1! Test lowering of F77 calls to HLFIR 2! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s 3 4! ----------------------------------------------------------------------------- 5! Test lowering of F77 procedure reference arguments 6! ----------------------------------------------------------------------------- 7 8subroutine call_no_arg() 9 call void() 10end subroutine 11! CHECK-LABEL: func.func @_QPcall_no_arg() { 12! CHECK-NEXT: fir.call @_QPvoid() fastmath<contract> : () -> () 13! CHECK-NEXT: return 14 15subroutine call_int_arg_var(n) 16 integer :: n 17 call take_i4(n) 18end subroutine 19! CHECK-LABEL: func.func @_QPcall_int_arg_var( 20! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> 21! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFcall_int_arg_varEn"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 22! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<i32>) -> () 23 24subroutine call_int_arg_expr() 25 call take_i4(42) 26end subroutine 27! CHECK-LABEL: func.func @_QPcall_int_arg_expr() { 28! CHECK: %[[VAL_0:.*]] = arith.constant 42 : i32 29! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {adapt.valuebyref} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1) 30! CHECK: fir.call @_QPtake_i4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<i32>) -> () 31! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<i32>, i1 32 33subroutine call_real_arg_expr() 34 call take_r4(0.42) 35end subroutine 36! CHECK-LABEL: func.func @_QPcall_real_arg_expr() { 37! CHECK: %[[VAL_0:.*]] = arith.constant 4.200000e-01 : f32 38! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {adapt.valuebyref} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1) 39! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<f32>) -> () 40! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<f32>, i1 41 42subroutine call_real_arg_var(x) 43 real :: x 44 call take_r4(x) 45end subroutine 46! CHECK-LABEL: func.func @_QPcall_real_arg_var( 47! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32> 48! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFcall_real_arg_varEx"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 49! CHECK: fir.call @_QPtake_r4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<f32>) -> () 50 51subroutine call_logical_arg_var(x) 52 logical :: x 53 call take_l4(x) 54end subroutine 55! CHECK-LABEL: func.func @_QPcall_logical_arg_var( 56! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.logical<4>> 57! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[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>>) 58! CHECK: fir.call @_QPtake_l4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> () 59 60subroutine call_logical_arg_expr() 61 call take_l4(.true.) 62end subroutine 63! CHECK-LABEL: func.func @_QPcall_logical_arg_expr() { 64! CHECK: %[[VAL_0:.*]] = arith.constant true 65! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<4> 66! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {adapt.valuebyref} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1) 67! CHECK: fir.call @_QPtake_l4(%[[VAL_2]]#1) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> () 68! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<4>>, i1 69 70subroutine call_logical_arg_expr_2() 71 call take_l8(.true._8) 72end subroutine 73! CHECK-LABEL: func.func @_QPcall_logical_arg_expr_2() { 74! CHECK: %[[VAL_0:.*]] = arith.constant true 75! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<8> 76! CHECK: %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {adapt.valuebyref} : (!fir.logical<8>) -> (!fir.ref<!fir.logical<8>>, !fir.ref<!fir.logical<8>>, i1) 77! CHECK: fir.call @_QPtake_l8(%[[VAL_2]]#1) fastmath<contract> : (!fir.ref<!fir.logical<8>>) -> () 78! CHECK: hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<8>>, i1 79 80subroutine call_char_arg_var(x) 81 character(*) :: x 82 call take_c(x) 83end subroutine 84! CHECK-LABEL: func.func @_QPcall_char_arg_var( 85! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> 86! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 87! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %{{[0-9]+}} {uniq_name = "_QFcall_char_arg_varEx"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>) 88! CHECK: fir.call @_QPtake_c(%[[VAL_2]]#0) fastmath<contract> : (!fir.boxchar<1>) -> () 89 90subroutine call_char_arg_var_expr(x) 91 character(*) :: x 92 call take_c(x//x) 93end subroutine 94! CHECK-LABEL: func.func @_QPcall_char_arg_var_expr( 95! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> 96! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 97! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %{{[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,?>>) 98! CHECK: %[[VAL_3:.*]] = arith.addi %[[VAL_1]]#1, %[[VAL_1]]#1 : index 99! 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,?>> 100! 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) 101! CHECK: fir.call @_QPtake_c(%[[VAL_5]]#0) fastmath<contract> : (!fir.boxchar<1>) -> () 102! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.char<1,?>>, i1 103 104subroutine call_arg_array_var(n) 105 integer :: n(10, 20) 106 call take_arr(n) 107end subroutine 108! CHECK-LABEL: func.func @_QPcall_arg_array_var( 109! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<10x20xi32>> 110! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index 111! CHECK: %[[VAL_2:.*]] = arith.constant 20 : index 112! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2> 113! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_3]]) dummy_scope %{{[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>>) 114! CHECK: fir.call @_QPtake_arr(%[[VAL_4]]#1) fastmath<contract> : (!fir.ref<!fir.array<10x20xi32>>) -> () 115 116subroutine call_arg_array_2(n) 117 integer, contiguous, optional :: n(:, :) 118 call take_arr_2(n) 119end subroutine 120! CHECK-LABEL: func.func @_QPcall_arg_array_2( 121! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xi32>> 122! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[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>>) 123! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>> 124! CHECK: fir.call @_QPtake_arr_2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> () 125 126! ----------------------------------------------------------------------------- 127! Test lowering of function results 128! ----------------------------------------------------------------------------- 129 130subroutine return_integer() 131 integer :: ifoo 132 print *, ifoo() 133end subroutine 134! CHECK-LABEL: func.func @_QPreturn_integer( 135! CHECK: fir.call @_QPifoo() fastmath<contract> : () -> i32 136 137 138subroutine return_logical() 139 logical :: lfoo 140 print *, lfoo() 141end subroutine 142! CHECK-LABEL: func.func @_QPreturn_logical( 143! CHECK: fir.call @_QPlfoo() fastmath<contract> : () -> !fir.logical<4> 144 145subroutine return_complex() 146 complex :: cplxfoo 147 print *, cplxfoo() 148end subroutine 149! CHECK-LABEL: func.func @_QPreturn_complex( 150! CHECK: fir.call @_QPcplxfoo() fastmath<contract> : () -> complex<f32> 151 152subroutine return_char(n) 153 integer(8) :: n 154 character(n) :: c2foo 155 print *, c2foo() 156end subroutine 157! CHECK-LABEL: func.func @_QPreturn_char( 158! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}n 159! CHECK: %[[VAL_2:.*]] = arith.constant 6 : i32 160! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<i64> 161! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index 162! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index 163! CHECK: %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index 164! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index 165! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : index) {bindc_name = ".result"} 166! CHECK: %[[VAL_14:.*]] = fir.call @_QPc2foo(%[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> 167! 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,?>>) 168 169! ----------------------------------------------------------------------------- 170! Test calls with alternate returns 171! ----------------------------------------------------------------------------- 172 173! CHECK-LABEL: func.func @_QPalternate_return_call( 174subroutine alternate_return_call(n1, n2, k) 175 integer :: n1, n2, k 176 ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}k 177 ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}n1 178 ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}n2 179 ! CHECK: %[[selector:.*]] = fir.call @_QPalternate_return(%[[VAL_4]]#1, %[[VAL_5]]#1) fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> index 180 ! CHECK-NEXT: fir.select %[[selector]] : index [1, ^[[block1:bb[0-9]+]], 2, ^[[block2:bb[0-9]+]], unit, ^[[blockunit:bb[0-9]+]] 181 call alternate_return(n1, *5, n2, *7) 182 ! CHECK: ^[[blockunit]]: // pred: ^bb0 183 k = 0; return; 184 ! CHECK: ^[[block1]]: // pred: ^bb0 1855 k = -1; return; 186 ! CHECK: ^[[block2]]: // pred: ^bb0 1877 k = 1; return 188end 189 190! ----------------------------------------------------------------------------- 191! Test calls to user procedures with intrinsic interfaces 192! ----------------------------------------------------------------------------- 193 194! CHECK-NAME: func.func @_QPintrinsic_iface() 195subroutine intrinsic_iface() 196 intrinsic acos 197 real :: x 198 procedure(acos) :: proc 199 x = proc(1.0) 200end subroutine 201! CHECK" fir.call @_QPproc(%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32 202