flang/test/Lower/HLFIR/calls-f77.f90

   1 ! Test lowering of F77 calls to HLFIR
   2 ! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
   3
   4 ! -----------------------------------------------------------------------------
   5 !     Test lowering of F77 procedure reference arguments
   6 ! -----------------------------------------------------------------------------
   7
   8 subroutine call_no_arg()
   9   call void()
  10 end subroutine
  11 ! CHECK-LABEL: func.func @_QPcall_no_arg() {
  12 ! CHECK-NEXT:  fir.call @_QPvoid() fastmath<contract> : () -> ()
  13 ! CHECK-NEXT:  return
  14
  15 subroutine call_int_arg_var(n)
  16   integer :: n
  17   call take_i4(n)
  18 end 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]] {uniq_name = "_QFcall_int_arg_varEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
  22 ! CHECK:  fir.call @_QPtake_i4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<i32>) -> ()
  23
  24 subroutine call_int_arg_expr()
  25   call take_i4(42)
  26 end 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]] {uniq_name = "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
  33 subroutine call_real_arg_expr()
  34   call take_r4(0.42)
  35 end 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]] {uniq_name = "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
  42 subroutine call_real_arg_var(x)
  43   real :: x
  44   call take_r4(x)
  45 end 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]] {uniq_name = "_QFcall_real_arg_varEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
  49 ! CHECK:  fir.call @_QPtake_r4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<f32>) -> ()
  50
  51 subroutine call_logical_arg_var(x)
  52   logical :: x
  53   call take_l4(x)
  54 end 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]] {uniq_name = "_QFcall_logical_arg_varEx"} : (!fir.ref<!fir.logical<4>>) -> (!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
  60 subroutine call_logical_arg_expr()
  61   call take_l4(.true.)
  62 end 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]] {uniq_name = "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
  70 subroutine call_logical_arg_expr_2()
  71   call take_l8(.true._8)
  72 end 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]] {uniq_name = "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
  80 subroutine call_char_arg_var(x)
  81   character(*) :: x
  82   call take_c(x)
  83 end 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 {uniq_name = "_QFcall_char_arg_varEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
  88 ! CHECK:  fir.call @_QPtake_c(%[[VAL_2]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()
  89
  90 subroutine call_char_arg_var_expr(x)
  91   character(*) :: x
  92   call take_c(x//x)
  93 end 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 {uniq_name = "_QFcall_char_arg_var_exprEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!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]] {uniq_name = "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
 104 subroutine call_arg_array_var(n)
 105   integer :: n(10, 20)
 106   call take_arr(n)
 107 end 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]]) {uniq_name = "_QFcall_arg_array_varEn"} : (!fir.ref<!fir.array<10x20xi32>>, !fir.shape<2>) -> (!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
 116 subroutine call_arg_array_2(n)
 117   integer, contiguous, optional :: n(:, :)
 118   call take_arr_2(n)
 119 end 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]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFcall_arg_array_2En"} : (!fir.box<!fir.array<?x?xi32>>) -> (!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
 130 subroutine return_integer()
 131   integer :: ifoo
 132   print *, ifoo()
 133 end subroutine
 134 ! CHECK-LABEL: func.func @_QPreturn_integer(
 135 ! CHECK:  fir.call @_QPifoo() fastmath<contract> : () -> i32
 136
 137
 138 subroutine return_logical()
 139   logical :: lfoo
 140   print *, lfoo()
 141 end subroutine
 142 ! CHECK-LABEL: func.func @_QPreturn_logical(
 143 ! CHECK:  fir.call @_QPlfoo() fastmath<contract> : () -> !fir.logical<4>
 144
 145 subroutine return_complex()
 146   complex :: cplxfoo
 147   print *, cplxfoo()
 148 end subroutine
 149 ! CHECK-LABEL: func.func @_QPreturn_complex(
 150 ! CHECK:  fir.call @_QPcplxfoo() fastmath<contract> : () -> !fir.complex<4>
 151
 152 subroutine return_char(n)
 153   integer(8) :: n
 154   character(n) :: c2foo
 155   print *, c2foo()
 156 end subroutine
 157 ! CHECK-LABEL: func.func @_QPreturn_char(
 158 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}n
 159 ! CHECK:  %[[VAL_2:.*]] = arith.constant -1 : i32
 160 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !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(
 174 subroutine 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
 185 5 k = -1; return;
 186   ! CHECK: ^[[block2]]: // pred: ^bb0
 187 7 k =  1; return
 188 end