diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -2633,6 +2633,18 @@ if (!procRef) { analyzer.CheckForNullPointer( "in a non-pointer intrinsic 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 ? &lastWhole0->GetUltimate() : 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); + } + } } assignment.emplace(analyzer.MoveExpr(0), analyzer.MoveExpr(1)); if (procRef) { diff --git a/flang/test/Semantics/assign11.f90 b/flang/test/Semantics/assign11.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/assign11.f90 @@ -0,0 +1,12 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! 10.2.1.2p1(1) +program test + class(*), allocatable :: pa + class(*), pointer :: pp + class(*), allocatable :: pac[:] + 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 +end diff --git a/flang/test/Semantics/call28.f90 b/flang/test/Semantics/call28.f90 --- a/flang/test/Semantics/call28.f90 +++ b/flang/test/Semantics/call28.f90 @@ -11,6 +11,7 @@ end subroutine pure subroutine s2(x) class(t), intent(in out) :: x + !ERROR: Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'x' is polymorphic in a pure subprogram x = t()