1! Test lowering of internal procedures returning arrays or characters. 2! This test allocation on the caller side of the results that may depend on 3! host associated symbols. 4! RUN: bbc -hlfir=false %s -o - | FileCheck %s 5 6module some_module 7 integer :: n_module 8end module 9 10! Test host calling array internal procedure. 11! Result depends on host variable. 12! CHECK-LABEL: func @_QPhost1 13subroutine host1() 14 implicit none 15 integer :: n 16! CHECK: %[[VAL_1:.*]] = fir.alloca i32 17 call takes_array(return_array()) 18! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32> 19! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index 20! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index 21! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index 22! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 23contains 24 function return_array() 25 real :: return_array(n) 26 end function 27end subroutine 28 29! Test host calling array internal procedure. 30! Result depends on module variable with the use statement inside the host. 31! CHECK-LABEL: func @_QPhost2 32subroutine host2() 33 use :: some_module 34 call takes_array(return_array()) 35! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32> 36! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32> 37! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index 38! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index 39! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index 40! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 41contains 42 function return_array() 43 real :: return_array(n_module) 44 end function 45end subroutine 46 47! Test host calling array internal procedure. 48! Result depends on module variable with the use statement inside the internal procedure. 49! CHECK-LABEL: func @_QPhost3 50subroutine host3() 51 call takes_array(return_array()) 52! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32> 53! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32> 54! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index 55! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index 56! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index 57! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 58contains 59 function return_array() 60 use :: some_module 61 real :: return_array(n_module) 62 end function 63end subroutine 64 65! Test internal procedure A calling array internal procedure B. 66! Result depends on host variable not directly used in A. 67subroutine host4() 68 implicit none 69 integer :: n 70 call internal_proc_a() 71contains 72! CHECK-LABEL: func private @_QFhost4Pinternal_proc_a 73! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} { 74 subroutine internal_proc_a() 75 call takes_array(return_array()) 76! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32 77! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>> 78! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>> 79! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32> 80! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index 81! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index 82! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index 83! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 84 end subroutine 85 function return_array() 86 real :: return_array(n) 87 end function 88end subroutine 89 90! Test internal procedure A calling array internal procedure B. 91! Result depends on module variable with use statement in the host. 92subroutine host5() 93 use :: some_module 94 implicit none 95 call internal_proc_a() 96contains 97! CHECK-LABEL: func private @_QFhost5Pinternal_proc_a() attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} { 98 subroutine internal_proc_a() 99 call takes_array(return_array()) 100! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32> 101! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32> 102! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index 103! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index 104! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index 105! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 106 end subroutine 107 function return_array() 108 real :: return_array(n_module) 109 end function 110end subroutine 111 112! Test internal procedure A calling array internal procedure B. 113! Result depends on module variable with use statement in B. 114subroutine host6() 115 implicit none 116 call internal_proc_a() 117contains 118! CHECK-LABEL: func private @_QFhost6Pinternal_proc_a 119 subroutine internal_proc_a() 120 call takes_array(return_array()) 121! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32> 122! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32> 123! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index 124! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index 125! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index 126! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 127 end subroutine 128 function return_array() 129 use :: some_module 130 real :: return_array(n_module) 131 end function 132end subroutine 133 134! Test host calling array internal procedure. 135! Result depends on a common block variable declared in the host. 136! CHECK-LABEL: func @_QPhost7 137subroutine host7() 138 implicit none 139 integer :: n_common 140 common /mycom/ n_common 141 call takes_array(return_array()) 142! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index 143! CHECK: %[[VAL_2:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>> 144! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>> 145! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8> 146! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32> 147! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32> 148! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index 149! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_9]], %{{.*}} : index 150! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_9]], %{{.*}} : index 151! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 152contains 153 function return_array() 154 real :: return_array(n_common) 155 end function 156end subroutine 157 158! Test host calling array internal procedure. 159! Result depends on a common block variable declared in the internal procedure. 160! CHECK-LABEL: func @_QPhost8 161subroutine host8() 162 implicit none 163 call takes_array(return_array()) 164! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index 165! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>> 166! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>> 167! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8> 168! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32> 169! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32> 170! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index 171! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index 172! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index 173! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 174contains 175 function return_array() 176 integer :: n_common 177 common /mycom/ n_common 178 real :: return_array(n_common) 179 end function 180end subroutine 181 182! Test internal procedure A calling array internal procedure B. 183! Result depends on a common block variable declared in the host. 184subroutine host9() 185 implicit none 186 integer :: n_common 187 common /mycom/ n_common 188 call internal_proc_a() 189contains 190! CHECK-LABEL: func private @_QFhost9Pinternal_proc_a 191 subroutine internal_proc_a() 192! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index 193! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>> 194! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>> 195! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8> 196! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32> 197! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32> 198! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index 199! CHECK: %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_0]] : index 200! CHECK: %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_6]], %[[VAL_0]] : index 201! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_8]] {bindc_name = ".result"} 202 call takes_array(return_array()) 203 end subroutine 204 function return_array() 205 use :: some_module 206 real :: return_array(n_common) 207 end function 208end subroutine 209 210! Test internal procedure A calling array internal procedure B. 211! Result depends on a common block variable declared in B. 212subroutine host10() 213 implicit none 214 call internal_proc_a() 215contains 216! CHECK-LABEL: func private @_QFhost10Pinternal_proc_a 217 subroutine internal_proc_a() 218 call takes_array(return_array()) 219! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index 220! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>> 221! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>> 222! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8> 223! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32> 224! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32> 225! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index 226! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index 227! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index 228! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"} 229 end subroutine 230 function return_array() 231 integer :: n_common 232 common /mycom/ n_common 233 real :: return_array(n_common) 234 end function 235end subroutine 236 237 238! Test call to a function returning an array where the interface is use 239! associated from a module. 240module define_interface 241contains 242function foo() 243 real :: foo(100) 244 foo = 42 245end function 246end module 247! CHECK-LABEL: func @_QPtest_call_to_used_interface( 248! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) { 249subroutine test_call_to_used_interface(dummy_proc) 250 use define_interface 251 procedure(foo) :: dummy_proc 252 call takes_array(dummy_proc()) 253! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index 254! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = ".result"} 255! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> 256! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> !fir.array<100xf32>) 257! CHECK: %[[VAL_6:.*]] = fir.call %[[VAL_5]]() {{.*}}: () -> !fir.array<100xf32> 258! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_2]](%[[VAL_4]]) : !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>, !fir.shape<1> 259! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>> 260! CHECK: fir.call @_QPtakes_array(%[[VAL_7]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> () 261end subroutine 262