[flang] Rearrange prototype & code placement of IsCoarray()

[klausler]

Summary

A quick fix last week to the shared library build caused
the predicate IsCoarray(const Symbol &) to be moved from
Semantics to Evaluate. This patch completes that move in
a way that properly combines the existing IsCoarray() tests
for expressions and other object with the test for a symbol.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/tools.h

template <typename T> bool IsAssumedRank(const Expr<T> &expr) {
   return std::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u);
 }
 template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
   return x && IsAssumedRank(*x);
 }
 
 // Predicate: true when an expression is a coarray (corank > 0)
 bool IsCoarray(const ActualArgument &);
+bool IsCoarray(const Symbol &);
 template <typename A> bool IsCoarray(const A &) { return false; }
 template <typename A> bool IsCoarray(const Designator<A> &designator) {
   if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
-    return symbol->get().Corank() > 0;
+    return IsCoarray(**symbol);
   }
   return false;
 }
 template <typename T> bool IsCoarray(const Expr<T> &expr) {
   return std::visit([](const auto &x) { return IsCoarray(x); }, expr.u);
 }
 template <typename A> bool IsCoarray(const std::optional<A> &x) {
   return x && IsCoarray(*x);

 bool IsPureProcedure(const Symbol &);
 bool IsPureProcedure(const Scope &);
 bool IsFunction(const Symbol &);
 bool IsFunction(const Scope &);
 bool IsProcedure(const Symbol &);
 bool IsProcedure(const Scope &);
 bool IsProcedurePointer(const Symbol &);
 bool IsAutomatic(const Symbol &);
-bool IsCoarray(const Symbol &);
 bool IsSaved(const Symbol &); // saved implicitly or explicitly
 bool IsDummy(const Symbol &);
 bool IsFunctionResult(const Symbol &);
 bool IsKindTypeParameter(const Symbol &);
 bool IsLenTypeParameter(const Symbol &);
 bool IsExtensibleType(const DerivedTypeSpec *);
 bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
 // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?

flang/lib/Evaluate/tools.cpp

bool IsAssumedRank(const ActualArgument &arg) {
   } else {
     const Symbol *assumedTypeDummy{arg.GetAssumedTypeDummy()};
     CHECK(assumedTypeDummy);
     return IsAssumedRank(*assumedTypeDummy);
   }
 }
 
 bool IsCoarray(const ActualArgument &arg) {
-  if (const auto *expr{arg.UnwrapExpr()}) {
-    return IsCoarray(*expr);
-  }
-  return false;
+  const auto *expr{arg.UnwrapExpr()};
+  return expr && IsCoarray(*expr);
+
+bool IsCoarray(const Symbol &symbol) {
+  return GetAssociationRoot(symbol).Corank() > 0;
 }
 
 bool IsProcedure(const Expr<SomeType> &expr) {
   return std::holds_alternative<ProcedureDesignator>(expr.u);
 }
 bool IsFunction(const Expr<SomeType> &expr) {
   const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)};
   return designator && designator->GetType().has_value();
if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) {
           }
         }
       }
     }
   }
   return false;
 }
 
