[flang-commits] [flang] [flang] Downgrade an overly strict error to a warning (PR #187524)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Mar 19 08:57:32 PDT 2026
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/187524
>From 168b3ca9c429360376d70a73154dad54c5217c93 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 19 Mar 2026 08:39:46 -0700
Subject: [PATCH] [flang] Downgrade an overly strict error to a warning
Fortran allows a PURE subroutine to have dummy argument with INTENT(IN OUT).
An actual argument that is associated with an INTENT(IN OUT) dummy argument
must be definable. Consequently, there's a hole in the language that
allows a PURE subroutine to modify arbitrary global state: the argument
could have a derived type with an impure FINAL subroutine, and that
FINAL subroutine could be invoked by an assignment to the dummy argument.
I consider this to be a mistake in the language design.
So the compiler was reporting this case as an error, although it is
indeed conforming usage, and not flagged by any other compiler.
Unfortunately, somebody has a code that needs this usage to be
accepted, because (I presume) they can't modify the dummy argument
to be INTENT(IN).
Consequently, we'll need to allow this usage. But it will elicit
a warning, and the warning is on by default.
---
.../include/flang/Support/Fortran-features.h | 2 +-
flang/lib/Semantics/check-call.cpp | 1 +
flang/lib/Semantics/definable.cpp | 15 ++++++++--
flang/lib/Semantics/definable.h | 3 +-
flang/lib/Support/Fortran-features.cpp | 1 +
flang/test/Semantics/bug181353.f90 | 29 +++++++++++++++++++
6 files changed, 47 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Semantics/bug181353.f90
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index feadc11ab7f85..f2bd0d21f25b6 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -84,7 +84,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile,
RealConstantWidening, VolatileOrAsynchronousTemporary, UnusedVariable,
UsedUndefinedVariable, BadValueInDeadCode, AssumedTypeSizeDummy,
- MisplacedIgnoreTKR, NamelistParameter)
+ MisplacedIgnoreTKR, NamelistParameter, ImpureFinalInPure)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index fb459be0933af..2dd47508a0b3f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -766,6 +766,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure};
if (dummy.intent == common::Intent::InOut) {
flags.set(DefinabilityFlag::AllowEventLockOrNotifyType);
+ flags.set(DefinabilityFlag::OnlyWarnOnImpureFinalInPureContext);
undefinableMessage =
"Actual argument associated with INTENT(IN OUT) %s is not definable"_err_en_US;
} else if (dummy.intent == common::Intent::Out) {
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index de16422b89abd..aabf830f0681b 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -220,8 +220,19 @@ static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
}
if (dyType && inPure) {
if (const Symbol * impure{HasImpureFinal(ultimate)}) {
- return BlameSymbol(at, "'%s' has an impure FINAL procedure '%s'"_en_US,
- original, impure->name());
+ if (flags.test(DefinabilityFlag::OnlyWarnOnImpureFinalInPureContext)) {
+ if (scope.context().ShouldWarn(
+ common::UsageWarning::ImpureFinalInPure)) {
+ parser::Message message{at,
+ "'%s' has an impure FINAL procedure and must be definable in this pure context"_warn_en_US,
+ original.name()};
+ evaluate::AttachDeclaration(message, original);
+ return message;
+ }
+ } else {
+ return BlameSymbol(at, "'%s' has an impure FINAL procedure '%s'"_en_US,
+ original, impure->name());
+ }
}
if (!flags.test(DefinabilityFlag::PolymorphicOkInPure)) {
if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h
index 0d027961417be..816dad3c17fab 100644
--- a/flang/lib/Semantics/definable.h
+++ b/flang/lib/Semantics/definable.h
@@ -33,7 +33,8 @@ ENUM_CLASS(DefinabilityFlag,
SourcedAllocation, // ALLOCATE(a,SOURCE=)
PolymorphicOkInPure, // don't check for polymorphic type in pure subprogram
DoNotNoteDefinition, // context does not imply definition
- AllowEventLockOrNotifyType, PotentialDeallocation)
+ AllowEventLockOrNotifyType, PotentialDeallocation,
+ OnlyWarnOnImpureFinalInPureContext)
using DefinabilityFlags =
common::EnumSet<DefinabilityFlag, DefinabilityFlag_enumSize>;
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 19080251b6462..4201f0b9b1e49 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -161,6 +161,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
warnUsage_.set(UsageWarning::BadValueInDeadCode);
warnUsage_.set(UsageWarning::MisplacedIgnoreTKR);
+ warnUsage_.set(UsageWarning::ImpureFinalInPure);
warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
}
diff --git a/flang/test/Semantics/bug181353.f90 b/flang/test/Semantics/bug181353.f90
new file mode 100644
index 0000000000000..53be2caf8c125
--- /dev/null
+++ b/flang/test/Semantics/bug181353.f90
@@ -0,0 +1,29 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+module m
+ type impure_t
+ contains
+ final :: finalize
+ end type
+ type inner_t
+ type(impure_t) :: impure
+ contains
+ procedure :: set => inner_set
+ end type
+ type outer_t
+ type(inner_t) :: inner
+ end type
+ interface
+ module subroutine finalize(this)
+ type(impure_t), intent(inout) :: this
+ end
+ pure module subroutine inner_set(this)
+ class(inner_t), intent(inout) :: this
+ end
+ end interface
+ contains
+ pure subroutine test(outer)
+ type(outer_t), intent(inout) :: outer
+ !WARNING: 'inner' has an impure FINAL procedure and must be definable in this pure context
+ call outer%inner%set()
+ end
+end
More information about the flang-commits
mailing list