[flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement #164529

akuhlens · 2025-10-22T01:31:28Z

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.

integer,pointer:: i
allocate(i,stat=i)
end

llvmbot · 2025-10-22T01:32:13Z

@llvm/pr-subscribers-openacc

@llvm/pr-subscribers-flang-semantics

Author: Andre Kuhlenschmidt (akuhlens)

Changes

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.

integer,pointer:: i
allocate(i,stat=i)
end

Full diff: https://github.com/llvm/llvm-project/pull/164529.diff

3 Files Affected:

(modified) flang/lib/Semantics/check-allocate.cpp (+25-1)
(modified) flang/lib/Semantics/check-deallocate.cpp (+64-40)
(added) flang/test/Semantics/allocate14.f90 (+25)

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<evaluate::DynamicType> sourceExprType;
   std::optional<parser::CharBlock> sourceExprLoc;
   std::optional<parser::CharBlock> 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<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);
                         }
+                        if (const auto *designator{
+                                parser::Unwrap<parser::Designator>(var)}) {
+                          info.statVar = &parser::GetLastName(*designator);
+                        }
                         info.gotStat = true;
                       },
                       [&](const parser::MsgVariable &var) {
@@ -158,6 +164,10 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
                           context.Say(
                               "ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
                         }
+                        if (const auto *designator{
+                                parser::Unwrap<parser::Designator>(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<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);
+              }
+              if (const auto *designator{
+                      parser::Unwrap<parser::Designator>(var)}) {
+                statVar = &parser::GetLastName(*designator);
+              }
+              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);
+              }
+              if (const auto *designator{
+                      parser::Unwrap<parser::Designator>(var)}) {
+                msgVar = &parser::GetLastName(*designator);
+              }
+              gotMsg = true;
+            },
+        },
+        deallocOpt.u);
+  }
   for (const parser::AllocateObject &allocateObject :
       std::get<std::list<parser::AllocateObject>>(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<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 (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
+

flang/lib/Semantics/check-allocate.cpp

flang/test/Semantics/allocate14.f90

flang/lib/Evaluate/variable.cpp

akuhlens · 2025-10-24T01:16:50Z

flang/lib/Evaluate/variable.cpp

+template <typename T, typename = void> struct has_union : std::false_type {};
+template <typename T>
+struct has_union<T, std::void_t<decltype(T::u)>> : std::true_type {};
+template <typename T, typename = void> struct has_base : std::false_type {};
+template <typename T>
+struct has_base<T, std::void_t<decltype(std::declval<T>().base())>>
+    : std::true_type {};
+template <typename T, typename = void>
+struct has_GetFirstSymbol : std::false_type {};
+template <typename T>
+struct has_GetFirstSymbol<T,
+    std::void_t<decltype(std::declval<T>().GetFirstSymbol())>>
+    : std::true_type {};
+
+template <typename P, typename R>
+bool TestVariableIsPathFromRoot(const P &path, const R &root) {
+  const SymbolRef *pathSym, *rootSym;
+  if constexpr (has_union<P>::value) {
+    pathSym = std::get_if<SymbolRef>(&path.u);
+  }
+  if constexpr (has_union<R>::value) {
+    rootSym = std::get_if<SymbolRef>(&root.u);
+  }
+  if (pathSym) {
+    return rootSym && AreSameSymbol(*rootSym, *pathSym);
+  }
+  if constexpr (has_GetFirstSymbol<P>::value) {
+    if (rootSym) {
+      return AreSameSymbol(path.GetFirstSymbol(), *rootSym);
+    }
+  }
+  if constexpr (std::is_same_v<P, R>) {
+    if (path == root) {
+      return true;
+    }
+  }
+  if constexpr (has_base<P>::value) {
+    return TestVariableIsPathFromRoot(path.base(), root);
+  }
+  if constexpr (has_union<P>::value) {
+    return common::visit(
+        common::visitors{
+            [&](const auto &x) { return TestVariableIsPathFromRoot(x, root); },
+        },
+        path.u);
+  }
+  return false;
+}


Is this an acceptable approach to getting the code that I want without having to write out all the different possibilities? If not, how would you go about this?

akuhlens · 2025-10-24T01:18:01Z

flang/lib/Semantics/check-allocate.cpp

  }
 }

+bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path) {


Probably not the best name for this... Have any suggestions?

Are, not Is

flang/docs/ImplementingASemanticCheck.md

flang/lib/Evaluate/variable.cpp

klausler · 2025-10-29T23:29:25Z

flang/lib/Semantics/check-allocate.cpp

  }
 }

+bool IsSameAllocation(const SomeExpr *root, const SomeExpr *path) {


Are, not Is

…e)allocated by same statement (llvm#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 ```

akuhlens requested review from eugeneepshteyn and klausler October 22, 2025 01:31

llvmbot added flang Flang issues not falling into any other category flang:semantics labels Oct 22, 2025

akuhlens changed the title ~~[flang][semantics] add symantic check that STAT and ERRMSG are non (de)allocated by same statement~~ [flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement Oct 22, 2025

eugeneepshteyn approved these changes Oct 22, 2025

View reviewed changes

klausler reviewed Oct 22, 2025

View reviewed changes

akuhlens commented Oct 22, 2025

View reviewed changes

flang/test/Semantics/allocate14.f90 Show resolved Hide resolved

akuhlens commented Oct 24, 2025

View reviewed changes

akuhlens requested a review from klausler October 24, 2025 01:19

klausler reviewed Oct 24, 2025

View reviewed changes

flang/docs/ImplementingASemanticCheck.md Outdated Show resolved Hide resolved

flang/lib/Evaluate/variable.cpp Outdated Show resolved Hide resolved

llvmbot added the openacc label Oct 29, 2025

akuhlens requested a review from klausler October 29, 2025 22:46

klausler approved these changes Oct 29, 2025

View reviewed changes

akuhlens added 8 commits October 30, 2025 09:20

initial commit

f86d026

address feedback

be2135b

handle base that is allocation

12b2fa2

explicitly null init pathSym and rootSym

d0f21ea

fixing random edit

5569917

simplify

bd89b72

remove random included file

2b557ad

IsSameAllocation/AreSameAllocation

4bf8199

akuhlens force-pushed the andre/check-allocate-stat branch from b640b61 to 4bf8199 Compare October 30, 2025 16:20

akuhlens merged commit 82ecbeb into llvm:main Oct 31, 2025
10 checks passed

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

[flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement #164529

[flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement #164529

Uh oh!

akuhlens commented Oct 22, 2025

Uh oh!

llvmbot commented Oct 22, 2025 •

edited

Loading

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

akuhlens Oct 24, 2025

Uh oh!

akuhlens Oct 24, 2025

Uh oh!

klausler Oct 29, 2025

Uh oh!

Uh oh!

Uh oh!

klausler Oct 29, 2025

Uh oh!

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

4 participants

[flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement #164529

[flang][semantics] add semantic check that STAT and ERRMSG are not (de)allocated by same statement #164529

Uh oh!

Conversation

akuhlens commented Oct 22, 2025

Uh oh!

llvmbot commented Oct 22, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

akuhlens Oct 24, 2025

Choose a reason for hiding this comment

Uh oh!

akuhlens Oct 24, 2025

Choose a reason for hiding this comment

Uh oh!

klausler Oct 29, 2025

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Uh oh!

klausler Oct 29, 2025

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

4 participants

llvmbot commented Oct 22, 2025 •

edited

Loading