[flang] [OpenMP] Name Resolution for OpenMP constructs (flang-compiler/f18#940)
authorJinxin (Brian) Yang <jinxiny@nvidia.com>
Tue, 28 Jan 2020 20:51:35 +0000 (12:51 -0800)
committerGitHub <noreply@github.com>
Tue, 28 Jan 2020 20:51:35 +0000 (12:51 -0800)
This is an extended framework based on the previous work that addresses
the NR on OpenMP directives/clauses (b2ea520). In this change:
  * New `OmpVisitor` is created (ResolveNamesVisitor derives from it) to
    create necessary scopes for certain OpenMP constructs. This is along
    with the regular Fortran NR process.
  * Old `OmpVisitor` is adjusted and converted to a standalone visitor--
    `OmpAttributeVisitor`. This is used to walk through the OpenMP constructs
    and do the NR for variables on the OpenMP directives or data references
    within the OpenMP constructs. "Do the NR" here means that based on the NR
    results of the regular Fortran NR, fix the symbols of `Names` related
    to the OpenMP constructs. Note that there is an `OmpContext` in this
    visitor (similar to the one in `OmpStructureChecker`), this is necessary
    when dealing with the nested OpenMP constructs in the future.

Given an OpenMP code:
```
real*8 a, b
  a = 1.
  b = 2.
  !$omp parallel private(a)
  a = 3.
  b = 4.
  !$omp end parallel
  print *, a, b
end
```

w/o -fopenmp:
```
real*8 a, b
 !REF: /MainProgram1/a
 a = 1.
 !REF: /MainProgram1/b
 b = 2.
 !!!! OMP parallel
 !REF: /MainProgram1/a
 a = 3.
 !REF: /MainProgram1/b
 b = 4.
 !!!! OMP end parallel
 !REF: /MainProgram1/a
 !REF: /MainProgram1/b
 print *, a, b
end
```

w/ -fopenmp:
```
real*8 a, b
 !REF: /MainProgram1/a
 a = 1.
 !REF: /MainProgram1/b
 b = 2.
!$omp parallel  private(a)   <-- new Symbol for 'a' created
 !DEF: /MainProgram1/Block1/a (OmpPrivate) HostAssoc REAL(8)
 a = 3.   <-- fix the old symbol with new Symbol in parallel scope
 !REF: /MainProgram1/b
 b = 4.   <-- do nothing because by default it is shared in this scope
!$omp end parallel
 !REF: /MainProgram1/a
 !REF: /MainProgram1/b
 print *, a, b
end
```

Please note that this is a framework update, there are still many
things on the TODO list for finishing the NR for OpenMP (based on
the `OpenMP-semantics.md` design doc), which will be on top of this
framework.

Some TODO items:
- Create a generic function to go through all the rules for deciding
  `predetermined`, `explicitly determined`, and `implicitly determined`
  data-sharing attributes. (This is the next biggest part)
- Handle `Array Sections` and `Array or Structure Element`.
- Take association into consideration for example Pointer association,
  `ASSOCIATE` construct, and etc.
- Handle all the name resolution for directives/clauses that have
  `parser::Name`.

* N.B. Extend `AddSourceRange` to apply to current and parent scopes
  - motivated by a few cases that need to call `AddSourceRange`
    for current & parent scopes; the extension should be safe
  - global scope is not included

Original-commit: flang-compiler/f18@0c3c39d30e3f166a6a1303337c5fd7eead720fd0
Reviewed-on: https://github.com/flang-compiler/f18/pull/940

flang/include/flang/parser/parse-tree.h
flang/include/flang/semantics/symbol.h
flang/lib/parser/openmp-parsers.cpp
flang/lib/semantics/resolve-names.cpp
flang/lib/semantics/scope.cpp
flang/test/semantics/CMakeLists.txt
flang/test/semantics/omp-device-constructs.f90
flang/test/semantics/omp-resolve05.f90 [new file with mode: 0644]
flang/test/semantics/omp-symbol07.f90 [new file with mode: 0644]

index 2963895..57093e3 100644 (file)
@@ -3498,10 +3498,12 @@ struct OmpSectionsDirective {
 struct OmpBeginSectionsDirective {
   TUPLE_CLASS_BOILERPLATE(OmpBeginSectionsDirective);
   std::tuple<OmpSectionsDirective, OmpClauseList> t;
+  CharBlock source;
 };
 struct OmpEndSectionsDirective {
   TUPLE_CLASS_BOILERPLATE(OmpEndSectionsDirective);
   std::tuple<OmpSectionsDirective, OmpClauseList> t;
+  CharBlock source;
 };
 
 // [!$omp section]
@@ -3742,21 +3744,25 @@ struct OpenMPStandaloneConstruct {
 struct OmpBeginLoopDirective {
   TUPLE_CLASS_BOILERPLATE(OmpBeginLoopDirective);
   std::tuple<OmpLoopDirective, OmpClauseList> t;
+  CharBlock source;
 };
 
 struct OmpEndLoopDirective {
   TUPLE_CLASS_BOILERPLATE(OmpEndLoopDirective);
   std::tuple<OmpLoopDirective, OmpClauseList> t;
+  CharBlock source;
 };
 
 struct OmpBeginBlockDirective {
   TUPLE_CLASS_BOILERPLATE(OmpBeginBlockDirective);
   std::tuple<OmpBlockDirective, OmpClauseList> t;
+  CharBlock source;
 };
 
 struct OmpEndBlockDirective {
   TUPLE_CLASS_BOILERPLATE(OmpEndBlockDirective);
   std::tuple<OmpBlockDirective, OmpClauseList> t;
+  CharBlock source;
 };
 
 struct OpenMPBlockConstruct {
index 335e6ed..faef1ca 100644 (file)
@@ -467,7 +467,7 @@ public:
       // OpenMP miscellaneous flags
       OmpCommonBlock, OmpReduction, OmpDeclareSimd, OmpDeclareTarget,
       OmpThreadprivate, OmpDeclareReduction, OmpFlushed, OmpCriticalLock,
-      OmpIfSpecified);
+      OmpIfSpecified, OmpNone);
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   const Scope &owner() const { return *owner_; }
index 076c3e8..fd1b961 100644 (file)
@@ -280,8 +280,8 @@ TYPE_PARSER(sourced(construct<OmpLoopDirective>(first(
         pure(OmpLoopDirective::Directive::TeamsDistributeSimd),
     "TEAMS DISTRIBUTE" >> pure(OmpLoopDirective::Directive::TeamsDistribute)))))
 
-TYPE_PARSER(construct<OmpBeginLoopDirective>(
-    sourced(Parser<OmpLoopDirective>{}), Parser<OmpClauseList>{}))
+TYPE_PARSER(sourced(construct<OmpBeginLoopDirective>(
+    sourced(Parser<OmpLoopDirective>{}), Parser<OmpClauseList>{})))
 
 // 2.14.1 construct-type-clause -> PARALLEL | SECTIONS | DO | TASKGROUP
 TYPE_PARSER(sourced(construct<OmpCancelType>(
@@ -345,8 +345,8 @@ TYPE_PARSER(construct<OmpBlockDirective>(
         "TEAMS" >> pure(OmpBlockDirective::Directive::Teams),
         "WORKSHARE" >> pure(OmpBlockDirective::Directive::Workshare))))
 
-TYPE_PARSER(construct<OmpBeginBlockDirective>(
-    sourced(Parser<OmpBlockDirective>{}), Parser<OmpClauseList>{}))
+TYPE_PARSER(sourced(construct<OmpBeginBlockDirective>(
+    sourced(Parser<OmpBlockDirective>{}), Parser<OmpClauseList>{})))
 
 TYPE_PARSER(construct<OmpReductionInitializerClause>(
     "INITIALIZER" >> parenthesized("OMP_PRIV =" >> expr)))
@@ -482,12 +482,12 @@ TYPE_PARSER(construct<OmpSectionsDirective>(
             pure(OmpSectionsDirective::Directive::ParallelSections))))
 
 // OMP BEGIN and END SECTIONS Directive
-TYPE_PARSER(construct<OmpBeginSectionsDirective>(
-    sourced(Parser<OmpSectionsDirective>{}), Parser<OmpClauseList>{}))
+TYPE_PARSER(sourced(construct<OmpBeginSectionsDirective>(
+    sourced(Parser<OmpSectionsDirective>{}), Parser<OmpClauseList>{})))
 TYPE_PARSER(
-    startOmpLine >> construct<OmpEndSectionsDirective>(
+    startOmpLine >> sourced(construct<OmpEndSectionsDirective>(
                         sourced("END"_tok >> Parser<OmpSectionsDirective>{}),
-                        Parser<OmpClauseList>{}))
+                        Parser<OmpClauseList>{})))
 
 // OMP SECTION-BLOCK
 TYPE_PARSER(maybe(startOmpLine >> "SECTION"_tok / endOmpLine) >>
@@ -512,15 +512,15 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US,
 
 // END OMP Block directives
 TYPE_PARSER(
-    startOmpLine >> construct<OmpEndBlockDirective>(
+    startOmpLine >> sourced(construct<OmpEndBlockDirective>(
                         sourced("END"_tok >> Parser<OmpBlockDirective>{}),
-                        Parser<OmpClauseList>{}))
+                        Parser<OmpClauseList>{})))
 
 // END OMP Loop directives
 TYPE_PARSER(
-    startOmpLine >> construct<OmpEndLoopDirective>(
+    startOmpLine >> sourced(construct<OmpEndLoopDirective>(
                         sourced("END"_tok >> Parser<OmpLoopDirective>{}),
-                        Parser<OmpClauseList>{}))
+                        Parser<OmpClauseList>{})))
 
 TYPE_PARSER(construct<OpenMPLoopConstruct>(
     Parser<OmpBeginLoopDirective>{} / endOmpLine))
index e6a9b7f..ca8e267 100644 (file)
@@ -8,6 +8,7 @@
 
 #include "resolve-names.h"
 #include "assignment.h"
+#include "check-omp-structure.h"
 #include "mod-file.h"
 #include "program-tree.h"
 #include "resolve-names-utils.h"
@@ -444,12 +445,7 @@ public:
 
   template<typename T> bool Pre(const parser::Statement<T> &x) {
     messageHandler().set_currStmtSource(x.source);
-    for (auto *scope = currScope_; scope; scope = &scope->parent()) {
-      scope->AddSourceRange(x.source);
-      if (scope->IsGlobal()) {
-        break;
-      }
-    }
+    currScope_->AddSourceRange(x.source);
     return true;
   }
   template<typename T> void Post(const parser::Statement<T> &) {
@@ -786,6 +782,8 @@ public:
   void CheckExplicitInterface(const parser::Name &);
   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 
+  const parser::Name *ResolveDesignator(const parser::Designator &);
+
 protected:
   bool BeginDecl();
   void EndDecl();
@@ -814,7 +812,6 @@ protected:
   // or nullptr in case of error.
   const parser::Name *ResolveStructureComponent(
       const parser::StructureComponent &);
-  const parser::Name *ResolveDesignator(const parser::Designator &);
   const parser::Name *ResolveDataRef(const parser::DataRef &);
   const parser::Name *ResolveVariable(const parser::Variable &);
   const parser::Name *ResolveName(const parser::Name &);
@@ -1045,43 +1042,132 @@ private:
   void PopAssociation();
 };
 
-// Resolve OpenMP construct entities and statement (TODO) entities
+// Create scopes for OpenMP constructs
 class OmpVisitor : public virtual DeclarationVisitor {
 public:
-  static const parser::Name *GetDesignatorNameIfDataRef(
-      const parser::Designator &designator) {
-    const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
-    return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
-  }
+  void AddOmpSourceRange(const parser::CharBlock &);
 
-  bool Pre(const parser::OpenMPBlockConstruct &) {
-    PushScope(Scope::Kind::Block, nullptr);
+  static bool NeedsScope(const parser::OpenMPBlockConstruct &);
+
+  bool Pre(const parser::OpenMPBlockConstruct &);
+  void Post(const parser::OpenMPBlockConstruct &);
+  bool Pre(const parser::OmpBeginBlockDirective &x) {
+    AddOmpSourceRange(x.source);
     return true;
   }
-  void Post(const parser::OpenMPBlockConstruct &) { PopScope(); }
-  bool Pre(const parser::OmpBeginBlockDirective &) {
-    ClearDataSharingAttributeObjects();
+  void Post(const parser::OmpBeginBlockDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
+  bool Pre(const parser::OmpEndBlockDirective &x) {
+    AddOmpSourceRange(x.source);
     return true;
   }
+  void Post(const parser::OmpEndBlockDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
 
   bool Pre(const parser::OpenMPLoopConstruct &) {
     PushScope(Scope::Kind::Block, nullptr);
     return true;
   }
   void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
-  bool Pre(const parser::OmpBeginLoopDirective &) {
-    ClearDataSharingAttributeObjects();
+  bool Pre(const parser::OmpBeginLoopDirective &x) {
+    AddOmpSourceRange(x.source);
+    return true;
+  }
+  void Post(const parser::OmpBeginLoopDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
+  bool Pre(const parser::OmpEndLoopDirective &x) {
+    AddOmpSourceRange(x.source);
+    return true;
+  }
+  void Post(const parser::OmpEndLoopDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
+
+  bool Pre(const parser::OpenMPSectionsConstruct &) {
+    PushScope(Scope::Kind::Block, nullptr);
+    return true;
+  }
+  void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
+  bool Pre(const parser::OmpBeginSectionsDirective &x) {
+    AddOmpSourceRange(x.source);
+    return true;
+  }
+  void Post(const parser::OmpBeginSectionsDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
+  bool Pre(const parser::OmpEndSectionsDirective &x) {
+    AddOmpSourceRange(x.source);
     return true;
   }
+  void Post(const parser::OmpEndSectionsDirective &) {
+    messageHandler().set_currStmtSource(std::nullopt);
+  }
+};
+
+bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
+  const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
+  const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+  switch (beginDir.v) {
+  case parser::OmpBlockDirective::Directive::TargetData:
+  case parser::OmpBlockDirective::Directive::Master:
+  case parser::OmpBlockDirective::Directive::Ordered: return false;
+  default: return true;
+  }
+}
 
-  bool Pre(const parser::OpenMPThreadprivate &x) {
+void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
+  messageHandler().set_currStmtSource(source);
+  currScope().AddSourceRange(source);
+}
+
+bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
+  if (NeedsScope(x)) {
     PushScope(Scope::Kind::Block, nullptr);
-    const auto &list{std::get<parser::OmpObjectList>(x.t)};
-    ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
+  }
+  return true;
+}
+
+void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
+  if (NeedsScope(x)) {
     PopScope();
-    return false;
   }
+}
+
+// Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
+class OmpAttributeVisitor {
+public:
+  explicit OmpAttributeVisitor(
+      SemanticsContext &context, ResolveNamesVisitor &resolver)
+    : context_{context}, resolver_{resolver} {}
+
+  template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
+
+  template<typename A> bool Pre(const A &) { return true; }
+  template<typename A> void Post(const A &) {}
+
+  bool Pre(const parser::OpenMPBlockConstruct &);
+  void Post(const parser::OpenMPBlockConstruct &) { PopContext(); }
+  void Post(const parser::OmpBeginBlockDirective &) {
+    GetContext().withinConstruct = true;
+  }
+
+  bool Pre(const parser::OpenMPLoopConstruct &);
+  void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
+  void Post(const parser::OmpBeginLoopDirective &) {
+    GetContext().withinConstruct = true;
+  }
+
+  bool Pre(const parser::OpenMPSectionsConstruct &);
+  void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
+
+  bool Pre(const parser::OpenMPThreadprivate &);
+  void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
 
+  // 2.15.3 Data-Sharing Attribute Clauses
+  void Post(const parser::OmpDefaultClause &);
   bool Pre(const parser::OmpClause::Shared &x) {
     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
     return false;
@@ -1099,7 +1185,60 @@ public:
     return false;
   }
 
+  void Post(const parser::Name &);
+
 private:
+  struct OmpContext {
+    OmpContext(const parser::CharBlock &source, OmpDirective d, Scope &s)
+      : directiveSource{source}, directive{d}, scope{s} {}
+    parser::CharBlock directiveSource;
+    OmpDirective directive;
+    Scope &scope;
+    // TODO: default DSA is implicitly determined in different ways
+    Symbol::Flag defaultDSA{Symbol::Flag::OmpShared};
+    // variables on Data-sharing attribute clauses
+    std::map<const Symbol *, Symbol::Flag> objectWithDSA;
+    bool withinConstruct{false};
+  };
+  // back() is the top of the stack
+  OmpContext &GetContext() {
+    CHECK(!ompContext_.empty());
+    return ompContext_.back();
+  }
+  void PushContext(const parser::CharBlock &source, OmpDirective dir) {
+    ompContext_.emplace_back(source, dir, context_.FindScope(source));
+  }
+  void PopContext() { ompContext_.pop_back(); }
+  void SetContextDirectiveSource(parser::CharBlock &dir) {
+    GetContext().directiveSource = dir;
+  }
+  void SetContextDirectiveEnum(OmpDirective dir) {
+    GetContext().directive = dir;
+  }
+  const Scope &currScope() { return GetContext().scope; }
+  void SetContextDefaultDSA(Symbol::Flag flag) {
+    GetContext().defaultDSA = flag;
+  }
+  void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
+    GetContext().objectWithDSA.emplace(&symbol, flag);
+  }
+  bool IsObjectWithDSA(const Symbol &symbol) {
+    auto it{GetContext().objectWithDSA.find(&symbol)};
+    return it != GetContext().objectWithDSA.end();
+  }
+
+  Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
+    const auto pair{
+        GetContext().scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
+    return *pair.first->second;
+  }
+
+  static const parser::Name *GetDesignatorNameIfDataRef(
+      const parser::Designator &designator) {
+    const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
+    return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
+  }
+
   static constexpr Symbol::Flags dataSharingAttributeFlags{
       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
@@ -1121,185 +1260,23 @@ private:
   }
   bool HasDataSharingAttributeObject(const Symbol &);
 
-  // TODO: resolve variables referenced in the OpenMP region
   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
-  Symbol &ResolveOmp(const parser::Name &, Symbol::Flag);
-  Symbol &ResolveOmp(Symbol &, Symbol::Flag);
+  Symbol *ResolveOmp(const parser::Name &, Symbol::Flag);
+  Symbol *ResolveOmp(Symbol &, Symbol::Flag);
   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
-  Symbol &DeclarePrivateAccessEntity(const parser::Name &, Symbol::Flag);
-  Symbol &DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
-  Symbol &DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
-  Symbol &DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
+  Symbol *DeclarePrivateAccessEntity(const parser::Name &, Symbol::Flag);
+  Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
+  Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
+  Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
   void CheckMultipleAppearances(
       const parser::Name &, const Symbol &, Symbol::Flag);
-
   SymbolSet dataSharingAttributeObjects_;  // on one directive
-};
-
-bool OmpVisitor::HasDataSharingAttributeObject(const Symbol &object) {
-  auto it{dataSharingAttributeObjects_.find(object)};
-  return it != dataSharingAttributeObjects_.end();
-}
-
-Symbol *OmpVisitor::ResolveOmpCommonBlockName(const parser::Name *name) {
-  if (auto *prev{name ? currScope().parent().FindCommonBlock(name->source)
-                      : nullptr}) {
-    name->symbol = prev;
-    return prev;
-  } else {
-    return nullptr;
-  }
-}
 
-void OmpVisitor::ResolveOmpObjectList(
-    const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
-  for (const auto &ompObject : ompObjectList.v) {
-    ResolveOmpObject(ompObject, ompFlag);
-  }
-}
-
-void OmpVisitor::ResolveOmpObject(
-    const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
-  std::visit(
-      common::visitors{
-          [&](const parser::Designator &designator) {
-            if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
-              auto &symbol{ResolveOmp(*name, ompFlag)};
-              if (dataSharingAttributeFlags.test(ompFlag)) {
-                CheckMultipleAppearances(*name, symbol, ompFlag);
-              }
-            } else if (const auto *name{ResolveDesignator(designator)};
-                       name && name->symbol) {
-              // Array sections to be changed to substrings as needed
-              if (AnalyzeExpr(context(), designator)) {
-                if (std::holds_alternative<parser::Substring>(designator.u)) {
-                  Say(designator.source,
-                      "Substrings are not allowed on OpenMP "
-                      "directives or clauses"_err_en_US);
-                  return;
-                }
-              }
-              // other checks, more TBD
-              if (const auto *details{
-                      name->symbol->detailsIf<ObjectEntityDetails>()}) {
-                if (details->IsArray()) {
-                  // TODO: check Array Sections
-                } else if (name->symbol->owner().IsDerivedType()) {
-                  // TODO: check Structure Component
-                }
-              }
-            }
-          },
-          [&](const parser::Name &name) {  // common block
-            if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
-              CheckMultipleAppearances(
-                  name, *symbol, Symbol::Flag::OmpCommonBlock);
-              // 2.15.3 When a named common block appears in a list, it has the
-              // same meaning as if every explicit member of the common block
-              // appeared in the list
-              for (const Symbol &object :
-                  symbol->get<CommonBlockDetails>().objects()) {
-                Symbol &mutableObject{const_cast<Symbol &>(object)};
-                ResolveOmp(mutableObject, ompFlag);
-              }
-            } else {
-              Say(name.source,  // 2.15.3
-                  "COMMON block must be declared in the same scoping unit "
-                  "in which the OpenMP directive or clause appears"_err_en_US);
-            }
-          },
-      },
-      ompObject.u);
-}
-
-Symbol &OmpVisitor::ResolveOmp(const parser::Name &name, Symbol::Flag ompFlag) {
-  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
-    return DeclarePrivateAccessEntity(name, ompFlag);
-  } else {
-    return DeclareOrMarkOtherAccessEntity(name, ompFlag);
-  }
-}
-
-Symbol &OmpVisitor::ResolveOmp(Symbol &symbol, Symbol::Flag ompFlag) {
-  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
-    return DeclarePrivateAccessEntity(symbol, ompFlag);
-  } else {
-    return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
-  }
-}
-
-Symbol &OmpVisitor::DeclarePrivateAccessEntity(
-    const parser::Name &name, Symbol::Flag ompFlag) {
-  Symbol &prev{FindOrDeclareEnclosingEntity(name)};
-  if (prev.owner() != currScope()) {
-    auto &symbol{MakeSymbol(name, HostAssocDetails{prev})};
-    symbol.set(ompFlag);
-    name.symbol = &symbol;  // override resolution to parent
-    return symbol;
-  } else {
-    prev.set(ompFlag);
-    return prev;
-  }
-}
-
-Symbol &OmpVisitor::DeclarePrivateAccessEntity(
-    Symbol &object, Symbol::Flag ompFlag) {
-  if (object.owner() != currScope() &&
-      !FindInScope(currScope(), object.name())) {
-    auto &symbol{MakeSymbol(object.name(), Attrs{}, HostAssocDetails{object})};
-    symbol.set(ompFlag);
-    return symbol;
-  } else {
-    object.set(ompFlag);
-    return object;
-  }
-}
-
-Symbol &OmpVisitor::DeclareOrMarkOtherAccessEntity(
-    const parser::Name &name, Symbol::Flag ompFlag) {
-  Symbol &prev{FindOrDeclareEnclosingEntity(name)};
-  name.symbol = &prev;
-  if (ompFlagsRequireMark.test(ompFlag)) {
-    prev.set(ompFlag);
-  }
-  return prev;
-}
-
-Symbol &OmpVisitor::DeclareOrMarkOtherAccessEntity(
-    Symbol &object, Symbol::Flag ompFlag) {
-  if (ompFlagsRequireMark.test(ompFlag)) {
-    object.set(ompFlag);
-  }
-  return object;
-}
-
-static bool WithMultipleAppearancesException(
-    const Symbol &symbol, Symbol::Flag ompFlag) {
-  return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
-             symbol.test(Symbol::Flag::OmpLastPrivate)) ||
-      (ompFlag == Symbol::Flag::OmpLastPrivate &&
-          symbol.test(Symbol::Flag::OmpFirstPrivate));
-}
-
-void OmpVisitor::CheckMultipleAppearances(
-    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
-  const auto *target{&symbol};
-  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
-    if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
-      target = &details->symbol();
-    }
-  }
-  if (HasDataSharingAttributeObject(*target) &&
-      !WithMultipleAppearancesException(symbol, ompFlag)) {
-    Say(name.source,
-        "'%s' appears in more than one data-sharing clause "
-        "on the same OpenMP directive"_err_en_US,
-        name.ToString());
-  } else {
-    AddDataSharingAttributeObject(*target);
-  }
-}
+  SemanticsContext &context_;
+  ResolveNamesVisitor &resolver_;
+  std::vector<OmpContext> ompContext_;  // used as a stack
+};
 
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public virtual ScopeHandler,
@@ -5730,6 +5707,7 @@ bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
   ResolveSpecificationParts(root);
   FinishSpecificationParts(root);
   ResolveExecutionParts(root);
