[Flang][OpenMP][Sema] Support propagation of REQUIRES information across program units

[skatrak]

Summary

This patch adds support for storing OpenMP REQUIRES information in the semantics symbols for programs/subprograms and modules/submodules, and populates them during directive resolution. A pass is added to name resolution that makes sure this information is also propagated across top-level programs, functions and subprograms.

Storing REQUIRES information inside of semantics symbols will also allow supporting the propagation of this information across Fortran modules. This will come as a separate patch.

The bool DirectiveAttributeVisitor::Pre(const parser::SpecificationPart &x) method is removed since it resulted in specification parts being visited twice.

This is patch 3/5 of a series splitting D149337 to simplify review.

[skatrak]

Rebase.

[kiranchandramohan]

Adding @klausler since the patch touches code outside the OpenMP semantics/parsing files.

[klausler]

flang/include/flang/Semantics/symbol.h

17

Why do you need parse-tree.h?

50

flang/include/flang/Common/enum-set.h is what we use in the f18 frontend for sets of attributes, such as Semantics/attr.h.

flang/test/Semantics/OpenMP/requires09.f90

2

What about module procedures? Do you need to emit these directives to module files?

[skatrak]

Address review comments.

flang/include/flang/Semantics/symbol.h

17

That's because it's got the definition of OmpAtomicDefaultMemOrderClause::Type, which is needed by WithOmpDeclarative.

50

Thank you for pointing this out, I didn't realize this. It's been addressed now.

flang/test/Semantics/OpenMP/requires09.f90

2

Yes, that's correct, but it comes as a separate dependent patch: D158168.

[skatrak]

Ping for review! I'd appreciate it if @klausler or someone else could give this patch another look, since there are a few other patches that depend on it. Thank you!

[klausler]

flang/include/flang/Semantics/symbol.h

17

That ENUM_CLASS (and others) could be moved elsewhere, such as to Common/Fortran.h, and then we wouldn't have to pull the gigantic parse-tree.h header file into every single compilation of semantics C++ files (and much of lowering).

18

Is BitMaskEnum.h still required?

18

Where is this used?

flang/lib/Semantics/resolve-directives.cpp

387

const auto

680

Use a reference, not a pointer, when indirecting to an object that must exist.

2157

If you're not going to use the pointer result of std::get_if, use std::holds_alternative instead.

2178

You're unconditionally dereferencing the pointer "symbol" in this code. Make it a reference instead.

[skatrak]

Address review comments.

[skatrak]

Thank you for the feedback. I've addressed all but one of your comments, which I believe it would be best to do as a separate patch. Let me know.

flang/include/flang/Semantics/symbol.h

17

That makes sense, but my feeling is that this refactoring should come as a separate patch, since it would move several unrelated enums to a different file and it would be noisy here. I'll work on a PR to do that and then update this patch after that one lands. Is that a reasonable approach?

18

It's used at the bottom of the file. A comment says "Define required info so that SymbolRef can be used inside llvm::DenseMap".

18

It's not required, thanks for noticing.

[skatrak]

Move enumeration into common header to avoid pulling all parse tree definitions into symbol.h.

[klausler]

flang/lib/Parser/unparse.cpp

2310 ↗

