1! Test lowering of procedure designators to HLFIR. 2! RUN: bbc -emit-hlfir -o - %s | FileCheck %s 3 4module 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 12contains 13 14subroutine test_pass_simple() 15 call takes_simple(simple) 16end 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 22subroutine test_pass_character() 23 call takes_char_proc(return_char) 24end 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 34subroutine test_pass_simple_dummy(proc) 35 procedure(simple) :: proc 36 call takes_simple(proc) 37end 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 42subroutine test_pass_character_dummy(proc) 43 procedure(return_char) :: proc 44 call takes_char_proc(proc) 45end 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 57subroutine test_pass_character_dummy_2(proc) 58 character(*), external :: proc 59 call takes_char_proc(proc) 60end 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 72subroutine test_pass_simple_internal() 73 integer :: x 74 call takes_simple(simple_internal) 75contains 76subroutine simple_internal() 77 x = 42 78end subroutine 79end 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 90subroutine test_pass_character_internal() 91 integer :: x 92 call takes_char_proc(return_char_internal) 93contains 94character(10) function return_char_internal() 95 return_char_internal = char(x) 96end function 97end 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 113subroutine test_call_simple_dummy(proc) 114 procedure(simple) :: proc 115 call proc() 116end 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 122subroutine test_call_character_dummy(proc) 123 procedure(return_char) :: proc 124 call takes_char(proc(42)) 125end 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_3:.*]] = fir.insert_value %{{.*}}, %c10{{.*}}, [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64> 130! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()> 131! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>) 132! CHECK: %[[VAL_13:.*]] = fir.call %[[VAL_5]](%[[VAL_1]], {{.*}} 133 134subroutine test_present_simple_dummy(proc) 135 procedure(simple), optional :: proc 136 call takes_logical(present(proc)) 137end 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 142subroutine test_present_character_dummy(proc) 143 procedure(return_char), optional :: proc 144 call takes_logical(present(proc)) 145end 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 158end module 159