/build/source/flang/lib/Semantics/check-declarations.cpp

Bug Summary

File:	build/source/flang/lib/Semantics/check-declarations.cpp
Warning:	line 1305, column 11 Forming reference to null pointer
Annotated Source Code

Press '?' to see keyboard shortcuts
Show analyzer invocation
clang -cc1 -cc1 -triple x86_64-pc-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name check-declarations.cpp -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model pic -pic-level 2 -mframe-pointer=none -relaxed-aliasing -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -ffunction-sections -fdata-sections -fcoverage-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -resource-dir /usr/lib/llvm-17/lib/clang/17 -isystem /build/source/llvm/../mlir/include -isystem tools/mlir/include -isystem tools/clang/include -isystem /build/source/llvm/../clang/include -D FLANG_INCLUDE_TESTS=1 -D FLANG_LITTLE_ENDIAN=1 -D FLANG_VENDOR="Debian " -D _DEBUG -D _GLIBCXX_ASSERTIONS -D _GNU_SOURCE -D _LIBCPP_ENABLE_ASSERTIONS -D __STDC_CONSTANT_MACROS -D __STDC_FORMAT_MACROS -D __STDC_LIMIT_MACROS -I tools/flang/lib/Semantics -I /build/source/flang/lib/Semantics -I /build/source/flang/include -I tools/flang/include -I include -I /build/source/llvm/include -D _FORTIFY_SOURCE=2 -D NDEBUG -U NDEBUG -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/x86_64-linux-gnu/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10/backward -internal-isystem /usr/lib/llvm-17/lib/clang/17/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -fmacro-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fmacro-prefix-map=/build/source/= -fcoverage-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fcoverage-prefix-map=/build/source/= -source-date-epoch 1683717183 -O2 -Wno-unused-command-line-argument -Wno-unused-parameter -Wwrite-strings -Wno-missing-field-initializers -Wno-long-long -Wno-maybe-uninitialized -Wno-class-memaccess -Wno-redundant-move -Wno-pessimizing-move -Wno-noexcept-type -Wno-comment -Wno-misleading-indentation -Wno-deprecated-copy -Wno-ctad-maybe-unsupported -std=c++17 -fdeprecated-macro -fdebug-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/= -ferror-limit 19 -fvisibility-inlines-hidden -stack-protector 2 -fgnuc-version=4.2.1 -fcolor-diagnostics -vectorize-loops -vectorize-slp -analyzer-output=html -analyzer-config stable-report-filename=true -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2023-05-10-133810-16478-1 -x c++ /build/source/flang/lib/Semantics/check-declarations.cpp
1//===-- lib/Semantics/check-declarations.cpp ------------------------------===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//

9// Static declaration checking

11#include "check-declarations.h"
12#include "definable.h"
13#include "pointer-assignment.h"
14#include "flang/Evaluate/check-expression.h"
15#include "flang/Evaluate/fold.h"
16#include "flang/Evaluate/tools.h"
17#include "flang/Parser/characters.h"
18#include "flang/Semantics/scope.h"
19#include "flang/Semantics/semantics.h"
20#include "flang/Semantics/symbol.h"
21#include "flang/Semantics/tools.h"
22#include "flang/Semantics/type.h"
23#include <algorithm>
24#include <map>
25#include <string>

27namespace Fortran::semantics {

29namespace characteristics = evaluate::characteristics;
30using characteristics::DummyArgument;
31using characteristics::DummyDataObject;
32using characteristics::DummyProcedure;
33using characteristics::FunctionResult;
34using characteristics::Procedure;

36class CheckHelper {
37public:
explicit CheckHelper(SemanticsContext &c) : context_{c} {}

SemanticsContext &context() { return context_; }
void Check() { Check(context_.globalScope()); }
void Check(const ParamValue &, bool canBeAssumed);
void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
void Check(const ShapeSpec &spec) {
  Check(spec.lbound());
  Check(spec.ubound());
}
void Check(const ArraySpec &);
void Check(const DeclTypeSpec &, bool canHaveAssumedTypeParameters);
void Check(const Symbol &);
void CheckCommonBlock(const Symbol &);
void Check(const Scope &);
const Procedure *Characterize(const Symbol &);

55private:
template <typename A> void CheckSpecExpr(const A &x) {
  evaluate::CheckSpecificationExpr(x, DEREF(scope_)Fortran::common::Deref(scope_, "flang/lib/Semantics/check-declarations.cpp"
, 57), foldingContext_);
}
void CheckValue(const Symbol &, const DerivedTypeSpec *);
void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
void CheckPointer(const Symbol &);
void CheckPassArg(
    const Symbol &proc, const Symbol *interface, const WithPassArg &);
void CheckProcBinding(const Symbol &, const ProcBindingDetails &);
void CheckObjectEntity(const Symbol &, const ObjectEntityDetails &);
void CheckPointerInitialization(const Symbol &);
void CheckArraySpec(const Symbol &, const ArraySpec &);
void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
void CheckSubprogram(const Symbol &, const SubprogramDetails &);
void CheckExternal(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 &);
bool CheckDefinedOperator(
    SourceName, GenericKind, const Symbol &, const Procedure &);
std::optional<parser::MessageFixedText> CheckNumberOfArgs(
    const GenericKind &, std::size_t);
bool CheckDefinedOperatorArg(
    const SourceName &, const Symbol &, const Procedure &, std::size_t);
bool CheckDefinedAssignment(const Symbol &, const Procedure &);
bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int);
void CheckSpecifics(const Symbol &, const GenericDetails &);
void CheckEquivalenceSet(const EquivalenceSet &);
void CheckBlockData(const Scope &);
void CheckGenericOps(const Scope &);
bool CheckConflicting(const Symbol &, Attr, Attr);
void WarnMissingFinal(const Symbol &);
void CheckSymbolType(const Symbol &); // C702
bool InPure() const {
  return innermostSymbol_ && IsPureProcedure(*innermostSymbol_);
}
bool InElemental() const {
  return innermostSymbol_ && IsElementalProcedure(*innermostSymbol_);
}
bool InFunction() const {
  return innermostSymbol_ && IsFunction(*innermostSymbol_);
}
bool InInterface() const {
  const SubprogramDetails *subp{innermostSymbol_
          ? innermostSymbol_->detailsIf<SubprogramDetails>()
          : nullptr};
  return subp && subp->isInterface();
}
template <typename... A>
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()) {
    evaluate::AttachDeclaration(*msg, symbol);
  }
  return msg;
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckGlobalName(const Symbol &);
void CheckExplicitSave(const Symbol &);
void CheckBindC(const Symbol &);
void CheckBindCFunctionResult(const Symbol &);
// Check functions for defined I/O procedures
void CheckDefinedIoProc(
    const Symbol &, const GenericDetails &, common::DefinedIo);
bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
void CheckDioDummyIsDerived(
    const Symbol &, const Symbol &, common::DefinedIo ioKind, const Symbol &);
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
void CheckDioDtvArg(
    const Symbol &, const Symbol *, common::DefinedIo, const Symbol &);
void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
void CheckDioAssumedLenCharacterArg(
    const Symbol &, const Symbol *, std::size_t, Attr);
void CheckDioVlistArg(const Symbol &, const Symbol *, std::size_t);
void CheckDioArgCount(const Symbol &, common::DefinedIo ioKind, std::size_t);
struct TypeWithDefinedIo {
  const DerivedTypeSpec &type;
  common::DefinedIo ioKind;
  const Symbol &proc;
  const Symbol &generic;
};
void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &, common::DefinedIo,
    const Symbol &, const Symbol &generic);
void CheckModuleProcedureDef(const Symbol &);

SemanticsContext &context_;
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
parser::ContextualMessages &messages_{foldingContext_.messages()};
const Scope *scope_{nullptr};
bool scopeIsUninstantiatedPDT_{false};
// This symbol is the one attached to the innermost enclosing scope
// that has a symbol.
const Symbol *innermostSymbol_{nullptr};
// Cache of calls to Procedure::Characterize(Symbol)
std::map<SymbolRef, std::optional<Procedure>, SymbolAddressCompare>
    characterizeCache_;
// Collection of module procedure symbols with non-BIND(C)
// global names, qualified by their module.
std::map<std::pair<SourceName, const Symbol *>, SymbolRef> moduleProcs_;
// Collection of symbols with global names, BIND(C) or otherwise
std::map<std::string, SymbolRef> globalNames_;
// Collection of external procedures without global definitions
std::map<std::string, SymbolRef> externalNames_;
167};

169class DistinguishabilityHelper {
170public:
DistinguishabilityHelper(SemanticsContext &context) : context_{context} {}
void Add(const Symbol &, GenericKind, const Symbol &, const Procedure &);
void Check(const Scope &);

175private:
void SayNotDistinguishable(const Scope &, const SourceName &, GenericKind,
    const Symbol &, const Symbol &);
void AttachDeclaration(parser::Message &, const Scope &, const Symbol &);

SemanticsContext &context_;
struct ProcedureInfo {
  GenericKind kind;
  const Symbol &symbol;
  const Procedure &procedure;
};
std::map<SourceName, std::vector<ProcedureInfo>> nameToInfo_;
187};

189void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
if (value.isAssumed()) {
  if (!canBeAssumed) { // C795, C721, C726
    messages_.Say(
        "An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result"_err_en_US);
  }
} else {
  CheckSpecExpr(value.GetExplicit());
}
198}

200void CheckHelper::Check(const ArraySpec &shape) {
for (const auto &spec : shape) {
  Check(spec);
}
204}

206void CheckHelper::Check(
  const DeclTypeSpec &type, bool canHaveAssumedTypeParameters) {
if (type.category() == DeclTypeSpec::Character) {
  Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters);
} else if (const DerivedTypeSpec *derived{type.AsDerived()}) {
  for (auto &parm : derived->parameters()) {
    Check(parm.second, canHaveAssumedTypeParameters);
  }
}
215}

