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 @_QMpcompPassign_scalar_real 122! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 123subroutine assign_scalar_real_p(p0_0, p1_0, p0_1, p1_1) 124 type(real_p0) :: p0_0, p0_1(100) 125 type(real_p1) :: p1_0, p1_1(100) 126 ! CHECK: %[[fld:.*]] = fir.field_index p 127 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 128 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 129 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 130 ! CHECK: fir.store {{.*}} to %[[addr]] 131 p0_0%p = 1. 132 133 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 134 ! CHECK: %[[fld:.*]] = fir.field_index p 135 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 136 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 137 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 138 ! CHECK: fir.store {{.*}} to %[[addr]] 139 p0_1(5)%p = 2. 140 141 ! CHECK: %[[fld:.*]] = fir.field_index p 142 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 143 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 144 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}} 145 ! CHECK: fir.store {{.*}} to %[[addr]] 146 p1_0%p(7) = 3. 147 148 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 149 ! CHECK: %[[fld:.*]] = fir.field_index p 150 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 151 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 152 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}} 153 ! CHECK: fir.store {{.*}} to %[[addr]] 154 p1_1(5)%p(7) = 4. 155end subroutine 156 157! CHECK-LABEL: func @_QMpcompPref_scalar_cst_char_p 158! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 159subroutine ref_scalar_cst_char_p(p0_0, p1_0, p0_1, p1_1) 160 type(cst_char_p0) :: p0_0, p0_1(100) 161 type(cst_char_p1) :: p1_0, p1_1(100) 162 163 ! CHECK: %[[fld:.*]] = fir.field_index p 164 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 165 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 166 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 167 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 168 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 169 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 170 call takes_char_scalar(p0_0%p) 171 172 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 173 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 174 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 175 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 176 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 177 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 178 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 179 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 180 call takes_char_scalar(p0_1(5)%p) 181 182 183 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 184 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 185 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 186 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 187 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 188 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 189 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 190 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 191 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 192 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 193 call takes_char_scalar(p1_0%p(7)) 194 195 196 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 197 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 198 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 199 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 200 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 201 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 202 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 203 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 204 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 205 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 206 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 207 call takes_char_scalar(p1_1(5)%p(7)) 208 209end subroutine 210 211! CHECK-LABEL: func @_QMpcompPref_scalar_def_char_p 212! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 213subroutine ref_scalar_def_char_p(p0_0, p1_0, p0_1, p1_1) 214 type(def_char_p0) :: p0_0, p0_1(100) 215 type(def_char_p1) :: p1_0, p1_1(100) 216 217 ! CHECK: %[[fld:.*]] = fir.field_index p 218 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 219 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 220 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 221 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 222 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 223 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 224 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 225 call takes_char_scalar(p0_0%p) 226 227 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 228 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 229 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 230 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 231 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 232 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 233 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 234 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 235 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 236 call takes_char_scalar(p0_1(5)%p) 237 238 239 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 240 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 241 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 242 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 243 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 244 ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 245 ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 246 ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 247 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] 248 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 249 call takes_char_scalar(p1_0%p(7)) 250 251 252 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 253 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 254 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 255 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 256 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 257 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 258 ! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 259 ! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 260 ! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]] 261 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] 262 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 263 call takes_char_scalar(p1_1(5)%p(7)) 264 265end subroutine 266 267! CHECK-LABEL: func @_QMpcompPref_scalar_derived 268! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 269subroutine ref_scalar_derived(p0_0, p1_0, p0_1, p1_1) 270 type(derived_p0) :: p0_0, p0_1(100) 271 type(derived_p1) :: p1_0, p1_1(100) 272 273 ! CHECK: %[[fld:.*]] = fir.field_index p 274 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 275 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 276 ! CHECK: %[[fldx:.*]] = fir.field_index x 277 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 278 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 279 call takes_real_scalar(p0_0%p%x) 280 281 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 282 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 283 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 284 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 285 ! CHECK: %[[fldx:.*]] = fir.field_index x 286 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 287 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 288 call takes_real_scalar(p0_1(5)%p%x) 289 290 ! CHECK: %[[fld:.*]] = fir.field_index p 291 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 292 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 293 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 294 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 295 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 296 ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] 297 ! CHECK: %[[fldx:.*]] = fir.field_index x 298 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] 299 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 300 call takes_real_scalar(p1_0%p(7)%x) 301 302 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 303 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 304 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 305 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 306 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 307 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 308 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] 309 ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] 310 ! CHECK: %[[fldx:.*]] = fir.field_index x 311 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] 312 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 313 call takes_real_scalar(p1_1(5)%p(7)%x) 314 315end subroutine 316 317! ----------------------------------------------------------------------------- 318! Test passing pointer component references as pointers 319! ----------------------------------------------------------------------------- 320 321! CHECK-LABEL: func @_QMpcompPpass_real_p 322! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 323subroutine pass_real_p(p0_0, p1_0, p0_1, p1_1) 324 type(real_p0) :: p0_0, p0_1(100) 325 type(real_p1) :: p1_0, p1_1(100) 326 ! CHECK: %[[fld:.*]] = fir.field_index p 327 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 328 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 329 call takes_real_scalar_pointer(p0_0%p) 330 331 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 332 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 333 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 334 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 335 call takes_real_scalar_pointer(p0_1(5)%p) 336 337 ! CHECK: %[[fld:.*]] = fir.field_index p 338 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 339 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 340 call takes_real_array_pointer(p1_0%p) 341 342 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 343 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 344 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 345 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 346 call takes_real_array_pointer(p1_1(5)%p) 347end subroutine 348 349! ----------------------------------------------------------------------------- 350! Test usage in intrinsics where pointer aspect matters 351! ----------------------------------------------------------------------------- 352 353! CHECK-LABEL: func @_QMpcompPassociated_p 354! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 355subroutine associated_p(p0_0, p1_0, p0_1, p1_1) 356 type(real_p0) :: p0_0, p0_1(100) 357 type(def_char_p1) :: p1_0, p1_1(100) 358 ! CHECK: %[[fld:.*]] = fir.field_index p 359 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 360 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 361 ! CHECK: fir.box_addr %[[box]] 362 call takes_logical(associated(p0_0%p)) 363 364 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 365 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 366 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 367 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 368 ! CHECK: fir.box_addr %[[box]] 369 call takes_logical(associated(p0_1(5)%p)) 370 371 ! CHECK: %[[fld:.*]] = fir.field_index p 372 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 373 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 374 ! CHECK: fir.box_addr %[[box]] 375 call takes_logical(associated(p1_0%p)) 376 377 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 378 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 379 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 380 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 381 ! CHECK: fir.box_addr %[[box]] 382 call takes_logical(associated(p1_1(5)%p)) 383end subroutine 384 385! ----------------------------------------------------------------------------- 386! Test pointer assignment of components 387! ----------------------------------------------------------------------------- 388 389! CHECK-LABEL: func @_QMpcompPpassoc_real 390! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 391subroutine passoc_real(p0_0, p1_0, p0_1, p1_1) 392 type(real_p0) :: p0_0, p0_1(100) 393 type(real_p1) :: p1_0, p1_1(100) 394 ! CHECK: %[[fld:.*]] = fir.field_index p 395 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 396 ! CHECK: fir.store {{.*}} to %[[coor]] 397 p0_0%p => real_target 398 399 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 400 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 401 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 402 ! CHECK: fir.store {{.*}} to %[[coor]] 403 p0_1(5)%p => real_target 404 405 ! CHECK: %[[fld:.*]] = fir.field_index p 406 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 407 ! CHECK: fir.store {{.*}} to %[[coor]] 408 p1_0%p => real_array_target 409 410 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 411 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 412 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 413 ! CHECK: fir.store {{.*}} to %[[coor]] 414 p1_1(5)%p => real_array_target 415end subroutine 416 417! CHECK-LABEL: func @_QMpcompPpassoc_char 418! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 419subroutine passoc_char(p0_0, p1_0, p0_1, p1_1) 420 type(cst_char_p0) :: p0_0, p0_1(100) 421 type(def_char_p1) :: p1_0, p1_1(100) 422 ! CHECK: %[[fld:.*]] = fir.field_index p 423 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 424 ! CHECK: fir.store {{.*}} to %[[coor]] 425 p0_0%p => char_target 426 427 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 428 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 429 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 430 ! CHECK: fir.store {{.*}} to %[[coor]] 431 p0_1(5)%p => char_target 432 433 ! CHECK: %[[fld:.*]] = fir.field_index p 434 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 435 ! CHECK: fir.store {{.*}} to %[[coor]] 436 p1_0%p => char_array_target 437 438 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 439 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 440 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 441 ! CHECK: fir.store {{.*}} to %[[coor]] 442 p1_1(5)%p => char_array_target 443end subroutine 444 445! ----------------------------------------------------------------------------- 446! Test nullify of components 447! ----------------------------------------------------------------------------- 448 449! CHECK-LABEL: func @_QMpcompPnullify_test 450! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 451subroutine nullify_test(p0_0, p1_0, p0_1, p1_1) 452 type(real_p0) :: p0_0, p0_1(100) 453 type(def_char_p1) :: p1_0, p1_1(100) 454 ! CHECK: %[[fld:.*]] = fir.field_index p 455 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 456 ! CHECK: fir.store {{.*}} to %[[coor]] 457 nullify(p0_0%p) 458 459 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 460 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 461 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 462 ! CHECK: fir.store {{.*}} to %[[coor]] 463 nullify(p0_1(5)%p) 464 465 ! CHECK: %[[fld:.*]] = fir.field_index p 466 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 467 ! CHECK: fir.store {{.*}} to %[[coor]] 468 nullify(p1_0%p) 469 470 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 471 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 472 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 473 ! CHECK: fir.store {{.*}} to %[[coor]] 474 nullify(p1_1(5)%p) 475end subroutine 476 477! ----------------------------------------------------------------------------- 478! Test allocation 479! ----------------------------------------------------------------------------- 480 481! CHECK-LABEL: func @_QMpcompPallocate_real 482! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 483subroutine allocate_real(p0_0, p1_0, p0_1, p1_1) 484 type(real_p0) :: p0_0, p0_1(100) 485 type(real_p1) :: p1_0, p1_1(100) 486 ! CHECK: %[[fld:.*]] = fir.field_index p 487 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 488 ! CHECK: fir.store {{.*}} to %[[coor]] 489 allocate(p0_0%p) 490 491 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 492 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 493 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 494 ! CHECK: fir.store {{.*}} to %[[coor]] 495 allocate(p0_1(5)%p) 496 497 ! CHECK: %[[fld:.*]] = fir.field_index p 498 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 499 ! CHECK: fir.store {{.*}} to %[[coor]] 500 allocate(p1_0%p(100)) 501 502 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 503 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 504 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 505 ! CHECK: fir.store {{.*}} to %[[coor]] 506 allocate(p1_1(5)%p(100)) 507end subroutine 508 509! CHECK-LABEL: func @_QMpcompPallocate_cst_char 510! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 511subroutine allocate_cst_char(p0_0, p1_0, p0_1, p1_1) 512 type(cst_char_p0) :: p0_0, p0_1(100) 513 type(cst_char_p1) :: p1_0, p1_1(100) 514 ! CHECK: %[[fld:.*]] = fir.field_index p 515 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 516 ! CHECK: fir.store {{.*}} to %[[coor]] 517 allocate(p0_0%p) 518 519 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 520 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 521 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 522 ! CHECK: fir.store {{.*}} to %[[coor]] 523 allocate(p0_1(5)%p) 524 525 ! CHECK: %[[fld:.*]] = fir.field_index p 526 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 527 ! CHECK: fir.store {{.*}} to %[[coor]] 528 allocate(p1_0%p(100)) 529 530 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 531 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 532 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 533 ! CHECK: fir.store {{.*}} to %[[coor]] 534 allocate(p1_1(5)%p(100)) 535end subroutine 536 537! CHECK-LABEL: func @_QMpcompPallocate_def_char 538! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 539subroutine allocate_def_char(p0_0, p1_0, p0_1, p1_1) 540 type(def_char_p0) :: p0_0, p0_1(100) 541 type(def_char_p1) :: p1_0, p1_1(100) 542 ! CHECK: %[[fld:.*]] = fir.field_index p 543 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 544 ! CHECK: fir.store {{.*}} to %[[coor]] 545 allocate(character(18)::p0_0%p) 546 547 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 548 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 549 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 550 ! CHECK: fir.store {{.*}} to %[[coor]] 551 allocate(character(18)::p0_1(5)%p) 552 553 ! CHECK: %[[fld:.*]] = fir.field_index p 554 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 555 ! CHECK: fir.store {{.*}} to %[[coor]] 556 allocate(character(18)::p1_0%p(100)) 557 558 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 559 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 560 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 561 ! CHECK: fir.store {{.*}} to %[[coor]] 562 allocate(character(18)::p1_1(5)%p(100)) 563end subroutine 564 565! ----------------------------------------------------------------------------- 566! Test deallocation 567! ----------------------------------------------------------------------------- 568 569! CHECK-LABEL: func @_QMpcompPdeallocate_real 570! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}}) 571subroutine deallocate_real(p0_0, p1_0, p0_1, p1_1) 572 type(real_p0) :: p0_0, p0_1(100) 573 type(real_p1) :: p1_0, p1_1(100) 574 ! CHECK: %[[fld:.*]] = fir.field_index p 575 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]] 576 ! CHECK: fir.store {{.*}} to %[[coor]] 577 deallocate(p0_0%p) 578 579 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}} 580 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 581 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 582 ! CHECK: fir.store {{.*}} to %[[coor]] 583 deallocate(p0_1(5)%p) 584 585 ! CHECK: %[[fld:.*]] = fir.field_index p 586 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]] 587 ! CHECK: fir.store {{.*}} to %[[coor]] 588 deallocate(p1_0%p) 589 590 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}} 591 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 592 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 593 ! CHECK: fir.store {{.*}} to %[[coor]] 594 deallocate(p1_1(5)%p) 595end subroutine 596 597! ----------------------------------------------------------------------------- 598! Test a very long component 599! ----------------------------------------------------------------------------- 600 601! CHECK-LABEL: func @_QMpcompPvery_long 602! CHECK-SAME: (%[[x:.*]]: {{.*}}) 603subroutine very_long(x) 604 type t0 605 real :: f 606 end type 607 type t1 608 type(t0), allocatable :: e(:) 609 end type 610 type t2 611 type(t1) :: d(10) 612 end type 613 type t3 614 type(t2) :: c 615 end type 616 type t4 617 type(t3), pointer :: b 618 end type 619 type t5 620 type(t4) :: a 621 end type 622 type(t5) :: x(:, :, :, :, :) 623 624 ! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[x]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.}} 625 ! CHECK-DAG: %[[flda:.*]] = fir.field_index a 626 ! CHECK-DAG: %[[fldb:.*]] = fir.field_index b 627 ! CHECK: %[[coor1:.*]] = fir.coordinate_of %[[coor0]], %[[flda]], %[[fldb]] 628 ! CHECK: %[[b_box:.*]] = fir.load %[[coor1]] 629 ! CHECK-DAG: %[[fldc:.*]] = fir.field_index c 630 ! CHECK-DAG: %[[fldd:.*]] = fir.field_index d 631 ! CHECK: %[[coor2:.*]] = fir.coordinate_of %[[b_box]], %[[fldc]], %[[fldd]] 632 ! CHECK: %[[index:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 633 ! CHECK: %[[coor3:.*]] = fir.coordinate_of %[[coor2]], %[[index]] 634 ! CHECK: %[[flde:.*]] = fir.field_index e 635 ! CHECK: %[[coor4:.*]] = fir.coordinate_of %[[coor3]], %[[flde]] 636 ! CHECK: %[[e_box:.*]] = fir.load %[[coor4]] 637 ! CHECK: %[[edims:.*]]:3 = fir.box_dims %[[e_box]], %c0{{.*}} 638 ! CHECK: %[[lb:.*]] = fir.convert %[[edims]]#0 : (index) -> i64 639 ! CHECK: %[[index2:.*]] = arith.subi %c7{{.*}}, %[[lb]] 640 ! CHECK: %[[coor5:.*]] = fir.coordinate_of %[[e_box]], %[[index2]] 641 ! CHECK: %[[fldf:.*]] = fir.field_index f 642 ! CHECK: %[[coor6:.*]] = fir.coordinate_of %[[coor5]], %[[fldf:.*]] 643 ! CHECK: fir.load %[[coor6]] : !fir.ref<f32> 644 print *, x(1,2,3,4,5)%a%b%c%d(6)%e(7)%f 645end subroutine 646 647! ----------------------------------------------------------------------------- 648! Test a recursive derived type reference 649! ----------------------------------------------------------------------------- 650 651! CHECK: func @_QMpcompPtest_recursive 652! CHECK-SAME: (%[[x:.*]]: {{.*}}) 653subroutine test_recursive(x) 654 type t 655 integer :: i 656 type(t), pointer :: next 657 end type 658 type(t) :: x 659 660 ! CHECK: %[[fldNext1:.*]] = fir.field_index next 661 ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]] 662 ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]] 663 ! CHECK: %[[fldNext2:.*]] = fir.field_index next 664 ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]] 665 ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]] 666 ! CHECK: %[[fldNext3:.*]] = fir.field_index next 667 ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]] 668 ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]] 669 ! CHECK: %[[fldi:.*]] = fir.field_index i 670 ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]] 671 ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32> 672 print *, x%next%next%next%i 673end subroutine 674 675end module 676