[flang-commits] [flang] [flang] Silence spurious error (PR #104821)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/104821

Don't complain about a local object with an impure final procedure in a pure subprogram when the local object is a named constant.

Fixes https://github.com/llvm/llvm-project/issues/104796.

>From b37ef7f91197274d27b12e80a67616a7f011e4f8 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 19 Aug 2024 10:46:35 -0700
Subject: [PATCH] [flang] Silence spurious error

Don't complain about a local object with an impure final
procedure in a pure subprogram when the local object is a named
constant.

Fixes https://github.com/llvm/llvm-project/issues/104796.
---
 flang/lib/Semantics/tools.cpp           | 5 +++--
 flang/test/Semantics/declarations05.f90 | 1 +
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 57d84bde60b43c..845183f2d9b253 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1558,8 +1558,9 @@ bool IsAutomaticallyDestroyed(const Symbol &symbol) {
   return symbol.has<ObjectEntityDetails>() &&
       (symbol.owner().kind() == Scope::Kind::Subprogram ||
           symbol.owner().kind() == Scope::Kind::BlockConstruct) &&
-      (!IsDummy(symbol) || IsIntentOut(symbol)) && !IsPointer(symbol) &&
-      !IsSaved(symbol) && !FindCommonBlockContaining(symbol);
+      !IsNamedConstant(symbol) && (!IsDummy(symbol) || IsIntentOut(symbol)) &&
+      !IsPointer(symbol) && !IsSaved(symbol) &&
+      !FindCommonBlockContaining(symbol);
 }
 
 const std::optional<parser::Name> &MaybeGetNodeName(
diff --git a/flang/test/Semantics/declarations05.f90 b/flang/test/Semantics/declarations05.f90
index 5144f0b91ab9de..b6dab7aeea0bc8 100644
--- a/flang/test/Semantics/declarations05.f90
+++ b/flang/test/Semantics/declarations05.f90
@@ -29,6 +29,7 @@ pure subroutine test
     type(t1) x1
     !WARNING: 'x1a' of derived type 't1' does not have a FINAL subroutine for its rank (1)
     type(t1), allocatable :: x1a(:)
+    type(t1), parameter :: namedConst = t1() ! ok
     !ERROR: 'x2' may not be a local variable in a pure subprogram
     !BECAUSE: 'x2' has an impure FINAL procedure 'final'
     type(t2) x2