217void CheckHelper::Check(const Symbol &symbol) {
if (symbol.name().size() > common::maxNameLen &&
    &symbol == &symbol.GetUltimate() &&
    !FindModuleFileContaining(symbol.owner())) {
  messages_.Say(symbol.name(),
      "%s has length %d, which is greater than the maximum name length "
      "%d"_port_en_US,
      symbol.name(), symbol.name().size(), common::maxNameLen);
}
if (context_.HasError(symbol)) {
  return;
}
auto restorer{messages_.SetLocation(symbol.name())};
context_.set_location(symbol.name());
const DeclTypeSpec *type{symbol.GetType()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
bool isDone{false};
common::visit(
    common::visitors{
        [&](const UseDetails &x) { isDone = true; },
        [&](const HostAssocDetails &x) {
          CheckHostAssoc(symbol, x);
          isDone = true;
        },
        [&](const ProcBindingDetails &x) {
          CheckProcBinding(symbol, x);
          isDone = true;
        },
        [&](const ObjectEntityDetails &x) { CheckObjectEntity(symbol, x); },
        [&](const ProcEntityDetails &x) { CheckProcEntity(symbol, x); },
        [&](const SubprogramDetails &x) { CheckSubprogram(symbol, x); },
        [&](const DerivedTypeDetails &x) { CheckDerivedType(symbol, x); },
1
Calling 'CheckHelper::CheckDerivedType'→
        [&](const GenericDetails &x) { CheckGeneric(symbol, x); },
        [](const auto &) {},
    },
    symbol.details());
if (symbol.attrs().test(Attr::VOLATILE)) {
  CheckVolatile(symbol, derived);
}
if (symbol.attrs().test(Attr::BIND_C)) {
  CheckBindC(symbol);
}
if (symbol.attrs().test(Attr::SAVE) &&
    !symbol.implicitAttrs().test(Attr::SAVE)) {
  CheckExplicitSave(symbol);
}
const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
if (symbol.attrs().test(Attr::CONTIGUOUS)) {
  if ((!object && !symbol.has<UseDetails>()) ||
      !((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
          evaluate::IsAssumedRank(symbol))) {
    if (symbol.owner().IsDerivedType()) { // C752
      messages_.Say(
          "A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
    } else { // C830
      messages_.Say(
          "CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank"_err_en_US);
    }
  }
}
CheckGlobalName(symbol);
if (isDone) {
  return; // following checks do not apply
}

if (symbol.attrs().test(Attr::PROTECTED)) {
  if (symbol.owner().kind() != Scope::Kind::Module) { // C854
    messages_.Say(
        "A PROTECTED entity must be in the specification part of a module"_err_en_US);
  }
  if (!evaluate::IsVariable(symbol) && !IsProcedurePointer(symbol)) { // C855
    messages_.Say(
        "A PROTECTED entity must be a variable or pointer"_err_en_US);
  }
  if (FindCommonBlockContaining(symbol)) { // C856
    messages_.Say(
        "A PROTECTED entity may not be in a common block"_err_en_US);
  }
}
if (IsPointer(symbol)) {
  CheckPointer(symbol);
}
if (InPure()) {
  if (InInterface()) {
    // Declarations in interface definitions "have no effect" if they
    // are not pertinent to the characteristics of the procedure.
    // Restrictions on entities in pure procedure interfaces don't need
    // enforcement.
  } else {
    if (IsSaved(symbol)) {
      if (IsInitialized(symbol)) {
        messages_.Say(
            "A pure subprogram may not initialize a variable"_err_en_US);
      } else {
        messages_.Say(
            "A pure subprogram may not have a variable with the SAVE attribute"_err_en_US);
      }
    }
  }
  if (symbol.attrs().test(Attr::VOLATILE) &&
      (IsDummy(symbol) || !InInterface())) {
    messages_.Say(
        "A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
  }
  if (IsProcedure(symbol) && !IsPureProcedure(symbol) && IsDummy(symbol)) {
    messages_.Say(
        "A dummy procedure of a pure subprogram must be pure"_err_en_US);
  }
}
if (type) { // Section 7.2, paragraph 7; C795
  bool isChar{type->category() == DeclTypeSpec::Character};
  bool canHaveAssumedParameter{(isChar && IsNamedConstant(symbol)) ||
      (IsAssumedLengthCharacter(symbol) && // C722
          (IsExternal(symbol) ||
              ClassifyProcedure(symbol) ==
                  ProcedureDefinitionClass::Dummy)) ||
      symbol.test(Symbol::Flag::ParentComp)};
  if (!IsStmtFunctionDummy(symbol)) { // C726
    if (object) {
      canHaveAssumedParameter |= object->isDummy() ||
          (isChar && object->isFuncResult()) ||
          IsStmtFunctionResult(symbol); // Avoids multiple messages
    } else {
      canHaveAssumedParameter |= symbol.has<AssocEntityDetails>();
    }
  }
  if (IsProcedurePointer(symbol) && symbol.HasExplicitInterface()) {
    // Don't check function result types here
  } else {
    Check(*type, canHaveAssumedParameter);
  }
  if (InPure() && InFunction() && IsFunctionResult(symbol)) {
    if (type->IsPolymorphic() && IsAllocatable(symbol)) { // C1585
      messages_.Say(
          "Result of pure function may not be both polymorphic and ALLOCATABLE"_err_en_US);
    }
    if (derived) {
      // These cases would be caught be the general validation of local
      // variables in a pure context, but these messages are more specific.
      if (HasImpureFinal(symbol)) { // C1584
        messages_.Say(
            "Result of pure function may not have an impure FINAL subroutine"_err_en_US);
      }
      if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
        SayWithDeclaration(*bad,
            "Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%s'"_err_en_US,
            bad.BuildResultDesignatorName());
      }
    }
  }
}
if (IsAssumedLengthCharacter(symbol) && IsFunction(symbol)) { // C723
  if (symbol.attrs().test(Attr::RECURSIVE)) {
    messages_.Say(
        "An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
  }
  if (symbol.Rank() > 0) {
    messages_.Say(
        "An assumed-length CHARACTER(*) function cannot return an array"_err_en_US);
  }
  if (!IsStmtFunction(symbol)) {
    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 (IsPointer(*result)) {
      messages_.Say(
          "An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
    }
  } else if (IsProcedurePointer(symbol) && IsDummy(symbol)) {
    messages_.Say(
        "A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
    // The non-dummy case is a hard error that's caught elsewhere.
  }
}
if (symbol.attrs().test(Attr::VALUE)) {
  CheckValue(symbol, derived);
}
if (IsDummy(symbol)) {
  if (IsNamedConstant(symbol)) {
    messages_.Say(
        "A dummy argument may not also be a named constant"_err_en_US);
  }
} else if (IsFunctionResult(symbol)) {
  if (IsNamedConstant(symbol)) {
    messages_.Say(
        "A function result may not also be a named constant"_err_en_US);
  }
  CheckBindCFunctionResult(symbol);
}
if (symbol.owner().IsModule() && IsAutomatic(symbol)) {
  messages_.Say(
      "Automatic data object '%s' may not appear in the specification part"
      " of a module"_err_en_US,
      symbol.name());
}
if (IsProcedure(symbol) && !symbol.HasExplicitInterface()) {
  if (IsAllocatable(symbol)) {
    messages_.Say(
        "Procedure '%s' may not be ALLOCATABLE without an explicit interface"_err_en_US,
        symbol.name());
  } else if (symbol.Rank() > 0) {
    messages_.Say(
        "Procedure '%s' may not be an array without an explicit interface"_err_en_US,
        symbol.name());
  }
}
if (symbol.attrs().test(Attr::ASYNCHRONOUS) &&
    !evaluate::IsVariable(symbol)) {
  messages_.Say(
      "An entity may not have the ASYNCHRONOUS attribute unless it is a variable"_err_en_US);
}
434}

436void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
CheckGlobalName(symbol);
if (symbol.attrs().test(Attr::BIND_C)) {
  CheckBindC(symbol);
}
441}

443// C859, C860
444void CheckHelper::CheckExplicitSave(const Symbol &symbol) {
const Symbol &ultimate{symbol.GetUltimate()};
if (ultimate.test(Symbol::Flag::InDataStmt)) {
  // checked elsewhere
} else if (symbol.has<UseDetails>()) {
  messages_.Say(
      "The USE-associated name '%s' may not have an explicit SAVE attribute"_err_en_US,
      symbol.name());
} else if (IsDummy(ultimate)) {
  messages_.Say(
      "The dummy argument '%s' may not have an explicit SAVE attribute"_err_en_US,
      symbol.name());
} else if (IsFunctionResult(ultimate)) {
  messages_.Say(
      "The function result variable '%s' may not have an explicit SAVE attribute"_err_en_US,
      symbol.name());
} else if (const Symbol * common{FindCommonBlockContaining(ultimate)}) {
  messages_.Say(
      "The entity '%s' in COMMON block /%s/ may not have an explicit SAVE attribute"_err_en_US,
      symbol.name(), common->name());
} else if (IsAutomatic(ultimate)) {
  messages_.Say(
      "The automatic object '%s' may not have an explicit SAVE attribute"_err_en_US,
      symbol.name());
} else if (!evaluate::IsVariable(ultimate) && !IsProcedurePointer(ultimate)) {
  messages_.Say(
      "The entity '%s' with an explicit SAVE attribute must be a variable, procedure pointer, or COMMON block"_err_en_US,
      symbol.name());
}
473}

475void CheckHelper::CheckBindCFunctionResult(const Symbol &symbol) { // C1553
if (!innermostSymbol_ || !IsBindCProcedure(*innermostSymbol_)) {
  return;
}
if (IsPointer(symbol) || IsAllocatable(symbol)) {
  messages_.Say(
      "BIND(C) function result cannot have ALLOCATABLE or POINTER attribute"_err_en_US);
}
if (const DeclTypeSpec * type{symbol.GetType()};
    type && type->category() == DeclTypeSpec::Character) {
  bool isConstOne{false}; // 18.3.1(1)
  if (const auto &len{type->characterTypeSpec().length().GetExplicit()}) {
    if (auto constLen{evaluate::ToInt64(*len)}) {
      isConstOne = constLen == 1;
    }
  }
  if (!isConstOne) {
    messages_.Say(
        "BIND(C) character function result must have length one"_err_en_US);
  }
}
if (symbol.Rank() > 0) {
  messages_.Say("BIND(C) function result must be scalar"_err_en_US);
}
if (symbol.Corank()) {
  messages_.Say("BIND(C) function result cannot be a coarray"_err_en_US);
}
502}

504void CheckHelper::CheckValue(
  const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865
if (!IsDummy(symbol)) {
  messages_.Say(
      "VALUE attribute may apply only to a dummy argument"_err_en_US);
}
if (IsProcedure(symbol)) {
  messages_.Say(
      "VALUE attribute may apply only to a dummy data object"_err_en_US);
}
if (IsAssumedSizeArray(symbol)) {
  messages_.Say(
      "VALUE attribute may not apply to an assumed-size array"_err_en_US);
}
if (evaluate::IsCoarray(symbol)) {
  messages_.Say("VALUE attribute may not apply to a coarray"_err_en_US);
}
if (IsAllocatable(symbol)) {
  messages_.Say("VALUE attribute may not apply to an ALLOCATABLE"_err_en_US);
} else if (IsPointer(symbol)) {
  messages_.Say("VALUE attribute may not apply to a POINTER"_err_en_US);
}
if (IsIntentInOut(symbol)) {
  messages_.Say(
      "VALUE attribute may not apply to an INTENT(IN OUT) argument"_err_en_US);
} else if (IsIntentOut(symbol)) {
  messages_.Say(
      "VALUE attribute may not apply to an INTENT(OUT) argument"_err_en_US);
}
if (symbol.attrs().test(Attr::VOLATILE)) {
  messages_.Say("VALUE attribute may not apply to a VOLATILE"_err_en_US);
}
if (innermostSymbol_ && IsBindCProcedure(*innermostSymbol_)) {
  if (IsOptional(symbol)) {
    messages_.Say(
        "VALUE attribute may not apply to an OPTIONAL in a BIND(C) procedure"_err_en_US);
  }
  if (symbol.Rank() > 0) {
    messages_.Say(
        "VALUE attribute may not apply to an array in a BIND(C) procedure"_err_en_US);
  }
}
if (derived) {
  if (FindCoarrayUltimateComponent(*derived)) {
    messages_.Say(
        "VALUE attribute may not apply to a type with a coarray ultimate component"_err_en_US);
  }
}
552}

554void CheckHelper::CheckAssumedTypeEntity( // C709
  const Symbol &symbol, const ObjectEntityDetails &details) {
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"
                    " attribute"_err_en_US,
          symbol.name());
    }
    if (symbol.attrs().test(Attr::POINTER)) {
      messages_.Say("Assumed-type argument '%s' cannot have the POINTER"
                    " attribute"_err_en_US,
          symbol.name());
    }
    if (symbol.attrs().test(Attr::VALUE)) {
      messages_.Say("Assumed-type argument '%s' cannot have the VALUE"
                    " attribute"_err_en_US,
          symbol.name());
    }
    if (symbol.attrs().test(Attr::INTENT_OUT)) {
      messages_.Say(
          "Assumed-type argument '%s' cannot be INTENT(OUT)"_err_en_US,
          symbol.name());
    }
    if (evaluate::IsCoarray(symbol)) {
      messages_.Say(
          "Assumed-type argument '%s' cannot be a coarray"_err_en_US,
          symbol.name());
    }
    if (details.IsArray() && details.shape().IsExplicitShape()) {
      messages_.Say("Assumed-type array argument '%s' must be assumed shape,"
                    " assumed size, or assumed rank"_err_en_US,
          symbol.name());
    }
  }
}
595}

597void CheckHelper::CheckObjectEntity(
  const Symbol &symbol, const ObjectEntityDetails &details) {
CheckSymbolType(symbol);
CheckArraySpec(symbol, details.shape());
Check(details.shape());
Check(details.coshape());
if (details.shape().Rank() > common::maxRank) {
  messages_.Say(
      "'%s' has rank %d, which is greater than the maximum supported rank %d"_err_en_US,
      symbol.name(), details.shape().Rank(), common::maxRank);
} else if (details.shape().Rank() + details.coshape().Rank() >
    common::maxRank) {
  messages_.Say(
      "'%s' has rank %d and corank %d, whose sum is greater than the maximum supported rank %d"_err_en_US,
      symbol.name(), details.shape().Rank(), details.coshape().Rank(),
      common::maxRank);
}
CheckAssumedTypeEntity(symbol, details);
WarnMissingFinal(symbol);
const DeclTypeSpec *type{details.type()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
if (!details.coshape().empty()) {
  bool isDeferredCoshape{details.coshape().CanBeDeferredShape()};
  if (IsAllocatable(symbol)) {
    if (!isDeferredCoshape) { // C827
      messages_.Say("'%s' is an ALLOCATABLE coarray and must have a deferred"
                    " coshape"_err_en_US,
          symbol.name());
    }
  } else if (symbol.owner().IsDerivedType()) { // C746
    std::string deferredMsg{
        isDeferredCoshape ? "" : " and have a deferred coshape"};
    messages_.Say("Component '%s' is a coarray and must have the ALLOCATABLE"
                  " attribute%s"_err_en_US,
        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 (IsBadCoarrayType(derived)) { // 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 (IsIntentOut(symbol)) {
    // Some of these errors would also be caught by the general check
    // for definability of automatically deallocated local variables,
    // but these messages are more specific.
    if (FindUltimateComponent(symbol, [](const Symbol &x) {
          return evaluate::IsCoarray(x) && IsAllocatable(x);
        })) { // C846
      messages_.Say(
          "An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray"_err_en_US);
    }
    if (IsOrContainsEventOrLockComponent(symbol)) { // C847
      messages_.Say(
          "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US);
    }
    if (details.IsAssumedSize()) { // C834
      if (type && type->IsPolymorphic()) {
        messages_.Say(
            "An INTENT(OUT) assumed-size dummy argument array may not be polymorphic"_err_en_US);
      }
      if (derived) {
        if (derived->HasDefaultInitialization()) {
          messages_.Say(
              "An INTENT(OUT) assumed-size dummy argument array may not have a derived type with any default component initialization"_err_en_US);
        }
        if (IsFinalizable(*derived)) {
          messages_.Say(
              "An INTENT(OUT) assumed-size dummy argument array may not be finalizable"_err_en_US);
        }
      }
    }
  }
  if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)Fortran::common::Deref(innermostSymbol_, "flang/lib/Semantics/check-declarations.cpp"
, 677)) &&
      !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 (type && type->IsPolymorphic()) { // C1588
        messages_.Say(
            "An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US);
      } else if (derived) {
        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(symbol)) { // C1587
          messages_.Say(
              "An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine"_err_en_US);
        }
      }
    } else if (!IsIntentInOut(symbol)) { // C1586
      messages_.Say(
          "non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute"_err_en_US);
    }
  }
  if (auto ignoreTKR{GetIgnoreTKR(symbol)}; !ignoreTKR.empty()) {
    const Symbol *ownerSymbol{symbol.owner().symbol()};
    const auto *ownerSubp{ownerSymbol->detailsIf<SubprogramDetails>()};
    bool inInterface{ownerSubp && ownerSubp->isInterface()};
    bool inExplicitInterface{
        inInterface && !IsSeparateModuleProcedureInterface(ownerSymbol)};
    bool inModuleProc{
        !inInterface && ownerSymbol && IsModuleProcedure(*ownerSymbol)};
    if (!inExplicitInterface && !inModuleProc) {
      messages_.Say(
          "!DIR$ IGNORE_TKR may apply only in an interface or a module procedure"_err_en_US);
    }
    if (ignoreTKR.test(common::IgnoreTKR::Contiguous) &&
        !IsAssumedShape(symbol)) {
      messages_.Say(
          "!DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array"_err_en_US);
    }
    if (ownerSymbol && ownerSymbol->attrs().test(Attr::ELEMENTAL) &&
        details.ignoreTKR().test(common::IgnoreTKR::Rank)) {
      messages_.Say(
          "!DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure"_err_en_US);
    }
    if (IsPassedViaDescriptor(symbol)) {
      if (IsAllocatableOrPointer(symbol)) {
        if (inExplicitInterface) {
          messages_.Say(
              "!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);
        } else {
          messages_.Say(
              "!DIR$ IGNORE_TKR may not apply to an allocatable or pointer"_err_en_US);
        }
      } else if (ignoreTKR.test(common::IgnoreTKR::Rank)) {
        if (ignoreTKR.count() == 1 && evaluate::IsAssumedRank(symbol)) {
          messages_.Say(
              "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US);
        } else if (inExplicitInterface) {
          messages_.Say(
              "!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US);
        } else {
          messages_.Say(
              "!DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor"_err_en_US);
        }
      }
    }
  }
} else if (symbol.attrs().test(Attr::INTENT_IN) ||
    symbol.attrs().test(Attr::INTENT_OUT) ||
    symbol.attrs().test(Attr::INTENT_INOUT)) {
  messages_.Say(
      "INTENT attributes may apply only to a dummy argument"_err_en_US); // C843
} else if (IsOptional(symbol)) {
  messages_.Say(
      "OPTIONAL attribute may apply only to a dummy argument"_err_en_US); // C849
} else if (!details.ignoreTKR().empty()) {
  messages_.Say(
      "!DIR$ IGNORE_TKR directive may apply only to a dummy data argument"_err_en_US);
}
if (InElemental()) {
  if (details.isDummy()) { // C15100
    if (details.shape().Rank() > 0) {
      messages_.Say(
          "A dummy argument of an ELEMENTAL procedure must be scalar"_err_en_US);
    }
    if (IsAllocatable(symbol)) {
      messages_.Say(
          "A dummy argument of an ELEMENTAL procedure may not be ALLOCATABLE"_err_en_US);
    }
    if (evaluate::IsCoarray(symbol)) {
      messages_.Say(
          "A dummy argument of an ELEMENTAL procedure may not be a coarray"_err_en_US);
    }
    if (IsPointer(symbol)) {
      messages_.Say(
          "A dummy argument of an ELEMENTAL procedure may not be a POINTER"_err_en_US);
    }
    if (!symbol.attrs().HasAny(Attrs{Attr::VALUE, Attr::INTENT_IN,
            Attr::INTENT_INOUT, Attr::INTENT_OUT})) { // C15102
      messages_.Say(
          "A dummy argument of an ELEMENTAL procedure must have an INTENT() or VALUE attribute"_err_en_US);
    }
  } else if (IsFunctionResult(symbol)) { // C15101
    if (details.shape().Rank() > 0) {
      messages_.Say(
          "The result of an ELEMENTAL function must be scalar"_err_en_US);
    }
    if (IsAllocatable(symbol)) {
      messages_.Say(
          "The result of an ELEMENTAL function may not be ALLOCATABLE"_err_en_US);
    }
    if (IsPointer(symbol)) {
      messages_.Say(
          "The result of an ELEMENTAL function may not be a POINTER"_err_en_US);
    }
  }
}
if (HasDeclarationInitializer(symbol)) { // C808; ignore DATA initialization
  CheckPointerInitialization(symbol);
  if (IsAutomatic(symbol)) {
    messages_.Say(
        "An automatic variable or component must not be initialized"_err_en_US);
  } else if (IsDummy(symbol)) {
    messages_.Say("A dummy argument must not be initialized"_err_en_US);
  } else if (IsFunctionResult(symbol)) {
    messages_.Say("A function result must not be initialized"_err_en_US);
  } else if (IsInBlankCommon(symbol) &&
      !FindModuleFileContaining(symbol.owner())) {
    messages_.Say(
        "A variable in blank COMMON should not be initialized"_port_en_US);
  }
}
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 (type && type->IsPolymorphic() &&
    !(type->IsAssumedType() || IsAllocatableOrPointer(symbol) ||
        IsDummy(symbol))) { // C708
  messages_.Say("CLASS entity '%s' must be a dummy argument or have "
                "ALLOCATABLE or POINTER attribute"_err_en_US,
      symbol.name());
}
if (derived && InPure() && !InInterface() &&
    IsAutomaticallyDestroyed(symbol) &&
    !IsIntentOut(symbol) /*has better messages*/ &&
    !IsFunctionResult(symbol) /*ditto*/) {
  // Check automatically deallocated local variables for possible
  // problems with finalization in PURE.
  if (auto whyNot{
          WhyNotDefinable(symbol.name(), symbol.owner(), {}, symbol)}) {
    if (auto *msg{messages_.Say(
            "'%s' may not be a local variable in a pure subprogram"_err_en_US,
            symbol.name())}) {
      msg->Attach(std::move(*whyNot));
    }
  }
}
if (symbol.attrs().test(Attr::EXTERNAL)) {
  SayWithDeclaration(symbol,
      "'%s' is a data object and may not be EXTERNAL"_err_en_US,
      symbol.name());
}
851}

853void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
if (IsPointer(symbol) && !context_.HasError(symbol) &&
    !scopeIsUninstantiatedPDT_) {
  if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
    if (object->init()) { // C764, C765; C808
      if (auto designator{evaluate::AsGenericExpr(symbol)}) {
        auto restorer{messages_.SetLocation(symbol.name())};
        context_.set_location(symbol.name());
        CheckInitialTarget(
            foldingContext_, *designator, *object->init(), DEREF(scope_)Fortran::common::Deref(scope_, "flang/lib/Semantics/check-declarations.cpp"
, 862));
      }
    }
  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
    if (proc->init() && *proc->init()) {
      // C1519 - must be nonelemental external or module procedure,
      // or an unrestricted specific intrinsic function.
      const Symbol &ultimate{(*proc->init())->GetUltimate()};
      if (ultimate.attrs().test(Attr::INTRINSIC)) {
        if (const auto intrinsic{
                context_.intrinsics().IsSpecificIntrinsicFunction(
                    ultimate.name().ToString())};
            !intrinsic || intrinsic->isRestrictedSpecific) { // C1030
          context_.Say(
              "Intrinsic procedure '%s' is not an unrestricted specific "
              "intrinsic permitted for use as the initializer for procedure "
              "pointer '%s'"_err_en_US,
              ultimate.name(), symbol.name());
        }
      } else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
          ultimate.owner().kind() != Scope::Kind::Module) {
        context_.Say("Procedure pointer '%s' initializer '%s' is neither "
                     "an external nor a module procedure"_err_en_US,
            symbol.name(), ultimate.name());
      } else if (IsElementalProcedure(ultimate)) {
        context_.Say("Procedure pointer '%s' cannot be initialized with the "
                     "elemental procedure '%s"_err_en_US,
            symbol.name(), ultimate.name());
      } else {
        // TODO: Check the "shalls" in the 15.4.3.6 paragraphs 7-10.
      }
    }
  }
}
896}

898// The six different kinds of array-specs:
899//   array-spec     -> explicit-shape-list | deferred-shape-list
900//                     | assumed-shape-list | implied-shape-list
901//                     | assumed-size | assumed-rank
902//   explicit-shape -> [ lb : ] ub
903//   deferred-shape -> :
904//   assumed-shape  -> [ lb ] :
905//   implied-shape  -> [ lb : ] *
906//   assumed-size   -> [ explicit-shape-list , ] [ lb : ] *
907//   assumed-rank   -> ..
908// Note:
909// - deferred-shape is also an assumed-shape
910// - A single "*" or "lb:*" might be assumed-size or implied-shape-list
911void CheckHelper::CheckArraySpec(
  const Symbol &symbol, const ArraySpec &arraySpec) {
if (arraySpec.Rank() == 0) {
  return;
}
bool isExplicit{arraySpec.IsExplicitShape()};
bool canBeDeferred{arraySpec.CanBeDeferredShape()};
bool canBeImplied{arraySpec.CanBeImpliedShape()};
bool canBeAssumedShape{arraySpec.CanBeAssumedShape()};
bool canBeAssumedSize{arraySpec.CanBeAssumedSize()};
bool isAssumedRank{arraySpec.IsAssumedRank()};
std::optional<parser::MessageFixedText> msg;
if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit &&
    !canBeAssumedSize) {
  msg = "Cray pointee '%s' must have explicit shape or"
        " assumed size"_err_en_US;
} else if (IsAllocatableOrPointer(symbol) && !canBeDeferred &&
    !isAssumedRank) {
  if (symbol.owner().IsDerivedType()) { // C745
    if (IsAllocatable(symbol)) {
      msg = "Allocatable array component '%s' must have"
            " deferred shape"_err_en_US;
    } else {
      msg = "Array pointer component '%s' must have deferred shape"_err_en_US;
    }
  } else {
    if (IsAllocatable(symbol)) { // C832
      msg = "Allocatable array '%s' must have deferred shape or"
            " assumed rank"_err_en_US;
    } else {
      msg = "Array pointer '%s' must have deferred shape or"
            " assumed rank"_err_en_US;
    }
  }
} else if (IsDummy(symbol)) {
  if (canBeImplied && !canBeAssumedSize) { // C836
    msg = "Dummy array argument '%s' may not have implied shape"_err_en_US;
  }
} else if (canBeAssumedShape && !canBeDeferred) {
  msg = "Assumed-shape array '%s' must be a dummy argument"_err_en_US;
} else if (canBeAssumedSize && !canBeImplied) { // C833
  msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US;
} else if (isAssumedRank) { // C837
  msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US;
} else if (canBeImplied) {
  if (!IsNamedConstant(symbol)) { // C835, C836
    msg = "Implied-shape array '%s' must be a named constant or a "
          "dummy argument"_err_en_US;
  }
} else if (IsNamedConstant(symbol)) {
  if (!isExplicit && !canBeImplied) {
    msg = "Named constant '%s' array must have constant or"
          " implied shape"_err_en_US;
  }
} else if (!IsAllocatableOrPointer(symbol) && !isExplicit) {
  if (symbol.owner().IsDerivedType()) { // C749
    msg = "Component array '%s' without ALLOCATABLE or POINTER attribute must"
          " have explicit shape"_err_en_US;
  } else { // C816
    msg = "Array '%s' without ALLOCATABLE or POINTER attribute must have"
          " explicit shape"_err_en_US;
  }
}
if (msg) {
  context_.Say(std::move(*msg), symbol.name());
}
977}

