Skip to content

Commit b90c2e9

Browse files
committed
[flang] Refine checks on assignments to coarrays
F'2023 10.2.1.2 paragraph 2 imposes some requirements on the left-hand sides of assignments when they have coindices, and one was not checked while another was inaccurately checked. In short, intrinsic assignment to a coindexed object can't change its type, and neither can it affect allocatable components.
1 parent f6e8366 commit b90c2e9

File tree

2 files changed

+24
-9
lines changed

2 files changed

+24
-9
lines changed

flang/lib/Semantics/expression.cpp

Lines changed: 18 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -3293,15 +3293,24 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
32933293
"in a non-pointer intrinsic assignment statement");
32943294
analyzer.CheckForAssumedRank("in an assignment statement");
32953295
const Expr<SomeType> &lhs{analyzer.GetExpr(0)};
3296-
if (auto dyType{lhs.GetType()};
3297-
dyType && dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
3298-
const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
3299-
const Symbol *lastWhole{
3300-
lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr};
3301-
if (!lastWhole || !IsAllocatable(*lastWhole)) {
3302-
Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
3303-
} else if (evaluate::IsCoarray(*lastWhole)) {
3304-
Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
3296+
if (auto dyType{lhs.GetType()}) {
3297+
if (dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
3298+
const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
3299+
const Symbol *lastWhole{
3300+
lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr};
3301+
if (!lastWhole || !IsAllocatable(*lastWhole)) {
3302+
Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
3303+
} else if (evaluate::IsCoarray(*lastWhole)) {
3304+
Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
3305+
}
3306+
}
3307+
if (auto *derived{GetDerivedTypeSpec(*dyType)}) {
3308+
if (auto iter{FindAllocatableUltimateComponent(*derived)}) {
3309+
if (ExtractCoarrayRef(lhs)) {
3310+
Say("Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%s'"_err_en_US,
3311+
iter.BuildResultDesignatorName());
3312+
}
3313+
}
33053314
}
33063315
}
33073316
}

flang/test/Semantics/assign11.f90

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,15 @@ program test
44
class(*), allocatable :: pa
55
class(*), pointer :: pp
66
class(*), allocatable :: pac[:]
7+
type t
8+
real, allocatable :: a
9+
end type
10+
type(t) auc[*]
711
pa = 1 ! ok
812
!ERROR: Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable
913
pp = 1
1014
!ERROR: Left-hand side of assignment may not be polymorphic if it is a coarray
1115
pac = 1
16+
!ERROR: Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%a'
17+
auc[1] = t()
1218
end

0 commit comments

Comments
 (0)