flang/lib/Semantics/tools.cpp

   1 //===-- lib/Semantics/tools.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 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Parser/tools.h"
  10 #include "flang/Common/Fortran.h"
  11 #include "flang/Common/indirection.h"
  12 #include "flang/Parser/dump-parse-tree.h"
  13 #include "flang/Parser/message.h"
  14 #include "flang/Parser/parse-tree.h"
  15 #include "flang/Semantics/scope.h"
  16 #include "flang/Semantics/semantics.h"
  17 #include "flang/Semantics/symbol.h"
  18 #include "flang/Semantics/tools.h"
  19 #include "flang/Semantics/type.h"
  20 #include "llvm/Support/raw_ostream.h"
  21 #include <algorithm>
  22 #include <set>
  23 #include <variant>
  24
  25 namespace Fortran::semantics {
  26
  27 // Find this or containing scope that matches predicate
  28 static const Scope *FindScopeContaining(
  29     const Scope &start, std::function<bool(const Scope &)> predicate) {
  30   for (const Scope *scope{&start};; scope = &scope->parent()) {
  31     if (predicate(*scope)) {
  32       return scope;
  33     }
  34     if (scope->IsTopLevel()) {
  35       return nullptr;
  36     }
  37   }
  38 }
  39
  40 const Scope &GetTopLevelUnitContaining(const Scope &start) {
  41   CHECK(!start.IsTopLevel());
  42   return DEREF(FindScopeContaining(
  43       start, [](const Scope &scope) { return scope.parent().IsTopLevel(); }));
  44 }
  45
  46 const Scope &GetTopLevelUnitContaining(const Symbol &symbol) {
  47   return GetTopLevelUnitContaining(symbol.owner());
  48 }
  49
  50 const Scope *FindModuleContaining(const Scope &start) {
  51   return FindScopeContaining(
  52       start, [](const Scope &scope) { return scope.IsModule(); });
  53 }
  54
  55 const Scope *FindModuleOrSubmoduleContaining(const Scope &start) {
  56   return FindScopeContaining(start, [](const Scope &scope) {
  57     return scope.IsModule() || scope.IsSubmodule();
  58   });
  59 }
  60
  61 const Scope *FindModuleFileContaining(const Scope &start) {
  62   return FindScopeContaining(
  63       start, [](const Scope &scope) { return scope.IsModuleFile(); });
  64 }
  65
  66 const Scope &GetProgramUnitContaining(const Scope &start) {
  67   CHECK(!start.IsTopLevel());
  68   return DEREF(FindScopeContaining(start, [](const Scope &scope) {
  69     switch (scope.kind()) {
  70     case Scope::Kind::Module:
  71     case Scope::Kind::MainProgram:
  72     case Scope::Kind::Subprogram:
  73     case Scope::Kind::BlockData:
  74       return true;
  75     default:
  76       return false;
  77     }
  78   }));
  79 }
  80
  81 const Scope &GetProgramUnitContaining(const Symbol &symbol) {
  82   return GetProgramUnitContaining(symbol.owner());
  83 }
  84
  85 const Scope &GetProgramUnitOrBlockConstructContaining(const Scope &start) {
  86   CHECK(!start.IsTopLevel());
  87   return DEREF(FindScopeContaining(start, [](const Scope &scope) {
  88     switch (scope.kind()) {
  89     case Scope::Kind::Module:
  90     case Scope::Kind::MainProgram:
  91     case Scope::Kind::Subprogram:
  92     case Scope::Kind::BlockData:
  93     case Scope::Kind::BlockConstruct:
  94       return true;
  95     default:
  96       return false;
  97     }
  98   }));
  99 }
 100
 101 const Scope &GetProgramUnitOrBlockConstructContaining(const Symbol &symbol) {
 102   return GetProgramUnitOrBlockConstructContaining(symbol.owner());
 103 }
 104
 105 const Scope *FindPureProcedureContaining(const Scope &start) {
 106   // N.B. We only need to examine the innermost containing program unit
 107   // because an internal subprogram of a pure subprogram must also
 108   // be pure (C1592).
 109   if (start.IsTopLevel()) {
 110     return nullptr;
 111   } else {
 112     const Scope &scope{GetProgramUnitContaining(start)};
 113     return IsPureProcedure(scope) ? &scope : nullptr;
 114   }
 115 }
 116
 117 const Scope *FindOpenACCConstructContaining(const Scope *scope) {
 118   return scope ? FindScopeContaining(*scope,
 119                      [](const Scope &s) {
 120                        return s.kind() == Scope::Kind::OpenACCConstruct;
 121                      })
 122                : nullptr;
 123 }
 124
 125 // 7.5.2.4 "same derived type" test -- rely on IsTkCompatibleWith() and its
 126 // infrastructure to detect and handle comparisons on distinct (but "same")
 127 // sequence/bind(C) derived types
 128 static bool MightBeSameDerivedType(
 129     const std::optional<evaluate::DynamicType> &lhsType,
 130     const std::optional<evaluate::DynamicType> &rhsType) {
 131   return lhsType && rhsType && lhsType->IsTkCompatibleWith(*rhsType);
 132 }
 133
 134 Tristate IsDefinedAssignment(
 135     const std::optional<evaluate::DynamicType> &lhsType, int lhsRank,
 136     const std::optional<evaluate::DynamicType> &rhsType, int rhsRank) {
 137   if (!lhsType || !rhsType) {
 138     return Tristate::No; // error or rhs is untyped
 139   }
 140   TypeCategory lhsCat{lhsType->category()};
 141   TypeCategory rhsCat{rhsType->category()};
 142   if (rhsRank > 0 && lhsRank != rhsRank) {
 143     return Tristate::Yes;
 144   } else if (lhsCat != TypeCategory::Derived) {
 145     return ToTristate(lhsCat != rhsCat &&
 146         (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat) ||
 147             lhsCat == TypeCategory::Unsigned ||
 148             rhsCat == TypeCategory::Unsigned));
 149   } else if (MightBeSameDerivedType(lhsType, rhsType)) {
 150     return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
 151   } else {
 152     return Tristate::Yes;
 153   }
 154 }
 155
 156 bool IsIntrinsicRelational(common::RelationalOperator opr,
 157     const evaluate::DynamicType &type0, int rank0,
 158     const evaluate::DynamicType &type1, int rank1) {
 159   if (!evaluate::AreConformable(rank0, rank1)) {
 160     return false;
 161   } else {
 162     auto cat0{type0.category()};
 163     auto cat1{type1.category()};
 164     if (cat0 == TypeCategory::Unsigned || cat1 == TypeCategory::Unsigned) {
 165       return cat0 == cat1;
 166     } else if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
 167       // numeric types: EQ/NE always ok, others ok for non-complex
 168       return opr == common::RelationalOperator::EQ ||
 169           opr == common::RelationalOperator::NE ||
 170           (cat0 != TypeCategory::Complex && cat1 != TypeCategory::Complex);
 171     } else {
 172       // not both numeric: only Character is ok
 173       return cat0 == TypeCategory::Character && cat1 == TypeCategory::Character;
 174     }
 175   }
 176 }
 177
 178 bool IsIntrinsicNumeric(const evaluate::DynamicType &type0) {
 179   return IsNumericTypeCategory(type0.category());
 180 }
 181 bool IsIntrinsicNumeric(const evaluate::DynamicType &type0, int rank0,
 182     const evaluate::DynamicType &type1, int rank1) {
 183   return evaluate::AreConformable(rank0, rank1) &&
 184       IsNumericTypeCategory(type0.category()) &&
 185       IsNumericTypeCategory(type1.category());
 186 }
 187
 188 bool IsIntrinsicLogical(const evaluate::DynamicType &type0) {
 189   return type0.category() == TypeCategory::Logical;
 190 }
 191 bool IsIntrinsicLogical(const evaluate::DynamicType &type0, int rank0,
 192     const evaluate::DynamicType &type1, int rank1) {
 193   return evaluate::AreConformable(rank0, rank1) &&
 194       type0.category() == TypeCategory::Logical &&
 195       type1.category() == TypeCategory::Logical;
 196 }
 197
 198 bool IsIntrinsicConcat(const evaluate::DynamicType &type0, int rank0,
 199     const evaluate::DynamicType &type1, int rank1) {
 200   return evaluate::AreConformable(rank0, rank1) &&
 201       type0.category() == TypeCategory::Character &&
 202       type1.category() == TypeCategory::Character &&
 203       type0.kind() == type1.kind();
 204 }
 205
 206 bool IsGenericDefinedOp(const Symbol &symbol) {
 207   const Symbol &ultimate{symbol.GetUltimate()};
 208   if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
 209     return generic->kind().IsDefinedOperator();
 210   } else if (const auto *misc{ultimate.detailsIf<MiscDetails>()}) {
 211     return misc->kind() == MiscDetails::Kind::TypeBoundDefinedOp;
 212   } else {
 213     return false;
 214   }
 215 }
 216
 217 bool IsDefinedOperator(SourceName name) {
 218   const char *begin{name.begin()};
 219   const char *end{name.end()};
 220   return begin != end && begin[0] == '.' && end[-1] == '.';
 221 }
 222
 223 std::string MakeOpName(SourceName name) {
 224   std::string result{name.ToString()};
 225   return IsDefinedOperator(name)         ? "OPERATOR(" + result + ")"
 226       : result.find("operator(", 0) == 0 ? parser::ToUpperCaseLetters(result)
 227                                          : result;
 228 }
 229
 230 bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
 231   const auto &objects{block.get<CommonBlockDetails>().objects()};
 232   return llvm::is_contained(objects, object);
 233 }
 234
 235 bool IsUseAssociated(const Symbol &symbol, const Scope &scope) {
 236   const Scope &owner{GetTopLevelUnitContaining(symbol.GetUltimate().owner())};
 237   return owner.kind() == Scope::Kind::Module &&
 238       owner != GetTopLevelUnitContaining(scope);
 239 }
 240
 241 bool DoesScopeContain(
 242     const Scope *maybeAncestor, const Scope &maybeDescendent) {
 243   return maybeAncestor && !maybeDescendent.IsTopLevel() &&
 244       FindScopeContaining(maybeDescendent.parent(),
 245           [&](const Scope &scope) { return &scope == maybeAncestor; });
 246 }
 247
 248 bool DoesScopeContain(const Scope *maybeAncestor, const Symbol &symbol) {
 249   return DoesScopeContain(maybeAncestor, symbol.owner());
 250 }
 251
 252 static const Symbol &FollowHostAssoc(const Symbol &symbol) {
 253   for (const Symbol *s{&symbol};;) {
 254     const auto *details{s->detailsIf<HostAssocDetails>()};
 255     if (!details) {
 256       return *s;
 257     }
 258     s = &details->symbol();
 259   }
 260 }
 261
 262 bool IsHostAssociated(const Symbol &symbol, const Scope &scope) {
 263   const Symbol &base{FollowHostAssoc(symbol)};
 264   return base.owner().IsTopLevel() ||
 265       DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
 266           GetProgramUnitOrBlockConstructContaining(scope));
 267 }
 268
 269 bool IsHostAssociatedIntoSubprogram(const Symbol &symbol, const Scope &scope) {
 270   const Symbol &base{FollowHostAssoc(symbol)};
 271   return base.owner().IsTopLevel() ||
 272       DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
 273           GetProgramUnitContaining(scope));
 274 }
 275
 276 bool IsInStmtFunction(const Symbol &symbol) {
 277   if (const Symbol * function{symbol.owner().symbol()}) {
 278     return IsStmtFunction(*function);
 279   }
 280   return false;
 281 }
 282
 283 bool IsStmtFunctionDummy(const Symbol &symbol) {
 284   return IsDummy(symbol) && IsInStmtFunction(symbol);
 285 }
 286
 287 bool IsStmtFunctionResult(const Symbol &symbol) {
 288   return IsFunctionResult(symbol) && IsInStmtFunction(symbol);
 289 }
 290
 291 bool IsPointerDummy(const Symbol &symbol) {
 292   return IsPointer(symbol) && IsDummy(symbol);
 293 }
 294
 295 bool IsBindCProcedure(const Symbol &original) {
 296   const Symbol &symbol{original.GetUltimate()};
 297   if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
 298     if (procDetails->procInterface()) {
 299       // procedure component with a BIND(C) interface
 300       return IsBindCProcedure(*procDetails->procInterface());
 301     }
 302   }
 303   return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol);
 304 }
 305
 306 bool IsBindCProcedure(const Scope &scope) {
 307   if (const Symbol * symbol{scope.GetSymbol()}) {
 308     return IsBindCProcedure(*symbol);
 309   } else {
 310     return false;
 311   }
 312 }
 313
 314 static const Symbol *FindPointerComponent(
 315     const Scope &scope, std::set<const Scope *> &visited) {
 316   if (!scope.IsDerivedType()) {
 317     return nullptr;
 318   }
 319   if (!visited.insert(&scope).second) {
 320     return nullptr;
 321   }
 322   // If there's a top-level pointer component, return it for clearer error
 323   // messaging.
 324   for (const auto &pair : scope) {
 325     const Symbol &symbol{*pair.second};
 326     if (IsPointer(symbol)) {
 327       return &symbol;
 328     }
 329   }
 330   for (const auto &pair : scope) {
 331     const Symbol &symbol{*pair.second};
 332     if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
 333       if (const DeclTypeSpec * type{details->type()}) {
 334         if (const DerivedTypeSpec * derived{type->AsDerived()}) {
 335           if (const Scope * nested{derived->scope()}) {
 336             if (const Symbol *
 337                 pointer{FindPointerComponent(*nested, visited)}) {
 338               return pointer;
 339             }
 340           }
 341         }
 342       }
 343     }
 344   }
 345   return nullptr;
 346 }
 347
 348 const Symbol *FindPointerComponent(const Scope &scope) {
 349   std::set<const Scope *> visited;
 350   return FindPointerComponent(scope, visited);
 351 }
 352
 353 const Symbol *FindPointerComponent(const DerivedTypeSpec &derived) {
 354   if (const Scope * scope{derived.scope()}) {
 355     return FindPointerComponent(*scope);
 356   } else {
 357     return nullptr;
 358   }
 359 }
 360
 361 const Symbol *FindPointerComponent(const DeclTypeSpec &type) {
 362   if (const DerivedTypeSpec * derived{type.AsDerived()}) {
 363     return FindPointerComponent(*derived);
 364   } else {
 365     return nullptr;
 366   }
 367 }
 368
 369 const Symbol *FindPointerComponent(const DeclTypeSpec *type) {
 370   return type ? FindPointerComponent(*type) : nullptr;
 371 }
 372
 373 const Symbol *FindPointerComponent(const Symbol &symbol) {
 374   return IsPointer(symbol) ? &symbol : FindPointerComponent(symbol.GetType());
 375 }
 376
 377 // C1594 specifies several ways by which an object might be globally visible.
 378 const Symbol *FindExternallyVisibleObject(
 379     const Symbol &object, const Scope &scope, bool isPointerDefinition) {
 380   // TODO: Storage association with any object for which this predicate holds,
 381   // once EQUIVALENCE is supported.
 382   const Symbol &ultimate{GetAssociationRoot(object)};
 383   if (IsDummy(ultimate)) {
 384     if (IsIntentIn(ultimate)) {
 385       return &ultimate;
 386     }
 387     if (!isPointerDefinition && IsPointer(ultimate) &&
 388         IsPureProcedure(ultimate.owner()) && IsFunction(ultimate.owner())) {
 389       return &ultimate;
 390     }
 391   } else if (ultimate.owner().IsDerivedType()) {
 392     return nullptr;
 393   } else if (&GetProgramUnitContaining(ultimate) !=
 394       &GetProgramUnitContaining(scope)) {
 395     return &object;
 396   } else if (const Symbol * block{FindCommonBlockContaining(ultimate)}) {
 397     return block;
 398   }
 399   return nullptr;
 400 }
 401
 402 const Symbol &BypassGeneric(const Symbol &symbol) {
 403   const Symbol &ultimate{symbol.GetUltimate()};
 404   if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
 405     if (const Symbol * specific{generic->specific()}) {
 406       return *specific;
 407     }
 408   }
 409   return symbol;
 410 }
 411
 412 const Symbol &GetCrayPointer(const Symbol &crayPointee) {
 413   const Symbol *found{nullptr};
 414   for (const auto &[pointee, pointer] :
 415       crayPointee.GetUltimate().owner().crayPointers()) {
 416     if (pointee == crayPointee.name()) {
 417       found = &pointer.get();
 418       break;
 419     }
 420   }
 421   return DEREF(found);
 422 }
 423
 424 bool ExprHasTypeCategory(
 425     const SomeExpr &expr, const common::TypeCategory &type) {
 426   auto dynamicType{expr.GetType()};
 427   return dynamicType && dynamicType->category() == type;
 428 }
 429
 430 bool ExprTypeKindIsDefault(
 431     const SomeExpr &expr, const SemanticsContext &context) {
 432   auto dynamicType{expr.GetType()};
 433   return dynamicType &&
 434       dynamicType->category() != common::TypeCategory::Derived &&
 435       dynamicType->kind() == context.GetDefaultKind(dynamicType->category());
 436 }
 437
 438 // If an analyzed expr or assignment is missing, dump the node and die.
 439 template <typename T>
 440 static void CheckMissingAnalysis(
 441     bool crash, SemanticsContext *context, const T &x) {
 442   if (crash && !(context && context->AnyFatalError())) {
 443     std::string buf;
 444     llvm::raw_string_ostream ss{buf};
 445     ss << "node has not been analyzed:\n";
 446     parser::DumpTree(ss, x);
 447     common::die(buf.c_str());
 448   }
 449 }
 450
 451 const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
 452   CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
 453   return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 454 }
 455 const SomeExpr *GetExprHelper::Get(const parser::Variable &x) {
 456   CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
 457   return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 458 }
 459 const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) {
 460   CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
 461   return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 462 }
 463 const SomeExpr *GetExprHelper::Get(const parser::AllocateObject &x) {
 464   CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
 465   return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 466 }
 467 const SomeExpr *GetExprHelper::Get(const parser::PointerObject &x) {
 468   CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
 469   return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 470 }
 471
 472 const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {
 473   return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
 474                            : nullptr;
 475 }
 476 const evaluate::Assignment *GetAssignment(
 477     const parser::PointerAssignmentStmt &x) {
 478   return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
 479                            : nullptr;
 480 }
 481
 482 const Symbol *FindInterface(const Symbol &symbol) {
 483   return common::visit(
 484       common::visitors{
 485           [](const ProcEntityDetails &details) {
 486             const Symbol *interface{details.procInterface()};
 487             return interface ? FindInterface(*interface) : nullptr;
 488           },
 489           [](const ProcBindingDetails &details) {
 490             return FindInterface(details.symbol());
 491           },
 492           [&](const SubprogramDetails &) { return &symbol; },
 493           [](const UseDetails &details) {
 494             return FindInterface(details.symbol());
 495           },
 496           [](const HostAssocDetails &details) {
 497             return FindInterface(details.symbol());
 498           },
 499           [](const GenericDetails &details) {
 500             return details.specific() ? FindInterface(*details.specific())
 501                                       : nullptr;
 502           },
 503           [](const auto &) -> const Symbol * { return nullptr; },
 504       },
 505       symbol.details());
 506 }
 507
 508 const Symbol *FindSubprogram(const Symbol &symbol) {
 509   return common::visit(
 510       common::visitors{
 511           [&](const ProcEntityDetails &details) -> const Symbol * {
 512             if (details.procInterface()) {
 513               return FindSubprogram(*details.procInterface());
 514             } else {
 515               return &symbol;
 516             }
 517           },
 518           [](const ProcBindingDetails &details) {
 519             return FindSubprogram(details.symbol());
 520           },
 521           [&](const SubprogramDetails &) { return &symbol; },
 522           [](const UseDetails &details) {
 523             return FindSubprogram(details.symbol());
 524           },
 525           [](const HostAssocDetails &details) {
 526             return FindSubprogram(details.symbol());
 527           },
 528           [](const GenericDetails &details) {
 529             return details.specific() ? FindSubprogram(*details.specific())
 530                                       : nullptr;
 531           },
 532           [](const auto &) -> const Symbol * { return nullptr; },
 533       },
 534       symbol.details());
 535 }
 536
 537 const Symbol *FindOverriddenBinding(
 538     const Symbol &symbol, bool &isInaccessibleDeferred) {
 539   isInaccessibleDeferred = false;
 540   if (symbol.has<ProcBindingDetails>()) {
 541     if (const DeclTypeSpec * parentType{FindParentTypeSpec(symbol.owner())}) {
 542       if (const DerivedTypeSpec * parentDerived{parentType->AsDerived()}) {
 543         if (const Scope * parentScope{parentDerived->typeSymbol().scope()}) {
 544           if (const Symbol *
 545               overridden{parentScope->FindComponent(symbol.name())}) {
 546             // 7.5.7.3 p1: only accessible bindings are overridden
 547             if (IsAccessible(*overridden, symbol.owner())) {
 548               return overridden;
 549             } else if (overridden->attrs().test(Attr::DEFERRED)) {
 550               isInaccessibleDeferred = true;
 551               return overridden;
 552             }
 553           }
 554         }
 555       }
 556     }
 557   }
 558   return nullptr;
 559 }
 560
 561 const Symbol *FindGlobal(const Symbol &original) {
 562   const Symbol &ultimate{original.GetUltimate()};
 563   if (ultimate.owner().IsGlobal()) {
 564     return &ultimate;
 565   }
 566   bool isLocal{false};
 567   if (IsDummy(ultimate)) {
 568   } else if (IsPointer(ultimate)) {
 569   } else if (ultimate.has<ProcEntityDetails>()) {
 570     isLocal = IsExternal(ultimate);
 571   } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
 572     isLocal = subp->isInterface();
 573   }
 574   if (isLocal) {
 575     const std::string *bind{ultimate.GetBindName()};
 576     if (!bind || ultimate.name() == *bind) {
 577       const Scope &globalScope{ultimate.owner().context().globalScope()};
 578       if (auto iter{globalScope.find(ultimate.name())};
 579           iter != globalScope.end()) {
 580         const Symbol &global{*iter->second};
 581         const std::string *globalBind{global.GetBindName()};
 582         if (!globalBind || global.name() == *globalBind) {
 583           return &global;
 584         }
 585       }
 586     }
 587   }
 588   return nullptr;
 589 }
 590
 591 const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &derived) {
 592   return FindParentTypeSpec(derived.typeSymbol());
 593 }
 594
 595 const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &decl) {
 596   if (const DerivedTypeSpec * derived{decl.AsDerived()}) {
 597     return FindParentTypeSpec(*derived);
 598   } else {
 599     return nullptr;
 600   }
 601 }
 602
 603 const DeclTypeSpec *FindParentTypeSpec(const Scope &scope) {
 604   if (scope.kind() == Scope::Kind::DerivedType) {
 605     if (const auto *symbol{scope.symbol()}) {
 606       return FindParentTypeSpec(*symbol);
 607     }
 608   }
 609   return nullptr;
 610 }
 611
 612 const DeclTypeSpec *FindParentTypeSpec(const Symbol &symbol) {
 613   if (const Scope * scope{symbol.scope()}) {
 614     if (const auto *details{symbol.detailsIf<DerivedTypeDetails>()}) {
 615       if (const Symbol * parent{details->GetParentComponent(*scope)}) {
 616         return parent->GetType();
 617       }
 618     }
 619   }
 620   return nullptr;
 621 }
 622
 623 const EquivalenceSet *FindEquivalenceSet(const Symbol &symbol) {
 624   const Symbol &ultimate{symbol.GetUltimate()};
 625   for (const EquivalenceSet &set : ultimate.owner().equivalenceSets()) {
 626     for (const EquivalenceObject &object : set) {
 627       if (object.symbol == ultimate) {
 628         return &set;
 629       }
 630     }
 631   }
 632   return nullptr;
 633 }
 634
 635 bool IsOrContainsEventOrLockComponent(const Symbol &original) {
 636   const Symbol &symbol{ResolveAssociations(original)};
 637   if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
 638     if (const DeclTypeSpec * type{details->type()}) {
 639       if (const DerivedTypeSpec * derived{type->AsDerived()}) {
 640         return IsEventTypeOrLockType(derived) ||
 641             FindEventOrLockPotentialComponent(*derived);
 642       }
 643     }
 644   }
 645   return false;
 646 }
 647
 648 // Check this symbol suitable as a type-bound procedure - C769
 649 bool CanBeTypeBoundProc(const Symbol &symbol) {
 650   if (IsDummy(symbol) || IsProcedurePointer(symbol)) {
 651     return false;
 652   } else if (symbol.has<SubprogramNameDetails>()) {
 653     return symbol.owner().kind() == Scope::Kind::Module;
 654   } else if (auto *details{symbol.detailsIf<SubprogramDetails>()}) {
 655     if (details->isInterface()) {
 656       return !symbol.attrs().test(Attr::ABSTRACT);
 657     } else {
 658       return symbol.owner().kind() == Scope::Kind::Module;
 659     }
 660   } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
 661     return !symbol.attrs().test(Attr::INTRINSIC) &&
 662         proc->HasExplicitInterface();
 663   } else {
 664     return false;
 665   }
 666 }
 667
 668 bool HasDeclarationInitializer(const Symbol &symbol) {
 669   if (IsNamedConstant(symbol)) {
 670     return false;
 671   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 672     return object->init().has_value();
 673   } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
 674     return proc->init().has_value();
 675   } else {
 676     return false;
 677   }
 678 }
 679
 680 bool IsInitialized(const Symbol &symbol, bool ignoreDataStatements,
 681     bool ignoreAllocatable, bool ignorePointer) {
 682   if (!ignoreAllocatable && IsAllocatable(symbol)) {
 683     return true;
 684   } else if (!ignoreDataStatements && symbol.test(Symbol::Flag::InDataStmt)) {
 685     return true;
 686   } else if (HasDeclarationInitializer(symbol)) {
 687     return true;
 688   } else if (IsPointer(symbol)) {
 689     return !ignorePointer;
 690   } else if (IsNamedConstant(symbol)) {
 691     return false;
 692   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 693     if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
 694       if (const auto *derived{object->type()->AsDerived()}) {
 695         return derived->HasDefaultInitialization(
 696             ignoreAllocatable, ignorePointer);
 697       }
 698     }
 699   }
 700   return false;
 701 }
 702
 703 bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
 704   if (IsAllocatable(symbol) || IsAutomatic(symbol)) {
 705     return true;
 706   } else if (IsNamedConstant(symbol) || IsFunctionResult(symbol) ||
 707       IsPointer(symbol)) {
 708     return false;
 709   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 710     if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
 711       if (const auto *derived{object->type()->AsDerived()}) {
 712         return &derived->typeSymbol() != derivedTypeSymbol &&
 713             derived->HasDestruction();
 714       }
 715     }
 716   }
 717   return false;
 718 }
 719
 720 bool HasIntrinsicTypeName(const Symbol &symbol) {
 721   std::string name{symbol.name().ToString()};
 722   if (name == "doubleprecision") {
 723     return true;
 724   } else if (name == "derived") {
 725     return false;
 726   } else {
 727     for (int i{0}; i != common::TypeCategory_enumSize; ++i) {
 728       if (name == parser::ToLowerCaseLetters(EnumToString(TypeCategory{i}))) {
 729         return true;
 730       }
 731     }
 732     return false;
 733   }
 734 }
 735
 736 bool IsSeparateModuleProcedureInterface(const Symbol *symbol) {
 737   if (symbol && symbol->attrs().test(Attr::MODULE)) {
 738     if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
 739       return details->isInterface();
 740     }
 741   }
 742   return false;
 743 }
 744
 745 SymbolVector FinalsForDerivedTypeInstantiation(const DerivedTypeSpec &spec) {
 746   SymbolVector result;
 747   const Symbol &typeSymbol{spec.typeSymbol()};
 748   if (const auto *derived{typeSymbol.detailsIf<DerivedTypeDetails>()}) {
 749     for (const auto &pair : derived->finals()) {
 750       const Symbol &subr{*pair.second};
 751       // Errors in FINAL subroutines are caught in CheckFinal
 752       // in check-declarations.cpp.
 753       if (const auto *subprog{subr.detailsIf<SubprogramDetails>()};
 754           subprog && subprog->dummyArgs().size() == 1) {
 755         if (const Symbol * arg{subprog->dummyArgs()[0]}) {
 756           if (const DeclTypeSpec * type{arg->GetType()}) {
 757             if (type->category() == DeclTypeSpec::TypeDerived &&
 758                 evaluate::AreSameDerivedType(spec, type->derivedTypeSpec())) {
 759               result.emplace_back(subr);
 760             }
 761           }
 762         }
 763       }
 764     }
 765   }
 766   return result;
 767 }
 768
 769 const Symbol *IsFinalizable(const Symbol &symbol,
 770     std::set<const DerivedTypeSpec *> *inProgress, bool withImpureFinalizer) {
 771   if (IsPointer(symbol) || evaluate::IsAssumedRank(symbol)) {
 772     return nullptr;
 773   }
 774   if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
 775     if (object->isDummy() && !IsIntentOut(symbol)) {
 776       return nullptr;
 777     }
 778     const DeclTypeSpec *type{object->type()};
 779     if (const DerivedTypeSpec * typeSpec{type ? type->AsDerived() : nullptr}) {
 780       return IsFinalizable(
 781           *typeSpec, inProgress, withImpureFinalizer, symbol.Rank());
 782     }
 783   }
 784   return nullptr;
 785 }
 786
 787 const Symbol *IsFinalizable(const DerivedTypeSpec &derived,
 788     std::set<const DerivedTypeSpec *> *inProgress, bool withImpureFinalizer,
 789     std::optional<int> rank) {
 790   const Symbol *elemental{nullptr};
 791   for (auto ref : FinalsForDerivedTypeInstantiation(derived)) {
 792     const Symbol *symbol{&ref->GetUltimate()};
 793     if (const auto *binding{symbol->detailsIf<ProcBindingDetails>()}) {
 794       symbol = &binding->symbol();
 795     }
 796     if (const auto *proc{symbol->detailsIf<ProcEntityDetails>()}) {
 797       symbol = proc->procInterface();
 798     }
 799     if (!symbol) {
 800     } else if (IsElementalProcedure(*symbol)) {
 801       elemental = symbol;
 802     } else {
 803       if (rank) {
 804         if (const SubprogramDetails *
 805             subp{symbol->detailsIf<SubprogramDetails>()}) {
 806           if (const auto &args{subp->dummyArgs()}; !args.empty() &&
 807               args.at(0) && !evaluate::IsAssumedRank(*args.at(0)) &&
 808               args.at(0)->Rank() != *rank) {
 809             continue; // not a finalizer for this rank
 810           }
 811         }
 812       }
 813       if (!withImpureFinalizer || !IsPureProcedure(*symbol)) {
 814         return symbol;
 815       }
 816       // Found non-elemental pure finalizer of matching rank, but still
 817       // need to check components for an impure finalizer.
 818       elemental = nullptr;
 819       break;
 820     }
 821   }
 822   if (elemental && (!withImpureFinalizer || !IsPureProcedure(*elemental))) {
 823     return elemental;
 824   }
 825   // Check components (including ancestors)
 826   std::set<const DerivedTypeSpec *> basis;
 827   if (inProgress) {
 828     if (inProgress->find(&derived) != inProgress->end()) {
 829       return nullptr; // don't loop on recursive type
 830     }
 831   } else {
 832     inProgress = &basis;
 833   }
 834   auto iterator{inProgress->insert(&derived).first};
 835   const Symbol *result{nullptr};
 836   for (const Symbol &component : PotentialComponentIterator{derived}) {
 837     result = IsFinalizable(component, inProgress, withImpureFinalizer);
 838     if (result) {
 839       break;
 840     }
 841   }
 842   inProgress->erase(iterator);
 843   return result;
 844 }
 845
 846 static const Symbol *HasImpureFinal(
 847     const DerivedTypeSpec &derived, std::optional<int> rank) {
 848   return IsFinalizable(derived, nullptr, /*withImpureFinalizer=*/true, rank);
 849 }
 850
 851 const Symbol *HasImpureFinal(const Symbol &original, std::optional<int> rank) {
 852   const Symbol &symbol{ResolveAssociations(original)};
 853   if (symbol.has<ObjectEntityDetails>()) {
 854     if (const DeclTypeSpec * symType{symbol.GetType()}) {
 855       if (const DerivedTypeSpec * derived{symType->AsDerived()}) {
 856         if (evaluate::IsAssumedRank(symbol)) {
 857           // finalizable assumed-rank not allowed (C839)
 858           return nullptr;
 859         } else {
 860           int actualRank{rank.value_or(symbol.Rank())};
 861           return HasImpureFinal(*derived, actualRank);
 862         }
 863       }
 864     }
 865   }
 866   return nullptr;
 867 }
 868
 869 bool MayRequireFinalization(const DerivedTypeSpec &derived) {
 870   return IsFinalizable(derived) ||
 871       FindPolymorphicAllocatablePotentialComponent(derived);
 872 }
 873
 874 bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
 875   DirectComponentIterator directs{derived};
 876   return std::any_of(directs.begin(), directs.end(), IsAllocatable);
 877 }
 878
 879 bool IsAssumedLengthCharacter(const Symbol &symbol) {
 880   if (const DeclTypeSpec * type{symbol.GetType()}) {
 881     return type->category() == DeclTypeSpec::Character &&
 882         type->characterTypeSpec().length().isAssumed();
 883   } else {
 884     return false;
 885   }
 886 }
 887
 888 bool IsInBlankCommon(const Symbol &symbol) {
 889   const Symbol *block{FindCommonBlockContaining(symbol)};
 890   return block && block->name().empty();
 891 }
 892
 893 // C722 and C723:  For a function to be assumed length, it must be external and
 894 // of CHARACTER type
 895 bool IsExternal(const Symbol &symbol) {
 896   return ClassifyProcedure(symbol) == ProcedureDefinitionClass::External;
 897 }
 898
 899 // Most scopes have no EQUIVALENCE, and this function is a fast no-op for them.
 900 std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &scope) {
 901   UnorderedSymbolSet distinct;
 902   for (const EquivalenceSet &set : scope.equivalenceSets()) {
 903     for (const EquivalenceObject &object : set) {
 904       distinct.emplace(object.symbol);
 905     }
 906   }
 907   // This set is ordered by ascending offsets, with ties broken by greatest
 908   // size.  A multiset is used here because multiple symbols may have the
 909   // same offset and size; the symbols in the set, however, are distinct.
 910   std::multiset<SymbolRef, SymbolOffsetCompare> associated;
 911   for (SymbolRef ref : distinct) {
 912     associated.emplace(*ref);
 913   }
 914   std::list<std::list<SymbolRef>> result;
 915   std::size_t limit{0};
 916   const Symbol *currentCommon{nullptr};
 917   for (const Symbol &symbol : associated) {
 918     const Symbol *thisCommon{FindCommonBlockContaining(symbol)};
 919     if (result.empty() || symbol.offset() >= limit ||
 920         thisCommon != currentCommon) {
 921       // Start a new group
 922       result.emplace_back(std::list<SymbolRef>{});
 923       limit = 0;
 924       currentCommon = thisCommon;
 925     }
 926     result.back().emplace_back(symbol);
 927     limit = std::max(limit, symbol.offset() + symbol.size());
 928   }
 929   return result;
 930 }
 931
 932 bool IsModuleProcedure(const Symbol &symbol) {
 933   return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module;
 934 }
 935
 936 class ImageControlStmtHelper {
 937   using ImageControlStmts =
 938       std::variant<parser::ChangeTeamConstruct, parser::CriticalConstruct,
 939           parser::EventPostStmt, parser::EventWaitStmt, parser::FormTeamStmt,
 940           parser::LockStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
 941           parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt>;
 942
 943 public:
 944   template <typename T> bool operator()(const T &) {
 945     return common::HasMember<T, ImageControlStmts>;
 946   }
 947   template <typename T> bool operator()(const common::Indirection<T> &x) {
 948     return (*this)(x.value());
 949   }
 950   template <typename A> bool operator()(const parser::Statement<A> &x) {
 951     return (*this)(x.statement);
 952   }
 953   bool operator()(const parser::AllocateStmt &stmt) {
 954     const auto &allocationList{std::get<std::list<parser::Allocation>>(stmt.t)};
 955     for (const auto &allocation : allocationList) {
 956       const auto &allocateObject{
 957           std::get<parser::AllocateObject>(allocation.t)};
 958       if (IsCoarrayObject(allocateObject)) {
 959         return true;
 960       }
 961     }
 962     return false;
 963   }
 964   bool operator()(const parser::DeallocateStmt &stmt) {
 965     const auto &allocateObjectList{
 966         std::get<std::list<parser::AllocateObject>>(stmt.t)};
 967     for (const auto &allocateObject : allocateObjectList) {
 968       if (IsCoarrayObject(allocateObject)) {
 969         return true;
 970       }
 971     }
 972     return false;
 973   }
 974   bool operator()(const parser::CallStmt &stmt) {
 975     const auto &procedureDesignator{
 976         std::get<parser::ProcedureDesignator>(stmt.call.t)};
 977     if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
 978       // TODO: also ensure that the procedure is, in fact, an intrinsic
 979       if (name->source == "move_alloc") {
 980         const auto &args{
 981             std::get<std::list<parser::ActualArgSpec>>(stmt.call.t)};
 982         if (!args.empty()) {
 983           const parser::ActualArg &actualArg{
 984               std::get<parser::ActualArg>(args.front().t)};
 985           if (const auto *argExpr{
 986                   std::get_if<common::Indirection<parser::Expr>>(
 987                       &actualArg.u)}) {
 988             return HasCoarray(argExpr->value());
 989           }
 990         }
 991       }
 992     }
 993     return false;
 994   }
 995   bool operator()(const parser::StopStmt &stmt) {
 996     // STOP is an image control statement; ERROR STOP is not
 997     return std::get<parser::StopStmt::Kind>(stmt.t) ==
 998         parser::StopStmt::Kind::Stop;
 999   }
