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

[PeteSteinfeld]

Summary

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.

[klausler]

flang/include/flang/Semantics/symbol.h

86 ↗

(On Diff #333307)

The f18 naming conventions would prefer something like GetResult.

[PeteSteinfeld]

flang/include/flang/Semantics/symbol.h

86 ↗

(On Diff #333307)

Thanks for catching this. I meant to create an accessor for result_. I'll rename it to result().

[PeteSteinfeld]

flang/include/flang/Semantics/symbol.h

86 ↗

(On Diff #333307)

Oops. There's already an accessor. I'll rename it GetResult as you suggest.

[tskeith]

flang/lib/Semantics/resolve-names.cpp

2949–2958

You can use details.isFunction() here and avoid the need for a new accessor.

[PeteSteinfeld]

Renamed a function based on feedback from Peter.

[PeteSteinfeld]

flang/lib/Semantics/resolve-names.cpp

2949–2958

Thanks, Tim. That's a much better alternative.

[PeteSteinfeld]

Avoiding creating a new interface from a suggestion from Tim.

[tskeith]

flang/lib/Semantics/resolve-names.cpp

3226

This was the only use of GetGenericDetails so you can eliminate it.

3233

Since the assumption is that GetGenericSymbol always returns a non-null pointer, it would be better if it returned a reference instead to make that explicit.

[PeteSteinfeld]

flang/lib/Semantics/resolve-names.cpp

3226

Thanks, Tim. Will do.

3233

Thanks, Tim. Will do.

[PeteSteinfeld]

More changes in response to Tim's comments ...

[PeteSteinfeld]

Ping

[klausler]

flang/lib/Semantics/resolve-names.cpp

686

return DEREF(genericSymbol);

[tskeith]

flang/lib/Semantics/resolve-names.cpp

688

This could be just: return DEREF(genericInfo_.top().symbol);

[PeteSteinfeld]

flang/lib/Semantics/resolve-names.cpp

686

Thanks!

688

Thanks!

flang/lib/Semantics/resolve-names.cpp

public:
   bool Pre(const parser::GenericStmt &);
   void Post(const parser::GenericStmt &);
 
   bool inInterfaceBlock() const;
   bool isGeneric() const;
   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 &);
 
 private:
   // A new GenericInfo is pushed for each interface block and generic stmt
   struct GenericInfo {
     GenericInfo(bool isInterface, bool isAbstract = false)
         : isInterface{isInterface}, isAbstract{isAbstract} {}
     bool isInterface; // in interface block
     bool isAbstract; // in abstract interface block
bool InterfaceVisitor::inInterfaceBlock() const {
   return !genericInfo_.empty() && GetGenericInfo().isInterface;
 }
 bool InterfaceVisitor::isGeneric() const {
   return !genericInfo_.empty() && GetGenericInfo().symbol;
 }
 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) {
   for (const auto &name : names) {
     specificProcs_.emplace(
         GetGenericInfo().symbol, std::make_pair(&name, kind));
   }
 }
bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
   }
 }
 
 void SubprogramVisitor::Post(const parser::ImplicitPart &) {
   // If the function has a type in the prefix, process it now
   if (funcInfo_.parsedType) {
     messageHandler().set_currStmtSource(funcInfo_.source);
     if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) {
+      if (!context().HasError(funcInfo_.resultSymbol)) {
         funcInfo_.resultSymbol->SetType(*type);
       }
     }
+  }
   funcInfo_ = {};
 }
 
 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, Symbol::Flag::Subroutine);
 }
void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   if (funcInfo_.resultName && funcInfo_.resultName->source != name.source) {
     // Note that RESULT is ignored if it has the same name as the function.
     funcResultName = funcInfo_.resultName;
   } else {
     EraseSymbol(name); // was added by PushSubprogramScope
     funcResultName = &name;
   }
   // add function result to function scope
+  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) {
     Say(funcInfo_.resultName->source,
         "The function name should not appear in RESULT, references to '%s' "
         "inside"
         " the function will be considered as references to the result only"_en_US,
         name.source);
Symbol &SubprogramVisitor::PushSubprogramScope(
   if (inInterfaceBlock()) {
     details.set_isInterface();
     if (isAbstract()) {
       symbol->attrs().set(Attr::ABSTRACT);
     } else {
       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);
   }
   FindSymbol(name)->set(subpFlag); // PushScope() created symbol
   return *symbol;
 }
 
 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {

flang/test/Semantics/resolve18.f90

 module m8
   real :: f8
   interface g8
     !ERROR: Procedure 'f8' was previously declared
     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