1! Test lowering of pointer components 2! RUN: bbc -emit-fir %s -o - | FileCheck %s 3 4module pcomp 5 implicit none 6 type t 7 real :: x 8 integer :: i 9 end type 10 interface 11 subroutine takes_real_scalar(x) 12 real :: x 13 end subroutine 14 subroutine takes_char_scalar(x) 15 character(*) :: x 16 end subroutine 17 subroutine takes_derived_scalar(x) 18 import t 19 type(t) :: x 20 end subroutine 21 subroutine takes_real_array(x) 22 real :: x(:) 23 end subroutine 24 subroutine takes_char_array(x) 25 character(*) :: x(:) 26 end subroutine 27 subroutine takes_derived_array(x) 28 import t 29 type(t) :: x(:) 30 end subroutine 31 subroutine takes_real_scalar_pointer(x) 32 real, pointer :: x 33 end subroutine 34 subroutine takes_real_array_pointer(x) 35 real, pointer :: x(:) 36 end subroutine 37 subroutine takes_logical(x) 38 logical :: x 39 end subroutine 40 end interface 41 42 type real_p0 43 real, pointer :: p 44 end type 45 type real_p1 46 real, pointer :: p(:) 47 end type 48 type cst_char_p0 49 character(10), pointer :: p 50 end type 51 type cst_char_p1 52 character(10), pointer :: p(:) 53 end type 54 type def_char_p0 55 character(:), pointer :: p 56 end type 57 type def_char_p1 58 character(:), pointer :: p(:) 59 end type 60 type derived_p0 61 type(t), pointer :: p 62 end type 63 type derived_p1 64 type(t), pointer :: p(:) 65 end type 66 67 real, target :: real_target, real_array_target(100) 68 character(10), target :: char_target, char_array_target(100) 69 70contains 71 72! ----------------------------------------------------------------------------- 73! Test pointer component references 74! ----------------------------------------------------------------------------- 75 76! CHECK-LABEL: func @_QMpcompPref_scalar_real_p( 77! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>{{.*}}) { 78subroutine ref_scalar_real_p(p0_0, p1_0, p0_1, p1_1) 79 type(real_p0) :: p0_0, p0_1(100) 80 type(real_p1) :: p1_0, p1_1(100) 81 82 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}> 83 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>> 84 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 85 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32> 86 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32> 87 ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> () 88 call takes_real_scalar(p0_0%p) 89 90 ! CHECK: %[[p0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>> 91 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}> 92 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>> 93 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 94 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32> 95 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32> 96 ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> () 97 call takes_real_scalar(p0_1(5)%p) 98 99 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 100 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 101 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 102 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 103 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 104 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 105 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32> 106 ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> () 107 call takes_real_scalar(p1_0%p(7)) 108 109 ! CHECK: %[[p1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>> 110 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 111 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 112 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 113 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 114 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 115 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 116 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32> 117 ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> () 118 call takes_real_scalar(p1_1(5)%p(7)) 119end subroutine 120 121! CHECK-LABEL: func @_QMpcompPref_array_real_p( 122! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>{{.*}}) { 123! CHECK: %[[VAL_2:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 124! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 125! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 126! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index 127! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 128! CHECK: %[[VAL_7:.*]] = arith.constant 20 : i64 129! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index 130! CHECK: %[[VAL_9:.*]] = arith.constant 2 : i64 131! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index 132! CHECK: %[[VAL_11:.*]] = arith.constant 50 : i64 133! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index 134! CHECK: %[[VAL_13:.*]] = fir.shift %[[VAL_6]]#0 : (index) -> !fir.shift<1> 135! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> 136! CHECK: %[[VAL_15:.*]] = fir.rebox %[[VAL_4]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>> 137! CHECK: fir.call @_QPtakes_real_array(%[[VAL_15]]) : (!fir.box<!fir.array<?xf32>>) -> () 138! CHECK: %[[VAL_16:.*]] = arith.constant 5 : i64 139! CHECK: %[[VAL_17:.*]] = arith.constant 1 : i64 140! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_17]] : i64 141! CHECK: %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_18]] : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>> 142! CHECK: %[[VAL_20:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 143! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_20]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 144! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 145! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index 146! CHECK: %[[VAL_24:.*]]:3 = fir.box_dims %[[VAL_22]], %[[VAL_23]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 147! CHECK: %[[VAL_25:.*]] = arith.constant 20 : i64 148! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index 149! CHECK: %[[VAL_27:.*]] = arith.constant 2 : i64 150! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index 151! CHECK: %[[VAL_29:.*]] = arith.constant 50 : i64 152! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i64) -> index 153! CHECK: %[[VAL_31:.*]] = fir.shift %[[VAL_24]]#0 : (index) -> !fir.shift<1> 154! CHECK: %[[VAL_32:.*]] = fir.slice %[[VAL_26]], %[[VAL_30]], %[[VAL_28]] : (index, index, index) -> !fir.slice<1> 155! CHECK: %[[VAL_33:.*]] = fir.rebox %[[VAL_22]](%[[VAL_31]]) {{\[}}%[[VAL_32]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>> 156! CHECK: fir.call @_QPtakes_real_array(%[[VAL_33]]) : (!fir.box<!fir.array<?xf32>>) -> () 157! CHECK: return 158! CHECK: } 159 160 161subroutine ref_array_real_p(p1_0, p1_1) 162 type(real_p1) :: p1_0, p1_1(100) 163 call takes_real_array(p1_0%p(20:50:2)) 164 call takes_real_array(p1_1(5)%p(20:50:2)) 165end subroutine 166 167! CHECK-LABEL: func @_QMpcompPassign_scalar_real 168! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 169subroutine assign_scalar_real_p(p0_0, p1_0, p0_1, p1_1) 170 type(real_p0) :: p0_0, p0_1(100) 171 type(real_p1) :: p1_0, p1_1(100) 172 ! CHECK: %[[fld:.*]] = fir.field_index p 173 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 174 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 175 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 176 ! CHECK: fir.store {{.*}} to %[[addr]] 177 p0_0%p = 1. 178 179 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 180 ! CHECK: %[[fld:.*]] = fir.field_index p 181 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 182 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 183 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 184 ! CHECK: fir.store {{.*}} to %[[addr]] 185 p0_1(5)%p = 2. 186 187 ! CHECK: %[[fld:.*]] = fir.field_index p 188 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 189 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 190 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}} 191 ! CHECK: fir.store {{.*}} to %[[addr]] 192 p1_0%p(7) = 3. 193 194 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 195 ! CHECK: %[[fld:.*]] = fir.field_index p 196 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 197 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 198 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}} 199 ! CHECK: fir.store {{.*}} to %[[addr]] 200 p1_1(5)%p(7) = 4. 201end subroutine 202 203! CHECK-LABEL: func @_QMpcompPref_scalar_cst_char_p 204! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 205subroutine ref_scalar_cst_char_p(p0_0, p1_0, p0_1, p1_1) 206 type(cst_char_p0) :: p0_0, p0_1(100) 207 type(cst_char_p1) :: p1_0, p1_1(100) 208 209 ! CHECK: %[[fld:.*]] = fir.field_index p 210 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 211 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 212 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 213 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 214 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 215 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 216 call takes_char_scalar(p0_0%p) 217 218 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 219 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 220 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 221 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 222 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 223 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 224 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 225 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 226 call takes_char_scalar(p0_1(5)%p) 227 228 229 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 230 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 231 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 232 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 233 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 234 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 235 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 236 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 237 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 238 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 239 call takes_char_scalar(p1_0%p(7)) 240 241 242 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 243 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 244 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 245 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 246 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 247 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 248 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 249 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 250 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 251 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 252 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 253 call takes_char_scalar(p1_1(5)%p(7)) 254 255end subroutine 256 257! CHECK-LABEL: func @_QMpcompPref_scalar_def_char_p 258! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 259subroutine ref_scalar_def_char_p(p0_0, p1_0, p0_1, p1_1) 260 type(def_char_p0) :: p0_0, p0_1(100) 261 type(def_char_p1) :: p1_0, p1_1(100) 262 263 ! CHECK: %[[fld:.*]] = fir.field_index p 264 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 265 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 266 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 267 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 268 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 269 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 270 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 271 call takes_char_scalar(p0_0%p) 272 273 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 274 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 275 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 276 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 277 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 278 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 279 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 280 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 281 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 282 call takes_char_scalar(p0_1(5)%p) 283 284 285 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 286 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 287 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 288 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 289 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 290 ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 291 ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 292 ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 293 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] 294 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 295 call takes_char_scalar(p1_0%p(7)) 296 297 298 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 299 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 300 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 301 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 302 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 303 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 304 ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 305 ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 306 ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 307 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] 308 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 309 call takes_char_scalar(p1_1(5)%p(7)) 310 311end subroutine 312 313! CHECK-LABEL: func @_QMpcompPref_scalar_derived 314! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 315subroutine ref_scalar_derived(p0_0, p1_0, p0_1, p1_1) 316 type(derived_p0) :: p0_0, p0_1(100) 317 type(derived_p1) :: p1_0, p1_1(100) 318 319 ! CHECK: %[[fld:.*]] = fir.field_index p 320 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 321 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 322 ! CHECK: %[[fldx:.*]] = fir.field_index x 323 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 324 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 325 call takes_real_scalar(p0_0%p%x) 326 327 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 328 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 329 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 330 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 331 ! CHECK: %[[fldx:.*]] = fir.field_index x 332 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 333 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 334 call takes_real_scalar(p0_1(5)%p%x) 335 336 ! CHECK: %[[fld:.*]] = fir.field_index p 337 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 338 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 339 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 340 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 341 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 342 ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] 343 ! CHECK: %[[fldx:.*]] = fir.field_index x 344 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] 345 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 346 call takes_real_scalar(p1_0%p(7)%x) 347 348 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 349 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 350 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 351 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 352 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 353 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 354 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 355 ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] 356 ! CHECK: %[[fldx:.*]] = fir.field_index x 357 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] 358 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 359 call takes_real_scalar(p1_1(5)%p(7)%x) 360 361end subroutine 362 363! ----------------------------------------------------------------------------- 364! Test passing pointer component references as pointers 365! ----------------------------------------------------------------------------- 366 367! CHECK-LABEL: func @_QMpcompPpass_real_p 368! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 369subroutine pass_real_p(p0_0, p1_0, p0_1, p1_1) 370 type(real_p0) :: p0_0, p0_1(100) 371 type(real_p1) :: p1_0, p1_1(100) 372 ! CHECK: %[[fld:.*]] = fir.field_index p 373 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 374 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 375 call takes_real_scalar_pointer(p0_0%p) 376 377 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 378 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 379 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 380 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 381 call takes_real_scalar_pointer(p0_1(5)%p) 382 383 ! CHECK: %[[fld:.*]] = fir.field_index p 384 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 385 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 386 call takes_real_array_pointer(p1_0%p) 387 388 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 389 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 390 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 391 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 392 call takes_real_array_pointer(p1_1(5)%p) 393end subroutine 394 395! ----------------------------------------------------------------------------- 396! Test usage in intrinsics where pointer aspect matters 397! ----------------------------------------------------------------------------- 398 399! CHECK-LABEL: func @_QMpcompPassociated_p 400! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 401subroutine associated_p(p0_0, p1_0, p0_1, p1_1) 402 type(real_p0) :: p0_0, p0_1(100) 403 type(def_char_p1) :: p1_0, p1_1(100) 404 ! CHECK: %[[fld:.*]] = fir.field_index p 405 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 406 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 407 ! CHECK: fir.box_addr %[[box]] 408 call takes_logical(associated(p0_0%p)) 409 410 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 411 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 412 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 413 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 414 ! CHECK: fir.box_addr %[[box]] 415 call takes_logical(associated(p0_1(5)%p)) 416 417 ! CHECK: %[[fld:.*]] = fir.field_index p 418 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 419 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 420 ! CHECK: fir.box_addr %[[box]] 421 call takes_logical(associated(p1_0%p)) 422 423 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 424 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 425 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 426 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 427 ! CHECK: fir.box_addr %[[box]] 428 call takes_logical(associated(p1_1(5)%p)) 429end subroutine 430 431! ----------------------------------------------------------------------------- 432! Test pointer assignment of components 433! ----------------------------------------------------------------------------- 434 435! CHECK-LABEL: func @_QMpcompPpassoc_real 436! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 437subroutine passoc_real(p0_0, p1_0, p0_1, p1_1) 438 type(real_p0) :: p0_0, p0_1(100) 439 type(real_p1) :: p1_0, p1_1(100) 440 ! CHECK: %[[fld:.*]] = fir.field_index p 441 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 442 ! CHECK: fir.store {{.*}} to %[[coor]] 443 p0_0%p => real_target 444 445 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 446 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 447 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 448 ! CHECK: fir.store {{.*}} to %[[coor]] 449 p0_1(5)%p => real_target 450 451 ! CHECK: %[[fld:.*]] = fir.field_index p 452 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 453 ! CHECK: fir.store {{.*}} to %[[coor]] 454 p1_0%p => real_array_target 455 456 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 457 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 458 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 459 ! CHECK: fir.store {{.*}} to %[[coor]] 460 p1_1(5)%p => real_array_target 461end subroutine 462 463! CHECK-LABEL: func @_QMpcompPpassoc_char 464! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 465subroutine passoc_char(p0_0, p1_0, p0_1, p1_1) 466 type(cst_char_p0) :: p0_0, p0_1(100) 467 type(def_char_p1) :: p1_0, p1_1(100) 468 ! CHECK: %[[fld:.*]] = fir.field_index p 469 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 470 ! CHECK: fir.store {{.*}} to %[[coor]] 471 p0_0%p => char_target 472 473 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 474 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 475 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 476 ! CHECK: fir.store {{.*}} to %[[coor]] 477 p0_1(5)%p => char_target 478 479 ! CHECK: %[[fld:.*]] = fir.field_index p 480 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 481 ! CHECK: fir.store {{.*}} to %[[coor]] 482 p1_0%p => char_array_target 483 484 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 485 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 486 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 487 ! CHECK: fir.store {{.*}} to %[[coor]] 488 p1_1(5)%p => char_array_target 489end subroutine 490 491! ----------------------------------------------------------------------------- 492! Test nullify of components 493! ----------------------------------------------------------------------------- 494 495! CHECK-LABEL: func @_QMpcompPnullify_test 496! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 497subroutine nullify_test(p0_0, p1_0, p0_1, p1_1) 498 type(real_p0) :: p0_0, p0_1(100) 499 type(def_char_p1) :: p1_0, p1_1(100) 500 ! CHECK: %[[fld:.*]] = fir.field_index p 501 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 502 ! CHECK: fir.store {{.*}} to %[[coor]] 503 nullify(p0_0%p) 504 505 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 506 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 507 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 508 ! CHECK: fir.store {{.*}} to %[[coor]] 509 nullify(p0_1(5)%p) 510 511 ! CHECK: %[[fld:.*]] = fir.field_index p 512 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 513 ! CHECK: fir.store {{.*}} to %[[coor]] 514 nullify(p1_0%p) 515 516 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 517 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 518 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 519 ! CHECK: fir.store {{.*}} to %[[coor]] 520 nullify(p1_1(5)%p) 521end subroutine 522 523! ----------------------------------------------------------------------------- 524! Test allocation 525! ----------------------------------------------------------------------------- 526 527! CHECK-LABEL: func @_QMpcompPallocate_real 528! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 529subroutine allocate_real(p0_0, p1_0, p0_1, p1_1) 530 type(real_p0) :: p0_0, p0_1(100) 531 type(real_p1) :: p1_0, p1_1(100) 532 ! CHECK: %[[fld:.*]] = fir.field_index p 533 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 534 ! CHECK: fir.store {{.*}} to %[[coor]] 535 allocate(p0_0%p) 536 537 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 538 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 539 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 540 ! CHECK: fir.store {{.*}} to %[[coor]] 541 allocate(p0_1(5)%p) 542 543 ! CHECK: %[[fld:.*]] = fir.field_index p 544 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 545 ! CHECK: fir.store {{.*}} to %[[coor]] 546 allocate(p1_0%p(100)) 547 548 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 549 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 550 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 551 ! CHECK: fir.store {{.*}} to %[[coor]] 552 allocate(p1_1(5)%p(100)) 553end subroutine 554 555! CHECK-LABEL: func @_QMpcompPallocate_cst_char 556! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 557subroutine allocate_cst_char(p0_0, p1_0, p0_1, p1_1) 558 type(cst_char_p0) :: p0_0, p0_1(100) 559 type(cst_char_p1) :: p1_0, p1_1(100) 560 ! CHECK: %[[fld:.*]] = fir.field_index p 561 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 562 ! CHECK: fir.store {{.*}} to %[[coor]] 563 allocate(p0_0%p) 564 565 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 566 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 567 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 568 ! CHECK: fir.store {{.*}} to %[[coor]] 569 allocate(p0_1(5)%p) 570 571 ! CHECK: %[[fld:.*]] = fir.field_index p 572 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 573 ! CHECK: fir.store {{.*}} to %[[coor]] 574 allocate(p1_0%p(100)) 575 576 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 577 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 578 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 579 ! CHECK: fir.store {{.*}} to %[[coor]] 580 allocate(p1_1(5)%p(100)) 581end subroutine 582 583! CHECK-LABEL: func @_QMpcompPallocate_def_char 584! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 585subroutine allocate_def_char(p0_0, p1_0, p0_1, p1_1) 586 type(def_char_p0) :: p0_0, p0_1(100) 587 type(def_char_p1) :: p1_0, p1_1(100) 588 ! CHECK: %[[fld:.*]] = fir.field_index p 589 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 590 ! CHECK: fir.store {{.*}} to %[[coor]] 591 allocate(character(18)::p0_0%p) 592 593 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 594 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 595 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 596 ! CHECK: fir.store {{.*}} to %[[coor]] 597 allocate(character(18)::p0_1(5)%p) 598 599 ! CHECK: %[[fld:.*]] = fir.field_index p 600 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 601 ! CHECK: fir.store {{.*}} to %[[coor]] 602 allocate(character(18)::p1_0%p(100)) 603 604 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 605 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 606 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 607 ! CHECK: fir.store {{.*}} to %[[coor]] 608 allocate(character(18)::p1_1(5)%p(100)) 609end subroutine 610 611! ----------------------------------------------------------------------------- 612! Test deallocation 613! ----------------------------------------------------------------------------- 614 615! CHECK-LABEL: func @_QMpcompPdeallocate_real 616! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 617subroutine deallocate_real(p0_0, p1_0, p0_1, p1_1) 618 type(real_p0) :: p0_0, p0_1(100) 619 type(real_p1) :: p1_0, p1_1(100) 620 ! CHECK: %[[fld:.*]] = fir.field_index p 621 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 622 ! CHECK: fir.store {{.*}} to %[[coor]] 623 deallocate(p0_0%p) 624 625 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 626 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 627 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 628 ! CHECK: fir.store {{.*}} to %[[coor]] 629 deallocate(p0_1(5)%p) 630 631 ! CHECK: %[[fld:.*]] = fir.field_index p 632 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 633 ! CHECK: fir.store {{.*}} to %[[coor]] 634 deallocate(p1_0%p) 635 636 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 637 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 638 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 639 ! CHECK: fir.store {{.*}} to %[[coor]] 640 deallocate(p1_1(5)%p) 641end subroutine 642 643! ----------------------------------------------------------------------------- 644! Test a very long component 645! ----------------------------------------------------------------------------- 646 647! CHECK-LABEL: func @_QMpcompPvery_long 648! CHECK-SAME: (%[[x:.*]]: {{.*}}) 649subroutine very_long(x) 650 type t0 651 real :: f 652 end type 653 type t1 654 type(t0), allocatable :: e(:) 655 end type 656 type t2 657 type(t1) :: d(10) 658 end type 659 type t3 660 type(t2) :: c 661 end type 662 type t4 663 type(t3), pointer :: b 664 end type 665 type t5 666 type(t4) :: a 667 end type 668 type(t5) :: x(:, :, :, :, :) 669 670 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[x]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.}} 671 ! CHECK-DAG: %[[flda:.*]] = fir.field_index a 672 ! CHECK-DAG: %[[fldb:.*]] = fir.field_index b 673 ! CHECK: %[[coor1:.*]] = fir.coordinate_of %[[coor0]], %[[flda]], %[[fldb]] 674 ! CHECK: %[[b_box:.*]] = fir.load %[[coor1]] 675 ! CHECK-DAG: %[[fldc:.*]] = fir.field_index c 676 ! CHECK-DAG: %[[fldd:.*]] = fir.field_index d 677 ! CHECK: %[[coor2:.*]] = fir.coordinate_of %[[b_box]], %[[fldc]], %[[fldd]] 678 ! CHECK: %[[index:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 679 ! CHECK: %[[coor3:.*]] = fir.coordinate_of %[[coor2]], %[[index]] 680 ! CHECK: %[[flde:.*]] = fir.field_index e 681 ! CHECK: %[[coor4:.*]] = fir.coordinate_of %[[coor3]], %[[flde]] 682 ! CHECK: %[[e_box:.*]] = fir.load %[[coor4]] 683 ! CHECK: %[[edims:.*]]:3 = fir.box_dims %[[e_box]], %c0{{.*}} 684 ! CHECK: %[[lb:.*]] = fir.convert %[[edims]]#0 : (index) -> i64 685 ! CHECK: %[[index2:.*]] = arith.subi %c7{{.*}}, %[[lb]] 686 ! CHECK: %[[coor5:.*]] = fir.coordinate_of %[[e_box]], %[[index2]] 687 ! CHECK: %[[fldf:.*]] = fir.field_index f 688 ! CHECK: %[[coor6:.*]] = fir.coordinate_of %[[coor5]], %[[fldf:.*]] 689 ! CHECK: fir.load %[[coor6]] : !fir.ref<f32> 690 print *, x(1,2,3,4,5)%a%b%c%d(6)%e(7)%f 691end subroutine 692 693! ----------------------------------------------------------------------------- 694! Test a recursive derived type reference 695! ----------------------------------------------------------------------------- 696 697! CHECK: func @_QMpcompPtest_recursive 698! CHECK-SAME: (%[[x:.*]]: {{.*}}) 699subroutine test_recursive(x) 700 type t 701 integer :: i 702 type(t), pointer :: next 703 end type 704 type(t) :: x 705 706 ! CHECK: %[[fldNext1:.*]] = fir.field_index next 707 ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]] 708 ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]] 709 ! CHECK: %[[fldNext2:.*]] = fir.field_index next 710 ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]] 711 ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]] 712 ! CHECK: %[[fldNext3:.*]] = fir.field_index next 713 ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]] 714 ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]] 715 ! CHECK: %[[fldi:.*]] = fir.field_index i 716 ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]] 717 ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32> 718 print *, x%next%next%next%i 719end subroutine 720 721end module 722 723! ----------------------------------------------------------------------------- 724! Test initial data target 725! ----------------------------------------------------------------------------- 726 727module pinit 728 use pcomp 729 ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEarp0 730 ! CHECK-DAG: %[[undef:.*]] = fir.undefined 731 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 732 ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEreal_target) 733 ! CHECK: %[[box:.*]] = fir.embox %[[target]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>> 734 ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>] : 735 ! CHECK: fir.has_value %[[insert]] 736 type(real_p0) :: arp0 = real_p0(real_target) 737 738! CHECK-LABEL: fir.global @_QMpinitEbrp1 : !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> { 739! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 740! CHECK: %[[VAL_1:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 741! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMpcompEreal_array_target) : !fir.ref<!fir.array<100xf32>> 742! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index 743! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index 744! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index 745! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i64 746! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index 747! CHECK: %[[VAL_8:.*]] = arith.constant 5 : i64 748! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index 749! CHECK: %[[VAL_10:.*]] = arith.constant 50 : i64 750! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index 751! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index 752! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index 753! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index 754! CHECK: %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index 755! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index 756! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index 757! CHECK: %[[VAL_18:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> 758! CHECK: %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1> 759! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_2]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>> 760! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_2]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 761! CHECK: %[[VAL_22:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_21]], ["p", !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>] : (!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>, !fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 762! CHECK: fir.has_value %[[VAL_22]] : !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 763! CHECK: } 764 type(real_p1) :: brp1 = real_p1(real_array_target(10:50:5)) 765 766 ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEccp0 767 ! CHECK-DAG: %[[undef:.*]] = fir.undefined 768 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 769 ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEchar_target) 770 ! CHECK: %[[box:.*]] = fir.embox %[[target]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>> 771 ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTcst_char_p0{p:!fir.box<!fir.ptr<!fir.char<1,10>>>}>] : 772 ! CHECK: fir.has_value %[[insert]] 773 type(cst_char_p0) :: ccp0 = cst_char_p0(char_target) 774 775 ! CHECK-LABEL: fir.global {{.*}}@_QMpinitEdcp1 776 ! CHECK-DAG: %[[undef:.*]] = fir.undefined 777 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 778 ! CHECK-DAG: %[[target:.*]] = fir.address_of(@_QMpcompEchar_array_target) 779 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[target]] : (!fir.ref<!fir.array<100x!fir.char<1,10>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>> 780 ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}} 781 ! CHECK-DAG: %[[box:.*]] = fir.embox %[[cast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 782 ! CHECK: %[[insert:.*]] = fir.insert_value %[[undef]], %[[box]], ["p", !fir.type<_QMpcompTdef_char_p1{p:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>] : 783 ! CHECK: fir.has_value %[[insert]] 784 type(def_char_p1) :: dcp1 = def_char_p1(char_array_target) 785end module 786