1! Test lowering of pointer assignments 2! RUN: bbc --use-desc-for-alloc=false -emit-fir -hlfir=false %s -o - | FileCheck %s 3 4 5! Note that p => NULL() are tested in pointer-disassociate.f90 6 7! ----------------------------------------------------------------------------- 8! Test simple pointer assignments to contiguous right-hand side 9! ----------------------------------------------------------------------------- 10 11! CHECK-LABEL: func @_QPtest_scalar( 12! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[x:.*]]: !fir.ref<f32> {{{.*}}, fir.target}) 13subroutine test_scalar(p, x) 14 real, target :: x 15 real, pointer :: p 16 ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>> 17 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 18 p => x 19end subroutine 20 21! CHECK-LABEL: func @_QPtest_scalar_char( 22! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) 23subroutine test_scalar_char(p, x) 24 character(*), target :: x 25 character(:), pointer :: p 26 ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 27 ! CHECK: %[[box:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>> 28 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>> 29 p => x 30end subroutine 31 32! CHECK-LABEL: func @_QPtest_array( 33! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target}) 34subroutine test_array(p, x) 35 real, target :: x(100) 36 real, pointer :: p(:) 37 ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} 38 ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 39 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 40 p => x 41end subroutine 42 43! CHECK-LABEL: func @_QPtest_array_char( 44! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) { 45subroutine test_array_char(p, x) 46 character(*), target :: x(100) 47 character(:), pointer :: p(:) 48 ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 49 ! CHECK: %[[xaddr:.*]] = fir.convert %[[c]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<100x!fir.char<1,?>>> 50 ! CHECK-DAG: %[[xaddr2:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<100x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>> 51 ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}} 52 ! CHECK: %[[box:.*]] = fir.embox %[[xaddr2]](%[[shape]]) typeparams %[[c]]#1 53 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> 54 p => x 55end subroutine 56 57! Test 10.2.2.3 point 10: lower bounds requirements: 58! pointer takes lbounds from rhs if no bounds spec. 59! CHECK-LABEL: func @_QPtest_array_with_lbs( 60! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 61subroutine test_array_with_lbs(p, x) 62 real, target :: x(51:150) 63 real, pointer :: p(:) 64 ! CHECK: %[[shape:.*]] = fir.shape_shift %c51{{.*}}, %c100{{.*}} 65 ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 66 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 67 p => x 68end subroutine 69 70! Test that the lhs takes the bounds from rhs. 71! CHECK-LABEL: func @_QPtest_pointer_component( 72! CHECK-SAME: %[[temp:.*]]: !fir.ref<!fir.type<_QFtest_pointer_componentTmytype{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>> {fir.bindc_name = "temp"}, %[[temp_ptr:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "temp_ptr"}) { 73subroutine test_pointer_component(temp, temp_ptr) 74 type mytype 75 real, pointer :: ptr(:) 76 end type mytype 77 type(mytype) :: temp 78 real, pointer :: temp_ptr(:) 79 ! CHECK: %[[ptr_addr:.*]] = fir.coordinate_of %[[temp]], %{{.*}} : (!fir.ref<!fir.type<_QFtest_pointer_componentTmytype{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 80 ! CHECK: %[[ptr:.*]] = fir.load %[[ptr_addr]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 81 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[ptr]], %{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 82 ! CHECK: %[[shift:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> 83 ! CHECK: %[[arr_box:.*]] = fir.rebox %[[ptr]](%[[shift]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>> 84 ! CHECK: %[[shift2:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> 85 ! CHECK: %[[final_box:.*]] = fir.rebox %[[arr_box]](%[[shift2]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 86 ! CHECK: fir.store %[[final_box]] to %[[temp_ptr]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 87 temp_ptr => temp%ptr 88end subroutine 89 90! ----------------------------------------------------------------------------- 91! Test pointer assignments with bound specs to contiguous right-hand side 92! ----------------------------------------------------------------------------- 93 94! Test 10.2.2.3 point 10: lower bounds requirements: 95! pointer takes lbounds from bound spec if specified 96! CHECK-LABEL: func @_QPtest_array_with_new_lbs( 97! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 98subroutine test_array_with_new_lbs(p, x) 99 real, target :: x(51:150) 100 real, pointer :: p(:) 101 ! CHECK: %[[shape:.*]] = fir.shape_shift %c4{{.*}}, %c100{{.*}} 102 ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 103 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 104 p(4:) => x 105end subroutine 106 107! Test F2018 10.2.2.3 point 9: bounds remapping 108! CHECK-LABEL: func @_QPtest_array_remap( 109! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target}) 110subroutine test_array_remap(p, x) 111 real, target :: x(100) 112 real, pointer :: p(:, :) 113 ! CHECK-DAG: %[[c2_idx:.*]] = fir.convert %c2{{.*}} : (i64) -> index 114 ! CHECK-DAG: %[[c11_idx:.*]] = fir.convert %c11{{.*}} : (i64) -> index 115 ! CHECK-DAG: %[[diff0:.*]] = arith.subi %[[c11_idx]], %[[c2_idx]] : index 116 ! CHECK-DAG: %[[ext0:.*]] = arith.addi %[[diff0:.*]], %c1{{.*}} : index 117 ! CHECK-DAG: %[[c3_idx:.*]] = fir.convert %c3{{.*}} : (i64) -> index 118 ! CHECK-DAG: %[[c12_idx:.*]] = fir.convert %c12{{.*}} : (i64) -> index 119 ! CHECK-DAG: %[[diff1:.*]] = arith.subi %[[c12_idx]], %[[c3_idx]] : index 120 ! CHECK-DAG: %[[ext1:.*]] = arith.addi %[[diff1]], %c1{{.*}} : index 121 ! CHECK-DAG: %[[addrCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?x?xf32>> 122 ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] 123 ! CHECK: %[[box:.*]] = fir.embox %[[addrCast]](%[[shape]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>> 124 ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> 125 p(2:11, 3:12) => x 126end subroutine 127 128! CHECK-LABEL: func @_QPtest_array_char_remap( 129! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) 130subroutine test_array_char_remap(p, x) 131 ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[x]] 132 character(*), target :: x(100) 133 character(:), pointer :: p(:, :) 134 ! CHECK: subi 135 ! CHECK: %[[ext0:.*]] = arith.addi 136 ! CHECK: subi 137 ! CHECK: %[[ext1:.*]] = arith.addi 138 ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] 139 ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) typeparams %[[unbox]]#1 : (!fir.ref<!fir.array<?x?x!fir.char<1,?>>>, !fir.shapeshift<2>, index) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>> 140 ! CHECK: fir.store %[[box]] to %[[p]] 141 p(2:11, 3:12) => x 142end subroutine 143 144! ----------------------------------------------------------------------------- 145! Test simple pointer assignments to non contiguous right-hand side 146! ----------------------------------------------------------------------------- 147 148! CHECK-LABEL: func @_QPtest_array_non_contig_rhs( 149! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target}) 150subroutine test_array_non_contig_rhs(p, x) 151 real, target :: x(:) 152 real, pointer :: p(:) 153 ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 154 ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 155 p => x 156end subroutine 157 158! Test 10.2.2.3 point 10: lower bounds requirements: 159! pointer takes lbounds from rhs if no bounds spec. 160! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_lbs( 161! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target}) 162subroutine test_array_non_contig_rhs_lbs(p, x) 163 real, target :: x(7:) 164 real, pointer :: p(:) 165 ! CHECK: %[[c7_idx:.*]] = fir.convert %c7{{.*}} : (i64) -> index 166 ! CHECK: %[[shift:.*]] = fir.shift %[[c7_idx]] : (index) -> !fir.shift<1> 167 ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 168 ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 169 p => x 170end subroutine 171 172! CHECK-LABEL: func @_QPtest_array_non_contig_rhs2( 173! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<200xf32>> {{{.*}}, fir.target}) { 174! CHECK: %[[VAL_2:.*]] = arith.constant 200 : index 175! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64 176! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i64) -> index 177! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 178! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index 179! CHECK: %[[VAL_7:.*]] = arith.constant 160 : i64 180! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index 181! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> 182! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_4]], %[[VAL_8]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1> 183! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_1]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] : (!fir.ref<!fir.array<200xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<51xf32>> 184! CHECK: %[[VAL_12:.*]] = fir.rebox %[[VAL_11]] : (!fir.box<!fir.array<51xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 185! CHECK: fir.store %[[VAL_12]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 186! CHECK: return 187! CHECK: } 188 189subroutine test_array_non_contig_rhs2(p, x) 190 real, target :: x(200) 191 real, pointer :: p(:) 192 p => x(10:160:3) 193end subroutine 194 195! ----------------------------------------------------------------------------- 196! Test pointer assignments with bound specs to non contiguous right-hand side 197! ----------------------------------------------------------------------------- 198 199 200! Test 10.2.2.3 point 10: lower bounds requirements: 201! pointer takes lbounds from bound spec if specified 202! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_new_lbs( 203! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target}) 204subroutine test_array_non_contig_rhs_new_lbs(p, x) 205 real, target :: x(7:) 206 real, pointer :: p(:) 207 ! CHECK: %[[shift:.*]] = fir.shift %c4{{.*}} 208 ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 209 210 ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 211 p(4:) => x 212end subroutine 213 214! Test F2018 10.2.2.3 point 9: bounds remapping 215! CHECK-LABEL: func @_QPtest_array_non_contig_remap( 216! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target}) 217subroutine test_array_non_contig_remap(p, x) 218 real, target :: x(:) 219 real, pointer :: p(:, :) 220 ! CHECK: subi 221 ! CHECK: %[[ext0:.*]] = arith.addi 222 ! CHECK: subi 223 ! CHECK: %[[ext1:.*]] = arith.addi 224 ! CHECK: %[[shape:.*]] = fir.shape_shift %{{.*}}, %[[ext0]], %{{.*}}, %[[ext1]] 225 ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shape]]) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>> 226 ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> 227 p(2:11, 3:12) => x 228end subroutine 229 230! Test remapping a slice 231 232! CHECK-LABEL: func @_QPtest_array_non_contig_remap_slice( 233! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<400xf32>> {{{.*}}, fir.target}) { 234! CHECK: %[[VAL_2:.*]] = arith.constant 400 : index 235! CHECK: %[[VAL_3:.*]] = arith.constant 2 : i64 236! CHECK: %[[VAL_4:.*]] = arith.constant 11 : i64 237! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 238! CHECK: %[[VAL_6:.*]] = arith.constant 12 : i64 239! CHECK: %[[VAL_7:.*]] = arith.constant 51 : i64 240! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index 241! CHECK: %[[VAL_9:.*]] = arith.constant 3 : i64 242! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index 243! CHECK: %[[VAL_11:.*]] = arith.constant 350 : i64 244! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index 245! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> 246! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> 247! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_1]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.ref<!fir.array<400xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<100xf32>> 248! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index 249! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (i64) -> index 250! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (i64) -> index 251! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index 252! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_16]] : index 253! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_5]] : (i64) -> index 254! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_6]] : (i64) -> index 255! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : index 256! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_23]], %[[VAL_16]] : index 257! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_3]] : (i64) -> index 258! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_5]] : (i64) -> index 259! CHECK: %[[VAL_27:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_20]], %[[VAL_26]], %[[VAL_24]] : (index, index, index, index) -> !fir.shapeshift<2> 260! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_15]](%[[VAL_27]]) : (!fir.box<!fir.array<100xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>> 261! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> 262! CHECK: return 263! CHECK: } 264subroutine test_array_non_contig_remap_slice(p, x) 265 real, target :: x(400) 266 real, pointer :: p(:, :) 267 p(2:11, 3:12) => x(51:350:3) 268end subroutine 269 270! ----------------------------------------------------------------------------- 271! Test pointer assignments that involves LHS pointers lowered to local variables 272! instead of a fir.ref<fir.box>, and RHS that are fir.box 273! ----------------------------------------------------------------------------- 274 275! CHECK-LABEL: func @_QPissue857( 276! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>> 277subroutine issue857(rhs) 278 type t 279 integer :: i 280 end type 281 type(t), pointer :: rhs, lhs 282 ! CHECK: %[[lhs:.*]] = fir.alloca !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>> 283 ! CHECK: %[[box_load:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>> 284 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>) -> !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>> 285 ! CHECK: fir.store %[[addr]] to %[[lhs]] : !fir.ref<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>> 286 lhs => rhs 287end subroutine 288 289! CHECK-LABEL: func @_QPissue857_array( 290! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>> 291subroutine issue857_array(rhs) 292 type t 293 integer :: i 294 end type 295 type(t), contiguous, pointer :: rhs(:), lhs(:) 296 ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>> {uniq_name = "_QFissue857_arrayElhs.addr"} 297 ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.lb0"} 298 ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.ext0"} 299 ! CHECK: %[[box:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>> 300 ! CHECK: %[[lb:.*]]:3 = fir.box_dims %[[box]], %c{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index) 301 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>> 302 ! CHECK: %[[ext:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index) 303 ! CHECK-DAG: fir.store %[[addr]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>> 304 ! CHECK-DAG: fir.store %[[ext]]#1 to %[[lhs_ext]] : !fir.ref<index> 305 ! CHECK-DAG: fir.store %[[lb]]#0 to %[[lhs_lb]] : !fir.ref<index> 306 lhs => rhs 307end subroutine 308 309! CHECK-LABEL: func @_QPissue857_array_shift( 310subroutine issue857_array_shift(rhs) 311 ! Test lower bounds is the one from the shift 312 type t 313 integer :: i 314 end type 315 type(t), contiguous, pointer :: rhs(:), lhs(:) 316 ! CHECK: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_shiftElhs.lb0"} 317 ! CHECK: %[[c42:.*]] = fir.convert %c42{{.*}} : (i64) -> index 318 ! CHECK: fir.store %[[c42]] to %[[lhs_lb]] : !fir.ref<index> 319 lhs(42:) => rhs 320end subroutine 321 322! CHECK-LABEL: func @_QPissue857_array_remap 323subroutine issue857_array_remap(rhs) 324 ! Test lower bounds is the one from the shift 325 type t 326 integer :: i 327 end type 328 type(t), contiguous, pointer :: rhs(:, :), lhs(:) 329 ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>> {uniq_name = "_QFissue857_array_remapElhs.addr"} 330 ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.lb0"} 331 ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.ext0"} 332 333 ! CHECK: %[[c101:.*]] = fir.convert %c101_i64 : (i64) -> index 334 ! CHECK: %[[c200:.*]] = fir.convert %c200_i64 : (i64) -> index 335 ! CHECK: %[[sub:.*]] = arith.subi %[[c200]], %[[c101]] : index 336 ! CHECK: %[[extent:.*]] = arith.addi %[[sub]], %c1{{.*}} : index 337 ! CHECK: %[[addr:.*]] = fir.box_addr %{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>> 338 ! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>> 339 ! CHECK: fir.store %[[addr_cast]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>> 340 ! CHECK: fir.store %[[extent]] to %[[lhs_ext]] : !fir.ref<index> 341 ! CHECK: %[[c101_2:.*]] = fir.convert %c101{{.*}} : (i64) -> index 342 ! CHECK: fir.store %[[c101_2]] to %[[lhs_lb]] : !fir.ref<index> 343 lhs(101:200) => rhs 344end subroutine 345 346! CHECK-LABEL: func @_QPissue857_char 347subroutine issue857_char(rhs) 348 ! Only check that the length is taken from the fir.box created for the slice. 349 ! CHECK-DAG: %[[lhs1_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs1.len"} 350 ! CHECK-DAG: %[[lhs2_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs2.len"} 351 character(:), contiguous, pointer :: lhs1(:), lhs2(:, :) 352 character(*), target :: rhs(100) 353 ! CHECK: %[[len:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<50x!fir.char<1,?>>>) -> index 354 ! CHECK: fir.store %[[len]] to %[[lhs1_len]] : !fir.ref<index> 355 lhs1 => rhs(1:50:1) 356 ! CHECK: %[[len2:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<50x!fir.char<1,?>>>) -> index 357 ! CHECK: fir.store %[[len2]] to %[[lhs2_len]] : !fir.ref<index> 358 lhs2(1:2, 1:25) => rhs(1:50:1) 359end subroutine 360 361! CHECK-LABEL: func @_QPissue1180( 362! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {{{.*}}, fir.target}) { 363subroutine issue1180(x) 364 integer, target :: x 365 integer, pointer :: p 366 common /some_common/ p 367 ! CHECK: %[[VAL_1:.*]] = fir.address_of(@some_common_) : !fir.ref<!fir.array<24xi8>> 368 ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>> 369 ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index 370 ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8> 371 ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<i32>>> 372 ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>> 373 ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<i32>>> 374 p => x 375end subroutine 376