[flang-commits] [flang] [flang] Compiler directives defined by plugins (PR #228757)
Valentin Churavy via flang-commits
flang-commits at lists.llvm.org
Sat Oct 3 12:33:12 PDT 2026
https://github.com/vchuravy created https://github.com/llvm/llvm-project/pull/228757
For a plugin that I am working on (using Enzyme with Fortran) I would like to add directives.
There are two variants, and either or both would work.
1. !DIR$ prefix
2. !$prefix
The first causes other compilers to warn about unrecognized directives (which is annoying, but fine) and the second is "just a comment". The second form has precedence in the Tapenade or TAF ecosystem where they use `!$AD` or `!$TAF`.
Follow-up on #212195 for more fully featured flang plugins. I am happy to split this PR into smaller chunks if that is helpful.
:robot:
A plugin loaded with `flang -fc1 -load` can define its own compiler directives, which flang parses, checks and attaches to the MLIR it generates for the plugin's passes to act on:
!DIR$ prefix keyword [ ( arg [, arg]... ) ]
arg -> [ name = ] value
value -> name | /common-block/ | integer | character-literal
A plugin registers each directive from a static initializer through flang/Support/PluginDirectives.h: its prefix and keyword, what it applies to (a procedure, a variable, or either) and its keyword arguments, each a procedure, a variable, an integer or a string, possibly required. It may also register `!$prefix` as a comment sentinel, so that `!$prefix keyword ...` is the same directive and other compilers see a comment (free form, and fixed form with `!`, `c` or `*` in column 1; `!$` followed by a blank remains OpenMP conditional compilation).
- Parsing: the form is accepted only for a registered prefix, so no other directive changes meaning. Once the prefix matches, a malformed argument list is a parse error.
- Semantics: name arguments are resolved and checked against the registered kinds. A procedure must be a subprogram or an external procedure; a variable must be a variable, or a COMMON block as `/name/`. The subject is the first positional argument or, without one, the enclosing subprogram; in a function without a RESULT clause its name is the function. A generic interface as the subject stands for each of its specific procedures, for a directive without procedure arguments; as a procedure argument it is an error.
- Module files: a directive on a module entity is written to the module file, so that units using the module see it too. One whose arguments are not visible in the module (e.g. an internal procedure) is left out with a warning.
- Lowering: each directive becomes an entry of a `fir.directives` array attribute on the func.func or fir.global of its subject, its procedure and variable arguments symbol references (declared if the unit does not yet).
flang/examples/DirectivesPlugin registers directives with the prefix "example", and its `!$example` sentinel; the tests in flang/test/Examples/plugin-directives*.f90 check their lowering, generic interfaces, the semantic and parse errors, the sentinel in free and fixed form, and module files with and without the plugin.
Assisted-by: Claude Code (Opus 5.5)
>From 5c0b36cee151458bda05551836dba702f61a84ae Mon Sep 17 00:00:00 2001
From: Valentin Churavy <v.churavy at gmail.com>
Date: Sat, 3 Oct 2026 21:22:31 +0200
Subject: [PATCH] [flang] Compiler directives defined by plugins
A plugin loaded with `flang -fc1 -load` can define its own compiler
directives, which flang parses, checks and attaches to the MLIR it
generates for the plugin's passes to act on:
!DIR$ prefix keyword [ ( arg [, arg]... ) ]
arg -> [ name = ] value
value -> name | /common-block/ | integer | character-literal
A plugin registers each directive from a static initializer through
flang/Support/PluginDirectives.h: its prefix and keyword, what it applies
to (a procedure, a variable, or either) and its keyword arguments, each a
procedure, a variable, an integer or a string, possibly required. It may
also register `!$prefix` as a comment sentinel, so that `!$prefix keyword
...` is the same directive and other compilers see a comment (free form,
and fixed form with `!`, `c` or `*` in column 1; `!$` followed by a blank
remains OpenMP conditional compilation).
- Parsing: the form is accepted only for a registered prefix, so no other
directive changes meaning. Once the prefix matches, a malformed argument
list is a parse error, not an ignored unrecognized directive.
- Semantics: name arguments are resolved and checked against the
registered kinds. A procedure must be a subprogram or an external
procedure (not a dummy procedure, procedure pointer, statement function
or intrinsic); a variable must be a variable, or a COMMON block as
`/name/`. The subject is the first positional argument or, without one,
the enclosing subprogram; in a function without a RESULT clause its name
is the function. A generic interface as the subject stands for each of
its specific procedures, for a directive without procedure arguments; as
a procedure argument it is an error.
- Module files: a directive on a module entity is written to the module
file, so that units using the module see it too. One whose arguments are
not visible in the module (e.g. an internal procedure) is left out with a
warning. Without the plugin, those read from a module file are ignored.
- Lowering: each directive becomes an entry of a `fir.directives` array
attribute on the func.func or fir.global of its subject, its procedure
and variable arguments symbol references (declared if the unit does not
yet). A unit that sees a directive through a module file attaches it
only to what it uses.
flang/examples/DirectivesPlugin registers directives with the prefix
"example", and its `!$example` sentinel; the tests in
flang/test/Examples/plugin-directives*.f90 check their lowering, generic
interfaces, the semantic and parse errors, the sentinel in free and fixed
form, and module files with and without the plugin.
Assisted-by: Claude Code (Opus 5.5)
Co-Authored-By: Claude Opus 5.5 <noreply at anthropic.com>
---
flang/examples/CMakeLists.txt | 1 +
.../examples/DirectivesPlugin/CMakeLists.txt | 9 +
.../DirectivesPlugin/DirectivesPlugin.cpp | 52 ++++
flang/include/flang/Lower/ConvertVariable.h | 5 +
flang/include/flang/Parser/dump-parse-tree.h | 3 +
flang/include/flang/Parser/parse-tree.h | 16 +-
flang/include/flang/Semantics/semantics.h | 20 ++
.../include/flang/Support/PluginDirectives.h | 98 +++++++
flang/lib/Lower/Bridge.cpp | 121 ++++++++
flang/lib/Lower/ConvertVariable.cpp | 8 +
flang/lib/Parser/Fortran-parsers.cpp | 71 ++++-
flang/lib/Parser/parsing.cpp | 5 +
flang/lib/Parser/prescan.cpp | 63 +++-
flang/lib/Parser/prescan.h | 17 ++
flang/lib/Parser/unparse.cpp | 23 ++
flang/lib/Semantics/mod-file.cpp | 69 +++++
flang/lib/Semantics/resolve-names.cpp | 276 +++++++++++++++++-
flang/lib/Support/CMakeLists.txt | 1 +
flang/lib/Support/PluginDirectives.cpp | 63 ++++
flang/test/CMakeLists.txt | 1 +
.../Examples/plugin-directives-errors.f90 | 65 +++++
.../Examples/plugin-directives-module.f90 | 57 ++++
.../test/Examples/plugin-directives-parse.f90 | 19 ++
.../Examples/plugin-directives-sentinel.f | 28 ++
flang/test/Examples/plugin-directives.f90 | 73 +++++
25 files changed, 1150 insertions(+), 14 deletions(-)
create mode 100644 flang/examples/DirectivesPlugin/CMakeLists.txt
create mode 100644 flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
create mode 100644 flang/include/flang/Support/PluginDirectives.h
create mode 100644 flang/lib/Support/PluginDirectives.cpp
create mode 100644 flang/test/Examples/plugin-directives-errors.f90
create mode 100644 flang/test/Examples/plugin-directives-module.f90
create mode 100644 flang/test/Examples/plugin-directives-parse.f90
create mode 100644 flang/test/Examples/plugin-directives-sentinel.f
create mode 100644 flang/test/Examples/plugin-directives.f90
diff --git a/flang/examples/CMakeLists.txt b/flang/examples/CMakeLists.txt
index 746a6f23ae015..ac11069f96cdd 100644
--- a/flang/examples/CMakeLists.txt
+++ b/flang/examples/CMakeLists.txt
@@ -1,3 +1,4 @@
+add_subdirectory(DirectivesPlugin)
add_subdirectory(PrintFlangFunctionNames)
add_subdirectory(FlangOmpReport)
add_subdirectory(FeatureList)
diff --git a/flang/examples/DirectivesPlugin/CMakeLists.txt b/flang/examples/DirectivesPlugin/CMakeLists.txt
new file mode 100644
index 0000000000000..f6c533a53a2f3
--- /dev/null
+++ b/flang/examples/DirectivesPlugin/CMakeLists.txt
@@ -0,0 +1,9 @@
+# TODO: Note that this is currently only available on Linux.
+# On Windows, we would also have to specify e.g. `PLUGIN_TOOL`.
+#
+# Nothing is linked in on purpose: the registry the plugin adds its directives
+# to is resolved against `flang -fc1` when the shared object is loaded.
+add_llvm_example_library(flangDirectivesPlugin
+ MODULE
+ DirectivesPlugin.cpp
+)
diff --git a/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp b/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
new file mode 100644
index 0000000000000..464d7a397415d
--- /dev/null
+++ b/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
@@ -0,0 +1,52 @@
+//===-- DirectivesPlugin.cpp ----------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Example plugin defining compiler directives with the prefix "example"
+// (flang/Support/PluginDirectives.h). Loaded with `flang -fc1 -load`, it makes
+// flang accept, check and lower
+//
+// !DIR$ EXAMPLE CALLBACK([proc,] HANDLER=proc [, PRIORITY=n] [, TAG=str])
+// !DIR$ EXAMPLE WATCH(var [, BY=var])
+// !DIR$ EXAMPLE NOTE([proc-or-var,] TEXT=str)
+//
+// which may also be spelled with the plugin's own comment sentinel, e.g.
+// `!$EXAMPLE NOTE(TEXT="...")`, a comment for other compilers.
+//
+// Each one becomes an entry of the `fir.directives` attribute of the
+// func.func or fir.global of its subject, for a pass of the plugin to act on;
+// this one defines no pass.
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Support/PluginDirectives.h"
+
+using namespace Fortran::common;
+
+namespace {
+
+[[maybe_unused]] const bool registered{[] {
+ // Call HANDLER when the subject procedure (by default, the subprogram the
+ // directive is in) is called.
+ registerPluginDirective(
+ {"example", "callback", PluginDirectiveSubject::Procedure,
+ {{"handler", PluginDirectiveArgKind::Procedure, /*required=*/true},
+ {"priority", PluginDirectiveArgKind::Integer},
+ {"tag", PluginDirectiveArgKind::String}}});
+ // Track the subject variable, or a COMMON block, possibly through another
+ // variable.
+ registerPluginDirective({"example", "watch", PluginDirectiveSubject::Variable,
+ {{"by", PluginDirectiveArgKind::Variable}}});
+ // A remark on a procedure or a variable.
+ registerPluginDirective({"example", "note", PluginDirectiveSubject::Any,
+ {{"text", PluginDirectiveArgKind::String, /*required=*/true}}});
+ // !$example ... is !DIR$ example ...
+ registerPluginDirectiveSentinel("example");
+ return true;
+}()};
+
+} // namespace
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index c8f117e63040f..92b3493132984 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -76,6 +76,11 @@ void initializeCloneAtRuntime(Fortran::lower::AbstractConverter &converter,
/// called.
void defineModuleVariable(AbstractConverter &, const pft::Variable &var);
+/// Declare the fir::GlobalOp of a module variable used from another module
+/// (as instantiateVariable does), outside of any function, and return it.
+fir::GlobalOp declareModuleVariable(AbstractConverter &,
+ const semantics::Symbol &);
+
/// Create fir::GlobalOp for all common blocks, including their initial values
/// if they have one. This should be called before lowering any scopes so that
/// common block globals are available when a common appear in a scope.
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 7ca404663b486..af7c5bb4bde58 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -234,6 +234,9 @@ class ParseTreeDumper {
NODE(CompilerDirective, NameValue)
NODE(CompilerDirective, NoInline)
NODE(CompilerDirective, Unrecognized)
+ NODE(CompilerDirective, Plugin)
+ NODE(CompilerDirective::Plugin, Arg)
+ NODE(CompilerDirective::Plugin, CommonBlock)
NODE(CompilerDirective, VectorAlways)
NODE_ENUM(CompilerDirective::VectorLength, VectorLength::Kind)
NODE(CompilerDirective, VectorLength)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 207a5543ab775..c1cad361289e6 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3487,11 +3487,25 @@ struct CompilerDirective {
EMPTY_CLASS(IVDep);
EMPTY_CLASS(Simd);
EMPTY_CLASS(Unrecognized);
+ // !DIR$ prefix keyword [( arg [, arg]... )] for a prefix registered by a
+ // plugin (see flang/Support/PluginDirectives.h).
+ struct Plugin {
+ // A COMMON block named in an argument, /name/.
+ WRAPPER_CLASS(CommonBlock, Name);
+ struct Arg {
+ TUPLE_CLASS_BOILERPLATE(Arg);
+ std::tuple<std::optional<Name>,
+ std::variant<Name, CommonBlock, std::uint64_t, std::string>>
+ t;
+ };
+ TUPLE_CLASS_BOILERPLATE(Plugin);
+ std::tuple<Name, Name, std::list<Arg>> t;
+ };
CharBlock source;
std::variant<std::list<IgnoreTKR>, LoopCount, std::list<AssumeAligned>,
VectorAlways, VectorLength, std::list<NameValue>, Unroll, UnrollAndJam,
Unrecognized, NoVector, NoUnroll, NoUnrollAndJam, ForceInline, Inline,
- NoInline, InlineAlways, Prefetch, IVDep, Simd>
+ NoInline, InlineAlways, Prefetch, IVDep, Simd, Plugin>
u;
};
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index d1365c4e7f46b..f064f8068a3c9 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -33,6 +33,7 @@ class IntrinsicTypeDefaultKinds;
namespace Fortran::parser {
struct AccObject;
+struct CompilerDirective;
struct Name;
struct Program;
class AllCookedSources;
@@ -417,6 +418,24 @@ class SemanticsContext {
omp::SemanticOverrides &GetOmpSemanticOverrides();
+ // Directives defined by plugins (flang/Support/PluginDirectives.h), after
+ // name resolution, with the procedure or variable they apply to. The names
+ // in their arguments have their symbols set.
+ struct PluginDirective {
+ SymbolRef subject;
+ const parser::CompilerDirective *directive;
+ // Read from a module file, i.e. written in another translation unit.
+ bool fromModFile{false};
+ };
+ void AddPluginDirective(const Symbol &subject,
+ const parser::CompilerDirective &directive, bool fromModFile) {
+ pluginDirectives_.push_back(
+ PluginDirective{subject, &directive, fromModFile});
+ }
+ const std::vector<PluginDirective> &GetPluginDirectives() const {
+ return pluginDirectives_;
+ }
+
private:
struct ScopeIndexComparator {
bool operator()(parser::CharBlock, parser::CharBlock) const;
@@ -464,6 +483,7 @@ class SemanticsContext {
std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
activeIndexVars_;
UnorderedSymbolSet errorSymbols_;
+ std::vector<PluginDirective> pluginDirectives_;
std::set<std::string> tempNames_;
const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
Scope *ppcBuiltinTypesScope_{nullptr}; // module __Fortran_PPC_types
diff --git a/flang/include/flang/Support/PluginDirectives.h b/flang/include/flang/Support/PluginDirectives.h
new file mode 100644
index 0000000000000..cff6b344f8a95
--- /dev/null
+++ b/flang/include/flang/Support/PluginDirectives.h
@@ -0,0 +1,98 @@
+//===-- include/flang/Support/PluginDirectives.h ----------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Compiler directives defined by plugins:
+//
+// !DIR$ prefix keyword [ ( arg [, arg]... ) ]
+// arg -> [ name = ] value, value -> name | integer | character-literal
+//
+// A plugin loaded with `flang -fc1 -load` registers the directives it defines
+// from a static initializer. The parser accepts the form above only for a
+// registered prefix; semantics resolves name arguments to symbols and checks
+// them against the registered argument kinds; lowering attaches the resolved
+// directive to its subject (a procedure or a variable) as an MLIR attribute,
+// for the plugin's own passes to interpret.
+//
+// A plugin may also register a comment sentinel for its prefix, so that
+//
+// !$prefix keyword [ ( arg [, arg]... ) ]
+//
+// is the same directive, and other compilers see a comment.
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SUPPORT_PLUGINDIRECTIVES_H_
+#define FORTRAN_SUPPORT_PLUGINDIRECTIVES_H_
+
+#include <string>
+#include <string_view>
+#include <vector>
+
+namespace Fortran::common {
+
+/// What a directive argument must be.
+enum class PluginDirectiveArgKind {
+ Procedure, ///< A name resolving to a procedure.
+ Variable, ///< A name resolving to a variable.
+ Integer, ///< An integer literal.
+ String, ///< A character literal, or a name taken as its spelling.
+};
+
+struct PluginDirectiveArg {
+ /// Empty for a positional argument.
+ std::string keyword;
+ PluginDirectiveArgKind kind;
+ bool required{false};
+};
+
+/// What a directive applies to.
+enum class PluginDirectiveSubject {
+ /// A procedure: the first positional argument if it is given, otherwise
+ /// the subprogram whose specification part holds the directive.
+ Procedure,
+ /// A variable: the first positional argument.
+ Variable,
+ /// Either, as for Procedure.
+ Any,
+};
+
+struct PluginDirectiveSpec {
+ std::string prefix; ///< Lower case, e.g. "enzyme".
+ std::string keyword; ///< Lower case, e.g. "custom_rule".
+ PluginDirectiveSubject subject{PluginDirectiveSubject::Procedure};
+ /// The arguments after the (optional) positional subject.
+ std::vector<PluginDirectiveArg> args;
+};
+
+/// Register a directive. Call from a static initializer in a plugin.
+void registerPluginDirective(PluginDirectiveSpec spec);
+
+/// Whether a plugin registered a directive with this (lower case) prefix.
+bool isPluginDirectivePrefix(std::string_view prefix);
+
+/// The registered directive, or null.
+const PluginDirectiveSpec *lookupPluginDirective(
+ std::string_view prefix, std::string_view keyword);
+
+/// Make `!$prefix` a directive sentinel for the directives with this (lower
+/// case) prefix: in free form, and in fixed form with `!`, `c` or `*` in
+/// column 1. The prescanner spells such a line `!dir$ prefix ...`, so it is
+/// parsed, resolved, written to module files and lowered as that spelling.
+/// A fixed form sentinel longer than four characters ends where `$prefix`
+/// does, and the column after it takes the place of column 6: blank on an
+/// initial line, and the continuation mark on a continuation line.
+/// `!$` followed by a blank remains OpenMP conditional compilation.
+/// Call from a static initializer in a plugin, like registerPluginDirective.
+void registerPluginDirectiveSentinel(std::string_view prefix);
+
+/// The sentinels registered by registerPluginDirectiveSentinel, as "$prefix".
+const std::vector<std::string> &getPluginDirectiveSentinels();
+
+} // namespace Fortran::common
+
+#endif // FORTRAN_SUPPORT_PLUGINDIRECTIVES_H_
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 9a35b82b8f20c..b8f23da2964c8 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -687,9 +687,130 @@ class FirConverter : public Fortran::lower::AbstractConverter {
*this, bridge.getSemanticsContext());
});
+ createBuilderOutsideOfFuncOpAndDo([&]() { lowerPluginDirectives(); });
+
finalizeOpenMPLowering(globalOmpRequiresSymbols);
}
+ /// Attach the directives defined by plugins to the operations of their
+ /// subjects in this module (a func.func for a procedure, a fir.global for a
+ /// variable), as a `fir.directives` array of dictionaries:
+ /// {prefix = "enzyme", keyword = "custom_rule",
+ /// args = {reverse = @_QMmPrev, ...}}
+ /// Procedure and variable arguments are symbol references, declaring the
+ /// procedure or module variable if this module does not yet; the plugin's
+ /// passes give them a meaning.
+ void lowerPluginDirectives() {
+ mlir::ModuleOp module{getModuleOp()};
+ mlir::MLIRContext *ctx{module.getContext()};
+ // What semantics lets a directive refer to: a subprogram or an external
+ // procedure, a variable, or a COMMON block. Nothing else has an operation
+ // (or even a mangled name).
+ auto isReferable{[](const Fortran::semantics::Symbol &sym) {
+ if (Fortran::semantics::IsProcedure(sym)) {
+ return !sym.has<Fortran::semantics::GenericDetails>() &&
+ !Fortran::semantics::IsDummy(sym) &&
+ !Fortran::semantics::IsProcedurePointer(sym) &&
+ !Fortran::semantics::IsStmtFunction(sym) &&
+ !sym.attrs().test(Fortran::semantics::Attr::INTRINSIC);
+ }
+ return sym.has<Fortran::semantics::ObjectEntityDetails>() ||
+ sym.has<Fortran::semantics::CommonBlockDetails>();
+ }};
+ // The operation of a procedure or variable, declared if need be (as a
+ // reference to it would): procedures, and variables of modules, which
+ // may be another module's.
+ auto getOrDeclare{[&](const Fortran::semantics::Symbol &sym)
+ -> mlir::Operation * {
+ if (!isReferable(sym)) {
+ return nullptr;
+ }
+ if (mlir::Operation *op{module.lookupSymbol(mangleName(sym))}) {
+ return op;
+ }
+ if (Fortran::semantics::IsProcedure(sym)) {
+ return Fortran::lower::getOrDeclareFunction(
+ Fortran::evaluate::ProcedureDesignator{sym}, *this)
+ .getOperation();
+ }
+ if (sym.has<Fortran::semantics::ObjectEntityDetails>() &&
+ sym.owner().IsModule()) {
+ return Fortran::lower::declareModuleVariable(*this, sym).getOperation();
+ }
+ return nullptr;
+ }};
+ for (const auto &[subject, directive, fromModFile] :
+ bridge.getSemanticsContext().GetPluginDirectives()) {
+ const Fortran::semantics::Symbol &ultimate{subject->GetUltimate()};
+ // The unit with the directive keeps it even for a procedure or variable
+ // it does not use otherwise (e.g. an external procedure with an
+ // interface body); a unit that sees it through a module file only for
+ // those it uses.
+ mlir::Operation *target{nullptr};
+ if (!fromModFile)
+ target = getOrDeclare(ultimate);
+ else if (isReferable(ultimate))
+ target = module.lookupSymbol(mangleName(ultimate));
+ if (!target) {
+ continue; // neither defined nor referenced here
+ }
+ const auto &[prefix, keyword, args]{
+ std::get<Fortran::parser::CompilerDirective::Plugin>(directive->u).t};
+ llvm::SmallVector<mlir::NamedAttribute> argAttrs;
+ for (const Fortran::parser::CompilerDirective::Plugin::Arg &arg : args) {
+ const auto &argKeyword{std::get<0>(arg.t)};
+ if (!argKeyword) {
+ continue; // the subject
+ }
+ mlir::Attribute value{Fortran::common::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::parser::Name &n) -> mlir::Attribute {
+ if (!n.symbol) {
+ return mlir::StringAttr::get(ctx, n.ToString());
+ }
+ mlir::Operation *op{getOrDeclare(n.symbol->GetUltimate())};
+ if (!op) {
+ return mlir::StringAttr::get(ctx, n.ToString());
+ }
+ return mlir::FlatSymbolRefAttr::get(
+ mlir::SymbolTable::getSymbolName(op));
+ },
+ [&](const Fortran::parser::CompilerDirective::Plugin::
+ CommonBlock &c) -> mlir::Attribute {
+ std::string name{c.v.symbol ? mangleName(*c.v.symbol)
+ : c.v.ToString()};
+ if (!module.lookupSymbol(name)) {
+ return mlir::StringAttr::get(ctx, c.v.ToString());
+ }
+ return mlir::FlatSymbolRefAttr::get(ctx, name);
+ },
+ [&](std::uint64_t n) -> mlir::Attribute {
+ return builder->getI64IntegerAttr(n);
+ },
+ [&](const std::string &str) -> mlir::Attribute {
+ return mlir::StringAttr::get(ctx, str);
+ },
+ },
+ std::get<1>(arg.t))};
+ argAttrs.push_back(
+ builder->getNamedAttr(argKeyword->ToString(), value));
+ }
+ mlir::Attribute entry{builder->getDictionaryAttr({
+ builder->getNamedAttr("prefix",
+ builder->getStringAttr(prefix.ToString())),
+ builder->getNamedAttr("keyword",
+ builder->getStringAttr(keyword.ToString())),
+ builder->getNamedAttr("args", builder->getDictionaryAttr(argAttrs)),
+ })};
+ llvm::SmallVector<mlir::Attribute> entries;
+ if (auto existing{
+ target->getAttrOfType<mlir::ArrayAttr>("fir.directives")})
+ entries.append(existing.begin(), existing.end());
+ entries.push_back(entry);
+ target->setAttr("fir.directives", builder->getArrayAttr(entries));
+ }
+ }
+
/// Declare a function.
void declareFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
CHECK(builder && "declareFunction called with uninitialized builder");
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 553032bb3909e..31f14abdfd406 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -3268,6 +3268,14 @@ void Fortran::lower::defineModuleVariable(
}
}
+fir::GlobalOp
+Fortran::lower::declareModuleVariable(AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym) {
+ Fortran::lower::pft::Variable var{sym, /*global=*/true};
+ return declareGlobal(converter, var, converter.mangleName(sym),
+ getLinkageAttribute(converter, var));
+}
+
void Fortran::lower::instantiateVariable(AbstractConverter &converter,
const pft::Variable &var,
Fortran::lower::SymMap &symMap,
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 263ce9249a8b2..931bdb2c8a034 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -38,6 +38,7 @@
#include "type-parser-implementation.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/user-state.h"
+#include "flang/Support/PluginDirectives.h"
namespace Fortran::parser {
@@ -1395,8 +1396,76 @@ constexpr auto inlinealwaysDir{
constexpr auto inlineDir{"INLINE" >> construct<CompilerDirective::Inline>()};
constexpr auto ivdep{"IVDEP" >> construct<CompilerDirective::IVDep>()};
constexpr auto simd{"SIMD" >> construct<CompilerDirective::Simd>()};
+// The prefix of a directive defined by a plugin: a name that a plugin
+// registered (flang/Support/PluginDirectives.h).
+struct PluginDirectivePrefix {
+ using resultType = Name;
+ constexpr PluginDirectivePrefix() {}
+ std::optional<Name> Parse(ParseState &state) const {
+ ParseState start{state};
+ if (std::optional<Name> n{name.Parse(state)}) {
+ std::string text{n->ToString()};
+ if (common::isPluginDirectivePrefix(text)) {
+ return n;
+ }
+ // Fixed form directives lose their blanks, so that the prefix runs
+ // into the keyword ("enzymeinactive"): take the longest registered
+ // prefix of the name.
+ if (state.inFixedForm()) {
+ for (std::size_t len{text.size() - 1}; len > 0; --len) {
+ if (common::isPluginDirectivePrefix(
+ std::string_view{text}.substr(0, len))) {
+ state = std::move(start);
+ space.Parse(state);
+ const char *begin{state.GetLocation()};
+ state.UncheckedAdvance(len);
+ return Name{CharBlock{begin, len}};
+ }
+ }
+ }
+ }
+ return std::nullopt;
+ }
+};
+constexpr auto pluginDirectiveValue{
+ construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
+ std::uint64_t, std::string>>(
+ construct<CompilerDirective::Plugin::CommonBlock>("/" >> name / "/")) ||
+ construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
+ std::uint64_t, std::string>>(name) ||
+ construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
+ std::uint64_t, std::string>>(digitString64) ||
+ construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
+ std::uint64_t, std::string>>(space >> charLiteralConstantWithoutKind)};
+constexpr auto pluginDirectiveArg{construct<CompilerDirective::Plugin::Arg>(
+ maybe(name / "="_tok), pluginDirectiveValue)};
+// The arguments of a directive defined by a plugin. Once its prefix is
+// recognized, the directive is the plugin's: arguments that do not parse are
+// an error, not an unrecognized directive to ignore.
+struct PluginDirectiveArgs {
+ using resultType = std::list<CompilerDirective::Plugin::Arg>;
+ constexpr PluginDirectiveArgs() {}
+ std::optional<resultType> Parse(ParseState &state) const {
+ static constexpr auto args{
+ defaulted(parenthesized(optionalList(pluginDirectiveArg))) /
+ lookAhead(endOfStmt)};
+ const char *start{state.GetLocation()};
+ ParseState backtrack{state};
+ if (std::optional<resultType> result{args.Parse(state)}) {
+ return result;
+ }
+ state = std::move(backtrack);
+ SkipTo<'\n'>{}.Parse(state);
+ state.Say(CharBlock{start, state.GetLocation()},
+ "malformed argument list of a directive defined by a plugin"_err_en_US);
+ return resultType{};
+ }
+};
+constexpr auto pluginDirective{construct<CompilerDirective::Plugin>(
+ PluginDirectivePrefix{}, name, PluginDirectiveArgs{})};
TYPE_PARSER(beginDirective >> some(letter) >> "$ "_tok >>
- sourced((construct<CompilerDirective>(ignore_tkr) ||
+ sourced((construct<CompilerDirective>(pluginDirective) ||
+ construct<CompilerDirective>(ignore_tkr) ||
construct<CompilerDirective>(loopCount) ||
construct<CompilerDirective>(assumeAligned) ||
construct<CompilerDirective>(vectorAlways) ||
diff --git a/flang/lib/Parser/parsing.cpp b/flang/lib/Parser/parsing.cpp
index 391416c8ba25b..dc8bfb263d7f1 100644
--- a/flang/lib/Parser/parsing.cpp
+++ b/flang/lib/Parser/parsing.cpp
@@ -13,6 +13,7 @@
#include "flang/Parser/preprocessor.h"
#include "flang/Parser/provenance.h"
#include "flang/Parser/source.h"
+#include "flang/Support/PluginDirectives.h"
#include "llvm/Support/raw_ostream.h"
namespace Fortran::parser {
@@ -105,6 +106,10 @@ const SourceFile *Parsing::Prescan(const std::string &path, Options options) {
for (const auto &sentinel : options.compilerDirectiveSentinels) {
prescanner.AddCompilerDirectiveSentinel(sentinel);
}
+ // !$prefix for the directives a plugin defines (Support/PluginDirectives.h)
+ for (const auto &sentinel : common::getPluginDirectiveSentinels()) {
+ prescanner.AddPluginDirectiveSentinel(sentinel);
+ }
ProvenanceRange range{allSources.AddIncludedFile(
*sourceFile, ProvenanceRange{}, options.isModuleFile)};
prescanner.Prescan(range);
diff --git a/flang/lib/Parser/prescan.cpp b/flang/lib/Parser/prescan.cpp
index e481661f8af8b..1aef084096a96 100644
--- a/flang/lib/Parser/prescan.cpp
+++ b/flang/lib/Parser/prescan.cpp
@@ -46,7 +46,8 @@ Prescanner::Prescanner(const Prescanner &that, Preprocessor &prepro,
prescannerNesting_{that.prescannerNesting_ + 1},
skipLeadingAmpersand_{that.skipLeadingAmpersand_},
compilerDirectiveBloomFilter_{that.compilerDirectiveBloomFilter_},
- compilerDirectiveSentinels_{that.compilerDirectiveSentinels_} {}
+ compilerDirectiveSentinels_{that.compilerDirectiveSentinels_},
+ pluginDirectiveSentinels_{that.pluginDirectiveSentinels_} {}
// Returns number of bytes to skip
static inline int IsSpace(const char *p) {
@@ -175,11 +176,22 @@ void Prescanner::Statement() {
// (ditto for !@cuf and !@acc).
EmitChar(tokens, '!');
++at_, ++column_;
- for (const char *sp{directiveSentinel_}; *sp != '\0';
- ++sp, ++at_, ++column_) {
+ const char *sp{directiveSentinel_};
+ if (InPluginDirective()) {
+ // !$prefix is spelled !dir$ prefix, a directive the parser knows.
+ EmitInsertedChar(tokens, 'd');
+ EmitInsertedChar(tokens, 'i');
+ EmitInsertedChar(tokens, 'r');
+ EmitChar(tokens, *sp++); // '$'
+ ++at_, ++column_;
+ EmitInsertedChar(tokens, ' ');
+ tokens.CloseToken();
+ }
+ for (; *sp != '\0'; ++sp, ++at_, ++column_) {
EmitChar(tokens, *sp);
}
- if (inFixedForm_) {
+ // Only a plugin directive sentinel can extend past column 5.
+ if (inFixedForm_ && column_ <= 6) {
// We need to add the whitespace after the sentinel because otherwise
// the line cannot be re-categorised as a compiler directive.
while (column_ <= 6) {
@@ -1516,8 +1528,11 @@ const char *Prescanner::FixedFormContinuationLine(
// !$ under -E is not continued, but deferred to later compilation
if (IsFixedFormCommentChar(col1) &&
!(InConditionalLine() && preprocessingOnly_)) {
+ // The sentinel and blanks up to column 5, or the end of a longer
+ // (plugin directive) sentinel; then the continuation column.
+ int fieldEnd{FixedFormSentinelFieldEnd(directiveSentinel_)};
int j{1};
- for (; j < 5; ++j) {
+ for (; j < fieldEnd; ++j) {
char ch{directiveSentinel_[j - 1]};
if (ch == '\0') {
break;
@@ -1525,17 +1540,17 @@ const char *Prescanner::FixedFormContinuationLine(
return nullptr;
}
}
- for (; j < 5; ++j) {
+ for (; j < fieldEnd; ++j) {
if (nextLine_[j] != ' ') {
return nullptr;
}
}
- const char *col6{nextLine_ + 5};
+ const char *col6{nextLine_ + fieldEnd};
if (*col6 != '\n' && *col6 != '0' && !IsSpaceOrTab(col6)) {
- if (atNewline && !IsSpace(nextLine_ + 6)) {
+ if (atNewline && !IsSpace(col6 + 1)) {
brokenToken_ = true;
}
- return nextLine_ + 6;
+ return col6 + 1;
}
}
} else { // Normal case: not in a compiler directive.
@@ -1733,7 +1748,9 @@ bool Prescanner::FixedFormContinuation(bool atNewline) {
"unterminated C-style comment"_err_en_US);
}
BeginSourceLine(cont);
- column_ = 7;
+ column_ = InCompilerDirective()
+ ? FixedFormSentinelFieldEnd(directiveSentinel_) + 2
+ : 7;
NextLine();
return true;
}
@@ -1820,6 +1837,24 @@ Prescanner::IsFixedFormCompilerDirectiveLine(const char *start) const {
return std::nullopt;
}
*sp = '\0';
+ // A plugin directive sentinel ($prefix) may be longer than columns 2-5;
+ // the column after it then takes the place of column 6, and must be blank
+ // on an initial line.
+ if (column == 6 && sentinel[0] == '$' && IsLetter(*p) &&
+ !pluginDirectiveSentinels_.empty()) {
+ std::string longSentinel{sentinel};
+ const char *q{p};
+ for (; IsLetter(*q); ++q) {
+ longSentinel += ToLowerCaseLetter(*q);
+ }
+ if (const char *ss{IsCompilerDirectiveSentinel(
+ longSentinel.data(), longSentinel.size())};
+ ss && IsPluginDirectiveSentinel(ss) &&
+ (*q == '\n' || IsSpaceOrTab(q))) {
+ return {LineClassification{
+ LineClassification::Kind::CompilerDirective, 0, ss}};
+ }
+ }
// A fixed form OpenMP conditional compilation sentinel must satisfy the
// following criteria, for initial lines:
// - Columns 3 through 5 must have only white space or numbers.
@@ -1913,6 +1948,12 @@ Prescanner &Prescanner::AddCompilerDirectiveSentinel(const std::string &dir) {
return *this;
}
+Prescanner &Prescanner::AddPluginDirectiveSentinel(const std::string &dir) {
+ AddCompilerDirectiveSentinel(dir);
+ pluginDirectiveSentinels_.insert(dir);
+ return *this;
+}
+
std::optional<CharBlock> Prescanner::GetKeywordMacroName(
const char *start) const {
if (IsLegalIdentifierStart(*start)) {
@@ -1978,7 +2019,7 @@ const char *Prescanner::IsCompilerDirectiveSentinel(CharBlock token) const {
std::optional<std::pair<const char *, const char *>>
Prescanner::IsCompilerDirectiveSentinel(const char *p) const {
- char sentinel[8];
+ char sentinel[16]; // room for plugin directive sentinels ($prefix)
for (std::size_t j{0}; j + 1 < sizeof sentinel; ++p, ++j) {
if (int n{IsSpaceOrTab(p)};
n || !(IsLetter(*p) || *p == '$' || *p == '@')) {
diff --git a/flang/lib/Parser/prescan.h b/flang/lib/Parser/prescan.h
index 900d8b6cb52ad..7db9841e34242 100644
--- a/flang/lib/Parser/prescan.h
+++ b/flang/lib/Parser/prescan.h
@@ -74,6 +74,9 @@ class Prescanner {
}
Prescanner &AddCompilerDirectiveSentinel(const std::string &);
+ // "$prefix" for a plugin directive prefix: `!$prefix` lines are spelled
+ // `!dir$ prefix` (see flang/Support/PluginDirectives.h).
+ Prescanner &AddPluginDirectiveSentinel(const std::string &);
void Prescan(ProvenanceRange);
void Statement();
@@ -212,6 +215,19 @@ class Prescanner {
std::strcmp(directiveSentinel_, "$omx") == 0 ||
std::strcmp(directiveSentinel_, "$ompx") == 0);
}
+ bool IsPluginDirectiveSentinel(const char *sentinel) const {
+ return sentinel && pluginDirectiveSentinels_.count(sentinel) > 0;
+ }
+ bool InPluginDirective() const {
+ return IsPluginDirectiveSentinel(directiveSentinel_);
+ }
+ // The last column of the sentinel field of a fixed form directive line:
+ // 5, or the end of a longer (plugin) sentinel, which the continuation
+ // column follows.
+ int FixedFormSentinelFieldEnd(const char *sentinel) const {
+ int length{static_cast<int>(std::strlen(sentinel))};
+ return length > 4 ? 1 + length : 5;
+ }
bool IsPastFixedFormColumnLimit(int column) const {
return fixedFormColumnLimit_ && column > *fixedFormColumnLimit_;
}
@@ -345,6 +361,7 @@ class Prescanner {
static const int prime1{1019}, prime2{1021};
std::bitset<prime2> compilerDirectiveBloomFilter_; // 128 bytes
std::unordered_set<std::string> compilerDirectiveSentinels_;
+ std::unordered_set<std::string> pluginDirectiveSentinels_;
};
} // namespace Fortran::parser
#endif // FORTRAN_PARSER_PRESCAN_H_
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index a046c08e710c6..72e245ab66be0 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1949,10 +1949,33 @@ class UnparseVisitor {
Word("!DIR$ ");
Word(x.source.ToString());
},
+ [&](const CompilerDirective::Plugin &plugin) {
+ Word("!DIR$ ");
+ Walk(std::get<0>(plugin.t));
+ Put(' ');
+ Walk(std::get<1>(plugin.t));
+ if (const auto &args{std::get<2>(plugin.t)}; !args.empty()) {
+ Walk("(", args, ", ", ")");
+ }
+ },
},
x.u);
Put('\n');
}
+ void Unparse(const CompilerDirective::Plugin::Arg &x) {
+ Walk(std::get<0>(x.t), "=");
+ common::visit(common::visitors{
+ [&](const Name &n) { Walk(n); },
+ [&](const CompilerDirective::Plugin::CommonBlock &c) {
+ Put('/');
+ Walk(c.v);
+ Put('/');
+ },
+ [&](std::uint64_t n) { Put(std::to_string(n)); },
+ [&](const std::string &str) { PutNormalized(str); },
+ },
+ std::get<1>(x.t));
+ }
void Unparse(const CompilerDirective::IgnoreTKR &x) {
if (const auto &maybeList{
std::get<std::optional<std::list<const char *>>>(x.t)}) {
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index c2d5b04a915b6..a3856061ea90a 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -396,6 +396,74 @@ static void PutOpenMPRequirements(
}
}
+// Directives defined by plugins whose subject this module declares, so that a
+// scope using the module sees them too. Written in canonical form, always
+// naming the subject (which a directive in a subprogram may leave implicit).
+// A directive in a module procedure may name what is not visible in the
+// module (e.g. an internal procedure or a dummy argument); it is left out, as
+// it could not be read back.
+static void PutPluginDirectives(
+ llvm::raw_ostream &os, const Scope &scope, SemanticsContext &context) {
+ // Whether a name argument means the same in the module as in the
+ // directive.
+ auto isVisible{[&](const Symbol &symbol) {
+ const Symbol *found{scope.FindSymbol(symbol.name())};
+ return found && &found->GetUltimate() == &symbol.GetUltimate();
+ }};
+ for (const auto &[subject, directive, fromModFile] :
+ context.GetPluginDirectives()) {
+ if (&subject->owner() != &scope) {
+ continue;
+ }
+ const auto &[prefix, keyword, args]{
+ std::get<parser::CompilerDirective::Plugin>(directive->u).t};
+ std::string buf;
+ llvm::raw_string_ostream line{buf};
+ line << "!dir$ " << prefix.ToString() << ' ' << keyword.ToString() << '(';
+ if (subject->has<CommonBlockDetails>()) {
+ line << '/' << subject->name().ToString() << '/';
+ } else {
+ line << subject->name().ToString();
+ }
+ const parser::Name *hidden{nullptr};
+ for (const parser::CompilerDirective::Plugin::Arg &arg : args) {
+ const auto &argKeyword{std::get<0>(arg.t)};
+ if (!argKeyword) {
+ continue; // the subject, written above
+ }
+ line << ", " << argKeyword->ToString() << '=';
+ common::visit(
+ common::visitors{
+ [&](const parser::Name &n) {
+ if (n.symbol && !isVisible(*n.symbol)) {
+ hidden = &n;
+ }
+ line << (n.symbol ? n.symbol->name().ToString() : n.ToString());
+ },
+ [&](const parser::CompilerDirective::Plugin::CommonBlock &c) {
+ if (!scope.FindCommonBlockInVisibleScopes(c.v.source)) {
+ hidden = &c.v;
+ }
+ line << '/' << c.v.ToString() << '/';
+ },
+ [&](std::uint64_t n) { line << n; },
+ [&](const std::string &str) {
+ line << parser::QuoteCharacterLiteral(str);
+ },
+ },
+ std::get<1>(arg.t));
+ }
+ if (hidden) {
+ context.Warn(common::UsageWarning::IgnoredDirective, hidden->source,
+ "This '%s %s' directive is not written to the module file of '%s', where '%s' is not visible; units that use the module do not see it"_warn_en_US,
+ prefix.ToString(), keyword.ToString(), scope.GetName().value(),
+ hidden->source);
+ continue;
+ }
+ os << buf << ")\n";
+ }
+}
+
static void PutOpenMPDeclarativeDirectives(llvm::raw_ostream &os,
const SymbolVector &symbols, SemanticsContext &semaCtx) {
llvm::omp::Version version{semaCtx.langOptions().getOpenMPVersion()};
@@ -471,6 +539,7 @@ void ModFileWriter::PutSymbols(
}
PutOpenMPRequirements(decls_, DEREF(scope.symbol()), context_);
PutOpenMPDeclarativeDirectives(decls_, sorted, context_);
+ PutPluginDirectives(decls_, scope, context_);
for (const auto &set : scope.equivalenceSets()) {
if (!set.empty() &&
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 67690d6f47d06..d1e0dbccc7f8d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -41,6 +41,7 @@
#include "flang/Semantics/tools.h"
#include "flang/Semantics/type.h"
#include "flang/Support/Fortran.h"
+#include "flang/Support/PluginDirectives.h"
#include "flang/Support/default-kinds.h"
#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/SmallVector.h"
@@ -2416,6 +2417,8 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
void Post(const parser::AssignStmt &);
void Post(const parser::AssignedGotoStmt &);
void Post(const parser::CompilerDirective &);
+ void ResolvePluginDirective(const parser::CompilerDirective &,
+ const parser::CompilerDirective::Plugin &);
bool Pre(const parser::SectionSubscript &);
@@ -11457,12 +11460,283 @@ void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
"INLINEALWAYS name '%s' does not match the subprogram name '%s'"_warn_en_US,
inlineAlways->v->ToString(), sym->name().ToString());
}
- } else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) {
+ } else if (const auto *plugin{
+ std::get_if<parser::CompilerDirective::Plugin>(&x.u)}) {
+ ResolvePluginDirective(x, *plugin);
+ } else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective) &&
+ // A module file may hold the directives of a plugin that is not
+ // loaded here (see PutPluginDirectives); they are not the user's to fix.
+ !(currScope().symbol() && currScope().symbol()->IsFromModFile())) {
Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US)
.set_usageWarning(common::UsageWarning::IgnoredDirective);
}
}
+// A directive registered by a plugin: resolve its name arguments, check them
+// against the registered argument kinds, and record it with its subject.
+void ResolveNamesVisitor::ResolvePluginDirective(
+ const parser::CompilerDirective &x,
+ const parser::CompilerDirective::Plugin &plugin) {
+ const auto &[prefix, keyword, args]{plugin.t};
+ const common::PluginDirectiveSpec *spec{
+ common::lookupPluginDirective(prefix.ToString(), keyword.ToString())};
+ if (!spec) {
+ Say(keyword.source, "Unknown '%s' directive '%s'"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ return;
+ }
+ auto isProcedure{[](const Symbol &symbol) {
+ // A procedure under CONTAINS that is named before it is defined.
+ return symbol.has<SubprogramNameDetails>() ||
+ IsProcedure(symbol.GetUltimate());
+ }};
+ // Check that a name stands for a procedure (kind Procedure), a variable
+ // (kind Variable) or either (no kind), as lowering can refer to it: a
+ // subprogram or an external procedure, not a dummy procedure, a procedure
+ // pointer, a statement function or an intrinsic; a variable, not e.g. a
+ // derived type or a namelist group. A generic interface is checked below,
+ // as a subject and as an argument.
+ auto checkKind{[&](const parser::Name &name, const Symbol *symbol,
+ std::optional<common::PluginDirectiveArgKind> kind) {
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (!isProcedure(*symbol)) {
+ if (kind == common::PluginDirectiveArgKind::Procedure) {
+ Say(name, "'%s' is not a procedure"_err_en_US);
+ return false;
+ }
+ if (!ultimate.has<ObjectEntityDetails>() &&
+ !ultimate.has<EntityDetails>()) {
+ Say(name, "'%s' is not a variable"_err_en_US);
+ return false;
+ }
+ return true;
+ }
+ if (kind == common::PluginDirectiveArgKind::Variable) {
+ Say(name, "'%s' is not a variable"_err_en_US);
+ return false;
+ }
+ if (ultimate.has<GenericDetails>()) {
+ return true; // a subject stands for its specifics; not an argument
+ }
+ if (IsDummy(ultimate) || IsProcedurePointer(ultimate) ||
+ ultimate.test(Symbol::Flag::StmtFunction) ||
+ ultimate.attrs().test(Attr::INTRINSIC)) {
+ Say(name, "'%s' must be a subprogram or an external procedure"_err_en_US);
+ return false;
+ }
+ return true;
+ }};
+ auto resolve{[&](const parser::Name &name,
+ std::optional<common::PluginDirectiveArgKind> kind)
+ -> const Symbol * {
+ Symbol *symbol{FindSymbol(name)};
+ if (!symbol) {
+ Say(name, "'%s' is not declared"_err_en_US);
+ return nullptr;
+ }
+ // In a function without a RESULT clause, its name is its result
+ // variable; where a procedure may be meant, it is the function.
+ if (kind != common::PluginDirectiveArgKind::Variable) {
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (IsFunctionResult(ultimate)) {
+ if (const Symbol *function{ultimate.owner().symbol()};
+ function && function->name() == ultimate.name()) {
+ symbol = const_cast<Symbol *>(function);
+ }
+ }
+ }
+ name.symbol = symbol;
+ return symbol;
+ }};
+ auto resolveCommon{[&](const parser::Name &name) -> Symbol * {
+ Symbol *symbol{currScope().FindCommonBlockInVisibleScopes(name.source)};
+ if (!symbol) {
+ Say(name, "COMMON block /%s/ is not declared"_err_en_US);
+ return nullptr;
+ }
+ name.symbol = symbol;
+ return symbol;
+ }};
+
+ // The subject: a leading positional name, or the enclosing subprogram.
+ std::optional<common::PluginDirectiveArgKind> subjectKind;
+ if (spec->subject == common::PluginDirectiveSubject::Procedure) {
+ subjectKind = common::PluginDirectiveArgKind::Procedure;
+ } else if (spec->subject == common::PluginDirectiveSubject::Variable) {
+ subjectKind = common::PluginDirectiveArgKind::Variable;
+ }
+ auto it{args.begin()};
+ const Symbol *subject{nullptr};
+ const parser::Name *subjectNamePtr{nullptr};
+ if (it != args.end() && !std::get<0>(it->t)) {
+ const auto &value{std::get<1>(it->t)};
+ if (const auto *name{std::get_if<parser::Name>(&value)}) {
+ subjectNamePtr = name;
+ subject = resolve(*name, subjectKind);
+ } else if (const auto *common{
+ std::get_if<parser::CompilerDirective::Plugin::CommonBlock>(
+ &value)}) {
+ subjectNamePtr = &common->v;
+ subject = resolveCommon(common->v);
+ } else {
+ Say(x.source,
+ "The subject of a '%s %s' directive must be a name or a COMMON block"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ return;
+ }
+ if (!subject) {
+ return;
+ }
+ ++it;
+ } else if (spec->subject != common::PluginDirectiveSubject::Variable) {
+ const Symbol *scopeSymbol{currScope().symbol()};
+ if (scopeSymbol && scopeSymbol->has<SubprogramDetails>()) {
+ subject = scopeSymbol;
+ }
+ }
+ if (!subject) {
+ Say(x.source,
+ "A '%s %s' directive must name what it applies to, or appear in a subprogram"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ return;
+ }
+ const parser::Name &subjectName{subjectNamePtr ? *subjectNamePtr : keyword};
+ if (subject->has<CommonBlockDetails>()) {
+ if (subjectKind == common::PluginDirectiveArgKind::Procedure) {
+ Say(subjectName, "'%s' is not a procedure"_err_en_US);
+ return;
+ }
+ } else if (!checkKind(subjectName, subject, subjectKind)) {
+ return;
+ }
+ // A generic interface stands for all of its specific procedures, also
+ // private ones and those of other modules, which a directive elsewhere
+ // could not name. Not for a directive with procedure arguments, which
+ // each specific procedure would need its own of.
+ // A name of the host (e.g. a procedure's own name, in it) is host
+ // associated; the directive is on the host's symbol, which a module file
+ // declares.
+ while (const auto *host{subject->detailsIf<HostAssocDetails>()}) {
+ subject = &host->symbol();
+ }
+ std::vector<const Symbol *> subjects{subject};
+ if (const auto *generic{subject->GetUltimate().detailsIf<GenericDetails>()}) {
+ bool takesProcedures{false};
+ for (const common::PluginDirectiveArg &a : spec->args) {
+ takesProcedures |= a.kind == common::PluginDirectiveArgKind::Procedure;
+ }
+ if (takesProcedures) {
+ Say(subjectName.source,
+ "'%s' is a generic interface; a '%s %s' directive must name one of its specific procedures"_err_en_US,
+ subjectName.ToString(), prefix.ToString(), keyword.ToString());
+ return;
+ }
+ subjects.clear();
+ for (const Symbol &specific : generic->specificProcs()) {
+ subjects.push_back(&specific);
+ }
+ if (const Symbol *specific{generic->specific()}; specific &&
+ std::find(subjects.begin(), subjects.end(), specific) ==
+ subjects.end()) {
+ subjects.push_back(specific);
+ }
+ if (subjects.empty()) {
+ Say(subjectName.source,
+ "Generic interface '%s' has no specific procedures"_err_en_US,
+ subjectName.ToString());
+ return;
+ }
+ }
+
+ // The other arguments are keyword arguments.
+ std::set<std::string> seen;
+ bool ok{true};
+ for (; it != args.end(); ++it) {
+ const auto &maybeKeyword{std::get<0>(it->t)};
+ if (!maybeKeyword) {
+ Say(x.source,
+ "Only the first argument of a '%s %s' directive may be positional"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ ok = false;
+ continue;
+ }
+ std::string argName{maybeKeyword->ToString()};
+ const common::PluginDirectiveArg *argSpec{nullptr};
+ for (const common::PluginDirectiveArg &a : spec->args) {
+ if (a.keyword == argName) {
+ argSpec = &a;
+ }
+ }
+ if (!argSpec) {
+ Say(maybeKeyword->source,
+ "'%s' is not an argument of the '%s %s' directive"_err_en_US, argName,
+ prefix.ToString(), keyword.ToString());
+ ok = false;
+ continue;
+ }
+ if (!seen.insert(argName).second) {
+ Say(maybeKeyword->source,
+ "Argument '%s' appears more than once"_err_en_US, argName);
+ ok = false;
+ continue;
+ }
+ const auto &value{std::get<1>(it->t)};
+ switch (argSpec->kind) {
+ case common::PluginDirectiveArgKind::Procedure:
+ case common::PluginDirectiveArgKind::Variable:
+ if (const auto *name{std::get_if<parser::Name>(&value)}) {
+ const Symbol *symbol{resolve(*name, argSpec->kind)};
+ ok &= symbol && checkKind(*name, symbol, argSpec->kind);
+ if (symbol &&
+ argSpec->kind == common::PluginDirectiveArgKind::Procedure &&
+ symbol->GetUltimate().has<GenericDetails>()) {
+ Say(name->source,
+ "'%s' is a generic interface; argument '%s' of a '%s %s' directive must name a specific procedure"_err_en_US,
+ name->ToString(), argName, prefix.ToString(), keyword.ToString());
+ ok = false;
+ }
+ } else if (const auto *common{std::get_if<
+ parser::CompilerDirective::Plugin::CommonBlock>(&value)};
+ common && argSpec->kind == common::PluginDirectiveArgKind::Variable) {
+ ok &= resolveCommon(common->v) != nullptr;
+ } else {
+ Say(maybeKeyword->source, "Argument '%s' must be a name"_err_en_US,
+ argName);
+ ok = false;
+ }
+ break;
+ case common::PluginDirectiveArgKind::Integer:
+ if (!std::holds_alternative<std::uint64_t>(value)) {
+ Say(maybeKeyword->source, "Argument '%s' must be an integer"_err_en_US,
+ argName);
+ ok = false;
+ }
+ break;
+ case common::PluginDirectiveArgKind::String:
+ if (std::holds_alternative<std::uint64_t>(value)) {
+ Say(maybeKeyword->source,
+ "Argument '%s' must be a character literal or a name"_err_en_US,
+ argName);
+ ok = false;
+ }
+ break;
+ }
+ }
+ for (const common::PluginDirectiveArg &a : spec->args) {
+ if (a.required && !seen.count(a.keyword)) {
+ Say(x.source, "The '%s %s' directive requires argument '%s'"_err_en_US,
+ prefix.ToString(), keyword.ToString(), a.keyword);
+ ok = false;
+ }
+ }
+ if (ok) {
+ for (const Symbol *s : subjects) {
+ context().AddPluginDirective(*s, x,
+ currScope().symbol() && currScope().symbol()->IsFromModFile());
+ }
+ }
+}
+
bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
x.u)) {
diff --git a/flang/lib/Support/CMakeLists.txt b/flang/lib/Support/CMakeLists.txt
index 599cd485f87c4..2b6601c808db5 100644
--- a/flang/lib/Support/CMakeLists.txt
+++ b/flang/lib/Support/CMakeLists.txt
@@ -47,6 +47,7 @@ add_flang_library(FortranSupport
FPMaxminBehavior.cpp
Flags.cpp
Fortran.cpp
+ PluginDirectives.cpp
Fortran-features.cpp
idioms.cpp
LangOptions.cpp
diff --git a/flang/lib/Support/PluginDirectives.cpp b/flang/lib/Support/PluginDirectives.cpp
new file mode 100644
index 0000000000000..1187572f8850a
--- /dev/null
+++ b/flang/lib/Support/PluginDirectives.cpp
@@ -0,0 +1,63 @@
+//===-- lib/Support/PluginDirectives.cpp ----------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Support/PluginDirectives.h"
+#include <list>
+
+namespace Fortran::common {
+
+// A list, so that the specs never move once registered.
+static std::list<PluginDirectiveSpec> &getPluginDirectives() {
+ static std::list<PluginDirectiveSpec> specs;
+ return specs;
+}
+
+void registerPluginDirective(PluginDirectiveSpec spec) {
+ getPluginDirectives().push_back(std::move(spec));
+}
+
+bool isPluginDirectivePrefix(std::string_view prefix) {
+ for (const PluginDirectiveSpec &spec : getPluginDirectives()) {
+ if (spec.prefix == prefix) {
+ return true;
+ }
+ }
+ return false;
+}
+
+const PluginDirectiveSpec *lookupPluginDirective(
+ std::string_view prefix, std::string_view keyword) {
+ for (const PluginDirectiveSpec &spec : getPluginDirectives()) {
+ if (spec.prefix == prefix && spec.keyword == keyword) {
+ return &spec;
+ }
+ }
+ return nullptr;
+}
+
+static std::vector<std::string> &getSentinels() {
+ static std::vector<std::string> sentinels;
+ return sentinels;
+}
+
+void registerPluginDirectiveSentinel(std::string_view prefix) {
+ std::string sentinel{"$"};
+ sentinel += prefix;
+ for (const std::string &s : getSentinels()) {
+ if (s == sentinel) {
+ return;
+ }
+ }
+ getSentinels().push_back(std::move(sentinel));
+}
+
+const std::vector<std::string> &getPluginDirectiveSentinels() {
+ return getSentinels();
+}
+
+} // namespace Fortran::common
diff --git a/flang/test/CMakeLists.txt b/flang/test/CMakeLists.txt
index 50980a521b241..7d1b57f7f7d75 100644
--- a/flang/test/CMakeLists.txt
+++ b/flang/test/CMakeLists.txt
@@ -138,6 +138,7 @@ if (LLVM_INCLUDE_EXAMPLES)
flangPrintFunctionNames
flangOmpReport
flangFeatureList
+ flangDirectivesPlugin
)
endif ()
diff --git a/flang/test/Examples/plugin-directives-errors.f90 b/flang/test/Examples/plugin-directives-errors.f90
new file mode 100644
index 0000000000000..dc60722045e52
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-errors.f90
@@ -0,0 +1,65 @@
+! Check the semantic errors in the directives of a plugin loaded with
+! `flang -fc1 -load`.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: rm -rf %t && mkdir -p %t
+! RUN: not %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -fsyntax-only -module-dir %t %s 2>&1 | FileCheck %s
+
+module m_errors
+ real :: x
+ type t
+ end type
+ interface gen
+ module procedure gen1, gen2
+ end interface
+ ! CHECK: error: A 'example watch' directive must name what it applies to, or appear in a subprogram
+ !dir$ example watch(by=x)
+ ! CHECK: error: Unknown 'example' directive 'nothing'
+ !dir$ example nothing
+contains
+ subroutine gen1(a)
+ integer :: a
+ end
+ subroutine gen2(a)
+ real :: a
+ end
+ subroutine s(dummy, pp)
+ external dummy
+ procedure(), pointer :: pp
+ integer :: sf, i
+ sf(i) = i
+ ! CHECK: error: The 'example callback' directive requires argument 'handler'
+ !dir$ example callback(priority=1)
+ ! CHECK: error: 'priority' is not an argument of the 'example watch' directive
+ !dir$ example watch(x, priority=1)
+ ! CHECK: error: Argument 'priority' must be an integer
+ !dir$ example callback(handler=s, priority=high)
+ ! CHECK: error: Argument 'handler' appears more than once
+ !dir$ example callback(handler=s, handler=s)
+ ! CHECK: error: Only the first argument of a 'example callback' directive may be positional
+ !dir$ example callback(handler=s, s)
+ ! CHECK: error: 'x' is not a procedure
+ !dir$ example callback(handler=x)
+ ! CHECK: error: 's' is not a variable
+ !dir$ example watch(s)
+ ! CHECK: error: 't' is not a variable
+ !dir$ example watch(x, by=t)
+ ! CHECK: error: 'undeclared' is not declared
+ !dir$ example callback(handler=undeclared)
+ ! CHECK: error: COMMON block /nocommon/ is not declared
+ !dir$ example watch(/nocommon/)
+ ! CHECK: error: 'gen' is a generic interface; argument 'handler' of a 'example callback' directive must name a specific procedure
+ !dir$ example callback(handler=gen)
+ ! CHECK: error: 'gen' is a generic interface; a 'example callback' directive must name one of its specific procedures
+ !dir$ example callback(gen, handler=s)
+ ! CHECK: error: 'dummy' must be a subprogram or an external procedure
+ !dir$ example callback(handler=dummy)
+ ! CHECK: error: 'pp' must be a subprogram or an external procedure
+ !dir$ example callback(handler=pp)
+ ! CHECK: error: 'sf' must be a subprogram or an external procedure
+ !dir$ example callback(handler=sf)
+ end
+end
diff --git a/flang/test/Examples/plugin-directives-module.f90 b/flang/test/Examples/plugin-directives-module.f90
new file mode 100644
index 0000000000000..c0564cab89083
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-module.f90
@@ -0,0 +1,57 @@
+! Check that the directives of a plugin loaded with `flang -fc1 -load` on the
+! entities of a module are written to its module file, and seen by the units
+! that use it.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: rm -rf %t && split-file %s %t
+! RUN: %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -fsyntax-only -module-dir %t %t/m.f90 2>&1 \
+! RUN: | FileCheck %s --check-prefix=WARN
+! RUN: FileCheck %s --check-prefix=MOD < %t/m.mod
+! RUN: %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -emit-hlfir -module-dir %t -o - %t/use.f90 | FileCheck %s
+
+! Without the plugin, the directives of the module file are ignored silently.
+! RUN: %flang_fc1 -emit-hlfir -module-dir %t -o - %t/use.f90 2>&1 \
+! RUN: | FileCheck %s --check-prefix=NOPLUGIN
+
+!--- m.f90
+module m
+ real :: x
+ !dir$ example watch(x)
+contains
+ subroutine on_call
+ end
+ subroutine s(y)
+ real :: y
+ !dir$ example callback(handler=on_call, tag="s")
+ ! A procedure naming itself.
+ !dir$ example note(s, text="self")
+ ! Not visible in the module: left out of the module file.
+ !dir$ example callback(handler=internal)
+ contains
+ subroutine internal
+ end
+ end
+end
+
+!--- use.f90
+subroutine u
+ use m
+ call s(x)
+end
+
+! WARN: warning: This 'example callback' directive is not written to the module file of 'm', where 'internal' is not visible; units that use the module do not see it
+
+! MOD: !dir$ example watch(x)
+! MOD-NEXT: !dir$ example callback(s, handler=on_call, tag="s")
+! MOD-NEXT: !dir$ example note(s, text="self")
+! MOD-NOT: internal
+
+! CHECK-DAG: fir.global @_QMmEx {fir.directives = [{args = {}, keyword = "watch", prefix = "example"}]}
+! CHECK-DAG: func.func private @_QMmPs(!fir.ref<f32>) attributes {fir.directives = [{args = {handler = @_QMmPon_call, tag = "s"}, keyword = "callback", prefix = "example"}, {args = {text = "self"}, keyword = "note", prefix = "example"}]}
+
+! NOPLUGIN-NOT: warning
+! NOPLUGIN-NOT: fir.directives
diff --git a/flang/test/Examples/plugin-directives-parse.f90 b/flang/test/Examples/plugin-directives-parse.f90
new file mode 100644
index 0000000000000..a3e76240f4156
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-parse.f90
@@ -0,0 +1,19 @@
+! Check that a directive with the prefix of a plugin loaded with
+! `flang -fc1 -load` but malformed arguments is an error, not an ignored
+! directive.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: not %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -fsyntax-only %s 2>&1 | FileCheck %s
+
+subroutine s
+ ! CHECK: error: malformed argument list of a directive defined by a plugin
+ !dir$ example callback(handler=s, priority=1.5)
+ ! CHECK: error: malformed argument list of a directive defined by a plugin
+ !dir$ example callback(handler=s, priority=-1)
+ ! CHECK: error: malformed argument list of a directive defined by a plugin
+ !dir$ example callback(handler=s) trailing
+ ! CHECK-NOT: Unrecognized compiler directive
+end
diff --git a/flang/test/Examples/plugin-directives-sentinel.f b/flang/test/Examples/plugin-directives-sentinel.f
new file mode 100644
index 0000000000000..36d110dc177e7
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-sentinel.f
@@ -0,0 +1,28 @@
+! Check the comment sentinel of a plugin loaded with `flang -fc1 -load` in
+! fixed form, and that without the plugin its lines are comments.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -emit-hlfir -o - %s | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -o - %s 2>&1 | FileCheck %s --check-prefix=NOPLUGIN
+! RUN: %flang_fc1 -fopenmp -emit-hlfir -o - %s 2>&1 \
+! RUN: | FileCheck %s --check-prefix=NOPLUGIN
+
+ subroutine s
+c$example note(text='c in column 1')
+ end
+
+ subroutine t
+ external s
+*$example callback(handler=s,
+*$example+ tag='continued')
+ end
+
+! CHECK-DAG: func.func @_QPs() attributes {fir.directives = [{args = {text = "c in column 1"}, keyword = "note", prefix = "example"}]}
+! CHECK-DAG: func.func @_QPt() attributes {fir.directives = [{args = {handler = @_QPs, tag = "continued"}, keyword = "callback", prefix = "example"}]}
+
+! NOPLUGIN-NOT: warning
+! NOPLUGIN-NOT: error
+! NOPLUGIN-NOT: fir.directives
diff --git a/flang/test/Examples/plugin-directives.f90 b/flang/test/Examples/plugin-directives.f90
new file mode 100644
index 0000000000000..ee54fd016eb5a
--- /dev/null
+++ b/flang/test/Examples/plugin-directives.f90
@@ -0,0 +1,73 @@
+! Check that the directives of a plugin loaded with `flang -fc1 -load` are
+! attached to the operations of their subjects.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: rm -rf %t && mkdir -p %t
+! RUN: %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -emit-hlfir -module-dir %t -o - %s | FileCheck %s
+
+module m
+ real :: x, y
+ common /blk/ z
+ real :: z
+ interface gen
+ module procedure gen_i, gen_r
+ end interface
+
+ ! A directive in a module names its subject.
+ !dir$ example watch(x, by=y)
+ !dir$ example watch(/blk/)
+ !dir$ example note(y, text="a variable")
+ ! A generic interface stands for each of its specific procedures.
+ !dir$ example note(gen, text="generic")
+contains
+ subroutine gen_i(i)
+ integer :: i
+ end
+ subroutine gen_r(r)
+ real :: r
+ end
+
+ subroutine on_call
+ end
+
+ ! In a subprogram, the subject is the subprogram unless named.
+ subroutine s
+ !dir$ example callback(handler=on_call, priority=2, tag="s")
+ !dir$ example note(text=no_quotes)
+ end
+
+ ! A function's own name, without a RESULT clause, is the function.
+ function f()
+ real :: f
+ !DIR$ EXAMPLE CALLBACK(f, HANDLER=on_call)
+ f = 0.
+ end
+
+ ! The plugin's sentinel, with a continuation line.
+ subroutine sentinel
+ !$example callback(handler=on_call, &
+ !$example tag="sentinel")
+ end
+end
+
+! A procedure the unit does not define or call.
+subroutine t
+ interface
+ subroutine ext
+ end
+ end interface
+ !dir$ example callback(ext, handler=t)
+end
+
+! CHECK-DAG: fir.global @_QMmEx {fir.directives = [{args = {by = @_QMmEy}, keyword = "watch", prefix = "example"}]}
+! CHECK-DAG: fir.global @_QMmEy {fir.directives = [{args = {text = "a variable"}, keyword = "note", prefix = "example"}]}
+! CHECK-DAG: fir.global common @blk_({{.*}}) <{{.*}}> {fir.directives = [{args = {}, keyword = "watch", prefix = "example"}]}
+! CHECK-DAG: func.func @_QMmPs() attributes {fir.directives = [{args = {handler = @_QMmPon_call, priority = 2 : i64, tag = "s"}, keyword = "callback", prefix = "example"}, {args = {text = "no_quotes"}, keyword = "note", prefix = "example"}]}
+! CHECK-DAG: func.func @_QMmPgen_i({{.*}}) attributes {fir.directives = [{args = {text = "generic"}, keyword = "note", prefix = "example"}]}
+! CHECK-DAG: func.func @_QMmPgen_r({{.*}}) attributes {fir.directives = [{args = {text = "generic"}, keyword = "note", prefix = "example"}]}
+! CHECK-DAG: func.func @_QMmPf() -> f32 attributes {fir.directives = [{args = {handler = @_QMmPon_call}, keyword = "callback", prefix = "example"}]}
+! CHECK-DAG: func.func @_QMmPsentinel() attributes {fir.directives = [{args = {handler = @_QMmPon_call, tag = "sentinel"}, keyword = "callback", prefix = "example"}]}
+! CHECK-DAG: func.func private @_QPext() attributes {fir.directives = [{args = {handler = @_QPt}, keyword = "callback", prefix = "example"}]}
More information about the flang-commits
mailing list