diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -91,10 +91,11 @@ // Predicate: true when an expression is a coarray (corank > 0) bool IsCoarray(const ActualArgument &); +bool IsCoarray(const Symbol &); template bool IsCoarray(const A &) { return false; } template bool IsCoarray(const Designator &designator) { if (const auto *symbol{std::get_if(&designator.u)}) { - return symbol->get().Corank() > 0; + return IsCoarray(**symbol); } return false; } @@ -1051,7 +1052,6 @@ 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 &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -699,10 +699,12 @@ } 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 &expr) { @@ -1193,10 +1195,6 @@ 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()}; @@ -1212,7 +1210,7 @@ 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. diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -541,7 +541,7 @@ CHECK(context.AnyFatalError()); return false; } - if (IsCoarray(*symbol_)) { + if (evaluate::IsCoarray(*symbol_)) { if (allocateInfo_.gotTypeSpec) { // C938 if (const DerivedTypeSpec * diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -372,7 +372,7 @@ 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)) { @@ -432,7 +432,7 @@ "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()); @@ -486,7 +486,7 @@ 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); @@ -545,7 +545,7 @@ 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); } @@ -1448,7 +1448,7 @@ } if (symbol.has() || symbol.has()) { 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); } diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp --- a/flang/lib/Semantics/check-do-forall.cpp +++ b/flang/lib/Semantics/check-do-forall.cpp @@ -132,7 +132,7 @@ // 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, diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4978,7 +4978,7 @@ "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; diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -924,7 +924,7 @@ 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); } }; @@ -988,7 +988,7 @@ 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; } } @@ -1248,7 +1248,8 @@ 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( @@ -1288,7 +1289,7 @@ 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); }); }