979void CheckHelper::CheckProcEntity(
  const Symbol &symbol, const ProcEntityDetails &details) {
CheckSymbolType(symbol);
if (details.isDummy()) {
  if (!symbol.attrs().test(Attr::POINTER) && // C843
      (symbol.attrs().test(Attr::INTENT_IN) ||
          symbol.attrs().test(Attr::INTENT_OUT) ||
          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.procInterface()
  };
  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"
    // because it is explicitly legal to *pass* the specific intrinsic
    // function SIN as an actual argument.
    messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
  }
} else if (symbol.attrs().test(Attr::INTENT_IN) ||
    symbol.attrs().test(Attr::INTENT_OUT) ||
    symbol.attrs().test(Attr::INTENT_INOUT)) {
  messages_.Say("INTENT attributes may apply only to a dummy "
                "argument"_err_en_US); // C843
} else if (IsOptional(symbol)) {
  messages_.Say("OPTIONAL attribute may apply only to a dummy "
                "argument"_err_en_US); // C849
} else if (symbol.owner().IsDerivedType()) {
  if (!symbol.attrs().test(Attr::POINTER)) { // C756
    const auto &name{symbol.name()};
    messages_.Say(name,
        "Procedure component '%s' must have POINTER attribute"_err_en_US,
        name);
  }
  CheckPassArg(symbol, details.procInterface(), details);
}
if (IsPointer(symbol)) {
  CheckPointerInitialization(symbol);
  if (const Symbol * interface{details.procInterface()}) {
    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
    }
  }
}
CheckExternal(symbol);
1048}

1050// When a module subprogram has the MODULE prefix the following must match
1051// with the corresponding separate module procedure interface body:
1052// - C1549: characteristics and dummy argument names
1053// - C1550: binding label
1054// - C1551: NON_RECURSIVE prefix
1055class SubprogramMatchHelper {
1056public:
explicit SubprogramMatchHelper(CheckHelper &checkHelper)
    : checkHelper{checkHelper} {}

void Check(const Symbol &, const Symbol &);

1062private:
SemanticsContext &context() { return checkHelper.context(); }
void CheckDummyArg(const Symbol &, const Symbol &, const DummyArgument &,
    const DummyArgument &);
void CheckDummyDataObject(const Symbol &, const Symbol &,
    const DummyDataObject &, const DummyDataObject &);
void CheckDummyProcedure(const Symbol &, const Symbol &,
    const DummyProcedure &, const DummyProcedure &);
bool CheckSameIntent(
    const Symbol &, const Symbol &, common::Intent, common::Intent);
template <typename... A>
void Say(
    const Symbol &, const Symbol &, parser::MessageFixedText &&, A &&...);
template <typename ATTRS>
bool CheckSameAttrs(const Symbol &, const Symbol &, ATTRS, ATTRS);
bool ShapesAreCompatible(const DummyDataObject &, const DummyDataObject &);
evaluate::Shape FoldShape(const evaluate::Shape &);
std::string AsFortran(DummyDataObject::Attr attr) {
  return parser::ToUpperCaseLetters(DummyDataObject::EnumToString(attr));
}
std::string AsFortran(DummyProcedure::Attr attr) {
  return parser::ToUpperCaseLetters(DummyProcedure::EnumToString(attr));
}

CheckHelper &checkHelper;
1087};

1089// 15.6.2.6 para 3 - can the result of an ENTRY differ from its function?
1090bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) {
if (result.attrs.test(FunctionResult::Attr::Allocatable) ||
    result.attrs.test(FunctionResult::Attr::Pointer)) {
  return false;
}
const auto *typeAndShape{result.GetTypeAndShape()};
if (!typeAndShape || typeAndShape->Rank() != 0) {
  return false;
}
auto category{typeAndShape->type().category()};
if (category == TypeCategory::Character ||
    category == TypeCategory::Derived) {
  return false;
}
int kind{typeAndShape->type().kind()};
return kind == context_.GetDefaultKind(category) ||
    (category == TypeCategory::Real &&
        kind == context_.doublePrecisionKind());
1108}

1110void CheckHelper::CheckSubprogram(
  const Symbol &symbol, const SubprogramDetails &details) {
if (const Symbol *iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
  SubprogramMatchHelper{*this}.Check(symbol, *iface);
}
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() ||
          entryScope->parent().IsSubmodule())) {
    error = "ENTRY may not appear in an internal subprogram"_err_en_US;
  } else if (subprogramDetails && details.isFunction() &&
      subprogramDetails->isFunction() &&
      !context_.HasError(details.result()) &&
      !context_.HasError(subprogramDetails->result())) {
    auto result{FunctionResult::Characterize(
        details.result(), context_.foldingContext())};
    auto subpResult{FunctionResult::Characterize(
        subprogramDetails->result(), context_.foldingContext())};
    if (result && subpResult && *result != *subpResult &&
        (!IsResultOkToDiffer(*result) || !IsResultOkToDiffer(*subpResult))) {
      error =
          "Result of ENTRY is not compatible with result of containing function"_err_en_US;
    }
  }
  if (error) {
    if (auto *msg{messages_.Say(symbol.name(), *error)}) {
      if (subprogram) {
        msg->Attach(subprogram->name(), "Containing subprogram"_en_US);
      }
    }
  }
}
if (const MaybeExpr & stmtFunction{details.stmtFunction()}) {
  if (auto msg{evaluate::CheckStatementFunction(
          symbol, *stmtFunction, context_.foldingContext())}) {
    SayWithDeclaration(symbol, std::move(*msg));
  } else if (details.result().flags().test(Symbol::Flag::Implicit)) {
    // 15.6.4 p2 weird requirement
    if (const Symbol *
        host{symbol.owner().parent().FindSymbol(symbol.name())}) {
      evaluate::AttachDeclaration(
          messages_.Say(symbol.name(),
              "An implicitly typed statement function should not appear when the same symbol is available in its host scope"_port_en_US),
          *host);
    }
  }
  if (GetProgramUnitOrBlockConstructContaining(symbol).kind() ==
      Scope::Kind::BlockConstruct) { // C1107
    messages_.Say(symbol.name(),
        "A statement function definition may not appear in a BLOCK construct"_err_en_US);
  }
}
if (IsElementalProcedure(symbol)) {
  // See comment on the similar check in CheckProcEntity()
  if (details.isDummy()) {
    messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
  } else {
    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()) {
  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);
  }
}
CheckExternal(symbol);
CheckModuleProcedureDef(symbol);
1190}

