xref: /llvm-project/flang/test/Lower/host-associated-functions.f90 (revision 5aaf384b1614fcef5504d0b16d3e5063f72943c1)
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
2
3! Test calling functions whose result interface is evaluated on the call site
4! and where the calls are located in an internal procedure while the
5! interface is defined in the host procedure.
6
7! CHECK-LABEL: func @_QPcapture_char_func_dummy(
8! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},
9! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
10subroutine capture_char_func_dummy(char_func_dummy, n)
11  character(n),external :: char_func_dummy
12  ! CHECK:  %[[VAL_2:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>
13  ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : i32
14  ! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
15  ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_4]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
16  ! CHECK:  %[[VAL_5:.*]] = arith.constant 1 : i32
17  ! CHECK:  %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
18  ! CHECK:  fir.store %[[VAL_1]] to %[[VAL_6]] : !fir.llvm_ptr<!fir.ref<i32>>
19  ! CHECK:  fir.call @_QFcapture_char_func_dummyPinternal(%[[VAL_2]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>) -> ()
20  call internal()
21contains
22  ! CHECK-LABEL: func private @_QFcapture_char_func_dummyPinternal(
23  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
24  subroutine internal()
25  ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
26  ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
27  ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
28  ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : i32
29  ! CHECK:  %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
30  ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.llvm_ptr<!fir.ref<i32>>
31  ! CHECK:  %[[VAL_12:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
32  ! CHECK:  %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.boxproc<() -> ()>) -> (() -> ())
33  ! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_6]] : !fir.ref<i32>
34  ! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> i64
35  ! CHECK:  %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
36  ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
37  ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[C0]] : index
38  ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_16]], %[[C0]] : index
39  ! CHECK:  %[[VAL_17:.*]] = llvm.intr.stacksave : !llvm.ptr
40  ! CHECK:  %[[VAL_18:.*]] = fir.alloca !fir.char<1,?>(%[[SELECT]] : index) {bindc_name = ".result"}
41  ! CHECK:  %[[VAL_19:.*]] = fir.convert %[[VAL_13]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
42  ! CHECK:  %[[VAL_20:.*]] = fir.call %[[VAL_19]](%[[VAL_18]], %[[SELECT]]) {{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
43   print *, char_func_dummy()
44  end subroutine
45end subroutine
46
47! CHECK-LABEL: func @_QPcapture_char_func_assumed_dummy(
48! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
49subroutine capture_char_func_assumed_dummy(char_func_dummy)
50  character(*),external :: char_func_dummy
51! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>>
52! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
53! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
54! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
55! CHECK:  fir.call @_QFcapture_char_func_assumed_dummyPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>) -> ()
56  call internal()
57contains
58! CHECK-LABEL: func private @_QFcapture_char_func_assumed_dummyPinternal(
59! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
60  subroutine internal()
61! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
62! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
63! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
64! CHECK:  %[[VAL_9:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
65! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.boxproc<() -> ()>) -> (() -> ())
66! CHECK:  %[[VAL_11:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
67! CHECK:  %[[VAL_12:.*]] = llvm.intr.stacksave : !llvm.ptr
68! CHECK:  %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : i64) {bindc_name = ".result"}
69! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_10]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
70! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
71! CHECK:  %[[VAL_16:.*]] = fir.call %[[VAL_14]](%[[VAL_13]], %[[VAL_15]]) {{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
72   print *, char_func_dummy()
73  end subroutine
74end subroutine
75
76! CHECK-LABEL: func @_QPcapture_char_func(
77! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
78subroutine capture_char_func(n)
79  character(n), external :: char_func
80! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
81! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
82! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
83! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
84! CHECK:  fir.call @_QFcapture_char_funcPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
85  call internal()
86contains
87! CHECK-LABEL: func private @_QFcapture_char_funcPinternal(
88! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc})
89  subroutine internal()
90   print *, char_func()
91  end subroutine
92end subroutine
93
94! CHECK-LABEL: func @_QPcapture_array_func(
95! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
96subroutine capture_array_func(n)
97  integer :: n
98  interface
99  function array_func()
100    import :: n
101    integer :: array_func(n)
102  end function
103  end interface
104! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
105! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
106! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
107! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
108! CHECK:  fir.call @_QFcapture_array_funcPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
109  call internal()
110contains
111  subroutine internal()
112! CHECK-LABEL: func private @_QFcapture_array_funcPinternal(
113! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {
114! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
115! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
116! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
117! CHECK:  %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
118! CHECK:  %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
119! CHECK:  %[[VAL_11:.*]] = arith.constant 1 : i64
120! CHECK:  %[[VAL_12:.*]] = arith.subi %[[VAL_10]], %[[VAL_11]] : i64
121! CHECK:  %[[VAL_13:.*]] = arith.constant 1 : i64
122! CHECK:  %[[VAL_14:.*]] = arith.addi %[[VAL_12]], %[[VAL_13]] : i64
123! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> index
124! CHECK:  %[[C0:.*]] = arith.constant 0 : index
125! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[C0]] : index
126! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_15]], %[[C0]] : index
127! CHECK:  %[[VAL_16:.*]] = llvm.intr.stacksave : !llvm.ptr
128! CHECK:  %[[VAL_17:.*]] = fir.alloca !fir.array<?xi32>, %[[SELECT]] {bindc_name = ".result"}
129   print *, array_func()
130  end subroutine
131end subroutine
132
133module define_char_func
134  contains
135  function return_char(n)
136    integer :: n
137    character(n) :: return_char
138    return_char = "a"
139  end function
140end module
141
142! CHECK-LABEL: func @_QPuse_module() {
143subroutine use_module()
144  ! verify there is no capture triggers by the interface.
145  use define_char_func
146! CHECK:  fir.call @_QFuse_modulePinternal() {{.*}}: () -> ()
147  call internal()
148  contains
149! CHECK-LABEL: func private @_QFuse_modulePinternal() {{.*}} {
150  subroutine internal()
151    print *, return_char(42)
152  end subroutine
153end subroutine
154