[flang] Refine coarray subobjects

[klausler]

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

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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

---

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

2 Files Affected:

• (modified) flang/lib/Evaluate/variable.cpp (+12-2)
• (modified) flang/test/Semantics/coarrays02.f90 (+22)

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