diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 827defd605f7f..8211df694b489 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3293,15 +3293,24 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) { "in a non-pointer intrinsic assignment statement"); analyzer.CheckForAssumedRank("in an assignment statement"); const Expr &lhs{analyzer.GetExpr(0)}; - if (auto dyType{lhs.GetType()}; - dyType && dyType->IsPolymorphic()) { // 10.2.1.2p1(1) - const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)}; - const Symbol *lastWhole{ - lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr}; - if (!lastWhole || !IsAllocatable(*lastWhole)) { - Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US); - } else if (evaluate::IsCoarray(*lastWhole)) { - Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US); + if (auto dyType{lhs.GetType()}) { + if (dyType->IsPolymorphic()) { // 10.2.1.2p1(1) + const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)}; + const Symbol *lastWhole{ + lastWhole0 ? &ResolveAssociations(*lastWhole0) : nullptr}; + if (!lastWhole || !IsAllocatable(*lastWhole)) { + Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US); + } else if (evaluate::IsCoarray(*lastWhole)) { + Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US); + } + } + if (auto *derived{GetDerivedTypeSpec(*dyType)}) { + if (auto iter{FindAllocatableUltimateComponent(*derived)}) { + if (ExtractCoarrayRef(lhs)) { + Say("Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%s'"_err_en_US, + iter.BuildResultDesignatorName()); + } + } } } } diff --git a/flang/test/Semantics/assign11.f90 b/flang/test/Semantics/assign11.f90 index eaa9533409502..37216526b5f33 100644 --- a/flang/test/Semantics/assign11.f90 +++ b/flang/test/Semantics/assign11.f90 @@ -4,9 +4,15 @@ program test class(*), allocatable :: pa class(*), pointer :: pp class(*), allocatable :: pac[:] + type t + real, allocatable :: a + end type + type(t) auc[*] pa = 1 ! ok !ERROR: Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable pp = 1 !ERROR: Left-hand side of assignment may not be polymorphic if it is a coarray pac = 1 + !ERROR: Left-hand side of assignment must not be coindexed due to allocatable ultimate component '%a' + auc[1] = t() end