1! Test lowering of structure constructors 2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 3 4module m_struct_ctor 5 implicit none 6 type t_simple 7 real :: x 8 end type 9 type t_char_scalar 10 real :: x 11 character(3) :: c 12 end type 13 type t_array 14 real :: x 15 integer :: i(5) 16 end type 17 type t_char_array 18 real :: x 19 character(3) :: c(5) 20 end type 21 type t_ptr 22 real :: x 23 integer, pointer :: p(:,:) 24 end type 25 type t_nested 26 real :: x 27 type(t_array) :: dt 28 end type 29contains 30 ! CHECK-LABEL: func @_QMm_struct_ctorPtest_simple( 31 ! CHECK-SAME: %[[x:.*]]: !fir.ref<f32>{{.*}}) 32 subroutine test_simple(x) 33 real :: x 34 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_simple{x:f32}> 35 ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_simple{x:f32}> 36 ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[tmp]], %[[field]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_simple{x:f32}>>, !fir.field) -> !fir.ref<f32> 37 ! CHECK: %[[val:.*]] = fir.load %[[x]] : !fir.ref<f32> 38 ! CHECK: fir.store %[[val]] to %[[xcoor]] : !fir.ref<f32> 39 call print_simple(t_simple(x=x)) 40 end subroutine 41 42 ! CHECK-LABEL: func @_QMm_struct_ctorPtest_char_scalar( 43 ! CHECK-SAME: %[[x:.*]]: !fir.ref<f32>{{.*}}) 44 subroutine test_char_scalar(x) 45 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_char_scalar{x:f32,c:!fir.char<1,3>}> 46 ! CHECK: %[[xfield:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_char_scalar{x:f32,c:!fir.char<1,3>}> 47 ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[tmp]], %[[xfield]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_char_scalar{x:f32,c:!fir.char<1,3>}>>, !fir.field) -> !fir.ref<f32> 48 ! CHECK: %[[val:.*]] = fir.load %[[x]] : !fir.ref<f32> 49 ! CHECK: fir.store %[[val]] to %[[xcoor]] : !fir.ref<f32> 50 51 ! CHECK: %[[cfield:.*]] = fir.field_index c, !fir.type<_QMm_struct_ctorTt_char_scalar{x:f32,c:!fir.char<1,3>}> 52 ! CHECK: %[[ccoor:.*]] = fir.coordinate_of %[[tmp]], %[[cfield]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_char_scalar{x:f32,c:!fir.char<1,3>}>>, !fir.field) -> !fir.ref<!fir.char<1,3>> 53 ! CHECK: %[[cst:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,3>> 54 ! CHECK-DAG: %[[ccast:.*]] = fir.convert %[[ccoor]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> 55 ! CHECK-DAG: %[[cstcast:.*]] = fir.convert %[[cst]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> 56 ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[ccast]], %[[cstcast]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 57 real :: x 58 call print_char_scalar(t_char_scalar(x=x, c="abc")) 59 end subroutine 60 61 ! CHECK-LABEL: func @_QMm_struct_ctorPtest_simple_array( 62 ! CHECK-SAME: %[[x:.*]]: !fir.ref<f32>{{.*}}, %[[j:.*]]: !fir.ref<!fir.array<5xi32>>{{.*}}) 63 subroutine test_simple_array(x, j) 64 real :: x 65 integer :: j(5) 66 call print_simple_array(t_array(x=x, i=2*j)) 67 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 68 ! CHECK: %[[xfield:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 69 ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[tmp]], %[[xfield]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<f32> 70 ! CHECK: %[[val:.*]] = fir.load %[[x]] : !fir.ref<f32> 71 ! CHECK: fir.store %[[val]] to %[[xcoor]] : !fir.ref<f32> 72 73 ! CHECK: %[[ifield:.*]] = fir.field_index i, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 74 ! CHECK: %[[icoor:.*]] = fir.coordinate_of %[[tmp]], %[[ifield]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<!fir.array<5xi32>> 75 ! CHECK: %[[iload:.*]] = fir.array_load %[[icoor]](%{{.*}}) : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32> 76 ! CHECK: %[[jload:.*]] = fir.array_load %[[j]](%{{.*}}) : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32> 77 ! CHECK: %[[loop:.*]] = fir.do_loop %[[idx:.*]] = %c0{{.*}} to %{{.*}} step %c1{{.*}} iter_args(%[[res:.*]] = %[[iload]]) -> (!fir.array<5xi32>) { 78 ! CHECK: %[[jval:.*]] = fir.array_fetch %[[jload]], %[[idx]] : (!fir.array<5xi32>, index) -> i32 79 ! CHECK: %[[ival:.*]] = arith.muli %c2{{.*}}, %[[jval]] : i32 80 ! CHECK: %[[iupdate:.*]] = fir.array_update %[[res]], %[[ival]], %[[idx]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32> 81 ! CHECK: fir.result %[[iupdate]] : !fir.array<5xi32> 82 ! CHECK: fir.array_merge_store %[[iload]], %[[loop]] to %[[icoor]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.ref<!fir.array<5xi32>> 83 84 end subroutine 85 86! CHECK-LABEL: func @_QMm_struct_ctorPtest_char_array( 87! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>{{.*}}, %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) { 88 subroutine test_char_array(x, c1) 89 ! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}> 90 ! CHECK: %[[VAL_4:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 91 ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<5x!fir.char<1,3>>> 92 ! CHECK: %[[VAL_6:.*]] = arith.constant 5 : index 93 ! CHECK: %[[VAL_7:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}> 94 ! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_7]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}>>, !fir.field) -> !fir.ref<f32> 95 ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32> 96 ! CHECK: fir.store %[[VAL_9]] to %[[VAL_8]] : !fir.ref<f32> 97 ! CHECK: %[[VAL_10:.*]] = fir.field_index c, !fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}> 98 ! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_10]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}>>, !fir.field) -> !fir.ref<!fir.array<5x!fir.char<1,3>>> 99 ! CHECK: %[[VAL_12:.*]] = arith.constant 5 : index 100 ! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1> 101 ! CHECK: %[[VAL_14:.*]] = fir.array_load %[[VAL_11]](%[[VAL_13]]) : (!fir.ref<!fir.array<5x!fir.char<1,3>>>, !fir.shape<1>) -> !fir.array<5x!fir.char<1,3>> 102 ! CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> 103 ! CHECK: %[[VAL_16:.*]] = fir.array_load %[[VAL_5]](%[[VAL_15]]) : (!fir.ref<!fir.array<5x!fir.char<1,3>>>, !fir.shape<1>) -> !fir.array<5x!fir.char<1,3>> 104 ! CHECK: %[[char_temp:.*]] = fir.alloca !fir.char<1,3> {bindc_name = ".chrtmp"} 105 ! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index 106 ! CHECK: %[[VAL_18:.*]] = arith.constant 0 : index 107 ! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_12]], %[[VAL_17]] : index 108 ! CHECK: %[[VAL_20:.*]] = fir.do_loop %[[VAL_21:.*]] = %[[VAL_18]] to %[[VAL_19]] step %[[VAL_17]] unordered iter_args(%[[VAL_22:.*]] = %[[VAL_14]]) -> (!fir.array<5x!fir.char<1,3>>) { 109 ! CHECK: %[[VAL_23:.*]] = fir.array_access %[[VAL_16]], %[[VAL_21]] : (!fir.array<5x!fir.char<1,3>>, index) -> !fir.ref<!fir.char<1,3>> 110 ! CHECK: %[[VAL_24:.*]] = fir.array_access %[[VAL_22]], %[[VAL_21]] : (!fir.array<5x!fir.char<1,3>>, index) -> !fir.ref<!fir.char<1,3>> 111 ! CHECK: %[[VAL_25:.*]] = arith.constant 3 : index 112 ! CHECK: %[[VAL_26:.*]] = arith.constant 1 : i64 113 ! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_25]] : (index) -> i64 114 ! CHECK: %[[VAL_28:.*]] = arith.muli %[[VAL_26]], %[[VAL_27]] : i64 115 ! CHECK: %[[VAL_29:.*]] = arith.constant false 116 ! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_24]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> 117 ! CHECK: %[[VAL_31:.*]] = fir.convert %[[char_temp]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> 118 ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_30]], %[[VAL_31]], %[[VAL_28]], %[[VAL_29]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 119 ! CHECK: %[[VAL_32:.*]] = fir.array_amend %[[VAL_22]], %[[VAL_24]] : (!fir.array<5x!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>) -> !fir.array<5x!fir.char<1,3>> 120 ! CHECK: fir.result %[[VAL_32]] : !fir.array<5x!fir.char<1,3>> 121 ! CHECK: } 122 ! CHECK: fir.array_merge_store %[[VAL_14]], %[[VAL_33:.*]] to %[[VAL_11]] : !fir.array<5x!fir.char<1,3>>, !fir.array<5x!fir.char<1,3>>, !fir.ref<!fir.array<5x!fir.char<1,3>>> 123 ! CHECK: fir.call @_QMm_struct_ctorPprint_char_array(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.type<_QMm_struct_ctorTt_char_array{x:f32,c:!fir.array<5x!fir.char<1,3>>}>>) -> () 124 125 real :: x 126 character(3) :: c1(5) 127 call print_char_array(t_char_array(x=x, c=c1)) 128 ! CHECK: return 129 ! CHECK: } 130 end subroutine 131 132 ! CHECK-LABEL: func @_QMm_struct_ctorPtest_ptr( 133 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>{{.*}}, %[[VAL_1:.*]]: !fir.box<!fir.array<?x?xi32>> {{{.*}}, fir.target}) { 134 ! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}> 135 ! CHECK: %[[VAL_4:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}> 136 ! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>, !fir.field) -> !fir.ref<f32> 137 ! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32> 138 ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<f32> 139 ! CHECK: %[[VAL_7:.*]] = fir.field_index p, !fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}> 140 ! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_7]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>> 141 ! CHECK: %[[VAL_9:.*]] = arith.constant 1 : i64 142 ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index 143 ! CHECK: %[[VAL_11:.*]] = arith.constant 2 : i64 144 ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index 145 ! CHECK: %[[VAL_13:.*]] = arith.constant 4 : i64 146 ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index 147 ! CHECK: %[[VAL_15:.*]] = arith.constant 1 : i64 148 ! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index 149 ! CHECK: %[[VAL_17:.*]] = arith.constant 1 : i64 150 ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i64) -> index 151 ! CHECK: %[[VAL_19:.*]] = arith.constant 3 : i64 152 ! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i64) -> index 153 ! CHECK: %[[VAL_21:.*]] = fir.slice %[[VAL_10]], %[[VAL_14]], %[[VAL_12]], %[[VAL_16]], %[[VAL_20]], %[[VAL_18]] : (index, index, index, index, index, index) -> !fir.slice<2> 154 ! CHECK: %[[VAL_22:.*]] = fir.rebox %[[VAL_1]] {{\[}}%[[VAL_21]]] : (!fir.box<!fir.array<?x?xi32>>, !fir.slice<2>) -> !fir.box<!fir.array<2x3xi32>> 155 ! CHECK: %[[VAL_23:.*]] = fir.rebox %[[VAL_22]] : (!fir.box<!fir.array<2x3xi32>>) -> !fir.box<!fir.ptr<!fir.array<?x?xi32>>> 156 ! CHECK: fir.store %[[VAL_23]] to %[[VAL_8]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>> 157 ! CHECK: fir.call @_QMm_struct_ctorPprint_ptr(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.type<_QMm_struct_ctorTt_ptr{x:f32,p:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>) -> () 158 ! CHECK: return 159 ! CHECK: } 160 161 subroutine test_ptr(x, a) 162 real :: x 163 integer, target :: a(:, :) 164 call print_ptr(t_ptr(x=x, p=a(1:4:2, 1:3:1))) 165 end subroutine 166 167 ! CHECK-LABEL: func @_QMm_struct_ctorPtest_nested( 168 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>> 169 subroutine test_nested(x, d) 170 real :: x 171 type(t_array) :: d 172 ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_nested{x:f32,dt:!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>}> 173 ! CHECK: %[[VAL_3:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_nested{x:f32,dt:!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>}> 174 ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_nested{x:f32,dt:!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>}>>, !fir.field) -> !fir.ref<f32> 175 ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref<f32> 176 ! CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref<f32> 177 ! CHECK: %[[VAL_6:.*]] = fir.field_index dt, !fir.type<_QMm_struct_ctorTt_nested{x:f32,dt:!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>}> 178 ! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_nested{x:f32,dt:!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>}>>, !fir.field) -> !fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>> 179 ! CHECK: %[[VAL_8:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 180 ! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<f32> 181 ! CHECK: %[[VAL_8b:.*]] = fir.field_index x, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 182 ! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_7]], %[[VAL_8b]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<f32> 183 ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_9]] : !fir.ref<f32> 184 ! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !fir.ref<f32> 185 ! CHECK: %[[VAL_12:.*]] = fir.field_index i, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 186 ! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_12]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<!fir.array<5xi32>> 187 ! CHECK: %[[VAL_12b:.*]] = fir.field_index i, !fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}> 188 ! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_7]], %[[VAL_12b]] : (!fir.ref<!fir.type<_QMm_struct_ctorTt_array{x:f32,i:!fir.array<5xi32>}>>, !fir.field) -> !fir.ref<!fir.array<5xi32>> 189 ! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index 190 ! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index 191 ! CHECK: %[[VAL_17:.*]] = arith.constant 4 : index 192 ! CHECK: fir.do_loop %[[VAL_18:.*]] = %[[VAL_15]] to %[[VAL_17]] step %[[VAL_16]] { 193 ! CHECK: %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_14]], %[[VAL_18]] : (!fir.ref<!fir.array<5xi32>>, index) -> !fir.ref<i32> 194 ! CHECK: %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_13]], %[[VAL_18]] : (!fir.ref<!fir.array<5xi32>>, index) -> !fir.ref<i32> 195 ! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_20]] : !fir.ref<i32> 196 ! CHECK: fir.store %[[VAL_21]] to %[[VAL_19]] : !fir.ref<i32> 197 ! CHECK: } 198 call print_nested(t_nested(x=x, dt=d)) 199 end subroutine 200 201 subroutine print_simple(t) 202 type(t_simple) :: t 203 print *, t%x 204 end subroutine 205 subroutine print_char_scalar(t) 206 type(t_char_scalar) :: t 207 print *, t%x, t%c 208 end subroutine 209 subroutine print_simple_array(t) 210 type(t_array) :: t 211 print *, t%x, t%i 212 end subroutine 213 subroutine print_char_array(t) 214 type(t_char_array) :: t 215 print *, t%x, t%c 216 end subroutine 217 subroutine print_ptr(t) 218 type(t_ptr) :: t 219 print *, t%x, t%p 220 end subroutine 221 subroutine print_nested(t) 222 type(t_nested) :: t 223 print *, t%x, t%dt%x, t%dt%i 224 end subroutine 225 226end module 227 228 use m_struct_ctor 229 integer, target :: i(4,3) = reshape([1,2,3,4,5,6,7,8,9,10,11,12], [4,3]) 230 call test_simple(42.) 231 call test_char_scalar(42.) 232 call test_simple_array(42., [1,2,3,4,5]) 233 call test_char_array(42., ["abc", "def", "geh", "ijk", "lmn"]) 234 call test_ptr(42., i) 235 call test_nested(42., t_array(x=43., i=[5,6,7,8,9])) 236end 237 238! CHECK-LABEL: func.func @_QPtest_parent_component1() { 239! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 240! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}> 241! CHECK: %[[VAL_14:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 242! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_14]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<i32> 243! CHECK: %[[VAL_16:.*]] = arith.constant 1 : i32 244! CHECK: fir.store %[[VAL_16]] to %[[VAL_15]] : !fir.ref<i32> 245! CHECK: %[[VAL_17:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 246! CHECK: %[[VAL_18:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_17]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>> 247! CHECK: %[[VAL_19:.*]] = arith.constant 2 : index 248! CHECK: %[[VAL_20:.*]] = fir.shape %[[VAL_19]] : (index) -> !fir.shape<1> 249! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_18]](%[[VAL_20]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.array<2xi32> 250! CHECK: %[[VAL_23:.*]] = arith.constant 2 : index 251! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_23]] : (index) -> !fir.shape<1> 252! CHECK: %[[VAL_25:.*]] = fir.array_load %[[VAL_22:.*]](%[[VAL_24]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.array<2xi32> 253! CHECK: %[[VAL_26:.*]] = arith.constant 1 : index 254! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index 255! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_19]], %[[VAL_26]] : index 256! CHECK: %[[VAL_29:.*]] = fir.do_loop %[[VAL_30:.*]] = %[[VAL_27]] to %[[VAL_28]] step %[[VAL_26]] unordered iter_args(%[[VAL_31:.*]] = %[[VAL_21]]) -> (!fir.array<2xi32>) { 257! CHECK: %[[VAL_32:.*]] = fir.array_fetch %[[VAL_25]], %[[VAL_30]] : (!fir.array<2xi32>, index) -> i32 258! CHECK: %[[VAL_33:.*]] = fir.array_update %[[VAL_31]], %[[VAL_32]], %[[VAL_30]] : (!fir.array<2xi32>, i32, index) -> !fir.array<2xi32> 259! CHECK: fir.result %[[VAL_33]] : !fir.array<2xi32> 260! CHECK: } 261! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_34:.*]] to %[[VAL_18]] : !fir.array<2xi32>, !fir.array<2xi32>, !fir.ref<!fir.array<2xi32>> 262! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>) -> !fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>> 263! CHECK: %[[VAL_36:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 264! CHECK: %[[VAL_37:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_36]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<i32> 265! CHECK: %[[VAL_38:.*]] = fir.field_index x, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 266! CHECK: %[[VAL_39:.*]] = fir.coordinate_of %[[VAL_35]], %[[VAL_38]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<i32> 267! CHECK: %[[VAL_40:.*]] = fir.load %[[VAL_37]] : !fir.ref<i32> 268! CHECK: fir.store %[[VAL_40]] to %[[VAL_39]] : !fir.ref<i32> 269! CHECK: %[[VAL_41:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 270! CHECK: %[[VAL_42:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_41]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>> 271! CHECK: %[[VAL_43:.*]] = fir.field_index y, !fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}> 272! CHECK: %[[VAL_44:.*]] = fir.coordinate_of %[[VAL_35]], %[[VAL_43]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tbase{x:i32,y:!fir.array<2xi32>}>>, !fir.field) -> !fir.ref<!fir.array<2xi32>> 273! CHECK: %[[VAL_45:.*]] = arith.constant 0 : index 274! CHECK: %[[VAL_46:.*]] = arith.constant 1 : index 275! CHECK: %[[VAL_47:.*]] = arith.constant 1 : index 276! CHECK: fir.do_loop %[[VAL_48:.*]] = %[[VAL_45]] to %[[VAL_47]] step %[[VAL_46]] { 277! CHECK: %[[VAL_49:.*]] = fir.coordinate_of %[[VAL_44]], %[[VAL_48]] : (!fir.ref<!fir.array<2xi32>>, index) -> !fir.ref<i32> 278! CHECK: %[[VAL_50:.*]] = fir.coordinate_of %[[VAL_42]], %[[VAL_48]] : (!fir.ref<!fir.array<2xi32>>, index) -> !fir.ref<i32> 279! CHECK: %[[VAL_51:.*]] = fir.load %[[VAL_50]] : !fir.ref<i32> 280! CHECK: fir.store %[[VAL_51]] to %[[VAL_49]] : !fir.ref<i32> 281! CHECK: } 282! CHECK: %[[VAL_52:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}> 283! CHECK: %[[VAL_53:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_52]] : (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>> 284! CHECK: %[[VAL_54:.*]] = arith.constant true 285! CHECK: %[[VAL_55:.*]] = fir.convert %[[VAL_54]] : (i1) -> !fir.logical<4> 286! CHECK: fir.store %[[VAL_55]] to %[[VAL_53]] : !fir.ref<!fir.logical<4>> 287! CHECK: fir.call @_QPprint_parent_component1(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.type<_QFtest_parent_component1Tmid{x:i32,y:!fir.array<2xi32>,mask:!fir.logical<4>}>>) -> () 288! CHECK: return 289! CHECK: } 290 291subroutine test_parent_component1() 292 type base 293 integer :: x, y(2) 294 end type base 295 type, extends(base) :: mid 296 logical :: mask 297 end type mid 298 299 call print_parent_component1(mid(base = base(1, [2, 3]), mask = .true.)) 300end 301 302! CHECK-LABEL: func.func @_QPtest_parent_component2() { 303! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}> 304! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_parent_component2Epv) : !fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>> 305! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>) -> !fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>> 306! CHECK: %[[VAL_9:.*]] = fir.field_index z, !fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}> 307! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>>, !fir.field) -> !fir.ref<!fir.char<1,5>> 308! CHECK: %[[VAL_11:.*]] = fir.field_index z, !fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}> 309! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_8]], %[[VAL_11]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tbase{z:!fir.char<1,5>}>>, !fir.field) -> !fir.ref<!fir.char<1,5>> 310! CHECK: %[[VAL_13:.*]] = arith.constant 5 : index 311! CHECK: %[[VAL_14:.*]] = arith.constant 1 : i64 312! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (index) -> i64 313! CHECK: %[[VAL_16:.*]] = arith.muli %[[VAL_14]], %[[VAL_15]] : i64 314! CHECK: %[[VAL_17:.*]] = arith.constant false 315! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_12]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8> 316! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8> 317! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_18]], %[[VAL_19]], %[[VAL_16]], %[[VAL_17]]) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 318! CHECK: %[[VAL_20:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}> 319! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_20]] : (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>> 320! CHECK: %[[VAL_22:.*]] = arith.constant true 321! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i1) -> !fir.logical<4> 322! CHECK: fir.store %[[VAL_23]] to %[[VAL_21]] : !fir.ref<!fir.logical<4>> 323! CHECK: fir.call @_QPprint_parent_component2(%[[VAL_0]]) {{.*}}: (!fir.ref<!fir.type<_QFtest_parent_component2Tmid{z:!fir.char<1,5>,mask:!fir.logical<4>}>>) -> () 324! CHECK: return 325! CHECK: } 326 327subroutine test_parent_component2() 328 type base 329 character(5) :: z 330 end type base 331 type, extends(base) :: mid 332 logical :: mask 333 end type mid 334 type(base) :: pv = base("aaa") 335 336 call print_parent_component2(mid(base = pv, mask = .true.)) 337end 338 339! CHECK-LABEL: func.func @_QPtest_parent_component3( 340! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>> {fir.bindc_name = "pp"}) { 341! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>> 342! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}> 343! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>> 344! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>) -> !fir.ref<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>> 345! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_10]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>) -> !fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>> 346! CHECK: fir.store %[[VAL_11]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>> 347! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>) -> !fir.ref<!fir.box<none>> 348! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.ptr<!fir.type<_QFtest_parent_component3Tbase{m:!fir.array<2x!fir.char<1,5>>}>>>) -> !fir.box<none> 349! CHECK: fir.call @_FortranAAssign(%[[VAL_14]], %[[VAL_15]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> () 350! CHECK: %[[VAL_18:.*]] = fir.field_index mask, !fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}> 351! CHECK: %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_18]] : (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>, !fir.field) -> !fir.ref<!fir.logical<4>> 352! CHECK: %[[VAL_20:.*]] = arith.constant true 353! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i1) -> !fir.logical<4> 354! CHECK: fir.store %[[VAL_21]] to %[[VAL_19]] : !fir.ref<!fir.logical<4>> 355! CHECK: fir.call @_QPprint_parent_component3(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.type<_QFtest_parent_component3Tmid{m:!fir.array<2x!fir.char<1,5>>,mask:!fir.logical<4>}>>) -> () 356! CHECK: return 357! CHECK: } 358 359subroutine test_parent_component3(pp) 360 type base 361 character(5) :: m(2) 362 end type base 363 type, extends(base) :: mid 364 logical :: mask 365 end type mid 366 type(base), pointer :: pp 367 368 call print_parent_component3(mid(base = pp, mask = .true.)) 369end 370