[flang] Support interface blocks.

Add subprogram symbols for each interface-body and set isInterface on
them. Create a symbol with GenericDetails for each generic interface
block and add interface specifications to the specific procedures of
the generic. InterfaceVisitor takes care of this.

Before processing the specification part of modules and subprograms,
collect the names of module subprograms and internal subprograms and add
them to the symbol table with SubprogramNameDetails. This allows us to
reference them from interface blocks in the specification part.
SubprogramNameDetails is converted to SubprogramDetails when the real
subprogram is visited.

This is achieved by setting subpNamesOnly_ and then walking the
ModuleSubprogramPart or InternalSubprogramPart. Creating the symbol and
scope for a module or subprogram now happens when the Module,
SubroutineSubprogram, or FunctionSubprogram node is encountered so
this can happen in the right order.

Add BeginSubprogram and EndSubprogram to handle the parts in common
between subprograms and interface specifications.

Add GenericSpec to type.h to represent all possible generic specs.
Only generic names are resolved so far.

Add tests for new error messages. Change resolve02.f90 to reflect the
new errors reported.

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

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 8af5d5b168fcd20a7cbe56332ef330f6b1e3b9d7..966003f9d0c06ef91f4d060bb385b21fede326d1 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -33,6 +33,9 @@ using namespace parser::literals;
 
 class MessageHandler;
 
