203 lines · plain
1! Test lowering of F77 calls to HLFIR2! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s3 4! -----------------------------------------------------------------------------5! Test lowering of F77 procedure reference arguments6! -----------------------------------------------------------------------------7 8subroutine call_no_arg()9 call void()10end subroutine11! CHECK-LABEL: func.func @_QPcall_no_arg() {12! CHECK-NEXT: fir.dummy_scope13! CHECK-NEXT: fir.call @_QPvoid() fastmath<contract> : () -> ()14! CHECK-NEXT: return15 16subroutine call_int_arg_var(n)17 integer :: n18 call take_i4(n)19end subroutine20! CHECK-LABEL: func.func @_QPcall_int_arg_var(21! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32>22! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_int_arg_varEn"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)23! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<i32>) -> ()24 25subroutine call_int_arg_expr()26 call take_i4(42)27end subroutine28! CHECK-LABEL: func.func @_QPcall_int_arg_expr() {29! CHECK: %[[VAL_0:.*]] = arith.constant 42 : i3230! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {adapt.valuebyref} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)31! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<i32>) -> ()32! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<i32>, i133 34subroutine call_real_arg_expr()35 call take_r4(0.42)36end subroutine37! CHECK-LABEL: func.func @_QPcall_real_arg_expr() {38! CHECK: %[[VAL_0:.*]] = arith.constant 4.200000e-01 : f3239! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {adapt.valuebyref} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1)40! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<f32>) -> ()41! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<f32>, i142 43subroutine call_real_arg_var(x)44 real :: x45 call take_r4(x)46end subroutine47! CHECK-LABEL: func.func @_QPcall_real_arg_var(48! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>49! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_real_arg_varEx"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>)50! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<f32>) -> ()51 52subroutine call_logical_arg_var(x)53 logical :: x54 call take_l4(x)55end subroutine56! CHECK-LABEL: func.func @_QPcall_logical_arg_var(57! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.logical<4>>58! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_logical_arg_varEx"} : (!fir.ref<!fir.logical<4>>, !fir.dscope) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)59! CHECK: fir.call @_QPtake_l4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()60 61subroutine call_logical_arg_expr()62 call take_l4(.true.)63end subroutine64! CHECK-LABEL: func.func @_QPcall_logical_arg_expr() {65! CHECK: %[[VAL_0:.*]] = arith.constant true66! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<4>67! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {adapt.valuebyref} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1)68! CHECK: fir.call @_QPtake_l4(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()69! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<4>>, i170 71subroutine call_logical_arg_expr_2()72 call take_l8(.true._8)73end subroutine74! CHECK-LABEL: func.func @_QPcall_logical_arg_expr_2() {75! CHECK: %[[VAL_0:.*]] = arith.constant true76! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<8>77! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {adapt.valuebyref} : (!fir.logical<8>) -> (!fir.ref<!fir.logical<8>>, !fir.ref<!fir.logical<8>>, i1)78! CHECK: fir.call @_QPtake_l8(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<8>>) -> ()79! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<8>>, i180 81subroutine call_char_arg_var(x)82 character(*) :: x83 call take_c(x)84end subroutine85! CHECK-LABEL: func.func @_QPcall_char_arg_var(86! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>87! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)88! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_char_arg_varEx"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)89! CHECK: fir.call @_QPtake_c(%[[VAL_2]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()90 91subroutine call_char_arg_var_expr(x)92 character(*) :: x93 call take_c(x//x)94end subroutine95! CHECK-LABEL: func.func @_QPcall_char_arg_var_expr(96! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>97! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)98! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_char_arg_var_exprEx"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)99! CHECK: %[[VAL_3:.*]] = arith.addi %[[VAL_1]]#1, %[[VAL_1]]#1 : index100! CHECK: %[[VAL_4:.*]] = hlfir.concat %[[VAL_2]]#0, %[[VAL_2]]#0 len %[[VAL_3]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>101! CHECK: %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]] typeparams %[[VAL_3]] {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)102! CHECK: fir.call @_QPtake_c(%[[VAL_5]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()103! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.char<1,?>>, i1104 105subroutine call_arg_array_var(n)106 integer :: n(10, 20)107 call take_arr(n)108end subroutine109! CHECK-LABEL: func.func @_QPcall_arg_array_var(110! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<10x20xi32>>111! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index112! CHECK: %[[VAL_2:.*]] = arith.constant 20 : index113! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>114! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_3]]) dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFcall_arg_array_varEn"} : (!fir.ref<!fir.array<10x20xi32>>, !fir.shape<2>, !fir.dscope) -> (!fir.ref<!fir.array<10x20xi32>>, !fir.ref<!fir.array<10x20xi32>>)115! CHECK: fir.call @_QPtake_arr(%[[VAL_4]]#0) fastmath<contract> : (!fir.ref<!fir.array<10x20xi32>>) -> ()116 117subroutine call_arg_array_2(n)118 integer, contiguous, optional :: n(:, :)119 call take_arr_2(n)120end subroutine121! CHECK-LABEL: func.func @_QPcall_arg_array_2(122! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xi32>>123! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFcall_arg_array_2En"} : (!fir.box<!fir.array<?x?xi32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)124! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>>125! CHECK: fir.call @_QPtake_arr_2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> ()126 127! -----------------------------------------------------------------------------128! Test lowering of function results129! -----------------------------------------------------------------------------130 131subroutine return_integer()132 integer :: ifoo133 print *, ifoo()134end subroutine135! CHECK-LABEL: func.func @_QPreturn_integer(136! CHECK: fir.call @_QPifoo() fastmath<contract> : () -> i32137 138 139subroutine return_logical()140 logical :: lfoo141 print *, lfoo()142end subroutine143! CHECK-LABEL: func.func @_QPreturn_logical(144! CHECK: fir.call @_QPlfoo() fastmath<contract> : () -> !fir.logical<4>145 146subroutine return_complex()147 complex :: cplxfoo148 print *, cplxfoo()149end subroutine150! CHECK-LABEL: func.func @_QPreturn_complex(151! CHECK: fir.call @_QPcplxfoo() fastmath<contract> : () -> complex<f32>152 153subroutine return_char(n)154 integer(8) :: n155 character(n) :: c2foo156 print *, c2foo()157end subroutine158! CHECK-LABEL: func.func @_QPreturn_char(159! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}n160! CHECK: %[[VAL_2:.*]] = arith.constant 6 : i32161! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<i64>162! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index163! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index164! CHECK: %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index165! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index166! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : index) {bindc_name = ".result"}167! CHECK: %[[VAL_14:.*]] = fir.call @_QPc2foo(%[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>168! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_13]] typeparams %[[VAL_11]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)169 170! -----------------------------------------------------------------------------171! Test calls with alternate returns172! -----------------------------------------------------------------------------173 174! CHECK-LABEL: func.func @_QPalternate_return_call(175subroutine alternate_return_call(n1, n2, k)176 integer :: n1, n2, k177 ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}k178 ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}n1179 ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}n2180 ! CHECK: %[[selector:.*]] = fir.call @_QPalternate_return(%[[VAL_4]]#0, %[[VAL_5]]#0) fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> index181 ! CHECK-NEXT: fir.select %[[selector]] : index [1, ^[[block1:bb[0-9]+]], 2, ^[[block2:bb[0-9]+]], unit, ^[[blockunit:bb[0-9]+]]182 call alternate_return(n1, *5, n2, *7)183 ! CHECK: ^[[blockunit]]: // pred: ^bb0184 k = 0; return;185 ! CHECK: ^[[block1]]: // pred: ^bb01865 k = -1; return;187 ! CHECK: ^[[block2]]: // pred: ^bb01887 k = 1; return189end190 191! -----------------------------------------------------------------------------192! Test calls to user procedures with intrinsic interfaces193! -----------------------------------------------------------------------------194 195! CHECK-LABEL: func.func @_QPintrinsic_iface()196subroutine intrinsic_iface()197 intrinsic acos198 real :: x199 procedure(acos) :: proc200 x = proc(1.0)201end subroutine202! CHECK: fir.call @_QPproc(%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32203