[flang] Refine checks on assignments to coarrays

[klausler]

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.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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.

---

Full diff: https://github.com/llvm/llvm-project/pull/129966.diff

2 Files Affected:

• (modified) flang/lib/Semantics/expression.cpp (+16-9)
• (modified) flang/test/Semantics/assign11.f90 (+6-3)

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 827defd605f7f..a58c14fa9184d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3293,15 +3293,22 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
             "in a non-pointer intrinsic assignment statement");
         analyzer.CheckForAssumedRank("in an assignment statement");
         const Expr<SomeType> &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);
+            }
+          }
+          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..645cd4e1c65ac 100644
--- a/flang/test/Semantics/assign11.f90
+++ b/flang/test/Semantics/assign11.f90
@@ -3,10 +3,13 @@
 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