[flang-commits] [flang] [Flang] Add parsing and attribute registration for SIMPLE specifier (PR #161285)
Šárka Holendová via flang-commits
flang-commits at lists.llvm.org
Mon Mar 23 17:58:32 PDT 2026
https://github.com/mlir-maiden updated https://github.com/llvm/llvm-project/pull/161285
>From a6566c69f3a47c1f5f3b0bee4d2285898c519982 Mon Sep 17 00:00:00 2001
From: Sarka Holendova <sarka.holendova at gmail.com>
Date: Mon, 29 Sep 2025 23:23:40 +0200
Subject: [PATCH 1/5] [Flang] Add parsing and attribute registration for SIMPLE
procedures
---
flang/include/flang/Evaluate/call.h | 1 +
flang/include/flang/Evaluate/characteristics.h | 5 +++--
flang/include/flang/Evaluate/tools.h | 2 ++
flang/include/flang/Parser/dump-parse-tree.h | 1 +
flang/include/flang/Parser/parse-tree.h | 5 +++--
flang/include/flang/Semantics/attr.h | 2 +-
flang/lib/Evaluate/call.cpp | 14 ++++++++++++++
flang/lib/Evaluate/tools.cpp | 9 +++++++++
flang/lib/Parser/program-parsers.cpp | 3 ++-
flang/lib/Parser/unparse.cpp | 1 +
flang/lib/Semantics/resolve-names.cpp | 1 +
flang/test/Parser/simple-unparse.f90 | 14 ++++++++++++++
flang/test/Parser/simple.f90 | 9 +++++++++
13 files changed, 61 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Parser/simple-unparse.f90
create mode 100644 flang/test/Parser/simple.f90
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 2a5929b873d74..be550c4f51ad2 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -219,6 +219,7 @@ struct ProcedureDesignator {
int Rank() const;
bool IsElemental() const;
bool IsPure() const;
+ bool IsSimple() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index d566c34ff71e8..d2410104dbb94 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -357,8 +357,8 @@ struct FunctionResult {
// 15.3.1
struct Procedure {
- ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer,
- NullAllocatable, Subroutine)
+ ENUM_CLASS(Attr, Pure, Simple, Elemental, BindC, ImplicitInterface,
+ NullPointer, NullAllocatable, Subroutine)
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
Procedure(){};
Procedure(FunctionResult &&, DummyArguments &&, Attrs);
@@ -390,6 +390,7 @@ struct Procedure {
bool IsSubroutine() const { return attrs.test(Attr::Subroutine); }
bool IsPure() const { return attrs.test(Attr::Pure); }
+ bool IsSimple() const { return attrs.test(Attr::Simple); }
bool IsElemental() const { return attrs.test(Attr::Elemental); }
bool IsBindC() const { return attrs.test(Attr::BindC); }
bool HasExplicitInterface() const {
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index cef57f1851bcc..d7345f466272e 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1547,6 +1547,8 @@ const Symbol *GetMainEntry(const Symbol *);
bool IsVariableName(const Symbol &);
bool IsPureProcedure(const Symbol &);
bool IsPureProcedure(const Scope &);
+bool IsSimpleProcedure(const Symbol &);
+bool IsSimpleProcedure(const Scope &);
bool IsExplicitlyImpureProcedure(const Symbol &);
bool IsElementalProcedure(const Symbol &);
bool IsFunction(const Symbol &);
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index ebac54f6e29ba..6f9296f51027a 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -758,6 +758,7 @@ class ParseTreeDumper {
NODE(PrefixSpec, Non_Recursive)
NODE(PrefixSpec, Pure)
NODE(PrefixSpec, Recursive)
+ NODE(PrefixSpec, Simple)
NODE(PrefixSpec, Attributes)
NODE(PrefixSpec, Launch_Bounds)
NODE(PrefixSpec, Cluster_Dims)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 806eb308a112f..25b3ade00acb0 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3111,7 +3111,7 @@ struct ProcedureDeclarationStmt {
// R1527 prefix-spec ->
// declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-// NON_RECURSIVE | PURE | RECURSIVE |
+// NON_RECURSIVE | PURE | RECURSIVE | SIMPLE |
// (CUDA) ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... )
// LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
struct PrefixSpec {
@@ -3122,11 +3122,12 @@ struct PrefixSpec {
EMPTY_CLASS(Non_Recursive);
EMPTY_CLASS(Pure);
EMPTY_CLASS(Recursive);
+ EMPTY_CLASS(Simple);
WRAPPER_CLASS(Attributes, std::list<common::CUDASubprogramAttrs>);
WRAPPER_CLASS(Launch_Bounds, std::list<ScalarIntConstantExpr>);
WRAPPER_CLASS(Cluster_Dims, std::list<ScalarIntConstantExpr>);
std::variant<DeclarationTypeSpec, Elemental, Impure, Module, Non_Recursive,
- Pure, Recursive, Attributes, Launch_Bounds, Cluster_Dims>
+ Pure, Recursive, Simple, Attributes, Launch_Bounds, Cluster_Dims>
u;
};
diff --git a/flang/include/flang/Semantics/attr.h b/flang/include/flang/Semantics/attr.h
index 76fab5e0c904d..488f325de5887 100644
--- a/flang/include/flang/Semantics/attr.h
+++ b/flang/include/flang/Semantics/attr.h
@@ -25,7 +25,7 @@ ENUM_CLASS(Attr, ABSTRACT, ALLOCATABLE, ASYNCHRONOUS, BIND_C, CONTIGUOUS,
DEFERRED, ELEMENTAL, EXTENDS, EXTERNAL, IMPURE, INTENT_IN, INTENT_INOUT,
INTENT_OUT, INTRINSIC, MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS,
OPTIONAL, PARAMETER, PASS, POINTER, PRIVATE, PROTECTED, PUBLIC, PURE,
- RECURSIVE, SAVE, TARGET, VALUE, VOLATILE)
+ RECURSIVE, SAVE, SIMPLE, TARGET, VALUE, VOLATILE)
// Set of attributes
class Attrs : public common::EnumSet<Attr, Attr_enumSize> {
diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index f77df92a7597a..b179fd7a4a4f5 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -158,6 +158,20 @@ bool ProcedureDesignator::IsPure() const {
return false;
}
+bool ProcedureDesignator::IsSimple() const {
+ if (const Symbol *interface{GetInterfaceSymbol()}) {
+ return IsSimpleProcedure(*interface);
+ } else if (const Symbol *symbol{GetSymbol()}) {
+ return IsSimpleProcedure(*symbol);
+ } else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
+ return intrinsic->characteristics.value().attrs.test(
+ characteristics::Procedure::Attr::Simple);
+ } else {
+ DIE("ProcedureDesignator::IsSimple(): no case");
+ }
+ return false;
+}
+
const SpecificIntrinsic *ProcedureDesignator::GetSpecificIntrinsic() const {
return std::get_if<SpecificIntrinsic>(&u);
}
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 171dd91fa9fd1..2d346bf01361f 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -2082,6 +2082,15 @@ bool IsPureProcedure(const Scope &scope) {
return symbol && IsPureProcedure(*symbol);
}
+bool IsSimpleProcedure(const Symbol &original) {
+ return original.attrs().test(Attr::SIMPLE);
+}
+
+bool IsSimpleProcedure(const Scope &scope) {
+ const Symbol *symbol{scope.GetSymbol()};
+ return symbol && IsSimpleProcedure(*symbol);
+}
+
bool IsExplicitlyImpureProcedure(const Symbol &original) {
// An ENTRY is IMPURE if its containing subprogram is so
return DEREF(GetMainEntry(&original.GetUltimate()))
diff --git a/flang/lib/Parser/program-parsers.cpp b/flang/lib/Parser/program-parsers.cpp
index 5f4e62ffdbbf2..13be667fa9b85 100644
--- a/flang/lib/Parser/program-parsers.cpp
+++ b/flang/lib/Parser/program-parsers.cpp
@@ -524,7 +524,7 @@ TYPE_PARSER(construct<AltReturnSpec>(star >> label))
// R1527 prefix-spec ->
// declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-// NON_RECURSIVE | PURE | RECURSIVE |
+// NON_RECURSIVE | PURE | RECURSIVE | SIMPLE |
// (CUDA) ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) |
// LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device),
@@ -539,6 +539,7 @@ TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),
construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)),
construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)),
construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)),
+ construct<PrefixSpec>(construct<PrefixSpec::Simple>("SIMPLE"_tok)),
extension<LanguageFeature::CUDA>(
construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >>
parenthesized(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 1d4d53de1491d..ccb93439ec8d0 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1761,6 +1761,7 @@ class UnparseVisitor {
void Post(const PrefixSpec::Non_Recursive) { Word("NON_RECURSIVE"); }
void Post(const PrefixSpec::Pure) { Word("PURE"); }
void Post(const PrefixSpec::Recursive) { Word("RECURSIVE"); }
+ void Post(const PrefixSpec::Simple) { Word("SIMPLE"); }
void Unparse(const PrefixSpec::Attributes &x) {
Word("ATTRIBUTES("), Walk(x.v), Word(")");
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d08c669377cb2..ef3abff19a856 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -265,6 +265,7 @@ class AttrsVisitor : public virtual BaseVisitor {
HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
+ HANDLE_ATTR_CLASS(PrefixSpec::Simple, SIMPLE)
HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
diff --git a/flang/test/Parser/simple-unparse.f90 b/flang/test/Parser/simple-unparse.f90
new file mode 100644
index 0000000000000..4cc52bfeee6cf
--- /dev/null
+++ b/flang/test/Parser/simple-unparse.f90
@@ -0,0 +1,14 @@
+! RUN: %flang_fc1 -fdebug-unparse-no-sema %s 2>&1 | FileCheck %s
+
+! Test that SIMPLE function specifier is recognized
+! by the parser and the unparser. This test does not
+! exercise semantic checks.
+
+simple function foo()
+ return
+end function
+
+! CHECK: SIMPLE FUNCTION foo()
+! CHECK-NEXT: RETURN
+! CHECK-NEXT: END FUNCTION
+
diff --git a/flang/test/Parser/simple.f90 b/flang/test/Parser/simple.f90
new file mode 100644
index 0000000000000..488909a5550a2
--- /dev/null
+++ b/flang/test/Parser/simple.f90
@@ -0,0 +1,9 @@
+! RUN: %flang_fc1 -fdebug-dump-parse-tree %s | FileCheck %s
+
+! Check that SIMPLE is recognized in the parse tree
+
+simple function foo()
+ return
+end function
+
+! CHECK: Simple
>From 453944466c40a320ac262c471b06231f1ff27599 Mon Sep 17 00:00:00 2001
From: Sarka Holendova <sarka.holendova at gmail.com>
Date: Thu, 9 Oct 2025 16:26:51 -0400
Subject: [PATCH 2/5] [flang] Extend SIMPLE specifier support: disallow
PURE+SIMPLE combination and update purity handling
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
- Adds a rule in resolve-names.cpp to diagnose procedures declared with both PURE and SIMPLE attributes (Fortran 2023 C759, C1543).
- Updates IsPureProcedureImpl() in tools.cpp so that SIMPLE implies PURE (Fortran 2023 §15.8).
- Introduces a new LIT test (simple-conflict.f90) verifying diagnostic emission for PURE+SIMPLE conflicts.
---
flang/lib/Evaluate/tools.cpp | 3 +++
flang/lib/Semantics/resolve-names.cpp | 1 +
flang/test/Semantics/simple-conflict.f90 | 12 ++++++++++++
3 files changed, 16 insertions(+)
create mode 100644 flang/test/Semantics/simple-conflict.f90
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 2d346bf01361f..2b29a0eb0298f 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -2067,6 +2067,9 @@ static bool IsPureProcedureImpl(
}
return true; // statement function was not found to be impure
}
+ if (symbol.attrs().test(Attr::SIMPLE)) {
+ return true; // SIMPLE implies PURE (Fortran 2023 §15.8)
+ }
return symbol.attrs().test(Attr::PURE) ||
(symbol.attrs().test(Attr::ELEMENTAL) &&
!symbol.attrs().test(Attr::IMPURE));
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index ef3abff19a856..f75226a9430e9 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2351,6 +2351,7 @@ bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
+ HaveAttrConflict(attrName, Attr::PURE, Attr::SIMPLE) ||
HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE) ||
HaveAttrConflict(attrName, Attr::INTRINSIC, Attr::EXTERNAL);
diff --git a/flang/test/Semantics/simple-conflict.f90 b/flang/test/Semantics/simple-conflict.f90
new file mode 100644
index 0000000000000..efc14c18e51f5
--- /dev/null
+++ b/flang/test/Semantics/simple-conflict.f90
@@ -0,0 +1,12 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+!
+! Verify that PURE and SIMPLE prefix-specs are mutually exclusive
+
+pure simple subroutine ps()
+end
+! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
+
+simple pure function sp()
+end
+! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
+
>From 374a0932373aa69f910bb050b10b2a8e656b75ef Mon Sep 17 00:00:00 2001
From: Sarka Holendova <sarka.holendova at gmail.com>
Date: Sat, 24 Jan 2026 18:51:49 -0500
Subject: [PATCH 3/5] [flang] Treat SIMPLE procedures as PURE - Set
PURE implicitly when SIMPLE is specified and add symbol-dump coverage
---
flang/lib/Semantics/resolve-names.cpp | 11 +++++-
flang/test/Semantics/simple-conflict.f90 | 12 -------
.../simple-satisfies-pure-negative.f90 | 36 +++++++++++++++++++
.../test/Semantics/simple-satisfies-pure.f90 | 33 +++++++++++++++++
flang/test/Semantics/simple.f90 | 17 +++++++++
5 files changed, 96 insertions(+), 13 deletions(-)
delete mode 100644 flang/test/Semantics/simple-conflict.f90
create mode 100644 flang/test/Semantics/simple-satisfies-pure-negative.f90
create mode 100644 flang/test/Semantics/simple-satisfies-pure.f90
create mode 100644 flang/test/Semantics/simple.f90
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f75226a9430e9..c5819c596e8a9 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -687,10 +687,20 @@ class ScopeHandler : public ImplicitRulesVisitor {
void SetExplicitAttr(Symbol &symbol, Attr attr) const {
symbol.attrs().set(attr);
symbol.implicitAttrs().reset(attr);
+
+ // SIMPLE implies PURE; mark PURE as implicit
+ if (attr == Attr::SIMPLE && !symbol.attrs().test(Attr::PURE)) {
+ SetImplicitAttr(symbol, Attr::PURE);
+ }
}
void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const {
symbol.attrs() |= attrs;
symbol.implicitAttrs() &= ~attrs;
+
+ // SIMPLE implies PURE; mark PURE as implicit
+ if (attrs.test(Attr::SIMPLE) && !symbol.attrs().test(Attr::PURE)) {
+ SetImplicitAttr(symbol, Attr::PURE);
+ }
}
void SetImplicitAttr(Symbol &symbol, Attr attr) const {
symbol.attrs().set(attr);
@@ -2351,7 +2361,6 @@ bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
- HaveAttrConflict(attrName, Attr::PURE, Attr::SIMPLE) ||
HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE) ||
HaveAttrConflict(attrName, Attr::INTRINSIC, Attr::EXTERNAL);
diff --git a/flang/test/Semantics/simple-conflict.f90 b/flang/test/Semantics/simple-conflict.f90
deleted file mode 100644
index efc14c18e51f5..0000000000000
--- a/flang/test/Semantics/simple-conflict.f90
+++ /dev/null
@@ -1,12 +0,0 @@
-! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
-!
-! Verify that PURE and SIMPLE prefix-specs are mutually exclusive
-
-pure simple subroutine ps()
-end
-! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
-
-simple pure function sp()
-end
-! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
-
diff --git a/flang/test/Semantics/simple-satisfies-pure-negative.f90 b/flang/test/Semantics/simple-satisfies-pure-negative.f90
new file mode 100644
index 0000000000000..3bf3d700f0687
--- /dev/null
+++ b/flang/test/Semantics/simple-satisfies-pure-negative.f90
@@ -0,0 +1,36 @@
+! This is the negative/control case for simple-satisfies-pure.f90.
+! It verifies that a procedure which is neither PURE nor SIMPLE is rejected
+! when passed to a dummy argument that requires a PURE procedure.
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+
+module m
+ implicit none
+
+ abstract interface
+ pure integer function iproc(x)
+ integer, intent(in) :: x
+ end function
+ end interface
+
+contains
+
+ ! Neither PURE nor SIMPLE -> must NOT satisfy PURE requirements
+ integer function impure(x)
+ integer, intent(in) :: x
+ impure = x
+ end function
+
+ pure integer function apply_pure(f, x)
+ procedure(iproc) :: f
+ integer, intent(in) :: x
+ apply_pure = f(x)
+ end function
+
+ integer function test()
+ test = apply_pure(impure, 1)
+ end function
+end module
+
+! CHECK: error: Actual procedure argument has interface incompatible with dummy argument 'f='
+! CHECK-SAME: incompatible procedure attributes: Pure
+
diff --git a/flang/test/Semantics/simple-satisfies-pure.f90 b/flang/test/Semantics/simple-satisfies-pure.f90
new file mode 100644
index 0000000000000..d08b758538530
--- /dev/null
+++ b/flang/test/Semantics/simple-satisfies-pure.f90
@@ -0,0 +1,33 @@
+! This test verifies that SIMPLE procedures satisfy PURE requirements.
+! (i.e. anywhere the language requires a PURE procedure, a SIMPLE one is accepted)
+! RUN: %flang_fc1 -fsyntax-only %s
+
+module m
+ implicit none
+
+ abstract interface
+ ! Dummy procedure explicitly requires PURE
+ pure integer function pure_iface(x)
+ integer, intent(in) :: x
+ end function
+ end interface
+
+contains
+
+ ! SIMPLE procedure (should be accepted where PURE is required)
+ simple integer function simple_impl(x)
+ integer, intent(in) :: x
+ simple_impl = x
+ end function
+
+ pure integer function apply_requires_pure(f, x)
+ procedure(pure_iface) :: f
+ integer, intent(in) :: x
+ apply_requires_pure = f(x)
+ end function
+
+ integer function test()
+ test = apply_requires_pure(simple_impl, 1)
+ end function
+end module
+
diff --git a/flang/test/Semantics/simple.f90 b/flang/test/Semantics/simple.f90
new file mode 100644
index 0000000000000..3c29a80843c71
--- /dev/null
+++ b/flang/test/Semantics/simple.f90
@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+
+module m
+contains
+ ! SIMPLE: should end up with both SIMPLE and PURE (PURE implied by SIMPLE)
+ simple subroutine s_simple()
+ end
+
+ ! PURE: should remain PURE, and should not acquire SIMPLE
+ pure subroutine s_pure()
+ end
+end module
+
+! CHECK: s_simple, PUBLIC, PURE, SIMPLE
+! CHECK: s_pure, PUBLIC, PURE
+! CHECK-NOT: s_pure, PUBLIC, PURE, SIMPLE
+
>From 3e6e918f486b0d589ba1f3c0a18d3261702a076a Mon Sep 17 00:00:00 2001
From: Sarka Holendova <sarka.holendova at gmail.com>
Date: Mon, 23 Mar 2026 20:38:12 -0400
Subject: [PATCH 4/5] [flang] Handle SIMPLE propagation and SIMPLE/IMPURE
conflict
Propagate SIMPLE in CharacterizeProcedure() so it is reflected in
procedure characteristics.
Treat SIMPLE as satisfying PURE in procedure compatibility, while
preserving that PURE alone does not satisfy SIMPLE.
Diagnose invalid SIMPLE+IMPURE combinations.
Update simple.f90 to use CHECK-DAG since the symbol dump order is not stable.
---
flang/lib/Evaluate/characteristics.cpp | 4 +++
flang/lib/Semantics/check-declarations.cpp | 6 +++++
.../pure-does-not-satisfy-simple.f90 | 26 +++++++++++++++++++
.../test/Semantics/simple-impure-conflict.f90 | 6 +++++
flang/test/Semantics/simple.f90 | 4 +--
5 files changed, 44 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/pure-does-not-satisfy-simple.f90
create mode 100644 flang/test/Semantics/simple-impure-conflict.f90
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 89547733ea33c..468b0d611c673 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -786,6 +786,7 @@ static std::optional<Procedure> CharacterizeProcedure(
CopyAttrs<Procedure, Procedure::Attr>(symbol, *result,
{
{semantics::Attr::BIND_C, Procedure::Attr::BindC},
+ {semantics::Attr::SIMPLE, Procedure::Attr::Simple},
});
CopyAttrs<Procedure, Procedure::Attr>(DEREF(GetMainEntry(&symbol)), *result,
{
@@ -1329,6 +1330,9 @@ bool Procedure::IsCompatibleWith(const Procedure &actual,
if (!attrs.test(Attr::Pure)) {
actualAttrs.reset(Attr::Pure);
}
+ if (!attrs.test(Attr::Simple)) {
+ actualAttrs.reset(Attr::Simple);
+ }
if (!attrs.test(Attr::Elemental) && specificIntrinsic) {
actualAttrs.reset(Attr::Elemental);
}
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index d769f221b1983..40fe874a3f286 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1505,6 +1505,12 @@ void CheckHelper::CheckSubprogram(
context_.SetError(symbol);
}
}
+ if (symbol.attrs().test(Attr::SIMPLE) &&
+ symbol.attrs().test(Attr::IMPURE)) {
+ messages_.Say(symbol.name(),
+ "A procedure may not have both the SIMPLE and IMPURE attributes"_err_en_US);
+ context_.SetError(symbol);
+ }
if (const Symbol *iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
SubprogramMatchHelper{*this}.Check(symbol, *iface);
}
diff --git a/flang/test/Semantics/pure-does-not-satisfy-simple.f90 b/flang/test/Semantics/pure-does-not-satisfy-simple.f90
new file mode 100644
index 0000000000000..03f41da6ef4b2
--- /dev/null
+++ b/flang/test/Semantics/pure-does-not-satisfy-simple.f90
@@ -0,0 +1,26 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+
+module pure_not_enough_for_simple
+
+ abstract interface
+ simple subroutine simple_proc()
+ end subroutine
+ end interface
+
+contains
+
+ subroutine needs_simple(p)
+ procedure(simple_proc) :: p
+ end subroutine
+
+ pure subroutine pure_only()
+ end subroutine
+
+ subroutine test()
+ call needs_simple(pure_only)
+ end subroutine
+
+end module
+
+! CHECK: incompatible procedure attributes
+! CHECK: Simple
diff --git a/flang/test/Semantics/simple-impure-conflict.f90 b/flang/test/Semantics/simple-impure-conflict.f90
new file mode 100644
index 0000000000000..f94a288636f68
--- /dev/null
+++ b/flang/test/Semantics/simple-impure-conflict.f90
@@ -0,0 +1,6 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+
+simple impure subroutine bug()
+end subroutine
+
+! CHECK: may not have both the SIMPLE and IMPURE attributes
diff --git a/flang/test/Semantics/simple.f90 b/flang/test/Semantics/simple.f90
index 3c29a80843c71..5511c730915ac 100644
--- a/flang/test/Semantics/simple.f90
+++ b/flang/test/Semantics/simple.f90
@@ -11,7 +11,7 @@ pure subroutine s_pure()
end
end module
-! CHECK: s_simple, PUBLIC, PURE, SIMPLE
-! CHECK: s_pure, PUBLIC, PURE
+! CHECK-DAG: s_simple, PUBLIC, PURE, SIMPLE
+! CHECK-DAG: s_pure, PUBLIC, PURE
! CHECK-NOT: s_pure, PUBLIC, PURE, SIMPLE
>From 5ffad8ed6f7b8aaebdde5d8fe0c95a79dfc09b82 Mon Sep 17 00:00:00 2001
From: Sarka Holendova <sarka.holendova at gmail.com>
Date: Mon, 23 Mar 2026 20:58:13 -0400
Subject: [PATCH 5/5] [flang] Fix clang-format in SIMPLE/IMPURE check
---
flang/lib/Semantics/check-declarations.cpp | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 40fe874a3f286..1bf0447732c00 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1505,8 +1505,7 @@ void CheckHelper::CheckSubprogram(
context_.SetError(symbol);
}
}
- if (symbol.attrs().test(Attr::SIMPLE) &&
- symbol.attrs().test(Attr::IMPURE)) {
+ if (symbol.attrs().test(Attr::SIMPLE) && symbol.attrs().test(Attr::IMPURE)) {
messages_.Say(symbol.name(),
"A procedure may not have both the SIMPLE and IMPURE attributes"_err_en_US);
context_.SetError(symbol);
More information about the flang-commits
mailing list