+static GenericSpec MapGenericSpec(const parser::GenericSpec &);
+
+
 // ImplicitRules maps initial character of identifier to the DeclTypeSpec*
 // representing the implicit type; nullptr if none.
 class ImplicitRules {
@@ -66,6 +69,7 @@ private:
 class AttrsVisitor {
 public:
   void BeginAttrs();
+  Attrs GetAttrs();
   Attrs EndAttrs();
   void Post(const parser::LanguageBindingSpec &);
   bool Pre(const parser::AccessSpec &);
@@ -325,14 +329,14 @@ public:
   template<typename D>
   Symbol &MakeSymbol(const SourceName &name, const Attrs &attrs, D &&details) {
     const auto &it = CurrScope().find(name);
-    auto &symbol = it->second;
     if (it == CurrScope().end()) {
       const auto pair = CurrScope().try_emplace(name, attrs, details);
       CHECK(pair.second);  // name was not found, so must be able to add
       return pair.first->second;
     }
+    auto &symbol = it->second;
     symbol.add_occurrence(name);
-    if (symbol.has<UnknownDetails>()) {
+    if (symbol.CanReplaceDetails(details)) {
       // update the existing symbol
       symbol.attrs() |= attrs;
       symbol.set_details(details);
@@ -363,6 +367,11 @@ public:
     return MakeSymbol(name, attrs, UnknownDetails());
   }
 
+protected:
+  // When subpNamesOnly_ is set we are only collecting procedure names.
+  // Create symbols with SubprogramNameDetails of the given kind.
+  std::optional<SubprogramKind> subpNamesOnly_;
+
 private:
   // Stack of containing scopes; memory referenced is owned by parent scopes
   std::stack<Scope *, std::list<Scope *>> scopes_;
@@ -373,8 +382,8 @@ private:
 
 class ModuleVisitor : public virtual ScopeHandler {
 public:
-  bool Pre(const parser::ModuleStmt &);
-  void Post(const parser::EndModuleStmt &);
+  bool Pre(const parser::Module &);
+  void Post(const parser::Module &);
   bool Pre(const parser::AccessStmt &);
 
   bool Pre(const parser::Only &x) {
@@ -516,16 +525,47 @@ private:
   }
 };
 
-class SubprogramVisitor : public virtual ScopeHandler {
+class InterfaceVisitor : public virtual ScopeHandler {
+public:
+  bool Pre(const parser::InterfaceStmt &x);
+  void Post(const parser::InterfaceStmt &);
+  void Post(const parser::EndInterfaceStmt &);
+  bool Pre(const parser::GenericSpec &x);
+  bool Pre(const parser::TypeBoundGenericStmt &);
+  void Post(const parser::TypeBoundGenericStmt &);
+  bool Pre(const parser::ProcedureStmt &x);
+  bool Pre(const parser::GenericStmt &);
+  void Post(const parser::GenericStmt &x);
+
+  bool inInterfaceBlock() const { return inInterfaceBlock_; }
+  bool isGeneric() const { return genericSymbol_ != nullptr; }
+  bool isAbstract() const { return isAbstract_; }
+
+protected:
+  // Add name to the generic we are currently processing
+  void AddToGeneric(const parser::Name &name, bool expectModuleProc = false);
+
+private:
+  bool inInterfaceBlock_{false};  // set when in interface block
+  bool isAbstract_{false};  // set when in abstract interface block
+  Symbol *genericSymbol_{nullptr};  // set when in generic interface block
+};
+
+class SubprogramVisitor : public InterfaceVisitor {
 public:
   bool Pre(const parser::StmtFunctionStmt &);
   void Post(const parser::StmtFunctionStmt &);
-  bool Pre(const parser::SubroutineStmt &);
   void Post(const parser::SubroutineStmt &);
-  void Post(const parser::EndSubroutineStmt &);
   bool Pre(const parser::FunctionStmt &);
   void Post(const parser::FunctionStmt &);
-  void Post(const parser::EndFunctionStmt &);
+  bool Pre(const parser::SubroutineSubprogram &);
+  void Post(const parser::SubroutineSubprogram &);
+  bool Pre(const parser::FunctionSubprogram &);
+  void Post(const parser::FunctionSubprogram &);
+  bool Pre(const parser::InterfaceBody::Subroutine &);
+  void Post(const parser::InterfaceBody::Subroutine &);
+  bool Pre(const parser::InterfaceBody::Function &);
+  void Post(const parser::InterfaceBody::Function &);
   bool Pre(const parser::Suffix &);
 
 protected:
@@ -536,19 +576,24 @@ private:
   // Function result name from parser::Suffix, if any.
   const parser::Name *funcResultName_{nullptr};
 
+  bool BeginSubprogram(const parser::Name &,
+      const std::optional<parser::InternalSubprogramPart> &);
+  void EndSubprogram();
   // Create a subprogram symbol in the current scope and push a new scope.
   Symbol &PushSubprogramScope(const parser::Name &);
 };
 
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public ArraySpecVisitor,
-                            public virtual ModuleVisitor,
-                            public virtual SubprogramVisitor {
+                            public ModuleVisitor,
+                            public SubprogramVisitor {
 public:
   using ArraySpecVisitor::Post;
   using ArraySpecVisitor::Pre;
   using ImplicitRulesVisitor::Post;
   using ImplicitRulesVisitor::Pre;
+  using InterfaceVisitor::Post;
+  using InterfaceVisitor::Pre;
   using ModuleVisitor::Post;
   using ModuleVisitor::Pre;
   using SubprogramVisitor::Post;
@@ -604,7 +649,7 @@ public:
         }
         symbol.attrs().set(Attr::EXTERNAL);
         symbol.set_details(SubprogramDetails{});
-      } else if (!symbol.has<SubprogramDetails>()) {
+      } else if (!symbol.isSubprogram()) {
         auto *details = symbol.detailsIf<EntityDetails>();
         if (!details || !details->isArray()) {
           Say(*name,
@@ -698,6 +743,10 @@ void AttrsVisitor::BeginAttrs() {
   CHECK(!attrs_);
   attrs_ = std::make_optional<Attrs>();
 }
+Attrs AttrsVisitor::GetAttrs() {
+  CHECK(attrs_);
+  return *attrs_;
+}
 Attrs AttrsVisitor::EndAttrs() {
   CHECK(attrs_);
   Attrs result{*attrs_};
@@ -1000,18 +1049,27 @@ void ScopeHandler::ApplyImplicitRules() {
 
 // ModuleVisitor implementation
 
-bool ModuleVisitor::Pre(const parser::ModuleStmt &stmt) {
-  const auto &name = stmt.v;
+bool ModuleVisitor::Pre(const parser::Module &x) {
+  // Make a symbol and push a scope for this module
+  const auto &name =
+      std::get<parser::Statement<parser::ModuleStmt>>(x.t).statement.v;
   auto &symbol = MakeSymbol(name, ModuleDetails{});
   ModuleDetails &details{symbol.details<ModuleDetails>()};
   Scope &modScope = CurrScope().MakeScope(Scope::Kind::Module, &symbol);
   details.set_scope(&modScope);
   PushScope(modScope);
   MakeSymbol(name, ModuleDetails{details});
-  return false;
+  // collect module subprogram names
+  if (const auto &subpPart =
+          std::get<std::optional<parser::ModuleSubprogramPart>>(x.t)) {
+    subpNamesOnly_ = SubprogramKind::Module;
+    parser::Walk(*subpPart, *static_cast<ResolveNamesVisitor*>(this));
+    subpNamesOnly_ = std::nullopt;
+  }
+  return true;
 }
 
-void ModuleVisitor::Post(const parser::EndModuleStmt &) {
+void ModuleVisitor::Post(const parser::Module &) {
   ApplyDefaultAccess();
   PopScope();
 }
@@ -1025,6 +1083,97 @@ void ModuleVisitor::ApplyDefaultAccess() {
   }
 }
 
+// InterfaceVistor implementation
+
+bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
+  inInterfaceBlock_ = true;
+  isAbstract_ = std::holds_alternative<parser::Abstract>(x.u);
+  BeginAttrs(); // GenericSpec expects this
+  return true;
+}
+void InterfaceVisitor::Post(const parser::InterfaceStmt &) {
+  EndAttrs();
+}
+
+void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
+  inInterfaceBlock_ = false;
+  isAbstract_ = false;
+  genericSymbol_ = nullptr;
+}
+
+// Create a symbol for the generic in genericSymbol_
+bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
+  auto attrs = GetAttrs();
+  const SourceName *genericName{nullptr};
+  GenericSpec genericSpec{MapGenericSpec(x)};
+  switch (genericSpec.kind()) {
+  case GenericSpec::Kind::GENERIC_NAME:
+    genericName = &genericSpec.genericName();
+    break;
+  case GenericSpec::Kind::OP_DEFINED:
+    genericName = &genericSpec.definedOp();
+    break;
+  default:
+    CRASH_NO_CASE;  // TODO: intrinsic ops
+  }
+  genericSymbol_ = &MakeSymbol(*genericName, attrs, GenericDetails{});
+  return false;
+}
+
+bool InterfaceVisitor::Pre(const parser::TypeBoundGenericStmt &) {
+  BeginAttrs();
+  return true;
+}
+void InterfaceVisitor::Post(const parser::TypeBoundGenericStmt &) {
+  EndAttrs();
+}
+
+bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
+  if (!isGeneric()) {
+    Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
+    return false;
+  }
+  bool expectModuleProc = std::get<parser::ProcedureStmt::Kind>(x.t) ==
+      parser::ProcedureStmt::Kind::ModuleProcedure;
+  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+    AddToGeneric(name, expectModuleProc);
+  }
+  return false;
+}
+
+bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
+  BeginAttrs();
+  return true;
+}
+void InterfaceVisitor::Post(const parser::GenericStmt &x) {
+  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+    AddToGeneric(name);
+  }
+  EndAttrs();
+}
+
+void InterfaceVisitor::AddToGeneric(
+    const parser::Name &name, bool expectModuleProc) {
+  const auto &it = CurrScope().find(name.source);
+  if (it == CurrScope().end()) {
+    Say(name, "Procedure '%s' not found"_err_en_US);
+    return;
+  }
+  auto &symbol = it->second;
+  if (!symbol.has<SubprogramDetails>() &&
+      !symbol.has<SubprogramNameDetails>()) {
+    Say(name, "'%s' is not a subprogram"_err_en_US);
+    return;
+  }
+  if (expectModuleProc) {
+    const auto *details = symbol.detailsIf<SubprogramNameDetails>();
+    if (!details || details->kind() != SubprogramKind::Module) {
+      Say(name, "'%s' is not a module procedure"_en_US);
+    }
+  }
+  genericSymbol_->details<GenericDetails>().add_specificProc(&symbol);
+}
+
 // SubprogramVisitor implementation
 
 bool SubprogramVisitor::Pre(const parser::StmtFunctionStmt &x) {
@@ -1052,7 +1201,6 @@ bool SubprogramVisitor::Pre(const parser::StmtFunctionStmt &x) {
     Say(name, "'%s' has not been declared as an array"_err_en_US);
     return true;
   }
-  BeginAttrs();  // no attrs to collect, but PushSubprogramScope expects this
   auto &symbol = PushSubprogramScope(name);
   CopyImplicitRules();
   if (occurrence) {
@@ -1087,33 +1235,62 @@ void SubprogramVisitor::Post(const parser::StmtFunctionStmt &x) {
   PopScope();
 }
 
-void SubprogramVisitor::Post(const parser::EndSubroutineStmt &subp) {
-  PopScope();
+bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
+  funcResultName_ = &suffix.resultName.value();
+  return true;
 }
 
-void SubprogramVisitor::Post(const parser::EndFunctionStmt &subp) {
-  PopScope();
+bool SubprogramVisitor::Pre(const parser::SubroutineSubprogram &x) {
+  const auto &name = std::get<parser::Name>(
+      std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t);
+  const auto &subpPart =
+          std::get<std::optional<parser::InternalSubprogramPart>>(x.t);
+  return BeginSubprogram(name, subpPart);
+}
+void SubprogramVisitor::Post(const parser::SubroutineSubprogram &) {
+  EndSubprogram();
 }
 
-bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
-  funcResultName_ = &suffix.resultName.value();
-  return true;
+bool SubprogramVisitor::Pre(const parser::FunctionSubprogram &x) {
+  const auto &name = std::get<parser::Name>(
+      std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t);
+  const auto &subpPart =
+      std::get<std::optional<parser::InternalSubprogramPart>>(x.t);
+  return BeginSubprogram(name, subpPart);
+}
+void SubprogramVisitor::Post(const parser::FunctionSubprogram &) {
+  EndSubprogram();
 }
 
-bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
-  BeginAttrs();
-  return true;
+bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
+  const auto &name = std::get<parser::Name>(
+      std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t);
+  return BeginSubprogram(name, std::nullopt);
+}
+void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &) {
+  EndSubprogram();
 }
+bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
+  const auto &name = std::get<parser::Name>(
+      std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t);
+  return BeginSubprogram(name, std::nullopt);
+}
+void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) {
+  EndSubprogram();
+}
+
 bool SubprogramVisitor::Pre(const parser::FunctionStmt &stmt) {
-  BeginAttrs();
-  BeginDeclTypeSpec();
-  CHECK(!funcResultName_);
+  if (!subpNamesOnly_) {
+    BeginDeclTypeSpec();
+    CHECK(!funcResultName_);
+  }
   return true;
 }
 
 void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
-  const auto &subrName = std::get<parser::Name>(stmt.t);
-  auto &symbol = PushSubprogramScope(subrName);
+  const auto &name = std::get<parser::Name>(stmt.t);
+  Symbol &symbol{*CurrScope().symbol()};
+  CHECK(name.source == symbol.name());
   auto &details = symbol.details<SubprogramDetails>();
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     const parser::Name *dummyName = std::get_if<parser::Name>(&dummyArg.u);
@@ -1124,8 +1301,9 @@ void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
 }
 
 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
-  const auto &funcName = std::get<parser::Name>(stmt.t);
-  auto &symbol = PushSubprogramScope(funcName);
+  const auto &name = std::get<parser::Name>(stmt.t);
+  Symbol &symbol{*CurrScope().symbol()};
+  CHECK(name.source == symbol.name());
   auto &details = symbol.details<SubprogramDetails>();
   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
     Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))};