(On Diff #555882)

This switch() could be better implemented using x.EnumToString().

[skatrak]

Use EnumToString() in place of switch statement.

flang/include/flang/Semantics/symbol.h

 //===-- include/flang/Semantics/symbol.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
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_SYMBOL_H_
 #define FORTRAN_SEMANTICS_SYMBOL_H_
 
 #include "type.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/enum-set.h"
 #include "flang/Common/reference.h"
 #include "flang/Common/visit.h"
+#include "flang/Parser/parse-tree.h"
 #include "llvm/ADT/DenseMapInfo.h"
 
 #include <array>
 #include <functional>
 #include <list>
 #include <optional>
 #include <set>
 #include <vector>
 

 class Symbol;
 class ProgramTree;
 
 using SymbolRef = common::Reference<const Symbol>;
 using SymbolVector = std::vector<SymbolRef>;
 using MutableSymbolRef = common::Reference<Symbol>;
 using MutableSymbolVector = std::vector<MutableSymbolRef>;
 
+// Mixin for details with OpenMP declarative constructs.
+class WithOmpDeclarative {
+  using OmpAtomicOrderType = parser::OmpAtomicDefaultMemOrderClause::Type;
+
+public:
+  ENUM_CLASS(RequiresFlag, ReverseOffload, UnifiedAddress, UnifiedSharedMemory,
+      DynamicAllocators);
+  using RequiresFlags = common::EnumSet<RequiresFlag, RequiresFlag_enumSize>;
+
+  bool has_ompRequires() const { return ompRequires_.has_value(); }
+  const RequiresFlags *ompRequires() const {
+    return ompRequires_ ? &*ompRequires_ : nullptr;
+  }
+  void set_ompRequires(RequiresFlags flags) { ompRequires_ = flags; }
+
+  bool has_ompAtomicDefaultMemOrder() const {
+    return ompAtomicDefaultMemOrder_.has_value();
+  }
+  const OmpAtomicOrderType *ompAtomicDefaultMemOrder() const {
+    return ompAtomicDefaultMemOrder_ ? &*ompAtomicDefaultMemOrder_ : nullptr;
+  }
+  void set_ompAtomicDefaultMemOrder(OmpAtomicOrderType flags) {
+    ompAtomicDefaultMemOrder_ = flags;
+  }
+
+private:
+  std::optional<RequiresFlags> ompRequires_;
+  std::optional<OmpAtomicOrderType> ompAtomicDefaultMemOrder_;
+};
+
 // A module or submodule.
-class ModuleDetails {
+class ModuleDetails : public WithOmpDeclarative {
 public:
   ModuleDetails(bool isSubmodule = false) : isSubmodule_{isSubmodule} {}
   bool isSubmodule() const { return isSubmodule_; }
   const Scope *scope() const { return scope_; }
   const Scope *ancestor() const; // for submodule; nullptr for module
   const Scope *parent() const; // for submodule; nullptr for module
   void set_scope(const Scope *);
   bool isDefaultPrivate() const { return isDefaultPrivate_; }
   void set_isDefaultPrivate(bool yes = true) { isDefaultPrivate_ = yes; }
 
 private:
   bool isSubmodule_;
   bool isDefaultPrivate_{false};
   const Scope *scope_{nullptr};
 };
 
-class MainProgramDetails {
+class MainProgramDetails : public WithOmpDeclarative {
 public:
 private:
 };
 
 class WithBindName {
 public:
   const std::string *bindName() const {
     return bindName_ ? &*bindName_ : nullptr;
private:
   unsigned gangDim_{0};
   bool isNohost_{false};
   std::optional<std::string> bindName_;
 };
 
 // A subroutine or function definition, or a subprogram interface defined
 // in an INTERFACE block as part of the definition of a dummy procedure
 // or a procedure pointer (with just POINTER).
-class SubprogramDetails : public WithBindName {
+class SubprogramDetails : public WithBindName, public WithOmpDeclarative {
 public:
   bool isFunction() const { return result_ != nullptr; }
   bool isInterface() const { return isInterface_; }
   void set_isInterface(bool value = true) { isInterface_ = value; }
   bool isDummy() const { return isDummy_; }
   void set_isDummy(bool value = true) { isDummy_ = value; }
   Scope *entryScope() { return entryScope_; }
   const Scope *entryScope() const { return entryScope_; }

flang/lib/Semantics/resolve-directives.h

 //===----------------------------------------------------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_RESOLVE_DIRECTIVES_H_
 #define FORTRAN_SEMANTICS_RESOLVE_DIRECTIVES_H_
 
 namespace Fortran::parser {
 struct Name;
+struct Program;
 struct ProgramUnit;
 } // namespace Fortran::parser
 
 namespace Fortran::semantics {
 
 class SemanticsContext;
 
 // Name resolution for OpenACC and OpenMP directives
 void ResolveAccParts(SemanticsContext &, const parser::ProgramUnit &);
 void ResolveOmpParts(SemanticsContext &, const parser::ProgramUnit &);
+void ResolveOmpTopLevelParts(SemanticsContext &, const parser::Program &);
 
 } // namespace Fortran::semantics
 #endif

flang/lib/Semantics/resolve-directives.cpp

 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
 #include <list>
 #include <map>
 #include <sstream>
 
+template <typename T>
+static Fortran::semantics::Scope *GetScope(
+    Fortran::semantics::SemanticsContext &context, const T &x) {
+  std::optional<Fortran::parser::CharBlock> source{GetSource(x)};
+  return source ? &context.FindScope(*source) : nullptr;
+}
+
 namespace Fortran::semantics {
 
 template <typename T> class DirectiveAttributeVisitor {
 public:
   explicit DirectiveAttributeVisitor(SemanticsContext &context)
       : context_{context} {}
 
   template <typename A> bool Pre(const A &) { return true; }
public:
   }
 
   bool Pre(const parser::ModuleSubprogram &) {
     // Clear the labels being tracked in the previous scope
     ClearLabels();
     return true;
   }
 
-  bool Pre(const parser::SpecificationPart &x) {
-    Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
-    return true;
-  }
-
   bool Pre(const parser::StmtFunctionStmt &x) {
     const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
     if (const auto *expr{GetExpr(context_, parsedExpr)}) {
       for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
         if (!IsStmtFunctionDummy(symbol)) {
           stmtFunctionExprSymbols_.insert(symbol.GetUltimate());
         }
       }
bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
     if (name) {
       ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd);
     }
     return true;
   }
   void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenMPRequiresConstruct &x) {
+    using Flags = WithOmpDeclarative::RequiresFlags;
+    using Requires = WithOmpDeclarative::RequiresFlag;
     PushContext(x.source, llvm::omp::Directive::OMPD_requires);
+
+    // Gather information from the clauses.
+    Flags flags;
+    std::optional<parser::OmpAtomicDefaultMemOrderClause::Type> memOrder;
+    for (const auto &clause : std::get<parser::OmpClauseList>(x.t).v) {
+      flags |= common::visit(
+          common::visitors{
+              [&memOrder](
+                  const parser::OmpClause::AtomicDefaultMemOrder &atomic) {
+                memOrder = atomic.v.v;
+                return Flags{};
+              },
+              [](const parser::OmpClause::ReverseOffload &) {
+                return Flags{Requires::ReverseOffload};
+              },
+              [](const parser::OmpClause::UnifiedAddress &) {
+                return Flags{Requires::UnifiedAddress};
+              },
+              [](const parser::OmpClause::UnifiedSharedMemory &) {
+                return Flags{Requires::UnifiedSharedMemory};
+              },
+              [](const parser::OmpClause::DynamicAllocators &) {
+                return Flags{Requires::DynamicAllocators};
+              },
+              [](const auto &) { return Flags{}; }},
+          clause.u);
+    }
+    // Merge clauses into parents' symbols details.
+    AddOmpRequiresToScope(currScope(), flags, memOrder);
     return true;
   }
   void Post(const parser::OpenMPRequiresConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenMPDeclareTargetConstruct &);
   void Post(const parser::OpenMPDeclareTargetConstruct &) { PopContext(); }
 
   bool Pre(const parser::OpenMPThreadprivate &);
private:
   void CheckAllNamesInAllocateStmt(const parser::CharBlock &source,
       const parser::OmpObjectList &ompObjectList,
       const parser::AllocateStmt &allocate);
   void CheckNameInAllocateStmt(const parser::CharBlock &source,
       const parser::Name &ompObject, const parser::AllocateStmt &allocate);
 
   bool HasSymbolInEnclosingScope(const Symbol &, Scope &);
   std::int64_t ordCollapseLevel{0};
+
+  void AddOmpRequiresToScope(Scope &, WithOmpDeclarative::RequiresFlags,
+      std::optional<parser::OmpAtomicDefaultMemOrderClause::Type>);
 };
 
 template <typename T>
 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
     const Symbol &object) {
   auto it{dataSharingAttributeObjects_.find(object)};
   return it != dataSharingAttributeObjects_.end();
 }
if (!context.AnyFatalError()) {
       // the corresponding DoConstruct, a second walk is to adjust the
       // symbols for all the data-refs of that loop iteration variable
       // prior to the DoConstruct.
       OmpAttributeVisitor{context}.Walk(node);
     }
   }
 }
 
+void ResolveOmpTopLevelParts(
+    SemanticsContext &context, const parser::Program &program) {
+  if (!context.IsEnabled(common::LanguageFeature::OpenMP)) {
+    return;
+  }
+
+  // Gather REQUIRES clauses from all non-module top-level program unit symbols,
+  // combine them together ensuring compatibility and apply them to all these
+  // program units. Modules are skipped because their REQUIRES clauses should be
+  // propagated via USE statements instead.
+  WithOmpDeclarative::RequiresFlags combinedFlags;
+  std::optional<parser::OmpAtomicDefaultMemOrderClause::Type> combinedMemOrder;
+
+  // Function to go through non-module top level program units and extract
+  // REQUIRES information to be processed by a function-like argument.
+  auto processProgramUnits{[&](auto processFn) {
+    for (const parser::ProgramUnit &unit : program.v) {
+      if (!std::holds_alternative<common::Indirection<parser::Module>>(
+              unit.u) &&
+          !std::holds_alternative<common::Indirection<parser::Submodule>>(
+              unit.u)) {
+        Symbol *symbol{common::visit(
+            [&context](
+                auto &x) { return GetScope(context, x.value())->symbol(); },
+            unit.u)};
+
+        common::visit(
+            [&](auto &details) {
+              if constexpr (std::is_convertible_v<decltype(&details),
+                                WithOmpDeclarative *>) {
+                processFn(*symbol, details);
+              }
+            },
+            symbol->details());
+      }
+    }
+  }};
+
+  // Combine global REQUIRES information from all program units except modules
+  // and submodules.
+  processProgramUnits([&](Symbol &symbol, WithOmpDeclarative &details) {
+    if (const WithOmpDeclarative::RequiresFlags *
+        flags{details.ompRequires()}) {
+      combinedFlags |= *flags;
+    }
+    if (const parser::OmpAtomicDefaultMemOrderClause::Type *
+        memOrder{details.ompAtomicDefaultMemOrder()}) {
+      if (combinedMemOrder && *combinedMemOrder != *memOrder) {
+        context.Say(symbol.scope()->sourceRange(),
+            "Conflicting '%s' REQUIRES clauses found in compilation "
+            "unit"_err_en_US,
+            parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
+                llvm::omp::Clause::OMPC_atomic_default_mem_order)
+                                           .str()));
+      }
+      combinedMemOrder = *memOrder;
+    }
+  });
+
+  // Update all program units except modules and submodules with the combined
+  // global REQUIRES information.
+  processProgramUnits([&](Symbol &, WithOmpDeclarative &details) {
+    if (combinedFlags.any()) {
+      details.set_ompRequires(combinedFlags);
+    }
+    if (combinedMemOrder) {
+      details.set_ompAtomicDefaultMemOrder(*combinedMemOrder);
+    }
+  });
+}
+
 void OmpAttributeVisitor::CheckDataCopyingClause(
     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
   const auto *checkSymbol{&symbol};
   if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
     checkSymbol = &details->symbol();
   }
 
   if (ompFlag == Symbol::Flag::OmpCopyIn) {
void OmpAttributeVisitor::CheckNameInAllocateStmt(
   }
   context_.Say(source,
       "Object '%s' in %s directive not "
       "found in corresponding ALLOCATE statement"_err_en_US,
       name.ToString(),
       parser::ToUpperCaseLetters(
           llvm::omp::getOpenMPDirectiveName(GetContext().directive).str()));
 }
