Skip to content

Commit 3d3c63d

Browse files
kkwlikkwli
authored
[flang] Add structure constructor with allocatable component (#77845)
Enable the structure constructor with allocatable component support. Handling of `null()` for the allocatable component is added.
1 parent 13e977d commit 3d3c63d

File tree

7 files changed

+258
-3
lines changed

7 files changed

+258
-3
lines changed

‎flang/lib/Evaluate/check-expression.cpp

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -190,7 +190,12 @@ struct IsActuallyConstantHelper {
190190
bool operator()(const StructureConstructor &x) {
191191
for (const auto &pair : x) {
192192
const Expr<SomeType> &y{pair.second.value()};
193-
if (!(*this)(y) && !IsNullPointer(y)) {
193+
const auto sym{pair.first};
194+
const bool compIsConstant{(*this)(y)};
195+
// If an allocatable component is initialized by a constant,
196+
// the structure constructor is not a constant.
197+
if ((!compIsConstant && !IsNullPointer(y)) ||
198+
(compIsConstant && IsAllocatable(sym))) {
194199
return false;
195200
}
196201
}

‎flang/lib/Evaluate/fold.cpp

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,11 @@ Expr<SomeDerived> FoldOperation(
8282
} else {
8383
isConstant &= IsInitialDataTarget(expr);
8484
}
85+
} else if (IsAllocatable(symbol)) {
86+
// F2023: 10.1.12 (3)(a)
87+
// If comp-spec is not null() for the allocatable component the
88+
// structure constructor is not a constant expression.
89+
isConstant &= IsNullPointer(expr);
8590
} else {
8691
isConstant &= IsActuallyConstant(expr) || IsNullPointer(expr);
8792
if (auto valueShape{GetConstantExtents(context, expr)}) {

‎flang/lib/Lower/ConvertConstant.cpp

Lines changed: 16 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@
1818
#include "flang/Lower/ConvertVariable.h"
1919
#include "flang/Lower/Mangler.h"
2020
#include "flang/Optimizer/Builder/Complex.h"
21+
#include "flang/Optimizer/Builder/MutableBox.h"
2122
#include "flang/Optimizer/Builder/Todo.h"
2223

2324
#include <algorithm>
@@ -362,8 +363,21 @@ static mlir::Value genStructureComponentInit(
362363
loc, fieldTy, name, recTy,
363364
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
364365

365-
if (Fortran::semantics::IsAllocatable(sym))
366-
TODO(loc, "allocatable component in structure constructor");
366+
if (Fortran::semantics::IsAllocatable(sym)) {
367+
if (!Fortran::evaluate::IsNullPointer(expr)) {
368+
fir::emitFatalError(loc, "constant structure constructor with an "
369+
"allocatable component value that is not NULL");
370+
} else {
371+
// Handle NULL() initialization
372+
mlir::Value componentValue{fir::factory::createUnallocatedBox(
373+
builder, loc, componentTy, std::nullopt)};
374+
componentValue = builder.createConvert(loc, componentTy, componentValue);
375+
376+
return builder.create<fir::InsertValueOp>(
377+
loc, recTy, res, componentValue,
378+
builder.getArrayAttr(field.getAttributes()));
379+
}
380+
}
367381

368382
if (Fortran::semantics::IsPointer(sym)) {
369383
if (Fortran::semantics::IsProcedure(sym))

‎flang/test/Lower/structure-constructors-alloc-comp.f90

Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,152 @@
1+
! Test lowering of structure constructors of derived types with allocatable component
2+
! RUN: bbc -emit-hlfir %s -o - | FileCheck --check-prefixes=HLFIR %s
3+
4+
module m_struct_ctor
5+
implicit none
6+
type t_alloc
7+
real :: x
8+
integer, allocatable :: a(:)
9+
end type
10+
11+
contains
12+
subroutine test_alloc1(y)
13+
real :: y
14+
call print_alloc_comp(t_alloc(x=y, a=null()))
15+
! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc1(
16+
! HLFIR-SAME: %[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}) {
17+
! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>
18+
! HLFIR: %[[VAL_1:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
19+
! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
20+
! HLFIR: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {{.*}}"_QMm_struct_ctorE.n.x"
21+
! HLFIR: %[[VAL_3:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
22+
! HLFIR: %[[CONS_2:.* ]]= arith.constant 1 : index
23+
! HLFIR: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {{.*}}"_QMm_struct_ctorE.n.a"
24+
! HLFIR: %[[VAL_5:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
25+
! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
26+
! HLFIR: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
27+
! HLFIR: %[[VAL_7:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
28+
! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
29+
! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
30+
! HLFIR: %[[VAL_8:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
31+
! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_8]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
32+
! HLFIR: %[[VAL_10:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
33+
! HLFIR: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
34+
! HLFIR: %[[VAL_12:.*]]:2 = hlfir.declare %[[ARG_0]] {uniq_name = "_QMm_struct_ctorFtest_alloc1Ey"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
35+
! HLFIR: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>)
36+
! HLFIR: %[[VAL_14:.*]] = fir.embox %[[VAL_13]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
37+
! HLFIR: %[[VAL_15:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
38+
! HLFIR: %[[CONS_6:.*]] = arith.constant {{.*}} : i32
39+
! HLFIR: %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<none>
40+
! HLFIR: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
41+
! HLFIR: %{{.*}} = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[CONS_6]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
42+
! HLFIR: %[[VAL_18:.*]] = hlfir.designate %[[VAL_13]]#0{"x"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<f32>
43+
! HLFIR: %[[VAL_19:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref<f32>
44+
! HLFIR: hlfir.assign %[[VAL_19]] to %[[VAL_18]] temporary_lhs : f32, !fir.ref<f32>
45+
! HLFIR: fir.call @_QPprint_alloc_comp(%[[VAL_13]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> ()
46+
! HLFIR: return
47+
! HLFIR: }
48+
end subroutine
49+
50+
subroutine test_alloc2(y, b)
51+
real :: y
52+
integer :: b(5)
53+
call print_alloc_comp(t_alloc(x=y, a=b))
54+
! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc2
55+
! HLFIR-SAME: (%[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}, %[[ARG_1:.*]]: !fir.ref<!fir.array<5xi32>> {fir.bindc_name = "b"}) {
56+
! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>
57+
! HLFIR: %[[VAL_1:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
58+
! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
59+
! HLFIR: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[CONS_1]] {{.*}}"_QMm_struct_ctorE.n.x"
60+
! HLFIR: %[[VAL_3:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
61+
! HLFIR: %[[CONS_2:.*]] = arith.constant 1 : index
62+
! HLFIR: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[CONS_2]] {{.*}}"_QMm_struct_ctorE.n.a"
63+
! HLFIR: %[[VAL_5:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
64+
! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
65+
! HLFIR: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[CONS_3]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
66+
! HLFIR: %[[VAL_7:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
67+
! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
68+
! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
69+
! HLFIR: %[[VAL_8:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
70+
! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_8]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
71+
! HLFIR: %[[VAL_10:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
72+
! HLFIR: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
73+
! HLFIR: %[[CONS_6:.*]] = arith.constant 5 : index
74+
! HLFIR: %[[VAL_12:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1>
75+
! HLFIR: %[[VAL_13:.*]]:2 = hlfir.declare %[[ARG_1]](%[[VAL_12]]) {uniq_name = "_QMm_struct_ctorFtest_alloc2Eb"} : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.array<5xi32>>)
76+
! HLFIR: %[[VAL_14:.*]]:2 = hlfir.declare %[[ARG_0]] {uniq_name = "_QMm_struct_ctorFtest_alloc2Ey"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
77+
! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>)
78+
! HLFIR: %[[VAL_16:.*]] = fir.embox %[[VAL_15]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
79+
! HLFIR: %[[VAL_17:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
80+
! HLFIR: %[[CONS_7:.*]] = arith.constant {{.*}} : i32
81+
! HLFIR: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<none>
82+
! HLFIR: %[[VAL_19:.*]] = fir.convert %[[VAL_17]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
83+
! HLFIR: {{.*}} = fir.call @_FortranAInitialize(%[[VAL_18]], %[[VAL_19]], %[[CONS_7]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
84+
! HLFIR: %[[VAL_20:.*]] = hlfir.designate %[[VAL_15]]#0{"x"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<f32>
85+
! HLFIR: %[[VAL_21:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<f32>
86+
! HLFIR: hlfir.assign %[[VAL_21]] to %[[VAL_20]] temporary_lhs : f32, !fir.ref<f32>
87+
! HLFIR: %[[VAL_22:.*]] = hlfir.designate %[[VAL_15]]#0{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
88+
! HLFIR: hlfir.assign %[[VAL_13]]#0 to %[[VAL_22]] realloc temporary_lhs : !fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
89+
! HLFIR: fir.call @_QPprint_alloc_comp(%[[VAL_15]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> ()
90+
! HLFIR: return
91+
! HLFIR: }
92+
end subroutine
93+
94+
subroutine test_alloc3()
95+
type(t_alloc) :: t1 = t_alloc(x=5, a=null())
96+
! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc3() {
97+
! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
98+
! HLFIR: %c1 = arith.constant 1 : index
99+
! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %c1 {{.*}}"_QMm_struct_ctorE.n.x"
100+
! HLFIR: %[[VAL_2:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
101+
! HLFIR: %c1_0 = arith.constant 1 : index
102+
! HLFIR: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %c1_0 {{.*}}"_QMm_struct_ctorE.n.a"
103+
! HLFIR: %[[VAL_4:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
104+
! HLFIR: %c7 = arith.constant 7 : index
105+
! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] typeparams %c7 {{.*}}"_QMm_struct_ctorE.n.t_alloc"
106+
! HLFIR: %[[VAL_6:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
107+
! HLFIR: %c0 = arith.constant 0 : index
108+
! HLFIR: %c2 = arith.constant 2 : index
109+
! HLFIR: %[[VAL_7:.*]] = fir.shape_shift %c0, %c2 : (index, index) -> !fir.shapeshift<1>
110+
! HLFIR: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_7]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
111+
! HLFIR: %[[VAL_9:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
112+
! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
113+
! HLFIR: %[[VAL_11:.*]] = fir.address_of(@_QMm_struct_ctorFtest_alloc3Et1) : !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
114+
! HLFIR: {{.*}}:2 = hlfir.declare %[[VAL_11]] {uniq_name = "_QMm_struct_ctorFtest_alloc3Et1"}
115+
! HLFIR: return
116+
! HLFIR: }
117+
end subroutine
118+
119+
subroutine test_alloc4()
120+
integer, pointer :: p(:)
121+
type(t_alloc) :: t1 = t_alloc(x=5, a=null(p))
122+
! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc4() {
123+
! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
124+
! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
125+
! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[CONS_1]] {{.*}}"_QMm_struct_ctorE.n.x"
126+
! HLFIR: %[[VAL_2:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
127+
! HLFIR: %[[CONS_2:.*]] = arith.constant 1 : index
128+
! HLFIR: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[CONS_2]] {{.*}}"_QMm_struct_ctorE.n.a"
129+
! HLFIR: %[[VAL_4:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
130+
! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
131+
! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] typeparams %[[CONS_3]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
132+
! HLFIR: %[[VAL_6:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
133+
! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
134+
! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
135+
! HLFIR: %[[VAL_7:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
136+
! HLFIR: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_7]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
137+
! HLFIR: %[[VAL_9:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
138+
! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
139+
! HLFIR: %[[VAL_11:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "p", uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"}
140+
! HLFIR: %[[VAL_12:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
141+
! HLFIR: %[[CONS_6:.*]] = arith.constant 0 : index
142+
! HLFIR: %[[VAL_13:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1>
143+
! HLFIR: %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
144+
! HLFIR: fir.store %[[VAL_14]] to %[[VAL_11]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
145+
! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_11]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"}
146+
! HLFIR: %[[VAL_16:.*]] = fir.address_of(@_QMm_struct_ctorFtest_alloc4Et1) : !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
147+
! HLFIR: %[[VAL_17:.*]]:2 = hlfir.declare %[[VAL_16]] {uniq_name = "_QMm_struct_ctorFtest_alloc4Et1"}
148+
! HLFIR: return
149+
! HLFIR: }
150+
end subroutine
151+
152+
end module m_struct_ctor

‎flang/test/Semantics/structconst06.f90

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module m
44
type t
55
real, allocatable :: a(:)
66
end type
7+
!ERROR: Must be a constant value
78
!ERROR: Scalar value cannot be expanded to shape of array component 'a'
89
type(t) :: x = t(0.)
910
end module

‎flang/test/Semantics/structconst07.f90

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,14 @@
22
type :: hasPointer
33
class(*), pointer :: sp
44
end type
5+
type :: hasAllocatable
6+
class(*), allocatable :: sa
7+
end type
58
type(hasPointer) hp
9+
type(hasAllocatable) ha
610
!CHECK: hp=haspointer(sp=NULL())
711
hp = hasPointer()
12+
!CHECK: ha=hasallocatable(sa=NULL())
13+
ha = hasAllocatable()
814
end
915

‎flang/test/Semantics/structconst08.f90

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2+
!
3+
! Error tests for structure constructors of derived types with allocatable components
4+
5+
module m
6+
type parent1
7+
integer, allocatable :: pa
8+
end type parent1
9+
type parent2
10+
real, allocatable :: pa(:)
11+
end type parent2
12+
type child
13+
integer :: i
14+
type(parent2) :: ca
15+
end type
16+
17+
contains
18+
subroutine test1()
19+
integer :: j
20+
real :: arr(5)
21+
integer, pointer :: ipp
22+
real, pointer :: rpp(:)
23+
!ERROR: Must be a constant value
24+
type(parent1) :: tp1 = parent1(3)
25+
!ERROR: Must be a constant value
26+
type(parent1) :: tp2 = parent1(j)
27+
type(parent1) :: tp3 = parent1(null())
28+
!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
29+
type(parent1) :: tp4 = parent1(null(ipp))
30+
31+
!ERROR: Must be a constant value
32+
type(parent2) :: tp5 = parent2([1.1,2.1,3.1])
33+
!ERROR: Must be a constant value
34+
type(parent2) :: tp6 = parent2(arr)
35+
type(parent2) :: tp7 = parent2(null())
36+
!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
37+
type(parent2) :: tp8 = parent2(null(rpp))
38+
end subroutine test1
39+
40+
subroutine test2()
41+
integer :: j
42+
real :: arr(5)
43+
integer, pointer :: ipp
44+
real, pointer :: rpp(:)
45+
type(parent1) :: tp1
46+
type(parent2) :: tp2
47+
tp1 = parent1(3)
48+
tp1 = parent1(j)
49+
tp1 = parent1(null())
50+
!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
51+
tp1 = parent1(null(ipp))
52+
53+
tp2 = parent2([1.1,2.1,3.1])
54+
tp2 = parent2(arr)
55+
tp2 = parent2(null())
56+
!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
57+
tp2 = parent2(null(rpp))
58+
end subroutine test2
59+
60+
subroutine test3()
61+
real, pointer :: pp(:)
62+
type(child) :: tc1 = child(5, parent2(null()))
63+
!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
64+
type(child) :: tc10 = child(5, parent2(null(pp)))
65+
!ERROR: Must be a constant value
66+
type(child) :: tc3 = child(5, parent2([1.1,1.2]))
67+
type(child) :: tc4
68+
69+
tc4 = child(5, parent2(null()))
70+
tc4 = child(5, parent2([1.1,1.2]))
71+
end subroutine test3
72+
end module m

0 commit comments

Comments
 (0)