[flang] Better error messages & more cases caught for bad forward refs

[klausler]

Summary

Subclause 10.1.12 in F'2018 prohibits forward references from
a specification expression to an object declared later in the
same specification part. Catch this error better and emit
specific error messages about the violation.

flang/lib/Semantics/resolve-names.cpp

if (symbol->CanReplaceDetails(details)) {
       // update the existing symbol
       symbol->attrs() |= attrs;
       symbol->set_details(std::move(details));
       return *symbol;
     } else if constexpr (std::is_same_v<UnknownDetails, D>) {
       symbol->attrs() |= attrs;
       return *symbol;
     } else {
+      if (!CheckPossibleBadForwardRef(*symbol)) {
         SayAlreadyDeclared(name, *symbol);
+      }
       // replace the old symbol with a new one with correct details
       EraseSymbol(*symbol);
       auto &result{MakeSymbol(name, attrs, std::move(details))};
       context().SetError(result);
       return result;
     }
   }
 
   void MakeExternal(Symbol &);
 
 protected:
   // Apply the implicit type rules to this symbol.
   void ApplyImplicitRules(Symbol &);
   const DeclTypeSpec *GetImplicitType(Symbol &);
   bool ConvertToObjectEntity(Symbol &);
   bool ConvertToProcEntity(Symbol &);
 
   const DeclTypeSpec &MakeNumericType(
       TypeCategory, const std::optional<parser::KindSelector> &);
   const DeclTypeSpec &MakeLogicalType(
       const std::optional<parser::KindSelector> &);
+  void NotePossibleBadForwardRef(const parser::Name &);
+  std::optional<SourceName> HadForwardRef(const Symbol &) const;
+  bool CheckPossibleBadForwardRef(const Symbol &);
 
   bool inExecutionPart_{false};
+  bool inSpecificationPart_{false};
+  std::set<SourceName> specPartForwardRefs_;
 
 private:
   Scope *currScope_{nullptr};
 };
 
 class ModuleVisitor : public virtual ScopeHandler {
 public:
   bool Pre(const parser::AccessStmt &);
if (context().HasError(symbol) || symbol.has<T>()) {
         symbol.has<ObjectEntityDetails>()) {
       if (InCommonBlock(symbol)) {
         SayWithDecl(name, symbol,
             "'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
       } else {
         SayWithDecl(
             name, symbol, "'%s' is already declared as an object"_err_en_US);
       }
-    } else {
+    } else if (!CheckPossibleBadForwardRef(symbol)) {
       SayAlreadyDeclared(name, symbol);
     }
     context().SetError(symbol);
     return symbol;
   }
 };
 
 // Resolve construct entities and statement entities.

 // ScopeHandler implementation
 
 void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
   SayAlreadyDeclared(name.source, prev);
 }
 void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
   if (context().HasError(prev)) {
     // don't report another error about prev
-  } else if (const auto *details{prev.detailsIf<UseDetails>()}) {
+  } else {
+    if (const auto *details{prev.detailsIf<UseDetails>()}) {
       Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
           .Attach(details->location(),
               "It is use-associated with '%s' in module '%s'"_err_en_US,
               details->symbol().name(), GetUsedModule(*details).name());
     } else {
       SayAlreadyDeclared(name, prev.name());
     }
     context().SetError(prev);
   }
