[flang-commits] [flang] 52a1346 - [flang] Distinguish intrinsic from non-intrinsic modules

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Mon Jan 31 13:31:35 PST 2022


Author: Peter Klausler
Date: 2022-01-31T13:31:27-08:00
New Revision: 52a1346b78b0971b6a89c53a6881cb9655e81245

URL: https://github.com/llvm/llvm-project/commit/52a1346b78b0971b6a89c53a6881cb9655e81245
DIFF: https://github.com/llvm/llvm-project/commit/52a1346b78b0971b6a89c53a6881cb9655e81245.diff

LOG: [flang] Distinguish intrinsic from non-intrinsic modules

For "USE, INTRINSIC", search only for intrinsic modules;
for "USE, NON_INTRINSIC", do not recognize intrinsic modules.
Allow modules of both kinds with the same name to be used in
the same source file (but not in the same scoping unit, a
constraint of the standard that is now enforced).

The symbol table's scope tree now has a single instance of
a scope with a new kind, IntrinsicModules, whose children are
the USE'd intrinsic modules (explicit or not).  This separate
"top-level" scope is a child of the single global scope and
it allows both intrinsic and non-intrinsic modules of the same
name to exist in the symbol table.  Intrinsic modules' scopes'
symbols now have the INTRINSIC attribute set.

The search path directories need to make a distinction between
regular directories and the one(s) that point(s) to intrinsic
modules.  I allow for multiple intrinsic module directories in
the second search path, although only one is needed today.

Differential Revision: https://reviews.llvm.org/D118631

Added: 
    flang/test/Semantics/modfile43.f90

Modified: 
    flang/include/flang/Parser/parsing.h
    flang/include/flang/Parser/provenance.h
    flang/include/flang/Semantics/scope.h
    flang/include/flang/Semantics/semantics.h
    flang/lib/Frontend/CompilerInvocation.cpp
    flang/lib/Lower/Mangler.cpp
    flang/lib/Parser/parsing.cpp
    flang/lib/Parser/provenance.cpp
    flang/lib/Semantics/mod-file.cpp
    flang/lib/Semantics/mod-file.h
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/resolve-names.h
    flang/lib/Semantics/scope.cpp
    flang/lib/Semantics/semantics.cpp
    flang/lib/Semantics/symbol.cpp
    flang/lib/Semantics/tools.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Parser/parsing.h b/flang/include/flang/Parser/parsing.h
