[flang-commits] [flang] 82ecbeb - [flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement (#164529)
via flang-commits
flang-commits at lists.llvm.org
Fri Oct 31 10:26:32 PDT 2025
Author: Andre Kuhlenschmidt
Date: 2025-10-31T10:26:27-07:00
New Revision: 82ecbeb278edfbe4015d2f0a62eb92ddc2d674b2
URL: https://github.com/llvm/llvm-project/commit/82ecbeb278edfbe4015d2f0a62eb92ddc2d674b2
DIFF: https://github.com/llvm/llvm-project/commit/82ecbeb278edfbe4015d2f0a62eb92ddc2d674b2.diff
LOG: [flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement (#164529)
Almost all compilers statically error on the following case even though
it isn't a numbered constraint. Now we do to instead segfaulting at
runtime.
```fortran
integer,pointer:: i
allocate(i,stat=i)
end
```
Added:
flang/test/Semantics/allocate14.f90
Modified:
flang/lib/Semantics/check-allocate.cpp
flang/lib/Semantics/check-allocate.h
flang/lib/Semantics/check-deallocate.cpp
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index e019bbdfa27f6..a411e20557456 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -26,6 +26,10 @@ struct AllocateCheckerInfo {
std::optional<evaluate::DynamicType> sourceExprType;
std::optional<parser::CharBlock> sourceExprLoc;
std::optional<parser::CharBlock> typeSpecLoc;
+ std::optional<parser::CharBlock> statSource;
+ std::optional<parser::CharBlock> msgSource;
+ const SomeExpr *statVar{nullptr};
+ const SomeExpr *msgVar{nullptr};
int sourceExprRank{0}; // only valid if gotMold || gotSource
bool gotStat{false};
bool gotMsg{false};
@@ -141,12 +145,15 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
[&](const parser::StatOrErrmsg &statOrErr) {
common::visit(
common::visitors{
- [&](const parser::StatVariable &) {
+ [&](const parser::StatVariable &var) {
if (info.gotStat) { // C943
context.Say(
"STAT may not be duplicated in a ALLOCATE statement"_err_en_US);
}
info.gotStat = true;
+ info.statVar = GetExpr(context, var);
+ info.statSource =
+ parser::Unwrap<parser::Variable>(var)->GetSource();
},
[&](const parser::MsgVariable &var) {
WarnOnDeferredLengthCharacterScalar(context,
@@ -159,6 +166,9 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
"ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
}
info.gotMsg = true;
+ info.msgVar = GetExpr(context, var);
+ info.msgSource =
+ parser::Unwrap<parser::Variable>(var)->GetSource();
},
},
statOrErr.u);
@@ -460,6 +470,16 @@ static bool HaveCompatibleLengths(
}
}
+bool AreSameAllocation(const SomeExpr *root, const SomeExpr *path) {
+ if (root && path) {
+ // For now we just use equality of expressions. If we implement a more
+ // sophisticated alias analysis we should use it here.
+ return *root == *path;
+ } else {
+ return false;
+ }
+}
+
bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
if (!ultimate_) {
CHECK(context.AnyFatalError());
@@ -690,6 +710,17 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
"Object in ALLOCATE must have DEVICE attribute when STREAM option is specified"_err_en_US);
}
}
+
+ if (const SomeExpr *allocObj{GetExpr(context, allocateObject_)}) {
+ if (AreSameAllocation(allocObj, allocateInfo_.statVar)) {
+ context.Say(allocateInfo_.statSource.value_or(name_.source),
+ "STAT variable in ALLOCATE must not be the variable being allocated"_err_en_US);
+ }
+ if (AreSameAllocation(allocObj, allocateInfo_.msgVar)) {
+ context.Say(allocateInfo_.msgSource.value_or(name_.source),
+ "ERRMSG variable in ALLOCATE must not be the variable being allocated"_err_en_US);
+ }
+ }
return RunCoarrayRelatedChecks(context);
}
diff --git a/flang/lib/Semantics/check-allocate.h b/flang/lib/Semantics/check-allocate.h
index e3f7f07bca5b7..54f7380bc3fe8 100644
--- a/flang/lib/Semantics/check-allocate.h
+++ b/flang/lib/Semantics/check-allocate.h
@@ -24,5 +24,6 @@ class AllocateChecker : public virtual BaseChecker {
private:
SemanticsContext &context_;
};
+bool AreSameAllocation(const SomeExpr *root, const SomeExpr *path);
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_CHECK_ALLOCATE_H_
diff --git a/flang/lib/Semantics/check-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp
index c1ebc5f4c0ec2..e6ce1b30a59f5 100644
--- a/flang/lib/Semantics/check-deallocate.cpp
+++ b/flang/lib/Semantics/check-deallocate.cpp
@@ -7,51 +7,87 @@
//===----------------------------------------------------------------------===//
#include "check-deallocate.h"
+#include "check-allocate.h"
#include "definable.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/tools.h"
+#include <optional>
namespace Fortran::semantics {
void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
+ bool gotStat{false}, gotMsg{false};
+ const SomeExpr *statVar{nullptr}, *msgVar{nullptr};
+ std::optional<parser::CharBlock> statSource;
+ std::optional<parser::CharBlock> msgSource;
+ for (const parser::StatOrErrmsg &deallocOpt :
+ std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
+ common::visit(
+ common::visitors{
+ [&](const parser::StatVariable &var) {
+ if (gotStat) {
+ context_.Say(
+ "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
+ }
+ gotStat = true;
+ statVar = GetExpr(context_, var);
+ statSource = parser::Unwrap<parser::Variable>(var)->GetSource();
+ },
+ [&](const parser::MsgVariable &var) {
+ WarnOnDeferredLengthCharacterScalar(context_,
+ GetExpr(context_, var),
+ parser::UnwrapRef<parser::Variable>(var).GetSource(),
+ "ERRMSG=");
+ if (gotMsg) {
+ context_.Say(
+ "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
+ }
+ gotMsg = true;
+ msgVar = GetExpr(context_, var);
+ msgSource = parser::Unwrap<parser::Variable>(var)->GetSource();
+ },
+ },
+ deallocOpt.u);
+ }
for (const parser::AllocateObject &allocateObject :
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
+ parser::CharBlock source;
common::visit(
common::visitors{
[&](const parser::Name &name) {
const Symbol *symbol{
name.symbol ? &name.symbol->GetUltimate() : nullptr};
- ;
+ source = name.source;
if (context_.HasError(symbol)) {
// already reported an error
} else if (!IsVariableName(*symbol)) {
- context_.Say(name.source,
+ context_.Say(source,
"Name in DEALLOCATE statement must be a variable name"_err_en_US);
} else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
- context_.Say(name.source,
+ context_.Say(source,
"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,
- DefinabilityFlag::PotentialDeallocation},
- *symbol)}) {
+ } else if (auto whyNot{
+ WhyNotDefinable(source, context_.FindScope(source),
+ {DefinabilityFlag::PointerDefinition,
+ DefinabilityFlag::AcceptAllocatable,
+ DefinabilityFlag::PotentialDeallocation},
+ *symbol)}) {
// Catch problems with non-definability of the
// pointer/allocatable
context_
- .Say(name.source,
+ .Say(source,
"Name in DEALLOCATE statement is not definable"_err_en_US)
.Attach(std::move(
whyNot->set_severity(parser::Severity::Because)));
- } else if (auto whyNot{WhyNotDefinable(name.source,
- context_.FindScope(name.source),
- DefinabilityFlags{}, *symbol)}) {
+ } else if (auto whyNot{
+ WhyNotDefinable(source, context_.FindScope(source),
+ DefinabilityFlags{}, *symbol)}) {
// Catch problems with non-definability of the dynamic object
context_
- .Say(name.source,
+ .Say(source,
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
.Attach(std::move(
whyNot->set_severity(parser::Severity::Because)));
@@ -62,13 +98,12 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
[&](const parser::StructureComponent &structureComponent) {
// Only perform structureComponent checks if it was successfully
// analyzed by expression analysis.
- auto source{structureComponent.component.source};
+ source = structureComponent.component.source;
if (const auto *expr{GetExpr(context_, allocateObject)}) {
- if (const Symbol *
- symbol{structureComponent.component.symbol
- ? &structureComponent.component.symbol
- ->GetUltimate()
- : nullptr};
+ if (const Symbol *symbol{structureComponent.component.symbol
+ ? &structureComponent.component.symbol
+ ->GetUltimate()
+ : nullptr};
!IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
context_.Say(source,
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
@@ -99,32 +134,16 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
},
},
allocateObject.u);
- }
- bool gotStat{false}, gotMsg{false};
- for (const parser::StatOrErrmsg &deallocOpt :
- std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
- common::visit(
- common::visitors{
- [&](const parser::StatVariable &) {
- if (gotStat) {
- context_.Say(
- "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
- }
- gotStat = true;
- },
- [&](const parser::MsgVariable &var) {
- WarnOnDeferredLengthCharacterScalar(context_,
- GetExpr(context_, var),
- parser::UnwrapRef<parser::Variable>(var).GetSource(),
- "ERRMSG=");
- if (gotMsg) {
- context_.Say(
- "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
- }
- gotMsg = true;
- },
- },
- deallocOpt.u);
+ if (const SomeExpr *allocObj{GetExpr(context_, allocateObject)}) {
+ if (AreSameAllocation(allocObj, statVar)) {
+ context_.Say(statSource.value_or(source),
+ "STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
+ }
+ if (AreSameAllocation(allocObj, msgVar)) {
+ context_.Say(msgSource.value_or(source),
+ "ERRMSG variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
+ }
+ }
}
}
diff --git a/flang/test/Semantics/allocate14.f90 b/flang/test/Semantics/allocate14.f90
new file mode 100644
index 0000000000000..a97cf5ad88b08
--- /dev/null
+++ b/flang/test/Semantics/allocate14.f90
@@ -0,0 +1,56 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors in ALLOCATE statements
+
+program allocate14
+
+ integer, allocatable :: i1, i2
+ character(200), allocatable :: msg1, msg2
+ type t
+ integer, allocatable :: i
+ character(10), allocatable :: msg
+ end type t
+ type(t) :: tt(2)
+ type(t), allocatable :: ts(:)
+
+ allocate(i1)
+ allocate(msg1)
+
+ allocate(i2, stat=i1, errmsg=msg1)
+ allocate(msg2, stat=i1, errmsg=msg1)
+ deallocate(i2, stat=i1, errmsg=msg1)
+ deallocate(msg2, stat=i1, errmsg=msg1)
+
+ !ERROR: STAT variable in ALLOCATE must not be the variable being allocated
+ allocate(i2, stat=i2, errmsg=msg2)
+ !ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated
+ allocate(msg2, stat=i2, errmsg=msg2)
+ !ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated
+ deallocate(i2, stat=i2, errmsg=msg2)
+ !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
+ deallocate(msg2, stat=i2, errmsg=msg2)
+
+ allocate(tt(1)%i)
+ allocate(tt(1)%msg)
+
+ allocate(tt(2)%i, stat=tt(1)%i, errmsg=tt(1)%msg)
+ allocate(tt(2)%msg, stat=tt(1)%i, errmsg=tt(1)%msg)
+ deallocate(tt(2)%i, stat=tt(1)%i, errmsg=tt(1)%msg)
+ deallocate(tt(2)%msg, stat=tt(1)%i, errmsg=tt(1)%msg)
+
+ !ERROR: STAT variable in ALLOCATE must not be the variable being allocated
+ allocate(tt(2)%i, stat=tt(2)%i, errmsg=tt(2)%msg)
+ !ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated
+ allocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg)
+ !ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated
+ deallocate(tt(2)%i, stat=tt(2)%i, errmsg=tt(2)%msg)
+ !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
+ deallocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg)
+
+ !TODO: STAT variable in ALLOCATE must not be the variable being allocated
+ !TODO: ERRMSG variable in ALLOCATE must not be the variable being allocated
+ allocate(ts(10), stat=ts(1)%i, errmsg=ts(1)%msg)
+ !TODO: STAT variable in DEALLOCATE must not be the variable being deallocated
+ !TODO: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
+ deallocate(ts, stat=ts(1)%i, errmsg=ts(1)%msg)
+end program
+
More information about the flang-commits
mailing list