[flang] Enforce F'2023 constraints C917 & C918 (#129962)

These are constraints that preclude the need to obtain type information
from descriptors on other images, essentially. When designating a
polymorphic component, its base may not be coindexed; nor shall a
coindexed designator have a type with a polymorphic potential subobject
component.

2 files changed, 46 insertions, 3 deletions

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 7b837930bf78..39a58a4e2336 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -650,8 +650,25 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
       dataRef = ExtractDataRef(std::move(result),
           /*intoSubstring=*/false, /*intoComplexPart=*/true);
     }
-    if (dataRef && !CheckDataRef(*dataRef)) {
-      result.reset();
+    if (dataRef) {
+      if (!CheckDataRef(*dataRef)) {
+        result.reset();
+      } else if (ExtractCoarrayRef(*dataRef).has_value()) {
+        if (auto dyType{result->GetType()};
+            dyType && dyType->category() == TypeCategory::Derived) {
+          if (!std::holds_alternative<CoarrayRef>(dataRef->u) &&
+              dyType->IsPolymorphic()) { // F'2023 C918
+            Say("The base of a polymorphic object may not be coindexed"_err_en_US);
+          }
+          if (const auto *derived{GetDerivedTypeSpec(*dyType)}) {
+            if (auto bad{FindPolymorphicAllocatablePotentialComponent(
+                    *derived)}) { // F'2023 C917
+              Say("A coindexed designator may not have a type with the polymorphic potential subobject component '%s'"_err_en_US,
+                  bad.BuildResultDesignatorName());
+            }
+          }
+        }
+      }
     }
   }
   return result;
diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90
index 193e5f8af4e6..dc907161250a 100644
--- a/flang/test/Semantics/coarrays02.f90
+++ b/flang/test/Semantics/coarrays02.f90
@@ -1,6 +1,6 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! More coarray error tests.
-module m
+module m1
   integer :: local[*] ! ok in module
 end
 program main
@@ -49,6 +49,32 @@ function func2()
   type(t) :: local
 end
 
+module m2
+  type t0
+    integer n
+  end type
+  type t1
+    class(t0), allocatable :: a
+  end type
+  type t2
+    type(t1) c
+  end type
+ contains
+  subroutine test(x)
+    type(t2), intent(in) :: x[*]
+    !ERROR: The base of a polymorphic object may not be coindexed
+    call sub1(x[1]%c%a)
+    !ERROR: A coindexed designator may not have a type with the polymorphic potential subobject component '%a'
+    call sub2(x[1]%c)
+  end
+  subroutine sub1(x)
+    type(t0), intent(in) :: x
+  end
+  subroutine sub2(x)
+    type(t1), intent(in) :: x
+  end
+end
+
 module m3
   type t
     real, allocatable :: a(:)