From fb792ebaf2114ad11d673cf891ae560e2e604711 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Sat, 17 Dec 2022 09:11:40 -0800 Subject: [PATCH] [flang] Apply definability checks in ALLOCATE/DEALLOCATE statements The pointers and allocatables that appear in ALLOCATE and DEALLOCATE statements need to be subject to the general definability checks so that problems with e.g. PROTECTED objects can be caught. (Also: regularize the capitalization of the DEALLOCATE error messages while I'm in here so that they're consistent with the messages that can come out for ALLOCATE.) Differential Revision: https://reviews.llvm.org/D140149 --- flang/lib/Semantics/check-allocate.cpp | 14 ++++++++++++ flang/lib/Semantics/check-deallocate.cpp | 37 ++++++++++++++++++++++++-------- flang/lib/Semantics/definable.cpp | 28 +++++++++++++++--------- flang/lib/Semantics/definable.h | 1 + flang/test/Semantics/allocate13.f90 | 20 +++++++++++++++++ flang/test/Semantics/deallocate05.f90 | 18 ++++++++-------- flang/test/Semantics/deallocate06.f90 | 2 +- flang/test/Semantics/dosemantics12.f90 | 4 ++-- 8 files changed, 93 insertions(+), 31 deletions(-) diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index ce81ca1..c397c9f 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -8,6 +8,7 @@ #include "check-allocate.h" #include "assignment.h" +#include "definable.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/type.h" #include "flang/Parser/parse-tree.h" @@ -532,6 +533,19 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { return false; } context.CheckIndexVarRedefine(name_); + if (allocateObject_.typedExpr && allocateObject_.typedExpr->v) { + if (auto whyNot{ + WhyNotDefinable(name_.source, context.FindScope(name_.source), + {DefinabilityFlag::PointerDefinition, + DefinabilityFlag::AcceptAllocatable}, + *allocateObject_.typedExpr->v)}) { + context + .Say(name_.source, + "Name in ALLOCATE statement is not definable"_err_en_US) + .Attach(std::move(*whyNot)); + return false; + } + } return RunCoarrayRelatedChecks(context); } diff --git a/flang/lib/Semantics/check-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp index 5e46960..db08977 100644 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "check-deallocate.h" +#include "definable.h" #include "flang/Evaluate/type.h" #include "flang/Parser/message.h" #include "flang/Parser/parse-tree.h" @@ -26,26 +27,44 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { // already reported an error } else if (!IsVariableName(*symbol)) { context_.Say(name.source, - "name in DEALLOCATE statement must be a variable name"_err_en_US); + "Name in DEALLOCATE statement must be a variable name"_err_en_US); } else if (!IsAllocatableOrPointer( symbol->GetUltimate())) { // C932 context_.Say(name.source, - "name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + "Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + } else if (auto whyNot{WhyNotDefinable(name.source, + context_.FindScope(name.source), + {DefinabilityFlag::PointerDefinition, + DefinabilityFlag::AcceptAllocatable}, + *symbol)}) { + context_ + .Say(name.source, + "Name in DEALLOCATE statement is not definable"_err_en_US) + .Attach(std::move(*whyNot)); } else if (CheckPolymorphism(name.source, *symbol)) { context_.CheckIndexVarRedefine(name); } }, [&](const parser::StructureComponent &structureComponent) { - // Only perform structureComponent checks it was successfully - // analyzed in expression analysis. - if (GetExpr(context_, allocateObject)) { + // Only perform structureComponent checks if it was successfully + // analyzed by expression analysis. + if (const auto *expr{GetExpr(context_, allocateObject)}) { if (const Symbol *symbol{structureComponent.component.symbol}) { + auto source{structureComponent.component.source}; if (!IsAllocatableOrPointer(*symbol)) { // C932 - context_.Say(structureComponent.component.source, - "component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + context_.Say(source, + "Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); + } else if (auto whyNot{WhyNotDefinable(source, + context_.FindScope(source), + {DefinabilityFlag::PointerDefinition, + DefinabilityFlag::AcceptAllocatable}, + *expr)}) { + context_ + .Say(source, + "Name in DEALLOCATE statement is not definable"_err_en_US) + .Attach(std::move(*whyNot)); } else { - CheckPolymorphism( - structureComponent.component.source, *symbol); + CheckPolymorphism(source, *symbol); } } } diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp index 06f96a2..092cfaf 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -70,12 +70,13 @@ static std::optional CheckDefinabilityInPureScope( // ptr1%ptr2 = ... -> ptr2 // ptr1%ptr2%nonptr = ... -> ptr2 // nonptr1%nonptr2 = ... -> nonptr1 -static const Symbol &GetRelevantSymbol( - const evaluate::DataRef &dataRef, bool isPointerDefinition) { +static const Symbol &GetRelevantSymbol(const evaluate::DataRef &dataRef, + bool isPointerDefinition, bool acceptAllocatable) { if (isPointerDefinition) { if (const auto *component{std::get_if(&dataRef.u)}) { - if (IsPointer(component->GetLastSymbol())) { - return GetRelevantSymbol(component->base(), false); + if (IsPointer(component->GetLastSymbol()) || + (acceptAllocatable && IsAllocatable(component->GetLastSymbol()))) { + return GetRelevantSymbol(component->base(), false, false); } } } @@ -91,6 +92,7 @@ static std::optional WhyNotDefinableBase(parser::CharBlock at, const Scope &scope, DefinabilityFlags flags, const Symbol &original) { const Symbol &ultimate{original.GetUltimate()}; bool isPointerDefinition{flags.test(DefinabilityFlag::PointerDefinition)}; + bool acceptAllocatable{flags.test(DefinabilityFlag::AcceptAllocatable)}; bool isTargetDefinition{!isPointerDefinition && IsPointer(ultimate)}; if (const auto *association{ultimate.detailsIf()}) { if (association->rank().has_value()) { @@ -103,8 +105,8 @@ static std::optional WhyNotDefinableBase(parser::CharBlock at, "Construct association '%s' has a vector subscript"_en_US, original); } else if (auto dataRef{evaluate::ExtractDataRef( *association->expr(), true, true)}) { - return WhyNotDefinableBase( - at, scope, flags, GetRelevantSymbol(*dataRef, isPointerDefinition)); + return WhyNotDefinableBase(at, scope, flags, + GetRelevantSymbol(*dataRef, isPointerDefinition, acceptAllocatable)); } } if (isTargetDefinition) { @@ -139,7 +141,12 @@ static std::optional WhyNotDefinableLast(parser::CharBlock at, const Scope &scope, DefinabilityFlags flags, const Symbol &original) { const Symbol &ultimate{original.GetUltimate()}; if (flags.test(DefinabilityFlag::PointerDefinition)) { - if (!IsPointer(ultimate)) { + if (flags.test(DefinabilityFlag::AcceptAllocatable)) { + if (!IsAllocatableOrPointer(ultimate)) { + return BlameSymbol( + at, "'%s' is neither a pointer nor an allocatable"_en_US, original); + } + } else if (!IsPointer(ultimate)) { return BlameSymbol(at, "'%s' is not a pointer"_en_US, original); } return std::nullopt; // pointer assignment - skip following checks @@ -173,8 +180,9 @@ static std::optional WhyNotDefinableLast(parser::CharBlock at, static std::optional WhyNotDefinable(parser::CharBlock at, const Scope &scope, DefinabilityFlags flags, const evaluate::DataRef &dataRef) { - const Symbol &base{GetRelevantSymbol( - dataRef, flags.test(DefinabilityFlag::PointerDefinition))}; + const Symbol &base{GetRelevantSymbol(dataRef, + flags.test(DefinabilityFlag::PointerDefinition), + flags.test(DefinabilityFlag::AcceptAllocatable))}; if (auto whyNot{WhyNotDefinableBase(at, scope, flags, base)}) { return whyNot; } else { @@ -187,7 +195,7 @@ static std::optional WhyNotDefinable(parser::CharBlock at, const Scope &scope, DefinabilityFlags flags, const evaluate::Component &component) { const evaluate::DataRef &dataRef{component.base()}; - const Symbol &base{GetRelevantSymbol(dataRef, false)}; + const Symbol &base{GetRelevantSymbol(dataRef, false, false)}; DefinabilityFlags baseFlags{flags}; baseFlags.reset(DefinabilityFlag::PointerDefinition); return WhyNotDefinableBase(at, scope, baseFlags, base); diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h index e4c94e3..374ea38 100644 --- a/flang/lib/Semantics/definable.h +++ b/flang/lib/Semantics/definable.h @@ -28,6 +28,7 @@ class Scope; ENUM_CLASS(DefinabilityFlag, VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment) PointerDefinition, // a pointer is being defined, not its target + AcceptAllocatable, // treat allocatable as if it were a pointer PolymorphicOkInPure) // don't check for polymorphic type in pure subprogram using DefinabilityFlags = diff --git a/flang/test/Semantics/allocate13.f90 b/flang/test/Semantics/allocate13.f90 index fe23c57..27097ba 100644 --- a/flang/test/Semantics/allocate13.f90 +++ b/flang/test/Semantics/allocate13.f90 @@ -171,3 +171,23 @@ subroutine C948_b() allocate(team[*], SOURCE=teamsrc) allocate(lock[*], SOURCE=locksrc) end subroutine + +module prot + real, pointer, protected :: pp + real, allocatable, protected :: pa +end module +subroutine prottest + use prot + !ERROR: Name in ALLOCATE statement is not definable + !BECAUSE: 'pp' is protected in this scope + allocate(pp) + !ERROR: Name in ALLOCATE statement is not definable + !BECAUSE: 'pa' is protected in this scope + allocate(pa) + !ERROR: Name in DEALLOCATE statement is not definable + !BECAUSE: 'pp' is protected in this scope + deallocate(pp) + !ERROR: Name in DEALLOCATE statement is not definable + !BECAUSE: 'pa' is protected in this scope + deallocate(pa) +end subroutine diff --git a/flang/test/Semantics/deallocate05.f90 b/flang/test/Semantics/deallocate05.f90 index 7d58350..bdc6998 100644 --- a/flang/test/Semantics/deallocate05.f90 +++ b/flang/test/Semantics/deallocate05.f90 @@ -32,27 +32,27 @@ Deallocate(rp) Allocate(x(3)) -!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute Deallocate(x(2)%p) -!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute Deallocate(pi) -!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute -!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute Deallocate(x(2)%p, pi) -!ERROR: name in DEALLOCATE statement must be a variable name +!ERROR: Name in DEALLOCATE statement must be a variable name Deallocate(prp) -!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute -!ERROR: name in DEALLOCATE statement must be a variable name +!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Name in DEALLOCATE statement must be a variable name Deallocate(pi, prp) -!ERROR: name in DEALLOCATE statement must be a variable name +!ERROR: Name in DEALLOCATE statement must be a variable name Deallocate(maxvalue) -!ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute Deallocate(x%p) !ERROR: STAT may not be duplicated in a DEALLOCATE statement diff --git a/flang/test/Semantics/deallocate06.f90 b/flang/test/Semantics/deallocate06.f90 index 16ae9f9..dda9ee8 100644 --- a/flang/test/Semantics/deallocate06.f90 +++ b/flang/test/Semantics/deallocate06.f90 @@ -19,7 +19,7 @@ contains deallocate(b) deallocate(c) deallocate(d) - !ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute + !ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute deallocate(e) end subroutine end diff --git a/flang/test/Semantics/dosemantics12.f90 b/flang/test/Semantics/dosemantics12.f90 index fc13aea..3adf310 100644 --- a/flang/test/Semantics/dosemantics12.f90 +++ b/flang/test/Semantics/dosemantics12.f90 @@ -369,7 +369,7 @@ subroutine s11() ! fails because you can only deallocate a variable that's allocatable. do concurrent (ivar = 1:10) print *, "hello" -!ERROR: name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute +!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute deallocate(ivar) end do @@ -429,7 +429,7 @@ subroutine s13() jvar = intentOutFunc(ivar) end do - ! Error for passing a DO variable to an INTENT(OUT) dummy, more complex + ! Error for passing a DO variable to an INTENT(OUT) dummy, more complex ! expression do ivar = 1, 10 !ERROR: Cannot redefine DO variable 'ivar' -- 2.7.4