[flang-commits] [flang] 882fa24 - [flang] Better error messages & more cases caught for bad forward refs

peter klausler via flang-commits flang-commits at lists.llvm.org
Fri Oct 30 17:11:56 PDT 2020


Author: peter klausler
Date: 2020-10-30T17:11:37-07:00
New Revision: 882fa241f1d242e7c3e4efcde0839fa2c01c1ddc

URL: https://github.com/llvm/llvm-project/commit/882fa241f1d242e7c3e4efcde0839fa2c01c1ddc
DIFF: https://github.com/llvm/llvm-project/commit/882fa241f1d242e7c3e4efcde0839fa2c01c1ddc.diff

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

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.

Differential revision: https://reviews.llvm.org/D90492

Added: 
    flang/test/Semantics/resolve97.f90

Modified: 
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 6462d7885d20..5f17aabac754 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -578,7 +578,9 @@ class ScopeHandler : public ImplicitRulesVisitor {
       symbol->attrs() |= attrs;
       return *symbol;
     } else {
-      SayAlreadyDeclared(name, *symbol);
+      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))};
@@ -600,8 +602,13 @@ class ScopeHandler : public ImplicitRulesVisitor {
       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};
@@ -982,7 +989,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
         SayWithDecl(
             name, symbol, "'%s' is already declared as an object"_err_en_US);
       }
-    } else {
+    } else if (!CheckPossibleBadForwardRef(symbol)) {
       SayAlreadyDeclared(name, symbol);
     }
     context().SetError(symbol);
@@ -1880,15 +1887,17 @@ void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &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>()}) {
-    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());
+    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);
   }
-  context().SetError(prev);
 }
 void ScopeHandler::SayAlreadyDeclared(
     const SourceName &name1, const SourceName &name2) {
@@ -2194,6 +2203,44 @@ const DeclTypeSpec &ScopeHandler::MakeLogicalType(
   }
 }
 
+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);
@@ -4686,6 +4733,8 @@ void DeclarationVisitor::SetType(
     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);
@@ -5466,12 +5515,14 @@ const parser::Name *DeclarationVisitor::ResolveDataRef(
 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);
@@ -5496,6 +5547,7 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
   }
   ConvertToObjectEntity(*symbol);
   ApplyImplicitRules(*symbol);
+  NotePossibleBadForwardRef(name);
   return &name;
 }
 
@@ -5518,7 +5570,8 @@ bool DeclarationVisitor::CheckForHostAssociatedImplicit(
   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);
@@ -5989,12 +6042,15 @@ static bool NeedsExplicitType(const Symbol &symbol) {
 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)}) {
@@ -6096,6 +6152,9 @@ void ResolveNamesVisitor::FinishSpecificationPart(
       symbol.set(
           symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
     }
+    if (!symbol.has<HostAssocDetails>()) {
+      CheckPossibleBadForwardRef(symbol);
+    }
   }
   currScope().InstantiateDerivedTypes(context());
   for (const auto &decl : decls) {

diff  --git a/flang/test/Semantics/resolve97.f90 b/flang/test/Semantics/resolve97.f90
new file mode 100644
index 000000000000..67adff2af292
--- /dev/null
+++ b/flang/test/Semantics/resolve97.f90
@@ -0,0 +1,94 @@
+! 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


        


More information about the flang-commits mailing list