[flang] Enforce F'2023 constraints C917 & C918

[klausler]

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.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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.

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/expression.cpp (+19-2)
• (modified) flang/test/Semantics/coarrays02.f90 (+27-1)

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 827defd605f7f..014cf802095d1 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -608,8 +608,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 a9f4958204936..5888e51c23800 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
@@ -48,3 +48,29 @@ function func2()
   !ERROR: Local variable 'local' without the SAVE or ALLOCATABLE attribute may not have a coarray potential subobject component '%comp'
   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

[klausler]

This code apparently depends on some changes pending in other code reviews. I'll let you know when it starts to build correctly once those other changes have merged.