-bool IsCoarray(const Symbol &symbol) {
-  return GetAssociationRoot(symbol).Corank() > 0;
-}
-
 bool IsSaved(const Symbol &original) {
   const Symbol &symbol{GetAssociationRoot(original)};
   const Scope &scope{symbol.owner()};
   auto scopeKind{scope.kind()};
   if (symbol.has<AssocEntityDetails>()) {
     return false; // ASSOCIATE(non-variable)
   } else if (scopeKind == Scope::Kind::DerivedType) {
     return false; // this is a component
   } else if (symbol.attrs().test(Attr::SAVE)) {
     return true; // explicit SAVE attribute
   } else if (IsDummy(symbol) || IsFunctionResult(symbol) ||
       IsAutomatic(symbol) || IsNamedConstant(symbol)) {
     return false;
   } else if (scopeKind == Scope::Kind::Module ||
       (scopeKind == Scope::Kind::MainProgram &&
-          (symbol.attrs().test(Attr::TARGET) || IsCoarray(symbol)))) {
+          (symbol.attrs().test(Attr::TARGET) || evaluate::IsCoarray(symbol)))) {
     // 8.5.16p4
     // In main programs, implied SAVE matters only for pointer
     // initialization targets and coarrays.
     // BLOCK DATA entities must all be in COMMON,
     // which was checked above.
     return true;
   } else if (scope.kind() == Scope::Kind::Subprogram &&
       scope.context().languageFeatures().IsEnabled(

flang/lib/Semantics/check-allocate.cpp

 }
 
 bool AllocationCheckerHelper::RunCoarrayRelatedChecks(
     SemanticsContext &context) const {
   if (!symbol_) {
     CHECK(context.AnyFatalError());
     return false;
   }
-  if (IsCoarray(*symbol_)) {
+  if (evaluate::IsCoarray(*symbol_)) {
     if (allocateInfo_.gotTypeSpec) {
       // C938
       if (const DerivedTypeSpec *
           derived{allocateInfo_.typeSpec->AsDerived()}) {
         if (IsTeamType(derived)) {
           context
               .Say(allocateInfo_.typeSpecLoc.value(),
                   "Type-Spec in ALLOCATE must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray"_err_en_US)

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::CheckValue(
   if (IsProcedure(symbol)) {
     messages_.Say(
         "VALUE attribute may apply only to a dummy data object"_err_en_US);
   }
   if (IsAssumedSizeArray(symbol)) {
     messages_.Say(
         "VALUE attribute may not apply to an assumed-size array"_err_en_US);
   }
-  if (IsCoarray(symbol)) {
+  if (evaluate::IsCoarray(symbol)) {
     messages_.Say("VALUE attribute may not apply to a coarray"_err_en_US);
   }
   if (IsAllocatable(symbol)) {
     messages_.Say("VALUE attribute may not apply to an ALLOCATABLE"_err_en_US);
   } else if (IsPointer(symbol)) {
     messages_.Say("VALUE attribute may not apply to a POINTER"_err_en_US);
   }
   if (IsIntentInOut(symbol)) {
if (!IsDummy(symbol)) {
                       " attribute"_err_en_US,
             symbol.name());
       }
       if (symbol.attrs().test(Attr::INTENT_OUT)) {
         messages_.Say(
             "Assumed-type argument '%s' cannot be INTENT(OUT)"_err_en_US,
             symbol.name());
       }
-      if (IsCoarray(symbol)) {
+      if (evaluate::IsCoarray(symbol)) {
         messages_.Say(
             "Assumed-type argument '%s' cannot be a coarray"_err_en_US,
             symbol.name());
       }
       if (details.IsArray() && details.shape().IsExplicitShape()) {
         messages_.Say(
             "Assumed-type array argument 'arg8' must be assumed shape,"
             " assumed size, or assumed rank"_err_en_US,
if (const DeclTypeSpec * type{details.type()}) {
             "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US,
             symbol.name());
       }
     }
   }
   if (details.isDummy()) {
     if (symbol.attrs().test(Attr::INTENT_OUT)) {
       if (FindUltimateComponent(symbol, [](const Symbol &x) {
-            return IsCoarray(x) && IsAllocatable(x);
+            return evaluate::IsCoarray(x) && IsAllocatable(x);
           })) { // C846
         messages_.Say(
             "An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray"_err_en_US);
       }
       if (IsOrContainsEventOrLockComponent(symbol)) { // C847
         messages_.Say(
             "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US);
       }
if (details.isDummy()) { // C15100
       if (details.shape().Rank() > 0) {
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure must be scalar"_err_en_US);
       }
       if (IsAllocatable(symbol)) {
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure may not be ALLOCATABLE"_err_en_US);
       }
-      if (IsCoarray(symbol)) {
+      if (evaluate::IsCoarray(symbol)) {
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure may not be a coarray"_err_en_US);
       }
       if (IsPointer(symbol)) {
         messages_.Say(
             "A dummy argument of an ELEMENTAL procedure may not be a POINTER"_err_en_US);
       }
       if (!symbol.attrs().HasAny(Attrs{Attr::VALUE, Attr::INTENT_IN,
if (IsIntentIn(symbol)) {
     messages_.Say(
         "VOLATILE attribute may not apply to an INTENT(IN) argument"_err_en_US);
   }
   if (IsProcedure(symbol)) {
     messages_.Say("VOLATILE attribute may apply only to a variable"_err_en_US);
   }
   if (symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()) {
     const Symbol &ultimate{symbol.GetUltimate()};
-    if (IsCoarray(ultimate)) {
+    if (evaluate::IsCoarray(ultimate)) {
       messages_.Say(
           "VOLATILE attribute may not apply to a coarray accessed by USE or host association"_err_en_US);
     }
     if (derived) {
       if (FindCoarrayUltimateComponent(*derived)) {
         messages_.Say(
             "VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association"_err_en_US);
       }

flang/lib/Semantics/check-do-forall.cpp

static bool HasImpureFinal(const Symbol &original) {
     return false;
   }
 
   // Predicate for deallocations caused by block exit and direct deallocation
   static bool DeallocateAll(const Symbol &) { return true; }
 
   // Predicate for deallocations caused by intrinsic assignment
   static bool DeallocateNonCoarray(const Symbol &component) {
-    return !IsCoarray(component);
+    return !evaluate::IsCoarray(component);
   }
 
   static bool WillDeallocatePolymorphic(const Symbol &entity,
       const std::function<bool(const Symbol &)> &WillDeallocate) {
     return WillDeallocate(entity) && IsPolymorphicAllocatable(entity);
   }
 
   // Is it possible that we will we deallocate a polymorphic entity or one

flang/lib/Semantics/resolve-names.cpp

SayWithDecl(name, symbol,
         "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
     return false;
   }
   if (IsFinalizable(symbol)) { // C1128
     SayWithDecl(name, symbol,
         "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
     return false;
   }
-  if (IsCoarray(symbol)) { // C1128
+  if (evaluate::IsCoarray(symbol)) { // C1128
     SayWithDecl(
         name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US);
     return false;
   }
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     if (type->IsPolymorphic() && IsDummy(symbol) &&
         !IsPointer(symbol)) { // C1128
       SayWithDecl(name, symbol,

flang/lib/Semantics/tools.cpp

public:
   }
   bool operator()(const parser::Statement<parser::ActionStmt> &stmt) {
     return std::visit(*this, stmt.statement.u);
   }
 
 private:
   bool IsCoarrayObject(const parser::AllocateObject &allocateObject) {
     const parser::Name &name{GetLastName(allocateObject)};
-    return name.symbol && IsCoarray(*name.symbol);
+    return name.symbol && evaluate::IsCoarray(*name.symbol);
   }
 };
 
 bool IsImageControlStmt(const parser::ExecutableConstruct &construct) {
   return std::visit(ImageControlStmtHelper{}, construct.u);
 }
 
 std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
return std::visit(
           [](const auto &) { return parser::CharBlock{}; },
       },
       executableConstruct.u);
 }
 
 bool HasCoarray(const parser::Expr &expression) {
   if (const auto *expr{GetExpr(expression)}) {
     for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
-      if (IsCoarray(GetAssociationRoot(symbol))) {
+      if (evaluate::IsCoarray(symbol)) {
         return true;
       }
     }
   }
   return false;
 }
 
 bool IsPolymorphic(const Symbol &symbol) {

 template class ComponentIterator<ComponentKind::Direct>;
 template class ComponentIterator<ComponentKind::Ultimate>;
 template class ComponentIterator<ComponentKind::Potential>;
 template class ComponentIterator<ComponentKind::Scope>;
 
 UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
     const DerivedTypeSpec &derived) {
   UltimateComponentIterator ultimates{derived};
-  return std::find_if(ultimates.begin(), ultimates.end(), IsCoarray);
+  return std::find_if(ultimates.begin(), ultimates.end(),
+      [](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
 }
 
 UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
     const DerivedTypeSpec &derived) {
   UltimateComponentIterator ultimates{derived};
   return std::find_if(ultimates.begin(), ultimates.end(), IsPointer);
 }
 
return std::find_if(
       ultimates.begin(), ultimates.end(), IsPolymorphicAllocatable);
 }
 
 UltimateComponentIterator::const_iterator
 FindPolymorphicAllocatableNonCoarrayUltimateComponent(
     const DerivedTypeSpec &derived) {
   UltimateComponentIterator ultimates{derived};
   return std::find_if(ultimates.begin(), ultimates.end(), [](const Symbol &x) {
-    return IsPolymorphicAllocatable(x) && !IsCoarray(x);
+    return IsPolymorphicAllocatable(x) && !evaluate::IsCoarray(x);
   });
 }
 
 const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
     const std::function<bool(const Symbol &)> &predicate) {
   UltimateComponentIterator ultimates{derived};
   if (auto it{std::find_if(ultimates.begin(), ultimates.end(),
           [&predicate](const Symbol &component) -> bool {