From f86d02684aa243bb82075e8b3e307ed4f1c8dded Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Tue, 21 Oct 2025 18:21:31 -0700 Subject: [PATCH 1/8] initial commit --- flang/lib/Semantics/check-allocate.cpp | 26 +++++- flang/lib/Semantics/check-deallocate.cpp | 104 ++++++++++++++--------- flang/test/Semantics/allocate14.f90 | 25 ++++++ 3 files changed, 114 insertions(+), 41 deletions(-) create mode 100644 flang/test/Semantics/allocate14.f90 diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index e019bbdfa27f6..517063d3dd00b 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -26,6 +26,8 @@ struct AllocateCheckerInfo { std::optional sourceExprType; std::optional sourceExprLoc; std::optional typeSpecLoc; + const parser::Name *statVar{nullptr}; + const parser::Name *msgVar{nullptr}; int sourceExprRank{0}; // only valid if gotMold || gotSource bool gotStat{false}; bool gotMsg{false}; @@ -141,11 +143,15 @@ static std::optional 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); } + if (const auto *designator{ + parser::Unwrap(var)}) { + info.statVar = &parser::GetLastName(*designator); + } info.gotStat = true; }, [&](const parser::MsgVariable &var) { @@ -158,6 +164,10 @@ static std::optional CheckAllocateOptions( context.Say( "ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US); } + if (const auto *designator{ + parser::Unwrap(var)}) { + info.msgVar = &parser::GetLastName(*designator); + } info.gotMsg = true; }, }, @@ -690,6 +700,20 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { "Object in ALLOCATE must have DEVICE attribute when STREAM option is specified"_err_en_US); } } + if (allocateInfo_.gotStat && allocateInfo_.statVar) { + if (const Symbol *symbol{allocateInfo_.statVar->symbol}; + symbol && *ultimate_ == symbol->GetUltimate()) { + context.Say(allocateInfo_.statVar->source, + "STAT variable in ALLOCATE must not be the variable being allocated"_err_en_US); + } + } + if (allocateInfo_.gotMsg && allocateInfo_.msgVar) { + if (const Symbol *symbol{allocateInfo_.msgVar->symbol}; + symbol && *ultimate_ == symbol->GetUltimate()) { + context.Say(allocateInfo_.msgVar->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-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp index c1ebc5f4c0ec2..d31793fa31c8b 100644 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -17,20 +17,56 @@ namespace Fortran::semantics { void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { + bool gotStat{false}, gotMsg{false}; + const parser::Name *statVar{nullptr}, *msgVar{nullptr}; + for (const parser::StatOrErrmsg &deallocOpt : + std::get>(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); + } + if (const auto *designator{ + parser::Unwrap(var)}) { + statVar = &parser::GetLastName(*designator); + } + gotStat = true; + }, + [&](const parser::MsgVariable &var) { + WarnOnDeferredLengthCharacterScalar(context_, + GetExpr(context_, var), + parser::UnwrapRef(var).GetSource(), + "ERRMSG="); + if (gotMsg) { + context_.Say( + "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US); + } + if (const auto *designator{ + parser::Unwrap(var)}) { + msgVar = &parser::GetLastName(*designator); + } + gotMsg = true; + }, + }, + deallocOpt.u); + } for (const parser::AllocateObject &allocateObject : std::get>(deallocateStmt.t)) { + const Symbol *ultimate{nullptr}; common::visit( common::visitors{ [&](const parser::Name &name) { - const Symbol *symbol{ - name.symbol ? &name.symbol->GetUltimate() : nullptr}; - ; - if (context_.HasError(symbol)) { + if (name.symbol) { + ultimate = &name.symbol->GetUltimate(); + } + if (context_.HasError(ultimate)) { // already reported an error - } else if (!IsVariableName(*symbol)) { + } else if (!IsVariableName(*ultimate)) { context_.Say(name.source, "Name in DEALLOCATE statement must be a variable name"_err_en_US); - } else if (!IsAllocatableOrObjectPointer(symbol)) { // C936 + } else if (!IsAllocatableOrObjectPointer(ultimate)) { // C936 context_.Say(name.source, "Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); } else if (auto whyNot{WhyNotDefinable(name.source, @@ -38,7 +74,7 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { {DefinabilityFlag::PointerDefinition, DefinabilityFlag::AcceptAllocatable, DefinabilityFlag::PotentialDeallocation}, - *symbol)}) { + *ultimate)}) { // Catch problems with non-definability of the // pointer/allocatable context_ @@ -48,7 +84,7 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { whyNot->set_severity(parser::Severity::Because))); } else if (auto whyNot{WhyNotDefinable(name.source, context_.FindScope(name.source), - DefinabilityFlags{}, *symbol)}) { + DefinabilityFlags{}, *ultimate)}) { // Catch problems with non-definability of the dynamic object context_ .Say(name.source, @@ -63,13 +99,11 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { // Only perform structureComponent checks if it was successfully // analyzed by expression analysis. auto source{structureComponent.component.source}; + if (structureComponent.component.symbol) { + ultimate = &structureComponent.component.symbol->GetUltimate(); + } if (const auto *expr{GetExpr(context_, allocateObject)}) { - if (const Symbol * - symbol{structureComponent.component.symbol - ? &structureComponent.component.symbol - ->GetUltimate() - : nullptr}; - !IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936 + if (!IsAllocatableOrObjectPointer(ultimate)) { // F'2023 C936 context_.Say(source, "Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US); } else if (auto whyNot{WhyNotDefinable(source, @@ -99,32 +133,22 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { }, }, allocateObject.u); - } - bool gotStat{false}, gotMsg{false}; - for (const parser::StatOrErrmsg &deallocOpt : - std::get>(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(var).GetSource(), - "ERRMSG="); - if (gotMsg) { - context_.Say( - "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US); - } - gotMsg = true; - }, - }, - deallocOpt.u); + if (ultimate) { + if (gotStat && statVar) { + if (const Symbol *symbol{statVar->symbol}; + symbol && *ultimate == symbol->GetUltimate()) { + context_.Say(statVar->source, + "STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); + } + } + if (gotMsg && msgVar) { + if (const Symbol *symbol{msgVar->symbol}; + symbol && *ultimate == symbol->GetUltimate()) { + context_.Say(msgVar->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..02bab1a8c6040 --- /dev/null +++ b/flang/test/Semantics/allocate14.f90 @@ -0,0 +1,25 @@ +! 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 + + 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) +end program + From be2135b10aa71c24f16e29818cd699daaf6b7372 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 22 Oct 2025 14:58:48 -0700 Subject: [PATCH 2/8] address feedback --- flang/lib/Semantics/check-allocate.cpp | 34 ++++----- flang/lib/Semantics/check-deallocate.cpp | 88 +++++++++++------------- flang/test/Semantics/allocate14.f90 | 31 +++++++++ 3 files changed, 87 insertions(+), 66 deletions(-) diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index 517063d3dd00b..0490e500760c6 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -26,8 +26,10 @@ struct AllocateCheckerInfo { std::optional sourceExprType; std::optional sourceExprLoc; std::optional typeSpecLoc; - const parser::Name *statVar{nullptr}; - const parser::Name *msgVar{nullptr}; + std::optional statSource; + std::optional msgSource; + const SomeExpr *statVar{nullptr}; + const SomeExpr *msgVar{nullptr}; int sourceExprRank{0}; // only valid if gotMold || gotSource bool gotStat{false}; bool gotMsg{false}; @@ -148,11 +150,10 @@ static std::optional CheckAllocateOptions( context.Say( "STAT may not be duplicated in a ALLOCATE statement"_err_en_US); } - if (const auto *designator{ - parser::Unwrap(var)}) { - info.statVar = &parser::GetLastName(*designator); - } info.gotStat = true; + info.statVar = GetExpr(context, var); + info.statSource = + parser::Unwrap(var)->GetSource(); }, [&](const parser::MsgVariable &var) { WarnOnDeferredLengthCharacterScalar(context, @@ -164,11 +165,10 @@ static std::optional CheckAllocateOptions( context.Say( "ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US); } - if (const auto *designator{ - parser::Unwrap(var)}) { - info.msgVar = &parser::GetLastName(*designator); - } info.gotMsg = true; + info.msgVar = GetExpr(context, var); + info.msgSource = + parser::Unwrap(var)->GetSource(); }, }, statOrErr.u); @@ -700,17 +700,13 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { "Object in ALLOCATE must have DEVICE attribute when STREAM option is specified"_err_en_US); } } - if (allocateInfo_.gotStat && allocateInfo_.statVar) { - if (const Symbol *symbol{allocateInfo_.statVar->symbol}; - symbol && *ultimate_ == symbol->GetUltimate()) { - context.Say(allocateInfo_.statVar->source, + if (const SomeExpr *allocObj{GetExpr(context, allocateObject_)}) { + if (allocateInfo_.statVar && *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 (allocateInfo_.gotMsg && allocateInfo_.msgVar) { - if (const Symbol *symbol{allocateInfo_.msgVar->symbol}; - symbol && *ultimate_ == symbol->GetUltimate()) { - context.Say(allocateInfo_.msgVar->source, + if (allocateInfo_.msgVar && *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); } } diff --git a/flang/lib/Semantics/check-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp index d31793fa31c8b..51c048c56c6a2 100644 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -13,12 +13,15 @@ #include "flang/Parser/parse-tree.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/tools.h" +#include namespace Fortran::semantics { void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { bool gotStat{false}, gotMsg{false}; - const parser::Name *statVar{nullptr}, *msgVar{nullptr}; + const SomeExpr *statVar{nullptr}, *msgVar{nullptr}; + std::optional statSource; + std::optional msgSource; for (const parser::StatOrErrmsg &deallocOpt : std::get>(deallocateStmt.t)) { common::visit( @@ -28,11 +31,9 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { context_.Say( "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US); } - if (const auto *designator{ - parser::Unwrap(var)}) { - statVar = &parser::GetLastName(*designator); - } gotStat = true; + statVar = GetExpr(context_, var); + statSource = parser::Unwrap(var)->GetSource(); }, [&](const parser::MsgVariable &var) { WarnOnDeferredLengthCharacterScalar(context_, @@ -43,51 +44,49 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { context_.Say( "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US); } - if (const auto *designator{ - parser::Unwrap(var)}) { - msgVar = &parser::GetLastName(*designator); - } gotMsg = true; + msgVar = GetExpr(context_, var); + msgSource = parser::Unwrap(var)->GetSource(); }, }, deallocOpt.u); } for (const parser::AllocateObject &allocateObject : std::get>(deallocateStmt.t)) { - const Symbol *ultimate{nullptr}; + parser::CharBlock source; common::visit( common::visitors{ [&](const parser::Name &name) { - if (name.symbol) { - ultimate = &name.symbol->GetUltimate(); - } - if (context_.HasError(ultimate)) { + const Symbol *symbol{ + name.symbol ? &name.symbol->GetUltimate() : nullptr}; + source = name.source; + if (context_.HasError(symbol)) { // already reported an error - } else if (!IsVariableName(*ultimate)) { - context_.Say(name.source, + } else if (!IsVariableName(*symbol)) { + context_.Say(source, "Name in DEALLOCATE statement must be a variable name"_err_en_US); - } else if (!IsAllocatableOrObjectPointer(ultimate)) { // C936 - context_.Say(name.source, + } else if (!IsAllocatableOrObjectPointer(symbol)) { // C936 + 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}, - *ultimate)}) { + } 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{}, *ultimate)}) { + } 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))); @@ -98,12 +97,13 @@ 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}; - if (structureComponent.component.symbol) { - ultimate = &structureComponent.component.symbol->GetUltimate(); - } + source = structureComponent.component.source; if (const auto *expr{GetExpr(context_, allocateObject)}) { - if (!IsAllocatableOrObjectPointer(ultimate)) { // F'2023 C936 + 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); } else if (auto whyNot{WhyNotDefinable(source, @@ -133,20 +133,14 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { }, }, allocateObject.u); - if (ultimate) { - if (gotStat && statVar) { - if (const Symbol *symbol{statVar->symbol}; - symbol && *ultimate == symbol->GetUltimate()) { - context_.Say(statVar->source, - "STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); - } + if (const SomeExpr *allocObj{GetExpr(context_, allocateObject)}) { + if (statVar && *allocObj == *statVar) { + context_.Say(statSource.value_or(source), + "STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); } - if (gotMsg && msgVar) { - if (const Symbol *symbol{msgVar->symbol}; - symbol && *ultimate == symbol->GetUltimate()) { - context_.Say(msgVar->source, - "ERRMSG variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); - } + if (msgVar && *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 index 02bab1a8c6040..231e69250cf74 100644 --- a/flang/test/Semantics/allocate14.f90 +++ b/flang/test/Semantics/allocate14.f90 @@ -2,8 +2,15 @@ ! 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) @@ -21,5 +28,29 @@ program allocate14 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) + + !FIXME: STAT variable in ALLOCATE must not be the variable being allocated + !FIXME: ERRMSG variable in ALLOCATE must not be the variable being allocated + allocate(ts(10), stat=ts(1)%i, errmsg=ts(1)%msg) + !FIXME: STAT variable in DEALLOCATE must not be the variable being deallocated + !FIXME: ERRMSG variable in DEALLOCATE must not be the variable being deallocated + deallocate(ts, stat=ts(1)%i, errmsg=ts(1)%msg) end program From 12b2fa2e11b966a45ade7a091190cfa09ccc2add Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Thu, 23 Oct 2025 18:11:42 -0700 Subject: [PATCH 3/8] handle base that is allocation --- flang/docs/ImplementingASemanticCheck.md | 2 +- flang/include/flang/Evaluate/variable.h | 4 +- flang/lib/Evaluate/variable.cpp | 59 ++++++++++++++++++++++++ flang/lib/Semantics/check-allocate.cpp | 28 ++++++++++- flang/lib/Semantics/check-allocate.h | 1 + flang/lib/Semantics/check-deallocate.cpp | 5 +- flang/test/Semantics/allocate14.f90 | 8 ++-- 7 files changed, 96 insertions(+), 11 deletions(-) diff --git a/flang/docs/ImplementingASemanticCheck.md b/flang/docs/ImplementingASemanticCheck.md index 598ef696ad14b..62f4d06350ece 100644 --- a/flang/docs/ImplementingASemanticCheck.md +++ b/flang/docs/ImplementingASemanticCheck.md @@ -775,7 +775,7 @@ to make sure that the names were clear. Here's what I ended up with: ```C++ void DoChecker::Leave(const parser::Expr &parsedExpr) { - ActualArgumentSet argSet{CollectActualArguments(GetExpr(parsedExpr))}; + ActualArgumentSet argSet{CollectActualArguments((parsedExpr))}; for (const evaluate::ActualArgumentRef &argRef : argSet) { if (const SomeExpr * argExpr{argRef->UnwrapExpr()}) { if (const Symbol * var{evaluate::UnwrapWholeSymbolDataRef(*argExpr)}) { diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h index 5c14421fd3a1b..2e2a21cd78ebd 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -289,7 +289,7 @@ struct DataRef { const Symbol &GetLastSymbol() const; std::optional> LEN() const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; - + bool IsPathFrom(const DataRef &) const; std::variant u; }; @@ -400,7 +400,7 @@ template class Designator { const Symbol *GetLastSymbol() const; std::optional> LEN() const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &o) const; - + bool IsPathFrom(const Designator &) const; Variant u; }; diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index b9b34d4d5bc89..25b53ea67c2f3 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -751,6 +751,65 @@ bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const { return field_ == that.field_ && base_ == that.base_ && dimension_ == that.dimension_; } +#include +#include +template struct has_union : std::false_type {}; +template +struct has_union> : std::true_type {}; +template struct has_base : std::false_type {}; +template +struct has_base().base())>> + : std::true_type {}; +template +struct has_GetFirstSymbol : std::false_type {}; +template +struct has_GetFirstSymbol().GetFirstSymbol())>> + : std::true_type {}; + +template +bool TestVariableIsPathFromRoot(const P &path, const R &root) { + const SymbolRef *pathSym, *rootSym; + if constexpr (has_union

::value) { + pathSym = std::get_if(&path.u); + } + if constexpr (has_union::value) { + rootSym = std::get_if(&root.u); + } + if (pathSym) { + return rootSym && AreSameSymbol(*rootSym, *pathSym); + } + if constexpr (has_GetFirstSymbol

::value) { + if (rootSym) { + return AreSameSymbol(path.GetFirstSymbol(), *rootSym); + } + } + if constexpr (std::is_same_v) { + if (path == root) { + return true; + } + } + if constexpr (has_base

::value) { + return TestVariableIsPathFromRoot(path.base(), root); + } + if constexpr (has_union

::value) { + return common::visit( + common::visitors{ + [&](const auto &x) { return TestVariableIsPathFromRoot(x, root); }, + }, + path.u); + } + return false; +} + +bool DataRef::IsPathFrom(const DataRef &that) const { + return TestVariableIsPathFromRoot(*this, that); +} + +template +bool Designator::IsPathFrom(const Designator &that) const { + return TestVariableIsPathFromRoot(*this, that); +} #ifdef _MSC_VER // disable bogus warning about missing definitions #pragma warning(disable : 4661) diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index 0490e500760c6..19f91cb5fd0b2 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -470,6 +470,29 @@ static bool HaveCompatibleLengths( } } +bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path) { + if (root) { + if (std::optional rootRef{ExtractDataRef(root)}) { + if (path) { + if (std::optional pathRef{ExtractDataRef(path)}) { + if (pathRef->IsPathFrom(*rootRef)) { + return true; + } + } else { + if (*root == *path) { + return true; + } + } + } + } else { + if (path && *root == *path) { + return true; + } + } + } + return false; +} + bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { if (!ultimate_) { CHECK(context.AnyFatalError()); @@ -700,12 +723,13 @@ 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 (allocateInfo_.statVar && *allocObj == *allocateInfo_.statVar) { + if (IsSameAllocation(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 (allocateInfo_.msgVar && *allocObj == *allocateInfo_.msgVar) { + if (IsSameAllocation(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); } diff --git a/flang/lib/Semantics/check-allocate.h b/flang/lib/Semantics/check-allocate.h index e3f7f07bca5b7..da1d681a1923b 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 IsSameAllocation(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 51c048c56c6a2..a58ad3f9b46d2 100644 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -7,6 +7,7 @@ //===----------------------------------------------------------------------===// #include "check-deallocate.h" +#include "check-allocate.h" #include "definable.h" #include "flang/Evaluate/type.h" #include "flang/Parser/message.h" @@ -134,11 +135,11 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { }, allocateObject.u); if (const SomeExpr *allocObj{GetExpr(context_, allocateObject)}) { - if (statVar && *allocObj == *statVar) { + if (IsSameAllocation(allocObj, statVar)) { context_.Say(statSource.value_or(source), "STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); } - if (msgVar && *allocObj == *msgVar) { + if (IsSameAllocation(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 index 231e69250cf74..000b7c8ad5af2 100644 --- a/flang/test/Semantics/allocate14.f90 +++ b/flang/test/Semantics/allocate14.f90 @@ -46,11 +46,11 @@ program allocate14 !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated deallocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg) - !FIXME: STAT variable in ALLOCATE must not be the variable being allocated - !FIXME: ERRMSG variable in ALLOCATE must not be the variable being allocated + !ERROR: STAT variable in ALLOCATE must not be the variable being allocated + !ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated allocate(ts(10), stat=ts(1)%i, errmsg=ts(1)%msg) - !FIXME: STAT variable in DEALLOCATE must not be the variable being deallocated - !FIXME: ERRMSG variable in DEALLOCATE must not be the variable being deallocated + !ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated + !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated deallocate(ts, stat=ts(1)%i, errmsg=ts(1)%msg) end program From d0f21ea6588c0a6d650a8f4b968f0696fbb4846d Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Thu, 23 Oct 2025 19:16:40 -0700 Subject: [PATCH 4/8] explicitly null init pathSym and rootSym --- flang/lib/Evaluate/variable.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index 25b53ea67c2f3..16ec725276331 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -769,7 +769,7 @@ struct has_GetFirstSymbol bool TestVariableIsPathFromRoot(const P &path, const R &root) { - const SymbolRef *pathSym, *rootSym; + const SymbolRef *pathSym{nullptr}, *rootSym{nullptr}; if constexpr (has_union