+
+void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope,
+    WithOmpDeclarative::RequiresFlags flags,
+    std::optional<parser::OmpAtomicDefaultMemOrderClause::Type> memOrder) {
+  Scope *scopeIter = &scope;
+  do {
+    if (Symbol * symbol{scopeIter->symbol()}) {
+      common::visit(
+          [&](auto &details) {
+            // Store clauses information into the symbol for the parent and
+            // enclosing modules, programs, functions and subroutines.
+            if constexpr (std::is_convertible_v<decltype(&details),
+                              WithOmpDeclarative *>) {
+              if (flags.any()) {
+                if (const WithOmpDeclarative::RequiresFlags *
+                    otherFlags{details.ompRequires()}) {
+                  flags |= *otherFlags;
+                }
+                details.set_ompRequires(flags);
+              }
+              if (memOrder) {
+                if (details.has_ompAtomicDefaultMemOrder() &&
+                    *details.ompAtomicDefaultMemOrder() != *memOrder) {
+                  context_.Say(scopeIter->sourceRange(),
+                      "Conflicting '%s' REQUIRES clauses found in compilation "
+                      "unit"_err_en_US,
+                      parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
+                          llvm::omp::Clause::OMPC_atomic_default_mem_order)
+                                                     .str()));
+                }
+                details.set_ompAtomicDefaultMemOrder(*memOrder);
+              }
+            }
+          },
+          symbol->details());
+    }
+    scopeIter = &scopeIter->parent();
+  } while (!scopeIter->IsGlobal());
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names.cpp