+}
 void ScopeHandler::SayAlreadyDeclared(
     const SourceName &name1, const SourceName &name2) {
   if (name1.begin() < name2.begin()) {
     SayAlreadyDeclared(name2, name1);
   } else {
     Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
         .Attach(name2, "Previous declaration of '%s'"_en_US, name2);
   }
const DeclTypeSpec &ScopeHandler::MakeLogicalType(
   KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
   if (auto known{evaluate::ToInt64(value)}) {
     return context().MakeLogicalType(static_cast<int>(*known));
   } else {
     return currScope_->MakeLogicalType(std::move(value));
   }
 }
 
+void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
+  if (inSpecificationPart_ && name.symbol) {
+    auto kind{currScope().kind()};
+    if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
+        kind == Scope::Kind::Block) {
+      bool isHostAssociated{&name.symbol->owner() == &currScope()
+              ? name.symbol->has<HostAssocDetails>()
+              : name.symbol->owner().Contains(currScope())};
+      if (isHostAssociated) {
+        specPartForwardRefs_.insert(name.source);
+      }
+    }
+  }
+}
+
+std::optional<SourceName> ScopeHandler::HadForwardRef(
+    const Symbol &symbol) const {
+  auto iter{specPartForwardRefs_.find(symbol.name())};
+  if (iter != specPartForwardRefs_.end()) {
+    return *iter;
+  }
+  return std::nullopt;
+}
+
+bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
+  if (!context().HasError(symbol)) {
+    if (auto fwdRef{HadForwardRef(symbol)}) {
+      Say(*fwdRef,
+          "Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
+          *fwdRef)
+          .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
+      context().SetError(symbol);
+      return true;
+    }
+  }
+  return false;
+}
+
 void ScopeHandler::MakeExternal(Symbol &symbol) {
   if (!symbol.attrs().test(Attr::EXTERNAL)) {
     symbol.attrs().set(Attr::EXTERNAL);
     if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
       Say(symbol.name(),
           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
           symbol.name());
     }
if (type.category() == DeclTypeSpec::Character) {
           "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
     }
   }
   auto *prevType{symbol.GetType()};
   if (!prevType) {
     symbol.SetType(type);
   } else if (symbol.has<UseDetails>()) {
     // error recovery case, redeclaration of use-associated name
+  } else if (HadForwardRef(symbol)) {
+    // error recovery after use of host-associated name
   } else if (!symbol.test(Symbol::Flag::Implicit)) {
     SayWithDecl(
         name, symbol, "The type of '%s' has already been declared"_err_en_US);
     context().SetError(symbol);
   } else if (type != *prevType) {
     SayWithDecl(name, symbol,
         "The type of '%s' has already been implicitly declared"_err_en_US);
     context().SetError(symbol);
return std::visit(
       x.u);
 }
 
 // If implicit types are allowed, ensure name is in the symbol table.
 // Otherwise, report an error if it hasn't been declared.
 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
   FindSymbol(name);
   if (CheckForHostAssociatedImplicit(name)) {
+    NotePossibleBadForwardRef(name);
     return &name;
   }
   if (Symbol * symbol{name.symbol}) {
     if (CheckUseError(name)) {
       return nullptr; // reported an error
     }
+    NotePossibleBadForwardRef(name);
     symbol->set(Symbol::Flag::ImplicitOrError, false);
     if (IsUplevelReference(*symbol)) {
       MakeHostAssocSymbol(name, *symbol);
     } else if (IsDummy(*symbol) ||
         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
       ConvertToObjectEntity(*symbol);
       ApplyImplicitRules(*symbol);
     }
     return &name;
   }
   if (isImplicitNoneType()) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
   // Create the symbol then ensure it is accessible
   MakeSymbol(InclusiveScope(), name.source, Attrs{});
   auto *symbol{FindSymbol(name)};
   if (!symbol) {
     Say(name,
         "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
     return nullptr;
   }
   ConvertToObjectEntity(*symbol);
   ApplyImplicitRules(*symbol);
+  NotePossibleBadForwardRef(name);
   return &name;
 }
 
 // A specification expression may refer to a symbol in the host procedure that
 // is implicitly typed. Because specification parts are processed before
 // execution parts, this may be the first time we see the symbol. It can't be a
 // local in the current scope (because it's in a specification expression) so
 // either it is implicitly declared in the host procedure or it is an error.
 // We create a symbol in the host assuming it is the former; if that proves to
 // be wrong we report an error later in CheckDeclarations().
 bool DeclarationVisitor::CheckForHostAssociatedImplicit(
     const parser::Name &name) {
   if (inExecutionPart_) {
     return false;
   }
   if (name.symbol) {
     ApplyImplicitRules(*name.symbol);
   }
   Symbol *hostSymbol;
   Scope *host{GetHostProcedure()};
   if (!host || isImplicitNoneType(*host)) {
     return false;
-  } else if (!name.symbol) {
+  }
+  if (!name.symbol) {
     hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
     ConvertToObjectEntity(*hostSymbol);
     ApplyImplicitRules(*hostSymbol);
     hostSymbol->set(Symbol::Flag::ImplicitOrError);
   } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {
     hostSymbol = name.symbol;
   } else {
     return false;
static bool NeedsExplicitType(const Symbol &symbol) {
   } else {
     return false;
   }
 }
 
 bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
   const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
       implicitPart, decls] = x.t;
+  auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
   Walk(accDecls);
   Walk(ompDecls);
   Walk(compilerDirectives);
   Walk(useStmts);
   Walk(importStmts);
   Walk(implicitPart);
