[flang] Change AttachDeclaration to take reference instead of pointer

AttachDeclaration (and so also SayWithDeclaration) don't do anything
when passed a null pointer for the symbol and in all but one place they
are called the symbol can't be null. So change both function to take
`const Symbol &` rather than `const Symbol *`. Change it to handle
procedure bindings as well.

Add `SayWithDeclaration` to `CheckHelper` to simplify calling the one in
`evaluate` and prevent attaching the declaration when it would point at
the same line.

Original-commit: flang-compiler/f18@5f1c2ff663
Reviewed-on: https://github.com/flang-compiler/f18/pull/841
Tree-same-pre-rewrite: false

flang/lib/evaluate/tools.cc

@@ -739,27 +739,35 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
 }
 
 parser::Message *AttachDeclaration(
-    parser::Message &message, const Symbol *symbol) {
+    parser::Message &message, const Symbol &symbol) {
-  if (symbol) {
+  const Symbol *unhosted{&symbol};
-    const Symbol *unhosted{symbol};
   while (
       const auto *assoc{unhosted->detailsIf<semantics::HostAssocDetails>()}) {
     unhosted = &assoc->symbol();
   }
-    if (const auto *use{symbol->detailsIf<semantics::UseDetails>()}) {
+  if (const auto *binding{
+          unhosted->detailsIf<semantics::ProcBindingDetails>()}) {
+    if (binding->symbol().name() != symbol.name()) {
+      message.Attach(binding->symbol().name(),
+          "Procedure '%s' is bound to '%s'"_en_US, symbol.name(),
+          binding->symbol().name());
+      return &message;
+    }
+    unhosted = &binding->symbol();
+  }
+  if (const auto *use{symbol.detailsIf<semantics::UseDetails>()}) {
     message.Attach(use->location(),
-          "'%s' is USE-associated with '%s' in module '%s'"_en_US,
+        "'%s' is USE-associated with '%s' in module '%s'"_en_US, symbol.name(),
-          symbol->name(), unhosted->name(), use->module().name());
+        unhosted->name(), use->module().name());
   } else {
     message.Attach(
-          unhosted->name(), "Declaration of '%s'"_en_US, symbol->name());
+        unhosted->name(), "Declaration of '%s'"_en_US, unhosted->name());
-    }
   }
   return &message;
 }
 
 parser::Message *AttachDeclaration(
-    parser::Message *message, const Symbol *symbol) {
+    parser::Message *message, const Symbol &symbol) {
   if (message) {
     AttachDeclaration(*message, symbol);
   }

flang/lib/evaluate/tools.h

@@ -810,11 +810,11 @@ bool HasVectorSubscript(const Expr<SomeType> &);
 // Utilities for attaching the location of the declaration of a symbol
 // of interest to a message, if both pointers are non-null.  Handles
 // the case of USE association gracefully.
-parser::Message *AttachDeclaration(parser::Message &, const Symbol *);
+parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
-parser::Message *AttachDeclaration(parser::Message *, const Symbol *);
+parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
 template<typename MESSAGES, typename... A>
 parser::Message *SayWithDeclaration(
-    MESSAGES &messages, const Symbol *symbol, A &&... x) {
+    MESSAGES &messages, const Symbol &symbol, A &&... x) {
   return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol);
 }
 

flang/lib/semantics/assignment.cc