@@ -1139,21 +1317,50 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   EndDeclTypeSpec();
 
   const parser::Name *funcResultName;
-  if (funcResultName_ && funcResultName_->source != funcName.source) {
+  if (funcResultName_ && funcResultName_->source != name.source) {
     funcResultName = funcResultName_;
     funcResultName_ = nullptr;
   } else {
-    CurrScope().erase(funcName.source);  // was added by PushSubprogramScope
-    funcResultName = &funcName;
+    CurrScope().erase(name.source);  // was added by PushSubprogramScope
+    funcResultName = &name;
   }
   details.set_result(MakeSymbol(*funcResultName, funcResultDetails));
 }
 
+bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
+    const std::optional<parser::InternalSubprogramPart> &subpPart) {
+  if (subpNamesOnly_) {
+    MakeSymbol(name, SubprogramNameDetails{*subpNamesOnly_});
+    return false;
+  }
+  PushSubprogramScope(name);
+  if (subpPart) {
+    subpNamesOnly_ = SubprogramKind::Internal;
+    parser::Walk(*subpPart, *static_cast<ResolveNamesVisitor *>(this));
+    subpNamesOnly_ = std::nullopt;
+  }
+  return true;
+}
+void SubprogramVisitor::EndSubprogram() {
+  if (!subpNamesOnly_) {
+    PopScope();
+  }
+}
+
 Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name) {
-  auto &symbol = MakeSymbol(name, EndAttrs(), SubprogramDetails());
+  auto &symbol = MakeSymbol(name, SubprogramDetails());
+  auto &details = symbol.details<SubprogramDetails>();
+  if (inInterfaceBlock()) {
+    details.set_isInterface();
+    if (!isAbstract()) {
+      symbol.attrs().set(Attr::EXTERNAL);
+    }
+    if (isGeneric()) {
+      AddToGeneric(name);
+    }
+  }
   Scope &subpScope = CurrScope().MakeScope(Scope::Kind::Subprogram, &symbol);
   PushScope(subpScope);
-  auto &details = symbol.details<SubprogramDetails>();
   // can't reuse this name inside subprogram:
   MakeSymbol(name, SubprogramDetails(details));
   return symbol;
@@ -1266,6 +1473,18 @@ void ResolveNamesVisitor::DeclareEntity(const parser::Name &name, Attrs attrs) {
     Say(name.source,
         "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
         name.source, details->module().name());
+  } else if (auto *details = symbol.detailsIf<SubprogramNameDetails>()) {
+    if (details->kind() == SubprogramKind::Module) {
+      Say(name,
+          "Declaration of '%s' conflicts with its use as module procedure"_err_en_US)
+          .Attach(symbol.name(), "Module procedure definition"_en_US);
+    } else if (details->kind() == SubprogramKind::Internal) {
+      Say(name,
+          "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US)
+          .Attach(symbol.name(), "Internal procedure definition"_en_US);
+    } else {
+      CHECK(!"unexpected kind");
+    }
   } else {
     Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
         .Attach(symbol.name(),
@@ -1434,6 +1653,86 @@ void ResolveNames(
   RewriteParseTree(program);
 }
 
+// Map the enum in the parser to the one in GenericSpec
+static GenericSpec::Kind MapIntrinsicOperator(
+    parser::DefinedOperator::IntrinsicOperator x) {
+  switch (x) {
+  case parser::DefinedOperator::IntrinsicOperator::Add:
+    return GenericSpec::OP_ADD;
+  case parser::DefinedOperator::IntrinsicOperator::AND:
+    return GenericSpec::OP_AND;
+  case parser::DefinedOperator::IntrinsicOperator::Concat:
+    return GenericSpec::OP_CONCAT;
+  case parser::DefinedOperator::IntrinsicOperator::Divide:
+    return GenericSpec::OP_DIVIDE;
+  case parser::DefinedOperator::IntrinsicOperator::EQ:
+    return GenericSpec::OP_EQ;
+  case parser::DefinedOperator::IntrinsicOperator::EQV:
+    return GenericSpec::OP_EQV;
+  case parser::DefinedOperator::IntrinsicOperator::GE:
+    return GenericSpec::OP_GE;
+  case parser::DefinedOperator::IntrinsicOperator::GT:
+    return GenericSpec::OP_GT;
+  case parser::DefinedOperator::IntrinsicOperator::LE:
+    return GenericSpec::OP_LE;
+  case parser::DefinedOperator::IntrinsicOperator::LT:
+    return GenericSpec::OP_LT;
+  case parser::DefinedOperator::IntrinsicOperator::Multiply:
+    return GenericSpec::OP_MULTIPLY;
+  case parser::DefinedOperator::IntrinsicOperator::NE:
+    return GenericSpec::OP_NE;
+  case parser::DefinedOperator::IntrinsicOperator::NEQV:
+    return GenericSpec::OP_NEQV;
+  case parser::DefinedOperator::IntrinsicOperator::NOT:
+    return GenericSpec::OP_NOT;
+  case parser::DefinedOperator::IntrinsicOperator::OR:
+    return GenericSpec::OP_OR;
+  case parser::DefinedOperator::IntrinsicOperator::Power:
+    return GenericSpec::OP_POWER;
+  case parser::DefinedOperator::IntrinsicOperator::Subtract:
+    return GenericSpec::OP_SUBTRACT;
+  default: CRASH_NO_CASE;
+  }
+}
+
+// Map a parser::GenericSpec to a semantics::GenericSpec
+static GenericSpec MapGenericSpec(const parser::GenericSpec &genericSpec) {
+  return std::visit(
+      parser::visitors{
+          [](const parser::Name &x) {
+            return GenericSpec::GenericName(x.source);
+          },
+          [](const parser::DefinedOperator &x) {
+            return std::visit(
+                parser::visitors{
+                    [](const parser::DefinedOpName &name) {
+                      return GenericSpec::DefinedOp(name.v.source);
+                    },
+                    [](const parser::DefinedOperator::IntrinsicOperator &x) {
+                      return GenericSpec::IntrinsicOp(MapIntrinsicOperator(x));
+                    },
+                },
+                x.u);
+          },
+          [](const parser::GenericSpec::Assignment &) {
+            return GenericSpec::IntrinsicOp(GenericSpec::ASSIGNMENT);
+          },
+          [](const parser::GenericSpec::ReadFormatted &) {
+            return GenericSpec::IntrinsicOp(GenericSpec::READ_FORMATTED);
+          },
+          [](const parser::GenericSpec::ReadUnformatted &) {
+            return GenericSpec::IntrinsicOp(GenericSpec::READ_UNFORMATTED);
+          },
+          [](const parser::GenericSpec::WriteFormatted &) {
+            return GenericSpec::IntrinsicOp(GenericSpec::WRITE_FORMATTED);
+          },
+          [](const parser::GenericSpec::WriteUnformatted &) {
+            return GenericSpec::IntrinsicOp(GenericSpec::WRITE_UNFORMATTED);
+          },
+      },
+      genericSpec.u);
+}
+
 static void PutIndent(std::ostream &os, int indent) {
   for (int i = 0; i < indent; ++i) {
     os << "  ";

diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc
index 1c1564b56750034cce742e7e9caf6574e0188a39..c7665885dade2347b0faa733d91c06b2cb4c8b95 100644 (file)
--- a/flang/lib/semantics/scope.cc
+++ b/flang/lib/semantics/scope.cc
@@ -22,7 +22,7 @@ const Scope Scope::systemScope{
     Scope::systemScope, Scope::Kind::System, nullptr};
 Scope Scope::globalScope{Scope::systemScope, Scope::Kind::Global, nullptr};
 
-Scope &Scope::MakeScope(Kind kind, const Symbol *symbol) {
+Scope &Scope::MakeScope(Kind kind, Symbol *symbol) {
   children_.emplace_back(*this, kind, symbol);
   return children_.back();
 }

diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h
index 7dcfe9a9ea982ff7d8372a3c49640f62d8f80fd2..bb62933c7be7dc4b066a6f0819f4ac8fff8a65f6 100644 (file)
--- a/flang/lib/semantics/scope.h
+++ b/flang/lib/semantics/scope.h
@@ -35,7 +35,7 @@ public:
 
   ENUM_CLASS(Kind, System, Global, Module, MainProgram, Subprogram)
 
-  Scope(const Scope &parent, Kind kind, const Symbol *symbol)
+  Scope(const Scope &parent, Kind kind, Symbol *symbol)
     : parent_{parent}, kind_{kind}, symbol_{symbol} {}
 
   const Scope &parent() const {
@@ -43,6 +43,7 @@ public:
     return parent_;
   }
   Kind kind() const { return kind_; }
+  Symbol *symbol() { return symbol_; }
   const Symbol *symbol() const { return symbol_; }
 
   const SourceName &name() const {
@@ -51,7 +52,7 @@ public:
   }
 
   /// Make a scope nested in this one
-  Scope &MakeScope(Kind kind, const Symbol *symbol = nullptr);
+  Scope &MakeScope(Kind kind, Symbol *symbol = nullptr);
 
   using size_type = mapType::size_type;
   using iterator = mapType::iterator;
@@ -94,7 +95,7 @@ public:
 private:
   const Scope &parent_;
   const Kind kind_;
-  const Symbol *const symbol_;
+  Symbol *const symbol_;
   std::list<Scope> children_;
   mapType symbols_;
 

diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc
index 7c280748959576bdc7099d52702a60c90ff90b3d..eea2f020b302c0f655c354998b6cc0181cfc445f 100644 (file)
--- a/flang/lib/semantics/symbol.cc
+++ b/flang/lib/semantics/symbol.cc
@@ -52,9 +52,11 @@ static std::string DetailsToString(const Details &details) {
           [&](const MainProgramDetails &) { return "MainProgram"; },
           [&](const ModuleDetails &) { return "Module"; },
           [&](const SubprogramDetails &) { return "Subprogram"; },
+          [&](const SubprogramNameDetails &) { return "SubprogramName"; },
           [&](const EntityDetails &) { return "Entity"; },
           [&](const UseDetails &) { return "Use"; },
           [&](const UseErrorDetails &) { return "UseError"; },
+          [&](const GenericDetails &) { return "Generic"; },
       },
       details);
 }
@@ -63,6 +65,25 @@ const std::string Symbol::GetDetailsName() const {
   return DetailsToString(details_);
 }
 
+void Symbol::set_details(Details &&details) {
+  CHECK(CanReplaceDetails(details));
+  details_.swap(details);
+}
+
+bool Symbol::CanReplaceDetails(const Details &details) const {
+  if (has<UnknownDetails>()) {
+    return true;  // can always replace UnknownDetails
+  } else if (has<UseDetails>() &&
+      std::holds_alternative<UseErrorDetails>(details)) {
+    return true;  // can replace UseDetails with UseErrorDetails
+  } else if (has<SubprogramNameDetails>() &&
+      std::holds_alternative<SubprogramDetails>(details)) {
+    return true;  // can replace SubprogramNameDetails with SubprogramDetails
+  } else {
+    return false;
+  }
+}
+
 const Symbol &Symbol::GetUltimate() const {
   if (const auto *details = detailsIf<UseDetails>()) {
     return details->symbol().GetUltimate();
@@ -71,6 +92,18 @@ const Symbol &Symbol::GetUltimate() const {
   }
 }
 
+bool Symbol::isSubprogram() const {
+  return std::visit(
+      parser::visitors{
+          [&](const SubprogramDetails &) { return true; },
+          [&](const SubprogramNameDetails &) { return true; },
+          [&](const GenericDetails &) { return true; },
+          [&](const UseDetails &x) { return x.symbol().isSubprogram(); },
+          [&](const auto &) { return false; },
+      },
+      details_);
+}
+
 std::ostream &operator<<(std::ostream &os, const EntityDetails &x) {
   if (x.type()) {
     os << " type: " << *x.type();
@@ -114,6 +147,12 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
               DumpType(os, x.result());
               os << x.result().name() << ')';
             }
+            if (x.isInterface()) {
+              os << " interface";
+            }
+          },
+          [&](const SubprogramNameDetails &x) {
+            os << ' ' << EnumToString(x.kind());
           },
           [&](const EntityDetails &x) { os << x; },
           [&](const UseDetails &x) {
@@ -125,6 +164,11 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
               os << " from " << pair.second->name() << " at " << *pair.first;
             }
           },
+          [&](const GenericDetails &x) {
+            for (const auto *proc : x.specificProcs()) {
+              os << ' ' << proc->name();
+            }
+          },
       },
       details);
   return os;

diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h
index 574cacf1b1136f6376c4e5ff865f1802051ca345..caa5285adbeb87c1e37982aa74371b27623983fd 100644 (file)
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -21,10 +21,6 @@
 
 namespace Fortran::semantics {
 
-/// A SourceName is a name in the cooked character stream,
-/// i.e. a range of lower-case characters with provenance.
-using SourceName = parser::CharBlock;
-
 /// A Symbol consists of common information (name, owner, and attributes)
 /// and details information specific to the kind of symbol, represented by the
 /// *Details classes.
@@ -56,6 +52,8 @@ public:
     : dummyArgs_{that.dummyArgs_}, result_{that.result_} {}
 
   bool isFunction() const { return result_.has_value(); }
+  bool isInterface() const { return isInterface_; }
+  void set_isInterface(bool value = true) { isInterface_ = value; }
   const Symbol &result() const {
     CHECK(isFunction());
     return **result_;
@@ -70,9 +68,27 @@ public:
 private:
   std::list<Symbol *> dummyArgs_;
   std::optional<Symbol *> result_;
+  bool isInterface_{false};  // true if this represents an interface-body
   friend std::ostream &operator<<(std::ostream &, const SubprogramDetails &);
 };
 
+// For SubprogramNameDetails, the kind indicates whether it is the name
+// of a module subprogram or internal subprogram.
+ENUM_CLASS(SubprogramKind, Module, Internal)
+
+// Symbol with SubprogramNameDetails is created when we scan for module and
+// internal procedure names, to record that there is a subprogram with this
+// name. Later they are replaced by SubprogramDetails with dummy and result
+// type information.
+class SubprogramNameDetails {
+public:
+  SubprogramNameDetails(SubprogramKind kind) : kind_{kind} {}
+  SubprogramNameDetails() = delete;
+  SubprogramKind kind() const { return kind_; }
+private:
+  SubprogramKind kind_;
+};
+
 class EntityDetails {
 public:
   EntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
@@ -126,10 +142,25 @@ private:
   listType occurrences_;
 };
 
+class GenericDetails {
+public:
+  using listType = std::list<const Symbol *>;
+
+  const listType specificProcs() const { return specificProcs_; }
+
+  void add_specificProc(const Symbol *proc) {
+    specificProcs_.push_back(proc);
+  }
+
+private:
+  listType specificProcs_;
+};
+
 class UnknownDetails {};
 
 using Details = std::variant<UnknownDetails, MainProgramDetails, ModuleDetails,
-    SubprogramDetails, EntityDetails, UseDetails, UseErrorDetails>;
+      SubprogramDetails, SubprogramNameDetails, EntityDetails, UseDetails,
+      UseErrorDetails, GenericDetails>;
 std::ostream &operator<<(std::ostream &, const Details &);
 
 class Symbol {
@@ -170,17 +201,10 @@ public:
 
   // Assign the details of the symbol from one of the variants.
   // Only allowed in certain cases.
-  void set_details(Details &&details) {
-    if (has<UnknownDetails>()) {
-      // can always replace UnknownDetails
-    } else if (has<UseDetails>() &&
-        std::holds_alternative<UseErrorDetails>(details)) {
-      // can replace UseDetails with UseErrorDetails
-    } else {
-      CHECK(!"can't replace details");
-    }
-    details_.swap(details);
-  }
+  void set_details(Details &&details);
+
+  // Can the details of this symbol be replaced with the given details?
+  bool CanReplaceDetails(const Details &details) const;
 
   const std::list<SourceName> &occurrences() const { return occurrences_; }
   void add_occurrence(const SourceName &name) { occurrences_.push_back(name); }
@@ -188,6 +212,8 @@ public:
   // Follow use-associations to get the ultimate entity.
   const Symbol &GetUltimate() const;
 
+  bool isSubprogram() const;
+
   bool operator==(const Symbol &that) const { return this == &that; }
   bool operator!=(const Symbol &that) const { return this != &that; }
 

diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc
index df0a4c9c66580e959f52d9933cdb465e9a144f5e..e39e6b5739eb0955fc40deda2660e016257c56a2 100644 (file)
--- a/flang/lib/semantics/type.cc
+++ b/flang/lib/semantics/type.cc
@@ -277,6 +277,37 @@ std::ostream &operator<<(std::ostream &o, const ProcComponentDef &x) {
   return o;
 }
 
+std::ostream &operator<<(std::ostream &o, const GenericSpec &x) {
+  switch (x.kind()) {
+  case GenericSpec::GENERIC_NAME: return o << x.genericName().ToString();
+  case GenericSpec::OP_DEFINED:
+    return o << '(' << x.definedOp().ToString() << ')';
+  case GenericSpec::ASSIGNMENT: return o << "ASSIGNMENT(=)";
+  case GenericSpec::READ_FORMATTED: return o << "READ(FORMATTED)";
+  case GenericSpec::READ_UNFORMATTED: return o << "READ(UNFORMATTED)";
+  case GenericSpec::WRITE_FORMATTED: return o << "WRITE(FORMATTED)";
+  case GenericSpec::WRITE_UNFORMATTED: return o << "WRITE(UNFORMATTED)";
+  case GenericSpec::OP_ADD: return o << "OPERATOR(+)";
+  case GenericSpec::OP_CONCAT: return o << "OPERATOR(//)";
+  case GenericSpec::OP_DIVIDE: return o << "OPERATOR(/)";
+  case GenericSpec::OP_MULTIPLY: return o << "OPERATOR(*)";
+  case GenericSpec::OP_POWER: return o << "OPERATOR(**)";
+  case GenericSpec::OP_SUBTRACT: return o << "OPERATOR(-)";
+  case GenericSpec::OP_AND: return o << "OPERATOR(.AND.)";
+  case GenericSpec::OP_EQ: return o << "OPERATOR(.EQ.)";
+  case GenericSpec::OP_EQV: return o << "OPERATOR(.EQV.)";
+  case GenericSpec::OP_GE: return o << "OPERATOR(.GE.)";
+  case GenericSpec::OP_GT: return o << "OPERATOR(.GT.)";
+  case GenericSpec::OP_LE: return o << "OPERATOR(.LE.)";
+  case GenericSpec::OP_LT: return o << "OPERATOR(.LT.)";
+  case GenericSpec::OP_NE: return o << "OPERATOR(.NE.)";
+  case GenericSpec::OP_NEQV: return o << "OPERATOR(.NEQV.)";
+  case GenericSpec::OP_NOT: return o << "OPERATOR(.NOT.)";
+  case GenericSpec::OP_OR: return o << "OPERATOR(.OR.)";
+  default: CRASH_NO_CASE;
+  }
+}
+
 DerivedTypeDef::DerivedTypeDef(const DerivedTypeDef::Data &data)
   : data_{data} {}
 

diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h
index 6f09b03bee8a2f4d40f987c403e2501c38c94220..93782f90c9aafb66e2f7d6fe7a2189d5b47cbfd9 100644 (file)
--- a/flang/lib/semantics/type.h
+++ b/flang/lib/semantics/type.h
@@ -53,6 +53,10 @@ namespace Fortran::semantics {
 
 using Name = std::string;
 
+/// A SourceName is a name in the cooked character stream,
+/// i.e. a range of lower-case characters with provenance.
+using SourceName = parser::CharBlock;
+
 // TODO
 class IntExpr {
 public:
@@ -410,6 +414,62 @@ private:
   friend std::ostream &operator<<(std::ostream &, const ProcComponentDef &);
 };
 
+class GenericSpec {
+public:
+  enum Kind {
+    GENERIC_NAME,
+    OP_DEFINED,
+    ASSIGNMENT,
+    READ_FORMATTED,
+    READ_UNFORMATTED,
+    WRITE_FORMATTED,
+    WRITE_UNFORMATTED,
+    OP_ADD,
+    OP_AND,
+    OP_CONCAT,
+    OP_DIVIDE,
+    OP_EQ,
+    OP_EQV,
+    OP_GE,
+    OP_GT,
+    OP_LE,
+    OP_LT,
+    OP_MULTIPLY,
+    OP_NE,
+    OP_NEQV,
+    OP_NOT,
+    OP_OR,
+    OP_POWER,
+    OP_SUBTRACT,
+  };
+  static GenericSpec IntrinsicOp(Kind kind) {
+    return GenericSpec(kind, nullptr);
+  }
+  static GenericSpec DefinedOp(const SourceName &name) {
+    return GenericSpec(OP_DEFINED, &name);
+  }
+  static GenericSpec GenericName(const SourceName &name) {
+    return GenericSpec(GENERIC_NAME, &name);
+  }
+
+  const Kind kind() const { return kind_; }
+  const SourceName &genericName() const {
+    CHECK(kind_ == GENERIC_NAME);
+    return *name_;
+  }
+  const SourceName &definedOp() const {
+    CHECK(kind_ == OP_DEFINED);
+    return *name_;
+  }
+
+private:
+  GenericSpec(Kind kind, const SourceName *name)
+    : kind_{kind}, name_{name} {}
+  const Kind kind_;
+  const SourceName *const name_;  // only for GENERIC_NAME & OP_DEFINED
+  friend std::ostream &operator<<(std::ostream &, const GenericSpec &);
+};
+
 class DerivedTypeDefBuilder;
 
 // Definition of a derived type

diff --git a/flang/test/semantics/resolve02.f90 b/flang/test/semantics/resolve02.f90
index 741f10e1f5353d16aa1897e5b8d368f3fbe2696e..c0ebfed448ce5653e58482f979994d24717d259c 100644 (file)
--- a/flang/test/semantics/resolve02.f90
+++ b/flang/test/semantics/resolve02.f90
@@ -13,9 +13,17 @@
 ! limitations under the License.
 
 subroutine s
+  !ERROR: Declaration of 'x' conflicts with its use as internal procedure
+  real :: x
+contains
+  subroutine x
+  end
+end
+
+module m
+  !ERROR: Declaration of 'x' conflicts with its use as module procedure
   real :: x
 contains
-  !ERROR: 'x' is already declared in this scoping unit
   subroutine x
   end
 end

diff --git a/flang/test/semantics/resolve15.f90 b/flang/test/semantics/resolve15.f90
new file mode 100644 (file)
index 0000000..a56758e
--- /dev/null
+++ b/flang/test/semantics/resolve15.f90
@@ -0,0 +1,20 @@
+module m
+  real :: var
+  interface i
+    !ERROR: 'var' is not a subprogram
+    !ERROR: Procedure 'bad' not found
+    procedure :: sub, var, bad
+  end interface
+contains
+  subroutine sub
+  end
+end
+
+subroutine s
+  interface i
+    module procedure :: sub
+  end interface
+contains
+  subroutine sub
+  end
+end

diff --git a/flang/test/semantics/resolve16.f90 b/flang/test/semantics/resolve16.f90
new file mode 100644 (file)
index 0000000..798b88b
--- /dev/null
+++ b/flang/test/semantics/resolve16.f90
@@ -0,0 +1,13 @@
+module m
+  interface
+    subroutine sub0
+    end
+    !ERROR: A PROCEDURE statement is only allowed in a generic interface block
+    procedure :: sub1, sub2
+  end interface
+contains
+  subroutine sub1
+  end
+  subroutine sub2
+  end
+end