[flang] Fix CHECK() calls on erroneous procedure declarations

When writing tests for a previous problem, I ran across situations where the
compiler was failing calls to CHECK().  In these situations, the compiler had
inconsistent semantic information because the programs were erroneous.  This
inconsistent information was causing the calls to CHECK().

I fixed this by avoiding the code that ended up making the failed calls to
CHECK() and making sure that we were only avoiding these situations when the
associated symbols were erroneous.

I also added tests that would cause the calls to CHECK() without these changes.

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

Author: psteinfeld

flang/lib/Semantics/resolve-names.cpp

@@ -681,7 +681,9 @@ class InterfaceVisitor : public virtual ScopeHandler {
   bool isAbstract() const;
 
 protected:
-  GenericDetails &GetGenericDetails();
+  Symbol &GetGenericSymbol() {
+    return DEREF(genericInfo_.top().symbol);
+  }
   // Add to generic the symbol for the subprogram with the same name
   void CheckGenericProcedures(Symbol &);
 
@@ -2681,9 +2683,6 @@ bool InterfaceVisitor::isGeneric() const {
 bool InterfaceVisitor::isAbstract() const {
   return !genericInfo_.empty() && GetGenericInfo().isAbstract;
 }
-GenericDetails &InterfaceVisitor::GetGenericDetails() {
-  return GetGenericInfo().symbol->get<GenericDetails>();
-}
 
 void InterfaceVisitor::AddSpecificProcs(
     const std::list<parser::Name> &names, ProcedureKind kind) {
@@ -2885,7 +2884,9 @@ void SubprogramVisitor::Post(const parser::ImplicitPart &) {
   if (funcInfo_.parsedType) {
     messageHandler().set_currStmtSource(funcInfo_.source);
     if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) {
-      funcInfo_.resultSymbol->SetType(*type);
+      if (!context().HasError(funcInfo_.resultSymbol)) {
+        funcInfo_.resultSymbol->SetType(*type);
+      }
     }
   }
   funcInfo_ = {};
@@ -2945,11 +2946,16 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
     funcResultName = &name;
   }
   // add function result to function scope
-  EntityDetails funcResultDetails;
-  funcResultDetails.set_funcResult(true);
-  funcInfo_.resultSymbol =
-      &MakeSymbol(*funcResultName, std::move(funcResultDetails));
-  details.set_result(*funcInfo_.resultSymbol);
+  if (details.isFunction()) {
+    CHECK(context().HasError(currScope().symbol()));
+  } else {
+    // add function result to function scope
+    EntityDetails funcResultDetails;
+    funcResultDetails.set_funcResult(true);
+    funcInfo_.resultSymbol =
+        &MakeSymbol(*funcResultName, std::move(funcResultDetails));
+    details.set_result(*funcInfo_.resultSymbol);
+  }
 
   // C1560.
   if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) {
@@ -3223,7 +3229,13 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
       MakeExternal(*symbol);
     }
     if (isGeneric()) {
-      GetGenericDetails().AddSpecificProc(*symbol, name.source);
+      Symbol &genericSymbol{GetGenericSymbol()};
+      if (genericSymbol.has<GenericDetails>()) {
+        genericSymbol.get<GenericDetails>().AddSpecificProc(
+            *symbol, name.source);
+      } else {
+        CHECK(context().HasError(genericSymbol));
+      }
     }
     set_inheritFromParent(false);
   }

flang/test/Semantics/resolve18.f90

@@ -121,3 +121,64 @@ subroutine f8()
     end subroutine f8
   end interface g8
 end module m8
+
+module m9
+  type f9
+  end type f9
+  !ERROR: 'f9' is already declared in this scoping unit
+  interface f9
+    real function f9()
+    end function f9
+  end interface f9
+contains
+  function f9(x)
+  end function f9
+end module m9
+
+module m10
+  type :: t10
+  end type t10
+  interface f10
+    function f10()
+    end function f10
+  end interface f10
+contains
+  !ERROR: 'f10' is already declared in this scoping unit
+  function f10(x)
+  end function f10
+end module m10
+
+module m11
+  type :: t11
+  end type t11
+  interface i11
+    function f11()
+    end function f11
+  end interface i11
+contains
+  !ERROR: 'f11' is already declared in this scoping unit
+  function f11(x)
+  end function f11
+end module m11
+
+module m12
+  interface f12
+    function f12()
+    end function f12
+  end interface f12
+contains
+  !ERROR: 'f12' is already declared in this scoping unit
+  function f12(x)
+  end function f12
+end module m12
+
+module m13
+  interface f13
+    function f13()
+    end function f13
+  end interface f13
+contains
+  !ERROR: 'f13' is already declared in this scoping unit
+  function f13()
+  end function f13
+end module m13