Skip to content

[flang] Add structure constructor with allocatable component #77845

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jan 17, 2024
Merged

[flang] Add structure constructor with allocatable component #77845

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
f43f9bc
[flang] Add structure constructor with allocatable component
kkwli Oct 26, 2023
9f0a252
Fix the component check
kkwli Jan 12, 2024
2fd2304
- update logic to handle the null(mod) case
kkwli Jan 16, 2024
9fa5d4f
fix format
kkwli Jan 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 6 additions & 1 deletion flang/lib/Evaluate/check-expression.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
}
Expand Down
5 changes: 5 additions & 0 deletions flang/lib/Evaluate/fold.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)}) {
Expand Down
18 changes: 16 additions & 2 deletions flang/lib/Lower/ConvertConstant.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down Expand Up @@ -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))
Expand Down
152 changes: 152 additions & 0 deletions flang/test/Lower/structure-constructors-alloc-comp.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions flang/test/Semantics/structconst06.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
6 changes: 6 additions & 0 deletions flang/test/Semantics/structconst07.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

72 changes: 72 additions & 0 deletions flang/test/Semantics/structconst08.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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