flang/test/Lower/HLFIR/procedure-designators.f90

   1 ! Test lowering of procedure designators to HLFIR.
   2 ! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
   3
   4 module test_proc_designator
   5   interface
   6     subroutine simple()
   7     end subroutine
   8     character(10) function return_char(x)
   9        integer :: x
  10     end function
  11   end interface
  12 contains
  13
  14 subroutine test_pass_simple()
  15   call takes_simple(simple)
  16 end subroutine
  17 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple() {
  18 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPsimple) : () -> ()
  19 ! CHECK:  %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : (() -> ()) -> !fir.boxproc<() -> ()>
  20 ! CHECK:  fir.call @_QPtakes_simple(%[[VAL_1]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
  21
  22 subroutine test_pass_character()
  23   call takes_char_proc(return_char)
  24 end subroutine
  25 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character() {
  26 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPreturn_char) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>
  27 ! CHECK:  %[[VAL_1:.*]] = arith.constant 10 : i64
  28 ! CHECK:  %[[VAL_2:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
  29 ! CHECK:  %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
  30 ! CHECK:  %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
  31 ! CHECK:  %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_1]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
  32 ! CHECK:  fir.call @_QPtakes_char_proc(%[[VAL_5]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
  33
  34 subroutine test_pass_simple_dummy(proc)
  35   procedure(simple) :: proc
  36   call takes_simple(proc)
  37 end subroutine
  38 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple_dummy(
  39 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
  40 ! CHECK:  fir.call @_QPtakes_simple(%[[VAL_0]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
  41
  42 subroutine test_pass_character_dummy(proc)
  43   procedure(return_char) :: proc
  44   call takes_char_proc(proc)
  45 end subroutine
  46 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_dummy(
  47 ! CHECK-SAME:    %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
  48 ! CHECK:  %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
  49 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  50 ! CHECK:  %[[VAL_3:.*]] = arith.constant 10 : i64
  51 ! CHECK:  %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
  52 ! CHECK:  %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
  53 ! CHECK:  %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
  54 ! CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
  55 ! CHECK:  fir.call @_QPtakes_char_proc(%[[VAL_7]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
  56
  57 subroutine test_pass_character_dummy_2(proc)
  58   character(*), external :: proc
  59   call takes_char_proc(proc)
  60 end subroutine
  61 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_dummy_2(
  62 ! CHECK-SAME:    %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
  63 ! CHECK:  %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
  64 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  65 ! CHECK:  %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
  66 ! CHECK:  %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
  67 ! CHECK:  %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
  68 ! CHECK:  %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
  69 ! CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
  70 ! CHECK:  fir.call @_QPtakes_char_proc(%[[VAL_7]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
  71
  72 subroutine test_pass_simple_internal()
  73   integer :: x
  74   call takes_simple(simple_internal)
  75 contains
  76 subroutine simple_internal()
  77   x = 42
  78 end subroutine
  79 end subroutine
  80 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple_internal() {
  81 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex
  82 ! CHECK:  %[[VAL_2:.*]] = fir.alloca tuple<!fir.ref<i32>>
  83 ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : i32
  84 ! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
  85 ! CHECK:  fir.store %[[VAL_1]]#1 to %[[VAL_4]] : !fir.llvm_ptr<!fir.ref<i32>>
  86 ! CHECK:  %[[VAL_5:.*]] = fir.address_of(@_QMtest_proc_designatorFtest_pass_simple_internalPsimple_internal) : (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
  87 ! CHECK:  %[[VAL_6:.*]] = fir.emboxproc %[[VAL_5]], %[[VAL_2]] : ((!fir.ref<tuple<!fir.ref<i32>>>) -> (), !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
  88 ! CHECK:  fir.call @_QPtakes_simple(%[[VAL_6]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
  89
  90 subroutine test_pass_character_internal()
  91   integer :: x
  92   call takes_char_proc(return_char_internal)
  93 contains
  94 character(10) function return_char_internal()
  95   return_char_internal = char(x)
  96 end function
  97 end subroutine
  98 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_internal() {
  99 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex
 100 ! CHECK:  %[[VAL_2:.*]] = fir.alloca tuple<!fir.ref<i32>>
 101 ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : i32
 102 ! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 103 ! CHECK:  fir.store %[[VAL_1]]#1 to %[[VAL_4]] : !fir.llvm_ptr<!fir.ref<i32>>
 104 ! CHECK:  %[[VAL_5:.*]] = fir.address_of(@_QMtest_proc_designatorFtest_pass_character_internalPreturn_char_internal) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxchar<1>
 105 ! CHECK:  %[[VAL_6:.*]] = arith.constant 10 : i64
 106 ! CHECK:  %[[VAL_7:.*]] = fir.emboxproc %[[VAL_5]], %[[VAL_2]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxchar<1>, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
 107 ! CHECK:  %[[VAL_8:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
 108 ! CHECK:  %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_7]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
 109 ! CHECK:  %[[VAL_10:.*]] = fir.insert_value %[[VAL_9]], %[[VAL_6]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
 110 ! CHECK:  fir.call @_QPtakes_char_proc(%[[VAL_10]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
 111
 112
 113 subroutine test_call_simple_dummy(proc)
 114   procedure(simple) :: proc
 115   call proc()
 116 end subroutine
 117 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_call_simple_dummy(
 118 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
 119 ! CHECK:  %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 120 ! CHECK:  fir.call %[[VAL_1]]() {{.*}}: () -> ()
 121
 122 subroutine test_call_character_dummy(proc)
 123   procedure(return_char) :: proc
 124   call takes_char(proc(42))
 125 end subroutine
 126 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_call_character_dummy(
 127 ! CHECK-SAME:    %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
 128 ! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".result"}
 129 ! CHECK:  %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 130 ! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 131 ! CHECK:  %[[VAL_12:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
 132 ! CHECK:  %[[VAL_13:.*]] = fir.call %[[VAL_12]](%[[VAL_1]], {{.*}}
 133
 134 subroutine test_present_simple_dummy(proc)
 135   procedure(simple), optional :: proc
 136   call takes_logical(present(proc))
 137 end subroutine
 138 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_present_simple_dummy(
 139 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
 140 ! CHECK:  %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> i1
 141
 142 subroutine test_present_character_dummy(proc)
 143   procedure(return_char), optional :: proc
 144   call takes_logical(present(proc))
 145 end subroutine
 146 ! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_present_character_dummy(
 147 ! CHECK-SAME:    %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
 148 ! CHECK:  %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 149 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 150 ! CHECK:  %[[VAL_3:.*]] = arith.constant 10 : i64
 151 ! CHECK:  %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
 152 ! CHECK:  %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
 153 ! CHECK:  %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
 154 ! CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
 155 ! CHECK:  %[[VAL_8:.*]] = fir.extract_value %[[VAL_7]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 156 ! CHECK:  %[[VAL_9:.*]] = fir.is_present %[[VAL_8]] : (!fir.boxproc<() -> ()>) -> i1
 157
 158 end module