[flang] Fix bogus error message with binding

[klausler]

Summary

ProcedureDesignator::GetInterfaceSymbol() needs to return
the procedure bound to a bindings.

flang/lib/Evaluate/call.cpp

if (const auto &result{intrinsic->characteristics.value().functionResult}) {
       // Otherwise, intrinsic returns a procedure pointer (e.g. NULL(MOLD=pptr))
     }
   }
   return 0;
 }
 
 const Symbol *ProcedureDesignator::GetInterfaceSymbol() const {
   if (const Symbol * symbol{GetSymbol()}) {
-    if (const auto *details{
-            symbol->detailsIf<semantics::ProcEntityDetails>()}) {
-      return details->interface().symbol();
+    const Symbol &ultimate{symbol->GetUltimate()};
+    if (const auto *proc{ultimate.detailsIf<semantics::ProcEntityDetails>()}) {
+      return proc->interface().symbol();
+    } else if (const auto *binding{
+                   ultimate.detailsIf<semantics::ProcBindingDetails>()}) {
+      return &binding->symbol();
     }
   }
   return nullptr;
 }
 
 bool ProcedureDesignator::IsElemental() const {
   if (const Symbol * interface{GetInterfaceSymbol()}) {
     return interface->attrs().test(semantics::Attr::ELEMENTAL);

flang/lib/Semantics/check-declarations.cpp

public:
   void Check(const Scope &);
   const Procedure *Characterize(const Symbol &);
 
 private:
   template <typename A> void CheckSpecExpr(const A &x) {
     evaluate::CheckSpecificationExpr(x, DEREF(scope_), foldingContext_);
   }
   void CheckValue(const Symbol &, const DerivedTypeSpec *);
-  void CheckVolatile(
-      const Symbol &, bool isAssociated, const DerivedTypeSpec *);
+  void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
   void CheckPointer(const Symbol &);
   void CheckPassArg(
       const Symbol &proc, const Symbol *interface, const WithPassArg &);
   void CheckProcBinding(const Symbol &, const ProcBindingDetails &);
   void CheckObjectEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckPointerInitialization(const Symbol &);
   void CheckArraySpec(const Symbol &, const ArraySpec &);
   void CheckProcEntity(const Symbol &, const ProcEntityDetails &);

 void CheckHelper::Check(const Symbol &symbol) {
   if (context_.HasError(symbol)) {
     return;
   }
   auto restorer{messages_.SetLocation(symbol.name())};
   context_.set_location(symbol.name());
   const DeclTypeSpec *type{symbol.GetType()};
   const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
-  bool isAssociated{symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()};
-  if (symbol.attrs().test(Attr::VOLATILE)) {
-    CheckVolatile(symbol, isAssociated, derived);
-  }
-  if (isAssociated) {
-    if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
-      CheckHostAssoc(symbol, *details);
-    }
-    return; // no other checks on associated symbols
-  }
-  if (IsPointer(symbol)) {
-    CheckPointer(symbol);
-  }
+  bool isDone{false};
   std::visit(
       common::visitors{
-          [&](const ProcBindingDetails &x) { CheckProcBinding(symbol, x); },
+          [&](const UseDetails &x) { isDone = true; },
+          [&](const HostAssocDetails &x) {
+            CheckHostAssoc(symbol, x);
+            isDone = true;
+          },
+          [&](const ProcBindingDetails &x) {
+            CheckProcBinding(symbol, x);
+            isDone = true;
+          },
           [&](const ObjectEntityDetails &x) { CheckObjectEntity(symbol, x); },
           [&](const ProcEntityDetails &x) { CheckProcEntity(symbol, x); },
           [&](const SubprogramDetails &x) { CheckSubprogram(symbol, x); },
           [&](const DerivedTypeDetails &x) { CheckDerivedType(symbol, x); },
           [&](const GenericDetails &x) { CheckGeneric(symbol, x); },
           [](const auto &) {},
       },
       symbol.details());
+  if (symbol.attrs().test(Attr::VOLATILE)) {
+    CheckVolatile(symbol, derived);
+  }
+  if (isDone) {
+    return; // following checks do not apply
+  }
+  if (IsPointer(symbol)) {
+    CheckPointer(symbol);
+  }
   if (InPure()) {
     if (IsSaved(symbol)) {
       messages_.Say(
           "A pure subprogram may not have a variable with the SAVE attribute"_err_en_US);
     }
     if (symbol.attrs().test(Attr::VOLATILE)) {
       messages_.Say(
           "A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
const Procedure *CheckHelper::Characterize(const Symbol &symbol) {
   if (it == characterizeCache_.end()) {
     auto pair{characterizeCache_.emplace(SymbolRef{symbol},
         Procedure::Characterize(symbol, context_.foldingContext()))};
     it = pair.first;
   }
   return common::GetPtrFromOptional(it->second);
 }
 
-void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated,
+void CheckHelper::CheckVolatile(const Symbol &symbol,
     const DerivedTypeSpec *derived) { // C866 - C868
   if (IsIntentIn(symbol)) {
     messages_.Say(
         "VOLATILE attribute may not apply to an INTENT(IN) argument"_err_en_US);
   }
   if (IsProcedure(symbol)) {
     messages_.Say("VOLATILE attribute may apply only to a variable"_err_en_US);
   }
-  if (isAssociated) {
+  if (symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()) {
     const Symbol &ultimate{symbol.GetUltimate()};
     if (IsCoarray(ultimate)) {
       messages_.Say(
           "VOLATILE attribute may not apply to a coarray accessed by USE or host association"_err_en_US);
     }
     if (derived) {
       if (FindCoarrayUltimateComponent(*derived)) {
         messages_.Say(

flang/test/Semantics/call17.f90

+! RUN: %f18 -fparse-only $s 2>&1 | FileCheck %s
+
+! Regression test: don't emit a bogus error about an invalid specification expression
+! in the declaration of a binding
+
+module m
+  type :: t
+    integer :: n
+   contains
+    !CHECK-NOT: Invalid specification expression
+    procedure :: binding => func
+  end type
+ contains
+  function func(x)
+    class(t), intent(in) :: x
+    character(len=x%n) :: func
+    func = ' '
+  end function
+end module

flang/test/Semantics/resolve88.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! C746, C747, and C748
 module m
   use ISO_FORTRAN_ENV
   use ISO_C_BINDING
 
   ! C746 If a coarray-spec appears, it shall be a deferred-coshape-spec-list and
   ! the component shall have the ALLOCATABLE attribute.
 
   type testCoArrayType
     real, allocatable, codimension[:] :: allocatableField
     !ERROR: Component 'deferredfield' is a coarray and must have the ALLOCATABLE attribute
     real, codimension[:] :: deferredField
-    !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray
     !ERROR: Component 'pointerfield' is a coarray and must have the ALLOCATABLE attribute
+    !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray
     real, pointer, codimension[:] :: pointerField
     !ERROR: Component 'realfield' is a coarray and must have the ALLOCATABLE attribute and have a deferred coshape
     real, codimension[*] :: realField
     !ERROR: 'realfield2' is an ALLOCATABLE coarray and must have a deferred coshape
     real, allocatable, codimension[*] :: realField2
   end type testCoArrayType
 
   ! C747 If a coarray-spec appears, the component shall not be of type C_PTR or