[flang] Fix bogus error message with binding

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

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

flang/lib/Evaluate/call.cpp

@@ -117,9 +117,12 @@ int ProcedureDesignator::Rank() const {
 
 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;

flang/lib/Semantics/check-declarations.cpp

@@ -53,8 +53,7 @@ private:
     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 &);
@@ -172,22 +171,18 @@ void CheckHelper::Check(const Symbol &symbol) {
   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); },
@@ -196,6 +191,15 @@ void CheckHelper::Check(const Symbol &symbol) {
           [](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(
@@ -1279,7 +1283,7 @@ const Procedure *CheckHelper::Characterize(const Symbol &symbol) {
   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(
@@ -1288,7 +1292,7 @@ void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated,
   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(

flang/test/Semantics/call17.f90

@@ -0,0 +1,19 @@
+! 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

@@ -11,8 +11,8 @@ module m
     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