From a6566c69f3a47c1f5f3b0bee4d2285898c519982 Mon Sep 17 00:00:00 2001 From: Sarka Holendova Date: Mon, 29 Sep 2025 23:23:40 +0200 Subject: [PATCH 1/2] [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> 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; 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); WRAPPER_CLASS(Launch_Bounds, std::list); WRAPPER_CLASS(Cluster_Dims, std::list); std::variant + 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 { 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(&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(&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(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(declarationTypeSpec), construct("NON_RECURSIVE"_tok)), construct(construct("PURE"_tok)), construct(construct("RECURSIVE"_tok)), + construct(construct("SIMPLE"_tok)), extension( construct(construct("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 Date: Thu, 9 Oct 2025 16:26:51 -0400 Subject: [PATCH 2/2] [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 +