if (node.IsModule()) {
     ApplyDefaultAccess();
   }
   PopScope(); // converts unclassified entities into objects
   for (const auto &child : node.children()) {
     ResolveExecutionParts(child);
   }
 }
 
-void ResolveNamesVisitor::Post(const parser::Program &) {
+void ResolveNamesVisitor::Post(const parser::Program &x) {
   // ensure that all temps were deallocated
   CHECK(!attrs_);
   CHECK(!cudaDataAttr_);
   CHECK(!GetDeclTypeSpec());
+  // Top-level resolution to propagate information across program units after
+  // each of them has been resolved separately.
+  ResolveOmpTopLevelParts(context(), x);
 }
 
 // A singleton instance of the scope -> IMPLICIT rules mapping is
 // shared by all instances of ResolveNamesVisitor and accessed by this
 // pointer when the visitors (other than the top-level original) are
 // constructed.
 static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};
 

flang/test/Semantics/OpenMP/requires09.f90

+! RUN: %python %S/../test_errors.py %s %flang -fopenmp
+! OpenMP Version 5.0
+! 2.4 Requires directive
+! All atomic_default_mem_order clauses in 'requires' directives found within a
+! compilation unit must specify the same ordering.
+
+subroutine f
+  !$omp requires atomic_default_mem_order(seq_cst)
+end subroutine f
+
+!ERROR: Conflicting 'ATOMIC_DEFAULT_MEM_ORDER' REQUIRES clauses found in compilation unit
+subroutine g
+  !$omp requires atomic_default_mem_order(relaxed)
+end subroutine g