1192void CheckHelper::CheckExternal(const Symbol &symbol) {
if (IsExternal(symbol)) {
  std::string interfaceName{symbol.name().ToString()};
  if (const auto *bind{symbol.GetBindName()}) {
    interfaceName = *bind;
  }
  if (const Symbol * global{FindGlobal(symbol)};
      global && global != &symbol) {
    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());
          }
        }
      }
      if (msg) {
        if (msg->IsFatal()) {
          context_.SetError(symbol);
        }
        evaluate::AttachDeclaration(msg, *global);
        evaluate::AttachDeclaration(msg, symbol);
      }
    }
  } else if (auto iter{externalNames_.find(interfaceName)};
             iter != externalNames_.end()) {
    const Symbol &previous{*iter->second};
    if (auto chars{Characterize(symbol)}) {
      if (auto previousChars{Characterize(previous)}) {
        std::string whyNot;
        if (!chars->IsCompatibleWith(*previousChars, &whyNot)) {
          if (auto *msg{messages_.Say(
                  "The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US,
                  symbol.name(), whyNot)}) {
            evaluate::AttachDeclaration(msg, previous);
            evaluate::AttachDeclaration(msg, symbol);
          }
        }
      }
    }
  } else {
    externalNames_.emplace(interfaceName, symbol);
  }
}
1257}

1259void CheckHelper::CheckDerivedType(
  const Symbol &derivedType, const DerivedTypeDetails &details) {
if (details.isForwardReferenced() && !context_.HasError(derivedType)) {
2
←
Assuming the condition is false→
  messages_.Say("The derived type '%s' has not been defined"_err_en_US,
      derivedType.name());
}
const Scope *scope{derivedType.scope()};
if (!scope) {
3
←
Assuming 'scope' is non-null→
  CHECK(details.isForwardReferenced())((details.isForwardReferenced()) || (Fortran::common::die("CHECK("
 "details.isForwardReferenced()" ") failed" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1267), false));
  return;
}
CHECK(scope->symbol() == &derivedType)((scope->symbol() == &derivedType) || (Fortran::common
::die("CHECK(" "scope->symbol() == &derivedType" ") failed"
 " at " "flang/lib/Semantics/check-declarations.cpp" "(%d)", 1270
), false));
4
←
Taking false branch→
5
←
Assuming the condition is true→
CHECK(scope->IsDerivedType())((scope->IsDerivedType()) || (Fortran::common::die("CHECK("
 "scope->IsDerivedType()" ") failed" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1271), false));
6
←
Assuming the condition is true→
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)}) {
7
←
Assuming 'parent' is non-null→
8
←
Taking true branch→
  const DerivedTypeSpec *parentDerived{parent->AsDerived()};
9
←
'parentDerived' initialized to a null pointer value→
  if (!IsExtensibleType(parentDerived)) { // C705
10
←
Assuming the condition is false→
    messages_.Say("The parent type is not extensible"_err_en_US);
  }
  if (!derivedType.attrs().test(Attr::ABSTRACT) && parentDerived10.1
'parentDerived' is null
 &&
      parentDerived->typeSymbol().attrs().test(Attr::ABSTRACT)) {
    ScopeComponentIterator components{*parentDerived};
    for (const Symbol &component : components) {
      if (component.attrs().test(Attr::DEFERRED)) {
        if (scope->FindComponent(component.name()) == &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());
        }
      }
    }
  }
  DerivedTypeSpec derived{derivedType.name(), derivedType};
  derived.set_scope(*scope);
  if (FindCoarrayUltimateComponent(derived) && // C736
11
←
Assuming the condition is false→
      !(parentDerived && FindCoarrayUltimateComponent(*parentDerived))) {
    messages_.Say(
        "Type '%s' has a coarray ultimate component so the type at the base "
        "of its type extension chain ('%s') must be a type that has a "
        "coarray ultimate component"_err_en_US,
        derivedType.name(), scope->GetDerivedTypeBase().GetSymbol()->name());
  }
  if (FindEventOrLockPotentialComponent(derived) && // C737
12
←
Assuming the condition is true→
      !(FindEventOrLockPotentialComponent(*parentDerived) ||
13
←
Forming reference to null pointer
          IsEventTypeOrLockType(parentDerived))) {
    messages_.Say(
        "Type '%s' has an EVENT_TYPE or LOCK_TYPE component, so the type "
        "at the base of its type extension chain ('%s') must either have an "
        "EVENT_TYPE or LOCK_TYPE component, or be EVENT_TYPE or "
        "LOCK_TYPE"_err_en_US,
        derivedType.name(), scope->GetDerivedTypeBase().GetSymbol()->name());
  }
}
if (HasIntrinsicTypeName(derivedType)) { // C729
  messages_.Say("A derived type name cannot be the name of an intrinsic"
                " type"_err_en_US);
}
std::map<SourceName, SymbolRef> previous;
for (const auto &pair : details.finals()) {
  SourceName source{pair.first};
  const Symbol &ref{*pair.second};
  if (CheckFinal(ref, source, derivedType) &&
      std::all_of(previous.begin(), previous.end(),
          [&](std::pair<SourceName, SymbolRef> prev) {
            return CheckDistinguishableFinals(
                ref, source, *prev.second, prev.first, derivedType);
          })) {
    previous.emplace(source, ref);
  }
}
1332}

1334// C786
1335bool CheckHelper::CheckFinal(
  const Symbol &subroutine, SourceName finalName, const Symbol &derivedType) {
if (!IsModuleProcedure(subroutine)) {
  SayWithDeclaration(subroutine, finalName,
      "FINAL subroutine '%s' of derived type '%s' must be a module procedure"_err_en_US,
      subroutine.name(), derivedType.name());
  return false;
}
const Procedure *proc{Characterize(subroutine)};
if (!proc) {
  return false; // error recovery
}
if (!proc->IsSubroutine()) {
  SayWithDeclaration(subroutine, finalName,
      "FINAL subroutine '%s' of derived type '%s' must be a subroutine"_err_en_US,
      subroutine.name(), derivedType.name());
  return false;
}
if (proc->dummyArguments.size() != 1) {
  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]}) {
      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,
      subroutine.name(), derivedType.name());
  return false;
}
bool ok{true};
if (arg.IsOptional()) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have an OPTIONAL dummy argument"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->attrs.test(DummyDataObject::Attr::Allocatable)) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have an ALLOCATABLE dummy argument"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->attrs.test(DummyDataObject::Attr::Pointer)) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have a POINTER dummy argument"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->intent == common::Intent::Out) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have a dummy argument with INTENT(OUT)"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->attrs.test(DummyDataObject::Attr::Value)) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have a dummy argument with the VALUE attribute"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->type.corank() > 0) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have a coarray dummy argument"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
}
if (ddo->type.type().IsPolymorphic()) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must not have a polymorphic dummy argument"_err_en_US,
      subroutine.name(), derivedType.name());
  ok = false;
} else if (ddo->type.type().category() != TypeCategory::Derived ||
    &ddo->type.type().GetDerivedTypeSpec().typeSymbol() != &derivedType) {
  SayWithDeclaration(*errSym, finalName,
      "FINAL subroutine '%s' of derived type '%s' must have a TYPE(%s) dummy argument"_err_en_US,
      subroutine.name(), derivedType.name(), derivedType.name());
  ok = false;
} else { // check that all LEN type parameters are assumed
  for (auto ref : OrderParameterDeclarations(derivedType)) {
    if (IsLenTypeParameter(*ref)) {
      const auto *value{
          ddo->type.type().GetDerivedTypeSpec().FindParameter(ref->name())};
      if (!value || !value->isAssumed()) {
        SayWithDeclaration(*errSym, finalName,
            "FINAL subroutine '%s' of derived type '%s' must have a dummy argument with an assumed LEN type parameter '%s=*'"_err_en_US,
            subroutine.name(), derivedType.name(), ref->name());
        ok = false;
      }
    }
  }
}
return ok;
1438}

1440bool CheckHelper::CheckDistinguishableFinals(const Symbol &f1,
  SourceName f1Name, const Symbol &f2, SourceName f2Name,
  const Symbol &derivedType) {
const Procedure *p1{Characterize(f1)};
const Procedure *p2{Characterize(f2)};
if (p1 && p2) {
  if (characteristics::Distinguishable(
          context_.languageFeatures(), *p1, *p2)) {
    return true;
  }
  if (auto *msg{messages_.Say(f1Name,
          "FINAL subroutines '%s' and '%s' of derived type '%s' cannot be distinguished by rank or KIND type parameter value"_err_en_US,
          f1Name, f2Name, derivedType.name())}) {
    msg->Attach(f2Name, "FINAL declaration of '%s'"_en_US, f2.name())
        .Attach(f1.name(), "Definition of '%s'"_en_US, f1Name)
        .Attach(f2.name(), "Definition of '%s'"_en_US, f2Name);
  }
}
return false;
1459}

1461void CheckHelper::CheckHostAssoc(
  const Symbol &symbol, const HostAssocDetails &details) {
const Symbol &hostSymbol{details.symbol()};
if (hostSymbol.test(Symbol::Flag::ImplicitOrError)) {
  if (details.implicitOrSpecExprError) {
    messages_.Say("Implicitly typed local entity '%s' not allowed in"
                  " specification expression"_err_en_US,
        symbol.name());
  } else if (details.implicitOrExplicitTypeError) {
    messages_.Say(
        "No explicit type declared for '%s'"_err_en_US, symbol.name());
  }
}
1474}

1476void CheckHelper::CheckGeneric(
  const Symbol &symbol, const GenericDetails &details) {
CheckSpecifics(symbol, details);
common::visit(common::visitors{
                  [&](const common::DefinedIo &io) {
                    CheckDefinedIoProc(symbol, details, io);
                  },
                  [&](const GenericKind::OtherKind &other) {
                    if (other == GenericKind::OtherKind::Name) {
                      CheckGenericVsIntrinsic(symbol, details);
                    }
                  },
                  [](const auto &) {},
              },
    details.kind().u);
// Ensure that shadowed symbols are checked
if (details.specific()) {
  Check(*details.specific());
}
if (details.derivedType()) {
  Check(*details.derivedType());
}
1498}

1500// Check that the specifics of this generic are distinguishable from each other
1501void CheckHelper::CheckSpecifics(
  const Symbol &generic, const GenericDetails &details) {
GenericKind kind{details.kind()};
DistinguishabilityHelper helper{context_};
for (const Symbol &specific : details.specificProcs()) {
  if (specific.attrs().test(Attr::ABSTRACT)) {
    if (auto *msg{messages_.Say(generic.name(),
            "Generic interface '%s' must not use abstract interface '%s' as a specific procedure"_err_en_US,
            generic.name(), specific.name())}) {
      msg->Attach(
          specific.name(), "Definition of '%s'"_en_US, specific.name());
    }
    continue;
  }
  if (specific.attrs().test(Attr::INTRINSIC)) {
    if (auto *msg{messages_.Say(specific.name(),
            "Specific procedure '%s' of generic interface '%s' may not be INTRINSIC"_err_en_US,
            specific.name(), generic.name())}) {
      msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name());
    }
    continue;
  }
  if (IsStmtFunction(specific)) {
    if (auto *msg{messages_.Say(specific.name(),
            "Specific procedure '%s' of generic interface '%s' may not be a statement function"_err_en_US,
            specific.name(), generic.name())}) {
      msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name());
    }
    continue;
  }
  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());
      }
    }
  }
}
helper.Check(generic.owner());
1545}

1547static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) {
auto lhs{std::get<DummyDataObject>(proc.dummyArguments[0].u).type};
auto rhs{std::get<DummyDataObject>(proc.dummyArguments[1].u).type};
return Tristate::No ==
    IsDefinedAssignment(lhs.type(), lhs.Rank(), rhs.type(), rhs.Rank());
1552}

1554static bool ConflictsWithIntrinsicOperator(
  const GenericKind &kind, const Procedure &proc) {
if (!kind.IsIntrinsicOperator()) {
  return false;
}
auto arg0{std::get<DummyDataObject>(proc.dummyArguments[0].u).type};
auto type0{arg0.type()};
if (proc.dummyArguments.size() == 1) { // unary
  return common::visit(
      common::visitors{
          [&](common::NumericOperator) { return IsIntrinsicNumeric(type0); },
          [&](common::LogicalOperator) { return IsIntrinsicLogical(type0); },
          [](const auto &) -> bool { DIE("bad generic kind")Fortran::common::die("bad generic kind" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1566); },
      },
      kind.u);
} else { // binary
  int rank0{arg0.Rank()};
  auto arg1{std::get<DummyDataObject>(proc.dummyArguments[1].u).type};
  auto type1{arg1.type()};
  int rank1{arg1.Rank()};
  return common::visit(
      common::visitors{
          [&](common::NumericOperator) {
            return IsIntrinsicNumeric(type0, rank0, type1, rank1);
          },
          [&](common::LogicalOperator) {
            return IsIntrinsicLogical(type0, rank0, type1, rank1);
          },
          [&](common::RelationalOperator opr) {
            return IsIntrinsicRelational(opr, type0, rank0, type1, rank1);
          },
          [&](GenericKind::OtherKind x) {
            CHECK(x == GenericKind::OtherKind::Concat)((x == GenericKind::OtherKind::Concat) || (Fortran::common::die
("CHECK(" "x == GenericKind::OtherKind::Concat" ") failed" " at "
 "flang/lib/Semantics/check-declarations.cpp" "(%d)", 1586), false
));
            return IsIntrinsicConcat(type0, rank0, type1, rank1);
          },
          [](const auto &) -> bool { DIE("bad generic kind")Fortran::common::die("bad generic kind" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1589); },
      },
      kind.u);
}
1593}

