[flang] Initial support for name resolution in modules.

Recognize modules and open and close the corresponding scope.
Handle PUBLIC and PRIVATE statements and set the corresponding
attributes on entity declarations in the module.

Refactoring (no functional changes): Make CheckImplicitSymbol() and
GetVariableName() overloadings private and out-of-line.

Add missing option to f18 help.

Original-commit: flang-compiler/f18@d01cacca6335629b8c82205a45d4347754dada5f
Reviewed-on: https://github.com/flang-compiler/f18/pull/70
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index a535613..bd3c923 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -90,6 +90,14 @@ public:
 protected:
   std::optional<Attrs> attrs_;
   std::string langBindingName_{""};
+
+  Attr AccessSpecToAttr(const parser::AccessSpec &x) {
+    switch (x.v) {
+    case parser::AccessSpec::Kind::Public: return Attr::PUBLIC;
+    case parser::AccessSpec::Kind::Private: return Attr::PRIVATE;
+    default: CRASH_NO_CASE;
+    }
+  }
 };
 
 // Find and create types from declaration-type-spec nodes.
@@ -330,6 +338,8 @@ public:
   void Post(const parser::EndFunctionStmt &);
   bool Pre(const parser::MainProgram &);
   void Post(const parser::EndProgramStmt &);
+  bool Pre(const parser::ModuleStmt &);
+  void Post(const parser::EndModuleStmt &);
   void Post(const parser::Program &);
 
   bool Pre(const parser::AllocatableStmt &) {
@@ -343,58 +353,13 @@ public:
   }
   void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
   void Post(const parser::DimensionStmt::Declaration &);
-
-  const parser::Name *GetVariableName(const parser::DataRef &x) {
-    return std::get_if<parser::Name>(&x.u);
-  }
-  const parser::Name *GetVariableName(const parser::Designator &x) {
-    return std::visit(
-        parser::visitors{
-            [&](const parser::ObjectName &x) { return &x; },
-            [&](const parser::DataRef &x) { return GetVariableName(x); },
-            [&](const auto &) {
-              return static_cast<const parser::Name *>(nullptr);
-            },
-        },
-        x.u);
-  }
-  const parser::Name *GetVariableName(const parser::Expr &x) {
-    if (const auto *designator =
-            std::get_if<parser::Indirection<parser::Designator>>(&x.u)) {
-      return GetVariableName(**designator);
-    } else {
-      return nullptr;
-    }
-  }
-  const parser::Name *GetVariableName(const parser::Variable &x) {
-    if (const auto *designator =
-            std::get_if<parser::Indirection<parser::Designator>>(&x.u)) {
-      return GetVariableName(**designator);
-    } else {
-      return nullptr;
-    }
-  }
+  bool Pre(const parser::AccessStmt &);
 
   void Post(const parser::Expr &x) { CheckImplicitSymbol(GetVariableName(x)); }
   void Post(const parser::Variable &x) {
     CheckImplicitSymbol(GetVariableName(x));
   }
 
-  // If implicit types are allowed, ensure name is in the symbol table
-  void CheckImplicitSymbol(const parser::Name *name) {
-    if (name) {
-      if (!isImplicitNoneType()) {
-        // ensure this name is in symbol table:
-        CurrScope().try_emplace(name->source);
-      } else {
-        const auto &it = CurrScope().find(name->source);
-        if (it == CurrScope().end() || it->second.has<UnknownDetails>()) {
-          Say(*name, "No explicit type declared for '%s'"_err_en_US);
-        }
-      }
-    }
-  }
-
   void Post(const parser::ProcedureDesignator &x) {
     if (const auto *name = std::get_if<parser::Name>(&x.u)) {
       Symbol &symbol{MakeSymbol(*name)};
@@ -426,6 +391,10 @@ private:
   std::optional<Attr> objectDeclAttr_;
   // Set when we see a stmt function that is really an array element assignment
   bool badStmtFuncFound_{false};
+  // The location of the last AccessStmt seen, if any.
+  const parser::CharBlock *prevAccessStmt_{nullptr};
+  // The default access spec for this module.
+  Attr defaultAccess_{Attr::PUBLIC};
 
   // Create a subprogram symbol in the current scope and push a new scope.
   Symbol &PushSubprogramScope(const parser::Name &);
@@ -472,6 +441,13 @@ private:
     return MakeSymbol(name, attrs, UnknownDetails());
   }
   void DeclareEntity(const parser::Name &, Attrs);
+  void SetAccess(const parser::Name &, Attr);
+  void ApplyDefaultAccess();
+  const parser::Name *GetVariableName(const parser::DataRef &);
+  const parser::Name *GetVariableName(const parser::Designator &);
+  const parser::Name *GetVariableName(const parser::Expr &);
+  const parser::Name *GetVariableName(const parser::Variable &);
+  void CheckImplicitSymbol(const parser::Name *);
 };
 
 // ImplicitRules implementation