1000   bool operator()(const parser::IfStmt &stmt) {
1001     return (*this)(
1002         std::get<parser::UnlabeledStatement<parser::ActionStmt>>(stmt.t)
1003             .statement);
1004   }
1005   bool operator()(const parser::ActionStmt &stmt) {
1006     return common::visit(*this, stmt.u);
1007   }
1008
1009 private:
1010   bool IsCoarrayObject(const parser::AllocateObject &allocateObject) {
1011     const parser::Name &name{GetLastName(allocateObject)};
1012     return name.symbol && evaluate::IsCoarray(*name.symbol);
1013   }
1014 };
1015
1016 bool IsImageControlStmt(const parser::ExecutableConstruct &construct) {
1017   return common::visit(ImageControlStmtHelper{}, construct.u);
1018 }
1019
1020 std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
1021     const parser::ExecutableConstruct &construct) {
1022   if (const auto *actionStmt{
1023           std::get_if<parser::Statement<parser::ActionStmt>>(&construct.u)}) {
1024     return common::visit(
1025         common::visitors{
1026             [](const common::Indirection<parser::AllocateStmt> &)
1027                 -> std::optional<parser::MessageFixedText> {
1028               return "ALLOCATE of a coarray is an image control"
1029                      " statement"_en_US;
1030             },
1031             [](const common::Indirection<parser::DeallocateStmt> &)
1032                 -> std::optional<parser::MessageFixedText> {
1033               return "DEALLOCATE of a coarray is an image control"
1034                      " statement"_en_US;
1035             },
1036             [](const common::Indirection<parser::CallStmt> &)
1037                 -> std::optional<parser::MessageFixedText> {
1038               return "MOVE_ALLOC of a coarray is an image control"
1039                      " statement "_en_US;
1040             },
1041             [](const auto &) -> std::optional<parser::MessageFixedText> {
1042               return std::nullopt;
1043             },
1044         },
1045         actionStmt->statement.u);
1046   }
1047   return std::nullopt;
1048 }
1049
1050 parser::CharBlock GetImageControlStmtLocation(
1051     const parser::ExecutableConstruct &executableConstruct) {
1052   return common::visit(
1053       common::visitors{
1054           [](const common::Indirection<parser::ChangeTeamConstruct>
1055                   &construct) {
1056             return std::get<parser::Statement<parser::ChangeTeamStmt>>(
1057                 construct.value().t)
1058                 .source;
1059           },
1060           [](const common::Indirection<parser::CriticalConstruct> &construct) {
1061             return std::get<parser::Statement<parser::CriticalStmt>>(
1062                 construct.value().t)
1063                 .source;
1064           },
1065           [](const parser::Statement<parser::ActionStmt> &actionStmt) {
1066             return actionStmt.source;
1067           },
1068           [](const auto &) { return parser::CharBlock{}; },
1069       },
1070       executableConstruct.u);
1071 }
1072
1073 bool HasCoarray(const parser::Expr &expression) {
1074   if (const auto *expr{GetExpr(nullptr, expression)}) {
1075     for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
1076       if (evaluate::IsCoarray(symbol)) {
1077         return true;
1078       }
1079     }
1080   }
1081   return false;
1082 }
1083
1084 bool IsAssumedType(const Symbol &symbol) {
1085   if (const DeclTypeSpec * type{symbol.GetType()}) {
1086     return type->IsAssumedType();
1087   }
1088   return false;
1089 }
1090
1091 bool IsPolymorphic(const Symbol &symbol) {
1092   if (const DeclTypeSpec * type{symbol.GetType()}) {
1093     return type->IsPolymorphic();
1094   }
1095   return false;
1096 }
1097
1098 bool IsUnlimitedPolymorphic(const Symbol &symbol) {
1099   if (const DeclTypeSpec * type{symbol.GetType()}) {
1100     return type->IsUnlimitedPolymorphic();
1101   }
1102   return false;
1103 }
1104
1105 bool IsPolymorphicAllocatable(const Symbol &symbol) {
1106   return IsAllocatable(symbol) && IsPolymorphic(symbol);
1107 }
1108
1109 const Scope *FindCUDADeviceContext(const Scope *scope) {
1110   return !scope ? nullptr : FindScopeContaining(*scope, [](const Scope &s) {
1111     return IsCUDADeviceContext(&s);
1112   });
1113 }
1114
1115 std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *symbol) {
1116   const auto *object{
1117       symbol ? symbol->detailsIf<ObjectEntityDetails>() : nullptr};
1118   return object ? object->cudaDataAttr() : std::nullopt;
1119 }
1120
1121 bool IsAccessible(const Symbol &original, const Scope &scope) {
1122   const Symbol &ultimate{original.GetUltimate()};
1123   if (ultimate.attrs().test(Attr::PRIVATE)) {
1124     const Scope *module{FindModuleContaining(ultimate.owner())};
1125     return !module || module->Contains(scope);
1126   } else {
1127     return true;
1128   }
1129 }
1130
1131 std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
1132     const Scope &scope, const Symbol &symbol) {
1133   if (IsAccessible(symbol, scope)) {
1134     return std::nullopt;
1135   } else if (FindModuleFileContaining(scope)) {
1136     // Don't enforce component accessibility checks in module files;
1137     // there may be forward-substituted named constants of derived type
1138     // whose structure constructors reference private components.
1139     return std::nullopt;
1140   } else {
1141     return parser::MessageFormattedText{
1142         "PRIVATE name '%s' is only accessible within module '%s'"_err_en_US,
1143         symbol.name(),
1144         DEREF(FindModuleContaining(symbol.owner())).GetName().value()};
1145   }
1146 }
1147
1148 SymbolVector OrderParameterNames(const Symbol &typeSymbol) {
1149   SymbolVector result;
1150   if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
1151     result = OrderParameterNames(spec->typeSymbol());
1152   }
1153   const auto &paramNames{typeSymbol.get<DerivedTypeDetails>().paramNameOrder()};
1154   result.insert(result.end(), paramNames.begin(), paramNames.end());
1155   return result;
1156 }
1157
1158 SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) {
1159   SymbolVector result;
1160   if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
1161     result = OrderParameterDeclarations(spec->typeSymbol());
1162   }
1163   const auto &paramDecls{typeSymbol.get<DerivedTypeDetails>().paramDeclOrder()};
1164   result.insert(result.end(), paramDecls.begin(), paramDecls.end());
1165   return result;
1166 }
1167
1168 const DeclTypeSpec &FindOrInstantiateDerivedType(
1169     Scope &scope, DerivedTypeSpec &&spec, DeclTypeSpec::Category category) {
1170   spec.EvaluateParameters(scope.context());
1171   if (const DeclTypeSpec *
1172       type{scope.FindInstantiatedDerivedType(spec, category)}) {
1173     return *type;
1174   }
1175   // Create a new instantiation of this parameterized derived type
1176   // for this particular distinct set of actual parameter values.
1177   DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))};
1178   type.derivedTypeSpec().Instantiate(scope);
1179   return type;
1180 }
1181
1182 const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) {
1183   if (proc) {
1184     if (const auto *subprogram{proc->detailsIf<SubprogramDetails>()}) {
1185       if (const Symbol * iface{subprogram->moduleInterface()}) {
1186         return iface;
1187       }
1188     }
1189   }
1190   return nullptr;
1191 }
1192
1193 ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
1194   const Symbol &ultimate{symbol.GetUltimate()};
1195   if (!IsProcedure(ultimate)) {
1196     return ProcedureDefinitionClass::None;
1197   } else if (ultimate.attrs().test(Attr::INTRINSIC)) {
1198     return ProcedureDefinitionClass::Intrinsic;
1199   } else if (IsDummy(ultimate)) {
1200     return ProcedureDefinitionClass::Dummy;
1201   } else if (IsProcedurePointer(symbol)) {
1202     return ProcedureDefinitionClass::Pointer;
1203   } else if (ultimate.attrs().test(Attr::EXTERNAL)) {
1204     return ProcedureDefinitionClass::External;
1205   } else if (const auto *nameDetails{
1206                  ultimate.detailsIf<SubprogramNameDetails>()}) {
1207     switch (nameDetails->kind()) {
1208     case SubprogramKind::Module:
1209       return ProcedureDefinitionClass::Module;
1210     case SubprogramKind::Internal:
1211       return ProcedureDefinitionClass::Internal;
1212     }
1213   } else if (const Symbol * subp{FindSubprogram(symbol)}) {
1214     if (const auto *subpDetails{subp->detailsIf<SubprogramDetails>()}) {
1215       if (subpDetails->stmtFunction()) {
1216         return ProcedureDefinitionClass::StatementFunction;
1217       }
1218     }
1219     switch (ultimate.owner().kind()) {
1220     case Scope::Kind::Global:
1221     case Scope::Kind::IntrinsicModules:
1222       return ProcedureDefinitionClass::External;
1223     case Scope::Kind::Module:
1224       return ProcedureDefinitionClass::Module;
1225     case Scope::Kind::MainProgram:
1226     case Scope::Kind::Subprogram:
1227       return ProcedureDefinitionClass::Internal;
1228     default:
1229       break;
1230     }
1231   }
1232   return ProcedureDefinitionClass::None;
1233 }
1234
1235 // ComponentIterator implementation
1236
1237 template <ComponentKind componentKind>
1238 typename ComponentIterator<componentKind>::const_iterator
1239 ComponentIterator<componentKind>::const_iterator::Create(
1240     const DerivedTypeSpec &derived) {
1241   const_iterator it{};
1242   it.componentPath_.emplace_back(derived);
1243   it.Increment(); // cue up first relevant component, if any
1244   return it;
1245 }
1246
1247 template <ComponentKind componentKind>
1248 const DerivedTypeSpec *
1249 ComponentIterator<componentKind>::const_iterator::PlanComponentTraversal(
1250     const Symbol &component) const {
1251   if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
1252     if (const DeclTypeSpec * type{details->type()}) {
1253       if (const auto *derived{type->AsDerived()}) {
1254         bool traverse{false};
1255         if constexpr (componentKind == ComponentKind::Ordered) {
1256           // Order Component (only visit parents)
1257           traverse = component.test(Symbol::Flag::ParentComp);
1258         } else if constexpr (componentKind == ComponentKind::Direct) {
1259           traverse = !IsAllocatableOrObjectPointer(&component);
1260         } else if constexpr (componentKind == ComponentKind::Ultimate) {
1261           traverse = !IsAllocatableOrObjectPointer(&component);
1262         } else if constexpr (componentKind == ComponentKind::Potential) {
1263           traverse = !IsPointer(component);
1264         } else if constexpr (componentKind == ComponentKind::Scope) {
1265           traverse = !IsAllocatableOrObjectPointer(&component);
1266         } else if constexpr (componentKind ==
1267             ComponentKind::PotentialAndPointer) {
1268           traverse = !IsPointer(component);
1269         }
1270         if (traverse) {
1271           const Symbol &newTypeSymbol{derived->typeSymbol()};
1272           // Avoid infinite loop if the type is already part of the types
1273           // being visited. It is possible to have "loops in type" because
1274           // C744 does not forbid to use not yet declared type for
1275           // ALLOCATABLE or POINTER components.
1276           for (const auto &node : componentPath_) {
1277             if (&newTypeSymbol == &node.GetTypeSymbol()) {
1278               return nullptr;
1279             }
1280           }
1281           return derived;
1282         }
1283       }
1284     } // intrinsic & unlimited polymorphic not traversable
1285   }
1286   return nullptr;
1287 }
1288
1289 template <ComponentKind componentKind>
1290 static bool StopAtComponentPre(const Symbol &component) {
1291   if constexpr (componentKind == ComponentKind::Ordered) {
1292     // Parent components need to be iterated upon after their
1293     // sub-components in structure constructor analysis.
1294     return !component.test(Symbol::Flag::ParentComp);
1295   } else if constexpr (componentKind == ComponentKind::Direct) {
1296     return true;
1297   } else if constexpr (componentKind == ComponentKind::Ultimate) {
1298     return component.has<ProcEntityDetails>() ||
1299         IsAllocatableOrObjectPointer(&component) ||
1300         (component.has<ObjectEntityDetails>() &&
1301             component.get<ObjectEntityDetails>().type() &&
1302             component.get<ObjectEntityDetails>().type()->AsIntrinsic());
1303   } else if constexpr (componentKind == ComponentKind::Potential) {
1304     return !IsPointer(component);
1305   } else if constexpr (componentKind == ComponentKind::PotentialAndPointer) {
1306     return true;
1307   } else {
1308     DIE("unexpected ComponentKind");
1309   }
1310 }
1311
1312 template <ComponentKind componentKind>
1313 static bool StopAtComponentPost(const Symbol &component) {
1314   return componentKind == ComponentKind::Ordered &&
1315       component.test(Symbol::Flag::ParentComp);
1316 }
1317
1318 template <ComponentKind componentKind>
1319 void ComponentIterator<componentKind>::const_iterator::Increment() {
1320   while (!componentPath_.empty()) {
1321     ComponentPathNode &deepest{componentPath_.back()};
1322     if (deepest.component()) {
1323       if (!deepest.descended()) {
1324         deepest.set_descended(true);
1325         if (const DerivedTypeSpec *
1326             derived{PlanComponentTraversal(*deepest.component())}) {
1327           componentPath_.emplace_back(*derived);
1328           continue;
1329         }
1330       } else if (!deepest.visited()) {
1331         deepest.set_visited(true);
1332         return; // this is the next component to visit, after descending
1333       }
1334     }
1335     auto &nameIterator{deepest.nameIterator()};
1336     if (nameIterator == deepest.nameEnd()) {
1337       componentPath_.pop_back();
1338     } else if constexpr (componentKind == ComponentKind::Scope) {
1339       deepest.set_component(*nameIterator++->second);
1340       deepest.set_descended(false);
1341       deepest.set_visited(true);
1342       return; // this is the next component to visit, before descending
1343     } else {
1344       const Scope &scope{deepest.GetScope()};
1345       auto scopeIter{scope.find(*nameIterator++)};
1346       if (scopeIter != scope.cend()) {
1347         const Symbol &component{*scopeIter->second};
1348         deepest.set_component(component);
1349         deepest.set_descended(false);
1350         if (StopAtComponentPre<componentKind>(component)) {
1351           deepest.set_visited(true);
1352           return; // this is the next component to visit, before descending
1353         } else {
1354           deepest.set_visited(!StopAtComponentPost<componentKind>(component));
1355         }
1356       }
1357     }
1358   }
1359 }
1360
1361 template <ComponentKind componentKind>
1362 SymbolVector
1363 ComponentIterator<componentKind>::const_iterator::GetComponentPath() const {
1364   SymbolVector result;
1365   for (const auto &node : componentPath_) {
1366     result.push_back(DEREF(node.component()));
1367   }
1368   return result;
1369 }
1370
1371 template <ComponentKind componentKind>
1372 std::string
1373 ComponentIterator<componentKind>::const_iterator::BuildResultDesignatorName()
1374     const {
1375   std::string designator;
1376   for (const Symbol &component : GetComponentPath()) {
1377     designator += "%"s + component.name().ToString();
1378   }
1379   return designator;
1380 }
1381
1382 template class ComponentIterator<ComponentKind::Ordered>;
1383 template class ComponentIterator<ComponentKind::Direct>;
1384 template class ComponentIterator<ComponentKind::Ultimate>;
1385 template class ComponentIterator<ComponentKind::Potential>;
1386 template class ComponentIterator<ComponentKind::Scope>;
1387 template class ComponentIterator<ComponentKind::PotentialAndPointer>;
1388
1389 UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
1390     const DerivedTypeSpec &derived) {
1391   UltimateComponentIterator ultimates{derived};
1392   return std::find_if(ultimates.begin(), ultimates.end(),
1393       [](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
1394 }
1395
1396 UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
1397     const DerivedTypeSpec &derived) {
1398   UltimateComponentIterator ultimates{derived};
1399   return std::find_if(ultimates.begin(), ultimates.end(), IsPointer);
1400 }
1401
1402 PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
1403     const DerivedTypeSpec &derived, bool ignoreCoarrays) {
1404   PotentialComponentIterator potentials{derived};
1405   auto iter{potentials.begin()};
1406   for (auto end{potentials.end()}; iter != end; ++iter) {
1407     const Symbol &component{*iter};
1408     if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
1409       if (const DeclTypeSpec * type{object->type()}) {
1410         if (IsEventTypeOrLockType(type->AsDerived())) {
1411           if (!ignoreCoarrays) {
1412             break; // found one
1413           }
1414           auto path{iter.GetComponentPath()};
1415           path.pop_back();
1416           if (std::find_if(path.begin(), path.end(), [](const Symbol &sym) {
1417                 return evaluate::IsCoarray(sym);
1418               }) == path.end()) {
1419             break; // found one not in a coarray
1420           }
1421         }
1422       }
1423     }
1424   }
1425   return iter;
1426 }
1427
1428 UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
1429     const DerivedTypeSpec &derived) {
1430   UltimateComponentIterator ultimates{derived};
1431   return std::find_if(ultimates.begin(), ultimates.end(), IsAllocatable);
1432 }
1433
1434 DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
1435     const DerivedTypeSpec &derived) {
1436   DirectComponentIterator directs{derived};
1437   return std::find_if(directs.begin(), directs.end(), IsAllocatableOrPointer);
1438 }
1439
1440 PotentialComponentIterator::const_iterator
1441 FindPolymorphicAllocatablePotentialComponent(const DerivedTypeSpec &derived) {
1442   PotentialComponentIterator potentials{derived};
1443   return std::find_if(
1444       potentials.begin(), potentials.end(), IsPolymorphicAllocatable);
1445 }
1446
1447 const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
1448     const std::function<bool(const Symbol &)> &predicate) {
1449   UltimateComponentIterator ultimates{derived};
1450   if (auto it{std::find_if(ultimates.begin(), ultimates.end(),
1451           [&predicate](const Symbol &component) -> bool {
1452             return predicate(component);
1453           })}) {
1454     return &*it;
1455   }
1456   return nullptr;
1457 }
1458
1459 const Symbol *FindUltimateComponent(const Symbol &symbol,
1460     const std::function<bool(const Symbol &)> &predicate) {
1461   if (predicate(symbol)) {
1462     return &symbol;
1463   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
1464     if (const auto *type{object->type()}) {
1465       if (const auto *derived{type->AsDerived()}) {
1466         return FindUltimateComponent(*derived, predicate);
1467       }
1468     }
1469   }
1470   return nullptr;
1471 }
1472
1473 const Symbol *FindImmediateComponent(const DerivedTypeSpec &type,
1474     const std::function<bool(const Symbol &)> &predicate) {
1475   if (const Scope * scope{type.scope()}) {
1476     const Symbol *parent{nullptr};
1477     for (const auto &pair : *scope) {
1478       const Symbol *symbol{&*pair.second};
1479       if (predicate(*symbol)) {
1480         return symbol;
1481       }
1482       if (symbol->test(Symbol::Flag::ParentComp)) {
1483         parent = symbol;
1484       }
1485     }
1486     if (parent) {
1487       if (const auto *object{parent->detailsIf<ObjectEntityDetails>()}) {
1488         if (const auto *type{object->type()}) {
1489           if (const auto *derived{type->AsDerived()}) {
1490             return FindImmediateComponent(*derived, predicate);
1491           }
1492         }
1493       }
1494     }
1495   }
1496   return nullptr;
1497 }
1498
1499 const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
1500   if (IsFunctionResult(symbol)) {
1501     if (const Symbol * function{symbol.owner().symbol()}) {
1502       if (symbol.name() == function->name()) {
1503         return function;
1504       }
1505     }
1506     // Check ENTRY result symbols too
1507     const Scope &outer{symbol.owner().parent()};
1508     auto iter{outer.find(symbol.name())};
1509     if (iter != outer.end()) {
1510       const Symbol &outerSym{*iter->second};
1511       if (const auto *subp{outerSym.detailsIf<SubprogramDetails>()}) {
1512         if (subp->entryScope() == &symbol.owner() &&
1513             symbol.name() == outerSym.name()) {
1514           return &outerSym;
1515         }
1516       }
1517     }
1518   }
1519   return nullptr;
1520 }
1521
1522 void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) {
1523   CheckLabelUse(gotoStmt.v);
1524 }
1525 void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) {
1526   for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
1527     CheckLabelUse(i);
1528   }
1529 }
1530
1531 void LabelEnforce::Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
1532   CheckLabelUse(std::get<1>(arithmeticIfStmt.t));
1533   CheckLabelUse(std::get<2>(arithmeticIfStmt.t));
1534   CheckLabelUse(std::get<3>(arithmeticIfStmt.t));
1535 }
1536
1537 void LabelEnforce::Post(const parser::AssignStmt &assignStmt) {
1538   CheckLabelUse(std::get<parser::Label>(assignStmt.t));
1539 }
1540
1541 void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
1542   for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
1543     CheckLabelUse(i);
1544   }
1545 }
1546
1547 void LabelEnforce::Post(const parser::AltReturnSpec &altReturnSpec) {
1548   CheckLabelUse(altReturnSpec.v);
1549 }
1550
1551 void LabelEnforce::Post(const parser::ErrLabel &errLabel) {
1552   CheckLabelUse(errLabel.v);
1553 }
1554 void LabelEnforce::Post(const parser::EndLabel &endLabel) {
1555   CheckLabelUse(endLabel.v);
1556 }
1557 void LabelEnforce::Post(const parser::EorLabel &eorLabel) {
1558   CheckLabelUse(eorLabel.v);
1559 }
1560
1561 void LabelEnforce::CheckLabelUse(const parser::Label &labelUsed) {
1562   if (labels_.find(labelUsed) == labels_.end()) {
1563     SayWithConstruct(context_, currentStatementSourcePosition_,
1564         parser::MessageFormattedText{
1565             "Control flow escapes from %s"_err_en_US, construct_},
1566         constructSourcePosition_);
1567   }
1568 }
1569
1570 parser::MessageFormattedText LabelEnforce::GetEnclosingConstructMsg() {
1571   return {"Enclosing %s statement"_en_US, construct_};
1572 }
1573
1574 void LabelEnforce::SayWithConstruct(SemanticsContext &context,
1575     parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
1576     parser::CharBlock constructLocation) {
1577   context.Say(stmtLocation, message)
1578       .Attach(constructLocation, GetEnclosingConstructMsg());
1579 }
1580
1581 bool HasAlternateReturns(const Symbol &subprogram) {
1582   for (const auto *dummyArg : subprogram.get<SubprogramDetails>().dummyArgs()) {
1583     if (!dummyArg) {
1584       return true;
1585     }
1586   }
1587   return false;
1588 }
1589
1590 bool IsAutomaticallyDestroyed(const Symbol &symbol) {
1591   return symbol.has<ObjectEntityDetails>() &&
1592       (symbol.owner().kind() == Scope::Kind::Subprogram ||
1593           symbol.owner().kind() == Scope::Kind::BlockConstruct) &&
1594       !IsNamedConstant(symbol) && (!IsDummy(symbol) || IsIntentOut(symbol)) &&
1595       !IsPointer(symbol) && !IsSaved(symbol) &&
1596       !FindCommonBlockContaining(symbol);
1597 }
1598
1599 const std::optional<parser::Name> &MaybeGetNodeName(
1600     const ConstructNode &construct) {
1601   return common::visit(
1602       common::visitors{
1603           [&](const parser::BlockConstruct *blockConstruct)
1604               -> const std::optional<parser::Name> & {
1605             return std::get<0>(blockConstruct->t).statement.v;
1606           },
1607           [&](const auto *a) -> const std::optional<parser::Name> & {
1608             return std::get<0>(std::get<0>(a->t).statement.t);
1609           },
1610       },
1611       construct);
1612 }
1613
1614 std::optional<ArraySpec> ToArraySpec(
1615     evaluate::FoldingContext &context, const evaluate::Shape &shape) {
1616   if (auto extents{evaluate::AsConstantExtents(context, shape)};
1617       extents && !evaluate::HasNegativeExtent(*extents)) {
1618     ArraySpec result;
1619     for (const auto &extent : *extents) {
1620       result.emplace_back(ShapeSpec::MakeExplicit(Bound{extent}));
1621     }
1622     return {std::move(result)};
1623   } else {
1624     return std::nullopt;
1625   }
1626 }
1627
1628 std::optional<ArraySpec> ToArraySpec(evaluate::FoldingContext &context,
1629     const std::optional<evaluate::Shape> &shape) {
1630   return shape ? ToArraySpec(context, *shape) : std::nullopt;
1631 }
1632
1633 static const DeclTypeSpec *GetDtvArgTypeSpec(const Symbol &proc) {
1634   if (const auto *subp{proc.detailsIf<SubprogramDetails>()};
1635       subp && !subp->dummyArgs().empty()) {
1636     if (const auto *arg{subp->dummyArgs()[0]}) {
1637       return arg->GetType();
1638     }
1639   }
1640   return nullptr;
1641 }
1642
1643 const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &proc) {
1644   if (const auto *type{GetDtvArgTypeSpec(proc)}) {
1645     return type->AsDerived();
1646   } else {
1647     return nullptr;
1648   }
1649 }
1650
1651 bool HasDefinedIo(common::DefinedIo which, const DerivedTypeSpec &derived,
1652     const Scope *scope) {
1653   if (const Scope * dtScope{derived.scope()}) {
1654     for (const auto &pair : *dtScope) {
1655       const Symbol &symbol{*pair.second};
1656       if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
1657         GenericKind kind{generic->kind()};
1658         if (const auto *io{std::get_if<common::DefinedIo>(&kind.u)}) {
1659           if (*io == which) {
1660             return true; // type-bound GENERIC exists
1661           }
1662         }
1663       }
1664     }
1665   }
1666   if (scope) {
1667     SourceName name{GenericKind::AsFortran(which)};
1668     evaluate::DynamicType dyDerived{derived};
1669     for (; scope && !scope->IsGlobal(); scope = &scope->parent()) {
1670       auto iter{scope->find(name)};
1671       if (iter != scope->end()) {
1672         const auto &generic{iter->second->GetUltimate().get<GenericDetails>()};
1673         for (auto ref : generic.specificProcs()) {
1674           const Symbol &procSym{ref->GetUltimate()};
1675           if (const DeclTypeSpec * dtSpec{GetDtvArgTypeSpec(procSym)}) {
1676             if (auto dyDummy{evaluate::DynamicType::From(*dtSpec)}) {
1677               if (dyDummy->IsTkCompatibleWith(dyDerived)) {
1678                 return true; // GENERIC or INTERFACE not in type
1679               }
1680             }
1681           }
1682         }
1683       }
1684     }
1685   }
1686   // Check for inherited defined I/O
1687   const auto *parentType{derived.typeSymbol().GetParentTypeSpec()};
1688   return parentType && HasDefinedIo(which, *parentType, scope);
1689 }
1690
1691 template <typename E>
1692 std::forward_list<std::string> GetOperatorNames(
1693     const SemanticsContext &context, E opr) {
1694   std::forward_list<std::string> result;
1695   for (const char *name : context.languageFeatures().GetNames(opr)) {
1696     result.emplace_front("operator("s + name + ')');
1697   }
1698   return result;
1699 }
1700
1701 std::forward_list<std::string> GetAllNames(
1702     const SemanticsContext &context, const SourceName &name) {
1703   std::string str{name.ToString()};
1704   if (!name.empty() && name.end()[-1] == ')' &&
1705       name.ToString().rfind("operator(", 0) == 0) {
1706     for (int i{0}; i != common::LogicalOperator_enumSize; ++i) {
1707       auto names{GetOperatorNames(context, common::LogicalOperator{i})};
1708       if (llvm::is_contained(names, str)) {
1709         return names;
1710       }
1711     }
1712     for (int i{0}; i != common::RelationalOperator_enumSize; ++i) {
1713       auto names{GetOperatorNames(context, common::RelationalOperator{i})};
1714       if (llvm::is_contained(names, str)) {
1715         return names;
1716       }
1717     }
1718   }
1719   return {str};
1720 }
1721
1722 void WarnOnDeferredLengthCharacterScalar(SemanticsContext &context,
1723     const SomeExpr *expr, parser::CharBlock at, const char *what) {
1724   if (context.languageFeatures().ShouldWarn(
1725           common::UsageWarning::F202XAllocatableBreakingChange)) {
1726     if (const Symbol *
1727         symbol{evaluate::UnwrapWholeSymbolOrComponentDataRef(expr)}) {
1728       const Symbol &ultimate{ResolveAssociations(*symbol)};
1729       if (const DeclTypeSpec * type{ultimate.GetType()}; type &&
1730           type->category() == DeclTypeSpec::Category::Character &&
1731           type->characterTypeSpec().length().isDeferred() &&
1732           IsAllocatable(ultimate) && ultimate.Rank() == 0) {
1733         context.Say(at,
1734             "The deferred length allocatable character scalar variable '%s' may be reallocated to a different length under the new Fortran 202X standard semantics for %s"_port_en_US,
1735             symbol->name(), what);
1736       }
1737     }
1738   }
1739 }
1740
1741 bool CouldBeDataPointerValuedFunction(const Symbol *original) {
1742   if (original) {
1743     const Symbol &ultimate{original->GetUltimate()};
1744     if (const Symbol * result{FindFunctionResult(ultimate)}) {
1745       return IsPointer(*result) && !IsProcedure(*result);
1746     }
1747     if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
1748       for (const SymbolRef &ref : generic->specificProcs()) {
1749         if (CouldBeDataPointerValuedFunction(&*ref)) {
1750           return true;
1751         }
1752       }
1753     }
1754   }
1755   return false;
1756 }
1757
1758 std::string GetModuleOrSubmoduleName(const Symbol &symbol) {
1759   const auto &details{symbol.get<ModuleDetails>()};
1760   std::string result{symbol.name().ToString()};
1761   if (details.ancestor() && details.ancestor()->symbol()) {
1762     result = details.ancestor()->symbol()->name().ToString() + ':' + result;
1763   }
1764   return result;
1765 }
1766
1767 std::string GetCommonBlockObjectName(const Symbol &common, bool underscoring) {
1768   if (const std::string * bind{common.GetBindName()}) {
1769     return *bind;
1770   }
1771   if (common.name().empty()) {
1772     return Fortran::common::blankCommonObjectName;
1773   }
1774   return underscoring ? common.name().ToString() + "_"s
1775                       : common.name().ToString();
1776 }
1777
1778 bool HadUseError(
1779     SemanticsContext &context, SourceName at, const Symbol *symbol) {
1780   if (const auto *details{
1781           symbol ? symbol->detailsIf<UseErrorDetails>() : nullptr}) {
1782     auto &msg{context.Say(
1783         at, "Reference to '%s' is ambiguous"_err_en_US, symbol->name())};
1784     for (const auto &[location, sym] : details->occurrences()) {
1785       const Symbol &ultimate{sym->GetUltimate()};
1786       auto &attachment{
1787           msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US,
1788               at, sym->owner().GetName().value())};
1789       if (&*sym != &ultimate) {
1790         // For incompatible definitions where one comes from a hermetic
1791         // module file's incorporated dependences and the other from another
1792         // module of the same name.
1793         attachment.Attach(ultimate.name(),
1794             "ultimately from '%s' in module '%s'"_en_US, ultimate.name(),
1795             ultimate.owner().GetName().value());
1796       }
1797     }
1798     context.SetError(*symbol);
1799     return true;
1800   } else {
1801     return false;
1802   }
1803 }
1804
1805 } // namespace Fortran::semantics