1595// Check if this procedure can be used for defined operators (see 15.4.3.4.2).
1596bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind,
  const Symbol &specific, const Procedure &proc) {
if (context_.HasError(specific)) {
  return false;
}
std::optional<parser::MessageFixedText> msg;
auto checkDefinedOperatorArgs{
    [&](SourceName opName, const Symbol &specific, const Procedure &proc) {
      bool arg0Defined{CheckDefinedOperatorArg(opName, specific, proc, 0)};
      bool arg1Defined{CheckDefinedOperatorArg(opName, specific, proc, 1)};
      return arg0Defined && arg1Defined;
    }};
if (specific.attrs().test(Attr::NOPASS)) { // C774
  msg = "%s procedure '%s' may not have NOPASS attribute"_err_en_US;
} else if (!proc.functionResult.has_value()) {
  msg = "%s procedure '%s' must be a function"_err_en_US;
} else if (proc.functionResult->IsAssumedLengthCharacter()) {
  const auto *subpDetails{specific.detailsIf<SubprogramDetails>()};
  if (subpDetails && !subpDetails->isDummy() && subpDetails->isInterface()) {
    // Error is caught by more general test for interfaces with
    // assumed-length character function results
    return true;
  }
  msg = "%s function '%s' may not have assumed-length CHARACTER(*)"
        " result"_err_en_US;
} else if (auto m{CheckNumberOfArgs(kind, proc.dummyArguments.size())}) {
  msg = std::move(m);
} else if (!checkDefinedOperatorArgs(opName, specific, proc)) {
  return false; // error was reported
} else if (ConflictsWithIntrinsicOperator(kind, proc)) {
  msg = "%s function '%s' conflicts with intrinsic operator"_err_en_US;
} else {
  return true; // OK
}
bool isFatal{msg->IsFatal()};
SayWithDeclaration(
    specific, std::move(*msg), MakeOpName(opName), specific.name());
if (isFatal) {
  context_.SetError(specific);
}
return false;
1637}

1639// If the number of arguments is wrong for this intrinsic operator, return
1640// false and return the error message in msg.
1641std::optional<parser::MessageFixedText> CheckHelper::CheckNumberOfArgs(
  const GenericKind &kind, std::size_t nargs) {
if (!kind.IsIntrinsicOperator()) {
  if (nargs < 1 || nargs > 2) {
    return "%s function '%s' should have 1 or 2 dummy arguments"_warn_en_US;
  }
  return std::nullopt;
}
std::size_t min{2}, max{2}; // allowed number of args; default is binary
common::visit(common::visitors{
                  [&](const common::NumericOperator &x) {
                    if (x == common::NumericOperator::Add ||
                        x == common::NumericOperator::Subtract) {
                      min = 1; // + and - are unary or binary
                    }
                  },
                  [&](const common::LogicalOperator &x) {
                    if (x == common::LogicalOperator::Not) {
                      min = 1; // .NOT. is unary
                      max = 1;
                    }
                  },
                  [](const common::RelationalOperator &) {
                    // all are binary
                  },
                  [](const GenericKind::OtherKind &x) {
                    CHECK(x == GenericKind::OtherKind::Concat)((x == GenericKind::OtherKind::Concat) || (Fortran::common::die
("CHECK(" "x == GenericKind::OtherKind::Concat" ") failed" " at "
 "flang/lib/Semantics/check-declarations.cpp" "(%d)", 1667), false
));
                  },
                  [](const auto &) { DIE("expected intrinsic operator")Fortran::common::die("expected intrinsic operator" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1669); },
              },
    kind.u);
if (nargs >= min && nargs <= max) {
  return std::nullopt;
} else if (max == 1) {
  return "%s function '%s' must have one dummy argument"_err_en_US;
} else if (min == 2) {
  return "%s function '%s' must have two dummy arguments"_err_en_US;
} else {
  return "%s function '%s' must have one or two dummy arguments"_err_en_US;
}
1681}

1683bool CheckHelper::CheckDefinedOperatorArg(const SourceName &opName,
  const Symbol &symbol, const Procedure &proc, std::size_t pos) {
if (pos >= proc.dummyArguments.size()) {
  return true;
}
auto &arg{proc.dummyArguments.at(pos)};
std::optional<parser::MessageFixedText> msg;
if (arg.IsOptional()) {
  msg = "In %s function '%s', dummy argument '%s' may not be"
        " OPTIONAL"_err_en_US;
} else if (const auto *dataObject{std::get_if<DummyDataObject>(&arg.u)};
           dataObject == nullptr) {
  msg = "In %s function '%s', dummy argument '%s' must be a"
        " data object"_err_en_US;
} else if (dataObject->intent != common::Intent::In &&
    !dataObject->attrs.test(DummyDataObject::Attr::Value)) {
  msg = "In %s function '%s', dummy argument '%s' must have INTENT(IN)"
        " or VALUE attribute"_err_en_US;
}
if (msg) {
  SayWithDeclaration(symbol, std::move(*msg),
      parser::ToUpperCaseLetters(opName.ToString()), symbol.name(), arg.name);
  return false;
}
return true;
1708}

1710// Check if this procedure can be used for defined assignment (see 15.4.3.4.3).
1711bool CheckHelper::CheckDefinedAssignment(
  const Symbol &specific, const Procedure &proc) {
if (context_.HasError(specific)) {
  return false;
}
std::optional<parser::MessageFixedText> msg;
if (specific.attrs().test(Attr::NOPASS)) { // C774
  msg = "Defined assignment procedure '%s' may not have"
        " NOPASS attribute"_err_en_US;
} else if (!proc.IsSubroutine()) {
  msg = "Defined assignment procedure '%s' must be a subroutine"_err_en_US;
} else if (proc.dummyArguments.size() != 2) {
  msg = "Defined assignment subroutine '%s' must have"
        " two dummy arguments"_err_en_US;
} else {
  // Check both arguments even if the first has an error.
  bool ok0{CheckDefinedAssignmentArg(specific, proc.dummyArguments[0], 0)};
  bool ok1{CheckDefinedAssignmentArg(specific, proc.dummyArguments[1], 1)};
  if (!(ok0 && ok1)) {
    return false; // error was reported
  } else if (ConflictsWithIntrinsicAssignment(proc)) {
    msg = "Defined assignment subroutine '%s' conflicts with"
          " intrinsic assignment"_err_en_US;
  } else {
    return true; // OK
  }
}
SayWithDeclaration(specific, std::move(msg.value()), specific.name());
context_.SetError(specific);
return false;
1741}

1743bool CheckHelper::CheckDefinedAssignmentArg(
  const Symbol &symbol, const DummyArgument &arg, int pos) {
std::optional<parser::MessageFixedText> msg;
if (arg.IsOptional()) {
  msg = "In defined assignment subroutine '%s', dummy argument '%s'"
        " may not be OPTIONAL"_err_en_US;
} else if (const auto *dataObject{std::get_if<DummyDataObject>(&arg.u)}) {
  if (pos == 0) {
    if (dataObject->intent != common::Intent::Out &&
        dataObject->intent != common::Intent::InOut) {
      msg = "In defined assignment subroutine '%s', first dummy argument '%s'"
            " must have INTENT(OUT) or INTENT(INOUT)"_err_en_US;
    }
  } else if (pos == 1) {
    if (dataObject->intent != common::Intent::In &&
        !dataObject->attrs.test(DummyDataObject::Attr::Value)) {
      msg =
          "In defined assignment subroutine '%s', second dummy"
          " argument '%s' must have INTENT(IN) or VALUE attribute"_err_en_US;
    } else if (dataObject->attrs.test(DummyDataObject::Attr::Pointer)) {
      msg =
          "In defined assignment subroutine '%s', second dummy argument '%s' must not be a pointer"_err_en_US;
    } else if (dataObject->attrs.test(DummyDataObject::Attr::Allocatable)) {
      msg =
          "In defined assignment subroutine '%s', second dummy argument '%s' must not be an allocatable"_err_en_US;
    }
  } else {
    DIE("pos must be 0 or 1")Fortran::common::die("pos must be 0 or 1" " at " "flang/lib/Semantics/check-declarations.cpp"
 "(%d)", 1770);
  }
} else {
  msg = "In defined assignment subroutine '%s', dummy argument '%s'"
        " must be a data object"_err_en_US;
}
if (msg) {
  SayWithDeclaration(symbol, std::move(*msg), symbol.name(), arg.name);
  context_.SetError(symbol);
  return false;
}
return true;
1782}

1784// Report a conflicting attribute error if symbol has both of these attributes
1785bool CheckHelper::CheckConflicting(const Symbol &symbol, Attr a1, Attr a2) {
if (symbol.attrs().test(a1) && symbol.attrs().test(a2)) {
  messages_.Say("'%s' may not have both the %s and %s attributes"_err_en_US,
      symbol.name(), AttrToString(a1), AttrToString(a2));
  return true;
} else {
  return false;
}
1793}

1795void CheckHelper::WarnMissingFinal(const Symbol &symbol) {
const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
if (!object ||
    (!IsAutomaticallyDestroyed(symbol) &&
        symbol.owner().kind() != Scope::Kind::DerivedType)) {
  return;
}
const DeclTypeSpec *type{object->type()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
const Symbol *derivedSym{derived ? &derived->typeSymbol() : nullptr};
int rank{object->shape().Rank()};
const Symbol *initialDerivedSym{derivedSym};
while (const auto *derivedDetails{
    derivedSym ? derivedSym->detailsIf<DerivedTypeDetails>() : nullptr}) {
  if (!derivedDetails->finals().empty() &&
      !derivedDetails->GetFinalForRank(rank)) {
    if (auto *msg{derivedSym == initialDerivedSym
                ? messages_.Say(symbol.name(),
                      "'%s' of derived type '%s' does not have a FINAL subroutine for its rank (%d)"_warn_en_US,
                      symbol.name(), derivedSym->name(), rank)
                : messages_.Say(symbol.name(),
                      "'%s' of derived type '%s' extended from '%s' does not have a FINAL subroutine for its rank (%d)"_warn_en_US,
                      symbol.name(), initialDerivedSym->name(),
                      derivedSym->name(), rank)}) {
      msg->Attach(derivedSym->name(),
          "Declaration of derived type '%s'"_en_US, derivedSym->name());
    }
    return;
  }
  derived = derivedSym->GetParentTypeSpec();
  derivedSym = derived ? &derived->typeSymbol() : nullptr;
}
1827}

1829const Procedure *CheckHelper::Characterize(const Symbol &symbol) {
auto it{characterizeCache_.find(symbol)};
if (it == characterizeCache_.end()) {
  auto pair{characterizeCache_.emplace(SymbolRef{symbol},
      Procedure::Characterize(symbol, context_.foldingContext()))};
  it = pair.first;
}
return common::GetPtrFromOptional(it->second);
1837}

1839void CheckHelper::CheckVolatile(const Symbol &symbol,
  const DerivedTypeSpec *derived) { // C866 - C868
if (IsIntentIn(symbol)) {
  messages_.Say(
      "VOLATILE attribute may not apply to an INTENT(IN) argument"_err_en_US);
}
if (IsProcedure(symbol)) {
  messages_.Say("VOLATILE attribute may apply only to a variable"_err_en_US);
}
if (symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()) {
  const Symbol &ultimate{symbol.GetUltimate()};
  if (evaluate::IsCoarray(ultimate)) {
    messages_.Say(
        "VOLATILE attribute may not apply to a coarray accessed by USE or host association"_err_en_US);
  }
  if (derived) {
    if (FindCoarrayUltimateComponent(*derived)) {
      messages_.Say(
          "VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association"_err_en_US);
    }
  }
}
1861}

1863void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
CheckConflicting(symbol, Attr::POINTER, Attr::TARGET);
CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE); // C751
CheckConflicting(symbol, Attr::POINTER, Attr::INTRINSIC);
// Prohibit constant pointers.  The standard does not explicitly prohibit
// them, but the PARAMETER attribute requires a entity-decl to have an
// initialization that is a constant-expr, and the only form of
// initialization that allows a constant-expr is the one that's not a "=>"
// pointer initialization.  See C811, C807, and section 8.5.13.
CheckConflicting(symbol, Attr::POINTER, Attr::PARAMETER);
if (symbol.Corank() > 0) {
  messages_.Say(
      "'%s' may not have the POINTER attribute because it is a coarray"_err_en_US,
      symbol.name());
}
1878}

1880// C760 constraints on the passed-object dummy argument
1881// C757 constraints on procedure pointer components
1882void 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
};
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) {
  messages_.Say(name,
      "Procedure component '%s' has invalid interface '%s'"_err_en_US, name,
      interface->name());
  return;
}
std::optional<SourceName> passName{details.passName()};
const auto &dummyArgs{subprogram->dummyArgs()};
if (!passName) {
  if (dummyArgs.empty()) {
    messages_.Say(name,
        proc.has<ProcEntityDetails>()
            ? "Procedure component '%s' with no dummy arguments"
              " must have NOPASS attribute"_err_en_US
            : "Procedure binding '%s' with no dummy arguments"
              " must have NOPASS attribute"_err_en_US,
        name);
    context_.SetError(*interface);
    return;
  }
  Symbol *argSym{dummyArgs[0]};
  if (!argSym) {
    messages_.Say(interface->name(),
        "Cannot use an alternate return as the passed-object dummy "
        "argument"_err_en_US);
    return;
  }
  passName = dummyArgs[0]->name();
}
std::optional<int> passArgIndex{};
for (std::size_t i{0}; i < dummyArgs.size(); ++i) {
  if (dummyArgs[i] && dummyArgs[i]->name() == *passName) {
    passArgIndex = i;
    break;
  }
}
if (!passArgIndex) { // C758
  messages_.Say(*passName,
      "'%s' is not a dummy argument of procedure interface '%s'"_err_en_US,
      *passName, interface->name());
  return;
}
const Symbol &passArg{*dummyArgs[*passArgIndex]};
std::optional<parser::MessageFixedText> msg;
if (!passArg.has<ObjectEntityDetails>()) {
  msg = "Passed-object dummy argument '%s' of procedure '%s'"
        " must be a data object"_err_en_US;
} else if (passArg.attrs().test(Attr::POINTER)) {
  msg = "Passed-object dummy argument '%s' of procedure '%s'"
        " may not have the POINTER attribute"_err_en_US;
} else if (passArg.attrs().test(Attr::ALLOCATABLE)) {
  msg = "Passed-object dummy argument '%s' of procedure '%s'"
        " may not have the ALLOCATABLE attribute"_err_en_US;
} else if (passArg.attrs().test(Attr::VALUE)) {
  msg = "Passed-object dummy argument '%s' of procedure '%s'"
        " may not have the VALUE attribute"_err_en_US;
} else if (passArg.Rank() > 0) {
  msg = "Passed-object dummy argument '%s' of procedure '%s'"
        " must be scalar"_err_en_US;
}
if (msg) {
  messages_.Say(name, std::move(*msg), passName.value(), name);
  return;
}
const DeclTypeSpec *type{passArg.GetType()};
if (!type) {
  return; // an error already occurred
}
const Symbol &typeSymbol{*proc.owner().GetSymbol()};
const DerivedTypeSpec *derived{type->AsDerived()};
if (!derived || derived->typeSymbol() != typeSymbol) {
  messages_.Say(name,
      "Passed-object dummy argument '%s' of procedure '%s'"
      " must be of type '%s' but is '%s'"_err_en_US,
      passName.value(), name, typeSymbol.name(), type->AsFortran());
  return;
}
if (IsExtensibleType(derived) != type->IsPolymorphic()) {
  messages_.Say(name,
      type->IsPolymorphic()
          ? "Passed-object dummy argument '%s' of procedure '%s'"
            " may not be polymorphic because '%s' is not extensible"_err_en_US
          : "Passed-object dummy argument '%s' of procedure '%s'"
            " must be polymorphic because '%s' is extensible"_err_en_US,
      passName.value(), name, typeSymbol.name());
  return;
}
for (const auto &[paramName, paramValue] : derived->parameters()) {
  if (paramValue.isLen() && !paramValue.isAssumed()) {
    messages_.Say(name,
        "Passed-object dummy argument '%s' of procedure '%s'"
        " has non-assumed length parameter '%s'"_err_en_US,
        passName.value(), name, paramName);
  }
}
1993}

