[flang] Extend characterization & checking for procedure bindings

Procedure bindings with explicit interfaces don't work when the
interface is shadowed by a generic interface of the same name,
and can produce spurious semantic error messages.  Extend the
characterization and checking code for such things, and the utility
functionns on which they depend, to dig through generics when they
occlude interface-defining subprograms.  This is done on demand in
checking code, not once during name resolution, because the
procedures in question may also be forward-referenced.

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

diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index e79f8ab6503e..0b03bf06eb73 100644
--- a/flang/include/flang/Semantics/symbol.h

flang/include/flang/Semantics/symbol.h

@@ -629,6 +629,10 @@ public:
                              [](const HostAssocDetails &x) {
                                return x.symbol().HasExplicitInterface();
                              },
+                             [](const GenericDetails &x) {
+                               return x.specific() &&
+                                   x.specific()->HasExplicitInterface();
+                             },
                              [](const auto &) { return false; },
                          },
         details_);

flang/lib/Evaluate/characteristics.cpp

@@ -499,7 +499,9 @@ static std::optional<Procedure> CharacterizeProcedure(
               }
               return intrinsic;
             }
-            const semantics::ProcInterface &interface { proc.interface() };
+            const semantics::ProcInterface &interface {
+              proc.interface()
+            };
             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
               auto interface {
                 CharacterizeProcedure(*interfaceSymbol, context, seenProcs)
@@ -558,6 +560,13 @@ static std::optional<Procedure> CharacterizeProcedure(
           [&](const semantics::HostAssocDetails &assoc) {
             return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
           },
+          [&](const semantics::GenericDetails &generic) {
+            if (const semantics::Symbol * specific{generic.specific()}) {
+              return CharacterizeProcedure(*specific, context, seenProcs);
+            } else {
+              return std::optional<Procedure>{};
+            }
+          },
           [&](const semantics::EntityDetails &) {
             context.messages().Say(
                 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,

flang/lib/Semantics/check-declarations.cpp

@@ -1517,11 +1517,14 @@ void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
 // C760 constraints on the passed-object dummy argument
 // C757 constraints on procedure pointer components
 void CheckHelper::CheckPassArg(
-    const Symbol &proc, const Symbol *interface, const WithPassArg &details) {
+    const Symbol &proc, const Symbol *interface0, const WithPassArg &details) {
   if (proc.attrs().test(Attr::NOPASS)) {
     return;
   }
   const auto &name{proc.name()};
+  const Symbol *interface {
+    interface0 ? FindInterface(*interface0) : nullptr
+  };
   if (!interface) {
     messages_.Say(name,
         "Procedure component '%s' must have NOPASS attribute or explicit interface"_err_en_US,

flang/lib/Semantics/resolve-names.cpp

@@ -4869,10 +4869,13 @@ void DeclarationVisitor::Post(
     if (!procedure) {
       procedure = NoteInterfaceName(procedureName);
     }
-    if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
-      SetPassNameOn(*s);
-      if (GetAttrs().test(Attr::DEFERRED)) {
-        context().SetError(*s);
+    if (procedure) {
+      if (auto *s{
+              MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
+        SetPassNameOn(*s);
+        if (GetAttrs().test(Attr::DEFERRED)) {
+          context().SetError(*s);
+        }
       }
     }
   }

flang/lib/Semantics/tools.cpp

@@ -456,9 +456,25 @@ const Symbol *FindInterface(const Symbol &symbol) {
   return common::visit(
       common::visitors{
           [](const ProcEntityDetails &details) {
-            return details.interface().symbol();
+            const Symbol *interface {
+              details.interface().symbol()
+            };
+            return interface ? FindInterface(*interface) : nullptr;
+          },
+          [](const ProcBindingDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [&](const SubprogramDetails &) { return &symbol; },
+          [](const UseDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [](const HostAssocDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [](const GenericDetails &details) {
+            return details.specific() ? FindInterface(*details.specific())
+                                      : nullptr;
           },
-          [](const ProcBindingDetails &details) { return &details.symbol(); },
           [](const auto &) -> const Symbol * { return nullptr; },
       },
       symbol.details());
@@ -484,6 +500,10 @@ const Symbol *FindSubprogram(const Symbol &symbol) {
           [](const HostAssocDetails &details) {
             return FindSubprogram(details.symbol());
           },
+          [](const GenericDetails &details) {
+            return details.specific() ? FindSubprogram(*details.specific())
+                                      : nullptr;
+          },
           [](const auto &) -> const Symbol * { return nullptr; },
       },
       symbol.details());

flang/test/Semantics/resolve20.f90

@@ -57,7 +57,7 @@ module m
     integer :: i
   contains
     !ERROR: 'proc' must be an abstract interface or a procedure with an explicit interface
-    !ERROR: Procedure component 'p1' has invalid interface 'proc'
+    !ERROR: Procedure component 'p1' must have NOPASS attribute or explicit interface
     procedure(proc), deferred :: p1
   end type t1