680 lines · plain
1! Test internal procedure host association lowering.2! RUN: bbc -hlfir=false -fwrapv %s -o - | FileCheck %s3 4! -----------------------------------------------------------------------------5! Test non character intrinsic scalars6! -----------------------------------------------------------------------------7 8!!! Test scalar (with implicit none)9 10! CHECK-LABEL: func @_QPtest1(11subroutine test112 implicit none13 integer i14 ! CHECK-DAG: %[[i:.*]] = fir.alloca i32 {{.*}}uniq_name = "_QFtest1Ei"15 ! CHECK-DAG: %[[tup:.*]] = fir.alloca tuple<!fir.ref<i32>>16 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[tup]], %c017 ! CHECK: fir.store %[[i]] to %[[addr]] : !fir.llvm_ptr<!fir.ref<i32>>18 ! CHECK: fir.call @_QFtest1Ptest1_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()19 call test1_internal20 print *, i21contains22 ! CHECK-LABEL: func private @_QFtest1Ptest1_internal(23 ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {24 ! CHECK: %[[iaddr:.*]] = fir.coordinate_of %[[arg]], %c025 ! CHECK: %[[i:.*]] = fir.load %[[iaddr]] : !fir.llvm_ptr<!fir.ref<i32>>26 ! CHECK: %[[val:.*]] = fir.call @_QPifoo() {{.*}}: () -> i3227 ! CHECK: fir.store %[[val]] to %[[i]] : !fir.ref<i32>28 subroutine test1_internal29 integer, external :: ifoo30 i = ifoo()31 end subroutine test1_internal32end subroutine test133 34!!! Test scalar35 36! CHECK-LABEL: func @_QPtest2() {37subroutine test238 a = 1.039 b = 2.040 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<f32>, !fir.ref<f32>>41 ! CHECK: %[[a0:.*]] = fir.coordinate_of %[[tup]], %c042 ! CHECK: fir.store %{{.*}} to %[[a0]] : !fir.llvm_ptr<!fir.ref<f32>>43 ! CHECK: %[[b0:.*]] = fir.coordinate_of %[[tup]], %c144 ! CHECK: fir.store %{{.*}} to %[[b0]] : !fir.llvm_ptr<!fir.ref<f32>>45 ! CHECK: fir.call @_QFtest2Ptest2_internal(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>>) -> ()46 call test2_internal47 print *, a, b48contains49 ! CHECK-LABEL: func private @_QFtest2Ptest2_internal(50 ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {51 subroutine test2_internal52 ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c053 ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>54 ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c155 ! CHECK: %{{.*}} = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>56 ! CHECK: fir.alloca57 ! CHECK: fir.load %[[aa]] : !fir.ref<f32>58 c = a59 a = b60 b = c61 call test2_inner62 end subroutine test2_internal63 64 ! CHECK-LABEL: func private @_QFtest2Ptest2_inner(65 ! CHECK-SAME: %[[arg:[^:]*]]: !fir.ref<tuple<!fir.ref<f32>, !fir.ref<f32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {66 subroutine test2_inner67 ! CHECK: %[[a:.*]] = fir.coordinate_of %[[arg]], %c068 ! CHECK: %[[aa:.*]] = fir.load %[[a]] : !fir.llvm_ptr<!fir.ref<f32>>69 ! CHECK: %[[b:.*]] = fir.coordinate_of %[[arg]], %c170 ! CHECK: %[[bb:.*]] = fir.load %[[b]] : !fir.llvm_ptr<!fir.ref<f32>>71 ! CHECK-DAG: %[[bd:.*]] = fir.load %[[bb]] : !fir.ref<f32>72 ! CHECK-DAG: %[[ad:.*]] = fir.load %[[aa]] : !fir.ref<f32>73 ! CHECK: %{{.*}} = arith.cmpf ogt, %[[ad]], %[[bd]] {{.*}} : f3274 if (a > b) then75 b = b + 2.076 end if77 end subroutine test2_inner78end subroutine test279 80! -----------------------------------------------------------------------------81! Test non character scalars82! -----------------------------------------------------------------------------83 84! CHECK-LABEL: func @_QPtest6(85! CHECK-SAME: %[[c:.*]]: !fir.boxchar<1>86subroutine test6(c)87 character(*) :: c88 ! CHECK: %[[cunbox:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)89 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.boxchar<1>>90 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>91 ! CHECK: %[[emboxchar:.*]] = fir.emboxchar %[[cunbox]]#0, %[[cunbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>92 ! CHECK: fir.store %[[emboxchar]] to %[[coor]] : !fir.ref<!fir.boxchar<1>>93 ! CHECK: fir.call @_QFtest6Ptest6_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.boxchar<1>>>) -> ()94 call test6_inner95 print *, c96 97contains98 ! CHECK-LABEL: func private @_QFtest6Ptest6_inner(99 ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {100 subroutine test6_inner101 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>102 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.boxchar<1>>103 ! CHECK: fir.unboxchar %[[load]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)104 c = "Hi there"105 end subroutine test6_inner106end subroutine test6107 108! -----------------------------------------------------------------------------109! Test non allocatable and pointer arrays110! -----------------------------------------------------------------------------111 112! CHECK-LABEL: func @_QPtest3(113! CHECK-SAME: %[[p:[^:]+]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[q:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[i:.*]]: !fir.ref<i64>114subroutine test3(p,q,i)115 integer(8) :: i116 real :: p(i:)117 real :: q(:)118 ! CHECK: %[[iload:.*]] = fir.load %[[i]] : !fir.ref<i64>119 ! CHECK: %[[icast:.*]] = fir.convert %[[iload]] : (i64) -> index120 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>121 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>122 ! CHECK: %[[pshift:.*]] = fir.shift %[[icast]] : (index) -> !fir.shift<1>123 ! CHECK: %[[pbox:.*]] = fir.rebox %[[p]](%[[pshift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>124 ! CHECK: fir.store %[[pbox]] to %[[ptup]] : !fir.ref<!fir.box<!fir.array<?xf32>>>125 ! CHECK: %[[qtup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>126 ! CHECK: %[[qbox:.*]] = fir.rebox %[[q]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>127 ! CHECK: fir.store %[[qbox]] to %[[qtup]] : !fir.ref<!fir.box<!fir.array<?xf32>>>128 129 i = i + 1130 q = -42.0131 132 ! CHECK: fir.call @_QFtest3Ptest3_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>) -> ()133 call test3_inner134 135 if (p(2) .ne. -42.0) then136 print *, "failed"137 end if138 139contains140 ! CHECK-LABEL: func private @_QFtest3Ptest3_inner(141 ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {142 subroutine test3_inner143 ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>144 ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>145 ! CHECK: %[[pbounds:.]]:3 = fir.box_dims %[[p]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)146 ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>147 ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<?xf32>>>148 ! CHECK: %[[qbounds:.]]:3 = fir.box_dims %[[q]], %c0{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)149 150 151 ! CHECK: %[[qlb:.*]] = fir.convert %[[qbounds]]#0 : (index) -> i64152 ! CHECK: %[[qoffset:.*]] = arith.subi %c1{{.*}}, %[[qlb]] : i64153 ! CHECK: %[[qelt:.*]] = fir.coordinate_of %[[q]], %[[qoffset]] : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>154 ! CHECK: %[[qload:.*]] = fir.load %[[qelt]] : !fir.ref<f32>155 ! CHECK: %[[plb:.*]] = fir.convert %[[pbounds]]#0 : (index) -> i64156 ! CHECK: %[[poffset:.*]] = arith.subi %c2{{.*}}, %[[plb]] : i64157 ! CHECK: %[[pelt:.*]] = fir.coordinate_of %[[p]], %[[poffset]] : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>158 ! CHECK: fir.store %[[qload]] to %[[pelt]] : !fir.ref<f32>159 p(2) = q(1)160 end subroutine test3_inner161end subroutine test3162 163! CHECK-LABEL: func @_QPtest3a(164! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.array<10xf32>>{{.*}}) {165subroutine test3a(p)166 real :: p(10)167 real :: q(10)168 ! CHECK: %[[q:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "q", uniq_name = "_QFtest3aEq"}169 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>170 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>171 ! CHECK: %[[shape:.*]] = fir.shape %c10{{.*}} : (index) -> !fir.shape<1>172 ! CHECK: %[[pbox:.*]] = fir.embox %[[p]](%[[shape]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>173 ! CHECK: fir.store %[[pbox]] to %[[ptup]] : !fir.ref<!fir.box<!fir.array<10xf32>>>174 ! CHECK: %[[qtup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>175 ! CHECK: %[[qbox:.*]] = fir.embox %[[q]](%[[shape]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>176 ! CHECK: fir.store %[[qbox]] to %[[qtup]] : !fir.ref<!fir.box<!fir.array<10xf32>>>177 178 q = -42.0179 ! CHECK: fir.call @_QFtest3aPtest3a_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>) -> ()180 call test3a_inner181 182 if (p(1) .ne. -42.0) then183 print *, "failed"184 end if185 186contains187 ! CHECK: func private @_QFtest3aPtest3a_inner(188 ! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {189 subroutine test3a_inner190 ! CHECK: %[[pcoor:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>191 ! CHECK: %[[p:.*]] = fir.load %[[pcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>192 ! CHECK: %[[paddr:.*]] = fir.box_addr %[[p]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>193 ! CHECK: %[[qcoor:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.box<!fir.array<10xf32>>, !fir.box<!fir.array<10xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<10xf32>>>194 ! CHECK: %[[q:.*]] = fir.load %[[qcoor]] : !fir.ref<!fir.box<!fir.array<10xf32>>>195 ! CHECK: %[[qaddr:.*]] = fir.box_addr %[[q]] : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>196 197 ! CHECK: %[[qelt:.*]] = fir.coordinate_of %[[qaddr]], %c0{{.*}} : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>198 ! CHECK: %[[qload:.*]] = fir.load %[[qelt]] : !fir.ref<f32>199 ! CHECK: %[[pelt:.*]] = fir.coordinate_of %[[paddr]], %c0{{.*}} : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>200 ! CHECK: fir.store %[[qload]] to %[[pelt]] : !fir.ref<f32>201 p(1) = q(1)202 end subroutine test3a_inner203end subroutine test3a204 205! -----------------------------------------------------------------------------206! Test allocatable and pointer scalars207! -----------------------------------------------------------------------------208 209! CHECK-LABEL: func @_QPtest4() {210subroutine test4211 real, pointer :: p212 real, allocatable, target :: ally213 ! CHECK: %[[ally:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "ally", fir.target, uniq_name = "_QFtest4Eally"}214 ! CHECK: %[[p:.*]] = fir.alloca !fir.box<!fir.ptr<f32>> {bindc_name = "p", uniq_name = "_QFtest4Ep"}215 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>216 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>217 ! CHECK: fir.store %[[p]] to %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>218 ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>219 ! CHECK: fir.store %[[ally]] to %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>220 ! CHECK: fir.call @_QFtest4Ptest4_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>) -> ()221 222 allocate(ally)223 ally = -42.0224 call test4_inner225 226 if (p .ne. -42.0) then227 print *, "failed"228 end if229 230contains231 ! CHECK-LABEL: func private @_QFtest4Ptest4_inner(232 ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {233 subroutine test4_inner234 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>235 ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<f32>>>>236 ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>237 ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<f32>>>>238 ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<f32>>>239 ! CHECK: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>240 ! CHECK: %[[ptr:.*]] = fir.embox %[[addr]] : (!fir.heap<f32>) -> !fir.box<!fir.ptr<f32>>241 ! CHECK: fir.store %[[ptr]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>242 p => ally243 end subroutine test4_inner244end subroutine test4245 246! -----------------------------------------------------------------------------247! Test allocatable and pointer arrays248! -----------------------------------------------------------------------------249 250! CHECK-LABEL: func @_QPtest5() {251subroutine test5252 real, pointer :: p(:)253 real, allocatable, target :: ally(:)254 255 ! CHECK: %[[ally:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "ally", fir.target256 ! CHECK: %[[p:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p"257 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>258 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>259 ! CHECK: fir.store %[[p]] to %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>260 ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>261 ! CHECK: fir.store %[[ally]] to %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>262 ! CHECK: fir.call @_QFtest5Ptest5_inner(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>) -> ()263 264 allocate(ally(10))265 ally = -42.0266 call test5_inner267 268 if (p(1) .ne. -42.0) then269 print *, "failed"270 end if271 272contains273 ! CHECK-LABEL: func private @_QFtest5Ptest5_inner(274 ! CHECK-SAME:%[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {275 subroutine test5_inner276 ! CHECK: %[[ptup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>277 ! CHECK: %[[p:.*]] = fir.load %[[ptup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>>278 ! CHECK: %[[atup:.*]] = fir.coordinate_of %[[tup]], %c1{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>279 ! CHECK: %[[a:.*]] = fir.load %[[atup]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>>280 ! CHECK: %[[abox:.*]] = fir.load %[[a]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>281 ! CHECK-DAG: %[[adims:.*]]:3 = fir.box_dims %[[abox]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)282 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[abox]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>283 ! CHECK-DAG: %[[ashape:.*]] = fir.shape_shift %[[adims]]#0, %[[adims]]#1 : (index, index) -> !fir.shapeshift<1>284 285 ! CHECK: %[[ptr:.*]] = fir.embox %[[addr]](%[[ashape]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>286 ! CHECK: fir.store %[[ptr]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>287 p => ally288 end subroutine test5_inner289end subroutine test5290 291 292! -----------------------------------------------------------------------------293! Test elemental internal procedure294! -----------------------------------------------------------------------------295 296! CHECK-LABEL: func @_QPtest7(297! CHECK-SAME: %[[j:.*]]: !fir.ref<i32>{{.*}}, %[[k:.*]]: !fir.box<!fir.array<?xi32>>298subroutine test7(j, k)299 implicit none300 integer :: j301 integer :: k(:)302 ! CHECK: %[[tup:.*]] = fir.alloca tuple<!fir.ref<i32>>303 ! CHECK: %[[jtup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>304 ! CHECK: fir.store %[[j]] to %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>305 306 ! CHECK: %[[kelem:.*]] = fir.array_coor %[[k]] %{{.*}} : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>307 ! CHECK: fir.call @_QFtest7Ptest7_inner(%[[kelem]], %[[tup]]) {{.*}}: (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> i32308 k = test7_inner(k)309contains310 311! CHECK-LABEL: func private @_QFtest7Ptest7_inner(312! CHECK-SAME: %[[i:.*]]: !fir.ref<i32>{{.*}}, %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) -> i32 attributes {fir.host_symbol = {{.*}}, fir.proc_attrs = #fir.proc_attrs<elemental, pure>, llvm.linkage = #llvm.linkage<internal>} {313elemental integer function test7_inner(i)314 implicit none315 integer, intent(in) :: i316 ! CHECK: %[[jtup:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>317 ! CHECK: %[[jptr:.*]] = fir.load %[[jtup]] : !fir.llvm_ptr<!fir.ref<i32>>318 ! CHECK-DAG: %[[iload:.*]] = fir.load %[[i]] : !fir.ref<i32>319 ! CHECK-DAG: %[[jload:.*]] = fir.load %[[jptr]] : !fir.ref<i32>320 ! CHECK: addi %[[iload]], %[[jload]] : i32321 test7_inner = i + j322end function323end subroutine324 325subroutine issue990()326 ! Test that host symbols used in statement functions inside an internal327 ! procedure are correctly captured from the host.328 implicit none329 integer :: captured330 call bar()331contains332! CHECK-LABEL: func private @_QFissue990Pbar(333! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {334subroutine bar()335 integer :: stmt_func, i336 stmt_func(i) = i + captured337 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>338 ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>339 ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>340 ! CHECK: arith.addi %{{.*}}, %[[value]] : i32341 print *, stmt_func(10)342end subroutine343end subroutine344 345subroutine issue990b()346 ! Test when an internal procedure uses a statement function from its host347 ! which uses host variables that are otherwise not used by the internal348 ! procedure.349 implicit none350 integer :: captured, captured_stmt_func, i351 captured_stmt_func(i) = i + captured352 call bar()353contains354! CHECK-LABEL: func private @_QFissue990bPbar(355! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {356subroutine bar()357 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>358 ! CHECK: %[[addr:.*]] = fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<i32>>359 ! CHECK: %[[value:.*]] = fir.load %[[addr]] : !fir.ref<i32>360 ! CHECK: arith.addi %{{.*}}, %[[value]] : i32361 print *, captured_stmt_func(10)362end subroutine363end subroutine364 365! Test capture of dummy procedure functions.366subroutine test8(dummy_proc)367 implicit none368 interface369 real function dummy_proc(x)370 real :: x371 end function372 end interface373 call bar()374contains375! CHECK-LABEL: func private @_QFtest8Pbar(376! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {377subroutine bar()378 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>379 ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>380 ! CHECK: %[[dummyProcCast:.*]] = fir.box_addr %[[dummyProc]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> f32)381 ! CHECK: fir.call %[[dummyProcCast]](%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32382 print *, dummy_proc(42.)383end subroutine384end subroutine385 386! Test capture of dummy subroutines.387subroutine test9(dummy_proc)388 implicit none389 interface390 subroutine dummy_proc()391 end subroutine392 end interface393 call bar()394contains395! CHECK-LABEL: func private @_QFtest9Pbar(396! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.boxproc<() -> ()>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {397subroutine bar()398 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.boxproc<() -> ()>>>, i32) -> !fir.ref<!fir.boxproc<() -> ()>>399 ! CHECK: %[[dummyProc:.*]] = fir.load %[[tupAddr]] : !fir.ref<!fir.boxproc<() -> ()>>400 ! CHECK: %[[pa:.*]] = fir.box_addr %[[dummyProc]]401 ! CHECK: fir.call %[[pa]]() {{.*}}: () -> ()402 call dummy_proc()403end subroutine404end subroutine405 406! Test capture of namelist407! CHECK-LABEL: func @_QPtest10(408! CHECK-SAME: %[[i:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>{{.*}}) {409subroutine test10(i)410 implicit none411 integer, pointer :: i(:)412 namelist /a_namelist/ i413 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup:.*]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>414 ! CHECK: fir.store %[[i]] to %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>415 ! CHECK: fir.call @_QFtest10Pbar(%[[tup]]) {{.*}}: (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>) -> ()416 call bar()417contains418! CHECK-LABEL: func private @_QFtest10Pbar(419! CHECK-SAME: %[[tup:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {420subroutine bar()421 ! CHECK: %[[tupAddr:.*]] = fir.coordinate_of %[[tup]], %c0{{.*}} : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>422 ! CHECK: fir.load %[[tupAddr]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>>423 read (88, NML = a_namelist)424end subroutine425end subroutine426 427! Test passing an internal procedure as a dummy argument.428 429! CHECK-LABEL: func @_QPtest_proc_dummy() {430! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFtest_proc_dummyEi"}431! CHECK: %[[VAL_5:.*]] = fir.alloca tuple<!fir.ref<i32>>432! CHECK: %[[VAL_7:.*]] = fir.address_of(@_QFtest_proc_dummyPtest_proc_dummy_a) : (!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> ()433! CHECK: %[[VAL_8:.*]] = fir.emboxproc %[[VAL_7]], %[[VAL_5]] : ((!fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>) -> (), !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>434! CHECK: fir.call @_QPtest_proc_dummy_other(%[[VAL_8]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()435 436! CHECK-LABEL: func private @_QFtest_proc_dummyPtest_proc_dummy_a(437! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "j"},438! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {439! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32440! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>441! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>442! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>443! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>444! CHECK: %[[VAL_7:.*]] = arith.addi %[[VAL_5]], %[[VAL_6]] : i32445! CHECK: fir.store %[[VAL_7]] to %[[VAL_4]] : !fir.ref<i32>446! CHECK: return447! CHECK: }448 449! CHECK-LABEL: func @_QPtest_proc_dummy_other(450! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {451! CHECK: %[[VAL_1:.*]] = arith.constant 4 : i32452! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref}453! CHECK: fir.store %[[VAL_1]] to %[[VAL_2]] : !fir.ref<i32>454! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<i32>) -> ())455! CHECK: fir.call %[[VAL_3]](%[[VAL_2]]) {{.*}}: (!fir.ref<i32>) -> ()456! CHECK: return457! CHECK: }458 459subroutine test_proc_dummy460 integer i461 i = 1462 call test_proc_dummy_other(test_proc_dummy_a)463 print *, i464contains465 subroutine test_proc_dummy_a(j)466 i = i + j467 end subroutine test_proc_dummy_a468end subroutine test_proc_dummy469 470subroutine test_proc_dummy_other(proc)471 call proc(4)472end subroutine test_proc_dummy_other473 474! CHECK-LABEL: func.func @_QPtest_proc_dummy_char() {475! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index476! CHECK: %[[VAL_1:.*]] = arith.constant 40 : index477! CHECK: %[[VAL_2:.*]] = arith.constant 10 : i64478! CHECK: %[[VAL_4:.*]] = arith.constant 6 : i32479! CHECK: %[[VAL_5:.*]] = arith.constant 32 : i8480! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index481! CHECK: %[[VAL_7:.*]] = arith.constant 9 : index482! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i32483! CHECK: %[[VAL_9:.*]] = arith.constant 10 : index484! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.char<1,40> {bindc_name = ".result"}485! CHECK: %[[VAL_11:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "message", uniq_name = "_QFtest_proc_dummy_charEmessage"}486! CHECK: %[[VAL_12:.*]] = fir.alloca tuple<!fir.boxchar<1>>487! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_12]], %[[VAL_8]] : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>488! CHECK: %[[VAL_14:.*]] = fir.emboxchar %[[VAL_11]], %[[VAL_9]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>489! CHECK: fir.store %[[VAL_14]] to %[[VAL_13]] : !fir.ref<!fir.boxchar<1>>490! CHECK: %[[VAL_15:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.+}}>>491! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_7]] : (index) -> i64492! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<!fir.char<1,10>>) -> !llvm.ptr493! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,9>>) -> !llvm.ptr494! CHECK: "llvm.intr.memmove"(%[[VAL_17]], %[[VAL_18]], %[[VAL_16]]) <{isVolatile = false}> : (!llvm.ptr, !llvm.ptr, i64) -> ()495! CHECK: %[[VAL_19:.*]] = fir.undefined !fir.char<1>496! CHECK: %[[VAL_20:.*]] = fir.insert_value %[[VAL_19]], %[[VAL_5]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>497! CHECK: cf.br ^bb1(%[[VAL_7]], %[[VAL_6]] : index, index)498! CHECK: ^bb1(%[[VAL_21:.*]]: index, %[[VAL_22:.*]]: index):499! CHECK: %[[VAL_23:.*]] = arith.cmpi sgt, %[[VAL_22]], %[[VAL_0]] : index500! CHECK: cf.cond_br %[[VAL_23]], ^bb2, ^bb3501! CHECK: ^bb2:502! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>503! CHECK: %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_24]], %[[VAL_21]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>504! CHECK: fir.store %[[VAL_20]] to %[[VAL_25]] : !fir.ref<!fir.char<1>>505! CHECK: %[[VAL_26:.*]] = arith.addi %[[VAL_21]], %[[VAL_6]] : index506! CHECK: %[[VAL_27:.*]] = arith.subi %[[VAL_22]], %[[VAL_6]] : index507! CHECK: cf.br ^bb1(%[[VAL_26]], %[[VAL_27]] : index, index)508! CHECK: ^bb3:509! CHECK: %[[VAL_28:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,{{.+}}>>510! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (!fir.ref<!fir.char<1,{{.+}}>>) -> !fir.ref<i8>511! CHECK: %[[VAL_30:.*]] = fir.call @_FortranAioBeginExternalListOutput512! CHECK: %[[VAL_31:.*]] = fir.address_of(@_QFtest_proc_dummy_charPgen_message) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxchar<1>513! CHECK: %[[VAL_32:.*]] = fir.emboxproc %[[VAL_31]], %[[VAL_12]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxchar<1>, !fir.ref<tuple<!fir.boxchar<1>>>) -> !fir.boxproc<() -> ()>514! CHECK: %[[VAL_33:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>515! CHECK: %[[VAL_34:.*]] = fir.insert_value %[[VAL_33]], %[[VAL_32]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>516! CHECK: %[[VAL_35:.*]] = fir.insert_value %[[VAL_34]], %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>517! CHECK: %[[VAL_36:.*]] = llvm.intr.stacksave : !llvm.ptr518! CHECK: %[[VAL_37:.*]] = fir.call @_QPget_message(%[[VAL_10]], %[[VAL_1]], %[[VAL_35]])519! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<i8>520! CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_1]] : (index) -> i64521! CHECK: %[[VAL_40:.*]] = fir.call @_FortranAioOutputAscii522! CHECK: llvm.intr.stackrestore %[[VAL_36]] : !llvm.ptr523! CHECK: %[[VAL_41:.*]] = fir.call @_FortranAioEndIoStatement524! CHECK: return525! CHECK: }526 527! CHECK-LABEL: func.func private @_QFtest_proc_dummy_charPgen_message(528! CHECK-SAME: %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<!fir.char<1,10>>,529! CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: index,530! CHECK-SAME: %[[VAL_2:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<tuple<!fir.boxchar<1>>> {fir.host_assoc}) -> !fir.boxchar<1> attributes {{.*}} {531! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index532! CHECK: %[[VAL_4:.*]] = arith.constant 32 : i8533! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index534! CHECK: %[[VAL_6:.*]] = arith.constant 10 : index535! CHECK: %[[VAL_7:.*]] = arith.constant 0 : i32536! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref<tuple<!fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>537! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<!fir.boxchar<1>>538! CHECK: %[[VAL_10:.*]]:2 = fir.unboxchar %[[VAL_9]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)539! CHECK: %[[VAL_11:.*]] = arith.cmpi sgt, %[[VAL_10]]#1, %[[VAL_6]] : index540! CHECK: %[[VAL_12:.*]] = arith.select %[[VAL_11]], %[[VAL_6]], %[[VAL_10]]#1 : index541! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (index) -> i64542! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !llvm.ptr543! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_10]]#0 : (!fir.ref<!fir.char<1,?>>) -> !llvm.ptr544! CHECK: "llvm.intr.memmove"(%[[VAL_14]], %[[VAL_15]], %[[VAL_13]]) <{isVolatile = false}> : (!llvm.ptr, !llvm.ptr, i64) -> ()545! CHECK: %[[VAL_16:.*]] = fir.undefined !fir.char<1>546! CHECK: %[[VAL_17:.*]] = fir.insert_value %[[VAL_16]], %[[VAL_4]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>547! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_6]], %[[VAL_12]] : index548! CHECK: cf.br ^bb1(%[[VAL_12]], %[[VAL_18]] : index, index)549! CHECK: ^bb1(%[[VAL_19:.*]]: index, %[[VAL_20:.*]]: index):550! CHECK: %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_3]] : index551! CHECK: cf.cond_br %[[VAL_21]], ^bb2, ^bb3552! CHECK: ^bb2:553! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.array<10x!fir.char<1>>>554! CHECK: %[[VAL_23:.*]] = fir.coordinate_of %[[VAL_22]], %[[VAL_19]] : (!fir.ref<!fir.array<10x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>555! CHECK: fir.store %[[VAL_17]] to %[[VAL_23]] : !fir.ref<!fir.char<1>>556! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_19]], %[[VAL_5]] : index557! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_20]], %[[VAL_5]] : index558! CHECK: cf.br ^bb1(%[[VAL_24]], %[[VAL_25]] : index, index)559! CHECK: ^bb3:560! CHECK: %[[VAL_26:.*]] = fir.emboxchar %[[VAL_0]], %[[VAL_6]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>561! CHECK: return %[[VAL_26]] : !fir.boxchar<1>562! CHECK: }563 564! CHECK-LABEL: func.func @_QPget_message(565! CHECK-SAME: %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<!fir.char<1,40>>,566! CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: index,567! CHECK-SAME: %[[VAL_2:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) -> !fir.boxchar<1> {568! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index569! CHECK: %[[VAL_4:.*]] = arith.constant 32 : i8570! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index571! CHECK: %[[VAL_6:.*]] = arith.constant 12 : index572! CHECK: %[[VAL_7:.*]] = arith.constant 40 : index573! CHECK: %[[VAL_8:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,12>>574! CHECK: %[[VAL_9:.*]] = fir.extract_value %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>575! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.boxproc<() -> ()>) -> (() -> ())576! CHECK: %[[VAL_11:.*]] = fir.extract_value %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64577! CHECK: %[[VAL_12:.*]] = llvm.intr.stacksave : !llvm.ptr578! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : i64) {bindc_name = ".result"}579! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_10]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)580! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_11]] : (i64) -> index581! CHECK: %[[VAL_16:.*]] = fir.call %[[VAL_14]](%[[VAL_13]], %[[VAL_15]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>582! CHECK: %[[VAL_17:.*]] = arith.addi %[[VAL_15]], %[[VAL_6]] : index583! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_17]] : index) {bindc_name = ".chrtmp"}584! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_6]] : (index) -> i64585! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,?>>) -> !llvm.ptr586! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.char<1,12>>) -> !llvm.ptr587! CHECK: "llvm.intr.memmove"(%[[VAL_20]], %[[VAL_21]], %[[VAL_19]]) <{isVolatile = false}> : (!llvm.ptr, !llvm.ptr, i64) -> ()588! CHECK: cf.br ^bb1(%[[VAL_6]], %[[VAL_15]] : index, index)589! CHECK: ^bb1(%[[VAL_22:.*]]: index, %[[VAL_23:.*]]: index):590! CHECK: %[[VAL_24:.*]] = arith.cmpi sgt, %[[VAL_23]], %[[VAL_3]] : index591! CHECK: cf.cond_br %[[VAL_24]], ^bb2, ^bb3592! CHECK: ^bb2:593! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_22]], %[[VAL_6]] : index594! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_13]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>595! CHECK: %[[VAL_27:.*]] = fir.coordinate_of %[[VAL_26]], %[[VAL_25]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>596! CHECK: %[[VAL_28:.*]] = fir.load %[[VAL_27]] : !fir.ref<!fir.char<1>>597! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>598! CHECK: %[[VAL_30:.*]] = fir.coordinate_of %[[VAL_29]], %[[VAL_22]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>599! CHECK: fir.store %[[VAL_28]] to %[[VAL_30]] : !fir.ref<!fir.char<1>>600! CHECK: %[[VAL_31:.*]] = arith.addi %[[VAL_22]], %[[VAL_5]] : index601! CHECK: %[[VAL_32:.*]] = arith.subi %[[VAL_23]], %[[VAL_5]] : index602! CHECK: cf.br ^bb1(%[[VAL_31]], %[[VAL_32]] : index, index)603! CHECK: ^bb3:604! CHECK: %[[VAL_33:.*]] = arith.cmpi sgt, %[[VAL_17]], %[[VAL_7]] : index605! CHECK: %[[VAL_34:.*]] = arith.select %[[VAL_33]], %[[VAL_7]], %[[VAL_17]] : index606! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_34]] : (index) -> i64607! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,40>>) -> !llvm.ptr608! CHECK: "llvm.intr.memmove"(%[[VAL_36]], %[[VAL_20]], %[[VAL_35]]) <{isVolatile = false}> : (!llvm.ptr, !llvm.ptr, i64) -> ()609! CHECK: %[[VAL_37:.*]] = fir.undefined !fir.char<1>610! CHECK: %[[VAL_38:.*]] = fir.insert_value %[[VAL_37]], %[[VAL_4]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>611! CHECK: %[[VAL_39:.*]] = arith.subi %[[VAL_7]], %[[VAL_34]] : index612! CHECK: cf.br ^bb4(%[[VAL_34]], %[[VAL_39]] : index, index)613! CHECK: ^bb4(%[[VAL_40:.*]]: index, %[[VAL_41:.*]]: index):614! CHECK: %[[VAL_42:.*]] = arith.cmpi sgt, %[[VAL_41]], %[[VAL_3]] : index615! CHECK: cf.cond_br %[[VAL_42]], ^bb5, ^bb6616! CHECK: ^bb5:617! CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,40>>) -> !fir.ref<!fir.array<40x!fir.char<1>>>618! CHECK: %[[VAL_44:.*]] = fir.coordinate_of %[[VAL_43]], %[[VAL_40]] : (!fir.ref<!fir.array<40x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>619! CHECK: fir.store %[[VAL_38]] to %[[VAL_44]] : !fir.ref<!fir.char<1>>620! CHECK: %[[VAL_45:.*]] = arith.addi %[[VAL_40]], %[[VAL_5]] : index621! CHECK: %[[VAL_46:.*]] = arith.subi %[[VAL_41]], %[[VAL_5]] : index622! CHECK: cf.br ^bb4(%[[VAL_45]], %[[VAL_46]] : index, index)623! CHECK: ^bb6:624! CHECK: llvm.intr.stackrestore %[[VAL_12]] : !llvm.ptr625! CHECK: %[[VAL_47:.*]] = fir.emboxchar %[[VAL_0]], %[[VAL_7]] : (!fir.ref<!fir.char<1,40>>, index) -> !fir.boxchar<1>626! CHECK: return %[[VAL_47]] : !fir.boxchar<1>627! CHECK: }628 629subroutine test_proc_dummy_char630 character(40) get_message631 external get_message632 character(10) message633 message = "Hi there!"634 print *, get_message(gen_message)635contains636 function gen_message637 character(10) :: gen_message638 gen_message = message639 end function gen_message640end subroutine test_proc_dummy_char641 642function get_message(a)643 character(40) :: get_message644 character(*) :: a645 get_message = "message is: " // a()646end function get_message647 648! CHECK-LABEL: func @_QPtest_11a() {649! CHECK: %[[a:.*]] = fir.address_of(@_QPtest_11b) : () -> ()650! CHECK: %[[b:.*]] = fir.emboxproc %[[a]] : (() -> ()) -> !fir.boxproc<() -> ()>651! CHECK: fir.call @_QPtest_11c(%[[b]], %{{.*}}) {{.*}}: (!fir.boxproc<() -> ()>, !fir.ref<i32>) -> ()652! CHECK: func private @_QPtest_11c(!fir.boxproc<() -> ()>, !fir.ref<i32>)653 654subroutine test_11a655 external test_11b656 call test_11c(test_11b, 3)657end subroutine test_11a658 659subroutine test_PDT_with_init_do_not_crash_host_symbol_analysis()660 integer :: i661 call sub()662contains663 subroutine sub()664 ! PDT definition symbols maps to un-analyzed expression,665 ! check this does not crash the visit of the internal procedure666 ! parse-tree to get the list of captured host variables.667 type type1 (k)668 integer, KIND :: k669 integer :: x = k670 end type671 type type2 (k, l)672 integer, KIND :: k = 4673 integer, LEN :: l = 2674 integer :: x = 10675 real :: y = 20676 end type677 print *, i678 end subroutine679end subroutine680