+  OmpAttributeVisitor{context(), *this}.Walk(x);
   return false;
 }
 
@@ -5915,6 +5893,315 @@ private:
   bool pushedScope_{false};
 };
 
+bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
+  const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
+  const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
+  switch (beginDir.v) {
+  case parser::OmpBlockDirective::Directive::Master:
+    PushContext(beginDir.source, OmpDirective::MASTER);
+    break;
+  case parser::OmpBlockDirective::Directive::Ordered:
+    PushContext(beginDir.source, OmpDirective::ORDERED);
+    break;
+  case parser::OmpBlockDirective::Directive::Parallel:
+    PushContext(beginDir.source, OmpDirective::PARALLEL);
+    break;
+  case parser::OmpBlockDirective::Directive::Single:
+    PushContext(beginDir.source, OmpDirective::SINGLE);
+    break;
+  case parser::OmpBlockDirective::Directive::Target:
+    PushContext(beginDir.source, OmpDirective::TARGET);
+    break;
+  case parser::OmpBlockDirective::Directive::TargetData:
+    PushContext(beginDir.source, OmpDirective::TARGET_DATA);
+    break;
+  case parser::OmpBlockDirective::Directive::Task:
+    PushContext(beginDir.source, OmpDirective::TASK);
+    break;
+  case parser::OmpBlockDirective::Directive::Teams:
+    PushContext(beginDir.source, OmpDirective::TEAMS);
+    break;
+  case parser::OmpBlockDirective::Directive::Workshare:
+    PushContext(beginDir.source, OmpDirective::WORKSHARE);
+    break;
+  default:
+    // TODO others
+    break;
+  }
+  ClearDataSharingAttributeObjects();
+  return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
+  const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+  const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
+  switch (beginDir.v) {
+  case parser::OmpLoopDirective::Directive::Distribute:
+    PushContext(beginDir.source, OmpDirective::DISTRIBUTE);
+    break;
+  case parser::OmpLoopDirective::Directive::Do:
+    PushContext(beginDir.source, OmpDirective::DO);
+    break;
+  case parser::OmpLoopDirective::Directive::DoSimd:
+    PushContext(beginDir.source, OmpDirective::DO_SIMD);
+    break;
+  case parser::OmpLoopDirective::Directive::ParallelDo:
+    PushContext(beginDir.source, OmpDirective::PARALLEL_DO);
+    break;
+  case parser::OmpLoopDirective::Directive::ParallelDoSimd:
+    PushContext(beginDir.source, OmpDirective::PARALLEL_DO_SIMD);
+    break;
+  case parser::OmpLoopDirective::Directive::Simd:
+    PushContext(beginDir.source, OmpDirective::SIMD);
+    break;
+  case parser::OmpLoopDirective::Directive::Taskloop:
+    PushContext(beginDir.source, OmpDirective::TASKLOOP);
+    break;
+  case parser::OmpLoopDirective::Directive::TaskloopSimd:
+    PushContext(beginDir.source, OmpDirective::TASKLOOP_SIMD);
+    break;
+  default:
+    // TODO others
+    break;
+  }
+  ClearDataSharingAttributeObjects();
+  return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
+  const auto &beginSectionsDir{
+      std::get<parser::OmpBeginSectionsDirective>(x.t)};
+  const auto &beginDir{
+      std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
+  switch (beginDir.v) {
+  case parser::OmpSectionsDirective::Directive::ParallelSections:
+    PushContext(beginDir.source, OmpDirective::PARALLEL_SECTIONS);
+    break;
+  case parser::OmpSectionsDirective::Directive::Sections:
+    PushContext(beginDir.source, OmpDirective::SECTIONS);
+    break;
+  default: break;
+  }
+  ClearDataSharingAttributeObjects();
+  return true;
+}
+
+bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
+  PushContext(x.source, OmpDirective::THREADPRIVATE);
+  const auto &list{std::get<parser::OmpObjectList>(x.t)};
+  ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
+  return false;
+}
+
+void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
+  if (!ompContext_.empty()) {
+    switch (x.v) {
+    case parser::OmpDefaultClause::Type::Private:
+      SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
+      break;
+    case parser::OmpDefaultClause::Type::Firstprivate:
+      SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
+      break;
+    case parser::OmpDefaultClause::Type::Shared:
+      SetContextDefaultDSA(Symbol::Flag::OmpShared);
+      break;
+    case parser::OmpDefaultClause::Type::None:
+      SetContextDefaultDSA(Symbol::Flag::OmpNone);
+      break;
+    }
+  }
+}
+
+// For OpenMP constructs, check all the data-refs within the constructs
+// and adjust the symbol for each Name if necessary
+void OmpAttributeVisitor::Post(const parser::Name &name) {
+  auto *symbol{name.symbol};
+  if (symbol && !ompContext_.empty() && GetContext().withinConstruct) {
+    if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
+        !IsObjectWithDSA(*symbol)) {
+      // TODO: create a separate function to go through the rules for
+      //       predetermined, explicitly determined, and implicitly
+      //       determined data-sharing attributes (2.15.1.1).
+      if (Symbol * found{currScope().FindSymbol(name.source)}) {
+        if (IsObjectWithDSA(*found)) {
+          name.symbol = found;  // adjust the symbol within region
+        } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
+          context_.Say(name.source,
+              "The DEFAULT(NONE) clause requires that '%s' must be listed in "
+              "a data-sharing attribute clause"_err_en_US,
+              symbol->name());
+        }
+      }
+    }
+  }  // within OpenMP construct
+}
+
+bool OmpAttributeVisitor::HasDataSharingAttributeObject(const Symbol &object) {
+  auto it{dataSharingAttributeObjects_.find(object)};
+  return it != dataSharingAttributeObjects_.end();
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
+    const parser::Name *name) {
+  if (auto *prev{name
+              ? GetContext().scope.parent().FindCommonBlock(name->source)
+              : nullptr}) {
+    name->symbol = prev;
+    return prev;
+  } else {
+    return nullptr;
+  }
+}
+
+void OmpAttributeVisitor::ResolveOmpObjectList(
+    const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
+  for (const auto &ompObject : ompObjectList.v) {
+    ResolveOmpObject(ompObject, ompFlag);
+  }
+}
+
+void OmpAttributeVisitor::ResolveOmpObject(
+    const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
+  std::visit(
+      common::visitors{
+          [&](const parser::Designator &designator) {
+            if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
+              if (auto *symbol{ResolveOmp(*name, ompFlag)}) {
+                AddToContextObjectWithDSA(*symbol, ompFlag);
+                if (dataSharingAttributeFlags.test(ompFlag)) {
+                  CheckMultipleAppearances(*name, *symbol, ompFlag);
+                }
+              }
+            } else if (const auto *designatorName{
+                           resolver_.ResolveDesignator(designator)};
+                       designatorName->symbol) {
+              // Array sections to be changed to substrings as needed
+              if (AnalyzeExpr(context_, designator)) {
+                if (std::holds_alternative<parser::Substring>(designator.u)) {
+                  context_.Say(designator.source,
+                      "Substrings are not allowed on OpenMP "
+                      "directives or clauses"_err_en_US);
+                }
+              }
+              // other checks, more TBD
+              if (const auto *details{designatorName->symbol
+                                          ->detailsIf<ObjectEntityDetails>()}) {
+                if (details->IsArray()) {
+                  // TODO: check Array Sections
+                } else if (designatorName->symbol->owner().IsDerivedType()) {
+                  // TODO: check Structure Component
+                }
+              }
+            }
+          },
+          [&](const parser::Name &name) {  // common block
+            if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
+              CheckMultipleAppearances(
+                  name, *symbol, Symbol::Flag::OmpCommonBlock);
+              // 2.15.3 When a named common block appears in a list, it has the
+              // same meaning as if every explicit member of the common block
+              // appeared in the list
+              for (const Symbol &object :
+                  symbol->get<CommonBlockDetails>().objects()) {
+                Symbol &mutableObject{const_cast<Symbol &>(object)};
+                if (auto *resolvedObject{ResolveOmp(mutableObject, ompFlag)}) {
+                  AddToContextObjectWithDSA(*resolvedObject, ompFlag);
+                }
+              }
+            } else {
+              context_.Say(name.source,  // 2.15.3
+                  "COMMON block must be declared in the same scoping unit "
+                  "in which the OpenMP directive or clause appears"_err_en_US);
+            }
+          },
+      },
+      ompObject.u);
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmp(
+    const parser::Name &name, Symbol::Flag ompFlag) {
+  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+    return DeclarePrivateAccessEntity(name, ompFlag);
+  } else {
+    return DeclareOrMarkOtherAccessEntity(name, ompFlag);
+  }
+}
+
+Symbol *OmpAttributeVisitor::ResolveOmp(Symbol &symbol, Symbol::Flag ompFlag) {
+  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+    return DeclarePrivateAccessEntity(symbol, ompFlag);
+  } else {
+    return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
+  }
+}
+
+Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
+    const parser::Name &name, Symbol::Flag ompFlag) {
+  if (!name.symbol) {
+    return nullptr;  // not resolved by Name Resolution step, do nothing
+  }
+  name.symbol = DeclarePrivateAccessEntity(*name.symbol, ompFlag);
+  return name.symbol;
+}
+
+Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
+    Symbol &object, Symbol::Flag ompFlag) {
+  if (object.owner() != currScope()) {
+    auto &symbol{MakeAssocSymbol(object.name(), object)};
+    symbol.set(ompFlag);
+    return &symbol;
+  } else {
+    object.set(ompFlag);
+    return &object;
+  }
+}
+
+Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
+    const parser::Name &name, Symbol::Flag ompFlag) {
+  Symbol *prev{currScope().FindSymbol(name.source)};
+  if (!name.symbol || !prev) {
+    return nullptr;
+  } else if (prev != name.symbol) {
+    name.symbol = prev;
+  }
+  return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
+}
+
+Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
+    Symbol &object, Symbol::Flag ompFlag) {
+  if (ompFlagsRequireMark.test(ompFlag)) {
+    object.set(ompFlag);
+  }
+  return &object;
+}
+
+static bool WithMultipleAppearancesException(
+    const Symbol &symbol, Symbol::Flag ompFlag) {
+  return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
+             symbol.test(Symbol::Flag::OmpLastPrivate)) ||
+      (ompFlag == Symbol::Flag::OmpLastPrivate &&
+          symbol.test(Symbol::Flag::OmpFirstPrivate));
+}
+
+void OmpAttributeVisitor::CheckMultipleAppearances(
+    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
+  const auto *target{&symbol};
+  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+    if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
+      target = &details->symbol();
+    }
+  }
+  if (HasDataSharingAttributeObject(*target) &&
+      !WithMultipleAppearancesException(symbol, ompFlag)) {
+    context_.Say(name.source,
+        "'%s' appears in more than one data-sharing clause "
+        "on the same OpenMP directive"_err_en_US,
+        name.ToString());
+  } else {
+    AddDataSharingAttributeObject(*target);
+  }
+}
+
 // Perform checks and completions that need to happen after all of
 // the specification parts but before any of the execution parts.
 void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