@@ -147,7 +147,7 @@ private:
   template<typename... A> parser::Message *Say(A &&... x) {
     auto *msg{messages_.Say(std::forward<A>(x)...)};
     if (pointer_) {
-      return AttachDeclaration(msg, pointer_);
+      return AttachDeclaration(msg, *pointer_);
     } else if (!source_.empty()) {
       msg->Attach(source_, "Declaration of %s"_en_US, description_);
     }
@@ -227,7 +227,7 @@ void CheckPointerAssignment(parser::ContextualMessages &messages,
   // from the RHS.
   if (!IsPointer(lhs)) {
     SayWithDeclaration(
-        messages, &lhs, "'%s' is not a pointer"_err_en_US, lhs.name());
+        messages, lhs, "'%s' is not a pointer"_err_en_US, lhs.name());
   } else {
     auto type{characteristics::TypeAndShape::Characterize(lhs)};
     auto proc{characteristics::Procedure::Characterize(lhs, intrinsics)};
@@ -584,7 +584,7 @@ static const char *WhyBaseObjectIsSuspicious(
 void CheckDefinabilityInPureScope(parser::ContextualMessages &messages,
     const Symbol &lhs, const Scope &scope) {
   if (const char *why{WhyBaseObjectIsSuspicious(lhs, scope)}) {
-    evaluate::SayWithDeclaration(messages, &lhs,
+    evaluate::SayWithDeclaration(messages, lhs,
         "A PURE subprogram may not define '%s' because it is %s"_err_en_US,
         lhs.name(), why);
   }
@@ -611,7 +611,7 @@ void CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
   if (const Symbol * base{GetFirstSymbol(expr)}) {
     if (const char *why{WhyBaseObjectIsSuspicious(*base, scope)}) {
       if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
-        evaluate::SayWithDeclaration(messages, base,
+        evaluate::SayWithDeclaration(messages, *base,
             "A PURE subprogram may not copy the value of '%s' because it is %s and has the POINTER component '%s'"_err_en_US,
             base->name(), why, *pointer);
       }
@@ -634,7 +634,7 @@ void AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
       if (const Symbol * base{GetFirstSymbol(rhs)}) {
         if (const char *why{
                 WhyBaseObjectIsSuspicious(*base, scope)}) {  // C1594(3)
-          evaluate::SayWithDeclaration(messages, base,
+          evaluate::SayWithDeclaration(messages, *base,
               "A PURE subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
               base->name(), why);
         }
@@ -652,7 +652,7 @@ void AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
           const DerivedTypeSpec &derived{type->GetDerivedTypeSpec()};
           if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
                   derived)}) {
-            evaluate::SayWithDeclaration(messages, &*bad,
+            evaluate::SayWithDeclaration(messages, *bad,
                 "Deallocation of polymorphic non-coarray component '%s' is not permitted in a PURE subprogram"_err_en_US,
                 bad.BuildResultDesignatorName());
           } else {

flang/lib/semantics/check-call.cc

@@ -170,7 +170,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           tbp{FindImmediateComponent(derived, [](const Symbol &symbol) {
             return symbol.has<ProcBindingDetails>();
           })}) {  // 15.5.2.4(2)
-        evaluate::SayWithDeclaration(messages, tbp,
+        evaluate::SayWithDeclaration(messages, *tbp,
             "Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
             dummyName, tbp->name());
       }
@@ -178,7 +178,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           finalizer{FindImmediateComponent(derived, [](const Symbol &symbol) {
             return symbol.has<FinalProcDetails>();
           })}) {  // 15.5.2.4(2)
-        evaluate::SayWithDeclaration(messages, finalizer,
+        evaluate::SayWithDeclaration(messages, *finalizer,
             "Actual argument associated with TYPE(*) %s may not have FINAL subroutine '%s'"_err_en_US,
             dummyName, finalizer->name());
       }
@@ -187,7 +187,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
       if (dummy.intent != common::Intent::In && !dummyIsValue) {
         if (auto bad{
                 FindAllocatableUltimateComponent(derived)}) {  // 15.5.2.4(6)
-          evaluate::SayWithDeclaration(messages, &*bad,
+          evaluate::SayWithDeclaration(messages, *bad,
               "Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
               bad.BuildResultDesignatorName(), dummyName);
         }
@@ -197,7 +197,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         if (const DeclTypeSpec * type{coarray.GetType()}) {
           if (const DerivedTypeSpec * derived{type->AsDerived()}) {
             if (auto bad{semantics::FindPointerUltimateComponent(*derived)}) {
-              evaluate::SayWithDeclaration(messages, &coarray,
+              evaluate::SayWithDeclaration(messages, coarray,
                   "Coindexed object '%s' with POINTER ultimate component '%s' cannot be associated with %s"_err_en_US,
                   coarray.name(), bad.BuildResultDesignatorName(), dummyName);
             }
@@ -207,7 +207,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     }
     if (actualIsVolatile != dummyIsVolatile) {  // 15.5.2.4(22)
       if (auto bad{semantics::FindCoarrayUltimateComponent(derived)}) {
-        evaluate::SayWithDeclaration(messages, &*bad,
+        evaluate::SayWithDeclaration(messages, *bad,
             "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US,
             dummyName, bad.BuildResultDesignatorName());
       }
@@ -232,8 +232,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US,
           dummyName);
     }
-    if (actualIsAssumedSize) {
+    if (actualIsAssumedSize && actualLastSymbol) {
-      evaluate::SayWithDeclaration(messages, actualLastSymbol,
+      evaluate::SayWithDeclaration(messages, *actualLastSymbol,
           "Assumed-size array may not be associated with assumed-shape %s"_err_en_US,
           dummyName);
     }
@@ -467,7 +467,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
         } else if (argInterface.attrs.test(
                        characteristics::Procedure::Attr::Elemental)) {
           if (argProcSymbol) {  // C1533
-            evaluate::SayWithDeclaration(messages, argProcSymbol,
+            evaluate::SayWithDeclaration(messages, *argProcSymbol,
                 "Non-intrinsic ELEMENTAL procedure '%s' may not be passed as an actual argument"_err_en_US,
                 argProcSymbol->name());
             return;  // avoid piling on with checks below

flang/lib/semantics/check-declarations.cc

@@ -54,6 +54,14 @@ private:
   void CheckVolatile(
       const Symbol &, bool isAssociated, const DerivedTypeSpec *);
   void CheckBinding(const Symbol &);
+  template<typename... A>
+  void SayWithDeclaration(const Symbol &symbol, A &&... x) {
+    if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
+      if (messages_.at() != symbol.name()) {
+        evaluate::AttachDeclaration(*msg, symbol);
+      }
+    }
+  }
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -131,7 +139,7 @@ void CheckHelper::Check(const Symbol &symbol) {
         for (const Symbol &component : components) {
           if (component.attrs().test(Attr::DEFERRED)) {
             if (symbol.scope()->FindComponent(component.name()) == &component) {
-              evaluate::SayWithDeclaration(messages_, &component,
+              SayWithDeclaration(component,
                   "Non-ABSTRACT extension of ABSTRACT derived type '%s' lacks a binding for DEFERRED procedure '%s'"_err_en_US,
                   parentDerived->typeSymbol().name(), component.name());
             }
@@ -157,12 +165,12 @@ void CheckHelper::Check(const Symbol &symbol) {
     }
     if (!IsDummy(symbol) && !IsFunctionResult(symbol)) {
       if (IsPolymorphicAllocatable(symbol)) {
-        evaluate::SayWithDeclaration(messages_, &symbol,
+        SayWithDeclaration(symbol,
             "Deallocation of polymorphic object '%s' is not permitted in a PURE subprogram"_err_en_US,
             symbol.name());
       } else if (derived) {
         if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
-          evaluate::SayWithDeclaration(messages_, &*bad,
+          SayWithDeclaration(*bad,
               "Deallocation of polymorphic object '%s%s' is not permitted in a PURE subprogram"_err_en_US,
               symbol.name(), bad.BuildResultDesignatorName());
         }
@@ -193,7 +201,7 @@ void CheckHelper::Check(const Symbol &symbol) {
       }
       if (derived) {
         if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
-          evaluate::SayWithDeclaration(messages_, &*bad,
+          SayWithDeclaration(*bad,
               "Result of PURE function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
               bad.BuildResultDesignatorName());
         }
@@ -383,7 +391,7 @@ void CheckHelper::CheckBinding(const Symbol &symbol) {
   if (const Symbol * dtSymbol{dtScope.symbol()}) {
     if (symbol.attrs().test(Attr::DEFERRED)) {
       if (!dtSymbol->attrs().test(Attr::ABSTRACT)) {
-        evaluate::SayWithDeclaration(messages_, dtSymbol,
+        SayWithDeclaration(*dtSymbol,
             "Procedure bound to non-ABSTRACT derived type '%s' may not be DEFERRED"_err_en_US,
             dtSymbol->name());
       }
@@ -396,7 +404,7 @@ void CheckHelper::CheckBinding(const Symbol &symbol) {
   }
   if (const Symbol * overridden{FindOverriddenBinding(symbol)}) {
     if (overridden->attrs().test(Attr::NON_OVERRIDABLE)) {
-      evaluate::SayWithDeclaration(messages_, overridden,
+      SayWithDeclaration(*overridden,
           "Override of NON_OVERRIDABLE '%s' is not permitted"_err_en_US,
           symbol.name());
     }
@@ -404,13 +412,13 @@ void CheckHelper::CheckBinding(const Symbol &symbol) {
             overridden->detailsIf<ProcBindingDetails>()}) {
       if (!binding.symbol().attrs().test(Attr::PURE) &&
           overriddenBinding->symbol().attrs().test(Attr::PURE)) {
-        evaluate::SayWithDeclaration(messages_, overridden,
+        SayWithDeclaration(*overridden,
             "An overridden PURE type-bound procedure binding must also be PURE"_err_en_US);
         return;
       }
       if (!binding.symbol().attrs().test(Attr::ELEMENTAL) &&
           overriddenBinding->symbol().attrs().test(Attr::ELEMENTAL)) {
-        evaluate::SayWithDeclaration(messages_, overridden,
+        SayWithDeclaration(*overridden,
             "A type-bound procedure and its override must both, or neither, be ELEMENTAL"_err_en_US);
         return;
       }
@@ -424,33 +432,33 @@ void CheckHelper::CheckBinding(const Symbol &symbol) {
           if (passIndex == *overriddenBinding->passIndex()) {
             if (!(bindingChars && overriddenChars &&
                     bindingChars->CanOverride(*overriddenChars, passIndex))) {
-              evaluate::SayWithDeclaration(messages_, overridden,
+              SayWithDeclaration(*overridden,
                   "A type-bound procedure and its override must have compatible interfaces apart from their passed argument"_err_en_US);
             }
           } else {
-            evaluate::SayWithDeclaration(messages_, overridden,
+            SayWithDeclaration(*overridden,
                 "A type-bound procedure and its override must use the same PASS argument"_err_en_US);
           }
         } else {
-          evaluate::SayWithDeclaration(messages_, overridden,
+          SayWithDeclaration(*overridden,
               "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US);
         }
       } else if (overriddenBinding->passIndex()) {
-        evaluate::SayWithDeclaration(messages_, overridden,
+        SayWithDeclaration(*overridden,
             "A NOPASS type-bound procedure may not override a passed-argument procedure"_err_en_US);
       } else if (!(bindingChars && overriddenChars &&
                      bindingChars->CanOverride(
                          *overriddenChars, std::nullopt))) {
-        evaluate::SayWithDeclaration(messages_, overridden,
+        SayWithDeclaration(*overridden,
             "A type-bound procedure and its override must have compatible interfaces"_err_en_US);
       }
       if (symbol.attrs().test(Attr::PRIVATE) &&
           overridden->attrs().test(Attr::PUBLIC)) {
-        evaluate::SayWithDeclaration(messages_, overridden,
+        SayWithDeclaration(*overridden,
             "A PRIVATE procedure may not override a PUBLIC procedure"_err_en_US);
       }
     } else {
-      evaluate::SayWithDeclaration(messages_, overridden,
+      SayWithDeclaration(*overridden,
           "A type-bound procedure binding may not have the same name as a parent component"_err_en_US);
     }
   }

flang/lib/semantics/expression.cc

@@ -1315,7 +1315,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
                           "ABSTRACT derived type '%s' may not be used in a "
                           "structure constructor"_err_en_US,
                           typeName),
-        &typeSymbol);
+        typeSymbol);
   }
 
   // This iterator traverses all of the components in the derived type and its
@@ -1477,14 +1477,14 @@ MaybeExpr ExpressionAnalyzer::Analyze(
                     "incompatible with component '%s' of type %s"_err_en_US,
                     valueType->AsFortran(), symbol->name(),
                     symType->AsFortran()),
-                symbol);
+                *symbol);
           } else {
             AttachDeclaration(
                 Say(expr.source,
                     "Value in structure constructor is incompatible with "
                     " component '%s' of type %s"_err_en_US,
                     symbol->name(), symType->AsFortran()),
-                symbol);
+                *symbol);
           }
         }
       }
@@ -1505,7 +1505,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
                                 "Structure constructor lacks a value for "
                                 "component '%s'"_err_en_US,
                                 symbol.name()),
-              &symbol);
+              symbol);
         }
       }
     }
@@ -1727,7 +1727,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
             "Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
             callSite);
       }
-      AttachDeclaration(msg, &proc);
+      AttachDeclaration(msg, proc);
     }
   }
 }
@@ -2125,7 +2125,7 @@ static void CheckFuncRefToArrayElementRefHasSubscripts(
             "A result variable must be declared with RESULT to allow recursive "
             "function calls"_en_US);
       } else {
-        AttachDeclaration(&msg, name->symbol);
+        AttachDeclaration(&msg, *name->symbol);
       }
     }
   }

flang/lib/semantics/semantics.h

@@ -143,7 +143,7 @@ public:
   void SayWithDecl(const Symbol &symbol, const parser::CharBlock &at,
       parser::MessageFixedText &&msg, A &&... args) {
     auto &message{Say(at, std::move(msg), args...)};
-    evaluate::AttachDeclaration(&message, &symbol);
+    evaluate::AttachDeclaration(&message, symbol);
   }
 
   const Scope &FindScope(parser::CharBlock) const;