[flang-commits] [flang] 3d3c63d - [flang] Add structure constructor with allocatable component (#77845)
via flang-commits
flang-commits at lists.llvm.org
Wed Jan 17 08:24:09 PST 2024
Author: Kelvin Li
Date: 2024-01-17T11:24:05-05:00
New Revision: 3d3c63da6bb68d5306cdc9f9fbf867b428e9b0bf
URL: https://github.com/llvm/llvm-project/commit/3d3c63da6bb68d5306cdc9f9fbf867b428e9b0bf
DIFF: https://github.com/llvm/llvm-project/commit/3d3c63da6bb68d5306cdc9f9fbf867b428e9b0bf.diff
LOG: [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.
Added:
flang/test/Lower/structure-constructors-alloc-comp.f90
flang/test/Semantics/structconst08.f90
Modified:
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/fold.cpp
flang/lib/Lower/ConvertConstant.cpp
flang/test/Semantics/structconst06.f90
flang/test/Semantics/structconst07.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 2f46ed7dccb645..14abac5ff9ba80 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -190,7 +190,12 @@ struct IsActuallyConstantHelper {
bool operator()(const StructureConstructor &x) {
for (const auto &pair : x) {
const Expr<SomeType> &y{pair.second.value()};
- if (!(*this)(y) && !IsNullPointer(y)) {
+ const auto sym{pair.first};
+ const bool compIsConstant{(*this)(y)};
+ // If an allocatable component is initialized by a constant,
+ // the structure constructor is not a constant.
+ if ((!compIsConstant && !IsNullPointer(y)) ||
+ (compIsConstant && IsAllocatable(sym))) {
return false;
}
}
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index dfcc2599a555e5..ed882958199802 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -82,6 +82,11 @@ Expr<SomeDerived> FoldOperation(
} else {
isConstant &= IsInitialDataTarget(expr);
}
+ } else if (IsAllocatable(symbol)) {
+ // F2023: 10.1.12 (3)(a)
+ // If comp-spec is not null() for the allocatable component the
+ // structure constructor is not a constant expression.
+ isConstant &= IsNullPointer(expr);
} else {
isConstant &= IsActuallyConstant(expr) || IsNullPointer(expr);
if (auto valueShape{GetConstantExtents(context, expr)}) {
diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index d7a4d68f2aaae7..336944d35b7e4a 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -18,6 +18,7 @@
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/Mangler.h"
#include "flang/Optimizer/Builder/Complex.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
#include <algorithm>
@@ -362,8 +363,21 @@ static mlir::Value genStructureComponentInit(
loc, fieldTy, name, recTy,
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
- if (Fortran::semantics::IsAllocatable(sym))
- TODO(loc, "allocatable component in structure constructor");
+ if (Fortran::semantics::IsAllocatable(sym)) {
+ if (!Fortran::evaluate::IsNullPointer(expr)) {
+ fir::emitFatalError(loc, "constant structure constructor with an "
+ "allocatable component value that is not NULL");
+ } else {
+ // Handle NULL() initialization
+ mlir::Value componentValue{fir::factory::createUnallocatedBox(
+ builder, loc, componentTy, std::nullopt)};
+ componentValue = builder.createConvert(loc, componentTy, componentValue);
+
+ return builder.create<fir::InsertValueOp>(
+ loc, recTy, res, componentValue,
+ builder.getArrayAttr(field.getAttributes()));
+ }
+ }
if (Fortran::semantics::IsPointer(sym)) {
if (Fortran::semantics::IsProcedure(sym))
diff --git a/flang/test/Lower/structure-constructors-alloc-comp.f90 b/flang/test/Lower/structure-constructors-alloc-comp.f90
new file mode 100644
index 00000000000000..f6dceb8f5e0501
--- /dev/null
+++ b/flang/test/Lower/structure-constructors-alloc-comp.f90
@@ -0,0 +1,152 @@
+! Test lowering of structure constructors of derived types with allocatable component
+! RUN: bbc -emit-hlfir %s -o - | FileCheck --check-prefixes=HLFIR %s
+
+module m_struct_ctor
+ implicit none
+ type t_alloc
+ real :: x
+ integer, allocatable :: a(:)
+ end type
+
+contains
+ subroutine test_alloc1(y)
+ real :: y
+ call print_alloc_comp(t_alloc(x=y, a=null()))
+! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc1(
+! HLFIR-SAME: %[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}) {
+! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>
+! HLFIR: %[[VAL_1:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
+! HLFIR: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {{.*}}"_QMm_struct_ctorE.n.x"
+! HLFIR: %[[VAL_3:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_2:.* ]]= arith.constant 1 : index
+! HLFIR: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {{.*}}"_QMm_struct_ctorE.n.a"
+! HLFIR: %[[VAL_5:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
+! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
+! HLFIR: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
+! HLFIR: %[[VAL_7:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
+! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
+! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
+! HLFIR: %[[VAL_8:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
+! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_8]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
+! HLFIR: %[[VAL_10:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
+! HLFIR: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
+! HLFIR: %[[VAL_12:.*]]:2 = hlfir.declare %[[ARG_0]] {uniq_name = "_QMm_struct_ctorFtest_alloc1Ey"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! 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>>>}>>)
+! 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>>>}>>
+! HLFIR: %[[VAL_15:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! HLFIR: %[[CONS_6:.*]] = arith.constant {{.*}} : i32
+! 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>
+! HLFIR: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! HLFIR: %{{.*}} = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[CONS_6]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
+! 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>
+! HLFIR: %[[VAL_19:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref<f32>
+! HLFIR: hlfir.assign %[[VAL_19]] to %[[VAL_18]] temporary_lhs : f32, !fir.ref<f32>
+! 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>>>}>>) -> ()
+! HLFIR: return
+! HLFIR: }
+ end subroutine
+
+ subroutine test_alloc2(y, b)
+ real :: y
+ integer :: b(5)
+ call print_alloc_comp(t_alloc(x=y, a=b))
+! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc2
+! HLFIR-SAME: (%[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}, %[[ARG_1:.*]]: !fir.ref<!fir.array<5xi32>> {fir.bindc_name = "b"}) {
+! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>
+! HLFIR: %[[VAL_1:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
+! HLFIR: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[CONS_1]] {{.*}}"_QMm_struct_ctorE.n.x"
+! HLFIR: %[[VAL_3:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_2:.*]] = arith.constant 1 : index
+! HLFIR: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[CONS_2]] {{.*}}"_QMm_struct_ctorE.n.a"
+! HLFIR: %[[VAL_5:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
+! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
+! HLFIR: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[CONS_3]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
+! HLFIR: %[[VAL_7:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
+! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
+! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
+! HLFIR: %[[VAL_8:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
+! HLFIR: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_8]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
+! HLFIR: %[[VAL_10:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
+! HLFIR: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
+! HLFIR: %[[CONS_6:.*]] = arith.constant 5 : index
+! HLFIR: %[[VAL_12:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1>
+! 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>>)
+! HLFIR: %[[VAL_14:.*]]:2 = hlfir.declare %[[ARG_0]] {uniq_name = "_QMm_struct_ctorFtest_alloc2Ey"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! 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>>>}>>)
+! 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>>>}>>
+! HLFIR: %[[VAL_17:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! HLFIR: %[[CONS_7:.*]] = arith.constant {{.*}} : i32
+! 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>
+! HLFIR: %[[VAL_19:.*]] = fir.convert %[[VAL_17]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! HLFIR: {{.*}} = fir.call @_FortranAInitialize(%[[VAL_18]], %[[VAL_19]], %[[CONS_7]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
+! 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>
+! HLFIR: %[[VAL_21:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<f32>
+! HLFIR: hlfir.assign %[[VAL_21]] to %[[VAL_20]] temporary_lhs : f32, !fir.ref<f32>
+! 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>>>>
+! 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>>>>
+! 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>>>}>>) -> ()
+! HLFIR: return
+! HLFIR: }
+ end subroutine
+
+ subroutine test_alloc3()
+ type(t_alloc) :: t1 = t_alloc(x=5, a=null())
+! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc3() {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
+! HLFIR: %c1 = arith.constant 1 : index
+! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %c1 {{.*}}"_QMm_struct_ctorE.n.x"
+! HLFIR: %[[VAL_2:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
+! HLFIR: %c1_0 = arith.constant 1 : index
+! HLFIR: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %c1_0 {{.*}}"_QMm_struct_ctorE.n.a"
+! HLFIR: %[[VAL_4:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
+! HLFIR: %c7 = arith.constant 7 : index
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] typeparams %c7 {{.*}}"_QMm_struct_ctorE.n.t_alloc"
+! HLFIR: %[[VAL_6:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
+! HLFIR: %c0 = arith.constant 0 : index
+! HLFIR: %c2 = arith.constant 2 : index
+! HLFIR: %[[VAL_7:.*]] = fir.shape_shift %c0, %c2 : (index, index) -> !fir.shapeshift<1>
+! HLFIR: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_7]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
+! HLFIR: %[[VAL_9:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
+! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
+! 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>>>}>>
+! HLFIR: {{.*}}:2 = hlfir.declare %[[VAL_11]] {uniq_name = "_QMm_struct_ctorFtest_alloc3Et1"}
+! HLFIR: return
+! HLFIR: }
+ end subroutine
+
+ subroutine test_alloc4()
+ integer, pointer :: p(:)
+ type(t_alloc) :: t1 = t_alloc(x=5, a=null(p))
+! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc4() {
+! HLFIR: %[[VAL_0:.*]] = fir.address_of(@_QMm_struct_ctorE.n.x) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_1:.*]] = arith.constant 1 : index
+! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[CONS_1]] {{.*}}"_QMm_struct_ctorE.n.x"
+! HLFIR: %[[VAL_2:.*]] = fir.address_of(@_QMm_struct_ctorE.n.a) : !fir.ref<!fir.char<1>>
+! HLFIR: %[[CONS_2:.*]] = arith.constant 1 : index
+! HLFIR: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[CONS_2]] {{.*}}"_QMm_struct_ctorE.n.a"
+! HLFIR: %[[VAL_4:.*]] = fir.address_of(@_QMm_struct_ctorE.n.t_alloc) : !fir.ref<!fir.char<1,7>>
+! HLFIR: %[[CONS_3:.*]] = arith.constant 7 : index
+! HLFIR: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] typeparams %[[CONS_3]] {{.*}}"_QMm_struct_ctorE.n.t_alloc"
+! HLFIR: %[[VAL_6:.*]] = fir.address_of(@_QMm_struct_ctorE.c.t_alloc)
+! HLFIR: %[[CONS_4:.*]] = arith.constant 0 : index
+! HLFIR: %[[CONS_5:.*]] = arith.constant 2 : index
+! HLFIR: %[[VAL_7:.*]] = fir.shape_shift %[[CONS_4]], %[[CONS_5]] : (index, index) -> !fir.shapeshift<1>
+! HLFIR: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_7]]) {{.*}}"_QMm_struct_ctorE.c.t_alloc"
+! HLFIR: %[[VAL_9:.*]] = fir.address_of(@_QMm_struct_ctorE.dt.t_alloc)
+! HLFIR: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {{.*}}"_QMm_struct_ctorE.dt.t_alloc"
+! HLFIR: %[[VAL_11:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "p", uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"}
+! HLFIR: %[[VAL_12:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! HLFIR: %[[CONS_6:.*]] = arith.constant 0 : index
+! HLFIR: %[[VAL_13:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1>
+! HLFIR: %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! HLFIR: fir.store %[[VAL_14]] to %[[VAL_11]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_11]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"}
+! 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>>>}>>
+! HLFIR: %[[VAL_17:.*]]:2 = hlfir.declare %[[VAL_16]] {uniq_name = "_QMm_struct_ctorFtest_alloc4Et1"}
+! HLFIR: return
+! HLFIR: }
+ end subroutine
+
+end module m_struct_ctor
diff --git a/flang/test/Semantics/structconst06.f90 b/flang/test/Semantics/structconst06.f90
index d5a40410ea63a1..45a0fb97842d30 100644
--- a/flang/test/Semantics/structconst06.f90
+++ b/flang/test/Semantics/structconst06.f90
@@ -4,6 +4,7 @@ module m
type t
real, allocatable :: a(:)
end type
+ !ERROR: Must be a constant value
!ERROR: Scalar value cannot be expanded to shape of array component 'a'
type(t) :: x = t(0.)
end module
diff --git a/flang/test/Semantics/structconst07.f90 b/flang/test/Semantics/structconst07.f90
index a34289a817af44..d61c54200dc82d 100644
--- a/flang/test/Semantics/structconst07.f90
+++ b/flang/test/Semantics/structconst07.f90
@@ -2,8 +2,14 @@
type :: hasPointer
class(*), pointer :: sp
end type
+type :: hasAllocatable
+ class(*), allocatable :: sa
+end type
type(hasPointer) hp
+type(hasAllocatable) ha
!CHECK: hp=haspointer(sp=NULL())
hp = hasPointer()
+!CHECK: ha=hasallocatable(sa=NULL())
+ha = hasAllocatable()
end
diff --git a/flang/test/Semantics/structconst08.f90 b/flang/test/Semantics/structconst08.f90
new file mode 100644
index 00000000000000..149c898dda9d4d
--- /dev/null
+++ b/flang/test/Semantics/structconst08.f90
@@ -0,0 +1,72 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+!
+! Error tests for structure constructors of derived types with allocatable components
+
+module m
+ type parent1
+ integer, allocatable :: pa
+ end type parent1
+ type parent2
+ real, allocatable :: pa(:)
+ end type parent2
+ type child
+ integer :: i
+ type(parent2) :: ca
+ end type
+
+contains
+ subroutine test1()
+ integer :: j
+ real :: arr(5)
+ integer, pointer :: ipp
+ real, pointer :: rpp(:)
+!ERROR: Must be a constant value
+ type(parent1) :: tp1 = parent1(3)
+!ERROR: Must be a constant value
+ type(parent1) :: tp2 = parent1(j)
+ type(parent1) :: tp3 = parent1(null())
+!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
+ type(parent1) :: tp4 = parent1(null(ipp))
+
+!ERROR: Must be a constant value
+ type(parent2) :: tp5 = parent2([1.1,2.1,3.1])
+!ERROR: Must be a constant value
+ type(parent2) :: tp6 = parent2(arr)
+ type(parent2) :: tp7 = parent2(null())
+!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
+ type(parent2) :: tp8 = parent2(null(rpp))
+ end subroutine test1
+
+ subroutine test2()
+ integer :: j
+ real :: arr(5)
+ integer, pointer :: ipp
+ real, pointer :: rpp(:)
+ type(parent1) :: tp1
+ type(parent2) :: tp2
+ tp1 = parent1(3)
+ tp1 = parent1(j)
+ tp1 = parent1(null())
+!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
+ tp1 = parent1(null(ipp))
+
+ tp2 = parent2([1.1,2.1,3.1])
+ tp2 = parent2(arr)
+ tp2 = parent2(null())
+!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
+ tp2 = parent2(null(rpp))
+ end subroutine test2
+
+ subroutine test3()
+ real, pointer :: pp(:)
+ type(child) :: tc1 = child(5, parent2(null()))
+!PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
+ type(child) :: tc10 = child(5, parent2(null(pp)))
+!ERROR: Must be a constant value
+ type(child) :: tc3 = child(5, parent2([1.1,1.2]))
+ type(child) :: tc4
+
+ tc4 = child(5, parent2(null()))
+ tc4 = child(5, parent2([1.1,1.2]))
+ end subroutine test3
+end module m
More information about the flang-commits
mailing list