[flang] Check discrepancies between local & available global subprograms

[klausler]

Summary

When a scope declares the name and perhaps some characteristics of
an external subprogram using any of the many means that Fortran supplies
for doing such a thing, and that external subprogram's definition is
available, check the local declaration against the external definition.
In particular, if the global definition's interface cannot be called
by means of an implicit interface, ensure that references are via an
explicit and compatible interface.

Further, extend call site checking so that when a local declaration
exists for a known global symbol and the arguments are valid for that
local declaration, the arguments are checked against the global's
interface, just are is already done when no local declaration exists.

[klausler]

clang-format

[klausler]

clang-format two entire files

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Semantics/symbol.h

private:
   Attrs implicitAttrs_; // subset of attrs_ that were not explicit
   Flags flags_;
   Scope *scope_{nullptr};
   std::size_t size_{0}; // size in bytes
   std::size_t offset_{0}; // byte offset in scope or common block
   Details details_;
 
   Symbol() {} // only created in class Symbols
-  const std::string GetDetailsName() const;
+  std::string GetDetailsName() const;
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
   friend llvm::raw_ostream &DumpForUnparse(
       llvm::raw_ostream &, const Symbol &, bool);
 
   static constexpr int startRecursionDepth{100};
 
   inline const DeclTypeSpec *GetTypeImpl(int depth = startRecursionDepth) const;
   inline int RankImpl(int depth = startRecursionDepth) const {

flang/include/flang/Semantics/tools.h

 const Symbol *FindPointerComponent(const Scope &);
 const Symbol *FindPointerComponent(const DerivedTypeSpec &);
 const Symbol *FindPointerComponent(const DeclTypeSpec &);
 const Symbol *FindPointerComponent(const Symbol &);
 const Symbol *FindInterface(const Symbol &);
 const Symbol *FindSubprogram(const Symbol &);
 const Symbol *FindFunctionResult(const Symbol &);
 const Symbol *FindOverriddenBinding(const Symbol &);
+const Symbol *FindGlobal(const Symbol &);
 
 const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &);
 const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
 const DeclTypeSpec *FindParentTypeSpec(const Scope &);
 const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
 
 const EquivalenceSet *FindEquivalenceSet(const Symbol &);
 

flang/lib/Evaluate/tools.cpp

 
 bool IsFunction(const Scope &scope) {
   const Symbol *symbol{scope.GetSymbol()};
   return symbol && IsFunction(*symbol);
 }
 
 bool IsProcedure(const Symbol &symbol) {
   return common::visit(common::visitors{
-                           [](const SubprogramDetails &) { return true; },
+                           [&symbol](const SubprogramDetails &) {
+                             const Scope *scope{symbol.scope()};
+                             // Main programs & BLOCK DATA are not procedures.
+                             return !scope ||
+                                 scope->kind() == Scope::Kind::Subprogram;
+                           },
                            [](const SubprogramNameDetails &) { return true; },
                            [](const ProcEntityDetails &) { return true; },
                            [](const GenericDetails &) { return true; },
                            [](const ProcBindingDetails &) { return true; },
                            [](const auto &) { return false; },
                        },
       symbol.GetUltimate().details());
 }

