[flang] Enforce F'2023 constraints C917 & C918

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;

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(:)