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