1995void CheckHelper::CheckProcBinding(
  const Symbol &symbol, const ProcBindingDetails &binding) {
const Scope &dtScope{symbol.owner()};
CHECK(dtScope.kind() == Scope::Kind::DerivedType)((dtScope.kind() == Scope::Kind::DerivedType) || (Fortran::common
::die("CHECK(" "dtScope.kind() == Scope::Kind::DerivedType" ") failed"
 " at " "flang/lib/Semantics/check-declarations.cpp" "(%d)", 1998
), false));
if (symbol.attrs().test(Attr::DEFERRED)) {
  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 (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)) {
      SayWithDeclaration(*overridden,
          "An overridden pure type-bound procedure binding must also be pure"_err_en_US);
      return;
    }
    if (!IsElementalProcedure(binding.symbol()) &&
        IsElementalProcedure(*overridden)) {
      SayWithDeclaration(*overridden,
          "A type-bound procedure and its override must both, or neither, be ELEMENTAL"_err_en_US);
      return;
    }
    bool isNopass{symbol.attrs().test(Attr::NOPASS)};
    if (isNopass != overridden->attrs().test(Attr::NOPASS)) {
      SayWithDeclaration(*overridden,
          isNopass
              ? "A NOPASS type-bound procedure may not override a passed-argument procedure"_err_en_US
              : "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US);
    } else {
      const auto *bindingChars{Characterize(binding.symbol())};
      const auto *overriddenChars{Characterize(*overridden)};
      if (bindingChars && overriddenChars) {
        if (isNopass) {
          if (!bindingChars->CanOverride(*overriddenChars, std::nullopt)) {
            SayWithDeclaration(*overridden,
                "A NOPASS type-bound procedure and its override must have identical interfaces"_err_en_US);
          }
        } else if (!context_.HasError(binding.symbol())) {
          int passIndex{bindingChars->FindPassIndex(binding.passName())};
          int overriddenPassIndex{
              overriddenChars->FindPassIndex(overriddenBinding->passName())};
          if (passIndex != overriddenPassIndex) {
            SayWithDeclaration(*overridden,
                "A type-bound procedure and its override must use the same PASS argument"_err_en_US);
          } else if (!bindingChars->CanOverride(
                         *overriddenChars, passIndex)) {
            SayWithDeclaration(*overridden,
                "A type-bound procedure and its override must have compatible interfaces"_err_en_US);
          }
        }
      }
    }
    if (symbol.attrs().test(Attr::PRIVATE)) {
      if (FindModuleContaining(dtScope) ==
          FindModuleContaining(overridden->owner())) {
        // types declared in same madule
        if (!overridden->attrs().test(Attr::PRIVATE)) {
          SayWithDeclaration(*overridden,
              "A PRIVATE procedure may not override a PUBLIC procedure"_err_en_US);
        }
      } else { // types declared in distinct madules
        if (!CheckAccessibleSymbol(dtScope.parent(), *overridden)) {
          SayWithDeclaration(*overridden,
              "A PRIVATE procedure may not override an accessible procedure"_err_en_US);
        }
      }
    }
  } else {
    SayWithDeclaration(*overridden,
        "A type-bound procedure binding may not have the same name as a parent component"_err_en_US);
  }
}
CheckPassArg(symbol, &binding.symbol(), binding);
2090}

2092void CheckHelper::Check(const Scope &scope) {
scope_ = &scope;
common::Restorer<const Symbol *> restorer{innermostSymbol_, innermostSymbol_};
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);
  }
} else {
  auto restorer{common::ScopedSet(
      scopeIsUninstantiatedPDT_, scope.IsParameterizedDerivedType())};
  for (const auto &set : scope.equivalenceSets()) {
    CheckEquivalenceSet(set);
  }
  for (const auto &pair : scope) {
    Check(*pair.second);
  }
  for (const auto &pair : scope.commonBlocks()) {
    CheckCommonBlock(*pair.second);
  }
  int mainProgCnt{0};
  for (const Scope &child : scope.children()) {
    Check(child);
    // A program shall consist of exactly one main program (5.2.2).
    if (child.kind() == Scope::Kind::MainProgram) {
      ++mainProgCnt;
      if (mainProgCnt > 1) {
        messages_.Say(child.sourceRange(),
            "A source file cannot contain more than one main program"_err_en_US);
      }
    }
  }
  if (scope.kind() == Scope::Kind::BlockData) {
    CheckBlockData(scope);
  }
  if (auto name{scope.GetName()}) {
    auto iter{scope.find(*name)};
    if (iter != scope.end()) {
      const char *kind{nullptr};
      switch (scope.kind()) {
      case Scope::Kind::Module:
        kind = scope.symbol()->get<ModuleDetails>().isSubmodule()
            ? "submodule"
            : "module";
        break;
      case Scope::Kind::MainProgram:
        kind = "main program";
        break;
      case Scope::Kind::BlockData:
        kind = "BLOCK DATA subprogram";
        break;
      default:;
      }
      if (kind) {
        messages_.Say(iter->second->name(),
            "Name '%s' declared in a %s should not have the same name as the %s"_port_en_US,
            *name, kind, kind);
      }
    }
  }
  CheckGenericOps(scope);
}
2159}

2161void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) {
auto iter{
    std::find_if(set.begin(), set.end(), [](const EquivalenceObject &object) {
      return FindCommonBlockContaining(object.symbol) != nullptr;
    })};
if (iter != set.end()) {
  const Symbol &commonBlock{DEREF(FindCommonBlockContaining(iter->symbol))Fortran::common::Deref(FindCommonBlockContaining(iter->symbol
), "flang/lib/Semantics/check-declarations.cpp", 2167)};
  for (auto &object : set) {
    if (&object != &*iter) {
      if (auto *details{object.symbol.detailsIf<ObjectEntityDetails>()}) {
        if (details->commonBlock()) {
          if (details->commonBlock() != &commonBlock) { // 8.10.3 paragraph 1
            if (auto *msg{messages_.Say(object.symbol.name(),
                    "Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks"_err_en_US)}) {
              msg->Attach(iter->symbol.name(),
                     "Other object in EQUIVALENCE set"_en_US)
                  .Attach(details->commonBlock()->name(),
                      "COMMON block containing '%s'"_en_US,
                      object.symbol.name())
                  .Attach(commonBlock.name(),
                      "COMMON block containing '%s'"_en_US,
                      iter->symbol.name());
            }
          }
        } else {
          // Mark all symbols in the equivalence set with the same COMMON
          // block to prevent spurious error messages about initialization
          // in BLOCK DATA outside COMMON
          details->set_commonBlock(commonBlock);
        }
      }
    }
  }
}
// TODO: Move C8106 (&al.) checks here from resolve-names-utils.cpp
2196}

2198void CheckHelper::CheckBlockData(const Scope &scope) {
// BLOCK DATA subprograms should contain only named common blocks.
// C1415 presents a list of statements that shouldn't appear in
// BLOCK DATA, but so long as the subprogram contains no executable
// code and allocates no storage outside named COMMON, we're happy
// (e.g., an ENUM is strictly not allowed).
for (const auto &pair : scope) {
  const Symbol &symbol{*pair.second};
  if (!(symbol.has<CommonBlockDetails>() || symbol.has<UseDetails>() ||
          symbol.has<UseErrorDetails>() || symbol.has<DerivedTypeDetails>() ||
          symbol.has<SubprogramDetails>() ||
          symbol.has<ObjectEntityDetails>() ||
          (symbol.has<ProcEntityDetails>() &&
              !symbol.attrs().test(Attr::POINTER)))) {
    messages_.Say(symbol.name(),
        "'%s' may not appear in a BLOCK DATA subprogram"_err_en_US,
        symbol.name());
  }
}
2217}

2219// Check distinguishability of generic assignment and operators.
2220// For these, generics and generic bindings must be considered together.
2221void 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)};
          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 (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()}) {
      for (const auto &pair2 : *typeScope) {
        addSpecifics(*pair2.second);
      }
    }
  }
}
helper.Check(scope);
2272}

2274static bool IsSubprogramDefinition(const Symbol &symbol) {
const auto *subp{symbol.detailsIf<SubprogramDetails>()};
return subp && !subp->isInterface() && symbol.scope() &&
    symbol.scope()->kind() == Scope::Kind::Subprogram;
2278}

2280static bool IsBlockData(const Symbol &symbol) {
return symbol.scope() && symbol.scope()->kind() == Scope::Kind::BlockData;
2282}

2284static bool IsExternalProcedureDefinition(const Symbol &symbol) {
return IsBlockData(symbol) ||
    (IsSubprogramDefinition(symbol) &&
        (IsExternal(symbol) || symbol.GetBindName()));
2288}

2290static std::optional<std::string> DefinesGlobalName(const Symbol &symbol) {
if (const auto *module{symbol.detailsIf<ModuleDetails>()}) {
  if (!module->isSubmodule() && !symbol.owner().IsIntrinsicModules()) {
    return symbol.name().ToString();
  }
} else if (IsBlockData(symbol)) {
  return symbol.name().ToString();
} else {
  const std::string *bindC{symbol.GetBindName()};
  if (symbol.has<CommonBlockDetails>() ||
      IsExternalProcedureDefinition(symbol)) {
    return bindC ? *bindC : symbol.name().ToString();
  } else if (bindC &&
      (symbol.has<ObjectEntityDetails>() || IsModuleProcedure(symbol))) {
    return *bindC;
  }
}
return std::nullopt;
2308}

2310// 19.2 p2
2311void CheckHelper::CheckGlobalName(const Symbol &symbol) {
if (auto global{DefinesGlobalName(symbol)}) {
  auto pair{globalNames_.emplace(std::move(*global), symbol)};
  if (!pair.second) {
    const Symbol &other{*pair.first->second};
    if (context_.HasError(symbol) || context_.HasError(other)) {
      // don't pile on
    } else if (symbol.has<CommonBlockDetails>() &&
        other.has<CommonBlockDetails>() && symbol.name() == other.name()) {
      // Two common blocks can have the same global name so long as
      // they're not in the same scope.
    } else if ((IsProcedure(symbol) || IsBlockData(symbol)) &&
        (IsProcedure(other) || IsBlockData(other)) &&
        (!IsExternalProcedureDefinition(symbol) ||
            !IsExternalProcedureDefinition(other))) {
      // both are procedures/BLOCK DATA, not both definitions
    } else if (symbol.has<ModuleDetails>()) {
      messages_.Say(symbol.name(),
          "Module '%s' conflicts with a global name"_port_en_US,
          pair.first->first);
    } else if (other.has<ModuleDetails>()) {
      messages_.Say(symbol.name(),
          "Global name '%s' conflicts with a module"_port_en_US,
          pair.first->first);
    } else if (auto *msg{messages_.Say(symbol.name(),
                   "Two entities have the same global name '%s'"_err_en_US,
                   pair.first->first)}) {
      msg->Attach(other.name(), "Conflicting declaration"_en_US);
      context_.SetError(symbol);
      context_.SetError(other);
    }
  }
}
2344}

