[flang] Fix checking of TBP bindings

[klausler]

Summary

Non-DEFERRED procedure binding checking can't blindly accept
all procedures defined in modules -- they can't be ABSTRACT
interfaces. And GetUltimate() must be used rather than
FindSubprogram(); the latter will resolve to a procedure's
interface in the case of "procedure(interface) :: external",
not "external".

flang/include/flang/Semantics/symbol.h

private:
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const DerivedTypeDetails &);
 };
 
 class ProcBindingDetails : public WithPassArg {
 public:
   explicit ProcBindingDetails(const Symbol &symbol) : symbol_{symbol} {}
   const Symbol &symbol() const { return symbol_; }
+  void ReplaceSymbol(const Symbol &symbol) { symbol_ = symbol; }
 
 private:
   SymbolRef symbol_; // procedure bound to; may be forward
 };
 
 class NamelistDetails {
 public:
   const SymbolVector &objects() const { return objects_; }

flang/include/flang/Semantics/tools.h

 bool IsStmtFunctionDummy(const Symbol &);
 bool IsStmtFunctionResult(const Symbol &);
 bool IsPointerDummy(const Symbol &);
 bool IsBindCProcedure(const Symbol &);
 bool IsBindCProcedure(const Scope &);
 // Returns a pointer to the function's symbol when true, else null
 const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
-bool CanBeTypeBoundProc(const Symbol *);
+bool CanBeTypeBoundProc(const Symbol &);
 // Does a non-PARAMETER symbol have explicit initialization with =value or
 // =>target in its declaration (but not in a DATA statement)? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE
 // attribute, or a derived type component default value.)
 bool HasDeclarationInitializer(const Symbol &);
 // Is the symbol explicitly or implicitly initialized in any way?
 bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,

 template <typename T>
 const Symbol *FindExternallyVisibleObject(
     const evaluate::Expr<T> &expr, const Scope &scope) {
   return common::visit(
       [&](const auto &x) { return FindExternallyVisibleObject(x, scope); },
       expr.u);
 }
 
-// Apply GetUltimate(), then if the symbol is a generic procedure shadowing a
+// Applies GetUltimate(), then if the symbol is a generic procedure shadowing a
 // specific procedure of the same name, return it instead.
 const Symbol &BypassGeneric(const Symbol &);
 
 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 
 bool ExprHasTypeCategory(
     const SomeExpr &expr, const common::TypeCategory &type);
 bool ExprTypeKindIsDefault(

flang/lib/Semantics/resolve-names.cpp

if (inInterfaceBlock()) {
     details.set_isInterface();
     if (isAbstract()) {
       SetExplicitAttr(*symbol, Attr::ABSTRACT);
     } else {
       MakeExternal(*symbol);
     }
     if (isGeneric()) {
       Symbol &genericSymbol{GetGenericSymbol()};
-      if (genericSymbol.has<GenericDetails>()) {
-        genericSymbol.get<GenericDetails>().AddSpecificProc(
-            *symbol, name.source);
+      if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {
+        details->AddSpecificProc(*symbol, name.source);
       } else {
         CHECK(context().HasError(genericSymbol));
       }
     }
     set_inheritFromParent(false);
   }
   FindSymbol(name)->set(subpFlag); // PushScope() created symbol
   return *symbol;
for (auto &declaration : x.declarations) {
     auto &bindingName{std::get<parser::Name>(declaration.t)};
     auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};
     const parser::Name &procedureName{optName ? *optName : bindingName};
     Symbol *procedure{FindSymbol(procedureName)};
     if (!procedure) {
       procedure = NoteInterfaceName(procedureName);
     }
     if (procedure) {
-      if (auto *s{
-              MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
+      const Symbol &bindTo{BypassGeneric(*procedure)};
+      if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) {
         SetPassNameOn(*s);
         if (GetAttrs().test(Attr::DEFERRED)) {
           context().SetError(*s);
         }
       }
     }
   }
 }
 
 void DeclarationVisitor::CheckBindings(
     const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
   CHECK(currScope().IsDerivedType());
   for (auto &declaration : tbps.declarations) {
     auto &bindingName{std::get<parser::Name>(declaration.t)};
     if (Symbol * binding{FindInScope(bindingName)}) {
       if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {
-        const Symbol *procedure{FindSubprogram(details->symbol())};
+        const Symbol &ultimate{details->symbol().GetUltimate()};
+        const Symbol &procedure{BypassGeneric(ultimate)};
+        if (&procedure != &ultimate) {
+          details->ReplaceSymbol(procedure);
+        }
         if (!CanBeTypeBoundProc(procedure)) {
           if (details->symbol().name() != binding->name()) {
             Say(binding->name(),
                 "The binding of '%s' ('%s') must be either an accessible "
                 "module procedure or an external procedure with "
                 "an explicit interface"_err_en_US,
                 binding->name(), details->symbol().name());
           } else {

flang/lib/Semantics/tools.cpp

if (const DeclTypeSpec * type{details->type()}) {
             FindEventOrLockPotentialComponent(*derived);
       }
     }
   }
   return false;
 }
 
 // Check this symbol suitable as a type-bound procedure - C769
-bool CanBeTypeBoundProc(const Symbol *symbol) {
-  if (!symbol || IsDummy(*symbol) || IsProcedurePointer(*symbol)) {
+bool CanBeTypeBoundProc(const Symbol &symbol) {
+  if (IsDummy(symbol) || IsProcedurePointer(symbol)) {
     return false;
-  } else if (symbol->has<SubprogramNameDetails>()) {
-    return symbol->owner().kind() == Scope::Kind::Module;
-  } else if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
-    return symbol->owner().kind() == Scope::Kind::Module ||
-        details->isInterface();
-  } else if (const auto *proc{symbol->detailsIf<ProcEntityDetails>()}) {
-    return !symbol->attrs().test(Attr::INTRINSIC) &&
+  } else if (symbol.has<SubprogramNameDetails>()) {
+    return symbol.owner().kind() == Scope::Kind::Module;
+  } else if (auto *details{symbol.detailsIf<SubprogramDetails>()}) {
+    if (details->isInterface()) {
+      return !symbol.attrs().test(Attr::ABSTRACT);
+    } else {
+      return symbol.owner().kind() == Scope::Kind::Module;
+    }
+  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
+    return !symbol.attrs().test(Attr::INTRINSIC) &&
         proc->HasExplicitInterface();
   } else {
     return false;
   }
 }
 
 bool HasDeclarationInitializer(const Symbol &symbol) {
   if (IsNamedConstant(symbol)) {

flang/test/Semantics/resolve32.f90

 
 module m
   use m2
   external bar
   interface
     subroutine foo
     end subroutine
   end interface
+  abstract interface
+    subroutine absfoo
+    end subroutine
+  end interface
   integer :: i
   type t1
     integer :: c
   contains
     !ERROR: The binding of 'a' ('missing') must be either an accessible module procedure or an external procedure with an explicit interface
     procedure, nopass :: a => missing
     procedure, nopass :: b => s, s2
     !ERROR: Type parameter, component, or procedure binding 'c' already defined in this type
     procedure, nopass :: c
     !ERROR: DEFERRED is only allowed when an interface-name is provided
     procedure, nopass, deferred :: d => s
     !Note: s3 not found because it's not accessible -- should we issue a message
     !to that effect?
     !ERROR: 's3' must be either an accessible module procedure or an external procedure with an explicit interface
     procedure, nopass :: s3
     procedure, nopass :: foo
+    !ERROR: 'absfoo' must be either an accessible module procedure or an external procedure with an explicit interface
+    procedure, nopass :: absfoo
     !ERROR: 'bar' must be either an accessible module procedure or an external procedure with an explicit interface
     procedure, nopass :: bar
     !ERROR: 'i' must be either an accessible module procedure or an external procedure with an explicit interface
     procedure, nopass :: i
     !ERROR: Type parameter, component, or procedure binding 'b' already defined in this type
     procedure, nopass :: b => s4
     !ERROR: DEFERRED is required when an interface-name is provided
     procedure(foo), nopass :: g