[flang-commits] [flang] [flang] Refine coarray subobjects (PR #130183)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/130183

A subobject of a coarray is not also a coarray if it involves an allocatable component, pointer component, or vector-valued subscript.

>From 42af701633a9040a487092d99da62fe83855fc13 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 6 Mar 2025 13:55:02 -0800
Subject: [PATCH] [flang] Refine coarray subobjects

A subobject of a coarray is not also a coarray if it involves an
allocatable component, pointer component, or vector-valued subscript.
---
 flang/lib/Evaluate/variable.cpp     | 14 ++++++++++++--
 flang/test/Semantics/coarrays02.f90 | 22 ++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 841d0f71ed0e2..849194b492053 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -477,8 +477,11 @@ int BaseObject::Corank() const {
 int Component::Corank() const {
   if (int corank{symbol_->Corank()}; corank > 0) {
     return corank;
+  } else if (semantics::IsAllocatableOrObjectPointer(&*symbol_)) {
+    return 0; // coarray subobjects ca%a or ca%p are not coarrays
+  } else {
+    return base().Corank();
   }
-  return base().Corank();
 }
 
 int NamedEntity::Corank() const {
@@ -489,7 +492,14 @@ int NamedEntity::Corank() const {
       u_);
 }
 
-int ArrayRef::Corank() const { return base().Corank(); }
+int ArrayRef::Corank() const {
+  for (const Subscript &subs : subscript_) {
+    if (!std::holds_alternative<Triplet>(subs.u) && subs.Rank() > 0) {
+      return 0; // vector-valued subscript - subobject is not a coarray
+    }
+  }
+  return base().Corank();
+}
 
 int DataRef::Corank() const {
   return common::visit(common::visitors{
diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90
index a9f4958204936..193e5f8af4e63 100644
--- a/flang/test/Semantics/coarrays02.f90
+++ b/flang/test/Semantics/coarrays02.f90
@@ -48,3 +48,25 @@ 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 m3
+  type t
+    real, allocatable :: a(:)
+    real, pointer :: p(:)
+    real arr(2)
+  end type
+ contains
+  subroutine sub(ca)
+    real, intent(in) :: ca(:)[*]
+  end
+  subroutine test(cat)
+    type(t), intent(in) :: cat[*]
+    call sub(cat%arr(1:2)) ! ok
+    !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray
+    call sub(cat%arr([1]))
+    !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray
+    call sub(cat%a)
+    !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray
+    call sub(cat%p)
+  end
+end