2346void CheckHelper::CheckBindC(const Symbol &symbol) {
bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
if (isExplicitBindC) {
  CheckConflicting(symbol, Attr::BIND_C, Attr::PARAMETER);
  CheckConflicting(symbol, Attr::BIND_C, Attr::ELEMENTAL);
} else {
  // symbol must be interoperable (e.g., dummy argument of interoperable
  // procedure interface) but is not itself BIND(C).
}
if (const std::string * bindName{symbol.GetBindName()};
    bindName) { // has a binding name
  if (!bindName->empty()) {
    bool ok{bindName->front() == '_' || parser::IsLetter(bindName->front())};
    for (char ch : *bindName) {
      ok &= ch == '_' || parser::IsLetter(ch) || parser::IsDecimalDigit(ch);
    }
    if (!ok) {
      messages_.Say(symbol.name(),
          "Symbol has a BIND(C) name that is not a valid C language identifier"_err_en_US);
      context_.SetError(symbol);
    }
  }
}
if (symbol.GetIsExplicitBindName()) { // BIND(C,NAME=...); C1552, C1529
  auto defClass{ClassifyProcedure(symbol)};
  if (IsProcedurePointer(symbol)) {
    messages_.Say(symbol.name(),
        "A procedure pointer may not have a BIND attribute with a name"_err_en_US);
    context_.SetError(symbol);
  } else if (defClass == ProcedureDefinitionClass::None ||
      IsExternal(symbol)) {
  } else if (symbol.attrs().test(Attr::ABSTRACT)) {
    messages_.Say(symbol.name(),
        "An ABSTRACT interface may not have a BIND attribute with a name"_err_en_US);
    context_.SetError(symbol);
  } else if (defClass == ProcedureDefinitionClass::Internal ||
      defClass == ProcedureDefinitionClass::Dummy) {
    messages_.Say(symbol.name(),
        "An internal or dummy procedure may not have a BIND(C,NAME=) binding label"_err_en_US);
    context_.SetError(symbol);
  }
}
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
  if (isExplicitBindC && !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);
  }
  auto shape{evaluate::GetShape(foldingContext_, symbol)};
  if (shape) {
    if (evaluate::GetRank(*shape) == 0) { // 18.3.4
      if (isExplicitBindC && IsAllocatableOrPointer(symbol)) {
        messages_.Say(symbol.name(),
            "A scalar interoperable variable may not be ALLOCATABLE or POINTER"_err_en_US);
        context_.SetError(symbol);
      }
    } else { // 18.3.5
      if (auto extents{
              evaluate::AsConstantExtents(foldingContext_, *shape)}) {
        if (evaluate::GetSize(*extents) == 0) {
          SayWithDeclaration(symbol, symbol.name(),
              "Interoperable array must have at least one element"_err_en_US);
          context_.SetError(symbol);
        }
      } else if ((isExplicitBindC || symbol.attrs().test(Attr::VALUE)) &&
          !evaluate::IsExplicitShape(symbol) && !object->IsAssumedSize()) {
        SayWithDeclaration(symbol, symbol.name(),
            "BIND(C) array must have explicit shape or be assumed-size unless a dummy argument without the VALUE attribute"_err_en_US);
        context_.SetError(symbol);
      }
    }
  }
  if (const auto *type{symbol.GetType()}) {
    const auto *derived{type->AsDerived()};
    if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
      if (auto *msg{messages_.Say(symbol.name(),
              "The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)}) {
        msg->Attach(
            derived->typeSymbol().name(), "Non-interoperable type"_en_US);
      }
      context_.SetError(symbol);
    }
    if (type->IsAssumedType() || IsAssumedLengthCharacter(symbol)) {
      // ok
    } else if (IsAllocatableOrPointer(symbol) &&
        type->category() == DeclTypeSpec::Character &&
        type->characterTypeSpec().length().isDeferred()) {
      // ok; F'2018 18.3.6 p2(6)
    } else if (derived || IsInteroperableIntrinsicType(*type)) {
      // F'2018 18.3.6 p2(4,5)
    } else if (type->category() == DeclTypeSpec::Logical && IsDummy(symbol) &&
        evaluate::GetRank(*shape) == 0) {
      // Special exception: LOGICAL scalar dummy arguments can be converted
      // before a call -- & after if not INTENT(IN) -- without loss of
      // information, and are accepted by some older compilers.
      messages_.Say(symbol.name(),
          "A BIND(C) LOGICAL dummy argument should have the interoperable KIND=C_BOOL"_port_en_US);
    } else if (symbol.attrs().test(Attr::VALUE)) {
      messages_.Say(symbol.name(),
          "A BIND(C) VALUE dummy argument must have an interoperable type"_err_en_US);
      context_.SetError(symbol);
    } else {
      messages_.Say(symbol.name(),
          "A BIND(C) object must have an interoperable type"_err_en_US);
      context_.SetError(symbol);
    }
  }
  if (IsOptional(symbol) && !symbol.attrs().test(Attr::VALUE)) {
    messages_.Say(symbol.name(),
        "An interoperable procedure with an OPTIONAL dummy argument might not be portable"_port_en_US);
  }
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
  if (!proc->procInterface() ||
      !proc->procInterface()->attrs().test(Attr::BIND_C)) {
    messages_.Say(symbol.name(),
        "An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement"_err_en_US);
    context_.SetError(symbol);
  }
} else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {
  for (const Symbol *dummy : subp->dummyArgs()) {
    if (dummy) {
      CheckBindC(*dummy);
    } else {
      messages_.Say(symbol.name(),
          "A subprogram interface with the BIND attribute may not have an alternate return argument"_err_en_US);
      context_.SetError(symbol);
    }
  }
} else if (const auto *derived{symbol.detailsIf<DerivedTypeDetails>()}) {
  if (derived->sequence()) { // C1801
    messages_.Say(symbol.name(),
        "A derived type with the BIND attribute cannot have the SEQUENCE attribute"_err_en_US);
    context_.SetError(symbol);
  } else if (!derived->paramDecls().empty()) { // C1802
    messages_.Say(symbol.name(),
        "A derived type with the BIND attribute has type parameter(s)"_err_en_US);
    context_.SetError(symbol);
  } else if (symbol.scope()->GetDerivedTypeParent()) { // C1803
    messages_.Say(symbol.name(),
        "A derived type with the BIND attribute cannot extend from another derived type"_err_en_US);
    context_.SetError(symbol);
  } else {
    for (const auto &pair : *symbol.scope()) {
      const Symbol *component{&*pair.second};
      if (IsProcedure(*component)) { // C1804
        messages_.Say(component->name(),
            "A derived type with the BIND attribute cannot have a type bound procedure"_err_en_US);
        context_.SetError(symbol);
      }
      if (IsAllocatableOrPointer(*component)) { // C1806
        messages_.Say(component->name(),
            "A derived type with the BIND attribute cannot have a pointer or allocatable component"_err_en_US);
        context_.SetError(symbol);
      }
      if (const auto *type{component->GetType()}) {
        if (const auto *derived{type->AsDerived()}) {
          if (!derived->typeSymbol().attrs().test(Attr::BIND_C)) {
            if (auto *msg{messages_.Say(component->name(),
                    "Component '%s' of an interoperable derived type must have the BIND attribute"_err_en_US,
                    component->name())}) {
              msg->Attach(derived->typeSymbol().name(),
                  "Non-interoperable component type"_en_US);
            }
            context_.SetError(symbol);
          }
        } else if (!IsInteroperableIntrinsicType(*type)) {
          messages_.Say(component->name(),
              "Each component of an interoperable derived type must have an interoperable type"_err_en_US);
          context_.SetError(symbol);
        }
      }
      if (auto extents{
              evaluate::GetConstantExtents(foldingContext_, component)};
          extents && evaluate::GetSize(*extents) == 0) {
        messages_.Say(component->name(),
            "An array component of an interoperable type must have at least one element"_err_en_US);
        context_.SetError(symbol);
      }
    }
  }
  if (derived->componentNames().empty() &&
      !FindModuleFileContaining(symbol.owner())) { // C1805
    messages_.Say(symbol.name(),
        "A derived type with the BIND attribute is empty"_port_en_US);
  }
}
2532}

2534bool CheckHelper::CheckDioDummyIsData(
  const Symbol &subp, const Symbol *arg, std::size_t position) {
if (arg && arg->detailsIf<ObjectEntityDetails>()) {
  return true;
} else {
  if (arg) {
    messages_.Say(arg->name(),
        "Dummy argument '%s' must be a data object"_err_en_US, arg->name());
  } else {
    messages_.Say(subp.name(),
        "Dummy argument %d of '%s' must be a data object"_err_en_US, position,
        subp.name());
  }
  return false;
}
2549}

2551void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
  common::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) {
// Check for conflict between non-type-bound defined I/O and type-bound
// generics. It's okay to have two or more distinct defined I/O procedures for
// the same type if they're coming from distinct non-type-bound interfaces.
// (The non-type-bound interfaces would have been merged into a single generic
//  -- with errors where indistinguishable --  when both were visible from the
// same scope.)
if (generic.owner().IsDerivedType()) {
  return;
}
if (const Scope * dtScope{derivedType.scope()}) {
  if (auto iter{dtScope->find(generic.name())}; iter != dtScope->end()) {
    for (auto specRef : iter->second->get<GenericDetails>().specificProcs()) {
      const Symbol &specific{specRef->get<ProcBindingDetails>().symbol()};
      if (specific == proc) { // unambiguous, accept
        continue;
      }
      if (const auto *specDT{GetDtvArgDerivedType(specific)};
          specDT && evaluate::AreSameDerivedType(derivedType, *specDT)) {
        SayWithDeclaration(*specRef, proc.name(),
            "Derived type '%s' has conflicting type-bound input/output procedure '%s'"_err_en_US,
            derivedType.name(), GenericKind::AsFortran(ioKind));
        return;
      }
    }
  }
}
2579}

2581void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
  common::DefinedIo ioKind, const Symbol &generic) {
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());
  }
}
2600}

2602void CheckHelper::CheckDioDummyIsDefaultInteger(
  const Symbol &subp, const Symbol &arg) {
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"
    " must be an INTEGER of default KIND"_err_en_US,
    arg.name());
2615}

2617void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
if (arg.Rank() > 0 || arg.Corank() > 0) {
  messages_.Say(arg.name(),
      "Dummy argument '%s' of a defined input/output procedure"
      " must be a scalar"_err_en_US,
      arg.name());
}
2624}

2626void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
  common::DefinedIo ioKind, const Symbol &generic) {
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
if (CheckDioDummyIsData(subp, arg, 0)) {
  CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
  CheckDioDummyAttrs(subp, *arg,
      ioKind == common::DefinedIo::ReadFormatted ||
              ioKind == common::DefinedIo::ReadUnformatted
          ? Attr::INTENT_INOUT
          : Attr::INTENT_IN);
}
2637}

2639// If an explicit INTRINSIC name is a function, so must all the specifics be,
2640// and similarly for subroutines
2641void CheckHelper::CheckGenericVsIntrinsic(
  const Symbol &symbol, const GenericDetails &generic) {
if (symbol.attrs().test(Attr::INTRINSIC)) {
  const evaluate::IntrinsicProcTable &table{
      context_.foldingContext().intrinsics()};
  bool isSubroutine{table.IsIntrinsicSubroutine(symbol.name().ToString())};
  if (isSubroutine || table.IsIntrinsicFunction(symbol.name().ToString())) {
    for (const SymbolRef &ref : generic.specificProcs()) {
      const Symbol &ultimate{ref->GetUltimate()};
      bool specificFunc{ultimate.test(Symbol::Flag::Function)};
      bool specificSubr{ultimate.test(Symbol::Flag::Subroutine)};
      if (!specificFunc && !specificSubr) {
        if (const auto *proc{ultimate.detailsIf<SubprogramDetails>()}) {
          if (proc->isFunction()) {
            specificFunc = true;
          } else {
            specificSubr = true;
          }
        }
      }
      if ((specificFunc || specificSubr) &&
          isSubroutine != specificSubr) { // C848
        messages_.Say(symbol.name(),
            "Generic interface '%s' with explicit intrinsic %s of the same name may not have specific procedure '%s' that is a %s"_err_en_US,
            symbol.name(), isSubroutine ? "subroutine" : "function",
            ref->name(), isSubroutine ? "function" : "subroutine");
      }
    }
  }
}
2671}

2673void CheckHelper::CheckDefaultIntegerArg(
  const Symbol &subp, const Symbol *arg, Attr intent) {
// Argument looks like: INTEGER, INTENT(intent) :: arg
if (CheckDioDummyIsData(subp, arg, 1)) {
  CheckDioDummyIsDefaultInteger(subp, *arg);
  CheckDioDummyIsScalar(subp, *arg);
  CheckDioDummyAttrs(subp, *arg, intent);
}
2681}

2683void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
  const Symbol *arg, std::size_t argPosition, Attr intent) {
// Argument looks like: CHARACTER (LEN=*), INTENT(intent) :: (iotype OR iomsg)
if (CheckDioDummyIsData(subp, arg, argPosition)) {
  CheckDioDummyAttrs(subp, *arg, intent);
  const DeclTypeSpec *type{arg ? arg->GetType() : nullptr};
  const IntrinsicTypeSpec *intrinsic{type ? type->AsIntrinsic() : nullptr};
  const auto kind{
      intrinsic ? evaluate::ToInt64(intrinsic->kind()) : std::nullopt};
  if (!IsAssumedLengthCharacter(*arg) ||
      (!kind ||
          *kind !=
              context_.defaultKinds().GetDefaultKind(
                  TypeCategory::Character))) {
    messages_.Say(arg->name(),
        "Dummy argument '%s' of a defined input/output procedure"
        " must be assumed-length CHARACTER of default kind"_err_en_US,
        arg->name());
  }
}
2703}

2705void CheckHelper::CheckDioVlistArg(
  const Symbol &subp, const Symbol *arg, std::size_t argPosition) {
// Vlist argument looks like: INTEGER, INTENT(IN) :: v_list(:)
if (CheckDioDummyIsData(subp, arg, argPosition)) {
  CheckDioDummyIsDefaultInteger(subp, *arg);
  CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
  const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()};
  if (!objectDetails || !objectDetails->shape().CanBeDeferredShape()) {
    messages_.Say(arg->name(),
        "Dummy argument '%s' of a defined input/output procedure must be"
        " deferred shape"_err_en_US,
        arg->name());
  }
}
2719}

2721void CheckHelper::CheckDioArgCount(
  const Symbol &subp, common::DefinedIo ioKind, std::size_t argCount) {
const std::size_t requiredArgCount{
    (std::size_t)(ioKind == common::DefinedIo::ReadFormatted ||
                ioKind == common::DefinedIo::WriteFormatted
            ? 6
            : 4)};
if (argCount != requiredArgCount) {
  SayWithDeclaration(subp,
      "Defined input/output procedure '%s' must have"
      " %d dummy arguments rather than %d"_err_en_US,
      subp.name(), requiredArgCount, argCount);
  context_.SetError(subp);
}
2735}

2737void CheckHelper::CheckDioDummyAttrs(
  const Symbol &subp, const Symbol &arg, Attr goodIntent) {
// Defined I/O procedures can't have attributes other than INTENT
Attrs attrs{arg.attrs()};
if (!attrs.test(goodIntent)) {
  messages_.Say(arg.name(),
      "Dummy argument '%s' of a defined input/output procedure"
      " must have intent '%s'"_err_en_US,
      arg.name(), AttrToString(goodIntent));
}
attrs = attrs - Attr::INTENT_IN - Attr::INTENT_OUT - Attr::INTENT_INOUT;
if (!attrs.empty()) {
  messages_.Say(arg.name(),
      "Dummy argument '%s' of a defined input/output procedure may not have"
      " any attributes"_err_en_US,
      arg.name());
}
2754}

2756// Enforce semantics for defined input/output procedures (12.6.4.8.2) and C777
2757void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
  const GenericDetails &details, common::DefinedIo ioKind) {
for (auto ref : details.specificProcs()) {
  const Symbol &ultimate{ref->GetUltimate()};
  const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
  const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
  if (ultimate.attrs().test(Attr::NOPASS)) { // C774
    messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
                  "attribute"_err_en_US,
        ultimate.name());
    context_.SetError(ultimate);
  }
  if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
    const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
    CheckDioArgCount(specific, ioKind, dummyArgs.size());
    int argCount{0};
    for (auto *arg : dummyArgs) {
      switch (argCount++) {
      case 0:
        // dtv-type-spec, INTENT(INOUT) :: dtv
        CheckDioDtvArg(specific, arg, ioKind, symbol);
        break;
      case 1:
        // INTEGER, INTENT(IN) :: unit
        CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
        break;
      case 2:
        if (ioKind == common::DefinedIo::ReadFormatted ||
            ioKind == common::DefinedIo::WriteFormatted) {
          // CHARACTER (LEN=*), INTENT(IN) :: iotype
          CheckDioAssumedLenCharacterArg(
              specific, arg, argCount, Attr::INTENT_IN);
        } else {
          // INTEGER, INTENT(OUT) :: iostat
          CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
        }
        break;
      case 3:
        if (ioKind == common::DefinedIo::ReadFormatted ||
            ioKind == common::DefinedIo::WriteFormatted) {
          // INTEGER, INTENT(IN) :: v_list(:)
          CheckDioVlistArg(specific, arg, argCount);
        } else {
          // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
          CheckDioAssumedLenCharacterArg(
              specific, arg, argCount, Attr::INTENT_INOUT);
        }
        break;
      case 4:
        // INTEGER, INTENT(OUT) :: iostat
        CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
        break;
      case 5:
        // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
        CheckDioAssumedLenCharacterArg(
            specific, arg, argCount, Attr::INTENT_INOUT);
        break;
      default:;
      }
    }
  }
}
2819}