::value) { pathSym = std::get_if(&path.u); } From 55699176625049b79f8bcc75bceaf8f3c7a63e22 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 29 Oct 2025 11:54:29 -0700 Subject: [PATCH 5/8] fixing random edit --- flang/docs/ImplementingASemanticCheck.md | 2 +- flang/lib/Evaluate/variable.cpp | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/flang/docs/ImplementingASemanticCheck.md b/flang/docs/ImplementingASemanticCheck.md index 62f4d06350ece..598ef696ad14b 100644 --- a/flang/docs/ImplementingASemanticCheck.md +++ b/flang/docs/ImplementingASemanticCheck.md @@ -775,7 +775,7 @@ to make sure that the names were clear. Here's what I ended up with: ```C++ void DoChecker::Leave(const parser::Expr &parsedExpr) { - ActualArgumentSet argSet{CollectActualArguments((parsedExpr))}; + ActualArgumentSet argSet{CollectActualArguments(GetExpr(parsedExpr))}; for (const evaluate::ActualArgumentRef &argRef : argSet) { if (const SomeExpr * argExpr{argRef->UnwrapExpr()}) { if (const Symbol * var{evaluate::UnwrapWholeSymbolDataRef(*argExpr)}) { diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index 16ec725276331..ad3ec13e59b53 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -811,6 +811,11 @@ bool Designator::IsPathFrom(const Designator &that) const { return TestVariableIsPathFromRoot(*this, that); } +template +optional Designator::IsSameEntity(const Designator &that) const { + return std::nullopt; +} + #ifdef _MSC_VER // disable bogus warning about missing definitions #pragma warning(disable : 4661) #endif From bd89b72487b5257953caa9042abfeef09cf24d65 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 29 Oct 2025 15:39:50 -0700 Subject: [PATCH 6/8] simplify --- flang/include/flang/Evaluate/variable.h | 4 +- flang/lib/Evaluate/variable.cpp | 64 ------------------- flang/lib/Semantics/check-allocate.cpp | 25 ++------ .../Semantics/OpenACC/acc-data-function.f90 | 19 ++++++ flang/test/Semantics/allocate14.f90 | 8 +-- 5 files changed, 31 insertions(+), 89 deletions(-) create mode 100644 flang/test/Semantics/OpenACC/acc-data-function.f90 diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h index 2e2a21cd78ebd..5c14421fd3a1b 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -289,7 +289,7 @@ struct DataRef { const Symbol &GetLastSymbol() const; std::optional> LEN() const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; - bool IsPathFrom(const DataRef &) const; + std::variant u; }; @@ -400,7 +400,7 @@ template class Designator { const Symbol *GetLastSymbol() const; std::optional> LEN() const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &o) const; - bool IsPathFrom(const Designator &) const; + Variant u; }; diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index ad3ec13e59b53..b9b34d4d5bc89 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -751,70 +751,6 @@ bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const { return field_ == that.field_ && base_ == that.base_ && dimension_ == that.dimension_; } -#include -#include -template struct has_union : std::false_type {}; -template -struct has_union> : std::true_type {}; -template struct has_base : std::false_type {}; -template -struct has_base().base())>> - : std::true_type {}; -template -struct has_GetFirstSymbol : std::false_type {}; -template -struct has_GetFirstSymbol().GetFirstSymbol())>> - : std::true_type {}; - -template -bool TestVariableIsPathFromRoot(const P &path, const R &root) { - const SymbolRef *pathSym{nullptr}, *rootSym{nullptr}; - if constexpr (has_union

