[flang] Don't take corank from actual intrinsic argument (llvm#124029)

When constructing the characteristics of a particular reference to an
intrinsic procedure that was passed a non-coindexed reference to local
coarray data as an actual argument, don't add the corank of the actual
argument to those characteristics.

Also clean up the TypeAndShape characteristics class a little; the
Attr::Coarray is redundant since the corank() accessor can be used to
the same effect.

Author: klausler

flang/include/flang/Evaluate/characteristics.h

@@ -60,8 +60,7 @@ bool ShapesAreCompatible(const std::optional<Shape> &,
 
 class TypeAndShape {
 public:
-  ENUM_CLASS(
-      Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape, Coarray)
+  ENUM_CLASS(Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape)
   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
 
   explicit TypeAndShape(DynamicType t) : type_{t}, shape_{Shape{}} {
@@ -103,9 +102,6 @@ class TypeAndShape {
     if (auto type{x.GetType()}) {
       TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
       result.corank_ = GetCorank(x);
-      if (result.corank_ > 0) {
-        result.attrs_.set(Attr::Coarray);
-      }
       if (type->category() == TypeCategory::Character) {
         if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
           if (auto length{chExpr->LEN()}) {
@@ -179,14 +175,14 @@ class TypeAndShape {
   const std::optional<Shape> &shape() const { return shape_; }
   const Attrs &attrs() const { return attrs_; }
   int corank() const { return corank_; }
+  void set_corank(int n) { corank_ = n; }
 
   // Return -1 for assumed-rank as a safety.
   int Rank() const { return shape_ ? GetRank(*shape_) : -1; }
 
   // Can sequence association apply to this argument?
   bool CanBeSequenceAssociated() const {
-    constexpr Attrs notAssumedOrExplicitShape{
-        ~Attrs{Attr::AssumedSize, Attr::Coarray}};
+    constexpr Attrs notAssumedOrExplicitShape{~Attrs{Attr::AssumedSize}};
     return Rank() > 0 && (attrs() & notAssumedOrExplicitShape).none();
   }
 

flang/lib/Evaluate/characteristics.cpp

@@ -227,9 +227,8 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
   } else if (semantics::IsAssumedSizeArray(symbol)) {
     attrs_.set(Attr::AssumedSize);
   }
-  if (int n{GetCorank(symbol)}) {
-    corank_ = n;
-    attrs_.set(Attr::Coarray);
+  if (int corank{GetCorank(symbol)}; corank > 0) {
+    corank_ = corank;
   }
   if (const auto *object{
           symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
@@ -439,9 +438,9 @@ bool DummyDataObject::CanBePassedViaImplicitInterface(
     return false; // 15.4.2.2(3)(a)
   } else if ((type.attrs() &
                  TypeAndShape::Attrs{TypeAndShape::Attr::AssumedShape,
-                     TypeAndShape::Attr::AssumedRank,
-                     TypeAndShape::Attr::Coarray})
-                 .any()) {
+                     TypeAndShape::Attr::AssumedRank})
+                 .any() ||
+      type.corank() > 0) {
     if (whyNot) {
       *whyNot = "a dummy argument is assumed-shape, assumed-rank, or a coarray";
     }
@@ -471,14 +470,15 @@ bool DummyDataObject::CanBePassedViaImplicitInterface(
 }
 
 bool DummyDataObject::IsPassedByDescriptor(bool isBindC) const {
-  constexpr TypeAndShape::Attrs shapeRequiringBox = {
+  constexpr TypeAndShape::Attrs shapeRequiringBox{
       TypeAndShape::Attr::AssumedShape, TypeAndShape::Attr::DeferredShape,
-      TypeAndShape::Attr::AssumedRank, TypeAndShape::Attr::Coarray};
+      TypeAndShape::Attr::AssumedRank};
   if ((attrs & Attrs{Attr::Allocatable, Attr::Pointer}).any()) {
     return true;
   } else if ((type.attrs() & shapeRequiringBox).any()) {
-    // Need to pass shape/coshape info in a descriptor.
-    return true;
+    return true; // pass shape in descriptor
+  } else if (type.corank() > 0) {
+    return true; // pass coshape in descriptor
   } else if (type.type().IsPolymorphic() && !type.type().IsAssumedType()) {
     // Need to pass dynamic type info in a descriptor.
     return true;

flang/lib/Evaluate/intrinsics.cpp

@@ -2576,6 +2576,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
             // Dummy procedures are never elemental.
             dummyProc->procedure.value().attrs.reset(
                 characteristics::Procedure::Attr::Elemental);
+          } else if (auto *dummyObject{
+                         std::get_if<characteristics::DummyDataObject>(
+                             &dc->u)}) {
+            dummyObject->type.set_corank(0);
           }
           dummyArgs.emplace_back(std::move(*dc));
           if (d.typePattern.kindCode == KindCode::same && !sameDummyArg) {

flang/lib/Lower/CallInterface.cpp

@@ -1132,10 +1132,7 @@ class Fortran::lower::CallInterfaceImpl {
 
     // TODO: intents that require special care (e.g finalization)
 
-    using ShapeAttr = Fortran::evaluate::characteristics::TypeAndShape::Attr;
-    const Fortran::evaluate::characteristics::TypeAndShape::Attrs &shapeAttrs =
-        obj.type.attrs();
-    if (shapeAttrs.test(ShapeAttr::Coarray))
+    if (obj.type.corank() > 0)
       TODO(loc, "coarray: dummy argument coarray in procedure interface");
 
     // So far assume that if the argument cannot be passed by implicit interface

flang/lib/Semantics/check-call.cpp

@@ -112,9 +112,9 @@ static bool CanAssociateWithStorageSequence(
              characteristics::TypeAndShape::Attr::AssumedRank) &&
       !dummy.type.attrs().test(
           characteristics::TypeAndShape::Attr::AssumedShape) &&
-      !dummy.type.attrs().test(characteristics::TypeAndShape::Attr::Coarray) &&
       !dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable) &&
-      !dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer);
+      !dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer) &&
+      dummy.type.corank() == 0;
 }
 
 // When a CHARACTER actual argument is known to be short,

flang/test/Semantics/call08.f90

@@ -26,6 +26,7 @@ subroutine test(x,c3,c4)
     real :: x(:)[*]
     real, intent(in) :: c3(:)[*]
     real, contiguous, intent(in) :: c4(:)[*]
+    character(2) :: coarr(2)[*] = [ "ab", "cd" ]
     call s01(c1) ! ok
     call s02(c2) ! ok
     call s03(c4) ! ok
@@ -44,5 +45,6 @@ subroutine test(x,c3,c4)
     call s04(c3)
     !ERROR: Actual argument associated with coarray dummy argument 'x=' (not assumed shape or rank) must be simply contiguous
     call s04(x)
+    print *, ichar(coarr(:)(1:1)) ! ok, ensure no bogus contiguity error
   end subroutine
 end module