@@ -553,11 +529,7 @@ void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
   }
 }
 bool AttrsVisitor::Pre(const parser::AccessSpec &x) {
-  switch (x.v) {
-  case parser::AccessSpec::Kind::Public: attrs_->set(Attr::PUBLIC); break;
-  case parser::AccessSpec::Kind::Private: attrs_->set(Attr::PRIVATE); break;
-  default: CRASH_NO_CASE;
-  }
+  attrs_->set(AccessSpecToAttr(x));
   return false;
 }
 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
@@ -691,7 +663,7 @@ void MessageHandler::Say(parser::MessageFormattedText &&x) {
 
 void MessageHandler::Say(
     const parser::CharBlock &source, parser::MessageFixedText &&msg) {
-  Say(parser::Message{
+  Say(Message{
       source, parser::MessageFormattedText{msg, source.ToString().c_str()}});
 }
 void MessageHandler::Say(
@@ -919,6 +891,49 @@ void ResolveNamesVisitor::DeclareEntity(const parser::Name &name, Attrs attrs) {
   }
 }
 
+bool ResolveNamesVisitor::Pre(const parser::AccessStmt &x) {
+  Attr accessAttr = AccessSpecToAttr(std::get<parser::AccessSpec>(x.t));
+  const auto &accessIds = std::get<std::list<parser::AccessId>>(x.t);
+  if (accessIds.empty()) {
+    if (prevAccessStmt_) {
+      Say("The default accessibility of this module has already "
+          "been declared"_err_en_US);
+      Say(*prevAccessStmt_, "Previous declaration"_en_US);
+    }
+    prevAccessStmt_ = currStmtSource();
+    defaultAccess_ = accessAttr;
+  } else {
+    for (const auto &accessId : accessIds) {
+      std::visit(
+          parser::visitors{
+              [=](const parser::Name &y) { SetAccess(y, accessAttr); },
+              [=](const parser::Indirection<parser::GenericSpec> &y) {
+                std::visit(
+                    parser::visitors{
+                        [=](const parser::Name &z) {
+                          SetAccess(z, accessAttr);
+                        },
+                        [](const auto &) { parser::die("TODO: GenericSpec"); },
+                    },
+                    y->u);
+              },
+          },
+          accessId.u);
+    }
+  }
+  return false;
+}
+
+// Set the access specification for this name.
+void ResolveNamesVisitor::SetAccess(const parser::Name &name, Attr attr) {
+  Symbol &symbol{MakeSymbol(name)};
+  if (symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
+    Say(name, "The accessibility of '%s' has already been specified"_err_en_US);
+  } else {
+    symbol.attrs().set(attr);
+  }
+}
+
 void ResolveNamesVisitor::Post(const parser::SpecificationPart &s) {
   badStmtFuncFound_ = false;
   if (isImplicitNoneType()) {
@@ -1110,6 +1125,79 @@ void ResolveNamesVisitor::Post(const parser::EndProgramStmt &) {
   PopScope();
 }
 
+bool ResolveNamesVisitor::Pre(const parser::ModuleStmt &stmt) {
+  const auto &name = stmt.v;
+  auto &symbol = MakeSymbol(name, ModuleDetails());
+  Scope &modScope = CurrScope().MakeScope(Scope::Kind::Module, &symbol);
+  PushScope(modScope);
+  MakeSymbol(name, ModuleDetails(symbol.details<ModuleDetails>()));
+  return false;
+}
+void ResolveNamesVisitor::Post(const parser::EndModuleStmt &) {
+  ApplyDefaultAccess();
+  ApplyImplicitRules();
+  PopScope();
+}
+
+void ResolveNamesVisitor::ApplyDefaultAccess() {
+  for (auto &pair : CurrScope()) {
+    Symbol &symbol = pair.second;
+    if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
+      symbol.attrs().set(defaultAccess_);
+    }
+  }
+}
+
+const parser::Name *ResolveNamesVisitor::GetVariableName(
+    const parser::DataRef &x) {
+  return std::get_if<parser::Name>(&x.u);
+}
+const parser::Name *ResolveNamesVisitor::GetVariableName(
+    const parser::Designator &x) {
+  return std::visit(
+      parser::visitors{
+          [&](const parser::ObjectName &x) { return &x; },
+          [&](const parser::DataRef &x) { return GetVariableName(x); },
+          [&](const auto &) {
+            return static_cast<const parser::Name *>(nullptr);
+          },
+      },
+      x.u);
+}
+const parser::Name *ResolveNamesVisitor::GetVariableName(
+    const parser::Expr &x) {
+  if (const auto *designator =
+          std::get_if<parser::Indirection<parser::Designator>>(&x.u)) {
+    return GetVariableName(**designator);
+  } else {
+    return nullptr;
+  }
+}
+const parser::Name *ResolveNamesVisitor::GetVariableName(
+    const parser::Variable &x) {
+  if (const auto *designator =
+          std::get_if<parser::Indirection<parser::Designator>>(&x.u)) {
+    return GetVariableName(**designator);
+  } else {
+    return nullptr;
+  }
+}
+
+// If implicit types are allowed, ensure name is in the symbol table
+void ResolveNamesVisitor::CheckImplicitSymbol(const parser::Name *name) {
+  if (name) {
+    if (!isImplicitNoneType()) {
+      // ensure this name is in symbol table:
+      CurrScope().try_emplace(name->source);
+    } else {
+      const auto &it = CurrScope().find(name->source);
+      if (it == CurrScope().end() || it->second.has<UnknownDetails>()) {
+        Say(*name, "No explicit type declared for '%s'"_err_en_US);
+      }
+    }
+  }
+}
+
 void ResolveNamesVisitor::Post(const parser::Program &) {
   // ensure that all temps were deallocated
   CHECK(!attrs_);

diff --git a/flang/test/semantics/resolve10.f90 b/flang/test/semantics/resolve10.f90
new file mode 100644 (file)
index 0000000..0a150ae
--- /dev/null
+++ b/flang/test/semantics/resolve10.f90
@@ -0,0 +1,5 @@
+module m
+  public
+  !ERROR: The default accessibility of this module has already been declared
+  private
+end

diff --git a/flang/test/semantics/resolve11.f90 b/flang/test/semantics/resolve11.f90
new file mode 100644 (file)
index 0000000..88c0255
--- /dev/null
+++ b/flang/test/semantics/resolve11.f90
@@ -0,0 +1,5 @@
+module m
+  public i
+  !ERROR: The accessibility of 'i' has already been specified
+  private i
+end

diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc
index 33cda50..e1d7904 100644 (file)
--- a/flang/tools/f18/f18.cc
+++ b/flang/tools/f18/f18.cc
@@ -375,6 +375,7 @@ int main(int argc, char *const argv[]) {
           << "  -fdebug-measure-parse-tree\n"
           << "  -fdebug-dump-provenance\n"
           << "  -fdebug-dump-parse-tree\n"
+          << "  -fdebug-dump-symbols\n"
           << "  -fdebug-resolve-names\n"
           << "  -fdebug-instrumented-parse\n"
           << "  -v -c -o -I -D -U    have their usual meanings\n"