::value) { - pathSym = std::get_if(&path.u); - } - if constexpr (has_union::value) { - rootSym = std::get_if(&root.u); - } - if (pathSym) { - return rootSym && AreSameSymbol(*rootSym, *pathSym); - } - if constexpr (has_GetFirstSymbol

::value) { - if (rootSym) { - return AreSameSymbol(path.GetFirstSymbol(), *rootSym); - } - } - if constexpr (std::is_same_v) { - if (path == root) { - return true; - } - } - if constexpr (has_base

::value) { - return TestVariableIsPathFromRoot(path.base(), root); - } - if constexpr (has_union

::value) { - return common::visit( - common::visitors{ - [&](const auto &x) { return TestVariableIsPathFromRoot(x, root); }, - }, - path.u); - } - return false; -} - -bool DataRef::IsPathFrom(const DataRef &that) const { - return TestVariableIsPathFromRoot(*this, that); -} - -template -bool Designator::IsPathFrom(const Designator &that) const { - return TestVariableIsPathFromRoot(*this, that); -} - -template -optional Designator::IsSameEntity(const Designator &that) const { - return std::nullopt; -} #ifdef _MSC_VER // disable bogus warning about missing definitions #pragma warning(disable : 4661) diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index 19f91cb5fd0b2..8a257ee9005ef 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -471,26 +471,13 @@ static bool HaveCompatibleLengths( } bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path) { - if (root) { - if (std::optional rootRef{ExtractDataRef(root)}) { - if (path) { - if (std::optional pathRef{ExtractDataRef(path)}) { - if (pathRef->IsPathFrom(*rootRef)) { - return true; - } - } else { - if (*root == *path) { - return true; - } - } - } - } else { - if (path && *root == *path) { - return true; - } - } + 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; } - return false; } bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { diff --git a/flang/test/Semantics/OpenACC/acc-data-function.f90 b/flang/test/Semantics/OpenACC/acc-data-function.f90 new file mode 100644 index 0000000000000..7718d2cad1687 --- /dev/null +++ b/flang/test/Semantics/OpenACC/acc-data-function.f90 @@ -0,0 +1,19 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenacc -pedantic + +module mm_acc_rout_function +contains + integer function dosomething(res) + !$acc routine seq + integer :: res + dosomething = res + 1 + end function +end module + +program main + use mm_acc_rout_function + implicit none + integer :: res = 1 + !$acc serial default(none) copy(res) + res = dosomething(res) + !$acc end serial +end program diff --git a/flang/test/Semantics/allocate14.f90 b/flang/test/Semantics/allocate14.f90 index 000b7c8ad5af2..a97cf5ad88b08 100644 --- a/flang/test/Semantics/allocate14.f90 +++ b/flang/test/Semantics/allocate14.f90 @@ -46,11 +46,11 @@ program allocate14 !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated deallocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg) - !ERROR: STAT variable in ALLOCATE must not be the variable being allocated - !ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated + !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) - !ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated - !ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated + !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 From 2b557ad89244fe6272cb64e97d58b9ed6a26561e Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 29 Oct 2025 15:44:12 -0700 Subject: [PATCH 7/8] remove random included file --- .../Semantics/OpenACC/acc-data-function.f90 | 19 ------------------- 1 file changed, 19 deletions(-) delete mode 100644 flang/test/Semantics/OpenACC/acc-data-function.f90 diff --git a/flang/test/Semantics/OpenACC/acc-data-function.f90 b/flang/test/Semantics/OpenACC/acc-data-function.f90 deleted file mode 100644 index 7718d2cad1687..0000000000000 --- a/flang/test/Semantics/OpenACC/acc-data-function.f90 +++ /dev/null @@ -1,19 +0,0 @@ -! RUN: %python %S/../test_errors.py %s %flang -fopenacc -pedantic - -module mm_acc_rout_function -contains - integer function dosomething(res) - !$acc routine seq - integer :: res - dosomething = res + 1 - end function -end module - -program main - use mm_acc_rout_function - implicit none - integer :: res = 1 - !$acc serial default(none) copy(res) - res = dosomething(res) - !$acc end serial -end program From 4bf8199828304cee4ab905efe5108e7ccc91122b Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Thu, 30 Oct 2025 09:16:51 -0700 Subject: [PATCH 8/8] IsSameAllocation/AreSameAllocation --- flang/lib/Semantics/check-allocate.cpp | 6 +++--- flang/lib/Semantics/check-allocate.h | 2 +- flang/lib/Semantics/check-deallocate.cpp | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index 8a257ee9005ef..a411e20557456 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -470,7 +470,7 @@ static bool HaveCompatibleLengths( } } -bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path) { +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. @@ -712,11 +712,11 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { } if (const SomeExpr *allocObj{GetExpr(context, allocateObject_)}) { - if (IsSameAllocation(allocObj, allocateInfo_.statVar)) { + 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 (IsSameAllocation(allocObj, allocateInfo_.msgVar)) { + 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); } diff --git a/flang/lib/Semantics/check-allocate.h b/flang/lib/Semantics/check-allocate.h index da1d681a1923b..54f7380bc3fe8 100644 --- a/flang/lib/Semantics/check-allocate.h +++ b/flang/lib/Semantics/check-allocate.h @@ -24,6 +24,6 @@ class AllocateChecker : public virtual BaseChecker { private: SemanticsContext &context_; }; -bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path); +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 a58ad3f9b46d2..e6ce1b30a59f5 100644 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -135,11 +135,11 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) { }, allocateObject.u); if (const SomeExpr *allocObj{GetExpr(context_, allocateObject)}) { - if (IsSameAllocation(allocObj, statVar)) { + 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 (IsSameAllocation(allocObj, msgVar)) { + if (AreSameAllocation(allocObj, msgVar)) { context_.Say(msgSource.value_or(source), "ERRMSG variable in DEALLOCATE must not be the variable being deallocated"_err_en_US); }