| ! Test lowering of whole allocatable and pointers to HLFIR |
| ! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s |
| |
| subroutine passing_allocatable(x) |
| interface |
| subroutine takes_allocatable(y) |
| real, allocatable :: y(:) |
| end subroutine |
| subroutine takes_array(y) |
| real :: y(*) |
| end subroutine |
| end interface |
| real, allocatable :: x(:) |
| call takes_allocatable(x) |
| call takes_array(x) |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPpassing_allocatable( |
| ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"} |
| ! CHECK: fir.call @_QPtakes_allocatable(%[[VAL_1]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> () |
| ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> |
| ! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> |
| ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> |
| ! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> () |
| |
| subroutine passing_pointer(x) |
| interface |
| subroutine takes_pointer(y) |
| real, pointer :: y(:) |
| end subroutine |
| end interface |
| real, pointer :: x(:) |
| call takes_pointer(x) |
| call takes_pointer(NULL()) |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPpassing_pointer( |
| ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> |
| ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"} |
| ! CHECK: fir.call @_QPtakes_pointer(%[[VAL_2]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> () |
| ! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> |
| ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index |
| ! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> |
| ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> |
| ! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> |
| ! CHECK: fir.call @_QPtakes_pointer(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> () |
| |
| subroutine passing_contiguous_pointer(x) |
| interface |
| subroutine takes_array(y) |
| real :: y(*) |
| end subroutine |
| end interface |
| real, pointer, contiguous :: x(:) |
| call takes_array(x) |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer( |
| ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<contiguous, pointer>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> |
| ! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>> |
| ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> |
| ! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> () |
| |
| subroutine character_allocatable_cst_len(x) |
| character(10), allocatable :: x |
| call takes_char(x) |
| call takes_char(x//"hello") |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPcharacter_allocatable_cst_len( |
| ! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index |
| ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_1:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>> |
| ! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>> |
| ! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index |
| ! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,10>> |
| ! CHECK: %[[VAL_7:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_5]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1> |
| ! CHECK: fir.call @_QPtakes_char(%[[VAL_7]]) {{.*}} : (!fir.boxchar<1>) -> () |
| ! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>> |
| ! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>> |
| ! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10:[a-z0-9]*]] typeparams %[[VAL_11:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter> |
| ! CHECK: %[[VAL_13:.*]] = arith.constant 10 : index |
| ! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_11]] : index |
| ! CHECK: %[[VAL_15:.*]] = hlfir.concat %[[VAL_9]], %[[VAL_12]]#0 len %[[VAL_14]] : (!fir.heap<!fir.char<1,10>>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,15>> |
| |
| subroutine character_allocatable_dyn_len(x, l) |
| integer(8) :: l |
| character(l), allocatable :: x |
| call takes_char(x) |
| call takes_char(x//"hello") |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPcharacter_allocatable_dyn_len( |
| ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {uniq_name = {{.*}}El"} |
| ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64> |
| ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64 |
| ! CHECK: %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : i64 |
| ! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : i64 |
| ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_6:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> |
| ! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> |
| ! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1> |
| ! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) {{.*}} : (!fir.boxchar<1>) -> () |
| ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> |
| ! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> |
| ! CHECK: %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1> |
| ! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14:[a-z0-9]*]] typeparams %[[VAL_15:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter> |
| ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (i64) -> index |
| ! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_15]] : index |
| ! CHECK: %[[VAL_19:.*]] = hlfir.concat %[[VAL_13]], %[[VAL_16]]#0 len %[[VAL_18]] : (!fir.boxchar<1>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,?>> |
| |
| subroutine print_allocatable(x) |
| real, allocatable :: x(:) |
| print *, x |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPprint_allocatable( |
| ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> |
| ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none> |
| ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]]) |
| |
| subroutine print_pointer(x) |
| real, pointer :: x(:) |
| print *, x |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPprint_pointer( |
| ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> |
| ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> |
| ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]]) |
| |
| subroutine elemental_expr(x) |
| integer, pointer :: x(:, :) |
| call takes_array_2(x+42) |
| end subroutine |
| ! CHECK-LABEL: func.func @_QPelemental_expr( |
| ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"} |
| ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>> |
| ! CHECK: %[[VAL_3:.*]] = arith.constant 42 : i32 |
| ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index |
| ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index) |
| ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index |
| ! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index) |
| ! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_5]]#1, %[[VAL_7]]#1 : (index, index) -> !fir.shape<2> |
| ! CHECK: %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] unordered : (!fir.shape<2>) -> !hlfir.expr<?x?xi32> { |
| ! CHECK: ^bb0(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index): |
| ! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index |
| ! CHECK: %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index) |
| ! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index |
| ! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_14]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index) |
| ! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index |
| ! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_13]]#0, %[[VAL_16]] : index |
| ! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_10]], %[[VAL_17]] : index |
| ! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_15]]#0, %[[VAL_16]] : index |
| ! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_11]], %[[VAL_19]] : index |
| ! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_18]], %[[VAL_20]]) : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, index) -> !fir.ref<i32> |
| ! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<i32> |
| ! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_3]] : i32 |
| ! CHECK: hlfir.yield_element %[[VAL_23]] : i32 |
| ! CHECK: } |
