[flang-commits] [flang] e97d92f - [flang] Disallow erroneous procedure declarations

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-03-22T14:52:45-07:00
New Revision: e97d92f0bb998e7d93b4e91d550ba0492d9c414b

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

LOG: [flang] Disallow erroneous procedure declarations

When writing tests for a previous problem, I ran across situations where we
were not producing error messages for declarations of specific procedures of
generic interfaces where every other compiler I tested (except nvfotran) did.
I added a check to CheckExtantExternal() and renamed it since it now checks for
erroneous extant symbols generally.

I also removed a call to this function from processing for ENTRY statements,
since it seemed unnecessary and its presence caused bogus error messages.

I also added some tests for erroneous declarations where we were not producing
error messages.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve18.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f69e7702559f..2d1d513c427e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -745,7 +745,7 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
   } funcInfo_;
 
   // Create a subprogram symbol in the current scope and push a new scope.
-  void CheckExtantExternal(const parser::Name &, Symbol::Flag);
+  void CheckExtantProc(const parser::Name &, Symbol::Flag);
   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
   Symbol *GetSpecificFromGeneric(const parser::Name &);
   SubprogramDetails &PostSubprogramStmt(const parser::Name &);
@@ -3084,7 +3084,6 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
 
   Symbol::Flag subpFlag{
       inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
-  CheckExtantExternal(name, subpFlag);
   Scope &outer{inclusiveScope.parent()}; // global or module scope
   if (Symbol * extant{FindSymbol(outer, name)}) {
     if (extant->has<ProcEntityDetails>()) {
@@ -3176,7 +3175,7 @@ bool SubprogramVisitor::BeginSubprogram(
 
 void SubprogramVisitor::EndSubprogram() { PopScope(); }
 
-void SubprogramVisitor::CheckExtantExternal(
+void SubprogramVisitor::CheckExtantProc(
     const parser::Name &name, Symbol::Flag subpFlag) {
   if (auto *prev{FindSymbol(name)}) {
     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
@@ -3189,6 +3188,11 @@ void SubprogramVisitor::CheckExtantExternal(
             *prev, "Previous call of '%s'"_en_US);
       }
       EraseSymbol(name);
+    } else if (const auto *details{prev->detailsIf<EntityDetails>()}) {
+      if (!details->isDummy()) {
+        Say2(name, "Procedure '%s' was previously declared"_err_en_US, *prev,
+            "Previous declaration of '%s'"_en_US);
+      }
     }
   }
 }
@@ -3197,7 +3201,7 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
     const parser::Name &name, Symbol::Flag subpFlag) {
   auto *symbol{GetSpecificFromGeneric(name)};
   if (!symbol) {
-    CheckExtantExternal(name, subpFlag);
+    CheckExtantProc(name, subpFlag);
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
   symbol->set(subpFlag);

diff  --git a/flang/test/Semantics/resolve18.f90 b/flang/test/Semantics/resolve18.f90
index dd9214533b26..204f6e7b383d 100644
--- a/flang/test/Semantics/resolve18.f90
+++ b/flang/test/Semantics/resolve18.f90
@@ -94,3 +94,30 @@ subroutine s5
   use m5b
   type(g) :: y
 end
+
+module m6
+  real :: f6
+  interface g6
+  !ERROR: Procedure 'f6' was previously declared
+    real function f6()
+    end function f6
+  end interface g6
+end module m6
+
+module m7
+  integer :: f7
+  interface g7
+    !ERROR: Procedure 'f7' was previously declared
+    real function f7()
+    end function f7
+  end interface g7
+end module m7
+
+module m8
+  real :: f8
+  interface g8
+    !ERROR: Procedure 'f8' was previously declared
+    subroutine f8()
+    end subroutine f8
+  end interface g8
+end module m8