index 96400b6..9db5995 100644 (file)
@@ -244,7 +244,10 @@ Scope *Scope::FindScope(parser::CharBlock source) {
 }
 
 void Scope::AddSourceRange(const parser::CharBlock &source) {
-  sourceRange_.ExtendToCover(source);
+  for (auto *scope = this; !scope->IsGlobal();
+       scope = &scope->parent()) {
+    scope->sourceRange_.ExtendToCover(source);
+  }
 }
 
 std::ostream &operator<<(std::ostream &os, const Scope &scope) {
index 1765b43..5dfbcb2 100644 (file)
@@ -163,6 +163,7 @@ set(ERROR_TESTS
   omp-resolve02.f90
   omp-resolve03.f90
   omp-resolve04.f90
+  omp-resolve05.f90
   omp-clause-validity01.f90
   omp-loop-association.f90
 #  omp-nested01.f90
@@ -227,6 +228,7 @@ set(SYMBOL_TESTS
   omp-symbol04.f90
   omp-symbol05.f90
   omp-symbol06.f90
+  omp-symbol07.f90
   kinds01.f90
   kinds03.f90
   procinterface01.f90
index ca94687..118e49c 100644 (file)
@@ -91,7 +91,7 @@ program main
   !$omp end teams
 
   !ERROR: At most one DEFAULT clause can appear on the TEAMS directive
-  !$omp teams default(shared) default(none)
+  !$omp teams default(shared) default(private)
   do i = 1, N
      a = 3.14
   enddo
diff --git a/flang/test/semantics/omp-resolve05.f90 b/flang/test/semantics/omp-resolve05.f90
new file mode 100644 (file)
index 0000000..0ba4fd8
--- /dev/null
@@ -0,0 +1,23 @@
+!OPTIONS: -fopenmp
+
+! 2.15.3 Data-Sharing Attribute Clauses
+! 2.15.3.1 default Clause
+
+subroutine default_none()
+  integer a(3)
+
+  A = 1
+  B = 2
+  !$omp parallel default(none) private(c)
+  !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-sharing attribute clause
+  A(1:2) = 3
+  !ERROR: The DEFAULT(NONE) clause requires that 'b' must be listed in a data-sharing attribute clause
+  B = 4
+  C = 5
+  !$omp end parallel
+end subroutine default_none
+
+program mm
+  call default_none()
+  !TODO: private, firstprivate, shared
+end
diff --git a/flang/test/semantics/omp-symbol07.f90 b/flang/test/semantics/omp-symbol07.f90
new file mode 100644 (file)
index 0000000..1704529
--- /dev/null
@@ -0,0 +1,37 @@
+!OPTIONS: -fopenmp
+
+! Generic tests
+!   1. subroutine or function calls should not be fixed for DSA or DMA
+
+!DEF: /foo (Function) Subprogram REAL(4)
+!DEF: /foo/rnum ObjectEntity REAL(4)
+function foo(rnum)
+  !REF: /foo/rnum
+  real rnum
+  !REF: /foo/rnum
+  rnum = rnum+1.
+end function foo
+!DEF: /function_call_in_region EXTERNAL (Subroutine) Subprogram
+subroutine function_call_in_region
+  implicit none
+  !DEF: /function_call_in_region/foo (Function) ProcEntity REAL(4)
+  real foo
+  !DEF: /function_call_in_region/a ObjectEntity REAL(4)
+  real :: a = 0.
+  !DEF: /function_call_in_region/b ObjectEntity REAL(4)
+  real :: b = 5.
+  !$omp parallel  default(none) private(a) shared(b)
+  !DEF: /function_call_in_region/Block1/a (OmpPrivate) HostAssoc REAL(4)
+  !REF: /function_call_in_region/foo
+  !REF: /function_call_in_region/b
+  a = foo(b)
+  !$omp end parallel
+  !REF: /function_call_in_region/a
+  !REF: /function_call_in_region/b
+  print *, a, b
+end subroutine function_call_in_region
+!DEF: /mm MainProgram
+program mm
+  !REF: /function_call_in_region
+  call function_call_in_region
+end program mm