+  auto setRestorer{
+      common::ScopedSet(specPartForwardRefs_, std::set<SourceName>{})};
   for (const auto &decl : decls) {
     if (const auto *spec{
             std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
       PreSpecificationConstruct(*spec);
     }
   }
   Walk(decls);
   FinishSpecificationPart(decls);
for (auto &pair : currScope()) {
     }
     if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
         !symbol.test(Symbol::Flag::Function) &&
         !symbol.test(Symbol::Flag::Subroutine)) {
       // in a module, external proc without return type is subroutine
       symbol.set(
           symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
     }
+    if (!symbol.has<HostAssocDetails>()) {
+      CheckPossibleBadForwardRef(symbol);
+    }
   }
   currScope().InstantiateDerivedTypes(context());
   for (const auto &decl : decls) {
     if (const auto *statement{std::get_if<
             parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(
             &decl.u)}) {
       AnalyzeStmtFunctionStmt(statement->statement.value());
     }

flang/test/Semantics/resolve97.f90

+! RUN: %S/test_errors.sh %s %t %f18
+
+! Check errors from illegal (10.1.12 para 2) forward references
+! in specification expressions to entities declared later in the
+! same specification part.
+
+module m1
+  integer :: m1j1, m1j2, m1j3, m1j4
+ contains
+  subroutine s1
+    !ERROR: Forward reference to 'm1j1' is not allowed in the same specification part
+    integer(kind=kind(m1j1)) :: t_s1m1j1
+    integer(kind=kind(m1s1j1)) :: t_s1j1 ! implicitly typed in s1
+    integer :: m1j1, m1s1j1, m1s1j2, m1s1j4
+    block
+      !ERROR: Forward reference to 'm1j2' is not allowed in the same specification part
+      integer(kind=kind(m1j2)) :: t_s1bm1j2
+      !ERROR: Forward reference to 'm1s1j2' is not allowed in the same specification part
+      integer(kind=kind(m1s1j2)) :: t_s1bm1s1j2
+      !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part
+      integer(kind=kind(m1s1j3)) :: t_m1s1j3 ! m1s1j3 implicitly typed in s1
+      integer :: m1j2, m1s1j2, m1s1j3
+    end block
+   contains
+    subroutine s2
+      !ERROR: Forward reference to 'm1j3' is not allowed in the same specification part
+      integer(kind=kind(m1j3)) :: t_m1j3
+      !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part
+      integer(kind=kind(m1s1j3)) :: t_m1s1j3
+      integer :: m1j3, m1s1j3, m1s2j1
+      block
+        !ERROR: Forward reference to 'm1j4' is not allowed in the same specification part
+        integer(kind=kind(m1j4)) :: t_m1j4
+        !ERROR: Forward reference to 'm1s1j4' is not allowed in the same specification part
+        integer(kind=kind(m1s1j4)) :: t_m1s1j4
+        !ERROR: Forward reference to 'm1s2j1' is not allowed in the same specification part
+        integer(kind=kind(m1s2j1)) :: t_m1s2j1
+        !ERROR: Forward reference to 'm1s2j2' is not allowed in the same specification part
+        integer(kind=kind(m1s2j2)) :: t_m1s2j2 ! m1s2j2 implicitly typed in s2
+        integer :: m1j4, m1s1j4, m1s2j1, m1s2j2
+      end block
+    end subroutine
+  end subroutine
+end module
+
+module m2
+  implicit none
+  integer :: m2j1, m2j2, m2j3, m2j4
+ contains
+  subroutine s1
+    !ERROR: Forward reference to 'm2j1' is not allowed in the same specification part
+    integer(kind=kind(m2j1)) :: t_s1m2j1
+    !ERROR: No explicit type declared for 'm2s1j1'
+    integer(kind=kind(m2s1j1)) :: t_s1j1
+    integer :: m2j1, m2s1j1, m2s1j2, m2s1j4
+    block
+      !ERROR: Forward reference to 'm2j2' is not allowed in the same specification part
+      integer(kind=kind(m2j2)) :: t_s1bm2j2
+      !ERROR: Forward reference to 'm2s1j2' is not allowed in the same specification part
+      integer(kind=kind(m2s1j2)) :: t_s1bm2s1j2
+      !ERROR: No explicit type declared for 'm2s1j3'
+      integer(kind=kind(m2s1j3)) :: t_m2s1j3
+      integer :: m2j2, m2s1j2, m2s1j3
+    end block
+   contains
+    subroutine s2
+      !ERROR: Forward reference to 'm2j3' is not allowed in the same specification part
+      integer(kind=kind(m2j3)) :: t_m2j3
+      !ERROR: No explicit type declared for 'm2s1j3'
+      integer(kind=kind(m2s1j3)) :: t_m2s1j3
+      integer :: m2j3, m2s1j3, m2s2j1
+      block
+        !ERROR: Forward reference to 'm2j4' is not allowed in the same specification part
+        integer(kind=kind(m2j4)) :: t_m2j4
+        !ERROR: Forward reference to 'm2s1j4' is not allowed in the same specification part
+        integer(kind=kind(m2s1j4)) :: t_m2s1j4
+        !ERROR: Forward reference to 'm2s2j1' is not allowed in the same specification part
+        integer(kind=kind(m2s2j1)) :: t_m2s2j1
+        !ERROR: No explicit type declared for 'm2s2j2'
+        integer(kind=kind(m2s2j2)) :: t_m2s2j2
+        integer :: m2j4, m2s1j4, m2s2j1, m2s2j2
+      end block
+    end subroutine
+  end subroutine
+end module
+
+! Case that elicited bad errors
+SUBROUTINE KEEL
+  INTEGER NODES
+ CONTAINS
+  SUBROUTINE SGEOM
+    REAL :: RADIUS(nodes)
+  END SUBROUTINE
+END SUBROUTINE KEEL