flang/test/Lower/derived-allocatable-components.f90

   1 ! Test lowering of allocatable components
   2 ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
   3
   4 module 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
  70 contains
  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>>>}>>>{{.*}}) {
  78 subroutine 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))
 121 end 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
 166 subroutine 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))
 170 end subroutine
 171
 172 ! CHECK-LABEL: func @_QMacompPref_scalar_cst_char_a
 173 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 174 subroutine 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: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
 183   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 184   call takes_char_scalar(a0_0%p)
 185
 186   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 187   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 188   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 189   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 190   ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
 191   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
 192   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 193   call takes_char_scalar(a0_1(5)%p)
 194
 195
 196   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 197   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 198   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 199   ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
 200   ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 201   ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
 202   ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
 203   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]]
 204   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
 205   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 206   call takes_char_scalar(a1_0%p(7))
 207
 208
 209   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 210   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 211   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 212   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 213   ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
 214   ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 215   ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
 216   ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
 217   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]]
 218   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}}
 219   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 220   call takes_char_scalar(a1_1(5)%p(7))
 221
 222 end subroutine
 223
 224 ! CHECK-LABEL: func @_QMacompPref_scalar_def_char_a
 225 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 226 subroutine ref_scalar_def_char_a(a0_0, a1_0, a0_1, a1_1)
 227   type(def_char_a0) :: a0_0, a0_1(100)
 228   type(def_char_a1) :: a1_0, a1_1(100)
 229
 230   ! CHECK: %[[fld:.*]] = fir.field_index p
 231   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 232   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 233   ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
 234   ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
 235   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
 236   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 237   call takes_char_scalar(a0_0%p)
 238
 239   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 240   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 241   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 242   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 243   ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
 244   ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
 245   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
 246   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 247   call takes_char_scalar(a0_1(5)%p)
 248
 249
 250   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 251   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 252   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 253   ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 254   ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
 255   ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
 256   ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
 257   ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index
 258   ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index
 259   ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index
 260   ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index
 261   ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]]
 262   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]]
 263   ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]]
 264   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]]
 265   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 266   call takes_char_scalar(a1_0%p(7))
 267
 268
 269   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 270   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 271   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 272   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 273   ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 274   ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
 275   ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]]
 276   ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
 277   ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index
 278   ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index
 279   ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index
 280   ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index
 281   ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]]
 282   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]]
 283   ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]]
 284   ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]]
 285   ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
 286   call takes_char_scalar(a1_1(5)%p(7))
 287
 288 end subroutine
 289
 290 ! CHECK-LABEL: func @_QMacompPref_scalar_derived
 291 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 292 subroutine ref_scalar_derived(a0_0, a1_0, a0_1, a1_1)
 293   type(derived_a0) :: a0_0, a0_1(100)
 294   type(derived_a1) :: a1_0, a1_1(100)
 295
 296   ! CHECK: %[[fld:.*]] = fir.field_index p
 297   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 298   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 299   ! CHECK: %[[fldx:.*]] = fir.field_index x
 300   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
 301   ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
 302   call takes_real_scalar(a0_0%p%x)
 303
 304   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 305   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 306   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 307   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 308   ! CHECK: %[[fldx:.*]] = fir.field_index x
 309   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
 310   ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
 311   call takes_real_scalar(a0_1(5)%p%x)
 312
 313   ! CHECK: %[[fld:.*]] = fir.field_index p
 314   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 315   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 316   ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 317   ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
 318   ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
 319   ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
 320   ! CHECK: %[[fldx:.*]] = fir.field_index x
 321   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
 322   ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
 323   call takes_real_scalar(a1_0%p(7)%x)
 324
 325   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 326   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 327   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 328   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 329   ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
 330   ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
 331   ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
 332   ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
 333   ! CHECK: %[[fldx:.*]] = fir.field_index x
 334   ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
 335   ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
 336   call takes_real_scalar(a1_1(5)%p(7)%x)
 337
 338 end subroutine
 339
 340 ! -----------------------------------------------------------------------------
 341 !            Test passing allocatable component references as allocatables
 342 ! -----------------------------------------------------------------------------
 343
 344 ! CHECK-LABEL: func @_QMacompPpass_real_a
 345 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 346 subroutine pass_real_a(a0_0, a1_0, a0_1, a1_1)
 347   type(real_a0) :: a0_0, a0_1(100)
 348   type(real_a1) :: a1_0, a1_1(100)
 349   ! CHECK: %[[fld:.*]] = fir.field_index p
 350   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 351   ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
 352   call takes_real_scalar_pointer(a0_0%p)
 353
 354   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 355   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 356   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 357   ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
 358   call takes_real_scalar_pointer(a0_1(5)%p)
 359
 360   ! CHECK: %[[fld:.*]] = fir.field_index p
 361   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 362   ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
 363   call takes_real_array_pointer(a1_0%p)
 364
 365   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 366   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 367   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 368   ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
 369   call takes_real_array_pointer(a1_1(5)%p)
 370 end subroutine
 371
 372 ! -----------------------------------------------------------------------------
 373 !            Test usage in intrinsics where pointer aspect matters
 374 ! -----------------------------------------------------------------------------
 375
 376 ! CHECK-LABEL: func @_QMacompPallocated_p
 377 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 378 subroutine allocated_p(a0_0, a1_0, a0_1, a1_1)
 379   type(real_a0) :: a0_0, a0_1(100)
 380   type(def_char_a1) :: a1_0, a1_1(100)
 381   ! CHECK: %[[fld:.*]] = fir.field_index p
 382   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 383   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 384   ! CHECK: fir.box_addr %[[box]]
 385   call takes_logical(allocated(a0_0%p))
 386
 387   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 388   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 389   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 390   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 391   ! CHECK: fir.box_addr %[[box]]
 392   call takes_logical(allocated(a0_1(5)%p))
 393
 394   ! CHECK: %[[fld:.*]] = fir.field_index p
 395   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 396   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 397   ! CHECK: fir.box_addr %[[box]]
 398   call takes_logical(allocated(a1_0%p))
 399
 400   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 401   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 402   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 403   ! CHECK: %[[box:.*]] = fir.load %[[coor]]
 404   ! CHECK: fir.box_addr %[[box]]
 405   call takes_logical(allocated(a1_1(5)%p))
 406 end subroutine
 407
 408 ! -----------------------------------------------------------------------------
 409 !            Test allocation
 410 ! -----------------------------------------------------------------------------
 411
 412 ! CHECK-LABEL: func @_QMacompPallocate_real
 413 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 414 subroutine allocate_real(a0_0, a1_0, a0_1, a1_1)
 415   type(real_a0) :: a0_0, a0_1(100)
 416   type(real_a1) :: a1_0, a1_1(100)
 417   ! CHECK: %[[fld:.*]] = fir.field_index p
 418   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 419   ! CHECK: fir.store {{.*}} to %[[coor]]
 420   allocate(a0_0%p)
 421
 422   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 423   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 424   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 425   ! CHECK: fir.store {{.*}} to %[[coor]]
 426   allocate(a0_1(5)%p)
 427
 428   ! CHECK: %[[fld:.*]] = fir.field_index p
 429   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 430   ! CHECK: fir.store {{.*}} to %[[coor]]
 431   allocate(a1_0%p(100))
 432
 433   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 434   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 435   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 436   ! CHECK: fir.store {{.*}} to %[[coor]]
 437   allocate(a1_1(5)%p(100))
 438 end subroutine
 439
 440 ! CHECK-LABEL: func @_QMacompPallocate_cst_char
 441 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 442 subroutine allocate_cst_char(a0_0, a1_0, a0_1, a1_1)
 443   type(cst_char_a0) :: a0_0, a0_1(100)
 444   type(cst_char_a1) :: a1_0, a1_1(100)
 445   ! CHECK: %[[fld:.*]] = fir.field_index p
 446   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 447   ! CHECK: fir.store {{.*}} to %[[coor]]
 448   allocate(a0_0%p)
 449
 450   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 451   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 452   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 453   ! CHECK: fir.store {{.*}} to %[[coor]]
 454   allocate(a0_1(5)%p)
 455
 456   ! CHECK: %[[fld:.*]] = fir.field_index p
 457   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 458   ! CHECK: fir.store {{.*}} to %[[coor]]
 459   allocate(a1_0%p(100))
 460
 461   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 462   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 463   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 464   ! CHECK: fir.store {{.*}} to %[[coor]]
 465   allocate(a1_1(5)%p(100))
 466 end subroutine
 467
 468 ! CHECK-LABEL: func @_QMacompPallocate_def_char
 469 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 470 subroutine allocate_def_char(a0_0, a1_0, a0_1, a1_1)
 471   type(def_char_a0) :: a0_0, a0_1(100)
 472   type(def_char_a1) :: a1_0, a1_1(100)
 473   ! CHECK: %[[fld:.*]] = fir.field_index p
 474   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 475   ! CHECK: fir.store {{.*}} to %[[coor]]
 476   allocate(character(18)::a0_0%p)
 477
 478   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 479   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 480   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 481   ! CHECK: fir.store {{.*}} to %[[coor]]
 482   allocate(character(18)::a0_1(5)%p)
 483
 484   ! CHECK: %[[fld:.*]] = fir.field_index p
 485   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 486   ! CHECK: fir.store {{.*}} to %[[coor]]
 487   allocate(character(18)::a1_0%p(100))
 488
 489   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 490   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 491   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 492   ! CHECK: fir.store {{.*}} to %[[coor]]
 493   allocate(character(18)::a1_1(5)%p(100))
 494 end subroutine
 495
 496 ! -----------------------------------------------------------------------------
 497 !            Test deallocation
 498 ! -----------------------------------------------------------------------------
 499
 500 ! CHECK-LABEL: func @_QMacompPdeallocate_real
 501 ! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}})
 502 subroutine deallocate_real(a0_0, a1_0, a0_1, a1_1)
 503   type(real_a0) :: a0_0, a0_1(100)
 504   type(real_a1) :: a1_0, a1_1(100)
 505   ! CHECK: %[[fld:.*]] = fir.field_index p
 506   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]]
 507   ! CHECK: fir.store {{.*}} to %[[coor]]
 508   deallocate(a0_0%p)
 509
 510   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}}
 511   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 512   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 513   ! CHECK: fir.store {{.*}} to %[[coor]]
 514   deallocate(a0_1(5)%p)
 515
 516   ! CHECK: %[[fld:.*]] = fir.field_index p
 517   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]]
 518   ! CHECK: fir.store {{.*}} to %[[coor]]
 519   deallocate(a1_0%p)
 520
 521   ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}}
 522   ! CHECK-DAG: %[[fld:.*]] = fir.field_index p
 523   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
 524   ! CHECK: fir.store {{.*}} to %[[coor]]
 525   deallocate(a1_1(5)%p)
 526 end subroutine
 527
 528 ! -----------------------------------------------------------------------------
 529 !            Test a recursive derived type reference
 530 ! -----------------------------------------------------------------------------
 531
 532 ! CHECK: func @_QMacompPtest_recursive
 533 ! CHECK-SAME: (%[[x:.*]]: {{.*}})
 534 subroutine test_recursive(x)
 535   type t
 536     integer :: i
 537     type(t), allocatable :: next
 538   end type
 539   type(t) :: x
 540
 541   ! CHECK: %[[fldNext1:.*]] = fir.field_index next
 542   ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]]
 543   ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]]
 544   ! CHECK: %[[fldNext2:.*]] = fir.field_index next
 545   ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]]
 546   ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]]
 547   ! CHECK: %[[fldNext3:.*]] = fir.field_index next
 548   ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]]
 549   ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]]
 550   ! CHECK: %[[fldi:.*]] = fir.field_index i
 551   ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]]
 552   ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32>
 553   print *, x%next%next%next%i
 554 end subroutine
 555
 556 end module