[flang-commits] [flang] fb792eb - [flang] Apply definability checks in ALLOCATE/DEALLOCATE statements
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sat Dec 17 09:46:28 PST 2022
Author: Peter Klausler
Date: 2022-12-17T09:46:16-08:00
New Revision: fb792ebaf2114ad11d673cf891ae560e2e604711
URL: https://github.com/llvm/llvm-project/commit/fb792ebaf2114ad11d673cf891ae560e2e604711
DIFF: https://github.com/llvm/llvm-project/commit/fb792ebaf2114ad11d673cf891ae560e2e604711.diff
LOG: [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
Added:
Modified:
flang/lib/Semantics/check-allocate.cpp
flang/lib/Semantics/check-deallocate.cpp
flang/lib/Semantics/definable.cpp
flang/lib/Semantics/definable.h
flang/test/Semantics/allocate13.f90
flang/test/Semantics/deallocate05.f90
flang/test/Semantics/deallocate06.f90
flang/test/Semantics/dosemantics12.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index ce81ca1a2a07..c397c9f0a778 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 5e46960e3350..db089776b77a 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 06f96a2dcf07..092cfaf4ae46 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -70,12 +70,13 @@ static std::optional<parser::Message> 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<evaluate::Component>(&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<parser::Message> 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<AssocEntityDetails>()}) {
if (association->rank().has_value()) {
@@ -103,8 +105,8 @@ static std::optional<parser::Message> 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<parser::Message> 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<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
static std::optional<parser::Message> 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<parser::Message> 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 e4c94e3d7c5a..374ea38451ac 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 fe23c57e11e7..27097ba85e67 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 7d58350bdd28..bdc699809406 100644
--- a/flang/test/Semantics/deallocate05.f90
+++ b/flang/test/Semantics/deallocate05.f90
@@ -32,27 +32,27 @@ Program deallocatetest
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 16ae9f9146a8..dda9ee80db70 100644
--- a/flang/test/Semantics/deallocate06.f90
+++ b/flang/test/Semantics/deallocate06.f90
@@ -19,7 +19,7 @@ subroutine s2()
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 fc13aeaf3e04..3adf31005126 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'
More information about the flang-commits
mailing list