176 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2 3! Test dummy procedures4 5! Test of dummy procedure call6! CHECK-LABEL: func @_QPfoo(7! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f328real function foo(bar)9 real :: bar, x10 ! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"}11 x = 42.12 ! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> f32)13 ! CHECK: fir.call %[[funccast]](%[[x]]) {{.*}}: (!fir.ref<f32>) -> f3214 foo = bar(x)15end function16 17! Test case where dummy procedure is only transiting.18! CHECK-LABEL: func @_QPprefoo(19! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}}) -> f3220real function prefoo(bar)21 external :: bar22 ! CHECK: fir.call @_QPfoo(%arg0) {{.*}}: (!fir.boxproc<() -> ()>) -> f3223 prefoo = foo(bar)24end function25 26! Function that will be passed as dummy argument27! CHECK-LABEL: func @_QPfunc(28! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}}) -> f3229real function func(x)30 real :: x31 func = x + 0.532end function33 34! Test passing functions as dummy procedure arguments35! CHECK-LABEL: func @_QPtest_func36real function test_func()37 real :: func, prefoo38 external :: func39 !CHECK: %[[f:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f3240 !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>41 !CHECK: fir.call @_QPprefoo(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> f3242 test_func = prefoo(func)43end function44 45! Repeat test with dummy subroutine46 47! CHECK-LABEL: func @_QPfoo_sub(48! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})49subroutine foo_sub(bar_sub)50 ! CHECK: %[[x:.*]] = fir.alloca f32 {{{.*}}uniq_name = "{{.*}}Ex"}51 x = 42.52 ! CHECK: %[[funccast:.*]] = fir.box_addr %arg0 : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> ())53 ! CHECK: fir.call %[[funccast]](%[[x]]) {{.*}}: (!fir.ref<f32>)54 call bar_sub(x)55end subroutine56 57! Test case where dummy procedure is only transiting.58! CHECK-LABEL: func @_QPprefoo_sub(59! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})60subroutine prefoo_sub(bar_sub)61 external :: bar_sub62 ! CHECK: fir.call @_QPfoo_sub(%arg0) {{.*}}: (!fir.boxproc<() -> ()>) -> ()63 call foo_sub(bar_sub)64end subroutine65 66! Subroutine that will be passed as dummy argument67! CHECK-LABEL: func @_QPsub(68! CHECK-SAME: %{{.*}}: !fir.ref<f32>{{.*}})69subroutine sub(x)70 real :: x71 print *, x72end subroutine73 74! Test passing functions as dummy procedure arguments75! CHECK-LABEL: func @_QPtest_sub76subroutine test_sub()77 external :: sub78 !CHECK: %[[f:.*]] = fir.address_of(@_QPsub) : (!fir.ref<f32>) -> ()79 !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> ()) -> !fir.boxproc<() -> ()>80 !CHECK: fir.call @_QPprefoo_sub(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()81 call prefoo_sub(sub)82end subroutine83 84! CHECK-LABEL: func @_QPpassing_not_defined_in_file()85subroutine passing_not_defined_in_file()86 external proc_not_defined_in_file87 ! CHECK: %[[addr:.*]] = fir.address_of(@_QPproc_not_defined_in_file) : () -> ()88 ! CHECK: %[[ep:.*]] = fir.emboxproc %[[addr]]89 ! CHECK: fir.call @_QPprefoo_sub(%[[ep]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()90 call prefoo_sub(proc_not_defined_in_file)91end subroutine92 93! Test passing unrestricted intrinsics94 95! Intrinsic using runtime96! CHECK-LABEL: func @_QPtest_acos97subroutine test_acos(x)98 intrinsic :: acos99 !CHECK: %[[f:.*]] = fir.address_of(@fir.acos.f32.ref_f32) : (!fir.ref<f32>) -> f32100 !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>101 !CHECK: fir.call @_QPfoo_acos(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()102 call foo_acos(acos)103end subroutine104 105! CHECK-LABEL: func @_QPtest_atan2106subroutine test_atan2()107 intrinsic :: atan2108 ! CHECK: %[[f:.*]] = fir.address_of(@fir.atan2.f32.ref_f32.ref_f32) : (!fir.ref<f32>, !fir.ref<f32>) -> f32109 ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<f32>, !fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>110 ! CHECK: fir.call @_QPfoo_atan2(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()111 call foo_atan2(atan2)112end subroutine113 114! Intrinsic implemented inlined115! CHECK-LABEL: func @_QPtest_aimag116subroutine test_aimag()117 intrinsic :: aimag118 !CHECK: %[[f:.*]] = fir.address_of(@fir.aimag.f32.ref_z32) : (!fir.ref<complex<f32>>) -> f32119 !CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<complex<f32>>) -> f32) -> !fir.boxproc<() -> ()>120 !CHECK: fir.call @_QPfoo_aimag(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()121 call foo_aimag(aimag)122end subroutine123 124! Character Intrinsic implemented inlined125! CHECK-LABEL: func @_QPtest_len126subroutine test_len()127 intrinsic :: len128 ! CHECK: %[[f:.*]] = fir.address_of(@fir.len.i32.bc1) : (!fir.boxchar<1>) -> i32129 ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.boxchar<1>) -> i32) -> !fir.boxproc<() -> ()>130 !CHECK: fir.call @_QPfoo_len(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()131 call foo_len(len)132end subroutine133 134! Intrinsic implemented inlined with specific name different from generic135! CHECK-LABEL: func @_QPtest_iabs136subroutine test_iabs()137 intrinsic :: iabs138 ! CHECK: %[[f:.*]] = fir.address_of(@fir.abs.i32.ref_i32) : (!fir.ref<i32>) -> i32139 ! CHECK: %[[fcast:.*]] = fir.emboxproc %[[f]] : ((!fir.ref<i32>) -> i32) -> !fir.boxproc<() -> ()>140 ! CHECK: fir.call @_QPfoo_iabs(%[[fcast]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()141 call foo_iabs(iabs)142end subroutine143 144! TODO: exhaustive test of unrestricted intrinsic table 16.2145 146! TODO: improve dummy procedure types when interface is given.147! CHECK: func @_QPtodo3(148! CHECK-SAME: %{{.*}}: !fir.boxproc<() -> ()>{{.*}})149! SHOULD-CHECK: func @_QPtodo3(%arg0: (!fir.ref<f32>) -> f32)150subroutine todo3(dummy_proc)151 intrinsic :: acos152 procedure(acos) :: dummy_proc153end subroutine154 155! CHECK-LABEL: func private @fir.acos.f32.ref_f32(%arg0: !fir.ref<f32>) -> f32156 !CHECK: %[[load:.*]] = fir.load %arg0157 !CHECK: %[[res:.*]] = math.acos %[[load]] fastmath<contract> : f32158 !CHECK: return %[[res]] : f32159 160! CHECK-LABEL: func private @fir.atan2.f32.ref_f32.ref_f32(161! CHECK-SAME: %[[x:.*]]: !fir.ref<f32>, %[[y:.*]]: !fir.ref<f32>) -> f32162 ! CHECK-DAG: %[[xload:.*]] = fir.load %[[x]] : !fir.ref<f32>163 ! CHECK-DAG: %[[yload:.*]] = fir.load %[[y]] : !fir.ref<f32>164 ! CHECK: %[[atan2:.*]] = math.atan2 %[[xload]], %[[yload]] fastmath<contract> : f32165 ! CHECK: return %[[atan2]] : f32166 167!CHECK-LABEL: func private @fir.aimag.f32.ref_z32(%arg0: !fir.ref<complex<f32>>)168 !CHECK: %[[load:.*]] = fir.load %arg0169 !CHECK: %[[imag:.*]] = fir.extract_value %[[load]], [1 : index] : (complex<f32>) -> f32170 !CHECK: return %[[imag]] : f32171 172!CHECK-LABEL: func private @fir.len.i32.bc1(%arg0: !fir.boxchar<1>)173 !CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)174 !CHECK: %[[len:.*]] = fir.convert %[[unboxed]]#1 : (index) -> i32175 !CHECK: return %[[len]] : i32176