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