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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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.

>From e851c1d373532d7a98f9bf5ac4138c2106e502e0 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 5 Mar 2025 16:17:51 -0800
Subject: [PATCH] [flang] Enforce F'2023 constraints C917 & C918

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.
---
 flang/lib/Semantics/expression.cpp  | 21 +++++++++++++++++++--
 flang/test/Semantics/coarrays02.f90 | 28 +++++++++++++++++++++++++++-
 2 files changed, 46 insertions(+), 3 deletions(-)

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