flang/lib/Semantics/check-call.h

 }
 
 namespace Fortran::semantics {
 class Scope;
 
 // Argument treatingExternalAsImplicit should be true when the called procedure
 // does not actually have an explicit interface at the call site, but
 // its characteristics are known because it is a subroutine or function
-// defined at the top level in the same source file.
-void CheckArguments(const evaluate::characteristics::Procedure &,
+// defined at the top level in the same source file.  Returns false if
+// messages were created, true if all is well.
+bool CheckArguments(const evaluate::characteristics::Procedure &,
     evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
     bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic);
 
 // Checks actual arguments against a procedure with an explicit interface.
 // Reports a buffer of errors when not compatible.
 parser::Messages CheckExplicitInterface(
     const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,

flang/lib/Semantics/check-call.cpp

bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     bool allowActualArgumentConversions) {
   return proc.HasExplicitInterface() &&
       !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr,
           allowActualArgumentConversions)
            .AnyFatalError();
 }
 
-void CheckArguments(const characteristics::Procedure &proc,
+bool CheckArguments(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
     const Scope &scope, bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic) {
   bool explicitInterface{proc.HasExplicitInterface()};
   parser::ContextualMessages &messages{context.messages()};
   if (!explicitInterface || treatingExternalAsImplicit) {
     parser::Messages buffer;
     {
       auto restorer{messages.SetMessages(buffer)};
       for (auto &actual : actuals) {
         if (actual) {
           CheckImplicitInterfaceArg(*actual, messages, context);
         }
       }
     }
     if (!buffer.empty()) {
       if (auto *msgs{messages.messages()}) {
         msgs->Annex(std::move(buffer));
       }
-      return; // don't pile on
+      return false; // don't pile on
     }
   }
   if (explicitInterface) {
     auto buffer{
         CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
+    if (!buffer.empty()) {
       if (treatingExternalAsImplicit && !buffer.empty()) {
         if (auto *msg{messages.Say(
                 "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
           buffer.AttachTo(*msg, parser::Severity::Because);
         }
       }
       if (auto *msgs{messages.messages()}) {
         msgs->Annex(std::move(buffer));
       }
+      return false;
+    }
   }
+  return true;
 }
 } // namespace Fortran::semantics

flang/lib/Semantics/check-declarations.cpp

private:
   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 CheckSubprogram(const Symbol &, const SubprogramDetails &);
+  void CheckLocalVsGlobal(const Symbol &);
   void CheckAssumedTypeEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
   bool CheckFinal(
       const Symbol &subroutine, SourceName, const Symbol &derivedType);
   bool CheckDistinguishableFinals(const Symbol &f1, SourceName f1name,
       const Symbol &f2, SourceName f2name, const Symbol &derivedType);
   void CheckGeneric(const Symbol &, const GenericDetails &);
   void CheckHostAssoc(const Symbol &, const HostAssocDetails &);
private:
   }
   bool InInterface() const {
     const SubprogramDetails *subp{innermostSymbol_
             ? innermostSymbol_->detailsIf<SubprogramDetails>()
             : nullptr};
     return subp && subp->isInterface();
   }
   template <typename... A>
-  void SayWithDeclaration(const Symbol &symbol, A &&...x) {
-    if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
-      if (messages_.at().begin() != symbol.name().begin()) {
-        evaluate::AttachDeclaration(*msg, symbol);
-      }
-    }
+  parser::Message *SayWithDeclaration(const Symbol &symbol, A &&...x) {
+    parser::Message *msg{messages_.Say(std::forward<A>(x)...)};
+    if (msg && messages_.at().begin() != symbol.name().begin()) {
+    return msg;
   }
   bool IsResultOkToDiffer(const FunctionResult &);
   void CheckBindC(const Symbol &);
   // Check functions for defined I/O procedures
   void CheckDefinedIoProc(
       const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
   bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
   void CheckDioDummyIsDerived(const Symbol &, const Symbol &,
for (const auto &spec : shape) {
     Check(spec);
   }
 }
 
 void CheckHelper::Check(
     const DeclTypeSpec &type, bool canHaveAssumedTypeParameters) {
   if (type.category() == DeclTypeSpec::Character) {
     Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters);
-  } else if (const DerivedTypeSpec * derived{type.AsDerived()}) {
+  } else if (const DerivedTypeSpec *derived{type.AsDerived()}) {
     for (auto &parm : derived->parameters()) {
       Check(parm.second, canHaveAssumedTypeParameters);
     }
   }
 }
 
 void CheckHelper::Check(const Symbol &symbol) {
   if (symbol.name().size() > common::maxNameLen &&
if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) { // C723
     }
     if (IsElementalProcedure(symbol)) {
       messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
     } else if (IsPureProcedure(symbol)) {
       messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
     }
-    if (const Symbol * result{FindFunctionResult(symbol)}) {
+    if (const Symbol *result{FindFunctionResult(symbol)}) {
       if (IsPointer(*result)) {
         messages_.Say(
             "An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
       }
     }
   }
   if (symbol.attrs().test(Attr::VALUE)) {
     CheckValue(symbol, derived);
if (FindCoarrayUltimateComponent(*derived)) {
       messages_.Say(
           "VALUE attribute may not apply to a type with a coarray ultimate component"_err_en_US);
     }
   }
 }
 
 void CheckHelper::CheckAssumedTypeEntity( // C709
     const Symbol &symbol, const ObjectEntityDetails &details) {
-  if (const DeclTypeSpec * type{symbol.GetType()};
+  if (const DeclTypeSpec *type{symbol.GetType()};
       type && type->category() == DeclTypeSpec::TypeStar) {
     if (!IsDummy(symbol)) {
       messages_.Say(
           "Assumed-type entity '%s' must be a dummy argument"_err_en_US,
           symbol.name());
     } else {
       if (symbol.attrs().test(Attr::ALLOCATABLE)) {
         messages_.Say("Assumed-type argument '%s' cannot have the ALLOCATABLE"
if (IsAllocatable(symbol)) {
           symbol.name(), deferredMsg);
     } else {
       if (!details.coshape().CanBeAssumedSize()) { // C828
         messages_.Say(
             "'%s' is a non-ALLOCATABLE coarray and must have an explicit coshape"_err_en_US,
             symbol.name());
       }
     }
-    if (const DeclTypeSpec * type{details.type()}) {
+    if (const DeclTypeSpec *type{details.type()}) {
       if (IsBadCoarrayType(type->AsDerived())) { // C747 & C824
         messages_.Say(
             "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US,
             symbol.name());
       }
     }
   }
   if (details.isDummy()) {
if (details.isDummy()) {
     }
     if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)) &&
         !IsPointer(symbol) && !IsIntentIn(symbol) &&
         !symbol.attrs().test(Attr::VALUE)) {
       if (InFunction()) { // C1583
         messages_.Say(
             "non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US);
       } else if (IsIntentOut(symbol)) {
-        if (const DeclTypeSpec * type{details.type()}) {
+        if (const DeclTypeSpec *type{details.type()}) {
           if (type && type->IsPolymorphic()) { // C1588
             messages_.Say(
                 "An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US);
-          } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+          } else if (const DerivedTypeSpec *derived{type->AsDerived()}) {
             if (FindUltimateComponent(*derived, [](const Symbol &x) {
                   const DeclTypeSpec *type{x.GetType()};
                   return type && type->IsPolymorphic();
                 })) { // C1588
               messages_.Say(
                   "An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component"_err_en_US);
             }
             if (HasImpureFinal(*derived)) { // C1587
if (symbol.owner().kind() == Scope::Kind::BlockData) {
     if (IsAllocatable(symbol)) {
       messages_.Say(
           "An ALLOCATABLE variable may not appear in a BLOCK DATA subprogram"_err_en_US);
     } else if (IsInitialized(symbol) && !FindCommonBlockContaining(symbol)) {
       messages_.Say(
           "An initialized variable in BLOCK DATA must be in a COMMON block"_err_en_US);
     }
   }
-  if (const DeclTypeSpec * type{details.type()}) { // C708
+  if (const DeclTypeSpec *type{details.type()}) { // C708
     if (type->IsPolymorphic() &&
         !(type->IsAssumedType() || IsAllocatableOrPointer(symbol) ||
             IsDummy(symbol))) {
       messages_.Say("CLASS entity '%s' must be a dummy argument or have "
                     "ALLOCATABLE or POINTER attribute"_err_en_US,
           symbol.name());
     }
   }
if (!symbol.attrs().test(Attr::POINTER) && // C843
             symbol.attrs().test(Attr::INTENT_INOUT))) {
       messages_.Say("A dummy procedure without the POINTER attribute"
                     " may not have an INTENT attribute"_err_en_US);
     }
     if (InElemental()) { // C15100
       messages_.Say(
           "An ELEMENTAL subprogram may not have a dummy procedure"_err_en_US);
     }
-    const Symbol *interface { details.interface().symbol() };
+    const Symbol *interface {
+      details.interface().symbol()
+    };
     if (!symbol.attrs().test(Attr::INTRINSIC) &&
         (IsElementalProcedure(symbol) ||
             (interface && !interface->attrs().test(Attr::INTRINSIC) &&
                 IsElementalProcedure(*interface)))) {
       // There's no explicit constraint or "shall" that we can find in the
       // standard for this check, but it seems to be implied in multiple
       // sites, and ELEMENTAL non-intrinsic actual arguments *are*
       // explicitly forbidden.  But we allow "PROCEDURE(SIN)::dummy"
if (!symbol.attrs().test(Attr::POINTER)) { // C756
       messages_.Say(name,
           "Procedure component '%s' must have POINTER attribute"_err_en_US,
           name);
     }
     CheckPassArg(symbol, details.interface().symbol(), details);
   }
   if (symbol.attrs().test(Attr::POINTER)) {
     CheckPointerInitialization(symbol);
-    if (const Symbol * interface{details.interface().symbol()}) {
+    if (const Symbol *interface{details.interface().symbol()}) {
       const Symbol &ultimate{interface->GetUltimate()};
       if (ultimate.attrs().test(Attr::INTRINSIC)) {
         if (const auto intrinsic{
                 context_.intrinsics().IsSpecificIntrinsicFunction(
                     ultimate.name().ToString())};
             !intrinsic || intrinsic->isRestrictedSpecific) { // C1515
           messages_.Say(
               "Intrinsic procedure '%s' is not an unrestricted specific "
               "intrinsic permitted for use as the definition of the interface "
               "to procedure pointer '%s'"_err_en_US,
               ultimate.name(), symbol.name());
         }
       } else if (IsElementalProcedure(*interface)) {
         messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
             symbol.name()); // C1517
       }
     }
   } else if (symbol.attrs().test(Attr::SAVE)) {
     messages_.Say(
         "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US,
         symbol.name());
   }
+  CheckLocalVsGlobal(symbol);
 }
 
 // When a module subprogram has the MODULE prefix the following must match
 // with the corresponding separate module procedure interface body:
 // - C1549: characteristics and dummy argument names
 // - C1550: binding label
 // - C1551: NON_RECURSIVE prefix
 class SubprogramMatchHelper {
bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) {
   int kind{typeAndShape->type().kind()};
   return kind == context_.GetDefaultKind(category) ||
       (category == TypeCategory::Real &&
           kind == context_.doublePrecisionKind());
 }
 
 void CheckHelper::CheckSubprogram(
     const Symbol &symbol, const SubprogramDetails &details) {
-  if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
+  if (const Symbol *iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
     SubprogramMatchHelper{*this}.Check(symbol, *iface);
   }
-  if (const Scope * entryScope{details.entryScope()}) {
+  if (const Scope *entryScope{details.entryScope()}) {
     // ENTRY 15.6.2.6, esp. C1571
     std::optional<parser::MessageFixedText> error;
     const Symbol *subprogram{entryScope->symbol()};
     const SubprogramDetails *subprogramDetails{nullptr};
     if (subprogram) {
       subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
     }
     if (!(entryScope->parent().IsGlobal() || entryScope->parent().IsModule() ||
if (details.isDummy()) {
       for (const Symbol *dummy : details.dummyArgs()) {
         if (!dummy) { // C15100
           messages_.Say(
               "An ELEMENTAL subroutine may not have an alternate return dummy argument"_err_en_US);
         }
       }
     }
   }
-  if (details.isInterface() && !details.isDummy() && details.isFunction() &&
+  if (details.isInterface()) {
+    if (!details.isDummy() && details.isFunction() &&
         IsAssumedLengthCharacter(details.result())) { // C721
       messages_.Say(details.result().name(),
           "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US);
     }
   }
+  CheckLocalVsGlobal(symbol);
+}
+
+void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
+  if (IsProcedure(symbol) && IsExternal(symbol)) {
+    if (const Symbol *global{FindGlobal(symbol)}; global && global != &symbol) {
+      std::string interfaceName{symbol.name().ToString()};
+      if (const auto *bind{symbol.GetBindName()}) {
+        interfaceName = *bind;
+      }
+      std::string definitionName{global->name().ToString()};
+      if (const auto *bind{global->GetBindName()}) {
+        definitionName = *bind;
+      }
+      if (interfaceName == definitionName) {
+        parser::Message *msg{nullptr};
+        if (!IsProcedure(*global)) {
+          if (symbol.flags().test(Symbol::Flag::Function) ||
+              symbol.flags().test(Symbol::Flag::Subroutine)) {
+            msg = messages_.Say(
+                "The global entity '%s' corresponding to the local procedure '%s' is not a callable subprogram"_err_en_US,
+                global->name(), symbol.name());
+          }
+        } else if (auto chars{Characterize(symbol)}) {
+          if (auto globalChars{Characterize(*global)}) {
+            if (chars->HasExplicitInterface()) {
+              std::string whyNot;
+              if (!chars->IsCompatibleWith(*globalChars, &whyNot)) {
+                msg = messages_.Say(
+                    "The global subprogram '%s' is not compatible with its local procedure declaration (%s)"_warn_en_US,
+                    global->name(), whyNot);
+              }
+            } else if (!globalChars->CanBeCalledViaImplicitInterface()) {
+              msg = messages_.Say(
+                  "The global subprogram '%s' may not be referenced via the implicit interface '%s'"_err_en_US,
+                  global->name(), symbol.name());
+            }
+          }
+        }
+        evaluate::AttachDeclaration(msg, *global);
+        evaluate::AttachDeclaration(msg, symbol);
+      }
+    }
+  }
+}
 
 void CheckHelper::CheckDerivedType(
     const Symbol &derivedType, const DerivedTypeDetails &details) {
   if (details.isForwardReferenced() && !context_.HasError(derivedType)) {
     messages_.Say("The derived type '%s' has not been defined"_err_en_US,
         derivedType.name());
   }
   const Scope *scope{derivedType.scope()};
   if (!scope) {
     CHECK(details.isForwardReferenced());
     return;
   }
   CHECK(scope->symbol() == &derivedType);
   CHECK(scope->IsDerivedType());
   if (derivedType.attrs().test(Attr::ABSTRACT) && // C734
       (derivedType.attrs().test(Attr::BIND_C) || details.sequence())) {
     messages_.Say("An ABSTRACT derived type must be extensible"_err_en_US);
   }
-  if (const DeclTypeSpec * parent{FindParentTypeSpec(derivedType)}) {
+  if (const DeclTypeSpec *parent{FindParentTypeSpec(derivedType)}) {
     const DerivedTypeSpec *parentDerived{parent->AsDerived()};
     if (!IsExtensibleType(parentDerived)) { // C705
       messages_.Say("The parent type is not extensible"_err_en_US);
     }
     if (!derivedType.attrs().test(Attr::ABSTRACT) && parentDerived &&
         parentDerived->typeSymbol().attrs().test(Attr::ABSTRACT)) {
       ScopeComponentIterator components{*parentDerived};
       for (const Symbol &component : components) {
SayWithDeclaration(subroutine, finalName,
         "FINAL subroutine '%s' of derived type '%s' must have a single dummy argument"_err_en_US,
         subroutine.name(), derivedType.name());
     return false;
   }
   const auto &arg{proc->dummyArguments[0]};
   const Symbol *errSym{&subroutine};
   if (const auto *details{subroutine.detailsIf<SubprogramDetails>()}) {
     if (!details->dummyArgs().empty()) {
-      if (const Symbol * argSym{details->dummyArgs()[0]}) {
+      if (const Symbol *argSym{details->dummyArgs()[0]}) {
         errSym = argSym;
       }
     }
   }
   const auto *ddo{std::get_if<DummyDataObject>(&arg.u)};
   if (!ddo) {
     SayWithDeclaration(subroutine, finalName,
         "FINAL subroutine '%s' of derived type '%s' must have a single dummy argument that is a data object"_err_en_US,

 void CheckHelper::CheckSpecificsAreDistinguishable(
     const Symbol &generic, const GenericDetails &details) {
   GenericKind kind{details.kind()};
   if (!kind.IsName()) {
     return;
   }
   DistinguishabilityHelper helper{context_};
   for (const Symbol &specific : details.specificProcs()) {
-    if (const Procedure * procedure{Characterize(specific)}) {
+    if (const Procedure *procedure{Characterize(specific)}) {
       if (procedure->HasExplicitInterface()) {
         helper.Add(generic, kind, specific, *procedure);
       } else {
         if (auto *msg{messages_.Say(specific.name(),
                 "Specific procedure '%s' of generic interface '%s' must have an explicit interface"_err_en_US,
                 specific.name(), generic.name())}) {
           msg->Attach(
               generic.name(), "Definition of '%s'"_en_US, generic.name());

 // C760 constraints on the passed-object dummy argument
 // C757 constraints on procedure pointer components
 void CheckHelper::CheckPassArg(
     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 };
+  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,
         name);
     return;
   }
   const auto *subprogram{interface->detailsIf<SubprogramDetails>()};
   if (!subprogram) {
void CheckHelper::CheckPassArg(
   }
 }
 
 void CheckHelper::CheckProcBinding(
     const Symbol &symbol, const ProcBindingDetails &binding) {
   const Scope &dtScope{symbol.owner()};
   CHECK(dtScope.kind() == Scope::Kind::DerivedType);
   if (symbol.attrs().test(Attr::DEFERRED)) {
-    if (const Symbol * dtSymbol{dtScope.symbol()}) {
+    if (const Symbol *dtSymbol{dtScope.symbol()}) {
       if (!dtSymbol->attrs().test(Attr::ABSTRACT)) { // C733
         SayWithDeclaration(*dtSymbol,
             "Procedure bound to non-ABSTRACT derived type '%s' may not be DEFERRED"_err_en_US,
             dtSymbol->name());
       }
     }
     if (symbol.attrs().test(Attr::NON_OVERRIDABLE)) {
       messages_.Say(
           "Type-bound procedure '%s' may not be both DEFERRED and NON_OVERRIDABLE"_err_en_US,
           symbol.name());
     }
   }
   if (binding.symbol().attrs().test(Attr::INTRINSIC) &&
       !context_.intrinsics().IsSpecificIntrinsicFunction(
           binding.symbol().name().ToString())) {
     messages_.Say(
         "Intrinsic procedure '%s' is not a specific intrinsic permitted for use in the definition of binding '%s'"_err_en_US,
         binding.symbol().name(), symbol.name());
   }
-  if (const Symbol * overridden{FindOverriddenBinding(symbol)}) {
+  if (const Symbol *overridden{FindOverriddenBinding(symbol)}) {
     if (overridden->attrs().test(Attr::NON_OVERRIDABLE)) {
       SayWithDeclaration(*overridden,
           "Override of NON_OVERRIDABLE '%s' is not permitted"_err_en_US,
           symbol.name());
     }
     if (const auto *overriddenBinding{
             overridden->detailsIf<ProcBindingDetails>()}) {
       if (!IsPureProcedure(symbol) && IsPureProcedure(*overridden)) {
if (const Symbol *overridden{FindOverriddenBinding(symbol)}) {
     }
   }
   CheckPassArg(symbol, &binding.symbol(), binding);
 }
 
 void CheckHelper::Check(const Scope &scope) {
   scope_ = &scope;
   common::Restorer<const Symbol *> restorer{innermostSymbol_, innermostSymbol_};
-  if (const Symbol * symbol{scope.symbol()}) {
+  if (const Symbol *symbol{scope.symbol()}) {
     innermostSymbol_ = symbol;
   }
   if (scope.IsParameterizedDerivedTypeInstantiation()) {
     auto restorer{common::ScopedSet(scopeIsUninstantiatedPDT_, false)};
     auto restorer2{context_.foldingContext().messages().SetContext(
         scope.instantiationContext().get())};
     for (const auto &pair : scope) {
       CheckPointerInitialization(*pair.second);

 void CheckHelper::CheckGenericOps(const Scope &scope) {
   DistinguishabilityHelper helper{context_};
   auto addSpecifics{[&](const Symbol &generic) {
     const auto *details{generic.GetUltimate().detailsIf<GenericDetails>()};
     if (!details) {
       // Not a generic; ensure characteristics are defined if a function.
       auto restorer{messages_.SetLocation(generic.name())};
       if (IsFunction(generic) && !context_.HasError(generic)) {
-        if (const Symbol * result{FindFunctionResult(generic)};
+        if (const Symbol *result{FindFunctionResult(generic)};
             result && !context_.HasError(*result)) {
           Characterize(generic);
         }
       }
       return;
     }
     GenericKind kind{details->kind()};
     if (!kind.IsAssignment() && !kind.IsOperator()) {
       return;
     }
     const SymbolVector &specifics{details->specificProcs()};
     const std::vector<SourceName> &bindingNames{details->bindingNames()};
     for (std::size_t i{0}; i < specifics.size(); ++i) {
       const Symbol &specific{*specifics[i]};
       auto restorer{messages_.SetLocation(bindingNames[i])};
-      if (const Procedure * proc{Characterize(specific)}) {
+      if (const Procedure *proc{Characterize(specific)}) {
         if (kind.IsAssignment()) {
           if (!CheckDefinedAssignment(specific, *proc)) {
             continue;
           }
         } else {
           if (!CheckDefinedOperator(generic.name(), kind, specific, *proc)) {
             continue;
           }
         }
         helper.Add(generic, kind, specific, *proc);
       }
     }
   }};
   for (const auto &pair : scope) {
     const Symbol &symbol{*pair.second};
     addSpecifics(symbol);
     const Symbol &ultimate{symbol.GetUltimate()};
     if (ultimate.has<DerivedTypeDetails>()) {
-      if (const Scope * typeScope{ultimate.scope()}) {
+      if (const Scope *typeScope{ultimate.scope()}) {
         for (const auto &pair2 : *typeScope) {
           addSpecifics(*pair2.second);
         }
       }
     }
   }
   helper.Check(scope);
 }
void CheckHelper::CheckBindC(const Symbol &symbol) {
   }
   CheckConflicting(symbol, Attr::BIND_C, Attr::PARAMETER);
   CheckConflicting(symbol, Attr::BIND_C, Attr::ELEMENTAL);
   if (symbol.has<ObjectEntityDetails>() && !symbol.owner().IsModule()) {
     messages_.Say(symbol.name(),
         "A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
     context_.SetError(symbol);
   }
-  if (const std::string * name{DefinesBindCName(symbol)}) {
+  if (const std::string *name{DefinesBindCName(symbol)}) {
     auto pair{bindC_.emplace(*name, symbol)};
     if (!pair.second) {
       const Symbol &other{*pair.first->second};
       if (symbol.has<CommonBlockDetails>() && other.has<CommonBlockDetails>() &&
           symbol.name() == other.name()) {
         // Two common blocks can have the same BIND(C) name so long as
         // they're not in the same scope.
       } else if (!context_.HasError(other)) {
for (TypeWithDefinedIo definedIoType : seenDefinedIoTypes_) {
     }
   }
   seenDefinedIoTypes_.emplace_back(
       TypeWithDefinedIo{derivedType, ioKind, proc, generic});
 }
 
 void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
     GenericKind::DefinedIo ioKind, const Symbol &generic) {
-  if (const DeclTypeSpec * type{arg.GetType()}) {
-    if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
+  if (const DeclTypeSpec *type{arg.GetType()}) {
+    if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
       CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
       bool isPolymorphic{type->IsPolymorphic()};
       if (isPolymorphic != IsExtensibleType(derivedType)) {
         messages_.Say(arg.name(),
             "Dummy argument '%s' of a defined input/output procedure must be %s when the derived type is %s"_err_en_US,
             arg.name(), isPolymorphic ? "TYPE()" : "CLASS()",
             isPolymorphic ? "not extensible" : "extensible");
       }
     } else {
       messages_.Say(arg.name(),
           "Dummy argument '%s' of a defined input/output procedure must have a"
           " derived type"_err_en_US,
           arg.name());
     }
   }
 }
 
 void CheckHelper::CheckDioDummyIsDefaultInteger(
     const Symbol &subp, const Symbol &arg) {
-  if (const DeclTypeSpec * type{arg.GetType()};
+  if (const DeclTypeSpec *type{arg.GetType()};
       type && type->IsNumeric(TypeCategory::Integer)) {
     if (const auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
         kind && *kind == context_.GetDefaultKind(TypeCategory::Integer)) {
       return;
     }
   }
   messages_.Say(arg.name(),
       "Dummy argument '%s' of a defined input/output procedure"

flang/lib/Semantics/expression.cpp

std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
   } else {
     return GetCharLength();
   }
 }
 
 static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
     const std::optional<parser::TypeSpec> &spec) {
   if (spec) {
-    if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
+    if (const semantics::DeclTypeSpec *typeSpec{spec->declTypeSpec}) {
       // Name resolution sets TypeSpec::declTypeSpec only when it's valid
       // (viz., an intrinsic type with valid known kind or a non-polymorphic
       // & non-ABSTRACT derived type).
-      if (const semantics::IntrinsicTypeSpec *
-          intrinsic{typeSpec->AsIntrinsic()}) {
+      if (const semantics::IntrinsicTypeSpec *intrinsic{
+              typeSpec->AsIntrinsic()}) {
         TypeCategory category{intrinsic->category()};
         if (auto optKind{ToInt64(intrinsic->kind())}) {
           int kind{static_cast<int>(*optKind)};
           if (category == TypeCategory::Character) {
             const semantics::CharacterTypeSpec &cts{
                 typeSpec->characterTypeSpec()};
             const semantics::ParamValue &len{cts.length()};
             // N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
             // type guards, but not in array constructors.
             return DynamicTypeWithLength{DynamicType{kind, len}};
           } else {
             return DynamicTypeWithLength{DynamicType{category, kind}};
           }
         }
-      } else if (const semantics::DerivedTypeSpec *
-          derived{typeSpec->AsDerived()}) {
+      } else if (const semantics::DerivedTypeSpec *derived{
+                     typeSpec->AsDerived()}) {
         return DynamicTypeWithLength{DynamicType{*derived}};
       }
     }
   }
   return std::nullopt;
 }
 
 // Utilities to set a source location, if we have one, on an actual argument,
if (subscripts == 0) {
     if (symbolRank != 0) {
       Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US,
           symbolRank, symbol.name(), subscripts);
     }
     return std::nullopt;
   } else if (const auto *object{
                  symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     // C928 & C1002
-    if (Triplet * last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
+    if (Triplet *last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
       if (!last->upper() && object->IsAssumedSize()) {
         Say("Assumed-size array '%s' must have explicit final "
             "subscript upper bound value"_err_en_US,
             symbol.name());
         return std::nullopt;
       }
     }
   } else {
static std::optional<parser::Substring> FixMisparsedSubstringDataRef(
   if (auto *ae{
           std::get_if<common::Indirection<parser::ArrayElement>>(&dataRef.u)}) {
     // ...%a(j:k) and "a" is a character scalar
     parser::ArrayElement &arrElement{ae->value()};
     if (arrElement.subscripts.size() == 1) {
       if (auto *triplet{std::get_if<parser::SubscriptTriplet>(
               &arrElement.subscripts.front().u)}) {
         if (!std::get<2 /*stride*/>(triplet->t).has_value()) {
-          if (const Symbol *
-              symbol{parser::GetLastName(arrElement.base).symbol}) {
+          if (const Symbol *symbol{
+                  parser::GetLastName(arrElement.base).symbol}) {
             const Symbol &ultimate{symbol->GetUltimate()};
-            if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
+            if (const semantics::DeclTypeSpec *type{ultimate.GetType()}) {
               if (!ultimate.IsObjectArray() &&
                   type->category() == semantics::DeclTypeSpec::Character) {
                 // The ambiguous S(j:k) was parsed as an array section
                 // reference, but it's now clear that it's a substring.
                 // Fix the parse tree in situ.
                 return arrElement.ConvertToSubstring();
               }
             }
if (context_.HasError(n.symbol)) { // includes case of no symbol
     const Symbol &ultimate{n.symbol->GetUltimate()};
     if (ultimate.has<semantics::TypeParamDetails>()) {
       // A bare reference to a derived type parameter (within a parameterized
       // derived type definition)
       return Fold(ConvertToType(
           ultimate, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));
     } else {
       if (n.symbol->attrs().test(semantics::Attr::VOLATILE)) {
-        if (const semantics::Scope *
-            pure{semantics::FindPureProcedureContaining(
+        if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
                 context_.FindScope(n.source))}) {
           SayAt(n,
               "VOLATILE variable '%s' may not be referenced in pure subprogram '%s'"_err_en_US,
               n.source, DEREF(pure->symbol()).name());
           n.symbol->attrs().reset(semantics::Attr::VOLATILE);
         }
       }
       if (!isWholeAssumedSizeArrayOk_ &&
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayElement &ae) {
   {
     auto restorer{AllowWholeAssumedSizeArray()};
     baseExpr = Analyze(ae.base);
   }
   if (baseExpr) {
     if (ae.subscripts.empty()) {
       // will be converted to function call later or error reported
     } else if (baseExpr->Rank() == 0) {
-      if (const Symbol * symbol{GetLastSymbol(*baseExpr)}) {
+      if (const Symbol *symbol{GetLastSymbol(*baseExpr)}) {
         if (!context_.HasError(symbol)) {
           if (inDataStmtConstant_) {
             // Better error for NULL(X) with a MOLD= argument
             Say("'%s' must be an array or structure constructor if used with non-empty parentheses as a DATA statement constant"_err_en_US,
                 symbol->name());
           } else {
             Say("'%s' is not an array"_err_en_US, symbol->name());
           }

 std::optional<Component> ExpressionAnalyzer::CreateComponent(
     DataRef &&base, const Symbol &component, const semantics::Scope &scope) {
   if (IsAllocatableOrPointer(component) && base.Rank() > 0) { // C919b
     Say("An allocatable or pointer component reference must be applied to a scalar base"_err_en_US);
   }
   if (&component.owner() == &scope) {
     return Component{std::move(base), component};
   }
-  if (const Symbol * typeSymbol{scope.GetSymbol()}) {
-    if (const Symbol *
-        parentComponent{typeSymbol->GetParentComponent(&scope)}) {
+  if (const Symbol *typeSymbol{scope.GetSymbol()}) {
+    if (const Symbol *parentComponent{typeSymbol->GetParentComponent(&scope)}) {
       if (const auto *object{
               parentComponent->detailsIf<semantics::ObjectEntityDetails>()}) {
         if (const auto *parentType{object->type()}) {
-          if (const semantics::Scope *
-              parentScope{parentType->derivedTypeSpec().scope()}) {
+          if (const semantics::Scope *parentScope{
+                  parentType->derivedTypeSpec().scope()}) {
             return CreateComponent(
                 DataRef{Component{std::move(base), *parentComponent}},
                 component, *parentScope);
           }
         }
       }
     }
   }

 MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
   if (auto maybeDataRef{ExtractDataRef(Analyze(x.base))}) {
     DataRef *dataRef{&*maybeDataRef};
     std::vector<Subscript> subscripts;
     SymbolVector reversed;
     if (auto *aRef{std::get_if<ArrayRef>(&dataRef->u)}) {
       subscripts = std::move(aRef->subscript());
       reversed.push_back(aRef->GetLastSymbol());
-      if (Component * component{aRef->base().UnwrapComponent()}) {
+      if (Component *component{aRef->base().UnwrapComponent()}) {
         dataRef = &component->base();
       } else {
         dataRef = nullptr;
       }
     }
     if (dataRef) {
       while (auto *component{std::get_if<Component>(&dataRef->u)}) {
         reversed.push_back(component->GetLastSymbol());
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
   return acContext.ToExpr();
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::StructureConstructor &structure) {
   auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
   parser::Name structureType{std::get<parser::Name>(parsedType.t)};
   parser::CharBlock &typeName{structureType.source};
-  if (semantics::Symbol * typeSymbol{structureType.symbol}) {
+  if (semantics::Symbol *typeSymbol{structureType.symbol}) {
     if (typeSymbol->has<semantics::DerivedTypeDetails>()) {
       semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()};
       if (!CheckIsValidForwardReference(dtSpec)) {
         return std::nullopt;
       }
     }
   }
   if (!parsedType.derivedTypeSpec) {
if (symbol) {
       unavailable.insert(symbol->name());
       if (value) {
         const auto &innermost{context_.FindScope(expr.source)};
         if (symbol->has<semantics::ProcEntityDetails>()) {
           CHECK(IsPointer(*symbol));
         } else if (symbol->has<semantics::ObjectEntityDetails>()) {
           // C1594(4)
           if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
-            if (const Symbol * pointer{FindPointerComponent(*symbol)}) {
-              if (const Symbol *
-                  object{FindExternallyVisibleObject(*value, *pureProc)}) {
+            if (const Symbol *pointer{FindPointerComponent(*symbol)}) {
+              if (const Symbol *object{
+                      FindExternallyVisibleObject(*value, *pureProc)}) {
                 if (auto *msg{Say(expr.source,
                         "Externally visible object '%s' may not be "
                         "associated with pointer component '%s' in a "
                         "pure procedure"_err_en_US,
                         object->name(), pointer->name())}) {
                   msg->Attach(object->name(), "Object declaration"_en_US)
                       .Attach(pointer->name(), "Pointer declaration"_en_US);
                 }
return common::visit(
         }
       },
       proc.details());
 }
 
 static int GetPassIndex(const Symbol &proc) {
   CHECK(!proc.attrs().test(semantics::Attr::NOPASS));
   std::optional<parser::CharBlock> passName{GetPassName(proc)};
-  const auto *interface { semantics::FindInterface(proc) };
+  const auto *interface {
+    semantics::FindInterface(proc)
+  };
   if (!passName || !interface) {
     return 0; // first argument is passed-object
   }
   const auto &subp{interface->get<semantics::SubprogramDetails>()};
   int index{0};
   for (const auto *arg : subp.dummyArgs()) {
     if (arg && arg->name() == passName) {
       return index;
static const Symbol *GetBindingResolution(
   return &binding->symbol();
 }
 
 auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
     const parser::ProcComponentRef &pcr, ActualArguments &&arguments,
     bool isSubroutine) -> std::optional<CalleeAndArguments> {
   const parser::StructureComponent &sc{pcr.v.thing};
   if (MaybeExpr base{Analyze(sc.base)}) {
-    if (const Symbol * sym{sc.component.symbol}) {
+    if (const Symbol *sym{sc.component.symbol}) {
       if (context_.HasError(sym)) {
         return std::nullopt;
       }
       if (!IsProcedure(*sym)) {
         AttachDeclaration(
             Say(sc.component.source, "'%s' is not a procedure"_err_en_US,
                 sc.component.source),
             *sym);
if (const Symbol *sym{sc.component.symbol}) {
             EmitGenericResolutionError(*sc.component.symbol, pair.second);
             return std::nullopt;
           }
         }
         std::optional<DataRef> dataRef{ExtractDataRef(std::move(*dtExpr))};
         if (dataRef && !CheckDataRef(*dataRef)) {
           return std::nullopt;
         }
-        if (const Symbol *
-            resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) {
+        if (const Symbol *resolution{
+                GetBindingResolution(dtExpr->GetType(), *sym)}) {
           AddPassArg(arguments, std::move(*dtExpr), *sym, false);
           return CalleeAndArguments{
               ProcedureDesignator{*resolution}, std::move(arguments)};
         } else if (dataRef.has_value()) {
           if (sym->attrs().test(semantics::Attr::NOPASS)) {
             return CalleeAndArguments{
                 ProcedureDesignator{Component{std::move(*dataRef), *sym}},
                 std::move(arguments)};
if (const auto *details{ultimate.detailsIf<semantics::GenericDetails>()}) {
     }
     if (nonElemental) {
       return {&AccessSpecific(symbol, *nonElemental), false};
     } else if (elemental) {
       return {&AccessSpecific(symbol, *elemental), false};
     }
     // Check parent derived type
     if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
-      if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
+      if (const Symbol *extended{parentScope->FindComponent(symbol.name())}) {
         auto pair{ResolveGeneric(
             *extended, actuals, adjustActuals, isSubroutine, false)};
         if (pair.first) {
           return pair;
         }
       }
     }
     if (mightBeStructureConstructor && details->derivedType()) {
       return {details->derivedType(), false};
     }
   }
   // Check for generic or explicit INTRINSIC of the same name in outer scopes.
   // See 15.5.5.2 for details.
   if (!symbol.owner().IsGlobal() && !symbol.owner().IsDerivedType()) {
     for (const std::string &n : GetAllNames(context_, symbol.name())) {
-      if (const Symbol * outer{symbol.owner().parent().FindSymbol(n)}) {
+      if (const Symbol *outer{symbol.owner().parent().FindSymbol(n)}) {
         auto pair{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
             mightBeStructureConstructor)};
         if (pair.first) {
           return pair;
         }
       }
     }
   }
if (const auto *dataRef{
         return AssumedTypeDummy(*name);
       }
     }
   }
   return nullptr;
 }
 template <>
 const Symbol *AssumedTypeDummy<parser::Name>(const parser::Name &name) {
-  if (const Symbol * symbol{name.symbol}) {
+  if (const Symbol *symbol{name.symbol}) {
     if (const auto *type{symbol->GetType()}) {
       if (type->category() == semantics::DeclTypeSpec::TypeStar) {
         return symbol;
       }
     }
   }
   return nullptr;
 }
static bool IsExternalCalledImplicitly(
   } else {
     return false;
   }
 }
 
 std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
     parser::CharBlock callSite, const ProcedureDesignator &proc,
     ActualArguments &arguments) {
+  bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
+  const Symbol *procSymbol{proc.GetSymbol()};
   auto chars{characteristics::Procedure::Characterize(
       proc, context_.foldingContext())};
+  bool ok{true};
   if (chars) {
-    bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
     if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
       Say(callSite,
           "References to the procedure '%s' require an explicit interface"_err_en_US,
-          DEREF(proc.GetSymbol()).name());
+          DEREF(procSymbol).name());
     }
     // Checks for ASSOCIATED() are done in intrinsic table processing
     const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
     bool procIsAssociated{
         specificIntrinsic && specificIntrinsic->name == "associated"};
     if (!procIsAssociated) {
-      const Symbol *procSymbol{proc.GetSymbol()};
       bool procIsDummy{procSymbol && IsDummy(*procSymbol)};
       if (chars->functionResult &&
           chars->functionResult->IsAssumedLengthCharacter() &&
           !specificIntrinsic && !procIsDummy) {
         Say(callSite,
             "Assumed-length character function must be defined with a length to be called"_err_en_US);
       }
-      semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
+      ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
           context_.FindScope(callSite), treatExternalAsImplicit,
           specificIntrinsic);
       if (procSymbol && !IsPureProcedure(*procSymbol)) {
-        if (const semantics::Scope *
-            pure{semantics::FindPureProcedureContaining(
+        if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
                 context_.FindScope(callSite))}) {
           Say(callSite,
               "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
               procSymbol->name(), DEREF(pure->symbol()).name());
         }
       }
     }
   }
+  if (ok && !treatExternalAsImplicit && procSymbol &&
+      !(chars && chars->HasExplicitInterface())) {
+    if (const Symbol *global{FindGlobal(*procSymbol)};
+        global && global != procSymbol && IsProcedure(*global)) {
+      // Check a known global definition behind a local interface
+      if (auto globalChars{characteristics::Procedure::Characterize(
+              *global, context_.foldingContext())}) {
+        semantics::CheckArguments(*globalChars, arguments, GetFoldingContext(),
+            context_.FindScope(callSite), true,
+            nullptr /*not specific intrinsic*/);
+      }
+    }
+  }
   return chars;
 }
 
 // Unary operations
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
   if (MaybeExpr operand{Analyze(x.v.value())}) {
-    if (const semantics::Symbol * symbol{GetLastSymbol(*operand)}) {
-      if (const semantics::Symbol * result{FindFunctionResult(*symbol)}) {
+    if (const semantics::Symbol *symbol{GetLastSymbol(*operand)}) {
+      if (const semantics::Symbol *result{FindFunctionResult(*symbol)}) {
         if (semantics::IsProcedurePointer(*result)) {
           Say("A function reference that returns a procedure "
               "pointer may not be parenthesized"_err_en_US); // C1003
         }
       }
     }
     return Parenthesize(std::move(*operand));
   }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
   // Represent %LOC() exactly as if it had been a call to the LOC() extension
   // intrinsic function.
   // Use the actual source for the name of the call for error reporting.
   std::optional<ActualArgument> arg;
-  if (const Symbol * assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
+  if (const Symbol *assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
     arg = ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
   } else if (MaybeExpr argExpr{Analyze(x.v.value())}) {
     arg = ActualArgument{std::move(*argExpr)};
   } else {
     return std::nullopt;
   }
   parser::CharBlock at{GetContextualMessages().at()};
   CHECK(at.size() >= 4);
static bool CheckFuncRefToArrayElement(semantics::SemanticsContext &context,
   auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
   const auto *name{std::get_if<parser::Name>(&proc.u)};
   if (!name) {
     name = &std::get<parser::ProcComponentRef>(proc.u).v.thing.component;
   }
   if (!name->symbol) {
     return false;
   } else if (name->symbol->Rank() == 0) {
-    if (const Symbol *
-        function{
+    if (const Symbol *function{
             semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)}) {
       auto &msg{context.Say(funcRef.v.source,
           "Recursive call to '%s' requires a distinct RESULT in its declaration"_err_en_US,
           name->source)};
       AttachDeclaration(&msg, *function);
       name->symbol = const_cast<Symbol *>(function);
     }
     return false;
static void FixMisparsedFunctionReference(
     semantics::SemanticsContext &context, const std::variant<A...> &constU) {
   // The parse tree is updated in situ when resolving an ambiguous parse.
   using uType = std::decay_t<decltype(constU)>;
   auto &u{const_cast<uType &>(constU)};
   if (auto *func{
           std::get_if<common::Indirection<parser::FunctionReference>>(&u)}) {
     parser::FunctionReference &funcRef{func->value()};
     auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
-    if (Symbol *
-        origSymbol{
+    if (Symbol *origSymbol{
             common::visit(common::visitors{
                               [&](parser::Name &name) { return name.symbol; },
                               [&](parser::ProcComponentRef &pcr) {
                                 return pcr.v.thing.component.symbol;
                               },
                           },
                 proc.u)}) {
       Symbol &symbol{origSymbol->GetUltimate()};
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
     ProcedureDesignator &&proc, ActualArguments &&arguments) {
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&proc.u)}) {
     if (intrinsic->characteristics.value().attrs.test(
             characteristics::Procedure::Attr::NullPointer) &&
         arguments.empty()) {
       return Expr<SomeType>{NullPointer{}};
     }
   }
-  if (const Symbol * symbol{proc.GetSymbol()}) {
+  if (const Symbol *symbol{proc.GetSymbol()}) {
     if (!ResolveForward(*symbol)) {
       return std::nullopt;
     }
   }
   if (auto chars{CheckCall(callSite, proc, arguments)}) {
     if (chars->functionResult) {
       const auto &result{*chars->functionResult};
       if (result.IsProcedurePointer()) {
if (!definedOpSymbolPtr) {
     definedOpSymbolPtr = &localDefinedOpSymbolPtr;
   }
   {
     auto restorer{context_.GetContextualMessages().DiscardMessages()};
     std::string oprNameString{
         isUserOp ? std::string{opr} : "operator("s + opr + ')'};
     parser::CharBlock oprName{oprNameString};
     const auto &scope{context_.context().FindScope(source_)};
-    if (Symbol * symbol{scope.FindSymbol(oprName)}) {
+    if (Symbol *symbol{scope.FindSymbol(oprName)}) {
       *definedOpSymbolPtr = symbol;
       parser::Name name{symbol->name(), symbol};
       if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
         return result;
       }
     }
     for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
-      if (const Symbol *
-          symbol{FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) {
+      if (const Symbol *symbol{
+              FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) {
         if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
           return result;
         }
       }
     }
   }
   if (*definedOpSymbolPtr) {
     SayNoMatch(ToUpperCase((*definedOpSymbolPtr)->name().ToString()));

 }
 
 std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
   auto restorer{context_.GetContextualMessages().DiscardMessages()};
   std::string oprNameString{"assignment(=)"};
   parser::CharBlock oprName{oprNameString};
   const Symbol *proc{nullptr};
   const auto &scope{context_.context().FindScope(source_)};
-  if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
+  if (const Symbol *symbol{scope.FindSymbol(oprName)}) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
     auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)};
     if (pair.first) {
       proc = pair.first;
     } else {
       context_.EmitGenericResolutionError(*symbol, pair.second);
     }
   }
   int passedObjectIndex{-1};
   const Symbol *definedOpSymbol{nullptr};
   for (std::size_t i{0}; i < actuals_.size(); ++i) {
-    if (const Symbol * specific{FindBoundOp(oprName, i, definedOpSymbol)}) {
-      if (const Symbol *
-          resolution{GetBindingResolution(GetType(i), *specific)}) {
+    if (const Symbol *specific{FindBoundOp(oprName, i, definedOpSymbol)}) {
+      if (const Symbol *resolution{
+              GetBindingResolution(GetType(i), *specific)}) {
         proc = resolution;
       } else {
         proc = specific;
         passedObjectIndex = i;
       }
     }
   }
   if (!proc) {
     return std::nullopt;
   }
   ActualArguments actualsCopy{actuals_};
   if (passedObjectIndex >= 0) {
     actualsCopy[passedObjectIndex]->set_isPassedObject();
   }
   return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
 }
 
 void ArgumentAnalyzer::Dump(llvm::raw_ostream &os) {
   os << "source_: " << source_.ToString() << " fatalErrors_ = " << fatalErrors_
      << '\n';
   for (const auto &actual : actuals_) {
     if (!actual.has_value()) {
       os << "- error\n";
-    } else if (const Symbol * symbol{actual->GetAssumedTypeDummy()}) {
+    } else if (const Symbol *symbol{actual->GetAssumedTypeDummy()}) {
       os << "- assumed type: " << symbol->name().ToString() << '\n';
     } else if (const Expr<SomeType> *expr{actual->UnwrapExpr()}) {
       expr->AsFortran(os << "- expr: ") << '\n';
     } else {
       DIE("bad ActualArgument");
     }
   }
 }
 
 std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
     const parser::Expr &expr) {
   source_.ExtendToCover(expr.source);
-  if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
+  if (const Symbol *assumedTypeDummy{AssumedTypeDummy(expr)}) {
     expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
     if (isProcedureCall_) {
       ActualArgument arg{ActualArgument::AssumedType{*assumedTypeDummy}};
       SetArgSourceLocation(arg, expr.source);
       return std::move(arg);
     }
     context_.SayAt(expr.source,
         "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);

flang/lib/Semantics/symbol.cpp

return common::visit(
           [](const CommonBlockDetails &) { return "CommonBlockDetails"; },
           [](const TypeParamDetails &) { return "TypeParam"; },
           [](const MiscDetails &) { return "Misc"; },
           [](const AssocEntityDetails &) { return "AssocEntity"; },
       },
       details);
 }
 
-const std::string Symbol::GetDetailsName() const {
-  return DetailsToString(details_);
-}
+std::string Symbol::GetDetailsName() const { return DetailsToString(details_); }
 
 void Symbol::set_details(Details &&details) {
   CHECK(CanReplaceDetails(details));
   details_ = std::move(details);
 }
 
 bool Symbol::CanReplaceDetails(const Details &details) const {
   if (has<UnknownDetails>()) {

flang/lib/Semantics/tools.cpp

if (const DeclTypeSpec * parentType{FindParentTypeSpec(symbol.owner())}) {
           return parentScope->FindComponent(symbol.name());
         }
       }
     }
   }
   return nullptr;
 }
 
+const Symbol *FindGlobal(const Symbol &original) {
+  const Symbol &ultimate{original.GetUltimate()};
+  if (ultimate.owner().IsGlobal()) {
+    return &ultimate;
+  }
+  bool isLocal{false};
+  if (IsDummy(ultimate)) {
+  } else if (IsPointer(ultimate)) {
+  } else if (ultimate.has<ProcEntityDetails>()) {
+    isLocal = IsExternal(ultimate);
+  } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
+    isLocal = subp->isInterface();
+  }
+  if (isLocal) {
+    const std::string *bind{ultimate.GetBindName()};
+    if (!bind || ultimate.name() == *bind) {
+      const Scope &globalScope{ultimate.owner().context().globalScope()};
+      if (auto iter{globalScope.find(ultimate.name())};
+          iter != globalScope.end()) {
+        const Symbol &global{*iter->second};
+        const std::string *globalBind{global.GetBindName()};
+        if (!globalBind || global.name() == *globalBind) {
+          return &global;
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
 const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &derived) {
   return FindParentTypeSpec(derived.typeSymbol());
 }
 
 const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &decl) {
   if (const DerivedTypeSpec * derived{decl.AsDerived()}) {
     return FindParentTypeSpec(*derived);
   } else {

flang/test/Semantics/global01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Catch discrepancies between a local interface and a global definition
+
+subroutine global1(x)
+  integer, intent(in) :: x
+end subroutine
+
+subroutine global2(x) bind(c,name="xyz")
+  integer, intent(in) :: x
+end subroutine
+
+subroutine global3(x)
+  integer, intent(in) :: x
+end subroutine
+
+pure subroutine global4(x)
+  integer, intent(in) :: x
+end subroutine
+
+subroutine global5(x)
+  integer, intent(in) :: x
+end subroutine
+
+program test
+  interface
+    !WARNING: The global subprogram 'global1' is not compatible with its local procedure declaration (incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4))
+    subroutine global1(x)
+      real, intent(in) :: x
+    end subroutine
+    subroutine global2(x)
+      real, intent(in) :: x
+    end subroutine
+    subroutine global3(x) bind(c,name="abc")
+      real, intent(in) :: x
+    end subroutine
+    subroutine global4(x) ! not PURE, but that's ok
+      integer, intent(in) :: x
+    end subroutine
+    !WARNING: The global subprogram 'global5' is not compatible with its local procedure declaration (incompatible procedure attributes: Pure)
+    pure subroutine global5(x)
+      integer, intent(in) :: x
+    end subroutine
+  end interface
+end
+

flang/test/Semantics/local-vs-global.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+module module_before_1
+end
+
+module module_before_2
+end
+
+block data block_data_before_1
+end
+
+block data block_data_before_2
+end
+
+subroutine explicit_before_1(a)
+  real, optional :: a
+end
+
+subroutine explicit_before_2(a)
+  real, optional :: a
+end
+
+subroutine implicit_before_1(a)
+  real :: a
+end
+
+subroutine implicit_before_2(a)
+  real :: a
+end
+
+function explicit_func_before_1(a)
+  real, optional :: a
+end
+
+function explicit_func_before_2(a)
+  real, optional :: a
+end
+
+function implicit_func_before_1(a)
+  real :: a
+end
+
+function implicit_func_before_2(a)
+  real :: a
+end
+
+program test
+  external justfine ! OK to name a BLOCK DATA if not called
+  !ERROR: The global entity 'module_before_1' corresponding to the local procedure 'module_before_1' is not a callable subprogram
+  external module_before_1
+  !ERROR: The global entity 'block_data_before_1' corresponding to the local procedure 'block_data_before_1' is not a callable subprogram
+  external block_data_before_1
+  !ERROR: The global subprogram 'explicit_before_1' may not be referenced via the implicit interface 'explicit_before_1'
+  external explicit_before_1
+  external implicit_before_1
+  !ERROR: The global subprogram 'explicit_func_before_1' may not be referenced via the implicit interface 'explicit_func_before_1'
+  external explicit_func_before_1
+  external implicit_func_before_1
+  !ERROR: The global entity 'module_after_1' corresponding to the local procedure 'module_after_1' is not a callable subprogram
+  external module_after_1
+  !ERROR: The global entity 'block_data_after_1' corresponding to the local procedure 'block_data_after_1' is not a callable subprogram
+  external block_data_after_1
+  !ERROR: The global subprogram 'explicit_after_1' may not be referenced via the implicit interface 'explicit_after_1'
+  external explicit_after_1
+  external implicit_after_1
+  !ERROR: The global subprogram 'explicit_func_after_1' may not be referenced via the implicit interface 'explicit_func_after_1'
+  external explicit_func_after_1
+  external implicit_func_after_1
+  call module_before_1
+  !ERROR: 'module_before_2' is not a callable procedure
+  call module_before_2
+  call block_data_before_1
+  !ERROR: 'block_data_before_2' is not a callable procedure
+  call block_data_before_2
+  call explicit_before_1(1.)
+  !ERROR: References to the procedure 'explicit_before_2' require an explicit interface
+  call explicit_before_2(1.)
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  call implicit_before_1
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  call implicit_before_2
+  print *, explicit_func_before_1(1.)
+  !ERROR: References to the procedure 'explicit_func_before_2' require an explicit interface
+  print *, explicit_func_before_2(1.)
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  print *, implicit_func_before_1()
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  print *, implicit_func_before_2()
+  call module_after_1
+  call module_after_2
+  call block_data_after_1
+  call block_data_after_2
+  call explicit_after_1(1.)
+  !ERROR: References to the procedure 'explicit_after_2' require an explicit interface
+  call explicit_after_2(1.)
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  call implicit_after_1
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  call implicit_after_2
+  print *, explicit_func_after_1(1.)
+  !ERROR: References to the procedure 'explicit_func_after_2' require an explicit interface
+  print *, explicit_func_after_2(1.)
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  print *, implicit_func_after_1()
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+  print *, implicit_func_after_2()
+end program
+
+block data justfine
+end
+
+module module_after_1
+end
+
+!ERROR: 'module_after_2' is already declared in this scoping unit
+module module_after_2
+end
+
+block data block_data_after_1
+end
+
+!ERROR: BLOCK DATA 'block_data_after_2' has been called
+block data block_data_after_2
+end
+
+subroutine explicit_after_1(a)
+  real, optional :: a
+end
+
+subroutine explicit_after_2(a)
+  real, optional :: a
+end
+
+subroutine implicit_after_1(a)
+  real :: a
+end
+
+subroutine implicit_after_2(a)
+  real :: a
+end
+
+function explicit_func_after_1(a)
+  real, optional :: a
+end
+
+function explicit_func_after_2(a)
+  real, optional :: a
+end
+
+function implicit_func_after_1(a)
+  real :: a
+end
+
+function implicit_func_after_2(a)
+  real :: a
+end

flang/test/Semantics/procinterface01.f90

  character function nested5(x)
   !REF: /module1/nested5/x
   real, intent(in) :: x
   !DEF: /module1/nested5/nested5 ObjectEntity CHARACTER(1_8,1)
   nested5 = "a"
  end function nested5
 end module module1
 
-!DEF: /explicit1 ELEMENTAL (Function) Subprogram REAL(4)
+!DEF: /explicit1 (Function) Subprogram REAL(4)
 !DEF: /explicit1/x INTENT(IN) ObjectEntity REAL(4)
-real elemental function explicit1(x)
+real function explicit1(x)
  !REF: /explicit1/x
  real, intent(in) :: x
  !DEF: /explicit1/explicit1 ObjectEntity REAL(4)
  !REF: /explicit1/x
  explicit1 = -x
 end function explicit1
 
 !DEF: /logical (Function) Subprogram INTEGER(4)
 !DEF: /logical/x INTENT(IN) ObjectEntity REAL(4)
 integer function logical(x)
  !REF: /logical/x
  real, intent(in) :: x
  !DEF: /logical/logical ObjectEntity INTEGER(4)
  !REF: /logical/x
  logical = x+3.
 end function logical
 
-!DEF: /tan (Function) Subprogram REAL(4)
+!DEF: /tan (Function) Subprogram CHARACTER(1_8,1)
 !DEF: /tan/x INTENT(IN) ObjectEntity REAL(4)
-real function tan(x)
+character*1 function tan(x)
  !REF: /tan/x
  real, intent(in) :: x
- !DEF: /tan/tan ObjectEntity REAL(4)
- !REF: /tan/x
- tan = x+5.
+ !DEF: /tan/tan ObjectEntity CHARACTER(1_8,1)
+ tan = "?"
 end function tan
 
 !DEF: /main MainProgram
 program main
  !REF: /module1
  use :: module1
  !DEF: /main/derived1 Use
  !DEF: /main/instance ObjectEntity TYPE(derived1)

flang/test/Semantics/resolve102.f90

function foo() result(r)
   !ERROR: Procedure 'r' is recursively defined.  Procedures in the cycle: 'foo', 'r'
   procedure(foo), pointer :: r 
 end function foo
 
 subroutine iface
   !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
   procedure(sub) :: p
   interface
+    !ERROR: Procedure 'sub' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
     subroutine sub(p2)
       import p
       procedure(p) :: p2
     end subroutine
   end interface
   call p(sub)
 end subroutine
 

flang/test/Semantics/resolve53.f90

module m7
   !ERROR: Generic 'g' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
   !ERROR: Generic 'g' may not have specific procedures 's3' and 's5' as their interfaces are not distinguishable
   interface g
     subroutine s5(x)
       real x(..)
     end subroutine
   end interface
 end
-    
-
 ! Two procedures that differ only by attributes are not distinguishable
 module m8
   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
   interface g
     pure subroutine s1(x)
       real, intent(in) :: x
     end subroutine
     subroutine s2(x)
real function f(x)
       character(*),intent(in) :: x
     end function
   end interface
   interface operator(+)
     procedure f
   end interface
 end module
 
-subroutine s1()
+subroutine subr1()
   use m20
   interface operator(.not.)
     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
     procedure f
   end interface
   interface operator(+)
     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
     procedure f
   end interface
-end subroutine s1
+end subroutine subr1
 
 ! Extensions for distinguishable allocatable arguments; these should not
 ! elicit errors from f18
 module m21
   type :: t
   end type
   interface int1
     procedure s1a, s1b ! only one is polymorphic

flang/test/Semantics/resolve62.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Resolve generic based on number of arguments
-subroutine s1
+subroutine subr1
   interface f
     real function f1(x)
       optional :: x
     end
     real function f2(x, y)
     end
   end interface
   z = f(1.0)
   z = f(1.0, 2.0)
   !ERROR: No specific procedure of generic 'f' matches the actual arguments
   z = f(1.0, 2.0, 3.0)
 end
 
 ! Elemental and non-element function both match: non-elemental one should be used
-subroutine s2
+subroutine subr2
   interface f
     logical elemental function f1(x)
       intent(in) :: x
     end
     real function f2(x)
       real :: x(10)
     end
   end interface
subroutine s3
   a = b .foo. c
 end
 
 ! Generic resolves successfully but error analyzing call
 module m4
   real, protected :: x
   real :: y
   interface s
-    pure subroutine s1(x)
+    pure subroutine s101(x)
       real, intent(out) :: x
     end
-    subroutine s2(x, y)
+    subroutine s102(x, y)
       real :: x, y
     end
   end interface
 end
 subroutine s4a
   use m4
   real :: z
   !OK