Skip to content

Commit 3ff1def

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 3ff1def

File tree

2 files changed

+22
-12
lines changed

2 files changed

+22
-12
lines changed

flang/lib/Semantics/expression.cpp

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -3293,15 +3293,22 @@ 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+
}
3304+
}
3305+
if (auto *derived{GetDerivedTypeSpec(*dyType)}) {
3306+
if (auto iter{FindAllocatableUltimateComponent(*derived)}) {
3307+
if (ExtractCoarrayRef(lhs)) {
3308+
Say("Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%s'"_err_en_US,
3309+
iter.BuildResultDesignatorName());
3310+
}
3311+
}
33053312
}
33063313
}
33073314
}

flang/test/Semantics/assign11.f90

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,13 @@
33
program test
44
class(*), allocatable :: pa
55
class(*), pointer :: pp
6-
class(*), allocatable :: pac[:]
6+
type t
7+
real, allocatable :: a
8+
end type
9+
type(t) auc[*]
710
pa = 1 ! ok
811
!ERROR: Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable
912
pp = 1
10-
!ERROR: Left-hand side of assignment may not be polymorphic if it is a coarray
11-
pac = 1
13+
!ERROR: Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%a'
14+
auc[1] = t()
1215
end

0 commit comments

Comments
 (0)