2821void CheckHelper::CheckSymbolType(const Symbol &symbol) {
if (!IsAllocatable(symbol) &&
    (!IsPointer(symbol) ||
        (IsProcedure(symbol) && !symbol.HasExplicitInterface()))) { // C702
  if (auto dyType{evaluate::DynamicType::From(symbol)}) {
    if (dyType->HasDeferredTypeParameter()) {
      messages_.Say(
          "'%s' has a type %s with a deferred type parameter but is neither an allocatable nor an object pointer"_err_en_US,
          symbol.name(), dyType->AsFortran());
    }
  }
}
2833}

2835void CheckHelper::CheckModuleProcedureDef(const Symbol &symbol) {
auto procClass{ClassifyProcedure(symbol)};
if (const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
    subprogram &&
    (procClass == ProcedureDefinitionClass::Module &&
        symbol.attrs().test(Attr::MODULE)) &&
    !subprogram->bindName() && !subprogram->isInterface()) {
  const Symbol *module{nullptr};
  if (const Scope * moduleScope{FindModuleContaining(symbol.owner())};
      moduleScope && moduleScope->symbol()) {
    if (const auto *details{
            moduleScope->symbol()->detailsIf<ModuleDetails>()}) {
      if (details->parent()) {
        moduleScope = details->parent();
      }
      module = moduleScope->symbol();
    }
  }
  if (module) {
    std::pair<SourceName, const Symbol *> key{symbol.name(), module};
    auto iter{moduleProcs_.find(key)};
    if (iter == moduleProcs_.end()) {
      moduleProcs_.emplace(std::move(key), symbol);
    } else if (
        auto *msg{messages_.Say(symbol.name(),
            "Module procedure '%s' in module '%s' has multiple definitions"_err_en_US,
            symbol.name(), module->name())}) {
      msg->Attach(iter->second->name(), "Previous definition of '%s'"_en_US,
          symbol.name());
    }
  }
}
2867}

2869void SubprogramMatchHelper::Check(
  const Symbol &symbol1, const Symbol &symbol2) {
const auto details1{symbol1.get<SubprogramDetails>()};
const auto details2{symbol2.get<SubprogramDetails>()};
if (details1.isFunction() != details2.isFunction()) {
  Say(symbol1, symbol2,
      details1.isFunction()
          ? "Module function '%s' was declared as a subroutine in the"
            " corresponding interface body"_err_en_US
          : "Module subroutine '%s' was declared as a function in the"
            " corresponding interface body"_err_en_US);
  return;
}
const auto &args1{details1.dummyArgs()};
const auto &args2{details2.dummyArgs()};
int nargs1{static_cast<int>(args1.size())};
int nargs2{static_cast<int>(args2.size())};
if (nargs1 != nargs2) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' has %d args but the corresponding interface"
      " body has %d"_err_en_US,
      nargs1, nargs2);
  return;
}
bool nonRecursive1{symbol1.attrs().test(Attr::NON_RECURSIVE)};
if (nonRecursive1 != symbol2.attrs().test(Attr::NON_RECURSIVE)) { // C1551
  Say(symbol1, symbol2,
      nonRecursive1
          ? "Module subprogram '%s' has NON_RECURSIVE prefix but"
            " the corresponding interface body does not"_err_en_US
          : "Module subprogram '%s' does not have NON_RECURSIVE prefix but "
            "the corresponding interface body does"_err_en_US);
}
const std::string *bindName1{details1.bindName()};
const std::string *bindName2{details2.bindName()};
if (!bindName1 && !bindName2) {
  // OK - neither has a binding label
} else if (!bindName1) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' does not have a binding label but the"
      " corresponding interface body does"_err_en_US);
} else if (!bindName2) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' has a binding label but the"
      " corresponding interface body does not"_err_en_US);
} else if (*bindName1 != *bindName2) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' has binding label '%s' but the corresponding"
      " interface body has '%s'"_err_en_US,
      *details1.bindName(), *details2.bindName());
}
const Procedure *proc1{checkHelper.Characterize(symbol1)};
const Procedure *proc2{checkHelper.Characterize(symbol2)};
if (!proc1 || !proc2) {
  return;
}
if (proc1->attrs.test(Procedure::Attr::Pure) !=
    proc2->attrs.test(Procedure::Attr::Pure)) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' and its corresponding interface body are not both PURE"_err_en_US);
}
if (proc1->attrs.test(Procedure::Attr::Elemental) !=
    proc2->attrs.test(Procedure::Attr::Elemental)) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' and its corresponding interface body are not both ELEMENTAL"_err_en_US);
}
if (proc1->attrs.test(Procedure::Attr::BindC) !=
    proc2->attrs.test(Procedure::Attr::BindC)) {
  Say(symbol1, symbol2,
      "Module subprogram '%s' and its corresponding interface body are not both BIND(C)"_err_en_US);
}
if (proc1->functionResult && proc2->functionResult &&
    *proc1->functionResult != *proc2->functionResult) {
  Say(symbol1, symbol2,
      "Return type of function '%s' does not match return type of"
      " the corresponding interface body"_err_en_US);
}
for (int i{0}; i < nargs1; ++i) {
  const Symbol *arg1{args1[i]};
  const Symbol *arg2{args2[i]};
  if (arg1 && !arg2) {
    Say(symbol1, symbol2,
        "Dummy argument %2$d of '%1$s' is not an alternate return indicator"
        " but the corresponding argument in the interface body is"_err_en_US,
        i + 1);
  } else if (!arg1 && arg2) {
    Say(symbol1, symbol2,
        "Dummy argument %2$d of '%1$s' is an alternate return indicator but"
        " the corresponding argument in the interface body is not"_err_en_US,
        i + 1);
  } else if (arg1 && arg2) {
    SourceName name1{arg1->name()};
    SourceName name2{arg2->name()};
    if (name1 != name2) {
      Say(*arg1, *arg2,
          "Dummy argument name '%s' does not match corresponding name '%s'"
          " in interface body"_err_en_US,
          name2);
    } else {
      CheckDummyArg(
          *arg1, *arg2, proc1->dummyArguments[i], proc2->dummyArguments[i]);
    }
  }
}
2973}

2975void SubprogramMatchHelper::CheckDummyArg(const Symbol &symbol1,
  const Symbol &symbol2, const DummyArgument &arg1,
  const DummyArgument &arg2) {
common::visit(
    common::visitors{
        [&](const DummyDataObject &obj1, const DummyDataObject &obj2) {
          CheckDummyDataObject(symbol1, symbol2, obj1, obj2);
        },
        [&](const DummyProcedure &proc1, const DummyProcedure &proc2) {
          CheckDummyProcedure(symbol1, symbol2, proc1, proc2);
        },
        [&](const DummyDataObject &, const auto &) {
          Say(symbol1, symbol2,
              "Dummy argument '%s' is a data object; the corresponding"
              " argument in the interface body is not"_err_en_US);
        },
        [&](const DummyProcedure &, const auto &) {
          Say(symbol1, symbol2,
              "Dummy argument '%s' is a procedure; the corresponding"
              " argument in the interface body is not"_err_en_US);
        },
        [&](const auto &, const auto &) {
          llvm_unreachable("Dummy arguments are not data objects or"::llvm::llvm_unreachable_internal("Dummy arguments are not data objects or"
 "procedures", "flang/lib/Semantics/check-declarations.cpp", 2998
)
                           "procedures")::llvm::llvm_unreachable_internal("Dummy arguments are not data objects or"
 "procedures", "flang/lib/Semantics/check-declarations.cpp", 2998
);
        },
    },
    arg1.u, arg2.u);
3002}

3004void SubprogramMatchHelper::CheckDummyDataObject(const Symbol &symbol1,
  const Symbol &symbol2, const DummyDataObject &obj1,
  const DummyDataObject &obj2) {
if (!CheckSameIntent(symbol1, symbol2, obj1.intent, obj2.intent)) {
} else if (!CheckSameAttrs(symbol1, symbol2, obj1.attrs, obj2.attrs)) {
} else if (obj1.type.type() != obj2.type.type()) {
  Say(symbol1, symbol2,
      "Dummy argument '%s' has type %s; the corresponding argument in the"
      " interface body has type %s"_err_en_US,
      obj1.type.type().AsFortran(), obj2.type.type().AsFortran());
} else if (!ShapesAreCompatible(obj1, obj2)) {
  Say(symbol1, symbol2,
      "The shape of dummy argument '%s' does not match the shape of the"
      " corresponding argument in the interface body"_err_en_US);
}
// TODO: coshape
3020}

3022void SubprogramMatchHelper::CheckDummyProcedure(const Symbol &symbol1,
  const Symbol &symbol2, const DummyProcedure &proc1,
  const DummyProcedure &proc2) {
if (!CheckSameIntent(symbol1, symbol2, proc1.intent, proc2.intent)) {
} else if (!CheckSameAttrs(symbol1, symbol2, proc1.attrs, proc2.attrs)) {
} else if (proc1 != proc2) {
  Say(symbol1, symbol2,
      "Dummy procedure '%s' does not match the corresponding argument in"
      " the interface body"_err_en_US);
}
3032}

3034bool SubprogramMatchHelper::CheckSameIntent(const Symbol &symbol1,
  const Symbol &symbol2, common::Intent intent1, common::Intent intent2) {
if (intent1 == intent2) {
  return true;
} else {
  Say(symbol1, symbol2,
      "The intent of dummy argument '%s' does not match the intent"
      " of the corresponding argument in the interface body"_err_en_US);
  return false;
}
3044}

3046// Report an error referring to first symbol with declaration of second symbol
3047template <typename... A>
3048void SubprogramMatchHelper::Say(const Symbol &symbol1, const Symbol &symbol2,
  parser::MessageFixedText &&text, A &&...args) {
auto &message{context().Say(symbol1.name(), std::move(text), symbol1.name(),
    std::forward<A>(args)...)};
evaluate::AttachDeclaration(message, symbol2);
3053}

3055template <typename ATTRS>
3056bool SubprogramMatchHelper::CheckSameAttrs(
  const Symbol &symbol1, const Symbol &symbol2, ATTRS attrs1, ATTRS attrs2) {
if (attrs1 == attrs2) {
  return true;
}
attrs1.IterateOverMembers([&](auto attr) {
  if (!attrs2.test(attr)) {
    Say(symbol1, symbol2,
        "Dummy argument '%s' has the %s attribute; the corresponding"
        " argument in the interface body does not"_err_en_US,
        AsFortran(attr));
  }
});
attrs2.IterateOverMembers([&](auto attr) {
  if (!attrs1.test(attr)) {
    Say(symbol1, symbol2,
        "Dummy argument '%s' does not have the %s attribute; the"
        " corresponding argument in the interface body does"_err_en_US,
        AsFortran(attr));
  }
});
return false;
3078}

3080bool SubprogramMatchHelper::ShapesAreCompatible(
  const DummyDataObject &obj1, const DummyDataObject &obj2) {
return characteristics::ShapesAreCompatible(
    FoldShape(obj1.type.shape()), FoldShape(obj2.type.shape()));
3084}

3086evaluate::Shape SubprogramMatchHelper::FoldShape(const evaluate::Shape &shape) {
evaluate::Shape result;
for (const auto &extent : shape) {
  result.emplace_back(
      evaluate::Fold(context().foldingContext(), common::Clone(extent)));
}
return result;
3093}

3095void DistinguishabilityHelper::Add(const Symbol &generic, GenericKind kind,
  const Symbol &specific, const Procedure &procedure) {
if (!context_.HasError(specific)) {
  nameToInfo_[generic.name()].emplace_back(
      ProcedureInfo{kind, specific, procedure});
}
3101}

3103void DistinguishabilityHelper::Check(const Scope &scope) {
for (const auto &[name, info] : nameToInfo_) {
  auto count{info.size()};
  for (std::size_t i1{0}; i1 < count - 1; ++i1) {
    const auto &[kind, symbol, proc]{info[i1]};
    for (std::size_t i2{i1 + 1}; i2 < count; ++i2) {
      auto distinguishable{kind.IsName()
              ? evaluate::characteristics::Distinguishable
              : evaluate::characteristics::DistinguishableOpOrAssign};
      if (!distinguishable(
              context_.languageFeatures(), proc, info[i2].procedure)) {
        SayNotDistinguishable(GetTopLevelUnitContaining(scope), name, kind,
            symbol, info[i2].symbol);
      }
    }
  }
}
3120}

3122void DistinguishabilityHelper::SayNotDistinguishable(const Scope &scope,
  const SourceName &name, GenericKind kind, const Symbol &proc1,
  const Symbol &proc2) {
std::string name1{proc1.name().ToString()};
std::string name2{proc2.name().ToString()};
if (kind.IsOperator() || kind.IsAssignment()) {
  // proc1 and proc2 may come from different scopes so qualify their names
  if (proc1.owner().IsDerivedType()) {
    name1 = proc1.owner().GetName()->ToString() + '%' + name1;
  }
  if (proc2.owner().IsDerivedType()) {
    name2 = proc2.owner().GetName()->ToString() + '%' + name2;
  }
}
parser::Message *msg;
if (scope.sourceRange().Contains(name)) {
  msg = &context_.Say(name,
      "Generic '%s' may not have specific procedures '%s' and '%s' as their interfaces are not distinguishable"_err_en_US,
      MakeOpName(name), name1, name2);
} else {
  msg = &context_.Say(*GetTopLevelUnitContaining(proc1).GetName(),
      "USE-associated generic '%s' may not have specific procedures '%s' and '%s' as their interfaces are not distinguishable"_err_en_US,
      MakeOpName(name), name1, name2);
}
AttachDeclaration(*msg, scope, proc1);
AttachDeclaration(*msg, scope, proc2);
3148}

3150// `evaluate::AttachDeclaration` doesn't handle the generic case where `proc`
3151// comes from a different module but is not necessarily use-associated.
3152void DistinguishabilityHelper::AttachDeclaration(
  parser::Message &msg, const Scope &scope, const Symbol &proc) {
const Scope &unit{GetTopLevelUnitContaining(proc)};
if (unit == scope) {
  evaluate::AttachDeclaration(msg, proc);
} else {
  msg.Attach(unit.GetName().value(),
      "'%s' is USE-associated from module '%s'"_en_US, proc.name(),
      unit.GetName().value());
}
3162}

3164void CheckDeclarations(SemanticsContext &context) {
CheckHelper{context}.Check();
3166}
3167} // namespace Fortran::semantics