index be2527981494c..f33c1ce55b733 100644
--- a/flang/include/flang/Parser/parsing.h
+++ b/flang/include/flang/Parser/parsing.h
@@ -32,6 +32,7 @@ struct Options {
   int fixedFormColumns{72};
   common::LanguageFeatureControl features;
   std::vector<std::string> searchDirectories;
+  std::vector<std::string> intrinsicModuleDirectories;
   std::vector<Predefinition> predefinitions;
   bool instrumentedParse{false};
   bool isModuleFile{false};

diff  --git a/flang/include/flang/Parser/provenance.h b/flang/include/flang/Parser/provenance.h
index 4ada5c81d6bac..eec0b9bb2a72f 100644
--- a/flang/include/flang/Parser/provenance.h
+++ b/flang/include/flang/Parser/provenance.h
@@ -149,6 +149,7 @@ class AllSources {
     return *this;
   }
 
+  void ClearSearchPath();
   void AppendSearchPathDirectory(std::string); // new last directory
   const SourceFile *Open(std::string path, llvm::raw_ostream &error,
       std::optional<std::string> &&prependPath = std::nullopt);

diff  --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h
index 6c6ee5956f490..97f8f1ccb5747 100644
--- a/flang/include/flang/Semantics/scope.h
+++ b/flang/include/flang/Semantics/scope.h
@@ -59,8 +59,8 @@ class Scope {
   using mapType = std::map<SourceName, MutableSymbolRef>;
 
 public:
-  ENUM_CLASS(Kind, Global, Module, MainProgram, Subprogram, BlockData,
-      DerivedType, Block, Forall, ImpliedDos)
+  ENUM_CLASS(Kind, Global, IntrinsicModules, Module, MainProgram, Subprogram,
+      BlockData, DerivedType, Block, Forall, ImpliedDos)
   using ImportKind = common::ImportKind;
 
   // Create the Global scope -- the root of the scope tree
@@ -87,6 +87,10 @@ class Scope {
   }
   Kind kind() const { return kind_; }
   bool IsGlobal() const { return kind_ == Kind::Global; }
+  bool IsIntrinsicModules() const { return kind_ == Kind::IntrinsicModules; }
+  bool IsTopLevel() const {
+    return kind_ == Kind::Global || kind_ == Kind::IntrinsicModules;
+  }
   bool IsModule() const {
     return kind_ == Kind::Module &&
         !symbol_->get<ModuleDetails>().isSubmodule();

diff  --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index f0660f6194212..6bd194fdfc03e 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -85,6 +85,9 @@ class SemanticsContext {
   const std::vector<std::string> &searchDirectories() const {
     return searchDirectories_;
   }
+  const std::vector<std::string> &intrinsicModuleDirectories() const {
+    return intrinsicModuleDirectories_;
+  }
   const std::string &moduleDirectory() const { return moduleDirectory_; }
   const std::string &moduleFileSuffix() const { return moduleFileSuffix_; }
   bool warnOnNonstandardUsage() const { return warnOnNonstandardUsage_; }
@@ -92,6 +95,7 @@ class SemanticsContext {
   bool debugModuleWriter() const { return debugModuleWriter_; }
   const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
   Scope &globalScope() { return globalScope_; }
+  Scope &intrinsicModulesScope() { return intrinsicModulesScope_; }
   parser::Messages &messages() { return messages_; }
   evaluate::FoldingContext &foldingContext() { return foldingContext_; }
   parser::AllCookedSources &allCookedSources() { return allCookedSources_; }
@@ -105,6 +109,11 @@ class SemanticsContext {
     searchDirectories_ = x;
     return *this;
   }
+  SemanticsContext &set_intrinsicModuleDirectories(
+      const std::vector<std::string> &x) {
+    intrinsicModuleDirectories_ = x;
+    return *this;
+  }
   SemanticsContext &set_moduleDirectory(const std::string &x) {
     moduleDirectory_ = x;
     return *this;
@@ -196,6 +205,7 @@ class SemanticsContext {
   parser::AllCookedSources &allCookedSources_;
   std::optional<parser::CharBlock> location_;
   std::vector<std::string> searchDirectories_;
+  std::vector<std::string> intrinsicModuleDirectories_;
   std::string moduleDirectory_{"."s};
   std::string moduleFileSuffix_{".mod"};
   bool warnOnNonstandardUsage_{false};
@@ -203,6 +213,7 @@ class SemanticsContext {
   bool debugModuleWriter_{false};
   const evaluate::IntrinsicProcTable intrinsics_;
   Scope globalScope_;
+  Scope &intrinsicModulesScope_;
   parser::Messages messages_;
   evaluate::FoldingContext foldingContext_;
   ConstructStack constructStack_;

diff  --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 2d8c9e386fce8..dcfa7412460f8 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -658,8 +658,8 @@ void CompilerInvocation::SetFortranOpts() {
       preprocessorOptions.searchDirectoriesFromIntrModPath.begin(),
       preprocessorOptions.searchDirectoriesFromIntrModPath.end());
 
-  //  Add the default intrinsic module directory at the end
-  fortranOptions.searchDirectories.emplace_back(getIntrinsicDir());
+  //  Add the default intrinsic module directory
+  fortranOptions.intrinsicModuleDirectories.emplace_back(getIntrinsicDir());
 
   // Add the directory supplied through -J/-module-dir to the list of search
   // directories
@@ -686,6 +686,7 @@ void CompilerInvocation::SetSemanticsOpts(
 
   semanticsContext_->set_moduleDirectory(moduleDir())
       .set_searchDirectories(fortranOptions.searchDirectories)
+      .set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
       .set_warnOnNonstandardUsage(enableConformanceChecks())
       .set_warningsAreErrors(warnAsErr())
       .set_moduleFileSuffix(moduleFileSuffix());

diff  --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index f74afc5b53dce..bc3252b018c83 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -22,7 +22,7 @@
 // recursively build the vector of module scopes
 static void moduleNames(const Fortran::semantics::Scope &scope,
                         llvm::SmallVector<llvm::StringRef, 2> &result) {
-  if (scope.kind() == Fortran::semantics::Scope::Kind::Global) {
+  if (scope.IsTopLevel()) {
     return;
   }
   moduleNames(scope.parent(), result);

diff  --git a/flang/lib/Parser/parsing.cpp b/flang/lib/Parser/parsing.cpp
index 92736619ec360..e29d5aff2496b 100644
--- a/flang/lib/Parser/parsing.cpp
+++ b/flang/lib/Parser/parsing.cpp
@@ -23,6 +23,7 @@ Parsing::~Parsing() {}
 const SourceFile *Parsing::Prescan(const std::string &path, Options options) {
   options_ = options;
   AllSources &allSources{allCooked_.allSources()};
+  allSources.ClearSearchPath();
   if (options.isModuleFile) {
     for (const auto &path : options.searchDirectories) {
       allSources.AppendSearchPathDirectory(path);

diff  --git a/flang/lib/Parser/provenance.cpp b/flang/lib/Parser/provenance.cpp
index cb8fbe7a4cdad..27cc1ebf84f89 100644
--- a/flang/lib/Parser/provenance.cpp
+++ b/flang/lib/Parser/provenance.cpp
@@ -159,6 +159,8 @@ const char &AllSources::operator[](Provenance at) const {
   return origin[origin.covers.MemberOffset(at)];
 }
 
+void AllSources::ClearSearchPath() { searchPath_.clear(); }
+
 void AllSources::AppendSearchPathDirectory(std::string directory) {
   // gfortran and ifort append to current path, PGI prepends
   searchPath_.push_back(directory);

diff  --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 20038c64319db..90cfbe04864db 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -899,8 +899,8 @@ static bool VerifyHeader(llvm::ArrayRef<char> content) {
   return expectSum == actualSum;
 }
 
-Scope *ModFileReader::Read(
-    const SourceName &name, Scope *ancestor, bool silent) {
+Scope *ModFileReader::Read(const SourceName &name,
+    std::optional<bool> isIntrinsic, Scope *ancestor, bool silent) {
   std::string ancestorName; // empty for module
   if (ancestor) {
     if (auto *scope{ancestor->FindSubmodule(name)}) {
@@ -908,16 +908,37 @@ Scope *ModFileReader::Read(
     }
     ancestorName = ancestor->GetName().value().ToString();
   } else {
-    auto it{context_.globalScope().find(name)};
-    if (it != context_.globalScope().end()) {
-      return it->second->scope();
+    if (!isIntrinsic.value_or(false)) {
+      auto it{context_.globalScope().find(name)};
+      if (it != context_.globalScope().end()) {
+        return it->second->scope();
+      }
+    }
+    if (isIntrinsic.value_or(true)) {
+      auto it{context_.intrinsicModulesScope().find(name)};
+      if (it != context_.intrinsicModulesScope().end()) {
+        return it->second->scope();
+      }
     }
   }
   parser::Parsing parsing{context_.allCookedSources()};
   parser::Options options;
   options.isModuleFile = true;
   options.features.Enable(common::LanguageFeature::BackslashEscapes);
-  options.searchDirectories = context_.searchDirectories();
+  if (!isIntrinsic.value_or(false)) {
+    options.searchDirectories = context_.searchDirectories();
+    // If a directory is in both lists, the intrinsic module directory
+    // takes precedence.
+    for (const auto &dir : context_.intrinsicModuleDirectories()) {
+      std::remove(options.searchDirectories.begin(),
+          options.searchDirectories.end(), dir);
+    }
+  }
+  if (isIntrinsic.value_or(true)) {
+    for (const auto &dir : context_.intrinsicModuleDirectories()) {
+      options.searchDirectories.push_back(dir);
+    }
+  }
   auto path{ModFileName(name, ancestorName, context_.moduleFileSuffix())};
   const auto *sourceFile{parsing.Prescan(path, options)};
   if (parsing.messages().AnyFatalError()) {
@@ -946,10 +967,21 @@ Scope *ModFileReader::Read(
     return nullptr;
   }
   Scope *parentScope; // the scope this module/submodule goes into
+  if (!isIntrinsic.has_value()) {
+    for (const auto &dir : context_.intrinsicModuleDirectories()) {
+      if (sourceFile->path().size() > dir.size() &&
+          sourceFile->path().find(dir) == 0) {
+        isIntrinsic = true;
+        break;
+      }
+    }
+  }
+  Scope &topScope{isIntrinsic.value_or(false) ? context_.intrinsicModulesScope()
+                                              : context_.globalScope()};
   if (!ancestor) {
-    parentScope = &context_.globalScope();
+    parentScope = &topScope;
   } else if (std::optional<SourceName> parent{GetSubmoduleParent(*parseTree)}) {
-    parentScope = Read(*parent, ancestor);
+    parentScope = Read(*parent, false /*not intrinsic*/, ancestor, silent);
   } else {
     parentScope = ancestor;
   }
@@ -959,9 +991,12 @@ Scope *ModFileReader::Read(
   }
   Symbol &modSymbol{*pair.first->second};
   modSymbol.set(Symbol::Flag::ModFile);
-  ResolveNames(context_, *parseTree);
+  ResolveNames(context_, *parseTree, topScope);
   CHECK(modSymbol.has<ModuleDetails>());
   CHECK(modSymbol.test(Symbol::Flag::ModFile));
+  if (isIntrinsic.value_or(false)) {
+    modSymbol.attrs().set(Attr::INTRINSIC);
+  }
   return modSymbol.scope();
 }
 

diff  --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h
index 1647928613f28..e732fdb9bcb63 100644
--- a/flang/lib/Semantics/mod-file.h
+++ b/flang/lib/Semantics/mod-file.h
@@ -81,8 +81,8 @@ class ModFileReader {
   // Find and read the module file for a module or submodule.
   // If ancestor is specified, look for a submodule of that module.
   // Return the Scope for that module/submodule or nullptr on error.
-  Scope *Read(
-      const SourceName &, Scope *ancestor = nullptr, bool silent = false);
+  Scope *Read(const SourceName &, std::optional<bool> isIntrinsic,
+      Scope *ancestor, bool silent = false);
 
 private:
   SemanticsContext &context_;

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 8e22bb5dc4394..b2613453e353d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -645,8 +645,13 @@ class ModuleVisitor : public virtual ScopeHandler {
   bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
   void ApplyDefaultAccess();
   void AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
+  void AddAndCheckExplicitIntrinsicUse(SourceName, bool isIntrinsic);
   void ClearUseRenames() { useRenames_.clear(); }
   void ClearUseOnly() { useOnly_.clear(); }
+  void ClearExplicitIntrinsicUses() {
+    explicitIntrinsicUses_.clear();
+    explicitNonIntrinsicUses_.clear();
+  }
 
 private:
   // The default access spec for this module.
@@ -659,6 +664,10 @@ class ModuleVisitor : public virtual ScopeHandler {
   std::set<std::pair<SourceName, Scope *>> useRenames_;
   // Names that have appeared in an ONLY clause of a USE statement
   std::set<std::pair<SourceName, Scope *>> useOnly_;
+  // Module names that have appeared in USE statements with explicit
+  // INTRINSIC or NON_INTRINSIC keywords
+  std::set<SourceName> explicitIntrinsicUses_;
+  std::set<SourceName> explicitNonIntrinsicUses_;
 
   Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
   // A rename in a USE statement: local => use
@@ -688,7 +697,8 @@ class ModuleVisitor : public virtual ScopeHandler {
   bool IsUseOnly(const SourceName &name) const {
     return useOnly_.find({name, useModuleScope_}) != useOnly_.end();
   }
-  Scope *FindModule(const parser::Name &, Scope *ancestor = nullptr);
+  Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic,
+      Scope *ancestor = nullptr);
 };
 
 class InterfaceVisitor : public virtual ScopeHandler {
@@ -1365,11 +1375,14 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
   using SubprogramVisitor::Post;
   using SubprogramVisitor::Pre;
 
-  ResolveNamesVisitor(SemanticsContext &context, ImplicitRulesMap &rules)
-      : BaseVisitor{context, *this, rules} {
-    PushScope(context.globalScope());
+  ResolveNamesVisitor(
+      SemanticsContext &context, ImplicitRulesMap &rules, Scope &top)
+      : BaseVisitor{context, *this, rules}, topScope_{top} {
+    PushScope(top);
   }
 
+  Scope &topScope() const { return topScope_; }
+
   // Default action for a parse tree node is to visit children.
   template <typename T> bool Pre(const T &) { return true; }
   template <typename T> void Post(const T &) {}
@@ -1427,6 +1440,7 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
   // Kind of procedure we are expecting to see in a ProcedureDesignator
   std::optional<Symbol::Flag> expectedProcFlag_;
   std::optional<SourceName> prevImportStmt_;
+  Scope &topScope_;
 
   void PreSpecificationConstruct(const parser::SpecificationConstruct &);
   void CreateCommonBlockSymbols(const parser::CommonStmt &);
@@ -2480,7 +2494,16 @@ bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
 
 // Set useModuleScope_ to the Scope of the module being used.
 bool ModuleVisitor::Pre(const parser::UseStmt &x) {
-  useModuleScope_ = FindModule(x.moduleName);
+  std::optional<bool> isIntrinsic;
+  if (x.nature) {
+    isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic;
+    AddAndCheckExplicitIntrinsicUse(x.moduleName.source, *isIntrinsic);
+  } else if (currScope().IsModule() && currScope().symbol() &&
+      currScope().symbol()->attrs().test(Attr::INTRINSIC)) {
+    // Intrinsic modules USE only other intrinsic modules
+    isIntrinsic = true;
+  }
+  useModuleScope_ = FindModule(x.moduleName, isIntrinsic);
   if (!useModuleScope_) {
     return false;
   }
@@ -2662,15 +2685,41 @@ void ModuleVisitor::AddGenericUse(
   generic.AddUse(currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol}));
 }
 
+// Enforce C1406
+void ModuleVisitor::AddAndCheckExplicitIntrinsicUse(
+    SourceName name, bool isIntrinsic) {
+  if (isIntrinsic) {
+    if (auto iter{explicitNonIntrinsicUses_.find(name)};
+        iter != explicitNonIntrinsicUses_.end()) {
+      Say(name,
+          "Cannot USE,INTRINSIC module '%s' in the same scope as USE,NON_INTRINSIC"_err_en_US,
+          name)
+          .Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
+    }
+    explicitIntrinsicUses_.insert(name);
+  } else {
+    if (auto iter{explicitIntrinsicUses_.find(name)};
+        iter != explicitIntrinsicUses_.end()) {
+      Say(name,
+          "Cannot USE,NON_INTRINSIC module '%s' in the same scope as USE,INTRINSIC"_err_en_US,
+          name)
+          .Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
+    }
+    explicitNonIntrinsicUses_.insert(name);
+  }
+}
+
 bool ModuleVisitor::BeginSubmodule(
     const parser::Name &name, const parser::ParentIdentifier &parentId) {
   auto &ancestorName{std::get<parser::Name>(parentId.t)};
   auto &parentName{std::get<std::optional<parser::Name>>(parentId.t)};
-  Scope *ancestor{FindModule(ancestorName)};
+  Scope *ancestor{FindModule(ancestorName, false /*not intrinsic*/)};
   if (!ancestor) {
     return false;
   }
-  Scope *parentScope{parentName ? FindModule(*parentName, ancestor) : ancestor};
+  Scope *parentScope{parentName
+          ? FindModule(*parentName, false /*not intrinsic*/, ancestor)
+          : ancestor};
   if (!parentScope) {
     return false;
   }
@@ -2696,9 +2745,10 @@ void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
 // If ancestor is present, look for a submodule of that ancestor module.
 // May have to read a .mod file to find it.
 // If an error occurs, report it and return nullptr.
-Scope *ModuleVisitor::FindModule(const parser::Name &name, Scope *ancestor) {
+Scope *ModuleVisitor::FindModule(const parser::Name &name,
+    std::optional<bool> isIntrinsic, Scope *ancestor) {
   ModFileReader reader{context()};
-  Scope *scope{reader.Read(name.source, ancestor)};
+  Scope *scope{reader.Read(name.source, isIntrinsic, ancestor)};
   if (!scope) {
     return nullptr;
   }
@@ -3463,12 +3513,11 @@ bool DeclarationVisitor::Pre(const parser::Initialization &) {
 }
 
 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
-  // TODO: may be under StructureStmt
   const auto &name{std::get<parser::ObjectName>(x.t)};
   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
   symbol.ReplaceName(name.source);
-  if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
+  if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
     if (ConvertToObjectEntity(symbol)) {
       Initialization(name, *init, false);
     }
@@ -6530,6 +6579,7 @@ bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
   Walk(useStmts);
   ClearUseRenames();
   ClearUseOnly();
+  ClearExplicitIntrinsicUses();
   Walk(importStmts);
   Walk(implicitPart);
   for (const auto &decl : decls) {
@@ -6828,7 +6878,7 @@ bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
     return true;
   }
   auto root{ProgramTree::Build(x)};
-  SetScope(context().globalScope());
+  SetScope(topScope_);
   ResolveSpecificationParts(root);
   FinishSpecificationParts(root);
   inExecutionPart_ = true;
@@ -7120,10 +7170,11 @@ void ResolveNamesVisitor::Post(const parser::Program &) {
 // constructed.
 static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};
 
-bool ResolveNames(SemanticsContext &context, const parser::Program &program) {
+bool ResolveNames(
+    SemanticsContext &context, const parser::Program &program, Scope &top) {
   ImplicitRulesMap implicitRulesMap;
   auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)};
-  ResolveNamesVisitor{context, implicitRulesMap}.Walk(program);
+  ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program);
   return !context.AnyFatalError();
 }
 
@@ -7132,7 +7183,8 @@ bool ResolveNames(SemanticsContext &context, const parser::Program &program) {
 void ResolveSpecificationParts(
     SemanticsContext &context, const Symbol &subprogram) {
   auto originalLocation{context.location()};
-  ResolveNamesVisitor visitor{context, DEREF(sharedImplicitRulesMap)};
+  ResolveNamesVisitor visitor{
+      context, DEREF(sharedImplicitRulesMap), context.globalScope()};
   const auto &details{subprogram.get<SubprogramNameDetails>()};
   ProgramTree &node{details.node()};
   const Scope &moduleScope{subprogram.owner()};

diff  --git a/flang/lib/Semantics/resolve-names.h b/flang/lib/Semantics/resolve-names.h
index 1a16f0936c660..78fdc2edc54a9 100644
--- a/flang/lib/Semantics/resolve-names.h
+++ b/flang/lib/Semantics/resolve-names.h
@@ -23,10 +23,11 @@ struct Program;
 
 namespace Fortran::semantics {
 
+class Scope;
 class SemanticsContext;
 class Symbol;
 
-bool ResolveNames(SemanticsContext &, const parser::Program &);
+bool ResolveNames(SemanticsContext &, const parser::Program &, Scope &top);
 void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
 void DumpSymbols(llvm::raw_ostream &);
 

diff  --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 289146a95efc7..3eda613ca422a 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -285,7 +285,7 @@ void Scope::add_importName(const SourceName &name) {
 
 // true if name can be imported or host-associated from parent scope.
 bool Scope::CanImport(const SourceName &name) const {
-  if (IsGlobal() || parent_.IsGlobal()) {
+  if (IsTopLevel() || parent_.IsTopLevel()) {
     return false;
   }
   switch (GetImportKind()) {
@@ -306,7 +306,7 @@ const Scope *Scope::FindScope(parser::CharBlock source) const {
 
 Scope *Scope::FindScope(parser::CharBlock source) {
   bool isContained{sourceRange_.Contains(source)};
-  if (!isContained && !IsGlobal() && !IsModuleFile()) {
+  if (!isContained && !IsTopLevel() && !IsModuleFile()) {
     return nullptr;
   }
   for (auto &child : children_) {
@@ -314,7 +314,7 @@ Scope *Scope::FindScope(parser::CharBlock source) {
       return scope;
     }
   }
-  return isContained ? this : nullptr;
+  return isContained && !IsTopLevel() ? this : nullptr;
 }
 
 void Scope::AddSourceRange(const parser::CharBlock &source) {

diff  --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 69b37e45aacb0..09bfd5e823110 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -165,7 +165,7 @@ using StatementSemanticsPass2 = SemanticsVisitor<AccStructureChecker,
 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {
-  ResolveNames(context, program);
+  ResolveNames(context, program, context.globalScope());
   RewriteParseTree(context, program);
   ComputeOffsets(context, context.globalScope());
   CheckDeclarations(context);
@@ -185,9 +185,10 @@ SemanticsContext::SemanticsContext(
     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
       allCookedSources_{allCookedSources},
       intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)},
-      globalScope_{*this}, foldingContext_{
-                               parser::ContextualMessages{&messages_},
-                               defaultKinds_, intrinsics_} {}
+      globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope(
+                               Scope::Kind::IntrinsicModules, nullptr)},
+      foldingContext_{
+          parser::ContextualMessages{&messages_}, defaultKinds_, intrinsics_} {}
 
 SemanticsContext::~SemanticsContext() {}
 
@@ -246,7 +247,9 @@ Scope &SemanticsContext::FindScope(parser::CharBlock source) {
   if (auto *scope{globalScope_.FindScope(source)}) {
     return *scope;
   } else {
-    common::die("SemanticsContext::FindScope(): invalid source location");
+    common::die(
+        "SemanticsContext::FindScope(): invalid source location for '%s'",
+        source.ToString().c_str());
   }
 }
 
@@ -339,8 +342,8 @@ bool SemanticsContext::IsTempName(const std::string &name) {
 }
 
 Scope *SemanticsContext::GetBuiltinModule(const char *name) {
-  return ModFileReader{*this}.Read(
-      SourceName{name, std::strlen(name)}, nullptr, true /*silence errors*/);
+  return ModFileReader{*this}.Read(SourceName{name, std::strlen(name)},
+      true /*intrinsic*/, nullptr, true /*silence errors*/);
 }
 
 void SemanticsContext::UseFortranBuiltinsModule() {

diff  --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 78074c3631ed5..c556adc64fba2 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -348,7 +348,7 @@ bool Symbol::IsSubprogram() const {
 
 bool Symbol::IsFromModFile() const {
   return test(Flag::ModFile) ||
-      (!owner_->IsGlobal() && owner_->symbol()->IsFromModFile());
+      (!owner_->IsTopLevel() && owner_->symbol()->IsFromModFile());
 }
 
 ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d)
@@ -543,7 +543,7 @@ void Symbol::dump() const { llvm::errs() << *this << '\n'; }
 // parent scopes. For scopes without corresponding symbols, use the kind
 // with an index (e.g. Block1, Block2, etc.).
 static void DumpUniqueName(llvm::raw_ostream &os, const Scope &scope) {
-  if (!scope.IsGlobal()) {
+  if (!scope.IsTopLevel()) {
     DumpUniqueName(os, scope.parent());
     os << '/';
     if (auto *scopeSymbol{scope.symbol()};

diff  --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index cd0fe2a298042..02877df091c65 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -31,16 +31,16 @@ static const Scope *FindScopeContaining(
     if (predicate(*scope)) {
       return scope;
     }
-    if (scope->IsGlobal()) {
+    if (scope->IsTopLevel()) {
       return nullptr;
     }
   }
 }
 
 const Scope &GetTopLevelUnitContaining(const Scope &start) {
-  CHECK(!start.IsGlobal());
+  CHECK(!start.IsTopLevel());
   return DEREF(FindScopeContaining(
-      start, [](const Scope &scope) { return scope.parent().IsGlobal(); }));
+      start, [](const Scope &scope) { return scope.parent().IsTopLevel(); }));
 }
 
 const Scope &GetTopLevelUnitContaining(const Symbol &symbol) {
@@ -58,7 +58,7 @@ const Scope *FindModuleFileContaining(const Scope &start) {
 }
 
 const Scope &GetProgramUnitContaining(const Scope &start) {
-  CHECK(!start.IsGlobal());
+  CHECK(!start.IsTopLevel());
   return DEREF(FindScopeContaining(start, [](const Scope &scope) {
     switch (scope.kind()) {
     case Scope::Kind::Module:
@@ -80,7 +80,7 @@ const Scope *FindPureProcedureContaining(const Scope &start) {
   // N.B. We only need to examine the innermost containing program unit
   // because an internal subprogram of a pure subprogram must also
   // be pure (C1592).
-  if (start.IsGlobal()) {
+  if (start.IsTopLevel()) {
     return nullptr;
   } else {
     const Scope &scope{GetProgramUnitContaining(start)};
@@ -203,7 +203,7 @@ bool IsUseAssociated(const Symbol &symbol, const Scope &scope) {
 
 bool DoesScopeContain(
     const Scope *maybeAncestor, const Scope &maybeDescendent) {
-  return maybeAncestor && !maybeDescendent.IsGlobal() &&
+  return maybeAncestor && !maybeDescendent.IsTopLevel() &&
       FindScopeContaining(maybeDescendent.parent(),
           [&](const Scope &scope) { return &scope == maybeAncestor; });
 }
@@ -1094,6 +1094,7 @@ ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
     }
     switch (ultimate.owner().kind()) {
     case Scope::Kind::Global:
+    case Scope::Kind::IntrinsicModules:
       return ProcedureDefinitionClass::External;
     case Scope::Kind::Module:
       return ProcedureDefinitionClass::Module;

diff  --git a/flang/test/Semantics/modfile43.f90 b/flang/test/Semantics/modfile43.f90
new file mode 100644
index 0000000000000..d2bf5e750ad12
--- /dev/null
+++ b/flang/test/Semantics/modfile43.f90
@@ -0,0 +1,30 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test intrinsic vs non_intrinsic module coexistence
+module iso_fortran_env
+  integer, parameter :: user_defined_123 = 123
+end module
+module m1
+  use, intrinsic :: iso_fortran_env, only: int32
+  !ERROR: Cannot USE,NON_INTRINSIC module 'iso_fortran_env' in the same scope as USE,INTRINSIC
+  use, non_intrinsic :: iso_fortran_env, only: user_defined_123
+end module
+module m2
+  use, intrinsic :: iso_fortran_env, only: int32
+end module
+module m3
+  use, non_intrinsic :: iso_fortran_env, only: user_defined_123
+end module
+module m4
+  use :: iso_fortran_env, only: user_defined_123
+end module
+module m5
+  !ERROR: Cannot read module file for module 'ieee_arithmetic': Source file 'ieee_arithmetic.mod' was not found
+  use, non_intrinsic :: ieee_arithmetic, only: ieee_selected_real_kind
+end module
+module notAnIntrinsicModule
+end module
+module m6
+  !ERROR: Cannot read module file for module 'notanintrinsicmodule': Source file 'notanintrinsicmodule.mod' was not found
+  use, intrinsic :: notAnIntrinsicModule
+end module
+


        


More information about the flang-commits mailing list