1! Test lowering of allocatable components 2! RUN: bbc -emit-fir %s -o - | FileCheck %s 3 4module acomp 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, allocatable :: x 33 end subroutine 34 subroutine takes_real_array_pointer(x) 35 real, allocatable :: x(:) 36 end subroutine 37 subroutine takes_logical(x) 38 logical :: x 39 end subroutine 40 end interface 41 42 type real_a0 43 real, allocatable :: p 44 end type 45 type real_a1 46 real, allocatable :: p(:) 47 end type 48 type cst_char_a0 49 character(10), allocatable :: p 50 end type 51 type cst_char_a1 52 character(10), allocatable :: p(:) 53 end type 54 type def_char_a0 55 character(:), allocatable :: p 56 end type 57 type def_char_a1 58 character(:), allocatable :: p(:) 59 end type 60 type derived_a0 61 type(t), allocatable :: p 62 end type 63 type derived_a1 64 type(t), allocatable :: 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 allocatable component references 74! ----------------------------------------------------------------------------- 75 76! CHECK-LABEL: func @_QMacompPref_scalar_real_a( 77! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}) { 78subroutine ref_scalar_real_a(a0_0, a1_0, a0_1, a1_1) 79 type(real_a0) :: a0_0, a0_1(100) 80 type(real_a1) :: a1_0, a1_1(100) 81 82 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}> 83 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<f32>>> 84 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<f32>>> 85 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32> 86 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap<f32>) -> !fir.ref<f32> 87 ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> () 88 call takes_real_scalar(a0_0%p) 89 90 ! CHECK: %[[a0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>> 91 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}> 92 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a0{p:!fir.box<!fir.heap<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<f32>>> 93 ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<f32>>> 94 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32> 95 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap<f32>) -> !fir.ref<f32> 96 ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> () 97 call takes_real_scalar(a0_1(5)%p) 98 99 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}> 100 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 101 ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 102 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 103 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 104 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 105 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 106 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 107 ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> () 108 call takes_real_scalar(a1_0%p(7)) 109 110 ! CHECK: %[[a1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>> 111 ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}> 112 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 113 ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 114 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 115 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 116 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 117 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 118 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 119 ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> () 120 call takes_real_scalar(a1_1(5)%p(7)) 121end subroutine 122 123! CHECK-LABEL: func @_QMacompPref_array_real_a( 124! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}) { 125! CHECK: %[[VAL_2:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}> 126! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 127! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 128! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index 129! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 130! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 131! CHECK: %[[VAL_8:.*]] = arith.constant 20 : i64 132! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index 133! CHECK: %[[VAL_10:.*]] = arith.constant 2 : i64 134! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index 135! CHECK: %[[VAL_12:.*]] = arith.constant 50 : i64 136! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> index 137! CHECK: %[[VAL_14:.*]] = fir.shape_shift %[[VAL_6]]#0, %[[VAL_6]]#1 : (index, index) -> !fir.shapeshift<1> 138! CHECK: %[[VAL_15:.*]] = fir.slice %[[VAL_9]], %[[VAL_13]], %[[VAL_11]] : (index, index, index) -> !fir.slice<1> 139! CHECK: %[[VAL_16:.*]] = fir.embox %[[VAL_7]](%[[VAL_14]]) {{\[}}%[[VAL_15]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<16xf32>> 140! CHECK: %[[VAL_16_NEW:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.array<16xf32>>) -> !fir.box<!fir.array<?xf32>> 141! CHECK: fir.call @_QPtakes_real_array(%[[VAL_16_NEW]]) : (!fir.box<!fir.array<?xf32>>) -> () 142! CHECK: %[[VAL_17:.*]] = arith.constant 5 : i64 143! CHECK: %[[VAL_18:.*]] = arith.constant 1 : i64 144! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_17]], %[[VAL_18]] : i64 145! CHECK: %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_19]] : (!fir.ref<!fir.array<100x!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>> 146! CHECK: %[[VAL_21:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}> 147! CHECK: %[[VAL_22:.*]] = fir.coordinate_of %[[VAL_20]], %[[VAL_21]] : (!fir.ref<!fir.type<_QMacompTreal_a1{p:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 148! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 149! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index 150! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_24]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 151! CHECK: %[[VAL_26:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 152! CHECK: %[[VAL_27:.*]] = arith.constant 20 : i64 153! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index 154! CHECK: %[[VAL_29:.*]] = arith.constant 2 : i64 155! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i64) -> index 156! CHECK: %[[VAL_31:.*]] = arith.constant 50 : i64 157! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i64) -> index 158! CHECK: %[[VAL_33:.*]] = fir.shape_shift %[[VAL_25]]#0, %[[VAL_25]]#1 : (index, index) -> !fir.shapeshift<1> 159! CHECK: %[[VAL_34:.*]] = fir.slice %[[VAL_28]], %[[VAL_32]], %[[VAL_30]] : (index, index, index) -> !fir.slice<1> 160! CHECK: %[[VAL_35:.*]] = fir.embox %[[VAL_26]](%[[VAL_33]]) {{\[}}%[[VAL_34]]] : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<16xf32>> 161! CHECK: %[[VAL_35_NEW:.*]] = fir.convert %[[VAL_35]] : (!fir.box<!fir.array<16xf32>>) -> !fir.box<!fir.array<?xf32>> 162! CHECK: fir.call @_QPtakes_real_array(%[[VAL_35_NEW]]) : (!fir.box<!fir.array<?xf32>>) -> () 163! CHECK: return 164! CHECK: } 165 166subroutine ref_array_real_a(a1_0, a1_1) 167 type(real_a1) :: a1_0, a1_1(100) 168 call takes_real_array(a1_0%p(20:50:2)) 169 call takes_real_array(a1_1(5)%p(20:50:2)) 170end subroutine 171 172! CHECK-LABEL: func @_QMacompPref_scalar_cst_char_a 173! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 174subroutine ref_scalar_cst_char_a(a0_0, a1_0, a0_1, a1_1) 175 type(cst_char_a0) :: a0_0, a0_1(100) 176 type(cst_char_a1) :: a1_0, a1_1(100) 177 178 ! CHECK: %[[fld:.*]] = fir.field_index p 179 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 180 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 181 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 182 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 183 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 184 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 185 call takes_char_scalar(a0_0%p) 186 187 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 188 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 189 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 190 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 191 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] 192 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 193 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 194 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 195 call takes_char_scalar(a0_1(5)%p) 196 197 198 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 199 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 200 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 201 ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] 202 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 203 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 204 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 205 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]] 206 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 207 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 208 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 209 call takes_char_scalar(a1_0%p(7)) 210 211 212 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 213 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 214 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 215 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 216 ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] 217 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 218 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 219 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 220 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]] 221 ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] 222 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} 223 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 224 call takes_char_scalar(a1_1(5)%p(7)) 225 226end subroutine 227 228! CHECK-LABEL: func @_QMacompPref_scalar_def_char_a 229! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 230subroutine ref_scalar_def_char_a(a0_0, a1_0, a0_1, a1_1) 231 type(def_char_a0) :: a0_0, a0_1(100) 232 type(def_char_a1) :: a1_0, a1_1(100) 233 234 ! CHECK: %[[fld:.*]] = fir.field_index p 235 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 236 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 237 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 238 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 239 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 240 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 241 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 242 call takes_char_scalar(a0_0%p) 243 244 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_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-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 249 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] 250 ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] 251 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] 252 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 253 call takes_char_scalar(a0_1(5)%p) 254 255 256 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 257 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 258 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 259 ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 260 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 261 ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] 262 ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>> 263 ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index 264 ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index 265 ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index 266 ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index 267 ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]] 268 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]] 269 ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]] 270 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]] 271 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 272 call takes_char_scalar(a1_0%p(7)) 273 274 275 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_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: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 280 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] 281 ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] 282 ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>> 283 ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index 284 ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index 285 ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index 286 ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index 287 ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]] 288 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]] 289 ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]] 290 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]] 291 ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) 292 call takes_char_scalar(a1_1(5)%p(7)) 293 294end subroutine 295 296! CHECK-LABEL: func @_QMacompPref_scalar_derived 297! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 298subroutine ref_scalar_derived(a0_0, a1_0, a0_1, a1_1) 299 type(derived_a0) :: a0_0, a0_1(100) 300 type(derived_a1) :: a1_0, a1_1(100) 301 302 ! CHECK: %[[fld:.*]] = fir.field_index p 303 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 304 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 305 ! CHECK: %[[fldx:.*]] = fir.field_index x 306 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 307 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 308 call takes_real_scalar(a0_0%p%x) 309 310 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 311 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 312 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 313 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 314 ! CHECK: %[[fldx:.*]] = fir.field_index x 315 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] 316 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 317 call takes_real_scalar(a0_1(5)%p%x) 318 319 ! CHECK: %[[fld:.*]] = fir.field_index p 320 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 321 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 322 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} 323 ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 324 ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 325 ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] 326 ! CHECK: %[[fldx:.*]] = fir.field_index x 327 ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] 328 ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) 329 call takes_real_scalar(a1_0%p(7)%x) 330 331 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 332 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 333 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[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]] : i64 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(a1_1(5)%p(7)%x) 343 344end subroutine 345 346! ----------------------------------------------------------------------------- 347! Test passing allocatable component references as allocatables 348! ----------------------------------------------------------------------------- 349 350! CHECK-LABEL: func @_QMacompPpass_real_a 351! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 352subroutine pass_real_a(a0_0, a1_0, a0_1, a1_1) 353 type(real_a0) :: a0_0, a0_1(100) 354 type(real_a1) :: a1_0, a1_1(100) 355 ! CHECK: %[[fld:.*]] = fir.field_index p 356 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 357 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 358 call takes_real_scalar_pointer(a0_0%p) 359 360 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 361 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 362 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 363 ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) 364 call takes_real_scalar_pointer(a0_1(5)%p) 365 366 ! CHECK: %[[fld:.*]] = fir.field_index p 367 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 368 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 369 call takes_real_array_pointer(a1_0%p) 370 371 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 372 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 373 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 374 ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) 375 call takes_real_array_pointer(a1_1(5)%p) 376end subroutine 377 378! ----------------------------------------------------------------------------- 379! Test usage in intrinsics where pointer aspect matters 380! ----------------------------------------------------------------------------- 381 382! CHECK-LABEL: func @_QMacompPallocated_p 383! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 384subroutine allocated_p(a0_0, a1_0, a0_1, a1_1) 385 type(real_a0) :: a0_0, a0_1(100) 386 type(def_char_a1) :: a1_0, a1_1(100) 387 ! CHECK: %[[fld:.*]] = fir.field_index p 388 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 389 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 390 ! CHECK: fir.box_addr %[[box]] 391 call takes_logical(allocated(a0_0%p)) 392 393 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 394 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 395 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 396 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 397 ! CHECK: fir.box_addr %[[box]] 398 call takes_logical(allocated(a0_1(5)%p)) 399 400 ! CHECK: %[[fld:.*]] = fir.field_index p 401 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 402 ! CHECK: %[[box:.*]] = fir.load %[[coor]] 403 ! CHECK: fir.box_addr %[[box]] 404 call takes_logical(allocated(a1_0%p)) 405 406 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_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(allocated(a1_1(5)%p)) 412end subroutine 413 414! ----------------------------------------------------------------------------- 415! Test allocation 416! ----------------------------------------------------------------------------- 417 418! CHECK-LABEL: func @_QMacompPallocate_real 419! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 420subroutine allocate_real(a0_0, a1_0, a0_1, a1_1) 421 type(real_a0) :: a0_0, a0_1(100) 422 type(real_a1) :: a1_0, a1_1(100) 423 ! CHECK: %[[fld:.*]] = fir.field_index p 424 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 425 ! CHECK: fir.store {{.*}} to %[[coor]] 426 allocate(a0_0%p) 427 428 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 429 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 430 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 431 ! CHECK: fir.store {{.*}} to %[[coor]] 432 allocate(a0_1(5)%p) 433 434 ! CHECK: %[[fld:.*]] = fir.field_index p 435 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 436 ! CHECK: fir.store {{.*}} to %[[coor]] 437 allocate(a1_0%p(100)) 438 439 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 440 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 441 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 442 ! CHECK: fir.store {{.*}} to %[[coor]] 443 allocate(a1_1(5)%p(100)) 444end subroutine 445 446! CHECK-LABEL: func @_QMacompPallocate_cst_char 447! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 448subroutine allocate_cst_char(a0_0, a1_0, a0_1, a1_1) 449 type(cst_char_a0) :: a0_0, a0_1(100) 450 type(cst_char_a1) :: a1_0, a1_1(100) 451 ! CHECK: %[[fld:.*]] = fir.field_index p 452 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 453 ! CHECK: fir.store {{.*}} to %[[coor]] 454 allocate(a0_0%p) 455 456 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 457 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 458 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 459 ! CHECK: fir.store {{.*}} to %[[coor]] 460 allocate(a0_1(5)%p) 461 462 ! CHECK: %[[fld:.*]] = fir.field_index p 463 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 464 ! CHECK: fir.store {{.*}} to %[[coor]] 465 allocate(a1_0%p(100)) 466 467 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 468 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 469 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 470 ! CHECK: fir.store {{.*}} to %[[coor]] 471 allocate(a1_1(5)%p(100)) 472end subroutine 473 474! CHECK-LABEL: func @_QMacompPallocate_def_char 475! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 476subroutine allocate_def_char(a0_0, a1_0, a0_1, a1_1) 477 type(def_char_a0) :: a0_0, a0_1(100) 478 type(def_char_a1) :: a1_0, a1_1(100) 479 ! CHECK: %[[fld:.*]] = fir.field_index p 480 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 481 ! CHECK: fir.store {{.*}} to %[[coor]] 482 allocate(character(18)::a0_0%p) 483 484 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 485 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 486 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 487 ! CHECK: fir.store {{.*}} to %[[coor]] 488 allocate(character(18)::a0_1(5)%p) 489 490 ! CHECK: %[[fld:.*]] = fir.field_index p 491 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 492 ! CHECK: fir.store {{.*}} to %[[coor]] 493 allocate(character(18)::a1_0%p(100)) 494 495 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 496 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 497 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 498 ! CHECK: fir.store {{.*}} to %[[coor]] 499 allocate(character(18)::a1_1(5)%p(100)) 500end subroutine 501 502! ----------------------------------------------------------------------------- 503! Test deallocation 504! ----------------------------------------------------------------------------- 505 506! CHECK-LABEL: func @_QMacompPdeallocate_real 507! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) 508subroutine deallocate_real(a0_0, a1_0, a0_1, a1_1) 509 type(real_a0) :: a0_0, a0_1(100) 510 type(real_a1) :: a1_0, a1_1(100) 511 ! CHECK: %[[fld:.*]] = fir.field_index p 512 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] 513 ! CHECK: fir.store {{.*}} to %[[coor]] 514 deallocate(a0_0%p) 515 516 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} 517 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 518 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 519 ! CHECK: fir.store {{.*}} to %[[coor]] 520 deallocate(a0_1(5)%p) 521 522 ! CHECK: %[[fld:.*]] = fir.field_index p 523 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] 524 ! CHECK: fir.store {{.*}} to %[[coor]] 525 deallocate(a1_0%p) 526 527 ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} 528 ! CHECK-DAG: %[[fld:.*]] = fir.field_index p 529 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] 530 ! CHECK: fir.store {{.*}} to %[[coor]] 531 deallocate(a1_1(5)%p) 532end subroutine 533 534! ----------------------------------------------------------------------------- 535! Test a recursive derived type reference 536! ----------------------------------------------------------------------------- 537 538! CHECK: func @_QMacompPtest_recursive 539! CHECK-SAME: (%[[x:.*]]: {{.*}}) 540subroutine test_recursive(x) 541 type t 542 integer :: i 543 type(t), allocatable :: next 544 end type 545 type(t) :: x 546 547 ! CHECK: %[[fldNext1:.*]] = fir.field_index next 548 ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]] 549 ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]] 550 ! CHECK: %[[fldNext2:.*]] = fir.field_index next 551 ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]] 552 ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]] 553 ! CHECK: %[[fldNext3:.*]] = fir.field_index next 554 ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]] 555 ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]] 556 ! CHECK: %[[fldi:.*]] = fir.field_index i 557 ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]] 558 ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32> 559 print *, x%next%next%next%i 560end subroutine 561 562end module 563