258 lines · plain
1! Test lowering of internal procedures returning arrays or characters.2! This test allocation on the caller side of the results that may depend on3! host associated symbols.4! RUN: bbc -hlfir=false %s -o - | FileCheck %s5 6module some_module7 integer :: n_module8end module9 10! Test host calling array internal procedure.11! Result depends on host variable.12! CHECK-LABEL: func @_QPhost113subroutine host1()14 implicit none15 integer :: n16! CHECK: %[[VAL_1:.*]] = fir.alloca i3217 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) -> index20! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index21! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index22! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}23contains24 function return_array()25 real :: return_array(n)26 end function27end subroutine28 29! Test host calling array internal procedure.30! Result depends on module variable with the use statement inside the host.31! CHECK-LABEL: func @_QPhost232subroutine host2()33 use :: some_module34 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) -> index38! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index39! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index40! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}41contains42 function return_array()43 real :: return_array(n_module)44 end function45end subroutine46 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 @_QPhost350subroutine 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) -> index55! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index56! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index57! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}58contains59 function return_array()60 use :: some_module61 real :: return_array(n_module)62 end function63end subroutine64 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 none69 integer :: n70 call internal_proc_a()71contains72! CHECK-LABEL: func private @_QFhost4Pinternal_proc_a73! 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 : i3277! 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) -> index81! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index82! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index83! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}84 end subroutine85 function return_array()86 real :: return_array(n)87 end function88end subroutine89 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_module94 implicit none95 call internal_proc_a()96contains97! 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) -> index103! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index104! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index105! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}106 end subroutine107 function return_array()108 real :: return_array(n_module)109 end function110end subroutine111 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 none116 call internal_proc_a()117contains118! CHECK-LABEL: func private @_QFhost6Pinternal_proc_a119 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) -> index124! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index125! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index126! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}127 end subroutine128 function return_array()129 use :: some_module130 real :: return_array(n_module)131 end function132end subroutine133 134! Test host calling array internal procedure.135! Result depends on a common block variable declared in the host.136! CHECK-LABEL: func @_QPhost7137subroutine host7()138 implicit none139 integer :: n_common140 common /mycom/ n_common141 call takes_array(return_array())142! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index143! CHECK: %[[VAL_2:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>144! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>145! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32>146! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>147! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index148! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_9]], %{{.*}} : index149! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_9]], %{{.*}} : index150! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}151contains152 function return_array()153 real :: return_array(n_common)154 end function155end subroutine156 157! Test host calling array internal procedure.158! Result depends on a common block variable declared in the internal procedure.159! CHECK-LABEL: func @_QPhost8160subroutine host8()161 implicit none162 call takes_array(return_array())163! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index164! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>165! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_0]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>166! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>167! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>168! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index169! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index170! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index171! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}172contains173 function return_array()174 integer :: n_common175 common /mycom/ n_common176 real :: return_array(n_common)177 end function178end subroutine179 180! Test internal procedure A calling array internal procedure B.181! Result depends on a common block variable declared in the host.182subroutine host9()183 implicit none184 integer :: n_common185 common /mycom/ n_common186 call internal_proc_a()187contains188! CHECK-LABEL: func private @_QFhost9Pinternal_proc_a189 subroutine internal_proc_a()190! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index191! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>192! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_0]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>193! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>194! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>195! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index196! CHECK: %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_0]] : index197! CHECK: %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_6]], %[[VAL_0]] : index198! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_8]] {bindc_name = ".result"}199 call takes_array(return_array())200 end subroutine201 function return_array()202 use :: some_module203 real :: return_array(n_common)204 end function205end subroutine206 207! Test internal procedure A calling array internal procedure B.208! Result depends on a common block variable declared in B.209subroutine host10()210 implicit none211 call internal_proc_a()212contains213! CHECK-LABEL: func private @_QFhost10Pinternal_proc_a214 subroutine internal_proc_a()215 call takes_array(return_array())216! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index217! CHECK: %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>218! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_0]] : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>219! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>220! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>221! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index222! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index223! CHECK: %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index224! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}225 end subroutine226 function return_array()227 integer :: n_common228 common /mycom/ n_common229 real :: return_array(n_common)230 end function231end subroutine232 233 234! Test call to a function returning an array where the interface is use235! associated from a module.236module define_interface237contains238function foo()239 real :: foo(100)240 foo = 42241end function242end module243! CHECK-LABEL: func @_QPtest_call_to_used_interface(244! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {245subroutine test_call_to_used_interface(dummy_proc)246 use define_interface247 procedure(foo) :: dummy_proc248 call takes_array(dummy_proc())249! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index250! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = ".result"}251! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>252! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> !fir.array<100xf32>)253! CHECK: %[[VAL_6:.*]] = fir.call %[[VAL_5]]() {{.*}}: () -> !fir.array<100xf32>254! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_2]](%[[VAL_4]]) : !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>, !fir.shape<1>255! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>>256! CHECK: fir.call @_QPtakes_array(%[[VAL_7]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()257end subroutine258