flang/lib/semantics/resolve-names.cpp

   1 //===-- lib/semantics/resolve-names.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 "resolve-names.h"
  10 #include "assignment.h"
  11 #include "check-omp-structure.h"
  12 #include "mod-file.h"
  13 #include "program-tree.h"
  14 #include "resolve-names-utils.h"
  15 #include "rewrite-parse-tree.h"
  16 #include "flang/common/Fortran.h"
  17 #include "flang/common/default-kinds.h"
  18 #include "flang/common/indirection.h"
  19 #include "flang/common/restorer.h"
  20 #include "flang/evaluate/characteristics.h"
  21 #include "flang/evaluate/common.h"
  22 #include "flang/evaluate/fold.h"
  23 #include "flang/evaluate/intrinsics.h"
  24 #include "flang/evaluate/tools.h"
  25 #include "flang/evaluate/type.h"
  26 #include "flang/parser/parse-tree-visitor.h"
  27 #include "flang/parser/parse-tree.h"
  28 #include "flang/parser/tools.h"
  29 #include "flang/semantics/attr.h"
  30 #include "flang/semantics/expression.h"
  31 #include "flang/semantics/scope.h"
  32 #include "flang/semantics/semantics.h"
  33 #include "flang/semantics/symbol.h"
  34 #include "flang/semantics/tools.h"
  35 #include "flang/semantics/type.h"
  36 #include <list>
  37 #include <map>
  38 #include <ostream>
  39 #include <set>
  40 #include <stack>
  41
  42 namespace Fortran::semantics {
  43
  44 using namespace parser::literals;
  45
  46 template<typename T> using Indirection = common::Indirection<T>;
  47 using Message = parser::Message;
  48 using Messages = parser::Messages;
  49 using MessageFixedText = parser::MessageFixedText;
  50 using MessageFormattedText = parser::MessageFormattedText;
  51
  52 class ResolveNamesVisitor;
  53
  54 // ImplicitRules maps initial character of identifier to the DeclTypeSpec
  55 // representing the implicit type; std::nullopt if none.
  56 // It also records the presence of IMPLICIT NONE statements.
  57 // When inheritFromParent is set, defaults come from the parent rules.
  58 class ImplicitRules {
  59 public:
  60   ImplicitRules(SemanticsContext &context, ImplicitRules *parent)
  61     : parent_{parent}, context_{context} {
  62     inheritFromParent_ = parent != nullptr;
  63   }
  64   bool isImplicitNoneType() const;
  65   bool isImplicitNoneExternal() const;
  66   void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
  67   void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
  68   void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
  69   // Get the implicit type for identifiers starting with ch. May be null.
  70   const DeclTypeSpec *GetType(char ch) const;
  71   // Record the implicit type for the range of characters [fromLetter,
  72   // toLetter].
  73   void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
  74       parser::Location toLetter);
  75
  76 private:
  77   static char Incr(char ch);
  78
  79   ImplicitRules *parent_;
  80   SemanticsContext &context_;
  81   bool inheritFromParent_{false};  // look in parent if not specified here
  82   bool isImplicitNoneType_{false};
  83   bool isImplicitNoneExternal_{false};
  84   // map_ contains the mapping between letters and types that were defined
  85   // by the IMPLICIT statements of the related scope. It does not contain
  86   // the default Fortran mappings nor the mapping defined in parents.
  87   std::map<char, common::Reference<const DeclTypeSpec>> map_;
  88
  89   friend std::ostream &operator<<(std::ostream &, const ImplicitRules &);
  90   friend void ShowImplicitRule(std::ostream &, const ImplicitRules &, char);
  91 };
  92
  93 // Track statement source locations and save messages.
  94 class MessageHandler {
  95 public:
  96   MessageHandler() { DIE("MessageHandler: default-constructed"); }
  97   explicit MessageHandler(SemanticsContext &c) : context_{&c} {}
  98   Messages &messages() { return context_->messages(); };
  99   const std::optional<SourceName> &currStmtSource() {
 100     return context_->location();
 101   }
 102   void set_currStmtSource(const std::optional<SourceName> &source) {
 103     context_->set_location(source);
 104   }
 105
 106   // Emit a message associated with the current statement source.
 107   Message &Say(MessageFixedText &&);
 108   Message &Say(MessageFormattedText &&);
 109   // Emit a message about a SourceName
 110   Message &Say(const SourceName &, MessageFixedText &&);
 111   // Emit a formatted message associated with a source location.
 112   template<typename... A>
 113   Message &Say(const SourceName &source, MessageFixedText &&msg, A &&... args) {
 114     return context_->Say(source, std::move(msg), std::forward<A>(args)...);
 115   }
 116
 117 private:
 118   SemanticsContext *context_;
 119 };
 120
 121 // Inheritance graph for the parse tree visitation classes that follow:
 122 //   BaseVisitor
 123 //   + AttrsVisitor
 124 //   | + DeclTypeSpecVisitor
 125 //   |   + ImplicitRulesVisitor
 126 //   |     + ScopeHandler -----------+--+
 127 //   |       + ModuleVisitor ========|==+
 128 //   |       + InterfaceVisitor      |  |
 129 //   |       +-+ SubprogramVisitor ==|==+
 130 //   + ArraySpecVisitor              |  |
 131 //     + DeclarationVisitor <--------+  |
 132 //       + ConstructVisitor             |
 133 //         + ResolveNamesVisitor <------+
 134
 135 class BaseVisitor {
 136 public:
 137   BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
 138   BaseVisitor(SemanticsContext &c, ResolveNamesVisitor &v)
 139     : this_{&v}, context_{&c}, messageHandler_{c} {}
 140   template<typename T> void Walk(const T &);
 141
 142   MessageHandler &messageHandler() { return messageHandler_; }
 143   const std::optional<SourceName> &currStmtSource() {
 144     return context_->location();
 145   }
 146   SemanticsContext &context() const { return *context_; }
 147   evaluate::FoldingContext &GetFoldingContext() const {
 148     return context_->foldingContext();
 149   }
 150
 151   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
 152   // It is not in any scope and always has MiscDetails.
 153   void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
 154
 155   template<typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
 156     return evaluate::Fold(GetFoldingContext(), std::move(expr));
 157   }
 158
 159   template<typename T> MaybeExpr EvaluateExpr(const T &expr) {
 160     return FoldExpr(AnalyzeExpr(*context_, expr));
 161   }
 162
 163   template<typename T>
 164   MaybeExpr EvaluateConvertedExpr(
 165       const Symbol &symbol, const T &expr, parser::CharBlock source) {
 166     if (context().HasError(symbol)) {
 167       return std::nullopt;
 168     }
 169     auto maybeExpr{AnalyzeExpr(*context_, expr)};
 170     if (!maybeExpr) {
 171       return std::nullopt;
 172     }
 173     auto exprType{maybeExpr->GetType()};
 174     auto converted{evaluate::ConvertToType(symbol, std::move(*maybeExpr))};
 175     if (!converted) {
 176       if (exprType) {
 177         Say(source,
 178             "Initialization expression could not be converted to declared type of '%s' from %s"_err_en_US,
 179             symbol.name(), exprType->AsFortran());
 180       } else {
 181         Say(source,
 182             "Initialization expression could not be converted to declared type of '%s'"_err_en_US,
 183             symbol.name());
 184       }
 185       return std::nullopt;
 186     }
 187     return FoldExpr(std::move(*converted));
 188   }
 189
 190   template<typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
 191     if (MaybeExpr maybeExpr{EvaluateExpr(expr)}) {
 192       if (auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*maybeExpr)}) {
 193         return std::move(*intExpr);
 194       }
 195     }
 196     return std::nullopt;
 197   }
 198
 199   template<typename T>
 200   MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
 201     if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
 202       return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
 203           std::move(*maybeIntExpr)));
 204     } else {
 205       return std::nullopt;
 206     }
 207   }
 208
 209   template<typename... A> Message &Say(A &&... args) {
 210     return messageHandler_.Say(std::forward<A>(args)...);
 211   }
 212   template<typename... A>
 213   Message &Say(
 214       const parser::Name &name, MessageFixedText &&text, const A &... args) {
 215     return messageHandler_.Say(name.source, std::move(text), args...);
 216   }
 217
 218 private:
 219   ResolveNamesVisitor *this_;
 220   SemanticsContext *context_;
 221   MessageHandler messageHandler_;
 222 };
 223
 224 // Provide Post methods to collect attributes into a member variable.
 225 class AttrsVisitor : public virtual BaseVisitor {
 226 public:
 227   bool BeginAttrs();  // always returns true
 228   Attrs GetAttrs();
 229   Attrs EndAttrs();
 230   bool SetPassNameOn(Symbol &);
 231   bool SetBindNameOn(Symbol &);
 232   void Post(const parser::LanguageBindingSpec &);
 233   bool Pre(const parser::AccessSpec &);
 234   bool Pre(const parser::IntentSpec &);
 235   bool Pre(const parser::Pass &);
 236
 237 // Simple case: encountering CLASSNAME causes ATTRNAME to be set.
 238 #define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
 239   bool Pre(const parser::CLASSNAME &) { \
 240     attrs_->set(Attr::ATTRNAME); \
 241     return false; \
 242   }
 243   HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
 244   HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
 245   HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
 246   HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
 247   HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
 248   HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
 249   HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
 250   HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
 251   HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
 252   HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
 253   HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
 254   HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
 255   HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
 256   HANDLE_ATTR_CLASS(External, EXTERNAL)
 257   HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
 258   HANDLE_ATTR_CLASS(NoPass, NOPASS)
 259   HANDLE_ATTR_CLASS(Optional, OPTIONAL)
 260   HANDLE_ATTR_CLASS(Parameter, PARAMETER)
 261   HANDLE_ATTR_CLASS(Pointer, POINTER)
 262   HANDLE_ATTR_CLASS(Protected, PROTECTED)
 263   HANDLE_ATTR_CLASS(Save, SAVE)
 264   HANDLE_ATTR_CLASS(Target, TARGET)
 265   HANDLE_ATTR_CLASS(Value, VALUE)
 266   HANDLE_ATTR_CLASS(Volatile, VOLATILE)
 267 #undef HANDLE_ATTR_CLASS
 268
 269 protected:
 270   std::optional<Attrs> attrs_;
 271
 272   Attr AccessSpecToAttr(const parser::AccessSpec &x) {
 273     switch (x.v) {
 274     case parser::AccessSpec::Kind::Public: return Attr::PUBLIC;
 275     case parser::AccessSpec::Kind::Private: return Attr::PRIVATE;
 276     }
 277     common::die("unreachable");  // suppress g++ warning
 278   }
 279   Attr IntentSpecToAttr(const parser::IntentSpec &x) {
 280     switch (x.v) {
 281     case parser::IntentSpec::Intent::In: return Attr::INTENT_IN;
 282     case parser::IntentSpec::Intent::Out: return Attr::INTENT_OUT;
 283     case parser::IntentSpec::Intent::InOut: return Attr::INTENT_INOUT;
 284     }
 285     common::die("unreachable");  // suppress g++ warning
 286   }
 287
 288 private:
 289   MaybeExpr bindName_;  // from BIND(C, NAME="...")
 290   std::optional<SourceName> passName_;  // from PASS(...)
 291 };
 292
 293 // Find and create types from declaration-type-spec nodes.
 294 class DeclTypeSpecVisitor : public AttrsVisitor {
 295 public:
 296   using AttrsVisitor::Post;
 297   using AttrsVisitor::Pre;
 298   void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
 299   void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
 300   void Post(const parser::DeclarationTypeSpec::ClassStar &);
 301   void Post(const parser::DeclarationTypeSpec::TypeStar &);
 302   bool Pre(const parser::TypeGuardStmt &);
 303   void Post(const parser::TypeGuardStmt &);
 304   void Post(const parser::TypeSpec &);
 305
 306 protected:
 307   struct State {
 308     bool expectDeclTypeSpec{false};  // should see decl-type-spec only when true
 309     const DeclTypeSpec *declTypeSpec{nullptr};
 310     struct {
 311       DerivedTypeSpec *type{nullptr};
 312       DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
 313     } derived;
 314     bool allowForwardReferenceToDerivedType{false};
 315   };
 316
 317   bool allowForwardReferenceToDerivedType() const {
 318     return state_.allowForwardReferenceToDerivedType;
 319   }
 320   void set_allowForwardReferenceToDerivedType(bool yes) {
 321     state_.allowForwardReferenceToDerivedType = yes;
 322   }
 323
 324   // Walk the parse tree of a type spec and return the DeclTypeSpec for it.
 325   template<typename T>
 326   const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
 327     auto restorer{common::ScopedSet(state_, State{})};
 328     set_allowForwardReferenceToDerivedType(allowForward);
 329     BeginDeclTypeSpec();
 330     Walk(x);
 331     const auto *type{GetDeclTypeSpec()};
 332     EndDeclTypeSpec();
 333     return type;
 334   }
 335
 336   const DeclTypeSpec *GetDeclTypeSpec();
 337   void BeginDeclTypeSpec();
 338   void EndDeclTypeSpec();
 339   void SetDeclTypeSpec(const DeclTypeSpec &);
 340   void SetDeclTypeSpecCategory(DeclTypeSpec::Category);
 341   DeclTypeSpec::Category GetDeclTypeSpecCategory() const {
 342     return state_.derived.category;
 343   }
 344   KindExpr GetKindParamExpr(
 345       TypeCategory, const std::optional<parser::KindSelector> &);
 346
 347 private:
 348   State state_;
 349
 350   void MakeNumericType(TypeCategory, int kind);
 351 };
 352
 353 // Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
 354 class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
 355 public:
 356   using DeclTypeSpecVisitor::Post;
 357   using DeclTypeSpecVisitor::Pre;
 358   using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
 359
 360   void Post(const parser::ParameterStmt &);
 361   bool Pre(const parser::ImplicitStmt &);
 362   bool Pre(const parser::LetterSpec &);
 363   bool Pre(const parser::ImplicitSpec &);
 364   void Post(const parser::ImplicitSpec &);
 365
 366   ImplicitRules &implicitRules() { return *implicitRules_; }
 367   const ImplicitRules &implicitRules() const { return *implicitRules_; }
 368   bool isImplicitNoneType() const {
 369     return implicitRules().isImplicitNoneType();
 370   }
 371   bool isImplicitNoneExternal() const {
 372     return implicitRules().isImplicitNoneExternal();
 373   }
 374
 375 protected:
 376   void BeginScope(const Scope &);
 377   void SetScope(const Scope &);
 378
 379 private:
 380   // scope -> implicit rules for that scope
 381   std::map<const Scope *, ImplicitRules> implicitRulesMap_;
 382   // implicit rules in effect for current scope
 383   ImplicitRules *implicitRules_{nullptr};
 384   std::optional<SourceName> prevImplicit_;
 385   std::optional<SourceName> prevImplicitNone_;
 386   std::optional<SourceName> prevImplicitNoneType_;
 387   std::optional<SourceName> prevParameterStmt_;
 388
 389   bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
 390 };
 391
 392 // Track array specifications. They can occur in AttrSpec, EntityDecl,
 393 // ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt.
 394 // 1. INTEGER, DIMENSION(10) :: x
 395 // 2. INTEGER :: x(10)
 396 // 3. ALLOCATABLE :: x(:)
 397 // 4. DIMENSION :: x(10)
 398 // 5. COMMON x(10)
 399 // 6. BasedPointerStmt
 400 class ArraySpecVisitor : public virtual BaseVisitor {
 401 public:
 402   void Post(const parser::ArraySpec &);
 403   void Post(const parser::ComponentArraySpec &);
 404   void Post(const parser::CoarraySpec &);
 405   void Post(const parser::AttrSpec &) { PostAttrSpec(); }
 406   void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
 407
 408 protected:
 409   const ArraySpec &arraySpec();
 410   const ArraySpec &coarraySpec();
 411   void BeginArraySpec();
 412   void EndArraySpec();
 413   void ClearArraySpec() { arraySpec_.clear(); }
 414   void ClearCoarraySpec() { coarraySpec_.clear(); }
 415
 416 private:
 417   // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
 418   ArraySpec arraySpec_;
 419   ArraySpec coarraySpec_;
 420   // When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
 421   // into attrArraySpec_
 422   ArraySpec attrArraySpec_;
 423   ArraySpec attrCoarraySpec_;
 424
 425   void PostAttrSpec();
 426 };
 427
 428 // Manage a stack of Scopes
 429 class ScopeHandler : public ImplicitRulesVisitor {
 430 public:
 431   using ImplicitRulesVisitor::Post;
 432   using ImplicitRulesVisitor::Pre;
 433
 434   Scope &currScope() { return DEREF(currScope_); }
 435   // The enclosing scope, skipping blocks and derived types.
 436   Scope &InclusiveScope();
 437   // The global scope, containing program units.
 438   Scope &GlobalScope();
 439
 440   // Create a new scope and push it on the scope stack.
 441   void PushScope(Scope::Kind kind, Symbol *symbol);
 442   void PushScope(Scope &scope);
 443   void PopScope();
 444   void SetScope(Scope &);
 445
 446   template<typename T> bool Pre(const parser::Statement<T> &x) {
 447     messageHandler().set_currStmtSource(x.source);
 448     currScope_->AddSourceRange(x.source);
 449     return true;
 450   }
 451   template<typename T> void Post(const parser::Statement<T> &) {
 452     messageHandler().set_currStmtSource(std::nullopt);
 453   }
 454
 455   // Special messages: already declared; referencing symbol's declaration;
 456   // about a type; two names & locations
 457   void SayAlreadyDeclared(const parser::Name &, Symbol &);
 458   void SayAlreadyDeclared(const SourceName &, Symbol &);
 459   void SayAlreadyDeclared(const SourceName &, const SourceName &);
 460   void SayWithReason(
 461       const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&);
 462   void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
 463   void SayLocalMustBeVariable(const parser::Name &, Symbol &);
 464   void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
 465   void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
 466       MessageFixedText &&);
 467   void Say2(
 468       const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
 469   void Say2(
 470       const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
 471
 472   // Search for symbol by name in current, parent derived type, and
 473   // containing scopes
 474   Symbol *FindSymbol(const parser::Name &);
 475   Symbol *FindSymbol(const Scope &, const parser::Name &);
 476   // Search for name only in scope, not in enclosing scopes.
 477   Symbol *FindInScope(const Scope &, const parser::Name &);
 478   Symbol *FindInScope(const Scope &, const SourceName &);
 479   // Search for name in a derived type scope and its parents.
 480   Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
 481   Symbol *FindInTypeOrParents(const parser::Name &);
 482   void EraseSymbol(const parser::Name &);
 483   void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
 484   // Make a new symbol with the name and attrs of an existing one
 485   Symbol &CopySymbol(const SourceName &, const Symbol &);
 486
 487   // Make symbols in the current or named scope
 488   Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
 489   Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
 490   Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
 491
 492   template<typename D>
 493   common::IfNoLvalue<Symbol &, D> MakeSymbol(
 494       const parser::Name &name, D &&details) {
 495     return MakeSymbol(name, Attrs{}, std::move(details));
 496   }
 497
 498   template<typename D>
 499   common::IfNoLvalue<Symbol &, D> MakeSymbol(
 500       const parser::Name &name, const Attrs &attrs, D &&details) {
 501     return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
 502   }
 503
 504   template<typename D>
 505   common::IfNoLvalue<Symbol &, D> MakeSymbol(
 506       const SourceName &name, const Attrs &attrs, D &&details) {
 507     // Note: don't use FindSymbol here. If this is a derived type scope,
 508     // we want to detect whether the name is already declared as a component.
 509     auto *symbol{FindInScope(currScope(), name)};
 510     if (!symbol) {
 511       symbol = &MakeSymbol(name, attrs);
 512       symbol->set_details(std::move(details));
 513       return *symbol;
 514     }
 515     if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
 516       if (auto *d{symbol->detailsIf<GenericDetails>()}) {
 517         if (!d->specific()) {
 518           // derived type with same name as a generic
 519           auto *derivedType{d->derivedType()};
 520           if (!derivedType) {
 521             derivedType =
 522                 &currScope().MakeSymbol(name, attrs, std::move(details));
 523             d->set_derivedType(*derivedType);
 524           } else {
 525             SayAlreadyDeclared(name, *derivedType);
 526           }
 527           return *derivedType;
 528         }
 529       }
 530     }
 531     if (symbol->CanReplaceDetails(details)) {
 532       // update the existing symbol
 533       symbol->attrs() |= attrs;
 534       symbol->set_details(std::move(details));
 535       return *symbol;
 536     } else if constexpr (std::is_same_v<UnknownDetails, D>) {
 537       symbol->attrs() |= attrs;
 538       return *symbol;
 539     } else {
 540       SayAlreadyDeclared(name, *symbol);
 541       // replace the old symbol with a new one with correct details
 542       EraseSymbol(*symbol);
 543       auto &result{MakeSymbol(name, attrs, std::move(details))};
 544       context().SetError(result);
 545       return result;
 546     }
 547   }
 548
 549   void MakeExternal(Symbol &);
 550
 551 protected:
 552   // Apply the implicit type rules to this symbol.
 553   void ApplyImplicitRules(Symbol &);
 554   const DeclTypeSpec *GetImplicitType(Symbol &);
 555   bool ConvertToObjectEntity(Symbol &);
 556   bool ConvertToProcEntity(Symbol &);
 557
 558   const DeclTypeSpec &MakeNumericType(
 559       TypeCategory, const std::optional<parser::KindSelector> &);
 560   const DeclTypeSpec &MakeLogicalType(
 561       const std::optional<parser::KindSelector> &);
 562
 563 private:
 564   Scope *currScope_{nullptr};
 565 };
 566
 567 class ModuleVisitor : public virtual ScopeHandler {
 568 public:
 569   bool Pre(const parser::AccessStmt &);
 570   bool Pre(const parser::Only &);
 571   bool Pre(const parser::Rename::Names &);
 572   bool Pre(const parser::Rename::Operators &);
 573   bool Pre(const parser::UseStmt &);
 574   void Post(const parser::UseStmt &);
 575
 576   void BeginModule(const parser::Name &, bool isSubmodule);
 577   bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
 578   void ApplyDefaultAccess();
 579
 580 private:
 581   // The default access spec for this module.
 582   Attr defaultAccess_{Attr::PUBLIC};
 583   // The location of the last AccessStmt without access-ids, if any.
 584   std::optional<SourceName> prevAccessStmt_;
 585   // The scope of the module during a UseStmt
 586   const Scope *useModuleScope_{nullptr};
 587
 588   Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
 589   // A rename in a USE statement: local => use
 590   struct SymbolRename {
 591     Symbol *local{nullptr};
 592     Symbol *use{nullptr};
 593   };
 594   // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
 595   SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
 596   SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
 597   void AddUse(const SourceName &, Symbol &localSymbol, const Symbol &useSymbol);
 598   void AddUse(const GenericSpecInfo &);
 599   Scope *FindModule(const parser::Name &, Scope *ancestor = nullptr);
 600 };
 601
 602 class InterfaceVisitor : public virtual ScopeHandler {
 603 public:
 604   bool Pre(const parser::InterfaceStmt &);
 605   void Post(const parser::EndInterfaceStmt &);
 606   bool Pre(const parser::GenericSpec &);
 607   bool Pre(const parser::ProcedureStmt &);
 608   bool Pre(const parser::GenericStmt &);
 609   void Post(const parser::GenericStmt &);
 610
 611   bool inInterfaceBlock() const;
 612   bool isGeneric() const;
 613   bool isAbstract() const;
 614
 615 protected:
 616   GenericDetails &GetGenericDetails();
 617   // Add to generic the symbol for the subprogram with the same name
 618   void CheckGenericProcedures(Symbol &);
 619
 620 private:
 621   // A new GenericInfo is pushed for each interface block and generic stmt
 622   struct GenericInfo {
 623     GenericInfo(bool isInterface, bool isAbstract = false)
 624       : isInterface{isInterface}, isAbstract{isAbstract} {}
 625     bool isInterface;  // in interface block
 626     bool isAbstract;  // in abstract interface block
 627     Symbol *symbol{nullptr};  // the generic symbol being defined
 628   };
 629   std::stack<GenericInfo> genericInfo_;
 630   const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }
 631   void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }
 632
 633   using ProcedureKind = parser::ProcedureStmt::Kind;
 634   // mapping of generic to its specific proc names and kinds
 635   std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>
 636       specificProcs_;
 637
 638   void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
 639   void ResolveSpecificsInGeneric(Symbol &generic);
 640 };
 641
 642 class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
 643 public:
 644   bool HandleStmtFunction(const parser::StmtFunctionStmt &);
 645   bool Pre(const parser::SubroutineStmt &);
 646   void Post(const parser::SubroutineStmt &);
 647   bool Pre(const parser::FunctionStmt &);
 648   void Post(const parser::FunctionStmt &);
 649   bool Pre(const parser::InterfaceBody::Subroutine &);
 650   void Post(const parser::InterfaceBody::Subroutine &);
 651   bool Pre(const parser::InterfaceBody::Function &);
 652   void Post(const parser::InterfaceBody::Function &);
 653   bool Pre(const parser::Suffix &);
 654   bool Pre(const parser::PrefixSpec &);
 655   void Post(const parser::ImplicitPart &);
 656
 657   bool BeginSubprogram(
 658       const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
 659   bool BeginMpSubprogram(const parser::Name &);
 660   void PushBlockDataScope(const parser::Name &);
 661   void EndSubprogram();
 662
 663 protected:
 664   // Set when we see a stmt function that is really an array element assignment
 665   bool badStmtFuncFound_{false};
 666
 667 private:
 668   // Info about the current function: parse tree of the type in the PrefixSpec;
 669   // name and symbol of the function result from the Suffix; source location.
 670   struct {
 671     const parser::DeclarationTypeSpec *parsedType{nullptr};
 672     const parser::Name *resultName{nullptr};
 673     Symbol *resultSymbol{nullptr};
 674     std::optional<SourceName> source;
 675   } funcInfo_;
 676
 677   // Create a subprogram symbol in the current scope and push a new scope.
 678   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
 679   Symbol *GetSpecificFromGeneric(const parser::Name &);
 680   SubprogramDetails &PostSubprogramStmt(const parser::Name &);
 681 };
 682
 683 class DeclarationVisitor : public ArraySpecVisitor,
 684                            public virtual ScopeHandler {
 685 public:
 686   using ArraySpecVisitor::Post;
 687   using ScopeHandler::Post;
 688   using ScopeHandler::Pre;
 689
 690   bool Pre(const parser::Initialization &);
 691   void Post(const parser::EntityDecl &);
 692   void Post(const parser::ObjectDecl &);
 693   void Post(const parser::PointerDecl &);
 694   bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
 695   void Post(const parser::BindStmt &) { EndAttrs(); }
 696   bool Pre(const parser::BindEntity &);
 697   bool Pre(const parser::NamedConstantDef &);
 698   bool Pre(const parser::NamedConstant &);
 699   void Post(const parser::EnumDef &);
 700   bool Pre(const parser::Enumerator &);
 701   bool Pre(const parser::AsynchronousStmt &);
 702   bool Pre(const parser::ContiguousStmt &);
 703   bool Pre(const parser::ExternalStmt &);
 704   bool Pre(const parser::IntentStmt &);
 705   bool Pre(const parser::IntrinsicStmt &);
 706   bool Pre(const parser::OptionalStmt &);
 707   bool Pre(const parser::ProtectedStmt &);
 708   bool Pre(const parser::ValueStmt &);
 709   bool Pre(const parser::VolatileStmt &);
 710   bool Pre(const parser::AllocatableStmt &) {
 711     objectDeclAttr_ = Attr::ALLOCATABLE;
 712     return true;
 713   }
 714   void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
 715   bool Pre(const parser::TargetStmt &) {
 716     objectDeclAttr_ = Attr::TARGET;
 717     return true;
 718   }
 719   void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
 720   void Post(const parser::DimensionStmt::Declaration &);
 721   void Post(const parser::CodimensionDecl &);
 722   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
 723   void Post(const parser::TypeDeclarationStmt &) { EndDecl(); }
 724   void Post(const parser::IntegerTypeSpec &);
 725   void Post(const parser::IntrinsicTypeSpec::Real &);
 726   void Post(const parser::IntrinsicTypeSpec::Complex &);
 727   void Post(const parser::IntrinsicTypeSpec::Logical &);
 728   void Post(const parser::IntrinsicTypeSpec::Character &);
 729   void Post(const parser::CharSelector::LengthAndKind &);
 730   void Post(const parser::CharLength &);
 731   void Post(const parser::LengthSelector &);
 732   bool Pre(const parser::KindParam &);
 733   bool Pre(const parser::DeclarationTypeSpec::Type &);
 734   bool Pre(const parser::DeclarationTypeSpec::Class &);
 735   bool Pre(const parser::DeclarationTypeSpec::Record &);
 736   void Post(const parser::DerivedTypeSpec &);
 737   bool Pre(const parser::DerivedTypeDef &);
 738   bool Pre(const parser::DerivedTypeStmt &);
 739   void Post(const parser::DerivedTypeStmt &);
 740   bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
 741   void Post(const parser::TypeParamDefStmt &);
 742   bool Pre(const parser::TypeAttrSpec::Extends &);
 743   bool Pre(const parser::PrivateStmt &);
 744   bool Pre(const parser::SequenceStmt &);
 745   bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
 746   void Post(const parser::ComponentDefStmt &) { EndDecl(); }
 747   void Post(const parser::ComponentDecl &);
 748   bool Pre(const parser::ProcedureDeclarationStmt &);
 749   void Post(const parser::ProcedureDeclarationStmt &);
 750   bool Pre(const parser::DataComponentDefStmt &);  // returns false
 751   bool Pre(const parser::ProcComponentDefStmt &);
 752   void Post(const parser::ProcComponentDefStmt &);
 753   bool Pre(const parser::ProcPointerInit &);
 754   void Post(const parser::ProcInterface &);
 755   void Post(const parser::ProcDecl &);
 756   bool Pre(const parser::TypeBoundProcedurePart &);
 757   void Post(const parser::TypeBoundProcedurePart &);
 758   void Post(const parser::ContainsStmt &);
 759   bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
 760   void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
 761   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 762   void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
 763   void Post(const parser::FinalProcedureStmt &);
 764   bool Pre(const parser::TypeBoundGenericStmt &);
 765   bool Pre(const parser::AllocateStmt &);
 766   void Post(const parser::AllocateStmt &);
 767   bool Pre(const parser::StructureConstructor &);
 768   bool Pre(const parser::NamelistStmt::Group &);
 769   bool Pre(const parser::IoControlSpec &);
 770   bool Pre(const parser::CommonStmt::Block &);
 771   void Post(const parser::CommonStmt::Block &);
 772   bool Pre(const parser::CommonBlockObject &);
 773   void Post(const parser::CommonBlockObject &);
 774   bool Pre(const parser::EquivalenceStmt &);
 775   bool Pre(const parser::SaveStmt &);
 776   bool Pre(const parser::BasedPointerStmt &);
 777
 778   void PointerInitialization(
 779       const parser::Name &, const parser::InitialDataTarget &);
 780   void PointerInitialization(
 781       const parser::Name &, const parser::ProcPointerInit &);
 782   void CheckExplicitInterface(const parser::Name &);
 783   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 784
 785   const parser::Name *ResolveDesignator(const parser::Designator &);
 786
 787 protected:
 788   bool BeginDecl();
 789   void EndDecl();
 790   Symbol &DeclareObjectEntity(const parser::Name &, Attrs);
 791   // Make sure that there's an entity in an enclosing scope called Name
 792   Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
 793   // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
 794   // it comes from the entity in the containing scope, or implicit rules.
 795   // Return pointer to the new symbol, or nullptr on error.
 796   Symbol *DeclareLocalEntity(const parser::Name &);
 797   // Declare a statement entity (e.g., an implied DO loop index).
 798   // If there isn't a type specified, implicit rules apply.
 799   // Return pointer to the new symbol, or nullptr on error.
 800   Symbol *DeclareStatementEntity(
 801       const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
 802   bool CheckUseError(const parser::Name &);
 803   void CheckAccessibility(const SourceName &, bool, Symbol &);
 804   bool CheckAccessibleComponent(const SourceName &, const Symbol &);
 805   void CheckCommonBlocks();
 806   void CheckSaveStmts();
 807   void CheckEquivalenceSets();
 808   bool CheckNotInBlock(const char *);
 809   bool NameIsKnownOrIntrinsic(const parser::Name &);
 810
 811   // Each of these returns a pointer to a resolved Name (i.e. with symbol)
 812   // or nullptr in case of error.
 813   const parser::Name *ResolveStructureComponent(
 814       const parser::StructureComponent &);
 815   const parser::Name *ResolveDataRef(const parser::DataRef &);
 816   const parser::Name *ResolveVariable(const parser::Variable &);
 817   const parser::Name *ResolveName(const parser::Name &);
 818   bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
 819   Symbol *NoteInterfaceName(const parser::Name &);
 820
 821 private:
 822   // The attribute corresponding to the statement containing an ObjectDecl
 823   std::optional<Attr> objectDeclAttr_;
 824   // Info about current character type while walking DeclTypeSpec.
 825   // Also captures any "*length" specifier on an individual declaration.
 826   struct {
 827     std::optional<ParamValue> length;
 828     std::optional<KindExpr> kind;
 829   } charInfo_;
 830   // Info about current derived type while walking DerivedTypeDef
 831   struct {
 832     const parser::Name *extends{nullptr};  // EXTENDS(name)
 833     bool privateComps{false};  // components are private by default
 834     bool privateBindings{false};  // bindings are private by default
 835     bool sawContains{false};  // currently processing bindings
 836     bool sequence{false};  // is a sequence type
 837     const Symbol *type{nullptr};  // derived type being defined
 838   } derivedTypeInfo_;
 839   // Collect equivalence sets and process at end of specification part
 840   std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets_;
 841   // Info about common blocks in the current scope
 842   struct {
 843     Symbol *curr{nullptr};  // common block currently being processed
 844     std::set<SourceName> names;  // names in any common block of scope
 845   } commonBlockInfo_;
 846   // Info about about SAVE statements and attributes in current scope
 847   struct {
 848     std::optional<SourceName> saveAll;  // "SAVE" without entity list
 849     std::set<SourceName> entities;  // names of entities with save attr
 850     std::set<SourceName> commons;  // names of common blocks with save attr
 851   } saveInfo_;
 852   // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
 853   // the interface name, if any.
 854   const parser::Name *interfaceName_{nullptr};
 855   // Map type-bound generic to binding names of its specific bindings
 856   std::multimap<Symbol *, const parser::Name *> genericBindings_;
 857   // Info about current ENUM
 858   struct EnumeratorState {
 859     // Enum value must hold inside a C_INT (7.6.2).
 860     std::optional<int> value{0};
 861   } enumerationState_;
 862
 863   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
 864   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
 865   Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
 866   Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &);
 867   void SetType(const parser::Name &, const DeclTypeSpec &);
 868   std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
 869   std::optional<DerivedTypeSpec> ResolveExtendsType(
 870       const parser::Name &, const parser::Name *);
 871   Symbol *MakeTypeSymbol(const SourceName &, Details &&);
 872   Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
 873   bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
 874   ParamValue GetParamValue(
 875       const parser::TypeParamValue &, common::TypeParamAttr attr);
 876   Symbol &MakeCommonBlockSymbol(const parser::Name &);
 877   void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
 878   std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
 879   Attrs HandleSaveName(const SourceName &, Attrs);
 880   void AddSaveName(std::set<SourceName> &, const SourceName &);
 881   void SetSaveAttr(Symbol &);
 882   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
 883   const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
 884   void CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName);
 885   void CheckInitialProcTarget(const Symbol &, const parser::Name &, SourceName);
 886   void Initialization(const parser::Name &, const parser::Initialization &,
 887       bool inComponentDecl);
 888   bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
 889
 890   // Declare an object or procedure entity.
 891   // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
 892   template<typename T>
 893   Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
 894     Symbol &symbol{MakeSymbol(name, attrs)};
 895     if (symbol.has<T>()) {
 896       // OK
 897     } else if (symbol.has<UnknownDetails>()) {
 898       symbol.set_details(T{});
 899     } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
 900       symbol.set_details(T{std::move(*details)});
 901     } else if (std::is_same_v<EntityDetails, T> &&
 902         (symbol.has<ObjectEntityDetails>() ||
 903             symbol.has<ProcEntityDetails>())) {
 904       // OK
 905     } else if (auto *details{symbol.detailsIf<UseDetails>()}) {
 906       Say(name.source,
 907           "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
 908           name.source, details->module().name());
 909     } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
 910       if (details->kind() == SubprogramKind::Module) {
 911         Say2(name,
 912             "Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
 913             symbol, "Module procedure definition"_en_US);
 914       } else if (details->kind() == SubprogramKind::Internal) {
 915         Say2(name,
 916             "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
 917             symbol, "Internal procedure definition"_en_US);
 918       } else {
 919         DIE("unexpected kind");
 920       }
 921     } else if (std::is_same_v<ObjectEntityDetails, T> &&
 922         symbol.has<ProcEntityDetails>()) {
 923       SayWithDecl(
 924           name, symbol, "'%s' is already declared as a procedure"_err_en_US);
 925     } else if (std::is_same_v<ProcEntityDetails, T> &&
 926         symbol.has<ObjectEntityDetails>()) {
 927       SayWithDecl(
 928           name, symbol, "'%s' is already declared as an object"_err_en_US);
 929     } else {
 930       SayAlreadyDeclared(name, symbol);
 931     }
 932     return symbol;
 933   }
 934 };
 935
 936 // Resolve construct entities and statement entities.
 937 // Check that construct names don't conflict with other names.
 938 class ConstructVisitor : public virtual DeclarationVisitor {
 939 public:
 940   bool Pre(const parser::ConcurrentHeader &);
 941   bool Pre(const parser::LocalitySpec::Local &);
 942   bool Pre(const parser::LocalitySpec::LocalInit &);
 943   bool Pre(const parser::LocalitySpec::Shared &);
 944   bool Pre(const parser::AcSpec &);
 945   bool Pre(const parser::AcImpliedDo &);
 946   bool Pre(const parser::DataImpliedDo &);
 947   bool Pre(const parser::DataStmtObject &);
 948   bool Pre(const parser::DoConstruct &);
 949   void Post(const parser::DoConstruct &);
 950   bool Pre(const parser::ForallConstruct &);
 951   void Post(const parser::ForallConstruct &);
 952   bool Pre(const parser::ForallStmt &);
 953   void Post(const parser::ForallStmt &);
 954   bool Pre(const parser::BlockStmt &);
 955   bool Pre(const parser::EndBlockStmt &);
 956   void Post(const parser::Selector &);
 957   bool Pre(const parser::AssociateStmt &);
 958   void Post(const parser::EndAssociateStmt &);
 959   void Post(const parser::Association &);
 960   void Post(const parser::SelectTypeStmt &);
 961   bool Pre(const parser::SelectTypeConstruct &);
 962   void Post(const parser::SelectTypeConstruct &);
 963   bool Pre(const parser::SelectTypeConstruct::TypeCase &);
 964   void Post(const parser::SelectTypeConstruct::TypeCase &);
 965   void Post(const parser::TypeGuardStmt::Guard &);
 966   bool Pre(const parser::ChangeTeamStmt &);
 967   void Post(const parser::EndChangeTeamStmt &);
 968   void Post(const parser::CoarrayAssociation &);
 969
 970   // Definitions of construct names
 971   bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
 972   bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
 973   bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
 974   bool Pre(const parser::LabelDoStmt &) {
 975     return false;  // error recovery
 976   }
 977   bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
 978   bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
 979   bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
 980   bool Pre(const parser::SelectRankConstruct &);
 981   void Post(const parser::SelectRankConstruct &);
 982   bool Pre(const parser::SelectRankStmt &x) {
 983     return CheckDef(std::get<0>(x.t));
 984   }
 985   bool Pre(const parser::SelectTypeStmt &x) {
 986     return CheckDef(std::get<0>(x.t));
 987   }
 988
 989   // References to construct names
 990   void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }
 991   void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }
 992   void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
 993   void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
 994   void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
 995   void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
 996   void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }
 997   void Post(const parser::ElseStmt &x) { CheckRef(x.v); }
 998   void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }
 999   void Post(const parser::CaseStmt &x) { CheckRef(x.t); }
1000   void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }
1001   void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }
1002   void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }
1003   void Post(const parser::CycleStmt &x) { CheckRef(x.v); }
1004   void Post(const parser::ExitStmt &x) { CheckRef(x.v); }
1005
1006 private:
1007   // R1105 selector -> expr | variable
1008   // expr is set in either case unless there were errors
1009   struct Selector {
1010     Selector() {}
1011     Selector(const SourceName &source, MaybeExpr &&expr)
1012       : source{source}, expr{std::move(expr)} {}
1013     operator bool() const { return expr.has_value(); }
1014     parser::CharBlock source;
1015     MaybeExpr expr;
1016   };
1017   // association -> [associate-name =>] selector
1018   struct Association {
1019     const parser::Name *name{nullptr};
1020     Selector selector;
1021   };
1022   std::vector<Association> associationStack_;
1023
1024   template<typename T> bool CheckDef(const T &t) {
1025     return CheckDef(std::get<std::optional<parser::Name>>(t));
1026   }
1027   template<typename T> void CheckRef(const T &t) {
1028     CheckRef(std::get<std::optional<parser::Name>>(t));
1029   }
1030   bool CheckDef(const std::optional<parser::Name> &);
1031   void CheckRef(const std::optional<parser::Name> &);
1032   const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
1033   const DeclTypeSpec &ToDeclTypeSpec(
1034       evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
1035   Symbol *MakeAssocEntity();
1036   void SetTypeFromAssociation(Symbol &);
1037   void SetAttrsFromAssociation(Symbol &);
1038   Selector ResolveSelector(const parser::Selector &);
1039   void ResolveIndexName(const parser::ConcurrentControl &control);
1040   Association &GetCurrentAssociation();
1041   void PushAssociation();
1042   void PopAssociation();
1043 };
1044
1045 // Create scopes for OpenMP constructs
1046 class OmpVisitor : public virtual DeclarationVisitor {
1047 public:
1048   void AddOmpSourceRange(const parser::CharBlock &);
1049
1050   static bool NeedsScope(const parser::OpenMPBlockConstruct &);
1051
1052   bool Pre(const parser::OpenMPBlockConstruct &);
1053   void Post(const parser::OpenMPBlockConstruct &);
1054   bool Pre(const parser::OmpBeginBlockDirective &x) {
1055     AddOmpSourceRange(x.source);
1056     return true;
1057   }
1058   void Post(const parser::OmpBeginBlockDirective &) {
1059     messageHandler().set_currStmtSource(std::nullopt);
1060   }
1061   bool Pre(const parser::OmpEndBlockDirective &x) {
1062     AddOmpSourceRange(x.source);
1063     return true;
1064   }
1065   void Post(const parser::OmpEndBlockDirective &) {
1066     messageHandler().set_currStmtSource(std::nullopt);
1067   }
1068
1069   bool Pre(const parser::OpenMPLoopConstruct &) {
1070     PushScope(Scope::Kind::Block, nullptr);
1071     return true;
1072   }
1073   void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
1074   bool Pre(const parser::OmpBeginLoopDirective &x) {
1075     AddOmpSourceRange(x.source);
1076     return true;
1077   }
1078   void Post(const parser::OmpBeginLoopDirective &) {
1079     messageHandler().set_currStmtSource(std::nullopt);
1080   }
1081   bool Pre(const parser::OmpEndLoopDirective &x) {
1082     AddOmpSourceRange(x.source);
1083     return true;
1084   }
1085   void Post(const parser::OmpEndLoopDirective &) {
1086     messageHandler().set_currStmtSource(std::nullopt);
1087   }
1088
1089   bool Pre(const parser::OpenMPSectionsConstruct &) {
1090     PushScope(Scope::Kind::Block, nullptr);
1091     return true;
1092   }
1093   void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
1094   bool Pre(const parser::OmpBeginSectionsDirective &x) {
1095     AddOmpSourceRange(x.source);
1096     return true;
1097   }
1098   void Post(const parser::OmpBeginSectionsDirective &) {
1099     messageHandler().set_currStmtSource(std::nullopt);
1100   }
1101   bool Pre(const parser::OmpEndSectionsDirective &x) {
1102     AddOmpSourceRange(x.source);
1103     return true;
1104   }
1105   void Post(const parser::OmpEndSectionsDirective &) {
1106     messageHandler().set_currStmtSource(std::nullopt);
1107   }
1108 };
1109
1110 bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
1111   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1112   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1113   switch (beginDir.v) {
1114   case parser::OmpBlockDirective::Directive::TargetData:
1115   case parser::OmpBlockDirective::Directive::Master:
1116   case parser::OmpBlockDirective::Directive::Ordered: return false;
1117   default: return true;
1118   }
1119 }
1120
1121 void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
1122   messageHandler().set_currStmtSource(source);
1123   currScope().AddSourceRange(source);
1124 }
1125
1126 bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1127   if (NeedsScope(x)) {
1128     PushScope(Scope::Kind::Block, nullptr);
1129   }
1130   return true;
1131 }
1132
1133 void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1134   if (NeedsScope(x)) {
1135     PopScope();
1136   }
1137 }
1138
1139 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
1140 class OmpAttributeVisitor {
1141 public:
1142   explicit OmpAttributeVisitor(
1143       SemanticsContext &context, ResolveNamesVisitor &resolver)
1144     : context_{context}, resolver_{resolver} {}
1145
1146   template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
1147
1148   template<typename A> bool Pre(const A &) { return true; }
1149   template<typename A> void Post(const A &) {}
1150
1151   bool Pre(const parser::OpenMPBlockConstruct &);
1152   void Post(const parser::OpenMPBlockConstruct &) { PopContext(); }
1153   void Post(const parser::OmpBeginBlockDirective &) {
1154     GetContext().withinConstruct = true;
1155   }
1156
1157   bool Pre(const parser::OpenMPLoopConstruct &);
1158   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
1159   void Post(const parser::OmpBeginLoopDirective &) {
1160     GetContext().withinConstruct = true;
1161   }
1162
1163   bool Pre(const parser::OpenMPSectionsConstruct &);
1164   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
1165
1166   bool Pre(const parser::OpenMPThreadprivate &);
1167   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
1168
1169   // 2.15.3 Data-Sharing Attribute Clauses
1170   void Post(const parser::OmpDefaultClause &);
1171   bool Pre(const parser::OmpClause::Shared &x) {
1172     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
1173     return false;
1174   }
1175   bool Pre(const parser::OmpClause::Private &x) {
1176     ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
1177     return false;
1178   }
1179   bool Pre(const parser::OmpClause::Firstprivate &x) {
1180     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
1181     return false;
1182   }
1183   bool Pre(const parser::OmpClause::Lastprivate &x) {
1184     ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
1185     return false;
1186   }
1187
1188   void Post(const parser::Name &);
1189
1190 private:
1191   struct OmpContext {
1192     OmpContext(const parser::CharBlock &source, OmpDirective d, Scope &s)
1193       : directiveSource{source}, directive{d}, scope{s} {}
1194     parser::CharBlock directiveSource;
1195     OmpDirective directive;
1196     Scope &scope;
1197     // TODO: default DSA is implicitly determined in different ways
1198     Symbol::Flag defaultDSA{Symbol::Flag::OmpShared};
1199     // variables on Data-sharing attribute clauses
1200     std::map<const Symbol *, Symbol::Flag> objectWithDSA;
1201     bool withinConstruct{false};
1202   };
1203   // back() is the top of the stack
1204   OmpContext &GetContext() {
1205     CHECK(!ompContext_.empty());
1206     return ompContext_.back();
1207   }
1208   void PushContext(const parser::CharBlock &source, OmpDirective dir) {
1209     ompContext_.emplace_back(source, dir, context_.FindScope(source));
1210   }
1211   void PopContext() { ompContext_.pop_back(); }
1212   void SetContextDirectiveSource(parser::CharBlock &dir) {
1213     GetContext().directiveSource = dir;
1214   }
1215   void SetContextDirectiveEnum(OmpDirective dir) {
1216     GetContext().directive = dir;
1217   }
1218   const Scope &currScope() { return GetContext().scope; }
1219   void SetContextDefaultDSA(Symbol::Flag flag) {
1220     GetContext().defaultDSA = flag;
1221   }
1222   void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
1223     GetContext().objectWithDSA.emplace(&symbol, flag);
1224   }
1225   bool IsObjectWithDSA(const Symbol &symbol) {
1226     auto it{GetContext().objectWithDSA.find(&symbol)};
1227     return it != GetContext().objectWithDSA.end();
1228   }
1229
1230   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
1231     const auto pair{
1232         GetContext().scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
1233     return *pair.first->second;
1234   }
1235
1236   static const parser::Name *GetDesignatorNameIfDataRef(
1237       const parser::Designator &designator) {
1238     const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
1239     return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
1240   }
1241
1242   static constexpr Symbol::Flags dataSharingAttributeFlags{
1243       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
1244       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
1245       Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
1246
1247   static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
1248       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
1249       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
1250       Symbol::Flag::OmpReduction};
1251
1252   static constexpr Symbol::Flags ompFlagsRequireMark{
1253       Symbol::Flag::OmpThreadprivate};
1254
1255   void AddDataSharingAttributeObject(SymbolRef object) {
1256     dataSharingAttributeObjects_.insert(object);
1257   }
1258   void ClearDataSharingAttributeObjects() {
1259     dataSharingAttributeObjects_.clear();
1260   }
1261   bool HasDataSharingAttributeObject(const Symbol &);
1262
1263   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
1264   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
1265   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag);
1266   Symbol *ResolveOmp(Symbol &, Symbol::Flag);
1267   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
1268   Symbol *DeclarePrivateAccessEntity(const parser::Name &, Symbol::Flag);
1269   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
1270   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
1271   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
1272   void CheckMultipleAppearances(
1273       const parser::Name &, const Symbol &, Symbol::Flag);
1274   SymbolSet dataSharingAttributeObjects_;  // on one directive
1275
1276   SemanticsContext &context_;
1277   ResolveNamesVisitor &resolver_;
1278   std::vector<OmpContext> ompContext_;  // used as a stack
1279 };
1280
1281 // Walk the parse tree and resolve names to symbols.
1282 class ResolveNamesVisitor : public virtual ScopeHandler,
1283                             public ModuleVisitor,
1284                             public SubprogramVisitor,
1285                             public ConstructVisitor,
1286                             public OmpVisitor {
1287 public:
1288   using ArraySpecVisitor::Post;
1289   using ConstructVisitor::Post;
1290   using ConstructVisitor::Pre;
1291   using DeclarationVisitor::Post;
1292   using DeclarationVisitor::Pre;
1293   using ImplicitRulesVisitor::Post;
1294   using ImplicitRulesVisitor::Pre;
1295   using InterfaceVisitor::Post;
1296   using InterfaceVisitor::Pre;
1297   using ModuleVisitor::Post;
1298   using ModuleVisitor::Pre;
1299   using OmpVisitor::Post;
1300   using OmpVisitor::Pre;
1301   using ScopeHandler::Post;
1302   using ScopeHandler::Pre;
1303   using SubprogramVisitor::Post;
1304   using SubprogramVisitor::Pre;
1305
1306   ResolveNamesVisitor(SemanticsContext &context) : BaseVisitor{context, *this} {
1307     PushScope(context.globalScope());
1308   }
1309
1310   // Default action for a parse tree node is to visit children.
1311   template<typename T> bool Pre(const T &) { return true; }
1312   template<typename T> void Post(const T &) {}
1313
1314   bool Pre(const parser::SpecificationPart &);
1315   void Post(const parser::Program &);
1316   bool Pre(const parser::ImplicitStmt &);
1317   void Post(const parser::PointerObject &);
1318   void Post(const parser::AllocateObject &);
1319   bool Pre(const parser::PointerAssignmentStmt &);
1320   void Post(const parser::Designator &);
1321   template<typename A, typename B>
1322   void Post(const parser::LoopBounds<A, B> &x) {
1323     ResolveName(*parser::Unwrap<parser::Name>(x.name));
1324   }
1325   void Post(const parser::ProcComponentRef &);
1326   bool Pre(const parser::ActualArg &);
1327   bool Pre(const parser::FunctionReference &);
1328   bool Pre(const parser::CallStmt &);
1329   bool Pre(const parser::ImportStmt &);
1330   void Post(const parser::TypeGuardStmt &);
1331   bool Pre(const parser::StmtFunctionStmt &);
1332   bool Pre(const parser::DefinedOpName &);
1333   bool Pre(const parser::ProgramUnit &);
1334
1335   // These nodes should never be reached: they are handled in ProgramUnit
1336   bool Pre(const parser::MainProgram &) { DIE("unreachable"); }
1337   bool Pre(const parser::FunctionSubprogram &) { DIE("unreachable"); }
1338   bool Pre(const parser::SubroutineSubprogram &) { DIE("unreachable"); }
1339   bool Pre(const parser::SeparateModuleSubprogram &) { DIE("unreachable"); }
1340   bool Pre(const parser::Module &) { DIE("unreachable"); }
1341   bool Pre(const parser::Submodule &) { DIE("unreachable"); }
1342   bool Pre(const parser::BlockData &) { DIE("unreachable"); }
1343
1344   void NoteExecutablePartCall(Symbol::Flag, const parser::Call &);
1345
1346 private:
1347   // Kind of procedure we are expecting to see in a ProcedureDesignator
1348   std::optional<Symbol::Flag> expectedProcFlag_;
1349   std::optional<SourceName> prevImportStmt_;
1350
1351   void PreSpecificationConstruct(const parser::SpecificationConstruct &);
1352   void CreateGeneric(const parser::GenericSpec &);
1353   void FinishSpecificationPart();
1354   void CheckImports();
1355   void CheckImport(const SourceName &, const SourceName &);
1356   void HandleCall(Symbol::Flag, const parser::Call &);
1357   void HandleProcedureName(Symbol::Flag, const parser::Name &);
1358   bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
1359   void ResolveSpecificationParts(ProgramTree &);
1360   void AddSubpNames(const ProgramTree &);
1361   bool BeginScope(const ProgramTree &);
1362   void FinishSpecificationParts(const ProgramTree &);
1363   void FinishDerivedTypeInstantiation(Scope &);
1364   void ResolveExecutionParts(const ProgramTree &);
1365 };
1366
1367 // ImplicitRules implementation
1368
1369 bool ImplicitRules::isImplicitNoneType() const {
1370   if (isImplicitNoneType_) {
1371     return true;
1372   } else if (map_.empty() && inheritFromParent_) {
1373     return parent_->isImplicitNoneType();
1374   } else {
1375     return false;  // default if not specified
1376   }
1377 }
1378
1379 bool ImplicitRules::isImplicitNoneExternal() const {
1380   if (isImplicitNoneExternal_) {
1381     return true;
1382   } else if (inheritFromParent_) {
1383     return parent_->isImplicitNoneExternal();
1384   } else {
1385     return false;  // default if not specified
1386   }
1387 }
1388
1389 const DeclTypeSpec *ImplicitRules::GetType(char ch) const {
1390   if (isImplicitNoneType_) {
1391     return nullptr;
1392   } else if (auto it{map_.find(ch)}; it != map_.end()) {
1393     return &*it->second;
1394   } else if (inheritFromParent_) {
1395     return parent_->GetType(ch);
1396   } else if (ch >= 'i' && ch <= 'n') {
1397     return &context_.MakeNumericType(TypeCategory::Integer);
1398   } else if (ch >= 'a' && ch <= 'z') {
1399     return &context_.MakeNumericType(TypeCategory::Real);
1400   } else {
1401     return nullptr;
1402   }
1403 }
1404
1405 void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
1406     parser::Location fromLetter, parser::Location toLetter) {
1407   for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
1408     auto res{map_.emplace(ch, type)};
1409     if (!res.second) {
1410       context_.Say(parser::CharBlock{fromLetter},
1411           "More than one implicit type specified for '%c'"_err_en_US, ch);
1412     }
1413     if (ch == *toLetter) {
1414       break;
1415     }
1416   }
1417 }
1418
1419 // Return the next char after ch in a way that works for ASCII or EBCDIC.
1420 // Return '\0' for the char after 'z'.
1421 char ImplicitRules::Incr(char ch) {
1422   switch (ch) {
1423   case 'i': return 'j';
1424   case 'r': return 's';
1425   case 'z': return '\0';
1426   default: return ch + 1;
1427   }
1428 }
1429
1430 std::ostream &operator<<(std::ostream &o, const ImplicitRules &implicitRules) {
1431   o << "ImplicitRules:\n";
1432   for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
1433     ShowImplicitRule(o, implicitRules, ch);
1434   }
1435   ShowImplicitRule(o, implicitRules, '_');
1436   ShowImplicitRule(o, implicitRules, '$');
1437   ShowImplicitRule(o, implicitRules, '@');
1438   return o;
1439 }
1440 void ShowImplicitRule(
1441     std::ostream &o, const ImplicitRules &implicitRules, char ch) {
1442   auto it{implicitRules.map_.find(ch)};
1443   if (it != implicitRules.map_.end()) {
1444     o << "  " << ch << ": " << *it->second << '\n';
1445   }
1446 }
1447
1448 template<typename T> void BaseVisitor::Walk(const T &x) {
1449   parser::Walk(x, *this_);
1450 }
1451
1452 void BaseVisitor::MakePlaceholder(
1453     const parser::Name &name, MiscDetails::Kind kind) {
1454   if (!name.symbol) {
1455     name.symbol = &context_->globalScope().MakeSymbol(
1456         name.source, Attrs{}, MiscDetails{kind});
1457   }
1458 }
1459
1460 // AttrsVisitor implementation
1461
1462 bool AttrsVisitor::BeginAttrs() {
1463   CHECK(!attrs_);
1464   attrs_ = std::make_optional<Attrs>();
1465   return true;
1466 }
1467 Attrs AttrsVisitor::GetAttrs() {
1468   CHECK(attrs_);
1469   return *attrs_;
1470 }
1471 Attrs AttrsVisitor::EndAttrs() {
1472   Attrs result{GetAttrs()};
1473   attrs_.reset();
1474   passName_ = std::nullopt;
1475   bindName_.reset();
1476   return result;
1477 }
1478
1479 bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
1480   if (!passName_) {
1481     return false;
1482   }
1483   std::visit(
1484       common::visitors{
1485           [&](ProcEntityDetails &x) { x.set_passName(*passName_); },
1486           [&](ProcBindingDetails &x) { x.set_passName(*passName_); },
1487           [](auto &) { common::die("unexpected pass name"); },
1488       },
1489       symbol.details());
1490   return true;
1491 }
1492
1493 bool AttrsVisitor::SetBindNameOn(Symbol &symbol) {
1494   if (!bindName_) {
1495     return false;
1496   }
1497   std::visit(
1498       common::visitors{
1499           [&](EntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1500           [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1501           [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1502           [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); },
1503           [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); },
1504           [](auto &) { common::die("unexpected bind name"); },
1505       },
1506       symbol.details());
1507   return true;
1508 }
1509
1510 void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
1511   CHECK(attrs_);
1512   attrs_->set(Attr::BIND_C);
1513   if (x.v) {
1514     bindName_ = EvaluateExpr(*x.v);
1515   }
1516 }
1517 bool AttrsVisitor::Pre(const parser::AccessSpec &x) {
1518   attrs_->set(AccessSpecToAttr(x));
1519   return false;
1520 }
1521 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
1522   CHECK(attrs_);
1523   attrs_->set(IntentSpecToAttr(x));
1524   return false;
1525 }
1526 bool AttrsVisitor::Pre(const parser::Pass &x) {
1527   if (x.v) {
1528     passName_ = x.v->source;
1529     MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
1530   } else {
1531     attrs_->set(Attr::PASS);
1532   }
1533   return false;
1534 }
1535
1536 // DeclTypeSpecVisitor implementation
1537
1538 const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
1539   return state_.declTypeSpec;
1540 }
1541
1542 void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
1543   CHECK(!state_.expectDeclTypeSpec);
1544   CHECK(!state_.declTypeSpec);
1545   state_.expectDeclTypeSpec = true;
1546 }
1547 void DeclTypeSpecVisitor::EndDeclTypeSpec() {
1548   CHECK(state_.expectDeclTypeSpec);
1549   state_ = {};
1550 }
1551
1552 void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
1553     DeclTypeSpec::Category category) {
1554   CHECK(state_.expectDeclTypeSpec);
1555   state_.derived.category = category;
1556 }
1557
1558 bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
1559   BeginDeclTypeSpec();
1560   return true;
1561 }
1562 void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
1563   EndDeclTypeSpec();
1564 }
1565
1566 void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
1567   // Record the resolved DeclTypeSpec in the parse tree for use by
1568   // expression semantics if the DeclTypeSpec is a valid TypeSpec.
1569   // The grammar ensures that it's an intrinsic or derived type spec,
1570   // not TYPE(*) or CLASS(*) or CLASS(T).
1571   if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
1572     switch (spec->category()) {
1573     case DeclTypeSpec::Numeric:
1574     case DeclTypeSpec::Logical:
1575     case DeclTypeSpec::Character: typeSpec.declTypeSpec = spec; break;
1576     case DeclTypeSpec::TypeDerived:
1577       if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
1578         if (derived->typeSymbol().attrs().test(Attr::ABSTRACT)) {
1579           Say("ABSTRACT derived type may not be used here"_err_en_US);
1580         }
1581         typeSpec.declTypeSpec = spec;
1582       }
1583       break;
1584     default: CRASH_NO_CASE;
1585     }
1586   }
1587 }
1588
1589 void DeclTypeSpecVisitor::Post(
1590     const parser::IntrinsicTypeSpec::DoublePrecision &) {
1591   MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
1592 }
1593 void DeclTypeSpecVisitor::Post(
1594     const parser::IntrinsicTypeSpec::DoubleComplex &) {
1595   MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
1596 }
1597 void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
1598   SetDeclTypeSpec(context().MakeNumericType(category, kind));
1599 }
1600
1601 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
1602   SetDeclTypeSpec(context().globalScope().MakeClassStarType());
1603 }
1604 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
1605   SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
1606 }
1607
1608 // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
1609 // and save it in state_.declTypeSpec.
1610 void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
1611   CHECK(state_.expectDeclTypeSpec);
1612   CHECK(!state_.declTypeSpec);
1613   state_.declTypeSpec = &declTypeSpec;
1614 }
1615
1616 KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
1617     TypeCategory category, const std::optional<parser::KindSelector> &kind) {
1618   return AnalyzeKindSelector(context(), category, kind);
1619 }
1620
1621 // MessageHandler implementation
1622
1623 Message &MessageHandler::Say(MessageFixedText &&msg) {
1624   return context_->Say(currStmtSource().value(), std::move(msg));
1625 }
1626 Message &MessageHandler::Say(MessageFormattedText &&msg) {
1627   return context_->Say(currStmtSource().value(), std::move(msg));
1628 }
1629 Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
1630   return Say(name, std::move(msg), name);
1631 }
1632
1633 // ImplicitRulesVisitor implementation
1634
1635 void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
1636   prevParameterStmt_ = currStmtSource();
1637 }
1638
1639 bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
1640   bool result{std::visit(
1641       common::visitors{
1642           [&](const std::list<ImplicitNoneNameSpec> &y) {
1643             return HandleImplicitNone(y);
1644           },
1645           [&](const std::list<parser::ImplicitSpec> &) {
1646             if (prevImplicitNoneType_) {
1647               Say("IMPLICIT statement after IMPLICIT NONE or "
1648                   "IMPLICIT NONE(TYPE) statement"_err_en_US);
1649               return false;
1650             } else {
1651               implicitRules().set_isImplicitNoneType(false);
1652             }
1653             return true;
1654           },
1655       },
1656       x.u)};
1657   prevImplicit_ = currStmtSource();
1658   return result;
1659 }
1660
1661 bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
1662   auto loLoc{std::get<parser::Location>(x.t)};
1663   auto hiLoc{loLoc};
1664   if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
1665     hiLoc = *hiLocOpt;
1666     if (*hiLoc < *loLoc) {
1667       Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
1668           std::string(hiLoc, 1), std::string(loLoc, 1));
1669       return false;
1670     }
1671   }
1672   implicitRules().SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
1673   return false;
1674 }
1675
1676 bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
1677   BeginDeclTypeSpec();
1678   set_allowForwardReferenceToDerivedType(true);
1679   return true;
1680 }
1681
1682 void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
1683   EndDeclTypeSpec();
1684 }
1685
1686 void ImplicitRulesVisitor::SetScope(const Scope &scope) {
1687   implicitRules_ = &implicitRulesMap_.at(&scope);
1688   prevImplicit_ = std::nullopt;
1689   prevImplicitNone_ = std::nullopt;
1690   prevImplicitNoneType_ = std::nullopt;
1691   prevParameterStmt_ = std::nullopt;
1692 }
1693 void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
1694   // find or create implicit rules for this scope
1695   implicitRulesMap_.try_emplace(&scope, context(), implicitRules_);
1696   SetScope(scope);
1697 }
1698
1699 // TODO: for all of these errors, reference previous statement too
1700 bool ImplicitRulesVisitor::HandleImplicitNone(
1701     const std::list<ImplicitNoneNameSpec> &nameSpecs) {
1702   if (prevImplicitNone_) {
1703     Say("More than one IMPLICIT NONE statement"_err_en_US);
1704     Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
1705     return false;
1706   }
1707   if (prevParameterStmt_) {
1708     Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
1709     return false;
1710   }
1711   prevImplicitNone_ = currStmtSource();
1712   if (nameSpecs.empty()) {
1713     prevImplicitNoneType_ = currStmtSource();
1714     implicitRules().set_isImplicitNoneType(true);
1715     if (prevImplicit_) {
1716       Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
1717       return false;
1718     }
1719   } else {
1720     int sawType{0};
1721     int sawExternal{0};
1722     for (const auto noneSpec : nameSpecs) {
1723       switch (noneSpec) {
1724       case ImplicitNoneNameSpec::External:
1725         implicitRules().set_isImplicitNoneExternal(true);
1726         ++sawExternal;
1727         break;
1728       case ImplicitNoneNameSpec::Type:
1729         prevImplicitNoneType_ = currStmtSource();
1730         implicitRules().set_isImplicitNoneType(true);
1731         if (prevImplicit_) {
1732           Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
1733           return false;
1734         }
1735         ++sawType;
1736         break;
1737       }
1738     }
1739     if (sawType > 1) {
1740       Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
1741       return false;
1742     }
1743     if (sawExternal > 1) {
1744       Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
1745       return false;
1746     }
1747   }
1748   return true;
1749 }
1750
1751 // ArraySpecVisitor implementation
1752
1753 void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
1754   CHECK(arraySpec_.empty());
1755   arraySpec_ = AnalyzeArraySpec(context(), x);
1756 }
1757 void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
1758   CHECK(arraySpec_.empty());
1759   arraySpec_ = AnalyzeArraySpec(context(), x);
1760 }
1761 void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
1762   CHECK(coarraySpec_.empty());
1763   coarraySpec_ = AnalyzeCoarraySpec(context(), x);
1764 }
1765
1766 const ArraySpec &ArraySpecVisitor::arraySpec() {
1767   return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
1768 }
1769 const ArraySpec &ArraySpecVisitor::coarraySpec() {
1770   return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
1771 }
1772 void ArraySpecVisitor::BeginArraySpec() {
1773   CHECK(arraySpec_.empty());
1774   CHECK(coarraySpec_.empty());
1775   CHECK(attrArraySpec_.empty());
1776   CHECK(attrCoarraySpec_.empty());
1777 }
1778 void ArraySpecVisitor::EndArraySpec() {
1779   CHECK(arraySpec_.empty());
1780   CHECK(coarraySpec_.empty());
1781   attrArraySpec_.clear();
1782   attrCoarraySpec_.clear();
1783 }
1784 void ArraySpecVisitor::PostAttrSpec() {
1785   // Save dimension/codimension from attrs so we can process array/coarray-spec
1786   // on the entity-decl
1787   if (!arraySpec_.empty()) {
1788     CHECK(attrArraySpec_.empty());
1789     attrArraySpec_ = arraySpec_;
1790     arraySpec_.clear();
1791   }
1792   if (!coarraySpec_.empty()) {
1793     CHECK(attrCoarraySpec_.empty());
1794     attrCoarraySpec_ = coarraySpec_;
1795     coarraySpec_.clear();
1796   }
1797 }
1798
1799 // ScopeHandler implementation
1800
1801 void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
1802   SayAlreadyDeclared(name.source, prev);
1803 }
1804 void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
1805   if (context().HasError(prev)) {
1806     // don't report another error about prev
1807   } else if (const auto *details{prev.detailsIf<UseDetails>()}) {
1808     Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
1809         .Attach(details->location(),
1810             "It is use-associated with '%s' in module '%s'"_err_en_US,
1811             details->symbol().name(), details->module().name());
1812   } else {
1813     SayAlreadyDeclared(name, prev.name());
1814   }
1815   context().SetError(prev);
1816 }
1817 void ScopeHandler::SayAlreadyDeclared(
1818     const SourceName &name1, const SourceName &name2) {
1819   if (name1.begin() < name2.begin()) {
1820     SayAlreadyDeclared(name2, name1);
1821   } else {
1822     Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
1823         .Attach(name2, "Previous declaration of '%s'"_en_US, name2);
1824   }
1825 }
1826
1827 void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
1828     MessageFixedText &&msg1, MessageFixedText &&msg2) {
1829   Say2(name, std::move(msg1), symbol, std::move(msg2));
1830   context().SetError(symbol, msg1.isFatal());
1831 }
1832
1833 void ScopeHandler::SayWithDecl(
1834     const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
1835   SayWithReason(name, symbol, std::move(msg),
1836       symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US
1837                                           : "Declaration of '%s'"_en_US);
1838 }
1839
1840 void ScopeHandler::SayLocalMustBeVariable(
1841     const parser::Name &name, Symbol &symbol) {
1842   SayWithDecl(name, symbol,
1843       "The name '%s' must be a variable to appear"
1844       " in a locality-spec"_err_en_US);
1845 }
1846
1847 void ScopeHandler::SayDerivedType(
1848     const SourceName &name, MessageFixedText &&msg, const Scope &type) {
1849   const Symbol &typeSymbol{DEREF(type.GetSymbol())};
1850   Say(name, std::move(msg), name, typeSymbol.name())
1851       .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
1852           typeSymbol.name());
1853 }
1854 void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
1855     const SourceName &name2, MessageFixedText &&msg2) {
1856   Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
1857 }
1858 void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
1859     Symbol &symbol, MessageFixedText &&msg2) {
1860   Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
1861   context().SetError(symbol, msg1.isFatal());
1862 }
1863 void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
1864     Symbol &symbol, MessageFixedText &&msg2) {
1865   Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
1866   context().SetError(symbol, msg1.isFatal());
1867 }
1868
1869 Scope &ScopeHandler::InclusiveScope() {
1870   for (auto *scope{&currScope()};; scope = &scope->parent()) {
1871     if (scope->kind() != Scope::Kind::Block && !scope->IsDerivedType()) {
1872       return *scope;
1873     }
1874   }
1875   common::die("inclusive scope not found");
1876 }
1877 Scope &ScopeHandler::GlobalScope() {
1878   for (auto *scope = currScope_; scope; scope = &scope->parent()) {
1879     if (scope->IsGlobal()) {
1880       return *scope;
1881     }
1882   }
1883   common::die("global scope not found");
1884 }
1885 void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
1886   PushScope(currScope().MakeScope(kind, symbol));
1887 }
1888 void ScopeHandler::PushScope(Scope &scope) {
1889   currScope_ = &scope;
1890   auto kind{currScope_->kind()};
1891   if (kind != Scope::Kind::Block) {
1892     ImplicitRulesVisitor::BeginScope(scope);
1893   }
1894   // The name of a module or submodule cannot be "used" in its scope,
1895   // as we read 19.3.1(2), so we allow the name to be used as a local
1896   // identifier in the module or submodule too.  Same with programs
1897   // (14.1(3)) and BLOCK DATA.
1898   if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
1899       kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
1900     if (auto *symbol{scope.symbol()}) {
1901       // Create a dummy symbol so we can't create another one with the same
1902       // name. It might already be there if we previously pushed the scope.
1903       if (!FindInScope(scope, symbol->name())) {
1904         auto &newSymbol{MakeSymbol(symbol->name())};
1905         if (kind == Scope::Kind::Subprogram) {
1906           // Allow for recursive references.  If this symbol is a function
1907           // without an explicit RESULT(), this new symbol will be discarded
1908           // and replaced with an object of the same name.
1909           newSymbol.set_details(HostAssocDetails{*symbol});
1910         } else {
1911           newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
1912         }
1913       }
1914     }
1915   }
1916 }
1917 void ScopeHandler::PopScope() {
1918   // Entities that are not yet classified as objects or procedures are now
1919   // assumed to be objects.
1920   // TODO: Statement functions
1921   for (auto &pair : currScope()) {
1922     ConvertToObjectEntity(*pair.second);
1923   }
1924   SetScope(currScope_->parent());
1925 }
1926 void ScopeHandler::SetScope(Scope &scope) {
1927   currScope_ = &scope;
1928   ImplicitRulesVisitor::SetScope(InclusiveScope());
1929 }
1930
1931 Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
1932   return FindSymbol(currScope(), name);
1933 }
1934 Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
1935   if (scope.IsDerivedType()) {
1936     if (Symbol * symbol{scope.FindComponent(name.source)}) {
1937       if (!symbol->has<ProcBindingDetails>() &&
1938           !symbol->test(Symbol::Flag::ParentComp)) {
1939         return Resolve(name, symbol);
1940       }
1941     }
1942     return FindSymbol(scope.parent(), name);
1943   } else {
1944     return Resolve(name, scope.FindSymbol(name.source));
1945   }
1946 }
1947
1948 Symbol &ScopeHandler::MakeSymbol(
1949     Scope &scope, const SourceName &name, Attrs attrs) {
1950   if (Symbol * symbol{FindInScope(scope, name)}) {
1951     symbol->attrs() |= attrs;
1952     return *symbol;
1953   } else {
1954     const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
1955     CHECK(pair.second);  // name was not found, so must be able to add
1956     return *pair.first->second;
1957   }
1958 }
1959 Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
1960   return MakeSymbol(currScope(), name, attrs);
1961 }
1962 Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
1963   return Resolve(name, MakeSymbol(name.source, attrs));
1964 }
1965 Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
1966   CHECK(!FindInScope(currScope(), name));
1967   return MakeSymbol(currScope(), name, symbol.attrs());
1968 }
1969
1970 // Look for name only in scope, not in enclosing scopes.
1971 Symbol *ScopeHandler::FindInScope(
1972     const Scope &scope, const parser::Name &name) {
1973   return Resolve(name, FindInScope(scope, name.source));
1974 }
1975 Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
1976   if (auto it{scope.find(name)}; it != scope.end()) {
1977     return &*it->second;
1978   } else {
1979     return nullptr;
1980   }
1981 }
1982
1983 // Find a component or type parameter by name in a derived type or its parents.
1984 Symbol *ScopeHandler::FindInTypeOrParents(
1985     const Scope &scope, const parser::Name &name) {
1986   return Resolve(name, scope.FindComponent(name.source));
1987 }
1988 Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
1989   return FindInTypeOrParents(currScope(), name);
1990 }
1991
1992 void ScopeHandler::EraseSymbol(const parser::Name &name) {
1993   currScope().erase(name.source);
1994   name.symbol = nullptr;
1995 }
1996
1997 static bool NeedsType(const Symbol &symbol) {
1998   return !symbol.GetType() &&
1999       std::visit(
2000           common::visitors{
2001               [](const EntityDetails &) { return true; },
2002               [](const ObjectEntityDetails &) { return true; },
2003               [](const AssocEntityDetails &) { return true; },
2004               [&](const ProcEntityDetails &p) {
2005                 return symbol.test(Symbol::Flag::Function) &&
2006                     !symbol.attrs().test(Attr::INTRINSIC) &&
2007                     !p.interface().type() && !p.interface().symbol();
2008               },
2009               [](const auto &) { return false; },
2010           },
2011           symbol.details());
2012 }
2013 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
2014   if (NeedsType(symbol)) {
2015     if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
2016       symbol.set(Symbol::Flag::Implicit);
2017       symbol.SetType(*type);
2018     } else if (symbol.has<ProcEntityDetails>() &&
2019         !symbol.attrs().test(Attr::EXTERNAL) &&
2020         context().intrinsics().IsIntrinsic(symbol.name().ToString())) {
2021       // type will be determined in expression semantics
2022       symbol.attrs().set(Attr::INTRINSIC);
2023     } else if (!context().HasError(symbol)) {
2024       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
2025       context().SetError(symbol);
2026     }
2027   }
2028 }
2029 const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
2030   const DeclTypeSpec *type{implicitRules().GetType(symbol.name().begin()[0])};
2031   if (type) {
2032     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
2033       // Resolve any forward-referenced derived type; a quick no-op else.
2034       auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
2035       instantiatable.Instantiate(currScope(), context());
2036     }
2037   }
2038   return type;
2039 }
2040
2041 // Convert symbol to be a ObjectEntity or return false if it can't be.
2042 bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
2043   if (symbol.has<ObjectEntityDetails>()) {
2044     // nothing to do
2045   } else if (symbol.has<UnknownDetails>()) {
2046     symbol.set_details(ObjectEntityDetails{});
2047   } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2048     symbol.set_details(ObjectEntityDetails{std::move(*details)});
2049   } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
2050     return useDetails->symbol().has<ObjectEntityDetails>();
2051   } else {
2052     return false;
2053   }
2054   return true;
2055 }
2056 // Convert symbol to be a ProcEntity or return false if it can't be.
2057 bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
2058   if (symbol.has<ProcEntityDetails>()) {
2059     // nothing to do
2060   } else if (symbol.has<UnknownDetails>()) {
2061     symbol.set_details(ProcEntityDetails{});
2062   } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2063     symbol.set_details(ProcEntityDetails{std::move(*details)});
2064     if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
2065       CHECK(!symbol.test(Symbol::Flag::Subroutine));
2066       symbol.set(Symbol::Flag::Function);
2067     }
2068   } else {
2069     return false;
2070   }
2071   return true;
2072 }
2073
2074 const DeclTypeSpec &ScopeHandler::MakeNumericType(
2075     TypeCategory category, const std::optional<parser::KindSelector> &kind) {
2076   KindExpr value{GetKindParamExpr(category, kind)};
2077   if (auto known{evaluate::ToInt64(value)}) {
2078     return context().MakeNumericType(category, static_cast<int>(*known));
2079   } else {
2080     return currScope_->MakeNumericType(category, std::move(value));
2081   }
2082 }
2083
2084 const DeclTypeSpec &ScopeHandler::MakeLogicalType(
2085     const std::optional<parser::KindSelector> &kind) {
2086   KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
2087   if (auto known{evaluate::ToInt64(value)}) {
2088     return context().MakeLogicalType(static_cast<int>(*known));
2089   } else {
2090     return currScope_->MakeLogicalType(std::move(value));
2091   }
2092 }
2093
2094 void ScopeHandler::MakeExternal(Symbol &symbol) {
2095   if (!symbol.attrs().test(Attr::EXTERNAL)) {
2096     symbol.attrs().set(Attr::EXTERNAL);
2097     if (symbol.attrs().test(Attr::INTRINSIC)) {  // C840
2098       Say(symbol.name(),
2099           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
2100           symbol.name());
2101     }
2102   }
2103 }
2104
2105 // ModuleVisitor implementation
2106
2107 bool ModuleVisitor::Pre(const parser::Only &x) {
2108   std::visit(
2109       common::visitors{
2110           [&](const Indirection<parser::GenericSpec> &generic) {
2111             AddUse(GenericSpecInfo{generic.value()});
2112           },
2113           [&](const parser::Name &name) {
2114             Resolve(name, AddUse(name.source, name.source).use);
2115           },
2116           [&](const parser::Rename &rename) { Walk(rename); },
2117       },
2118       x.u);
2119   return false;
2120 }
2121
2122 bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
2123   const auto &localName{std::get<0>(x.t)};
2124   const auto &useName{std::get<1>(x.t)};
2125   SymbolRename rename{AddUse(localName.source, useName.source)};
2126   Resolve(useName, rename.use);
2127   Resolve(localName, rename.local);
2128   return false;
2129 }
2130 bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
2131   const parser::DefinedOpName &local{std::get<0>(x.t)};
2132   const parser::DefinedOpName &use{std::get<1>(x.t)};
2133   GenericSpecInfo localInfo{local};
2134   GenericSpecInfo useInfo{use};
2135   if (IsIntrinsicOperator(context(), local.v.source)) {
2136     Say(local.v,
2137         "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
2138   } else if (IsLogicalConstant(context(), local.v.source)) {
2139     Say(local.v,
2140         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
2141   } else {
2142     SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())};
2143     useInfo.Resolve(rename.use);
2144     localInfo.Resolve(rename.local);
2145   }
2146   return false;
2147 }
2148
2149 // Set useModuleScope_ to the Scope of the module being used.
2150 bool ModuleVisitor::Pre(const parser::UseStmt &x) {
2151   useModuleScope_ = FindModule(x.moduleName);
2152   return useModuleScope_ != nullptr;
2153 }
2154 void ModuleVisitor::Post(const parser::UseStmt &x) {
2155   if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
2156     // Not a use-only: collect the names that were used in renames,
2157     // then add a use for each public name that was not renamed.
2158     std::set<SourceName> useNames;
2159     for (const auto &rename : *list) {
2160       std::visit(
2161           common::visitors{
2162               [&](const parser::Rename::Names &names) {
2163                 useNames.insert(std::get<1>(names.t).source);
2164               },
2165               [&](const parser::Rename::Operators &ops) {
2166                 useNames.insert(std::get<1>(ops.t).v.source);
2167               },
2168           },
2169           rename.u);
2170     }
2171     for (const auto &[name, symbol] : *useModuleScope_) {
2172       if (symbol->attrs().test(Attr::PUBLIC) &&
2173           !symbol->detailsIf<MiscDetails>()) {
2174         if (useNames.count(name) == 0) {
2175           auto *localSymbol{FindInScope(currScope(), name)};
2176           if (!localSymbol) {
2177             localSymbol = &CopySymbol(name, *symbol);
2178           }
2179           AddUse(x.moduleName.source, *localSymbol, *symbol);
2180         }
2181       }
2182     }
2183   }
2184   useModuleScope_ = nullptr;
2185 }
2186
2187 ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2188     const SourceName &localName, const SourceName &useName) {
2189   return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));
2190 }
2191
2192 ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2193     const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {
2194   if (!useModuleScope_) {
2195     return {};  // error occurred finding module
2196   }
2197   if (!useSymbol) {
2198     Say(useName,
2199         IsDefinedOperator(useName)
2200             ? "Operator '%s' not found in module '%s'"_err_en_US
2201             : "'%s' not found in module '%s'"_err_en_US,
2202         useName, useModuleScope_->GetName().value());
2203     return {};
2204   }
2205   if (useSymbol->attrs().test(Attr::PRIVATE)) {
2206     Say(useName,
2207         IsDefinedOperator(useName)
2208             ? "Operator '%s' is PRIVATE in '%s'"_err_en_US
2209             : "'%s' is PRIVATE in '%s'"_err_en_US,
2210         useName, useModuleScope_->GetName().value());
2211     return {};
2212   }
2213   auto &localSymbol{MakeSymbol(localName)};
2214   AddUse(useName, localSymbol, *useSymbol);
2215   return {&localSymbol, useSymbol};
2216 }
2217
2218 // symbol must be either a Use or a Generic formed by merging two uses.
2219 // Convert it to a UseError with this additional location.
2220 static void ConvertToUseError(
2221     Symbol &symbol, const SourceName &location, const Scope &module) {
2222   const auto *useDetails{symbol.detailsIf<UseDetails>()};
2223   if (!useDetails) {
2224     auto &genericDetails{symbol.get<GenericDetails>()};
2225     useDetails = &genericDetails.useDetails().value();
2226   }
2227   symbol.set_details(
2228       UseErrorDetails{*useDetails}.add_occurrence(location, module));
2229 }
2230
2231 void ModuleVisitor::AddUse(
2232     const SourceName &location, Symbol &localSymbol, const Symbol &useSymbol) {
2233   localSymbol.attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
2234   localSymbol.flags() = useSymbol.flags();
2235   if (auto *useDetails{localSymbol.detailsIf<UseDetails>()}) {
2236     const Symbol &ultimate{localSymbol.GetUltimate()};
2237     if (ultimate == useSymbol.GetUltimate()) {
2238       // use-associating the same symbol again -- ok
2239     } else if (ultimate.has<GenericDetails>() &&
2240         useSymbol.has<GenericDetails>()) {
2241       // use-associating generics with the same names: merge them into a
2242       // new generic in this scope
2243       auto generic1{ultimate.get<GenericDetails>()};
2244       generic1.set_useDetails(*useDetails);
2245       // useSymbol has specific g and so does generic1
2246       auto &generic2{useSymbol.get<GenericDetails>()};
2247       if (generic1.specific() && generic2.specific() &&
2248           generic1.specific() != generic2.specific()) {
2249         Say(location,
2250             "Generic interface '%s' has ambiguous specific procedures"
2251             " from modules '%s' and '%s'"_err_en_US,
2252             localSymbol.name(), useDetails->module().name(),
2253             useSymbol.owner().GetName().value());
2254       } else if (generic1.derivedType() && generic2.derivedType() &&
2255           generic1.derivedType() != generic2.derivedType()) {
2256         Say(location,
2257             "Generic interface '%s' has ambiguous derived types"
2258             " from modules '%s' and '%s'"_err_en_US,
2259             localSymbol.name(), useDetails->module().name(),
2260             useSymbol.owner().GetName().value());
2261       } else {
2262         generic1.CopyFrom(generic2);
2263       }
2264       EraseSymbol(localSymbol);
2265       MakeSymbol(localSymbol.name(), ultimate.attrs(), std::move(generic1));
2266     } else {
2267       ConvertToUseError(localSymbol, location, *useModuleScope_);
2268     }
2269   } else {
2270     auto *genericDetails{localSymbol.detailsIf<GenericDetails>()};
2271     if (genericDetails && genericDetails->useDetails()) {
2272       // localSymbol came from merging two use-associated generics
2273       if (auto *useDetails{useSymbol.detailsIf<GenericDetails>()}) {
2274         genericDetails->CopyFrom(*useDetails);
2275       } else {
2276         ConvertToUseError(localSymbol, location, *useModuleScope_);
2277       }
2278     } else if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) {
2279       details->add_occurrence(location, *useModuleScope_);
2280     } else if (!localSymbol.has<UnknownDetails>()) {
2281       Say(location,
2282           "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
2283           localSymbol.name())
2284           .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US,
2285               localSymbol.name());
2286     } else {
2287       localSymbol.set_details(UseDetails{location, useSymbol});
2288     }
2289   }
2290 }
2291
2292 void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
2293   if (useModuleScope_) {
2294     const auto &name{info.symbolName()};
2295     auto rename{
2296         AddUse(name, name, info.FindInScope(context(), *useModuleScope_))};
2297     info.Resolve(rename.use);
2298   }
2299 }
2300
2301 bool ModuleVisitor::BeginSubmodule(
2302     const parser::Name &name, const parser::ParentIdentifier &parentId) {
2303   auto &ancestorName{std::get<parser::Name>(parentId.t)};
2304   auto &parentName{std::get<std::optional<parser::Name>>(parentId.t)};
2305   Scope *ancestor{FindModule(ancestorName)};
2306   if (!ancestor) {
2307     return false;
2308   }
2309   Scope *parentScope{parentName ? FindModule(*parentName, ancestor) : ancestor};
2310   if (!parentScope) {
2311     return false;
2312   }
2313   PushScope(*parentScope);  // submodule is hosted in parent
2314   BeginModule(name, true);
2315   if (!ancestor->AddSubmodule(name.source, currScope())) {
2316     Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
2317         ancestorName.source, name.source);
2318   }
2319   return true;
2320 }
2321
2322 void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
2323   auto &symbol{MakeSymbol(name, ModuleDetails{isSubmodule})};
2324   auto &details{symbol.get<ModuleDetails>()};
2325   PushScope(Scope::Kind::Module, &symbol);
2326   details.set_scope(&currScope());
2327   defaultAccess_ = Attr::PUBLIC;
2328   prevAccessStmt_ = std::nullopt;
2329 }
2330
2331 // Find a module or submodule by name and return its scope.
2332 // If ancestor is present, look for a submodule of that ancestor module.
2333 // May have to read a .mod file to find it.
2334 // If an error occurs, report it and return nullptr.
2335 Scope *ModuleVisitor::FindModule(const parser::Name &name, Scope *ancestor) {
2336   ModFileReader reader{context()};
2337   Scope *scope{reader.Read(name.source, ancestor)};
2338   if (!scope) {
2339     return nullptr;
2340   }
2341   if (scope->kind() != Scope::Kind::Module) {
2342     Say(name, "'%s' is not a module"_err_en_US);
2343     return nullptr;
2344   }
2345   if (DoesScopeContain(scope, currScope())) {  // 14.2.2(1)
2346     Say(name, "Module '%s' cannot USE itself"_err_en_US);
2347   }
2348   Resolve(name, scope->symbol());
2349   return scope;
2350 }
2351
2352 void ModuleVisitor::ApplyDefaultAccess() {
2353   for (auto &pair : currScope()) {
2354     Symbol &symbol = *pair.second;
2355     if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
2356       symbol.attrs().set(defaultAccess_);
2357     }
2358   }
2359 }
2360
2361 // InterfaceVistor implementation
2362
2363 bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
2364   bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
2365   genericInfo_.emplace(/*isInterface*/ true, isAbstract);
2366   return true;
2367 }
2368
2369 void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
2370   genericInfo_.pop();
2371 }
2372
2373 // Create a symbol in genericSymbol_ for this GenericSpec.
2374 bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
2375   if (auto *symbol{GenericSpecInfo{x}.FindInScope(context(), currScope())}) {
2376     SetGenericSymbol(*symbol);
2377   }
2378   return false;
2379 }
2380
2381 bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
2382   if (!isGeneric()) {
2383     Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
2384     return false;
2385   }
2386   auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
2387   const auto &names{std::get<std::list<parser::Name>>(x.t)};
2388   AddSpecificProcs(names, kind);
2389   return false;
2390 }
2391
2392 bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
2393   genericInfo_.emplace(/*isInterface*/ false);
2394   return true;
2395 }
2396 void InterfaceVisitor::Post(const parser::GenericStmt &x) {
2397   if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) {
2398     GetGenericInfo().symbol->attrs().set(AccessSpecToAttr(*accessSpec));
2399   }
2400   const auto &names{std::get<std::list<parser::Name>>(x.t)};
2401   AddSpecificProcs(names, ProcedureKind::Procedure);
2402   genericInfo_.pop();
2403 }
2404
2405 bool InterfaceVisitor::inInterfaceBlock() const {
2406   return !genericInfo_.empty() && GetGenericInfo().isInterface;
2407 }
2408 bool InterfaceVisitor::isGeneric() const {
2409   return !genericInfo_.empty() && GetGenericInfo().symbol;
2410 }
2411 bool InterfaceVisitor::isAbstract() const {
2412   return !genericInfo_.empty() && GetGenericInfo().isAbstract;
2413 }
2414 GenericDetails &InterfaceVisitor::GetGenericDetails() {
2415   return GetGenericInfo().symbol->get<GenericDetails>();
2416 }
2417
2418 void InterfaceVisitor::AddSpecificProcs(
2419     const std::list<parser::Name> &names, ProcedureKind kind) {
2420   for (const auto &name : names) {
2421     specificProcs_.emplace(
2422         GetGenericInfo().symbol, std::make_pair(&name, kind));
2423   }
2424 }
2425
2426 // By now we should have seen all specific procedures referenced by name in
2427 // this generic interface. Resolve those names to symbols.
2428 void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
2429   auto &details{generic.get<GenericDetails>()};
2430   std::set<SourceName> namesSeen;  // to check for duplicate names
2431   for (const Symbol &symbol : details.specificProcs()) {
2432     namesSeen.insert(symbol.name());
2433   }
2434   auto range{specificProcs_.equal_range(&generic)};
2435   for (auto it{range.first}; it != range.second; ++it) {
2436     auto *name{it->second.first};
2437     auto kind{it->second.second};
2438     const auto *symbol{FindSymbol(*name)};
2439     if (!symbol) {
2440       Say(*name, "Procedure '%s' not found"_err_en_US);
2441       continue;
2442     }
2443     symbol = &symbol->GetUltimate();
2444     if (symbol == &generic) {
2445       if (auto *specific{generic.get<GenericDetails>().specific()}) {
2446         symbol = specific;
2447       }
2448     }
2449     if (!symbol->has<SubprogramDetails>() &&
2450         !symbol->has<SubprogramNameDetails>()) {
2451       Say(*name, "'%s' is not a subprogram"_err_en_US);
2452       continue;
2453     }
2454     if (kind == ProcedureKind::ModuleProcedure) {
2455       if (const auto *nd{symbol->detailsIf<SubprogramNameDetails>()}) {
2456         if (nd->kind() != SubprogramKind::Module) {
2457           Say(*name, "'%s' is not a module procedure"_err_en_US);
2458         }
2459       } else {
2460         // USE-associated procedure
2461         const auto *sd{symbol->detailsIf<SubprogramDetails>()};
2462         CHECK(sd);
2463         if (symbol->owner().kind() != Scope::Kind::Module ||
2464             sd->isInterface()) {
2465           Say(*name, "'%s' is not a module procedure"_err_en_US);
2466         }
2467       }
2468     }
2469     if (!namesSeen.insert(name->source).second) {
2470       Say(*name,
2471           details.kind().IsDefinedOperator()
2472               ? "Procedure '%s' is already specified in generic operator '%s'"_err_en_US
2473               : "Procedure '%s' is already specified in generic '%s'"_err_en_US,
2474           name->source, generic.name());
2475       continue;
2476     }
2477     details.AddSpecificProc(*symbol, name->source);
2478   }
2479   specificProcs_.erase(range.first, range.second);
2480 }
2481
2482 // Check that the specific procedures are all functions or all subroutines.
2483 // If there is a derived type with the same name they must be functions.
2484 // Set the corresponding flag on generic.
2485 void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
2486   ResolveSpecificsInGeneric(generic);
2487   auto &details{generic.get<GenericDetails>()};
2488   if (auto *proc{details.CheckSpecific()}) {
2489     auto msg{
2490         "'%s' may not be the name of both a generic interface and a"
2491         " procedure unless it is a specific procedure of the generic"_err_en_US};
2492     if (proc->name().begin() > generic.name().begin()) {
2493       Say(proc->name(), std::move(msg));
2494     } else {
2495       Say(generic.name(), std::move(msg));
2496     }
2497   }
2498   auto &specifics{details.specificProcs()};
2499   if (specifics.empty()) {
2500     if (details.derivedType()) {
2501       generic.set(Symbol::Flag::Function);
2502     }
2503     return;
2504   }
2505   const Symbol &firstSpecific{specifics.front()};
2506   bool isFunction{firstSpecific.test(Symbol::Flag::Function)};
2507   for (const Symbol &specific : specifics) {
2508     if (isFunction != specific.test(Symbol::Flag::Function)) {  // C1514
2509       auto &msg{Say(generic.name(),
2510           "Generic interface '%s' has both a function and a subroutine"_err_en_US)};
2511       if (isFunction) {
2512         msg.Attach(firstSpecific.name(), "Function declaration"_en_US);
2513         msg.Attach(specific.name(), "Subroutine declaration"_en_US);
2514       } else {
2515         msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US);
2516         msg.Attach(specific.name(), "Function declaration"_en_US);
2517       }
2518     }
2519   }
2520   if (!isFunction && details.derivedType()) {
2521     SayDerivedType(generic.name(),
2522         "Generic interface '%s' may only contain functions due to derived type"
2523         " with same name"_err_en_US,
2524         *details.derivedType()->scope());
2525   }
2526   generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
2527 }
2528
2529 // SubprogramVisitor implementation
2530
2531 // Return false if it is actually an assignment statement.
2532 bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
2533   const auto &name{std::get<parser::Name>(x.t)};
2534   const DeclTypeSpec *resultType{nullptr};
2535   // Look up name: provides return type or tells us if it's an array
2536   if (auto *symbol{FindSymbol(name)}) {
2537     auto *details{symbol->detailsIf<EntityDetails>()};
2538     if (!details) {
2539       badStmtFuncFound_ = true;
2540       return false;
2541     }
2542     // TODO: check that attrs are compatible with stmt func
2543     resultType = details->type();
2544     symbol->details() = UnknownDetails{};  // will be replaced below
2545   }
2546   if (badStmtFuncFound_) {
2547     Say(name, "'%s' has not been declared as an array"_err_en_US);
2548     return true;
2549   }
2550   auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
2551   EraseSymbol(symbol);  // removes symbol added by PushSubprogramScope
2552   auto &details{symbol.get<SubprogramDetails>()};
2553   for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {
2554     ObjectEntityDetails dummyDetails{true};
2555     if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {
2556       if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) {
2557         if (d->type()) {
2558           dummyDetails.set_type(*d->type());
2559         }
2560       }
2561     }
2562     Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};
2563     ApplyImplicitRules(dummy);
2564     details.add_dummyArg(dummy);
2565   }
2566   ObjectEntityDetails resultDetails;
2567   if (resultType) {
2568     resultDetails.set_type(*resultType);
2569   }
2570   Symbol &result{MakeSymbol(name, std::move(resultDetails))};
2571   ApplyImplicitRules(result);
2572   details.set_result(result);
2573   const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
2574   Walk(parsedExpr);
2575   if (auto expr{AnalyzeExpr(context(), parsedExpr)}) {
2576     details.set_stmtFunction(std::move(*expr));
2577   } else {
2578     context().SetError(symbol);
2579   }
2580   PopScope();
2581   return true;
2582 }
2583
2584 bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
2585   if (suffix.resultName) {
2586     funcInfo_.resultName = &suffix.resultName.value();
2587   }
2588   return true;
2589 }
2590
2591 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
2592   // Save this to process after UseStmt and ImplicitPart
2593   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
2594     funcInfo_.parsedType = parsedType;
2595     funcInfo_.source = currStmtSource();
2596     return false;
2597   } else {
2598     return true;
2599   }
2600 }
2601
2602 void SubprogramVisitor::Post(const parser::ImplicitPart &) {
2603   // If the function has a type in the prefix, process it now
2604   if (funcInfo_.parsedType) {
2605     messageHandler().set_currStmtSource(funcInfo_.source);
2606     if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) {
2607       funcInfo_.resultSymbol->SetType(*type);
2608     }
2609   }
2610   funcInfo_ = {};
2611 }
2612
2613 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
2614   const auto &name{std::get<parser::Name>(
2615       std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
2616   return BeginSubprogram(name, Symbol::Flag::Subroutine);
2617 }
2618 void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &) {
2619   EndSubprogram();
2620 }
2621 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
2622   const auto &name{std::get<parser::Name>(
2623       std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)};
2624   return BeginSubprogram(name, Symbol::Flag::Function);
2625 }
2626 void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) {
2627   EndSubprogram();
2628 }
2629
2630 bool SubprogramVisitor::Pre(const parser::SubroutineStmt &) {
2631   return BeginAttrs();
2632 }
2633 bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
2634   return BeginAttrs();
2635 }
2636
2637 void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
2638   const auto &name{std::get<parser::Name>(stmt.t)};
2639   auto &details{PostSubprogramStmt(name)};
2640   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
2641     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
2642       Symbol &dummy{MakeSymbol(*dummyName, EntityDetails(true))};
2643       details.add_dummyArg(dummy);
2644     } else {
2645       details.add_alternateReturn();
2646     }
2647   }
2648 }
2649
2650 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
2651   const auto &name{std::get<parser::Name>(stmt.t)};
2652   auto &details{PostSubprogramStmt(name)};
2653   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
2654     Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))};
2655     details.add_dummyArg(dummy);
2656   }
2657   const parser::Name *funcResultName;
2658   if (funcInfo_.resultName && funcInfo_.resultName->source != name.source) {
2659     // Note that RESULT is ignored if it has the same name as the function.
2660     funcResultName = funcInfo_.resultName;
2661   } else {
2662     EraseSymbol(name);  // was added by PushSubprogramScope
2663     funcResultName = &name;
2664   }
2665   // add function result to function scope
2666   EntityDetails funcResultDetails;
2667   funcResultDetails.set_funcResult(true);
2668   funcInfo_.resultSymbol =
2669       &MakeSymbol(*funcResultName, std::move(funcResultDetails));
2670   details.set_result(*funcInfo_.resultSymbol);
2671
2672   // C1560. TODO also enforce on entry names when entry implemented
2673   if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) {
2674     Say(funcInfo_.resultName->source,
2675         "The function name should not appear in RESULT, references to '%s' "
2676         "inside"
2677         " the function will be considered as references to the result only"_en_US,
2678         name.source);
2679     // RESULT name was ignored above, the only side effect from doing so will be
2680     // the inability to make recursive calls. The related parser::Name is still
2681     // resolved to the created function result symbol because every parser::Name
2682     // should be resolved to avoid internal errors.
2683     Resolve(*funcInfo_.resultName, funcInfo_.resultSymbol);
2684   }
2685   name.symbol = currScope().symbol();  // must not be function result symbol
2686 }
2687
2688 SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
2689     const parser::Name &name) {
2690   Symbol &symbol{*currScope().symbol()};
2691   CHECK(name.source == symbol.name());
2692   SetBindNameOn(symbol);
2693   symbol.attrs() |= EndAttrs();
2694   if (symbol.attrs().test(Attr::MODULE)) {
2695     symbol.attrs().set(Attr::EXTERNAL, false);
2696   }
2697   return symbol.get<SubprogramDetails>();
2698 }
2699
2700 // A subprogram declared with MODULE PROCEDURE
2701 bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
2702   auto *symbol{FindSymbol(name)};
2703   if (symbol && symbol->has<SubprogramNameDetails>()) {
2704     symbol = FindSymbol(currScope().parent(), name);
2705   }
2706   if (!symbol || !symbol->IsSeparateModuleProc()) {
2707     Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
2708     return false;
2709   }
2710   if (symbol->owner() != currScope()) {
2711     symbol = &MakeSymbol(name, SubprogramDetails{});
2712   }
2713   PushScope(Scope::Kind::Subprogram, symbol);
2714   return true;
2715 }
2716
2717 // A subprogram declared with SUBROUTINE or FUNCTION
2718 bool SubprogramVisitor::BeginSubprogram(
2719     const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) {
2720   if (hasModulePrefix && !inInterfaceBlock()) {
2721     auto *symbol{FindSymbol(currScope().parent(), name)};
2722     if (!symbol || !symbol->IsSeparateModuleProc()) {
2723       Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
2724       return false;
2725     }
2726   }
2727   PushSubprogramScope(name, subpFlag);
2728   return true;
2729 }
2730
2731 void SubprogramVisitor::EndSubprogram() { PopScope(); }
2732
2733 Symbol &SubprogramVisitor::PushSubprogramScope(
2734     const parser::Name &name, Symbol::Flag subpFlag) {
2735   auto *symbol{GetSpecificFromGeneric(name)};
2736   if (!symbol) {
2737     if (auto *prev{FindSymbol(name)}) {
2738       if (prev->attrs().test(Attr::EXTERNAL) &&
2739           prev->has<ProcEntityDetails>()) {
2740         // this subprogram was previously called, now being declared
2741         if (!prev->test(subpFlag)) {
2742           Say2(name,
2743               subpFlag == Symbol::Flag::Function
2744                   ? "'%s' was previously called as a subroutine"_err_en_US
2745                   : "'%s' was previously called as a function"_err_en_US,
2746               *prev, "Previous call of '%s'"_en_US);
2747         }
2748         EraseSymbol(name);
2749       }
2750     }
2751     symbol = &MakeSymbol(name, SubprogramDetails{});
2752   }
2753   symbol->set(subpFlag);
2754   PushScope(Scope::Kind::Subprogram, symbol);
2755   auto &details{symbol->get<SubprogramDetails>()};
2756   if (inInterfaceBlock()) {
2757     details.set_isInterface();
2758     if (!isAbstract()) {
2759       MakeExternal(*symbol);
2760     }
2761     if (isGeneric()) {
2762       GetGenericDetails().AddSpecificProc(*symbol, name.source);
2763     }
2764     implicitRules().set_inheritFromParent(false);
2765   }
2766   FindSymbol(name)->set(subpFlag);  // PushScope() created symbol
2767   return *symbol;
2768 }
2769
2770 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
2771   if (auto *prev{FindSymbol(name)}) {
2772     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
2773       if (prev->test(Symbol::Flag::Subroutine) ||
2774           prev->test(Symbol::Flag::Function)) {
2775         Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,
2776             "Previous call of '%s'"_en_US);
2777       }
2778       EraseSymbol(name);
2779     }
2780   }
2781   if (name.source.empty()) {
2782     // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM
2783     PushScope(Scope::Kind::BlockData, nullptr);
2784   } else {
2785     PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
2786   }
2787 }
2788
2789 // If name is a generic, return specific subprogram with the same name.
2790 Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
2791   if (auto *symbol{FindSymbol(name)}) {
2792     if (auto *details{symbol->detailsIf<GenericDetails>()}) {
2793       // found generic, want subprogram
2794       auto *specific{details->specific()};
2795       if (!specific) {
2796         specific =
2797             &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
2798         details->set_specific(Resolve(name, *specific));
2799       } else if (isGeneric()) {
2800         SayAlreadyDeclared(name, *specific);
2801       } else if (!specific->has<SubprogramDetails>()) {
2802         specific->set_details(SubprogramDetails{});
2803       }
2804       return specific;
2805     }
2806   }
2807   return nullptr;
2808 }
2809
2810 // DeclarationVisitor implementation
2811
2812 bool DeclarationVisitor::BeginDecl() {
2813   BeginDeclTypeSpec();
2814   BeginArraySpec();
2815   return BeginAttrs();
2816 }
2817 void DeclarationVisitor::EndDecl() {
2818   EndDeclTypeSpec();
2819   EndArraySpec();
2820   EndAttrs();
2821 }
2822
2823 bool DeclarationVisitor::CheckUseError(const parser::Name &name) {
2824   const auto *details{name.symbol->detailsIf<UseErrorDetails>()};
2825   if (!details) {
2826     return false;
2827   }
2828   Message &msg{Say(name, "Reference to '%s' is ambiguous"_err_en_US)};
2829   for (const auto &[location, module] : details->occurrences()) {
2830     msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US,
2831         name.source, module->GetName().value());
2832   }
2833   return true;
2834 }
2835
2836 // Report error if accessibility of symbol doesn't match isPrivate.
2837 void DeclarationVisitor::CheckAccessibility(
2838     const SourceName &name, bool isPrivate, Symbol &symbol) {
2839   if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
2840     Say2(name,
2841         "'%s' does not have the same accessibility as its previous declaration"_err_en_US,
2842         symbol, "Previous declaration of '%s'"_en_US);
2843   }
2844 }
2845
2846 // Check that component is accessible from current scope.
2847 bool DeclarationVisitor::CheckAccessibleComponent(
2848     const SourceName &name, const Symbol &symbol) {
2849   if (!symbol.attrs().test(Attr::PRIVATE)) {
2850     return true;
2851   }
2852   // component must be in a module/submodule because of PRIVATE:
2853   const Scope *moduleScope{&symbol.owner()};
2854   CHECK(moduleScope->IsDerivedType());
2855   while (
2856       moduleScope->kind() != Scope::Kind::Module && !moduleScope->IsGlobal()) {
2857     moduleScope = &moduleScope->parent();
2858   }
2859   if (moduleScope->kind() == Scope::Kind::Module) {
2860     for (auto *scope{&currScope()}; !scope->IsGlobal();
2861          scope = &scope->parent()) {
2862       if (scope == moduleScope) {
2863         return true;
2864       }
2865     }
2866     Say(name,
2867         "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US,
2868         name.ToString(), moduleScope->GetName().value());
2869   } else {
2870     Say(name,
2871         "PRIVATE component '%s' is only accessible within its module"_err_en_US,
2872         name.ToString());
2873   }
2874   return false;
2875 }
2876
2877 void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
2878   const auto &name{std::get<parser::Name>(x.t)};
2879   DeclareObjectEntity(name, Attrs{});
2880 }
2881 void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
2882   const auto &name{std::get<parser::Name>(x.t)};
2883   DeclareObjectEntity(name, Attrs{});
2884 }
2885
2886 bool DeclarationVisitor::Pre(const parser::Initialization &) {
2887   // Defer inspection of initializers to Initialization() so that the
2888   // symbol being initialized will be available within the initialization
2889   // expression.
2890   return false;
2891 }
2892
2893 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
2894   // TODO: may be under StructureStmt
2895   const auto &name{std::get<parser::ObjectName>(x.t)};
2896   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
2897   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
2898   symbol.ReplaceName(name.source);
2899   if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
2900     if (ConvertToObjectEntity(symbol)) {
2901       Initialization(name, *init, false);
2902     }
2903   } else if (attrs.test(Attr::PARAMETER)) {
2904     Say(name, "Missing initialization for parameter '%s'"_err_en_US);
2905   }
2906 }
2907
2908 void DeclarationVisitor::Post(const parser::PointerDecl &x) {
2909   const auto &name{std::get<parser::Name>(x.t)};
2910   Symbol &symbol{DeclareUnknownEntity(name, Attrs{Attr::POINTER})};
2911   symbol.ReplaceName(name.source);
2912 }
2913
2914 bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
2915   auto kind{std::get<parser::BindEntity::Kind>(x.t)};
2916   auto &name{std::get<parser::Name>(x.t)};
2917   Symbol *symbol;
2918   if (kind == parser::BindEntity::Kind::Object) {
2919     symbol = &HandleAttributeStmt(Attr::BIND_C, name);
2920   } else {
2921     symbol = &MakeCommonBlockSymbol(name);
2922     symbol->attrs().set(Attr::BIND_C);
2923   }
2924   SetBindNameOn(*symbol);
2925   return false;
2926 }
2927 bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
2928   auto &name{std::get<parser::NamedConstant>(x.t).v};
2929   auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
2930   if (!ConvertToObjectEntity(symbol) ||
2931       symbol.test(Symbol::Flag::CrayPointer) ||
2932       symbol.test(Symbol::Flag::CrayPointee)) {
2933     SayWithDecl(
2934         name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);
2935     return false;
2936   }
2937   const auto &expr{std::get<parser::ConstantExpr>(x.t)};
2938   ApplyImplicitRules(symbol);
2939   Walk(expr);
2940   if (auto converted{
2941           EvaluateConvertedExpr(symbol, expr, expr.thing.value().source)}) {
2942     symbol.get<ObjectEntityDetails>().set_init(std::move(*converted));
2943   }
2944   return false;
2945 }
2946 bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
2947   const parser::Name &name{x.v};
2948   if (!FindSymbol(name)) {
2949     Say(name, "Named constant '%s' not found"_err_en_US);
2950   } else {
2951     CheckUseError(name);
2952   }
2953   return false;
2954 }
2955
2956 bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
2957   const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
2958   Symbol *symbol{FindSymbol(name)};
2959   if (symbol) {
2960     // Contrary to named constants appearing in a PARAMETER statement,
2961     // enumerator names should not have their type, dimension or any other
2962     // attributes defined before they are declared in the enumerator statement.
2963     // This is not explicitly forbidden by the standard, but they are scalars
2964     // which type is left for the compiler to chose, so do not let users try to
2965     // tamper with that.
2966     SayAlreadyDeclared(name, *symbol);
2967     symbol = nullptr;
2968   } else {
2969     // Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
2970     symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
2971     symbol->SetType(context().MakeNumericType(
2972         TypeCategory::Integer, evaluate::CInteger::kind));
2973   }
2974
2975   if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
2976           enumerator.t)}) {
2977     Walk(*init);  // Resolve names in expression before evaluation.
2978     MaybeIntExpr expr{EvaluateIntExpr(*init)};
2979     if (auto value{evaluate::ToInt64(expr)}) {
2980       // Cast all init expressions to C_INT so that they can then be
2981       // safely incremented (see 7.6 Note 2).
2982       enumerationState_.value = static_cast<int>(*value);
2983     } else {
2984       Say(name,
2985           "Enumerator value could not be computed "
2986           "from the given expression"_err_en_US);
2987       // Prevent resolution of next enumerators value
2988       enumerationState_.value = std::nullopt;
2989     }
2990   }
2991
2992   if (symbol) {
2993     if (enumerationState_.value) {
2994       symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
2995           evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
2996     } else {
2997       context().SetError(*symbol);
2998     }
2999   }
3000
3001   if (enumerationState_.value) {
3002     (*enumerationState_.value)++;
3003   }
3004   return false;
3005 }
3006
3007 void DeclarationVisitor::Post(const parser::EnumDef &) {
3008   enumerationState_ = EnumeratorState{};
3009 }
3010
3011 bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
3012   return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
3013 }
3014 bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {
3015   return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);
3016 }
3017 bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
3018   HandleAttributeStmt(Attr::EXTERNAL, x.v);
3019   for (const auto &name : x.v) {
3020     auto *symbol{FindSymbol(name)};
3021     if (!ConvertToProcEntity(*symbol)) {
3022       SayWithDecl(
3023           name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
3024     }
3025   }
3026   return false;
3027 }
3028 bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
3029   auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
3030   auto &names{std::get<std::list<parser::Name>>(x.t)};
3031   return CheckNotInBlock("INTENT") &&  // C1107
3032       HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
3033 }
3034 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
3035   HandleAttributeStmt(Attr::INTRINSIC, x.v);
3036   for (const auto &name : x.v) {
3037     auto *symbol{FindSymbol(name)};
3038     if (!ConvertToProcEntity(*symbol)) {
3039       SayWithDecl(
3040           name, *symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
3041     } else if (symbol->attrs().test(Attr::EXTERNAL)) {  // C840
3042       Say(symbol->name(),
3043           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
3044           symbol->name());
3045     }
3046   }
3047   return false;
3048 }
3049 bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
3050   return CheckNotInBlock("OPTIONAL") &&  // C1107
3051       HandleAttributeStmt(Attr::OPTIONAL, x.v);
3052 }
3053 bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {
3054   return HandleAttributeStmt(Attr::PROTECTED, x.v);
3055 }
3056 bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
3057   return CheckNotInBlock("VALUE") &&  // C1107
3058       HandleAttributeStmt(Attr::VALUE, x.v);
3059 }
3060 bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
3061   return HandleAttributeStmt(Attr::VOLATILE, x.v);
3062 }
3063 // Handle a statement that sets an attribute on a list of names.
3064 bool DeclarationVisitor::HandleAttributeStmt(
3065     Attr attr, const std::list<parser::Name> &names) {
3066   for (const auto &name : names) {
3067     HandleAttributeStmt(attr, name);
3068   }
3069   return false;
3070 }
3071 Symbol &DeclarationVisitor::HandleAttributeStmt(
3072     Attr attr, const parser::Name &name) {
3073   if (attr == Attr::INTRINSIC &&
3074       !context().intrinsics().IsIntrinsic(name.source.ToString())) {
3075     Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
3076   }
3077   auto *symbol{FindInScope(currScope(), name)};
3078   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
3079     // these can be set on a symbol that is host-assoc or use-assoc
3080     if (!symbol &&
3081         (currScope().kind() == Scope::Kind::Subprogram ||
3082             currScope().kind() == Scope::Kind::Block)) {
3083       if (auto *hostSymbol{FindSymbol(name)}) {
3084         name.symbol = nullptr;
3085         symbol = &MakeSymbol(name, HostAssocDetails{*hostSymbol});
3086       }
3087     }
3088   } else if (symbol && symbol->has<UseDetails>()) {
3089     Say(currStmtSource().value(),
3090         "Cannot change %s attribute on use-associated '%s'"_err_en_US,
3091         EnumToString(attr), name.source);
3092     return *symbol;
3093   }
3094   if (!symbol) {
3095     symbol = &MakeSymbol(name, EntityDetails{});
3096   }
3097   symbol->attrs().set(attr);
3098   symbol->attrs() = HandleSaveName(name.source, symbol->attrs());
3099   return *symbol;
3100 }
3101 // C1107
3102 bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {
3103   if (currScope().kind() == Scope::Kind::Block) {
3104     Say(MessageFormattedText{
3105         "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});
3106     return false;
3107   } else {
3108     return true;
3109   }
3110 }
3111
3112 void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
3113   CHECK(objectDeclAttr_);
3114   const auto &name{std::get<parser::ObjectName>(x.t)};
3115   DeclareObjectEntity(name, Attrs{*objectDeclAttr_});
3116 }
3117
3118 // Declare an entity not yet known to be an object or proc.
3119 Symbol &DeclarationVisitor::DeclareUnknownEntity(
3120     const parser::Name &name, Attrs attrs) {
3121   if (!arraySpec().empty() || !coarraySpec().empty()) {
3122     return DeclareObjectEntity(name, attrs);
3123   } else {
3124     Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
3125     if (auto *type{GetDeclTypeSpec()}) {
3126       SetType(name, *type);
3127     }
3128     charInfo_.length.reset();
3129     SetBindNameOn(symbol);
3130     if (symbol.attrs().test(Attr::EXTERNAL)) {
3131       ConvertToProcEntity(symbol);
3132     }
3133     return symbol;
3134   }
3135 }
3136
3137 Symbol &DeclarationVisitor::DeclareProcEntity(
3138     const parser::Name &name, Attrs attrs, const ProcInterface &interface) {
3139   Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
3140   if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
3141     if (interface.type()) {
3142       symbol.set(Symbol::Flag::Function);
3143     } else if (interface.symbol()) {
3144       if (interface.symbol()->test(Symbol::Flag::Function)) {
3145         symbol.set(Symbol::Flag::Function);
3146       } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
3147         symbol.set(Symbol::Flag::Subroutine);
3148       }
3149     }
3150     details->set_interface(interface);
3151     SetBindNameOn(symbol);
3152     SetPassNameOn(symbol);
3153   }
3154   return symbol;
3155 }
3156
3157 Symbol &DeclarationVisitor::DeclareObjectEntity(
3158     const parser::Name &name, Attrs attrs) {
3159   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
3160   if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
3161     if (auto *type{GetDeclTypeSpec()}) {
3162       SetType(name, *type);
3163     }
3164     if (!arraySpec().empty()) {
3165       if (details->IsArray()) {
3166         Say(name,
3167             "The dimensions of '%s' have already been declared"_err_en_US);
3168         context().SetError(symbol);
3169       } else {
3170         details->set_shape(arraySpec());
3171       }
3172     }
3173     if (!coarraySpec().empty()) {
3174       if (details->IsCoarray()) {
3175         Say(name,
3176             "The codimensions of '%s' have already been declared"_err_en_US);
3177         context().SetError(symbol);
3178       } else {
3179         details->set_coshape(coarraySpec());
3180       }
3181     }
3182     SetBindNameOn(symbol);
3183   }
3184   ClearArraySpec();
3185   ClearCoarraySpec();
3186   charInfo_.length.reset();
3187   return symbol;
3188 }
3189
3190 void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
3191   SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
3192 }
3193 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
3194   SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
3195 }
3196 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
3197   SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
3198 }
3199 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
3200   SetDeclTypeSpec(MakeLogicalType(x.kind));
3201 }
3202 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
3203   if (!charInfo_.length) {
3204     charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};
3205   }
3206   if (!charInfo_.kind) {
3207     charInfo_.kind =
3208         KindExpr{context().GetDefaultKind(TypeCategory::Character)};
3209   }
3210   SetDeclTypeSpec(currScope().MakeCharacterType(
3211       std::move(*charInfo_.length), std::move(*charInfo_.kind)));
3212   charInfo_ = {};
3213 }
3214 void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
3215   charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
3216   if (x.length) {
3217     charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
3218   }
3219 }
3220 void DeclarationVisitor::Post(const parser::CharLength &x) {
3221   if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {
3222     charInfo_.length = ParamValue{
3223         static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};
3224   } else {
3225     charInfo_.length = GetParamValue(
3226         std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);
3227   }
3228 }
3229 void DeclarationVisitor::Post(const parser::LengthSelector &x) {
3230   if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {
3231     charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);
3232   }
3233 }
3234
3235 bool DeclarationVisitor::Pre(const parser::KindParam &x) {
3236   if (const auto *kind{std::get_if<
3237           parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
3238           &x.u)}) {
3239     const parser::Name &name{kind->thing.thing.thing};
3240     if (!FindSymbol(name)) {
3241       Say(name, "Parameter '%s' not found"_err_en_US);
3242     }
3243   }
3244   return false;
3245 }
3246
3247 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
3248   CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
3249   return true;
3250 }
3251
3252 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) {
3253   SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
3254   return true;
3255 }
3256
3257 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) {
3258   // TODO
3259   return true;
3260 }
3261
3262 void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
3263   const auto &typeName{std::get<parser::Name>(x.t)};
3264   auto spec{ResolveDerivedType(typeName)};
3265   if (!spec) {
3266     return;
3267   }
3268   bool seenAnyName{false};
3269   for (const auto &typeParamSpec :
3270       std::get<std::list<parser::TypeParamSpec>>(x.t)) {
3271     const auto &optKeyword{
3272         std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};
3273     std::optional<SourceName> name;
3274     if (optKeyword) {
3275       seenAnyName = true;
3276       name = optKeyword->v.source;
3277     } else if (seenAnyName) {
3278       Say(typeName.source, "Type parameter value must have a name"_err_en_US);
3279       continue;
3280     }
3281     const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
3282     // The expressions in a derived type specifier whose values define
3283     // non-defaulted type parameters are evaluated (folded) in the enclosing
3284     // scope.  The KIND/LEN distinction is resolved later in
3285     // DerivedTypeSpec::CookParameters().
3286     ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
3287     if (!param.isExplicit() || param.GetExplicit()) {
3288       spec->AddRawParamValue(optKeyword, std::move(param));
3289     }
3290   }
3291
3292   // The DerivedTypeSpec *spec is used initially as a search key.
3293   // If it turns out to have the same name and actual parameter
3294   // value expressions as another DerivedTypeSpec in the current
3295   // scope does, then we'll use that extant spec; otherwise, when this
3296   // spec is distinct from all derived types previously instantiated
3297   // in the current scope, this spec will be moved into that collection.
3298   const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};
3299   auto category{GetDeclTypeSpecCategory()};
3300   if (dtDetails.isForwardReferenced()) {
3301     DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
3302     SetDeclTypeSpec(type);
3303     return;
3304   }
3305   // Normalize parameters to produce a better search key.
3306   spec->CookParameters(GetFoldingContext());
3307   if (!spec->MightBeParameterized()) {
3308     spec->EvaluateParameters(GetFoldingContext());
3309   }
3310   if (const DeclTypeSpec *
3311       extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
3312     // This derived type and parameter expressions (if any) are already present
3313     // in this scope.
3314     SetDeclTypeSpec(*extant);
3315   } else {
3316     DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
3317     DerivedTypeSpec &derived{type.derivedTypeSpec()};
3318     if (derived.MightBeParameterized() &&
3319         currScope().IsParameterizedDerivedType()) {
3320       // Defer instantiation; use the derived type's definition's scope.
3321       derived.set_scope(DEREF(spec->typeSymbol().scope()));
3322     } else {
3323       auto restorer{
3324           GetFoldingContext().messages().SetLocation(currStmtSource().value())};
3325       derived.Instantiate(currScope(), context());
3326     }
3327     SetDeclTypeSpec(type);
3328   }
3329   // Capture the DerivedTypeSpec in the parse tree for use in building
3330   // structure constructor expressions.
3331   x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
3332 }
3333
3334 // The descendents of DerivedTypeDef in the parse tree are visited directly
3335 // in this Pre() routine so that recursive use of the derived type can be
3336 // supported in the components.
3337 bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
3338   auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
3339   Walk(stmt);
3340   Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));
3341   auto &scope{currScope()};
3342   CHECK(scope.symbol());
3343   CHECK(scope.symbol()->scope() == &scope);
3344   auto &details{scope.symbol()->get<DerivedTypeDetails>()};
3345   std::set<SourceName> paramNames;
3346   for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
3347     details.add_paramName(paramName.source);
3348     auto *symbol{FindInScope(scope, paramName)};
3349     if (!symbol) {
3350       Say(paramName,
3351           "No definition found for type parameter '%s'"_err_en_US);  // C742
3352     } else if (!symbol->has<TypeParamDetails>()) {
3353       Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US,
3354           *symbol, "Definition of '%s'"_en_US);  // C741
3355     }
3356     if (!paramNames.insert(paramName.source).second) {
3357       Say(paramName,
3358           "Duplicate type parameter name: '%s'"_err_en_US);  // C731
3359     }
3360   }
3361   for (const auto &[name, symbol] : currScope()) {
3362     if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) {
3363       SayDerivedType(name,
3364           "'%s' is not a type parameter of this derived type"_err_en_US,
3365           currScope());  // C742
3366     }
3367   }
3368   Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t));
3369   if (derivedTypeInfo_.sequence) {
3370     details.set_sequence(true);
3371     if (derivedTypeInfo_.extends) {
3372       Say(stmt.source,
3373           "A sequence type may not have the EXTENDS attribute"_err_en_US);  // C735
3374     }
3375     if (!details.paramNames().empty()) {
3376       Say(stmt.source,
3377           "A sequence type may not have type parameters"_err_en_US);  // C740
3378     }
3379   }
3380   Walk(std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t));
3381   Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
3382   Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));
3383   derivedTypeInfo_ = {};
3384   PopScope();
3385   return false;
3386 }
3387 bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
3388   return BeginAttrs();
3389 }
3390 void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
3391   auto &name{std::get<parser::Name>(x.t)};
3392   // Resolve the EXTENDS() clause before creating the derived
3393   // type's symbol to foil attempts to recursively extend a type.
3394   auto *extendsName{derivedTypeInfo_.extends};
3395   std::optional<DerivedTypeSpec> extendsType{
3396       ResolveExtendsType(name, extendsName)};
3397   auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})};
3398   symbol.ReplaceName(name.source);
3399   derivedTypeInfo_.type = &symbol;
3400   PushScope(Scope::Kind::DerivedType, &symbol);
3401   if (extendsType) {
3402     // Declare the "parent component"; private if the type is.
3403     // Any symbol stored in the EXTENDS() clause is temporarily
3404     // hidden so that a new symbol can be created for the parent
3405     // component without producing spurious errors about already
3406     // existing.
3407     const Symbol &extendsSymbol{extendsType->typeSymbol()};
3408     auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
3409     if (OkToAddComponent(*extendsName, &extendsSymbol)) {
3410       auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
3411       comp.attrs().set(
3412           Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE));
3413       comp.set(Symbol::Flag::ParentComp);
3414       DeclTypeSpec &type{currScope().MakeDerivedType(
3415           DeclTypeSpec::TypeDerived, std::move(*extendsType))};
3416       type.derivedTypeSpec().set_scope(*extendsSymbol.scope());
3417       comp.SetType(type);
3418       DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
3419       details.add_component(comp);
3420     }
3421   }
3422   EndAttrs();
3423 }
3424
3425 void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
3426   auto *type{GetDeclTypeSpec()};
3427   auto attr{std::get<common::TypeParamAttr>(x.t)};
3428   for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
3429     auto &name{std::get<parser::Name>(decl.t)};
3430     if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{attr})}) {
3431       SetType(name, *type);
3432       if (auto &init{
3433               std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) {
3434         if (auto maybeExpr{EvaluateConvertedExpr(
3435                 *symbol, *init, init->thing.thing.thing.value().source)}) {
3436           auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)};
3437           CHECK(intExpr);
3438           symbol->get<TypeParamDetails>().set_init(std::move(*intExpr));
3439         }
3440       }
3441     }
3442   }
3443   EndDecl();
3444 }
3445 bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
3446   derivedTypeInfo_.extends = &x.v;
3447   return false;
3448 }
3449
3450 bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
3451   if (!currScope().parent().IsModule()) {
3452     Say("PRIVATE is only allowed in a derived type that is"
3453         " in a module"_err_en_US);  // C766
3454   } else if (derivedTypeInfo_.sawContains) {
3455     derivedTypeInfo_.privateBindings = true;
3456   } else if (!derivedTypeInfo_.privateComps) {
3457     derivedTypeInfo_.privateComps = true;
3458   } else {
3459     Say("PRIVATE may not appear more than once in"
3460         " derived type components"_en_US);  // C738
3461   }
3462   return false;
3463 }
3464 bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {
3465   derivedTypeInfo_.sequence = true;
3466   return false;
3467 }
3468 void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
3469   const auto &name{std::get<parser::Name>(x.t)};
3470   auto attrs{GetAttrs()};
3471   if (derivedTypeInfo_.privateComps &&
3472       !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
3473     attrs.set(Attr::PRIVATE);
3474   }
3475   if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
3476     if (const auto *declType{GetDeclTypeSpec()}) {
3477       if (const auto *derived{declType->AsDerived()}) {
3478         if (derivedTypeInfo_.type == &derived->typeSymbol()) {  // C737
3479           Say("Recursive use of the derived type requires "
3480               "POINTER or ALLOCATABLE"_err_en_US);
3481         }
3482       }
3483     }
3484   }
3485   if (OkToAddComponent(name)) {
3486     auto &symbol{DeclareObjectEntity(name, attrs)};
3487     if (symbol.has<ObjectEntityDetails>()) {
3488       if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
3489         Initialization(name, *init, true);
3490       }
3491     }
3492     currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
3493   }
3494   ClearArraySpec();
3495   ClearCoarraySpec();
3496 }
3497 bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) {
3498   CHECK(!interfaceName_);
3499   return BeginDecl();
3500 }
3501 void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
3502   interfaceName_ = nullptr;
3503   EndDecl();
3504 }
3505 bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
3506   // Overrides parse tree traversal so as to handle attributes first,
3507   // so POINTER & ALLOCATABLE enable forward references to derived types.
3508   Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
3509   set_allowForwardReferenceToDerivedType(
3510       GetAttrs().test(Attr::POINTER) || GetAttrs().test(Attr::ALLOCATABLE));
3511   Walk(std::get<parser::DeclarationTypeSpec>(x.t));
3512   set_allowForwardReferenceToDerivedType(false);
3513   Walk(std::get<std::list<parser::ComponentDecl>>(x.t));
3514   return false;
3515 }
3516 bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
3517   CHECK(!interfaceName_);
3518   return true;
3519 }
3520 void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
3521   interfaceName_ = nullptr;
3522 }
3523 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
3524   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
3525     return !NameIsKnownOrIntrinsic(*name);
3526   }
3527   return true;
3528 }
3529 void DeclarationVisitor::Post(const parser::ProcInterface &x) {
3530   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
3531     interfaceName_ = name;
3532     NoteInterfaceName(*name);
3533   }
3534 }
3535
3536 void DeclarationVisitor::Post(const parser::ProcDecl &x) {
3537   const auto &name{std::get<parser::Name>(x.t)};
3538   ProcInterface interface;
3539   if (interfaceName_) {
3540     interface.set_symbol(*interfaceName_->symbol);
3541   } else if (auto *type{GetDeclTypeSpec()}) {
3542     interface.set_type(*type);
3543   }
3544   auto attrs{HandleSaveName(name.source, GetAttrs())};
3545   DerivedTypeDetails *dtDetails{nullptr};
3546   if (Symbol * symbol{currScope().symbol()}) {
3547     dtDetails = symbol->detailsIf<DerivedTypeDetails>();
3548   }
3549   if (!dtDetails) {
3550     attrs.set(Attr::EXTERNAL);
3551   }
3552   Symbol &symbol{DeclareProcEntity(name, attrs, interface)};
3553   if (dtDetails) {
3554     dtDetails->add_component(symbol);
3555   }
3556 }
3557
3558 bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {
3559   derivedTypeInfo_.sawContains = true;
3560   return true;
3561 }
3562
3563 // Resolve binding names from type-bound generics, saved in genericBindings_.
3564 void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) {
3565   // track specifics seen for the current generic to detect duplicates:
3566   const Symbol *currGeneric{nullptr};
3567   std::set<SourceName> specifics;
3568   for (const auto [generic, bindingName] : genericBindings_) {
3569     if (generic != currGeneric) {
3570       currGeneric = generic;
3571       specifics.clear();
3572     }
3573     auto [it, inserted]{specifics.insert(bindingName->source)};
3574     if (!inserted) {
3575       Say(*bindingName,  // C773
3576           "Binding name '%s' was already specified for generic '%s'"_err_en_US,
3577           bindingName->source, generic->name())
3578           .Attach(*it, "Previous specification of '%s'"_en_US, *it);
3579       continue;
3580     }
3581     auto *symbol{FindInTypeOrParents(*bindingName)};
3582     if (!symbol) {
3583       Say(*bindingName,  // C772
3584           "Binding name '%s' not found in this derived type"_err_en_US);
3585     } else if (!symbol->has<ProcBindingDetails>()) {
3586       SayWithDecl(*bindingName, *symbol,  // C772
3587           "'%s' is not the name of a specific binding of this type"_err_en_US);
3588     } else {
3589       generic->get<GenericDetails>().AddSpecificProc(
3590           *symbol, bindingName->source);
3591     }
3592   }
3593   genericBindings_.clear();
3594 }
3595
3596 void DeclarationVisitor::Post(const parser::ContainsStmt &) {
3597   if (derivedTypeInfo_.sequence) {
3598     Say("A sequence type may not have a CONTAINS statement"_err_en_US);  // C740
3599   }
3600 }
3601
3602 void DeclarationVisitor::Post(
3603     const parser::TypeBoundProcedureStmt::WithoutInterface &x) {
3604   if (GetAttrs().test(Attr::DEFERRED)) {  // C783
3605     Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US);
3606   }
3607   for (auto &declaration : x.declarations) {
3608     auto &bindingName{std::get<parser::Name>(declaration.t)};
3609     auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};
3610     const parser::Name &procedureName{optName ? *optName : bindingName};
3611     Symbol *procedure{FindSymbol(procedureName)};
3612     if (!procedure) {
3613       procedure = NoteInterfaceName(procedureName);
3614     }
3615     if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
3616       SetPassNameOn(*s);
3617       if (GetAttrs().test(Attr::DEFERRED)) {
3618         context().SetError(*s);
3619       }
3620     }
3621   }
3622 }
3623
3624 void DeclarationVisitor::CheckBindings(
3625     const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
3626   CHECK(currScope().IsDerivedType());
3627   for (auto &declaration : tbps.declarations) {
3628     auto &bindingName{std::get<parser::Name>(declaration.t)};
3629     if (Symbol * binding{FindInScope(currScope(), bindingName)}) {
3630       if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {
3631         const Symbol *procedure{FindSubprogram(details->symbol())};
3632         if (!CanBeTypeBoundProc(procedure)) {
3633           if (details->symbol().name() != binding->name()) {
3634             Say(binding->name(),
3635                 "The binding of '%s' ('%s') must be either an accessible "
3636                 "module procedure or an external procedure with "
3637                 "an explicit interface"_err_en_US,
3638                 binding->name(), details->symbol().name());
3639           } else {
3640             Say(binding->name(),
3641                 "'%s' must be either an accessible module procedure "
3642                 "or an external procedure with an explicit interface"_err_en_US,
3643                 binding->name());
3644           }
3645           context().SetError(*binding);
3646         }
3647       }
3648     }
3649   }
3650 }
3651
3652 void DeclarationVisitor::Post(
3653     const parser::TypeBoundProcedureStmt::WithInterface &x) {
3654   if (!GetAttrs().test(Attr::DEFERRED)) {  // C783
3655     Say("DEFERRED is required when an interface-name is provided"_err_en_US);
3656   }
3657   if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) {
3658     for (auto &bindingName : x.bindingNames) {
3659       if (auto *s{
3660               MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) {
3661         SetPassNameOn(*s);
3662         if (!GetAttrs().test(Attr::DEFERRED)) {
3663           context().SetError(*s);
3664         }
3665       }
3666     }
3667   }
3668 }
3669
3670 void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) {
3671   for (auto &name : x.v) {
3672     MakeTypeSymbol(name, FinalProcDetails{});
3673   }
3674 }
3675
3676 bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
3677   const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)};
3678   const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};
3679   const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)};
3680   auto info{GenericSpecInfo{genericSpec.value()}};
3681   SourceName symbolName{info.symbolName()};
3682   bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private
3683                             : derivedTypeInfo_.privateBindings};
3684   auto *genericSymbol{info.FindInScope(context(), currScope())};
3685   if (genericSymbol) {
3686     if (!genericSymbol->has<GenericDetails>()) {
3687       genericSymbol = nullptr;  // MakeTypeSymbol will report the error below
3688     }
3689   } else {
3690     // look in parent types:
3691     Symbol *inheritedSymbol{nullptr};
3692     for (const auto &name : info.GetAllNames(context())) {
3693       inheritedSymbol = currScope().FindComponent(SourceName{name});
3694       if (inheritedSymbol) {
3695         break;
3696       }
3697     }
3698     if (inheritedSymbol && inheritedSymbol->has<GenericDetails>()) {
3699       CheckAccessibility(symbolName, isPrivate, *inheritedSymbol);  // C771
3700     }
3701   }
3702   if (genericSymbol) {
3703     CheckAccessibility(symbolName, isPrivate, *genericSymbol);  // C771
3704   } else {
3705     genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{});
3706     if (!genericSymbol) {
3707       return false;
3708     }
3709     if (isPrivate) {
3710       genericSymbol->attrs().set(Attr::PRIVATE);
3711     }
3712   }
3713   for (const parser::Name &bindingName : bindingNames) {
3714     genericBindings_.emplace(genericSymbol, &bindingName);
3715   }
3716   info.Resolve(genericSymbol);
3717   return false;
3718 }
3719
3720 bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
3721   BeginDeclTypeSpec();
3722   return true;
3723 }
3724 void DeclarationVisitor::Post(const parser::AllocateStmt &) {
3725   EndDeclTypeSpec();
3726 }
3727
3728 bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
3729   auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};
3730   const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};
3731   if (!type) {
3732     return false;
3733   }
3734   const DerivedTypeSpec *spec{type->AsDerived()};
3735   const Scope *typeScope{spec ? spec->scope() : nullptr};
3736   if (!typeScope) {
3737     return false;
3738   }
3739
3740   // N.B C7102 is implicitly enforced by having inaccessible types not
3741   // being found in resolution.
3742   // More constraints are enforced in expression.cpp so that they
3743   // can apply to structure constructors that have been converted
3744   // from misparsed function references.
3745   for (const auto &component :
3746       std::get<std::list<parser::ComponentSpec>>(x.t)) {
3747     // Visit the component spec expression, but not the keyword, since
3748     // we need to resolve its symbol in the scope of the derived type.
3749     Walk(std::get<parser::ComponentDataSource>(component.t));
3750     if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
3751       if (Symbol * symbol{FindInTypeOrParents(*typeScope, kw->v)}) {
3752         if (!kw->v.symbol) {
3753           kw->v.symbol = symbol;
3754         }
3755         CheckAccessibleComponent(kw->v.source, *symbol);
3756       }
3757     }
3758   }
3759   return false;
3760 }
3761
3762 bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) {
3763   for (const parser::BasedPointer &bp : x.v) {
3764     const parser::ObjectName &pointerName{std::get<0>(bp.t)};
3765     const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
3766     auto *pointer{FindSymbol(pointerName)};
3767     if (!pointer) {
3768       pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
3769     } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) {
3770       SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
3771     } else if (pointer->Rank() > 0) {
3772       SayWithDecl(pointerName, *pointer,
3773           "Cray pointer '%s' must be a scalar"_err_en_US);
3774     } else if (pointer->test(Symbol::Flag::CrayPointee)) {
3775       Say(pointerName,
3776           "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
3777     }
3778     pointer->set(Symbol::Flag::CrayPointer);
3779     const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer,
3780         context().defaultKinds().subscriptIntegerKind())};
3781     const auto *type{pointer->GetType()};
3782     if (!type) {
3783       pointer->SetType(pointerType);
3784     } else if (*type != pointerType) {
3785       Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
3786           pointerName.source, pointerType.AsFortran());
3787     }
3788     if (ResolveName(pointeeName)) {
3789       Symbol &pointee{*pointeeName.symbol};
3790       if (pointee.has<UseDetails>()) {
3791         Say(pointeeName,
3792             "'%s' cannot be a Cray pointee as it is use-associated"_err_en_US);
3793         continue;
3794       } else if (!ConvertToObjectEntity(pointee) || IsNamedConstant(pointee)) {
3795         Say(pointeeName, "'%s' is not a variable"_err_en_US);
3796         continue;
3797       } else if (pointee.test(Symbol::Flag::CrayPointer)) {
3798         Say(pointeeName,
3799             "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
3800       } else if (pointee.test(Symbol::Flag::CrayPointee)) {
3801         Say(pointeeName,
3802             "'%s' was already declared as a Cray pointee"_err_en_US);
3803       } else {
3804         pointee.set(Symbol::Flag::CrayPointee);
3805       }
3806       if (const auto *pointeeType{pointee.GetType()}) {
3807         if (const auto *derived{pointeeType->AsDerived()}) {
3808           if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
3809             Say(pointeeName,
3810                 "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US);
3811           }
3812         }
3813       }
3814       // process the pointee array-spec, if present
3815       BeginArraySpec();
3816       Walk(std::get<std::optional<parser::ArraySpec>>(bp.t));
3817       const auto &spec{arraySpec()};
3818       if (!spec.empty()) {
3819         auto &details{pointee.get<ObjectEntityDetails>()};
3820         if (details.shape().empty()) {
3821           details.set_shape(spec);
3822         } else {
3823           SayWithDecl(pointeeName, pointee,
3824               "Array spec was already declared for '%s'"_err_en_US);
3825         }
3826       }
3827       ClearArraySpec();
3828       currScope().add_crayPointer(pointeeName.source, *pointer);
3829     }
3830   }
3831   return false;
3832 }
3833
3834 bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
3835   if (!CheckNotInBlock("NAMELIST")) {  // C1107
3836     return false;
3837   }
3838
3839   NamelistDetails details;
3840   for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
3841     auto *symbol{FindSymbol(name)};
3842     if (!symbol) {
3843       symbol = &MakeSymbol(name, ObjectEntityDetails{});
3844       ApplyImplicitRules(*symbol);
3845     } else if (!ConvertToObjectEntity(*symbol)) {
3846       SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
3847     }
3848     details.add_object(*symbol);
3849   }
3850
3851   const auto &groupName{std::get<parser::Name>(x.t)};
3852   auto *groupSymbol{FindInScope(currScope(), groupName)};
3853   if (!groupSymbol) {
3854     groupSymbol = &MakeSymbol(groupName, std::move(details));
3855   } else if (groupSymbol->has<NamelistDetails>()) {
3856     groupSymbol->get<NamelistDetails>().add_objects(details.objects());
3857   } else {
3858     SayAlreadyDeclared(groupName, *groupSymbol);
3859   }
3860   return false;
3861 }
3862
3863 bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {
3864   if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
3865     auto *symbol{FindSymbol(*name)};
3866     if (!symbol) {
3867       Say(*name, "Namelist group '%s' not found"_err_en_US);
3868     } else if (!symbol->GetUltimate().has<NamelistDetails>()) {
3869       SayWithDecl(
3870           *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
3871     }
3872   }
3873   return true;
3874 }
3875
3876 bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {
3877   CheckNotInBlock("COMMON");  // C1107
3878   const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
3879   parser::Name blankCommon;
3880   blankCommon.source =
3881       SourceName{currStmtSource().value().begin(), std::size_t{0}};
3882   CHECK(!commonBlockInfo_.curr);
3883   commonBlockInfo_.curr =
3884       &MakeCommonBlockSymbol(optName ? *optName : blankCommon);
3885   return true;
3886 }
3887
3888 void DeclarationVisitor::Post(const parser::CommonStmt::Block &) {
3889   commonBlockInfo_.curr = nullptr;
3890 }
3891
3892 bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {
3893   BeginArraySpec();
3894   return true;
3895 }
3896
3897 void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {
3898   CHECK(commonBlockInfo_.curr);
3899   const auto &name{std::get<parser::Name>(x.t)};
3900   auto &symbol{DeclareObjectEntity(name, Attrs{})};
3901   ClearArraySpec();
3902   ClearCoarraySpec();
3903   auto *details{symbol.detailsIf<ObjectEntityDetails>()};
3904   if (!details) {
3905     return;  // error was reported
3906   }
3907   commonBlockInfo_.curr->get<CommonBlockDetails>().add_object(symbol);
3908   auto pair{commonBlockInfo_.names.insert(name.source)};
3909   if (!pair.second) {
3910     const SourceName &prev{*pair.first};
3911     Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,
3912         "Previous occurrence of '%s' in a COMMON block"_en_US);
3913     return;
3914   }
3915   details->set_commonBlock(*commonBlockInfo_.curr);
3916 }
3917
3918 bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {
3919   // save equivalence sets to be processed after specification part
3920   CheckNotInBlock("EQUIVALENCE");  // C1107
3921   for (const std::list<parser::EquivalenceObject> &set : x.v) {
3922     equivalenceSets_.push_back(&set);
3923   }
3924   return false;  // don't implicitly declare names yet
3925 }
3926
3927 void DeclarationVisitor::CheckEquivalenceSets() {
3928   EquivalenceSets equivSets{context()};
3929   for (const auto *set : equivalenceSets_) {
3930     const auto &source{set->front().v.value().source};
3931     if (set->size() <= 1) {  // R871
3932       Say(source, "Equivalence set must have more than one object"_err_en_US);
3933     }
3934     for (const parser::EquivalenceObject &object : *set) {
3935       const auto &designator{object.v.value()};
3936       // The designator was not resolved when it was encountered so do it now.
3937       // AnalyzeExpr causes array sections to be changed to substrings as needed
3938       Walk(designator);
3939       if (AnalyzeExpr(context(), designator)) {
3940         equivSets.AddToSet(designator);
3941       }
3942     }
3943     equivSets.FinishSet(source);
3944   }
3945   for (auto &set : equivSets.sets()) {
3946     if (!set.empty()) {
3947       currScope().add_equivalenceSet(std::move(set));
3948     }
3949   }
3950   equivalenceSets_.clear();
3951 }
3952
3953 bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {
3954   if (x.v.empty()) {
3955     saveInfo_.saveAll = currStmtSource();
3956   } else {
3957     for (const parser::SavedEntity &y : x.v) {
3958       auto kind{std::get<parser::SavedEntity::Kind>(y.t)};
3959       const auto &name{std::get<parser::Name>(y.t)};
3960       if (kind == parser::SavedEntity::Kind::Common) {
3961         MakeCommonBlockSymbol(name);
3962         AddSaveName(saveInfo_.commons, name.source);
3963       } else {
3964         HandleAttributeStmt(Attr::SAVE, name);
3965       }
3966     }
3967   }
3968   return false;
3969 }
3970
3971 void DeclarationVisitor::CheckSaveStmts() {
3972   for (const SourceName &name : saveInfo_.entities) {
3973     auto *symbol{FindInScope(currScope(), name)};
3974     if (!symbol) {
3975       // error was reported
3976     } else if (saveInfo_.saveAll) {
3977       // C889 - note that pgi, ifort, xlf do not enforce this constraint
3978       Say2(name,
3979           "Explicit SAVE of '%s' is redundant due to global SAVE statement"_err_en_US,
3980           *saveInfo_.saveAll, "Global SAVE statement"_en_US);
3981     } else if (auto msg{CheckSaveAttr(*symbol)}) {
3982       Say(name, std::move(*msg));
3983     } else {
3984       SetSaveAttr(*symbol);
3985     }
3986   }
3987   for (const SourceName &name : saveInfo_.commons) {
3988     if (auto *symbol{currScope().FindCommonBlock(name)}) {
3989       auto &objects{symbol->get<CommonBlockDetails>().objects()};
3990       if (objects.empty()) {
3991         if (currScope().kind() != Scope::Kind::Block) {
3992           Say(name,
3993               "'%s' appears as a COMMON block in a SAVE statement but not in"
3994               " a COMMON statement"_err_en_US);
3995         } else {  // C1108
3996           Say(name,
3997               "SAVE statement in BLOCK construct may not contain a"
3998               " common block name '%s'"_err_en_US);
3999         }
4000       } else {
4001         for (const Symbol &object :
4002             symbol->get<CommonBlockDetails>().objects()) {
4003           SetSaveAttr(*const_cast<Symbol *>(&object));
4004         }
4005       }
4006     }
4007   }
4008   if (saveInfo_.saveAll) {
4009     // Apply SAVE attribute to applicable symbols
4010     for (auto pair : currScope()) {
4011       auto &symbol{*pair.second};
4012       if (!CheckSaveAttr(symbol)) {
4013         SetSaveAttr(symbol);
4014       }
4015     }
4016   }
4017   saveInfo_ = {};
4018 }
4019
4020 // If SAVE attribute can't be set on symbol, return error message.
4021 std::optional<MessageFixedText> DeclarationVisitor::CheckSaveAttr(
4022     const Symbol &symbol) {
4023   if (symbol.IsDummy()) {
4024     return "SAVE attribute may not be applied to dummy argument '%s'"_err_en_US;
4025   } else if (symbol.IsFuncResult()) {
4026     return "SAVE attribute may not be applied to function result '%s'"_err_en_US;
4027   } else if (symbol.has<ProcEntityDetails>() &&
4028       !symbol.attrs().test(Attr::POINTER)) {
4029     return "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US;
4030   } else {
4031     return std::nullopt;
4032   }
4033 }
4034
4035 // Instead of setting SAVE attribute, record the name in saveInfo_.entities.
4036 Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) {
4037   if (attrs.test(Attr::SAVE)) {
4038     attrs.set(Attr::SAVE, false);
4039     AddSaveName(saveInfo_.entities, name);
4040   }
4041   return attrs;
4042 }
4043
4044 // Record a name in a set of those to be saved.
4045 void DeclarationVisitor::AddSaveName(
4046     std::set<SourceName> &set, const SourceName &name) {
4047   auto pair{set.insert(name)};
4048   if (!pair.second) {
4049     Say2(name, "SAVE attribute was already specified on '%s'"_err_en_US,
4050         *pair.first, "Previous specification of SAVE attribute"_en_US);
4051   }
4052 }
4053
4054 // Set the SAVE attribute on symbol unless it is implicitly saved anyway.
4055 void DeclarationVisitor::SetSaveAttr(Symbol &symbol) {
4056   if (!IsSaved(symbol)) {
4057     symbol.attrs().set(Attr::SAVE);
4058   }
4059 }
4060
4061 // Check types of common block objects, now that they are known.
4062 void DeclarationVisitor::CheckCommonBlocks() {
4063   // check for empty common blocks
4064   for (const auto pair : currScope().commonBlocks()) {
4065     const auto &symbol{*pair.second};
4066     if (symbol.get<CommonBlockDetails>().objects().empty() &&
4067         symbol.attrs().test(Attr::BIND_C)) {
4068       Say(symbol.name(),
4069           "'%s' appears as a COMMON block in a BIND statement but not in"
4070           " a COMMON statement"_err_en_US);
4071     }
4072   }
4073   // check objects in common blocks
4074   for (const auto &name : commonBlockInfo_.names) {
4075     const auto *symbol{currScope().FindSymbol(name)};
4076     if (!symbol) {
4077       continue;
4078     }
4079     const auto &attrs{symbol->attrs()};
4080     if (attrs.test(Attr::ALLOCATABLE)) {
4081       Say(name,
4082           "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
4083     } else if (attrs.test(Attr::BIND_C)) {
4084       Say(name,
4085           "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
4086     } else if (symbol->IsDummy()) {
4087       Say(name,
4088           "Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
4089     } else if (symbol->IsFuncResult()) {
4090       Say(name,
4091           "Function result '%s' may not appear in a COMMON block"_err_en_US);
4092     } else if (const DeclTypeSpec * type{symbol->GetType()}) {
4093       if (type->category() == DeclTypeSpec::ClassStar) {
4094         Say(name,
4095             "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US);
4096       } else if (const auto *derived{type->AsDerived()}) {
4097         auto &typeSymbol{derived->typeSymbol()};
4098         if (!typeSymbol.attrs().test(Attr::BIND_C) &&
4099             !typeSymbol.get<DerivedTypeDetails>().sequence()) {
4100           Say(name,
4101               "Derived type '%s' in COMMON block must have the BIND or"
4102               " SEQUENCE attribute"_err_en_US);
4103         }
4104         CheckCommonBlockDerivedType(name, typeSymbol);
4105       }
4106     }
4107   }
4108   commonBlockInfo_ = {};
4109 }
4110
4111 Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
4112   return Resolve(name, currScope().MakeCommonBlock(name.source));
4113 }
4114
4115 bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
4116   return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
4117 }
4118
4119 // Check if this derived type can be in a COMMON block.
4120 void DeclarationVisitor::CheckCommonBlockDerivedType(
4121     const SourceName &name, const Symbol &typeSymbol) {
4122   if (const auto *scope{typeSymbol.scope()}) {
4123     for (const auto &pair : *scope) {
4124       const Symbol &component{*pair.second};
4125       if (component.attrs().test(Attr::ALLOCATABLE)) {
4126         Say2(name,
4127             "Derived type variable '%s' may not appear in a COMMON block"
4128             " due to ALLOCATABLE component"_err_en_US,
4129             component.name(), "Component with ALLOCATABLE attribute"_en_US);
4130         return;
4131       }
4132       if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
4133         if (details->init()) {
4134           Say2(name,
4135               "Derived type variable '%s' may not appear in a COMMON block"
4136               " due to component with default initialization"_err_en_US,
4137               component.name(), "Component with default initialization"_en_US);
4138           return;
4139         }
4140         if (const auto *type{details->type()}) {
4141           if (const auto *derived{type->AsDerived()}) {
4142             CheckCommonBlockDerivedType(name, derived->typeSymbol());
4143           }
4144         }
4145       }
4146     }
4147   }
4148 }
4149
4150 bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
4151     const parser::Name &name) {
4152   if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
4153           name.source.ToString())}) {
4154     // Unrestricted specific intrinsic function names (e.g., "cos")
4155     // are acceptable as procedure interfaces.
4156     Symbol &symbol{
4157         MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
4158     if (interface->IsElemental()) {
4159       symbol.attrs().set(Attr::ELEMENTAL);
4160     }
4161     symbol.set_details(ProcEntityDetails{});
4162     Resolve(name, symbol);
4163     return true;
4164   } else {
4165     return false;
4166   }
4167 }
4168
4169 // Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED
4170 bool DeclarationVisitor::PassesSharedLocalityChecks(
4171     const parser::Name &name, Symbol &symbol) {
4172   if (!IsVariableName(symbol)) {
4173     SayLocalMustBeVariable(name, symbol);  // C1124
4174     return false;
4175   }
4176   if (symbol.owner() == currScope()) {  // C1125 and C1126
4177     SayAlreadyDeclared(name, symbol);
4178     return false;
4179   }
4180   return true;
4181 }
4182
4183 // Checks for locality-specs LOCAL and LOCAL_INIT
4184 bool DeclarationVisitor::PassesLocalityChecks(
4185     const parser::Name &name, Symbol &symbol) {
4186   if (IsAllocatable(symbol)) {  // C1128
4187     SayWithDecl(name, symbol,
4188         "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US);
4189     return false;
4190   }
4191   if (IsOptional(symbol)) {  // C1128
4192     SayWithDecl(name, symbol,
4193         "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
4194     return false;
4195   }
4196   if (IsIntentIn(symbol)) {  // C1128
4197     SayWithDecl(name, symbol,
4198         "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
4199     return false;
4200   }
4201   if (IsFinalizable(symbol)) {  // C1128
4202     SayWithDecl(name, symbol,
4203         "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
4204     return false;
4205   }
4206   if (IsCoarray(symbol)) {  // C1128
4207     SayWithDecl(
4208         name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US);
4209     return false;
4210   }
4211   if (const DeclTypeSpec * type{symbol.GetType()}) {
4212     if (type->IsPolymorphic() && symbol.IsDummy() &&
4213         !IsPointer(symbol)) {  // C1128
4214       SayWithDecl(name, symbol,
4215           "Nonpointer polymorphic argument '%s' not allowed in a "
4216           "locality-spec"_err_en_US);
4217       return false;
4218     }
4219   }
4220   if (IsAssumedSizeArray(symbol)) {  // C1128
4221     SayWithDecl(name, symbol,
4222         "Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
4223     return false;
4224   }
4225   if (std::optional<MessageFixedText> msg{
4226           WhyNotModifiable(symbol, currScope())}) {
4227     SayWithReason(name, symbol,
4228         "'%s' may not appear in a locality-spec because it is not "
4229         "definable"_err_en_US,
4230         std::move(*msg));
4231     return false;
4232   }
4233   return PassesSharedLocalityChecks(name, symbol);
4234 }
4235
4236 Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
4237     const parser::Name &name) {
4238   Symbol *prev{FindSymbol(name)};
4239   if (!prev) {
4240     // Declare the name as an object in the enclosing scope so that
4241     // the name can't be repurposed there later as something else.
4242     prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
4243     ConvertToObjectEntity(*prev);
4244     ApplyImplicitRules(*prev);
4245   }
4246   return *prev;
4247 }
4248
4249 Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
4250   Symbol &prev{FindOrDeclareEnclosingEntity(name)};
4251   if (!PassesLocalityChecks(name, prev)) {
4252     return nullptr;
4253   }
4254   name.symbol = nullptr;
4255   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
4256   if (auto *type{prev.GetType()}) {
4257     symbol.SetType(*type);
4258     symbol.set(Symbol::Flag::Implicit, prev.test(Symbol::Flag::Implicit));
4259   }
4260   return &symbol;
4261 }
4262
4263 Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
4264     const std::optional<parser::IntegerTypeSpec> &type) {
4265   const DeclTypeSpec *declTypeSpec{nullptr};
4266   if (auto *prev{FindSymbol(name)}) {
4267     if (prev->owner() == currScope()) {
4268       SayAlreadyDeclared(name, *prev);
4269       return nullptr;
4270     }
4271     name.symbol = nullptr;
4272     declTypeSpec = prev->GetType();
4273   }
4274   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
4275   if (!symbol.has<ObjectEntityDetails>()) {
4276     return nullptr;  // error was reported in DeclareEntity
4277   }
4278   if (type) {
4279     declTypeSpec = ProcessTypeSpec(*type);
4280   }
4281   if (declTypeSpec) {
4282     // Subtlety: Don't let a "*length" specifier (if any is pending) affect the
4283     // declaration of this implied DO loop control variable.
4284     auto restorer{
4285         common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};
4286     SetType(name, *declTypeSpec);
4287   } else {
4288     ApplyImplicitRules(symbol);
4289   }
4290   return Resolve(name, &symbol);
4291 }
4292
4293 // Set the type of an entity or report an error.
4294 void DeclarationVisitor::SetType(
4295     const parser::Name &name, const DeclTypeSpec &type) {
4296   CHECK(name.symbol);
4297   auto &symbol{*name.symbol};
4298   if (charInfo_.length) {  // Declaration has "*length" (R723)
4299     auto length{std::move(*charInfo_.length)};
4300     charInfo_.length.reset();
4301     if (type.category() == DeclTypeSpec::Character) {
4302       auto kind{type.characterTypeSpec().kind()};
4303       // Recurse with correct type.
4304       SetType(name,
4305           currScope().MakeCharacterType(std::move(length), std::move(kind)));
4306       return;
4307     } else {
4308       Say(name,
4309           "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
4310     }
4311   }
4312   auto *prevType{symbol.GetType()};
4313   if (!prevType) {
4314     symbol.SetType(type);
4315   } else if (symbol.has<UseDetails>()) {
4316     // error recovery case, redeclaration of use-associated name
4317   } else if (!symbol.test(Symbol::Flag::Implicit)) {
4318     SayWithDecl(
4319         name, symbol, "The type of '%s' has already been declared"_err_en_US);
4320   } else if (type != *prevType) {
4321     SayWithDecl(name, symbol,
4322         "The type of '%s' has already been implicitly declared"_err_en_US);
4323   } else {
4324     symbol.set(Symbol::Flag::Implicit, false);
4325   }
4326 }
4327
4328 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
4329     const parser::Name &name) {
4330   Symbol *symbol{FindSymbol(name)};
4331   if (!symbol || symbol->has<UnknownDetails>()) {
4332     if (allowForwardReferenceToDerivedType()) {
4333       if (!symbol) {
4334         symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
4335         Resolve(name, *symbol);
4336       };
4337       DerivedTypeDetails details;
4338       details.set_isForwardReferenced();
4339       symbol->set_details(std::move(details));
4340     } else {
4341       Say(name, "Derived type '%s' not found"_err_en_US);
4342       return std::nullopt;
4343     }
4344   }
4345   if (CheckUseError(name)) {
4346     return std::nullopt;
4347   }
4348   symbol = &symbol->GetUltimate();
4349   if (auto *details{symbol->detailsIf<GenericDetails>()}) {
4350     if (details->derivedType()) {
4351       symbol = details->derivedType();
4352     }
4353   }
4354   if (symbol->has<DerivedTypeDetails>()) {
4355     return DerivedTypeSpec{name.source, *symbol};
4356   } else {
4357     Say(name, "'%s' is not a derived type"_err_en_US);
4358     return std::nullopt;
4359   }
4360 }
4361
4362 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
4363     const parser::Name &typeName, const parser::Name *extendsName) {
4364   if (!extendsName) {
4365     return std::nullopt;
4366   } else if (typeName.source == extendsName->source) {
4367     Say(extendsName->source,
4368         "Derived type '%s' cannot extend itself"_err_en_US);
4369     return std::nullopt;
4370   } else {
4371     return ResolveDerivedType(*extendsName);
4372   }
4373 }
4374
4375 Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
4376   // The symbol is checked later by CheckExplicitInterface() and
4377   // CheckBindings().  It can be a forward reference.
4378   if (!NameIsKnownOrIntrinsic(name)) {
4379     Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
4380     Resolve(name, symbol);
4381   }
4382   return name.symbol;
4383 }
4384
4385 void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
4386   if (const Symbol * symbol{name.symbol}) {
4387     if (!symbol->HasExplicitInterface()) {
4388       Say(name,
4389           "'%s' must be an abstract interface or a procedure with "
4390           "an explicit interface"_err_en_US,
4391           symbol->name());
4392     }
4393   }
4394 }
4395
4396 // Create a symbol for a type parameter, component, or procedure binding in
4397 // the current derived type scope. Return false on error.
4398 Symbol *DeclarationVisitor::MakeTypeSymbol(
4399     const parser::Name &name, Details &&details) {
4400   return Resolve(name, MakeTypeSymbol(name.source, std::move(details)));
4401 }
4402 Symbol *DeclarationVisitor::MakeTypeSymbol(
4403     const SourceName &name, Details &&details) {
4404   Scope &derivedType{currScope()};
4405   CHECK(derivedType.IsDerivedType());
4406   if (auto *symbol{FindInScope(derivedType, name)}) {
4407     Say2(name,
4408         "Type parameter, component, or procedure binding '%s'"
4409         " already defined in this type"_err_en_US,
4410         *symbol, "Previous definition of '%s'"_en_US);
4411     return nullptr;
4412   } else {
4413     auto attrs{GetAttrs()};
4414     // Apply binding-private-stmt if present and this is a procedure binding
4415     if (derivedTypeInfo_.privateBindings &&
4416         !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
4417         std::holds_alternative<ProcBindingDetails>(details)) {
4418       attrs.set(Attr::PRIVATE);
4419     }
4420     Symbol &result{MakeSymbol(name, attrs, std::move(details))};
4421     if (result.has<TypeParamDetails>()) {
4422       derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result);
4423     }
4424     return &result;
4425   }
4426 }
4427
4428 // Return true if it is ok to declare this component in the current scope.
4429 // Otherwise, emit an error and return false.
4430 bool DeclarationVisitor::OkToAddComponent(
4431     const parser::Name &name, const Symbol *extends) {
4432   for (const Scope *scope{&currScope()}; scope;) {
4433     CHECK(scope->IsDerivedType());
4434     if (auto *prev{FindInScope(*scope, name)}) {
4435       auto msg{""_en_US};
4436       if (extends) {
4437         msg = "Type cannot be extended as it has a component named"
4438               " '%s'"_err_en_US;
4439       } else if (prev->test(Symbol::Flag::ParentComp)) {
4440         msg = "'%s' is a parent type of this type and so cannot be"
4441               " a component"_err_en_US;
4442       } else if (scope != &currScope()) {
4443         msg = "Component '%s' is already declared in a parent of this"
4444               " derived type"_err_en_US;
4445       } else {
4446         msg = "Component '%s' is already declared in this"
4447               " derived type"_err_en_US;
4448       }
4449       Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US);
4450       return false;
4451     }
4452     if (scope == &currScope() && extends) {
4453       // The parent component has not yet been added to the scope.
4454       scope = extends->scope();
4455     } else {
4456       scope = scope->GetDerivedTypeParent();
4457     }
4458   }
4459   return true;
4460 }
4461
4462 ParamValue DeclarationVisitor::GetParamValue(
4463     const parser::TypeParamValue &x, common::TypeParamAttr attr) {
4464   return std::visit(
4465       common::visitors{
4466           [=](const parser::ScalarIntExpr &x) {
4467             return ParamValue{EvaluateIntExpr(x), attr};
4468           },
4469           [=](const parser::Star &) { return ParamValue::Assumed(attr); },
4470           [=](const parser::TypeParamValue::Deferred &) {
4471             return ParamValue::Deferred(attr);
4472           },
4473       },
4474       x.u);
4475 }
4476
4477 // ConstructVisitor implementation
4478
4479 void ConstructVisitor::ResolveIndexName(
4480     const parser::ConcurrentControl &control) {
4481   const parser::Name &name{std::get<parser::Name>(control.t)};
4482   auto *prev{FindSymbol(name)};
4483   if (prev) {
4484     if (prev->owner().kind() == Scope::Kind::Forall ||
4485         prev->owner() == currScope()) {
4486       SayAlreadyDeclared(name, *prev);
4487       return;
4488     }
4489     name.symbol = nullptr;
4490   }
4491   auto &symbol{DeclareObjectEntity(name, {})};
4492
4493   if (symbol.GetType()) {
4494     // type came from explicit type-spec
4495   } else if (!prev) {
4496     ApplyImplicitRules(symbol);
4497   } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) {
4498     Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US,
4499         *prev, "Previous declaration of '%s'"_en_US);
4500     return;
4501   } else {
4502     if (const auto *type{prev->GetType()}) {
4503       symbol.SetType(*type);
4504     }
4505     if (prev->IsObjectArray()) {
4506       SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US);
4507       return;
4508     }
4509   }
4510   EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
4511 }
4512
4513 // We need to make sure that all of the index-names get declared before the
4514 // expressions in the loop control are evaluated so that references to the
4515 // index-names in the expressions are correctly detected.
4516 bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
4517   BeginDeclTypeSpec();
4518   Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t));
4519   const auto &controls{
4520       std::get<std::list<parser::ConcurrentControl>>(header.t)};
4521   for (const auto &control : controls) {
4522     ResolveIndexName(control);
4523   }
4524   Walk(controls);
4525   Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t));
4526   EndDeclTypeSpec();
4527   return false;
4528 }
4529
4530 bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
4531   for (auto &name : x.v) {
4532     if (auto *symbol{DeclareLocalEntity(name)}) {
4533       symbol->set(Symbol::Flag::LocalityLocal);
4534     }
4535   }
4536   return false;
4537 }
4538
4539 bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
4540   for (auto &name : x.v) {
4541     if (auto *symbol{DeclareLocalEntity(name)}) {
4542       symbol->set(Symbol::Flag::LocalityLocalInit);
4543     }
4544   }
4545   return false;
4546 }
4547
4548 bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
4549   for (const auto &name : x.v) {
4550     if (!FindSymbol(name)) {
4551       Say(name, "Variable '%s' with SHARED locality implicitly declared"_en_US);
4552     }
4553     Symbol &prev{FindOrDeclareEnclosingEntity(name)};
4554     if (PassesSharedLocalityChecks(name, prev)) {
4555       auto &symbol{MakeSymbol(name, HostAssocDetails{prev})};
4556       symbol.set(Symbol::Flag::LocalityShared);
4557       name.symbol = &symbol;  // override resolution to parent
4558     }
4559   }
4560   return false;
4561 }
4562
4563 bool ConstructVisitor::Pre(const parser::AcSpec &x) {
4564   ProcessTypeSpec(x.type);
4565   PushScope(Scope::Kind::ImpliedDos, nullptr);
4566   Walk(x.values);
4567   PopScope();
4568   return false;
4569 }
4570
4571 bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
4572   auto &values{std::get<std::list<parser::AcValue>>(x.t)};
4573   auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
4574   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
4575   auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
4576   DeclareStatementEntity(bounds.name.thing.thing, type);
4577   Walk(bounds);
4578   Walk(values);
4579   return false;
4580 }
4581
4582 bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
4583   auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
4584   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
4585   auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
4586   DeclareStatementEntity(bounds.name.thing.thing, type);
4587   Walk(bounds);
4588   Walk(objects);
4589   return false;
4590 }
4591
4592 bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
4593   std::visit(
4594       common::visitors{
4595           [&](const Indirection<parser::Variable> &y) {
4596             Walk(y.value());
4597             if (const auto *designator{
4598                     std::get_if<Indirection<parser::Designator>>(
4599                         &y.value().u)}) {
4600               if (const parser::Name *
4601                   name{ResolveDesignator(designator->value())}) {
4602                 if (name->symbol) {
4603                   name->symbol->set(Symbol::Flag::InDataStmt);
4604                 }
4605               }
4606               // TODO check C874 - C881
4607             } else {
4608               // TODO report C875 error: variable is not a designator here?
4609             }
4610           },
4611           [&](const parser::DataImpliedDo &y) {
4612             PushScope(Scope::Kind::ImpliedDos, nullptr);
4613             Walk(y);
4614             PopScope();
4615           },
4616       },
4617       x.u);
4618   return false;
4619 }
4620
4621 bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
4622   if (x.IsDoConcurrent()) {
4623     PushScope(Scope::Kind::Block, nullptr);
4624   }
4625   return true;
4626 }
4627 void ConstructVisitor::Post(const parser::DoConstruct &x) {
4628   if (x.IsDoConcurrent()) {
4629     PopScope();
4630   }
4631 }
4632
4633 bool ConstructVisitor::Pre(const parser::ForallConstruct &) {
4634   PushScope(Scope::Kind::Forall, nullptr);
4635   return true;
4636 }
4637 void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }
4638 bool ConstructVisitor::Pre(const parser::ForallStmt &) {
4639   PushScope(Scope::Kind::Forall, nullptr);
4640   return true;
4641 }
4642 void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }
4643
4644 bool ConstructVisitor::Pre(const parser::BlockStmt &x) {
4645   CheckDef(x.v);
4646   PushScope(Scope::Kind::Block, nullptr);
4647   return false;
4648 }
4649 bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) {
4650   PopScope();
4651   CheckRef(x.v);
4652   return false;
4653 }
4654
4655 void ConstructVisitor::Post(const parser::Selector &x) {
4656   GetCurrentAssociation().selector = ResolveSelector(x);
4657 }
4658
4659 bool ConstructVisitor::Pre(const parser::AssociateStmt &x) {
4660   CheckDef(x.t);
4661   PushScope(Scope::Kind::Block, nullptr);
4662   PushAssociation();
4663   return true;
4664 }
4665 void ConstructVisitor::Post(const parser::EndAssociateStmt &x) {
4666   PopAssociation();
4667   PopScope();
4668   CheckRef(x.v);
4669 }
4670
4671 void ConstructVisitor::Post(const parser::Association &x) {
4672   const auto &name{std::get<parser::Name>(x.t)};
4673   GetCurrentAssociation().name = &name;
4674   if (auto *symbol{MakeAssocEntity()}) {
4675     SetTypeFromAssociation(*symbol);
4676     SetAttrsFromAssociation(*symbol);
4677   }
4678   GetCurrentAssociation() = {};  // clean for further parser::Association.
4679 }
4680
4681 bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) {
4682   CheckDef(x.t);
4683   PushScope(Scope::Kind::Block, nullptr);
4684   PushAssociation();
4685   return true;
4686 }
4687
4688 void ConstructVisitor::Post(const parser::CoarrayAssociation &x) {
4689   const auto &decl{std::get<parser::CodimensionDecl>(x.t)};
4690   const auto &name{std::get<parser::Name>(decl.t)};
4691   if (auto *symbol{FindInScope(currScope(), name)}) {
4692     const auto &selector{std::get<parser::Selector>(x.t)};
4693     if (auto sel{ResolveSelector(selector)}) {
4694       const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)};
4695       if (!whole || whole->Corank() == 0) {
4696         Say(sel.source,  // C1116
4697             "Selector in coarray association must name a coarray"_err_en_US);
4698       } else if (auto dynType{sel.expr->GetType()}) {
4699         if (!symbol->GetType()) {
4700           symbol->SetType(ToDeclTypeSpec(std::move(*dynType)));
4701         }
4702       }
4703     }
4704   }
4705 }
4706
4707 void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) {
4708   PopAssociation();
4709   PopScope();
4710   CheckRef(x.t);
4711 }
4712
4713 bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) {
4714   PushAssociation();
4715   return true;
4716 }
4717
4718 void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {
4719   PopAssociation();
4720 }
4721
4722 void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
4723   auto &association{GetCurrentAssociation()};
4724   if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
4725     // This isn't a name in the current scope, it is in each TypeGuardStmt
4726     MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);
4727     association.name = &*name;
4728   } else {
4729     if (const Symbol *
4730         whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
4731       ConvertToObjectEntity(const_cast<Symbol &>(*whole));
4732       if (!IsVariableName(*whole)) {
4733         Say(association.selector.source,  // C901
4734             "Selector is not a variable"_err_en_US);
4735         association = {};
4736       }
4737     } else {
4738       Say(association.selector.source,  // C1157
4739           "Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
4740       association = {};
4741     }
4742   }
4743 }
4744
4745 bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {
4746   PushScope(Scope::Kind::Block, nullptr);
4747   return true;
4748 }
4749 void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {
4750   PopScope();
4751 }
4752
4753 void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
4754   if (auto *symbol{MakeAssocEntity()}) {
4755     if (std::holds_alternative<parser::Default>(x.u)) {
4756       SetTypeFromAssociation(*symbol);
4757     } else if (const auto *type{GetDeclTypeSpec()}) {
4758       symbol->SetType(*type);
4759     }
4760     SetAttrsFromAssociation(*symbol);
4761   }
4762 }
4763
4764 bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
4765   PushAssociation();
4766   return true;
4767 }
4768
4769 void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
4770   PopAssociation();
4771 }
4772
4773 bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
4774   if (x) {
4775     MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
4776   }
4777   return true;
4778 }
4779
4780 void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
4781   if (x) {
4782     // Just add an occurrence of this name; checking is done in ValidateLabels
4783     FindSymbol(*x);
4784   }
4785 }
4786
4787 // Make a symbol representing an associating entity from current association.
4788 Symbol *ConstructVisitor::MakeAssocEntity() {
4789   Symbol *symbol{nullptr};
4790   auto &association{GetCurrentAssociation()};
4791   if (association.name) {
4792     symbol = &MakeSymbol(*association.name, UnknownDetails{});
4793     if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) {
4794       Say(*association.name,  // C1104
4795           "The associate name '%s' is already used in this associate statement"_err_en_US);
4796       return nullptr;
4797     }
4798   } else if (const Symbol *
4799       whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
4800     symbol = &MakeSymbol(whole->name());
4801   } else {
4802     return nullptr;
4803   }
4804   if (auto &expr{association.selector.expr}) {
4805     symbol->set_details(AssocEntityDetails{common::Clone(*expr)});
4806   } else {
4807     symbol->set_details(AssocEntityDetails{});
4808   }
4809   return symbol;
4810 }
4811
4812 // Set the type of symbol based on the current association selector.
4813 void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {
4814   auto &details{symbol.get<AssocEntityDetails>()};
4815   const MaybeExpr *pexpr{&details.expr()};
4816   if (!*pexpr) {
4817     pexpr = &GetCurrentAssociation().selector.expr;
4818   }
4819   if (*pexpr) {
4820     const SomeExpr &expr{**pexpr};
4821     if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {
4822       if (const auto *charExpr{
4823               evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>(
4824                   expr)}) {
4825         symbol.SetType(ToDeclTypeSpec(std::move(*type),
4826             FoldExpr(
4827                 std::visit([](const auto &kindChar) { return kindChar.LEN(); },
4828                     charExpr->u))));
4829       } else {
4830         symbol.SetType(ToDeclTypeSpec(std::move(*type)));
4831       }
4832     } else {
4833       // BOZ literals, procedure designators, &c. are not acceptable
4834       Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);
4835     }
4836   }
4837 }
4838
4839 // If current selector is a variable, set some of its attributes on symbol.
4840 void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
4841   Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
4842   symbol.attrs() |= attrs &
4843       Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::CONTIGUOUS};
4844   if (attrs.test(Attr::POINTER)) {
4845     symbol.attrs().set(Attr::TARGET);
4846   }
4847 }
4848
4849 ConstructVisitor::Selector ConstructVisitor::ResolveSelector(
4850     const parser::Selector &x) {
4851   return std::visit(
4852       common::visitors{
4853           [&](const parser::Expr &expr) {
4854             return Selector{expr.source, EvaluateExpr(expr)};
4855           },
4856           [&](const parser::Variable &var) {
4857             return Selector{var.GetSource(), EvaluateExpr(var)};
4858           },
4859       },
4860       x.u);
4861 }
4862
4863 ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() {
4864   CHECK(!associationStack_.empty());
4865   return associationStack_.back();
4866 }
4867
4868 void ConstructVisitor::PushAssociation() {
4869   associationStack_.emplace_back(Association{});
4870 }
4871
4872 void ConstructVisitor::PopAssociation() {
4873   CHECK(!associationStack_.empty());
4874   associationStack_.pop_back();
4875 }
4876
4877 const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
4878     evaluate::DynamicType &&type) {
4879   switch (type.category()) {
4880     SWITCH_COVERS_ALL_CASES
4881   case common::TypeCategory::Integer:
4882   case common::TypeCategory::Real:
4883   case common::TypeCategory::Complex:
4884     return context().MakeNumericType(type.category(), type.kind());
4885   case common::TypeCategory::Logical:
4886     return context().MakeLogicalType(type.kind());
4887   case common::TypeCategory::Derived:
4888     if (type.IsAssumedType()) {
4889       return currScope().MakeTypeStarType();
4890     } else if (type.IsUnlimitedPolymorphic()) {
4891       return currScope().MakeClassStarType();
4892     } else {
4893       return currScope().MakeDerivedType(
4894           type.IsPolymorphic() ? DeclTypeSpec::ClassDerived
4895                                : DeclTypeSpec::TypeDerived,
4896           common::Clone(type.GetDerivedTypeSpec())
4897
4898       );
4899     }
4900   case common::TypeCategory::Character: CRASH_NO_CASE;
4901   }
4902 }
4903
4904 const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
4905     evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
4906   CHECK(type.category() == common::TypeCategory::Character);
4907   if (length) {
4908     return currScope().MakeCharacterType(
4909         ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},
4910         KindExpr{type.kind()});
4911   } else {
4912     return currScope().MakeCharacterType(
4913         ParamValue::Deferred(common::TypeParamAttr::Len),
4914         KindExpr{type.kind()});
4915   }
4916 }
4917
4918 // ResolveNamesVisitor implementation
4919
4920 // Ensures that bare undeclared intrinsic procedure names passed as actual
4921 // arguments get recognized as being intrinsics.
4922 bool ResolveNamesVisitor::Pre(const parser::ActualArg &arg) {
4923   if (const auto *expr{std::get_if<Indirection<parser::Expr>>(&arg.u)}) {
4924     if (const auto *designator{
4925             std::get_if<Indirection<parser::Designator>>(&expr->value().u)}) {
4926       if (const auto *dataRef{
4927               std::get_if<parser::DataRef>(&designator->value().u)}) {
4928         if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
4929           NameIsKnownOrIntrinsic(*name);
4930         }
4931       }
4932     }
4933   }
4934   return true;
4935 }
4936
4937 bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
4938   HandleCall(Symbol::Flag::Function, x.v);
4939   return false;
4940 }
4941 bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
4942   HandleCall(Symbol::Flag::Subroutine, x.v);
4943   return false;
4944 }
4945
4946 bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
4947   auto &scope{currScope()};
4948   // Check C896 and C899: where IMPORT statements are allowed
4949   switch (scope.kind()) {
4950   case Scope::Kind::Module:
4951     if (scope.IsModule()) {
4952       Say("IMPORT is not allowed in a module scoping unit"_err_en_US);
4953       return false;
4954     } else if (x.kind == common::ImportKind::None) {
4955       Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US);
4956       return false;
4957     }
4958     break;
4959   case Scope::Kind::MainProgram:
4960     Say("IMPORT is not allowed in a main program scoping unit"_err_en_US);
4961     return false;
4962   case Scope::Kind::Subprogram:
4963     if (scope.parent().IsGlobal()) {
4964       Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US);
4965       return false;
4966     }
4967     break;
4968   case Scope::Kind::BlockData:  // C1415 (in part)
4969     Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);
4970     return false;
4971   default:;
4972   }
4973   if (auto error{scope.SetImportKind(x.kind)}) {
4974     Say(std::move(*error));
4975   }
4976   for (auto &name : x.names) {
4977     if (FindSymbol(scope.parent(), name)) {
4978       scope.add_importName(name.source);
4979     } else {
4980       Say(name, "'%s' not found in host scope"_err_en_US);
4981     }
4982   }
4983   prevImportStmt_ = currStmtSource();
4984   return false;
4985 }
4986
4987 const parser::Name *DeclarationVisitor::ResolveStructureComponent(
4988     const parser::StructureComponent &x) {
4989   return FindComponent(ResolveDataRef(x.base), x.component);
4990 }
4991
4992 const parser::Name *DeclarationVisitor::ResolveDesignator(
4993     const parser::Designator &x) {
4994   return std::visit(
4995       common::visitors{
4996           [&](const parser::DataRef &x) { return ResolveDataRef(x); },
4997           [&](const parser::Substring &x) {
4998             return ResolveDataRef(std::get<parser::DataRef>(x.t));
4999           },
5000       },
5001       x.u);
5002 }
5003
5004 const parser::Name *DeclarationVisitor::ResolveDataRef(
5005     const parser::DataRef &x) {
5006   return std::visit(
5007       common::visitors{
5008           [=](const parser::Name &y) { return ResolveName(y); },
5009           [=](const Indirection<parser::StructureComponent> &y) {
5010             return ResolveStructureComponent(y.value());
5011           },
5012           [&](const Indirection<parser::ArrayElement> &y) {
5013             Walk(y.value().subscripts);
5014             return ResolveDataRef(y.value().base);
5015           },
5016           [&](const Indirection<parser::CoindexedNamedObject> &y) {
5017             Walk(y.value().imageSelector);
5018             return ResolveDataRef(y.value().base);
5019           },
5020       },
5021       x.u);
5022 }
5023
5024 const parser::Name *DeclarationVisitor::ResolveVariable(
5025     const parser::Variable &x) {
5026   return std::visit(
5027       common::visitors{
5028           [&](const Indirection<parser::Designator> &y) {
5029             return ResolveDesignator(y.value());
5030           },
5031           [&](const Indirection<parser::FunctionReference> &y) {
5032             const auto &proc{
5033                 std::get<parser::ProcedureDesignator>(y.value().v.t)};
5034             return std::visit(
5035                 common::visitors{
5036                     [&](const parser::Name &z) { return &z; },
5037                     [&](const parser::ProcComponentRef &z) {
5038                       return ResolveStructureComponent(z.v.thing);
5039                     },
5040                 },
5041                 proc.u);
5042           },
5043       },
5044       x.u);
5045 }
5046
5047 // If implicit types are allowed, ensure name is in the symbol table.
5048 // Otherwise, report an error if it hasn't been declared.
5049 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
5050   if (Symbol * symbol{FindSymbol(name)}) {
5051     if (CheckUseError(name)) {
5052       return nullptr;  // reported an error
5053     }
5054     if (symbol->IsDummy() ||
5055         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
5056       ConvertToObjectEntity(*symbol);
5057       ApplyImplicitRules(*symbol);
5058     }
5059     return &name;
5060   }
5061   if (isImplicitNoneType()) {
5062     Say(name, "No explicit type declared for '%s'"_err_en_US);
5063     return nullptr;
5064   }
5065   // Create the symbol then ensure it is accessible
5066   MakeSymbol(InclusiveScope(), name.source, Attrs{});
5067   auto *symbol{FindSymbol(name)};
5068   if (!symbol) {
5069     Say(name,
5070         "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
5071     return nullptr;
5072   }
5073   ConvertToObjectEntity(*symbol);
5074   ApplyImplicitRules(*symbol);
5075   return &name;
5076 }
5077
5078 // base is a part-ref of a derived type; find the named component in its type.
5079 // Also handles intrinsic type parameter inquiries (%kind, %len) and
5080 // COMPLEX component references (%re, %im).
5081 const parser::Name *DeclarationVisitor::FindComponent(
5082     const parser::Name *base, const parser::Name &component) {
5083   if (!base || !base->symbol) {
5084     return nullptr;
5085   }
5086   auto &symbol{base->symbol->GetUltimate()};
5087   if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) {
5088     SayWithDecl(*base, symbol,
5089         "'%s' is an invalid base for a component reference"_err_en_US);
5090     return nullptr;
5091   }
5092   auto *type{symbol.GetType()};
5093   if (!type) {
5094     return nullptr;  // should have already reported error
5095   }
5096   if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
5097     auto name{component.ToString()};
5098     auto category{intrinsic->category()};
5099     MiscDetails::Kind miscKind{MiscDetails::Kind::None};
5100     if (name == "kind") {
5101       miscKind = MiscDetails::Kind::KindParamInquiry;
5102     } else if (category == TypeCategory::Character) {
5103       if (name == "len") {
5104         miscKind = MiscDetails::Kind::LenParamInquiry;
5105       }
5106     } else if (category == TypeCategory::Complex) {
5107       if (name == "re") {
5108         miscKind = MiscDetails::Kind::ComplexPartRe;
5109       } else if (name == "im") {
5110         miscKind = MiscDetails::Kind::ComplexPartIm;
5111       }
5112     }
5113     if (miscKind != MiscDetails::Kind::None) {
5114       MakePlaceholder(component, miscKind);
5115       return nullptr;
5116     }
5117   } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
5118     if (const Scope * scope{derived->scope()}) {
5119       if (Resolve(component, scope->FindComponent(component.source))) {
5120         if (CheckAccessibleComponent(component.source, *component.symbol)) {
5121           return &component;
5122         }
5123       } else {
5124         SayDerivedType(component.source,
5125             "Component '%s' not found in derived type '%s'"_err_en_US, *scope);
5126       }
5127     }
5128     return nullptr;
5129   }
5130   if (symbol.test(Symbol::Flag::Implicit)) {
5131     Say(*base,
5132         "'%s' is not an object of derived type; it is implicitly typed"_err_en_US);
5133   } else {
5134     SayWithDecl(
5135         *base, symbol, "'%s' is not an object of derived type"_err_en_US);
5136   }
5137   return nullptr;
5138 }
5139
5140 // C764, C765
5141 void DeclarationVisitor::CheckInitialDataTarget(
5142     const Symbol &pointer, const SomeExpr &expr, SourceName source) {
5143   auto &messages{GetFoldingContext().messages()};
5144   auto restorer{messages.SetLocation(source)};
5145   if (!evaluate::IsInitialDataTarget(expr, messages)) {
5146     Say(source,
5147         "Pointer '%s' cannot be initialized with a reference to a designator with non-constant subscripts"_err_en_US,
5148         pointer.name());
5149     return;
5150   }
5151   if (pointer.Rank() != expr.Rank()) {
5152     Say(source,
5153         "Pointer '%s' of rank %d cannot be initialized with a target of different rank (%d)"_err_en_US,
5154         pointer.name(), pointer.Rank(), expr.Rank());
5155     return;
5156   }
5157   // TODO: check type compatibility
5158   // TODO: check non-deferred type parameter values
5159   // TODO: check contiguity if pointer is CONTIGUOUS
5160 }
5161
5162 void DeclarationVisitor::CheckInitialProcTarget(
5163     const Symbol &pointer, const parser::Name &target, SourceName source) {
5164   // C1519 - must be nonelemental external or module procedure,
5165   // or an unrestricted specific intrinsic function.
5166   if (const Symbol * targetSym{target.symbol}) {
5167     const Symbol &ultimate{targetSym->GetUltimate()};
5168     if (ultimate.attrs().test(Attr::INTRINSIC)) {
5169     } else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
5170         ultimate.owner().kind() != Scope::Kind::Module) {
5171       Say(source,
5172           "Procedure pointer '%s' initializer '%s' is neither "
5173           "an external nor a module procedure"_err_en_US,
5174           pointer.name(), ultimate.name());
5175     } else if (ultimate.attrs().test(Attr::ELEMENTAL)) {
5176       Say(source,
5177           "Procedure pointer '%s' cannot be initialized with the "
5178           "elemental procedure '%s"_err_en_US,
5179           pointer.name(), ultimate.name());
5180     } else {
5181       // TODO: Check the "shalls" in the 15.4.3.6 paragraphs 7-10.
5182     }
5183   }
5184 }
5185
5186 void DeclarationVisitor::Initialization(const parser::Name &name,
5187     const parser::Initialization &init, bool inComponentDecl) {
5188   if (!name.symbol) {
5189     return;
5190   }
5191   if (std::holds_alternative<parser::InitialDataTarget>(init.u)) {
5192     // Defer analysis to the end of the specification parts so that forward
5193     // references work better.
5194     return;
5195   }
5196   // Traversal of the initializer was deferred to here so that the
5197   // symbol being declared can be available for use in the expression, e.g.:
5198   //   real, parameter :: x = tiny(x)
5199   Walk(init.u);
5200   Symbol &ultimate{name.symbol->GetUltimate()};
5201   if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
5202     // TODO: check C762 - all bounds and type parameters of component
5203     // are colons or constant expressions if component is initialized
5204     bool isPointer{false};
5205     std::visit(
5206         common::visitors{
5207             [&](const parser::ConstantExpr &expr) {
5208               if (inComponentDecl) {
5209                 // Can't convert to type of component, which might not yet
5210                 // be known; that's done later during instantiation.
5211                 if (MaybeExpr value{EvaluateExpr(expr)}) {
5212                   details->set_init(std::move(*value));
5213                 }
5214               } else {
5215                 if (MaybeExpr folded{EvaluateConvertedExpr(
5216                         ultimate, expr, expr.thing.value().source)}) {
5217                   details->set_init(std::move(*folded));
5218                 }
5219               }
5220             },
5221             [&](const parser::NullInit &) {
5222               isPointer = true;
5223               details->set_init(SomeExpr{evaluate::NullPointer{}});
5224             },
5225             [&](const parser::InitialDataTarget &initExpr) {
5226               isPointer = true;
5227               if (MaybeExpr expr{EvaluateExpr(initExpr)}) {
5228                 CheckInitialDataTarget(
5229                     ultimate, *expr, initExpr.value().source);
5230                 details->set_init(std::move(*expr));
5231               }
5232             },
5233             [&](const std::list<Indirection<parser::DataStmtValue>> &) {
5234               if (inComponentDecl) {
5235                 Say(name,
5236                     "Component '%s' initialized with DATA statement values"_err_en_US);
5237               } else {
5238                 // TODO - DATA statements and DATA-like initialization extension
5239               }
5240             },
5241         },
5242         init.u);
5243     if (isPointer) {
5244       if (!IsPointer(ultimate)) {
5245         Say(name,
5246             "Non-pointer component '%s' initialized with pointer target"_err_en_US);
5247       }
5248     } else {
5249       if (IsPointer(ultimate)) {
5250         Say(name,
5251             "Object pointer component '%s' initialized with non-pointer expression"_err_en_US);
5252       } else if (IsAllocatable(ultimate)) {
5253         Say(name, "Allocatable component '%s' cannot be initialized"_err_en_US);
5254       }
5255     }
5256   }
5257 }
5258
5259 void DeclarationVisitor::PointerInitialization(
5260     const parser::Name &name, const parser::InitialDataTarget &target) {
5261   if (name.symbol) {
5262     Symbol &ultimate{name.symbol->GetUltimate()};
5263     if (IsPointer(ultimate)) {
5264       if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
5265         CHECK(!details->init());
5266         Walk(target);
5267         if (MaybeExpr expr{EvaluateExpr(target)}) {
5268           CheckInitialDataTarget(ultimate, *expr, target.value().source);
5269           details->set_init(std::move(*expr));
5270         }
5271       }
5272     } else {
5273       Say(name, "'%s' is not a pointer but is initialized like one"_err_en_US);
5274     }
5275   }
5276 }
5277 void DeclarationVisitor::PointerInitialization(
5278     const parser::Name &name, const parser::ProcPointerInit &target) {
5279   if (name.symbol) {
5280     Symbol &ultimate{name.symbol->GetUltimate()};
5281     if (IsProcedurePointer(ultimate)) {
5282       auto &details{ultimate.get<ProcEntityDetails>()};
5283       CHECK(!details.init());
5284       Walk(target);
5285       if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
5286         CheckInitialProcTarget(ultimate, *targetName, name.source);
5287         if (targetName->symbol) {
5288           details.set_init(*targetName->symbol);
5289         }
5290       } else {
5291         details.set_init(nullptr);  // explicit NULL()
5292       }
5293     } else {
5294       Say(name,
5295           "'%s' is not a procedure pointer but is initialized "
5296           "like one"_err_en_US);
5297     }
5298   }
5299 }
5300
5301 void ResolveNamesVisitor::HandleCall(
5302     Symbol::Flag procFlag, const parser::Call &call) {
5303   std::visit(
5304       common::visitors{
5305           [&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
5306           [&](const parser::ProcComponentRef &x) { Walk(x); },
5307       },
5308       std::get<parser::ProcedureDesignator>(call.t).u);
5309   Walk(std::get<std::list<parser::ActualArgSpec>>(call.t));
5310 }
5311
5312 void ResolveNamesVisitor::HandleProcedureName(
5313     Symbol::Flag flag, const parser::Name &name) {
5314   CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
5315   auto *symbol{FindSymbol(name)};
5316   if (!symbol) {
5317     if (context().intrinsics().IsIntrinsic(name.source.ToString())) {
5318       symbol =
5319           &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC});
5320     } else {
5321       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
5322     }
5323     Resolve(name, *symbol);
5324     if (symbol->has<ModuleDetails>()) {
5325       SayWithDecl(name, *symbol,
5326           "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
5327       return;
5328     }
5329     if (!symbol->attrs().test(Attr::INTRINSIC)) {
5330       if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
5331         Say(name,
5332             "'%s' is an external procedure without the EXTERNAL"
5333             " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
5334         return;
5335       }
5336       MakeExternal(*symbol);
5337     }
5338     ConvertToProcEntity(*symbol);
5339     SetProcFlag(name, *symbol, flag);
5340   } else if (symbol->has<UnknownDetails>()) {
5341     DIE("unexpected UnknownDetails");
5342   } else if (CheckUseError(name)) {
5343     // error was reported
5344   } else {
5345     symbol = &Resolve(name, symbol)->GetUltimate();
5346     ConvertToProcEntity(*symbol);
5347     if (!SetProcFlag(name, *symbol, flag)) {
5348       return;  // reported error
5349     }
5350     if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
5351         symbol->has<ObjectEntityDetails>() ||
5352         symbol->has<AssocEntityDetails>()) {
5353       // Symbols with DerivedTypeDetails, ObjectEntityDetails and
5354       // AssocEntityDetails are accepted here as procedure-designators because
5355       // this means the related FunctionReference are mis-parsed structure
5356       // constructors or array references that will be fixed later when
5357       // analyzing expressions.
5358     } else if (symbol->test(Symbol::Flag::Implicit)) {
5359       Say(name,
5360           "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);
5361     } else {
5362       SayWithDecl(name, *symbol,
5363           "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
5364     }
5365   }
5366 }
5367
5368 // Variant of HandleProcedureName() for use while skimming the executable
5369 // part of a subprogram to catch calls to dummy procedures that are part
5370 // of the subprogram's interface, and to mark as procedures any symbols
5371 // that might otherwise have been miscategorized as objects.
5372 void ResolveNamesVisitor::NoteExecutablePartCall(
5373     Symbol::Flag flag, const parser::Call &call) {
5374   auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
5375   if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
5376     // Subtlety: The symbol pointers in the parse tree are not set, because
5377     // they might end up resolving elsewhere (e.g., construct entities in
5378     // SELECT TYPE).
5379     if (Symbol * symbol{currScope().FindSymbol(name->source)}) {
5380       Symbol::Flag other{flag == Symbol::Flag::Subroutine
5381               ? Symbol::Flag::Function
5382               : Symbol::Flag::Subroutine};
5383       if (!symbol->test(other)) {
5384         ConvertToProcEntity(*symbol);
5385         if (symbol->has<ProcEntityDetails>()) {
5386           symbol->set(flag);
5387           if (symbol->IsDummy()) {
5388             symbol->attrs().set(Attr::EXTERNAL);
5389           }
5390           ApplyImplicitRules(*symbol);
5391         }
5392       }
5393     }
5394   }
5395 }
5396
5397 // Check and set the Function or Subroutine flag on symbol; false on error.
5398 bool ResolveNamesVisitor::SetProcFlag(
5399     const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
5400   if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
5401     SayWithDecl(
5402         name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
5403     return false;
5404   } else if (symbol.test(Symbol::Flag::Subroutine) &&
5405       flag == Symbol::Flag::Function) {
5406     SayWithDecl(
5407         name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
5408     return false;
5409   } else if (symbol.has<ProcEntityDetails>()) {
5410     symbol.set(flag);  // in case it hasn't been set yet
5411     if (flag == Symbol::Flag::Function) {
5412       ApplyImplicitRules(symbol);
5413     }
5414   } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
5415     SayWithDecl(
5416         name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
5417   }
5418   return true;
5419 }
5420
5421 bool ModuleVisitor::Pre(const parser::AccessStmt &x) {
5422   Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))};
5423   if (currScope().kind() != Scope::Kind::Module) {
5424     Say(currStmtSource().value(),
5425         "%s statement may only appear in the specification part of a module"_err_en_US,
5426         EnumToString(accessAttr));
5427     return false;
5428   }
5429   const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)};
5430   if (accessIds.empty()) {
5431     if (prevAccessStmt_) {
5432       Say("The default accessibility of this module has already been declared"_err_en_US)
5433           .Attach(*prevAccessStmt_, "Previous declaration"_en_US);
5434     }
5435     prevAccessStmt_ = currStmtSource();
5436     defaultAccess_ = accessAttr;
5437   } else {
5438     for (const auto &accessId : accessIds) {
5439       std::visit(
5440           common::visitors{
5441               [=](const parser::Name &y) {
5442                 Resolve(y, SetAccess(y.source, accessAttr));
5443               },
5444               [=](const Indirection<parser::GenericSpec> &y) {
5445                 auto info{GenericSpecInfo{y.value()}};
5446                 const auto &symbolName{info.symbolName()};
5447                 if (auto *symbol{info.FindInScope(context(), currScope())}) {
5448                   info.Resolve(&SetAccess(symbolName, accessAttr, symbol));
5449                 } else if (info.kind().IsName()) {
5450                   info.Resolve(&SetAccess(symbolName, accessAttr));
5451                 } else {
5452                   Say(symbolName, "Generic spec '%s' not found"_err_en_US);
5453                 }
5454               },
5455           },
5456           accessId.u);
5457     }
5458   }
5459   return false;
5460 }
5461
5462 // Set the access specification for this symbol.
5463 Symbol &ModuleVisitor::SetAccess(
5464     const SourceName &name, Attr attr, Symbol *symbol) {
5465   if (!symbol) {
5466     symbol = &MakeSymbol(name);
5467   }
5468   Attrs &attrs{symbol->attrs()};
5469   if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
5470     // PUBLIC/PRIVATE already set: make it a fatal error if it changed
5471     Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE;
5472     auto msg{IsDefinedOperator(name)
5473             ? "The accessibility of operator '%s' has already been specified as %s"_en_US
5474             : "The accessibility of '%s' has already been specified as %s"_en_US};
5475     Say(name, WithIsFatal(msg, attr != prev), name, EnumToString(prev));
5476   } else {
5477     attrs.set(attr);
5478   }
5479   return *symbol;
5480 }
5481
5482 static bool NeedsExplicitType(const Symbol &symbol) {
5483   if (symbol.has<UnknownDetails>()) {
5484     return true;
5485   } else if (const auto *details{symbol.detailsIf<EntityDetails>()}) {
5486     return !details->type();
5487   } else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
5488     return !details->type();
5489   } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
5490     return !details->interface().symbol() && !details->interface().type();
5491   } else {
5492     return false;
5493   }
5494 }
5495
5496 bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
5497   Walk(std::get<0>(x.t));
5498   Walk(std::get<1>(x.t));
5499   Walk(std::get<2>(x.t));
5500   Walk(std::get<3>(x.t));
5501   const std::list<parser::DeclarationConstruct> &decls{std::get<4>(x.t)};
5502   for (const auto &decl : decls) {
5503     if (const auto *spec{
5504             std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
5505       PreSpecificationConstruct(*spec);
5506     }
5507   }
5508   Walk(decls);
5509   FinishSpecificationPart();
5510   return false;
5511 }
5512
5513 // Initial processing on specification constructs, before visiting them.
5514 void ResolveNamesVisitor::PreSpecificationConstruct(
5515     const parser::SpecificationConstruct &spec) {
5516   std::visit(
5517       common::visitors{
5518           [&](const Indirection<parser::DerivedTypeDef> &) {},
5519           [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
5520             CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
5521           },
5522           [&](const Indirection<parser::InterfaceBlock> &y) {
5523             const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(
5524                 y.value().t)};
5525             const auto *spec{std::get_if<std::optional<parser::GenericSpec>>(
5526                 &stmt.statement.u)};
5527             if (spec && *spec) {
5528               CreateGeneric(**spec);
5529             }
5530           },
5531           [&](const auto &) {},
5532       },
5533       spec.u);
5534 }
5535
5536 void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
5537   auto info{GenericSpecInfo{x}};
5538   const SourceName &symbolName{info.symbolName()};
5539   if (IsLogicalConstant(context(), symbolName)) {
5540     Say(symbolName,
5541         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
5542     return;
5543   }
5544   GenericDetails genericDetails;
5545   if (Symbol * existing{info.FindInScope(context(), currScope())}) {
5546     if (existing->has<GenericDetails>()) {
5547       info.Resolve(existing);
5548       return;  // already have generic, add to it
5549     }
5550     Symbol &ultimate{existing->GetUltimate()};
5551     if (auto *ultimateDetails{ultimate.detailsIf<GenericDetails>()}) {
5552       genericDetails.CopyFrom(*ultimateDetails);
5553     } else if (ultimate.has<SubprogramDetails>() ||
5554         ultimate.has<SubprogramNameDetails>()) {
5555       genericDetails.set_specific(ultimate);
5556     } else if (ultimate.has<DerivedTypeDetails>()) {
5557       genericDetails.set_derivedType(ultimate);
5558     } else {
5559       SayAlreadyDeclared(symbolName, *existing);
5560     }
5561     EraseSymbol(*existing);
5562   }
5563   info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
5564 }
5565
5566 void ResolveNamesVisitor::FinishSpecificationPart() {
5567   badStmtFuncFound_ = false;
5568   CheckImports();
5569   bool inModule{currScope().kind() == Scope::Kind::Module};
5570   for (auto &pair : currScope()) {
5571     auto &symbol{*pair.second};
5572     if (NeedsExplicitType(symbol)) {
5573       ApplyImplicitRules(symbol);
5574     }
5575     if (symbol.has<GenericDetails>()) {
5576       CheckGenericProcedures(symbol);
5577     }
5578     if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
5579         !symbol.test(Symbol::Flag::Function)) {
5580       // in a module, external proc without return type is subroutine
5581       symbol.set(Symbol::Flag::Subroutine);
5582     }
5583   }
5584   currScope().InstantiateDerivedTypes(context());
5585   // TODO: what about instantiations in BLOCK?
5586   CheckSaveStmts();
5587   CheckCommonBlocks();
5588   CheckEquivalenceSets();
5589 }
5590
5591 void ResolveNamesVisitor::CheckImports() {
5592   auto &scope{currScope()};
5593   switch (scope.GetImportKind()) {
5594   case common::ImportKind::None: break;
5595   case common::ImportKind::All:
5596     // C8102: all entities in host must not be hidden
5597     for (const auto &pair : scope.parent()) {
5598       auto &name{pair.first};
5599       std::optional<SourceName> scopeName{scope.GetName()};
5600       if (!scopeName || name != *scopeName) {
5601         CheckImport(prevImportStmt_.value(), name);
5602       }
5603     }
5604     break;
5605   case common::ImportKind::Default:
5606   case common::ImportKind::Only:
5607     // C8102: entities named in IMPORT must not be hidden
5608     for (auto &name : scope.importNames()) {
5609       CheckImport(name, name);
5610     }
5611     break;
5612   }
5613 }
5614
5615 void ResolveNamesVisitor::CheckImport(
5616     const SourceName &location, const SourceName &name) {
5617   if (auto *symbol{FindInScope(currScope(), name)}) {
5618     Say(location, "'%s' from host is not accessible"_err_en_US, name)
5619         .Attach(symbol->name(), "'%s' is hidden by this entity"_en_US,
5620             symbol->name());
5621   }
5622 }
5623
5624 bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {
5625   return CheckNotInBlock("IMPLICIT") &&  // C1107
5626       ImplicitRulesVisitor::Pre(x);
5627 }
5628
5629 void ResolveNamesVisitor::Post(const parser::PointerObject &x) {
5630   std::visit(
5631       common::visitors{
5632           [&](const parser::Name &x) { ResolveName(x); },
5633           [&](const parser::StructureComponent &x) {
5634             ResolveStructureComponent(x);
5635           },
5636       },
5637       x.u);
5638 }
5639 void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {
5640   std::visit(
5641       common::visitors{
5642           [&](const parser::Name &x) { ResolveName(x); },
5643           [&](const parser::StructureComponent &x) {
5644             ResolveStructureComponent(x);
5645           },
5646       },
5647       x.u);
5648 }
5649
5650 bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
5651   const auto &dataRef{std::get<parser::DataRef>(x.t)};
5652   const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
5653   const auto &expr{std::get<parser::Expr>(x.t)};
5654   ResolveDataRef(dataRef);
5655   Walk(bounds);
5656   // Resolve unrestricted specific intrinsic procedures as in "p => cos".
5657   if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
5658     if (NameIsKnownOrIntrinsic(*name)) {
5659       return false;
5660     }
5661   }
5662   Walk(expr);
5663   return false;
5664 }
5665 void ResolveNamesVisitor::Post(const parser::Designator &x) {
5666   ResolveDesignator(x);
5667 }
5668
5669 void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
5670   ResolveStructureComponent(x.v.thing);
5671 }
5672 void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {
5673   DeclTypeSpecVisitor::Post(x);
5674   ConstructVisitor::Post(x);
5675 }
5676 bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
5677   CheckNotInBlock("STATEMENT FUNCTION");  // C1107
5678   if (HandleStmtFunction(x)) {
5679     return false;
5680   } else {
5681     // This is an array element assignment: resolve names of indices
5682     const auto &names{std::get<std::list<parser::Name>>(x.t)};
5683     for (auto &name : names) {
5684       ResolveName(name);
5685     }
5686     return true;
5687   }
5688 }
5689
5690 bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {
5691   const parser::Name &name{x.v};
5692   if (FindSymbol(name)) {
5693     // OK
5694   } else if (IsLogicalConstant(context(), name.source)) {
5695     Say(name,
5696         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
5697   } else {
5698     // Resolved later in expression semantics
5699     MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);
5700   }
5701   return false;
5702 }
5703
5704 bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
5705   auto root{ProgramTree::Build(x)};
5706   SetScope(context().globalScope());
5707   ResolveSpecificationParts(root);
5708   FinishSpecificationParts(root);
5709   ResolveExecutionParts(root);
5710   OmpAttributeVisitor{context(), *this}.Walk(x);
5711   return false;
5712 }
5713
5714 // References to procedures need to record that their symbols are known
5715 // to be procedures, so that they don't get converted to objects by default.
5716 class ExecutionPartSkimmer {
5717 public:
5718   explicit ExecutionPartSkimmer(ResolveNamesVisitor &resolver)
5719     : resolver_{resolver} {}
5720
5721   void Walk(const parser::ExecutionPart *exec) {
5722     if (exec) {
5723       parser::Walk(*exec, *this);
5724     }
5725   }
5726
5727   template<typename A> bool Pre(const A &) { return true; }
5728   template<typename A> void Post(const A &) {}
5729   void Post(const parser::FunctionReference &fr) {
5730     resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v);
5731   }
5732   void Post(const parser::CallStmt &cs) {
5733     resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.v);
5734   }
5735
5736 private:
5737   ResolveNamesVisitor &resolver_;
5738 };
5739
5740 // Build the scope tree and resolve names in the specification parts of this
5741 // node and its children
5742 void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
5743   if (!BeginScope(node)) {
5744     return;  // an error prevented scope from being created
5745   }
5746   Scope &scope{currScope()};
5747   node.set_scope(scope);
5748   AddSubpNames(node);
5749   std::visit(
5750       [&](const auto *x) {
5751         if (x) {
5752           Walk(*x);
5753         }
5754       },
5755       node.stmt());
5756   Walk(node.spec());
5757   // If this is a function, convert result to an object. This is to prevent the
5758   // result to be converted later to a function symbol if it is called inside
5759   // the function.
5760   // If the result is function pointer, then ConvertToObjectEntity will not
5761   // convert the result to an object, and calling the symbol inside the function
5762   // will result in calls to the result pointer.
5763   // A function cannot be called recursively if RESULT was not used to define a
5764   // distinct result name (15.6.2.2 point 4.).
5765   if (Symbol * symbol{scope.symbol()}) {
5766     if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
5767       if (details->isFunction()) {
5768         ConvertToObjectEntity(const_cast<Symbol &>(details->result()));
5769       }
5770     }
5771   }
5772   if (node.IsModule()) {
5773     ApplyDefaultAccess();
5774   }
5775   for (auto &child : node.children()) {
5776     ResolveSpecificationParts(child);
5777   }
5778   ExecutionPartSkimmer{*this}.Walk(node.exec());
5779   PopScope();
5780   // Ensure that every object entity has a type.
5781   for (auto &pair : *node.scope()) {
5782     ApplyImplicitRules(*pair.second);
5783   }
5784 }
5785
5786 // Add SubprogramNameDetails symbols for contained subprograms
5787 void ResolveNamesVisitor::AddSubpNames(const ProgramTree &node) {
5788   auto kind{
5789       node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
5790   for (const auto &child : node.children()) {
5791     auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind})};
5792     symbol.set(child.GetSubpFlag());
5793   }
5794 }
5795
5796 // Push a new scope for this node or return false on error.
5797 bool ResolveNamesVisitor::BeginScope(const ProgramTree &node) {
5798   switch (node.GetKind()) {
5799     SWITCH_COVERS_ALL_CASES
5800   case ProgramTree::Kind::Program:
5801     PushScope(Scope::Kind::MainProgram,
5802         &MakeSymbol(node.name(), MainProgramDetails{}));
5803     return true;
5804   case ProgramTree::Kind::Function:
5805   case ProgramTree::Kind::Subroutine:
5806     return BeginSubprogram(
5807         node.name(), node.GetSubpFlag(), node.HasModulePrefix());
5808   case ProgramTree::Kind::MpSubprogram: return BeginMpSubprogram(node.name());
5809   case ProgramTree::Kind::Module: BeginModule(node.name(), false); return true;
5810   case ProgramTree::Kind::Submodule:
5811     return BeginSubmodule(node.name(), node.GetParentId());
5812   case ProgramTree::Kind::BlockData:
5813     PushBlockDataScope(node.name());
5814     return true;
5815   }
5816 }
5817
5818 // Some analyses and checks, such as the processing of initializers of
5819 // pointers, are deferred until all of the pertinent specification parts
5820 // have been visited.  This deferred processing enables the use of forward
5821 // references in these circumstances.
5822 class DeferredCheckVisitor {
5823 public:
5824   explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)
5825     : resolver_{resolver} {}
5826
5827   template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
5828
5829   template<typename A> bool Pre(const A &) { return true; }
5830   template<typename A> void Post(const A &) {}
5831
5832   void Post(const parser::DerivedTypeStmt &x) {
5833     const auto &name{std::get<parser::Name>(x.t)};
5834     if (Symbol * symbol{name.symbol}) {
5835       if (Scope * scope{symbol->scope()}) {
5836         if (scope->IsDerivedType()) {
5837           resolver_.PushScope(*scope);
5838           pushedScope_ = true;
5839         }
5840       }
5841     }
5842   }
5843   void Post(const parser::EndTypeStmt &) {
5844     if (pushedScope_) {
5845       resolver_.PopScope();
5846       pushedScope_ = false;
5847     }
5848   }
5849
5850   void Post(const parser::ProcInterface &pi) {
5851     if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
5852       resolver_.CheckExplicitInterface(*name);
5853     }
5854   }
5855   bool Pre(const parser::EntityDecl &decl) {
5856     Init(std::get<parser::Name>(decl.t),
5857         std::get<std::optional<parser::Initialization>>(decl.t));
5858     return false;
5859   }
5860   bool Pre(const parser::ComponentDecl &decl) {
5861     Init(std::get<parser::Name>(decl.t),
5862         std::get<std::optional<parser::Initialization>>(decl.t));
5863     return false;
5864   }
5865   bool Pre(const parser::ProcDecl &decl) {
5866     if (const auto &init{
5867             std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {
5868       resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init);
5869     }
5870     return false;
5871   }
5872   void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) {
5873     resolver_.CheckExplicitInterface(tbps.interfaceName);
5874   }
5875   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
5876     if (pushedScope_) {
5877       resolver_.CheckBindings(tbps);
5878     }
5879   }
5880
5881 private:
5882   void Init(const parser::Name &name,
5883       const std::optional<parser::Initialization> &init) {
5884     if (init) {
5885       if (const auto *target{
5886               std::get_if<parser::InitialDataTarget>(&init->u)}) {
5887         resolver_.PointerInitialization(name, *target);
5888       }
5889     }
5890   }
5891
5892   ResolveNamesVisitor &resolver_;
5893   bool pushedScope_{false};
5894 };
5895
5896 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
5897   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
5898   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
5899   switch (beginDir.v) {
5900   case parser::OmpBlockDirective::Directive::Master:
5901     PushContext(beginDir.source, OmpDirective::MASTER);
5902     break;
5903   case parser::OmpBlockDirective::Directive::Ordered:
5904     PushContext(beginDir.source, OmpDirective::ORDERED);
5905     break;
5906   case parser::OmpBlockDirective::Directive::Parallel:
5907     PushContext(beginDir.source, OmpDirective::PARALLEL);
5908     break;
5909   case parser::OmpBlockDirective::Directive::Single:
5910     PushContext(beginDir.source, OmpDirective::SINGLE);
5911     break;
5912   case parser::OmpBlockDirective::Directive::Target:
5913     PushContext(beginDir.source, OmpDirective::TARGET);
5914     break;
5915   case parser::OmpBlockDirective::Directive::TargetData:
5916     PushContext(beginDir.source, OmpDirective::TARGET_DATA);
5917     break;
5918   case parser::OmpBlockDirective::Directive::Task:
5919     PushContext(beginDir.source, OmpDirective::TASK);
5920     break;
5921   case parser::OmpBlockDirective::Directive::Teams:
5922     PushContext(beginDir.source, OmpDirective::TEAMS);
5923     break;
5924   case parser::OmpBlockDirective::Directive::Workshare:
5925     PushContext(beginDir.source, OmpDirective::WORKSHARE);
5926     break;
5927   default:
5928     // TODO others
5929     break;
5930   }
5931   ClearDataSharingAttributeObjects();
5932   return true;
5933 }
5934
5935 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
5936   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
5937   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
5938   switch (beginDir.v) {
5939   case parser::OmpLoopDirective::Directive::Distribute:
5940     PushContext(beginDir.source, OmpDirective::DISTRIBUTE);
5941     break;
5942   case parser::OmpLoopDirective::Directive::Do:
5943     PushContext(beginDir.source, OmpDirective::DO);
5944     break;
5945   case parser::OmpLoopDirective::Directive::DoSimd:
5946     PushContext(beginDir.source, OmpDirective::DO_SIMD);
5947     break;
5948   case parser::OmpLoopDirective::Directive::ParallelDo:
5949     PushContext(beginDir.source, OmpDirective::PARALLEL_DO);
5950     break;
5951   case parser::OmpLoopDirective::Directive::ParallelDoSimd:
5952     PushContext(beginDir.source, OmpDirective::PARALLEL_DO_SIMD);
5953     break;
5954   case parser::OmpLoopDirective::Directive::Simd:
5955     PushContext(beginDir.source, OmpDirective::SIMD);
5956     break;
5957   case parser::OmpLoopDirective::Directive::Taskloop:
5958     PushContext(beginDir.source, OmpDirective::TASKLOOP);
5959     break;
5960   case parser::OmpLoopDirective::Directive::TaskloopSimd:
5961     PushContext(beginDir.source, OmpDirective::TASKLOOP_SIMD);
5962     break;
5963   default:
5964     // TODO others
5965     break;
5966   }
5967   ClearDataSharingAttributeObjects();
5968   return true;
5969 }
5970
5971 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
5972   const auto &beginSectionsDir{
5973       std::get<parser::OmpBeginSectionsDirective>(x.t)};
5974   const auto &beginDir{
5975       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
5976   switch (beginDir.v) {
5977   case parser::OmpSectionsDirective::Directive::ParallelSections:
5978     PushContext(beginDir.source, OmpDirective::PARALLEL_SECTIONS);
5979     break;
5980   case parser::OmpSectionsDirective::Directive::Sections:
5981     PushContext(beginDir.source, OmpDirective::SECTIONS);
5982     break;
5983   default: break;
5984   }
5985   ClearDataSharingAttributeObjects();
5986   return true;
5987 }
5988
5989 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
5990   PushContext(x.source, OmpDirective::THREADPRIVATE);
5991   const auto &list{std::get<parser::OmpObjectList>(x.t)};
5992   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
5993   return false;
5994 }
5995
5996 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
5997   if (!ompContext_.empty()) {
5998     switch (x.v) {
5999     case parser::OmpDefaultClause::Type::Private:
6000       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
6001       break;
6002     case parser::OmpDefaultClause::Type::Firstprivate:
6003       SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
6004       break;
6005     case parser::OmpDefaultClause::Type::Shared:
6006       SetContextDefaultDSA(Symbol::Flag::OmpShared);
6007       break;
6008     case parser::OmpDefaultClause::Type::None:
6009       SetContextDefaultDSA(Symbol::Flag::OmpNone);
6010       break;
6011     }
6012   }
6013 }
6014
6015 // For OpenMP constructs, check all the data-refs within the constructs
6016 // and adjust the symbol for each Name if necessary
6017 void OmpAttributeVisitor::Post(const parser::Name &name) {
6018   auto *symbol{name.symbol};
6019   if (symbol && !ompContext_.empty() && GetContext().withinConstruct) {
6020     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
6021         !IsObjectWithDSA(*symbol)) {
6022       // TODO: create a separate function to go through the rules for
6023       //       predetermined, explicitly determined, and implicitly
6024       //       determined data-sharing attributes (2.15.1.1).
6025       if (Symbol * found{currScope().FindSymbol(name.source)}) {
6026         if (IsObjectWithDSA(*found)) {
6027           name.symbol = found;  // adjust the symbol within region
6028         } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
6029           context_.Say(name.source,
6030               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
6031               "a data-sharing attribute clause"_err_en_US,
6032               symbol->name());
6033         }
6034       }
6035     }
6036   }  // within OpenMP construct
6037 }
6038
6039 bool OmpAttributeVisitor::HasDataSharingAttributeObject(const Symbol &object) {
6040   auto it{dataSharingAttributeObjects_.find(object)};
6041   return it != dataSharingAttributeObjects_.end();
6042 }
6043
6044 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
6045     const parser::Name *name) {
6046   if (auto *prev{name
6047               ? GetContext().scope.parent().FindCommonBlock(name->source)
6048               : nullptr}) {
6049     name->symbol = prev;
6050     return prev;
6051   } else {
6052     return nullptr;
6053   }
6054 }
6055
6056 void OmpAttributeVisitor::ResolveOmpObjectList(
6057     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
6058   for (const auto &ompObject : ompObjectList.v) {
6059     ResolveOmpObject(ompObject, ompFlag);
6060   }
6061 }
6062
6063 void OmpAttributeVisitor::ResolveOmpObject(
6064     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
6065   std::visit(
6066       common::visitors{
6067           [&](const parser::Designator &designator) {
6068             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
6069               if (auto *symbol{ResolveOmp(*name, ompFlag)}) {
6070                 AddToContextObjectWithDSA(*symbol, ompFlag);
6071                 if (dataSharingAttributeFlags.test(ompFlag)) {
6072                   CheckMultipleAppearances(*name, *symbol, ompFlag);
6073                 }
6074               }
6075             } else if (const auto *designatorName{
6076                            resolver_.ResolveDesignator(designator)};
6077                        designatorName->symbol) {
6078               // Array sections to be changed to substrings as needed
6079               if (AnalyzeExpr(context_, designator)) {
6080                 if (std::holds_alternative<parser::Substring>(designator.u)) {
6081                   context_.Say(designator.source,
6082                       "Substrings are not allowed on OpenMP "
6083                       "directives or clauses"_err_en_US);
6084                 }
6085               }
6086               // other checks, more TBD
6087               if (const auto *details{designatorName->symbol
6088                                           ->detailsIf<ObjectEntityDetails>()}) {
6089                 if (details->IsArray()) {
6090                   // TODO: check Array Sections
6091                 } else if (designatorName->symbol->owner().IsDerivedType()) {
6092                   // TODO: check Structure Component
6093                 }
6094               }
6095             }
6096           },
6097           [&](const parser::Name &name) {  // common block
6098             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
6099               CheckMultipleAppearances(
6100                   name, *symbol, Symbol::Flag::OmpCommonBlock);
6101               // 2.15.3 When a named common block appears in a list, it has the
6102               // same meaning as if every explicit member of the common block
6103               // appeared in the list
6104               for (const Symbol &object :
6105                   symbol->get<CommonBlockDetails>().objects()) {
6106                 Symbol &mutableObject{const_cast<Symbol &>(object)};
6107                 if (auto *resolvedObject{ResolveOmp(mutableObject, ompFlag)}) {
6108                   AddToContextObjectWithDSA(*resolvedObject, ompFlag);
6109                 }
6110               }
6111             } else {
6112               context_.Say(name.source,  // 2.15.3
6113                   "COMMON block must be declared in the same scoping unit "
6114                   "in which the OpenMP directive or clause appears"_err_en_US);
6115             }
6116           },
6117       },
6118       ompObject.u);
6119 }
6120
6121 Symbol *OmpAttributeVisitor::ResolveOmp(
6122     const parser::Name &name, Symbol::Flag ompFlag) {
6123   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
6124     return DeclarePrivateAccessEntity(name, ompFlag);
6125   } else {
6126     return DeclareOrMarkOtherAccessEntity(name, ompFlag);
6127   }
6128 }
6129
6130 Symbol *OmpAttributeVisitor::ResolveOmp(Symbol &symbol, Symbol::Flag ompFlag) {
6131   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
6132     return DeclarePrivateAccessEntity(symbol, ompFlag);
6133   } else {
6134     return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
6135   }
6136 }
6137
6138 Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
6139     const parser::Name &name, Symbol::Flag ompFlag) {
6140   if (!name.symbol) {
6141     return nullptr;  // not resolved by Name Resolution step, do nothing
6142   }
6143   name.symbol = DeclarePrivateAccessEntity(*name.symbol, ompFlag);
6144   return name.symbol;
6145 }
6146
6147 Symbol *OmpAttributeVisitor::DeclarePrivateAccessEntity(
6148     Symbol &object, Symbol::Flag ompFlag) {
6149   if (object.owner() != currScope()) {
6150     auto &symbol{MakeAssocSymbol(object.name(), object)};
6151     symbol.set(ompFlag);
6152     return &symbol;
6153   } else {
6154     object.set(ompFlag);
6155     return &object;
6156   }
6157 }
6158
6159 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
6160     const parser::Name &name, Symbol::Flag ompFlag) {
6161   Symbol *prev{currScope().FindSymbol(name.source)};
6162   if (!name.symbol || !prev) {
6163     return nullptr;
6164   } else if (prev != name.symbol) {
6165     name.symbol = prev;
6166   }
6167   return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
6168 }
6169
6170 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
6171     Symbol &object, Symbol::Flag ompFlag) {
6172   if (ompFlagsRequireMark.test(ompFlag)) {
6173     object.set(ompFlag);
6174   }
6175   return &object;
6176 }
6177
6178 static bool WithMultipleAppearancesException(
6179     const Symbol &symbol, Symbol::Flag ompFlag) {
6180   return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
6181              symbol.test(Symbol::Flag::OmpLastPrivate)) ||
6182       (ompFlag == Symbol::Flag::OmpLastPrivate &&
6183           symbol.test(Symbol::Flag::OmpFirstPrivate));
6184 }
6185
6186 void OmpAttributeVisitor::CheckMultipleAppearances(
6187     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
6188   const auto *target{&symbol};
6189   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
6190     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
6191       target = &details->symbol();
6192     }
6193   }
6194   if (HasDataSharingAttributeObject(*target) &&
6195       !WithMultipleAppearancesException(symbol, ompFlag)) {
6196     context_.Say(name.source,
6197         "'%s' appears in more than one data-sharing clause "
6198         "on the same OpenMP directive"_err_en_US,
6199         name.ToString());
6200   } else {
6201     AddDataSharingAttributeObject(*target);
6202   }
6203 }
6204
6205 // Perform checks and completions that need to happen after all of
6206 // the specification parts but before any of the execution parts.
6207 void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
6208   if (!node.scope()) {
6209     return;  // error occurred creating scope
6210   }
6211   SetScope(*node.scope());
6212   // The initializers of pointers, pointer components, and non-deferred
6213   // type-bound procedure bindings have not yet been traversed.
6214   // We do that now, when any (formerly) forward references that appear
6215   // in those initializers will resolve to the right symbols.
6216   DeferredCheckVisitor{*this}.Walk(node.spec());
6217   DeferredCheckVisitor{*this}.Walk(node.exec());  // for BLOCK
6218   for (Scope &childScope : currScope().children()) {
6219     if (childScope.IsDerivedType() && !childScope.symbol()) {
6220       FinishDerivedTypeInstantiation(childScope);
6221     }
6222   }
6223   for (const auto &child : node.children()) {
6224     FinishSpecificationParts(child);
6225   }
6226 }
6227
6228 // Fold object pointer initializer designators with the actual
6229 // type parameter values of a particular instantiation.
6230 void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
6231   CHECK(scope.IsDerivedType() && !scope.symbol());
6232   if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
6233     spec->Instantiate(currScope(), context());
6234     const Symbol &origTypeSymbol{spec->typeSymbol()};
6235     if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
6236       CHECK(origTypeScope->IsDerivedType() &&
6237           origTypeScope->symbol() == &origTypeSymbol);
6238       auto &foldingContext{GetFoldingContext()};
6239       auto restorer{foldingContext.WithPDTInstance(*spec)};
6240       for (auto &pair : scope) {
6241         Symbol &comp{*pair.second};
6242         const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};
6243         if (IsPointer(comp)) {
6244           if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
6245             auto origDetails{origComp.get<ObjectEntityDetails>()};
6246             if (const MaybeExpr & init{origDetails.init()}) {
6247               SomeExpr newInit{*init};
6248               MaybeExpr folded{
6249                   evaluate::Fold(foldingContext, std::move(newInit))};
6250               details->set_init(std::move(folded));
6251             }
6252           }
6253         }
6254       }
6255     }
6256   }
6257 }
6258
6259 // Resolve names in the execution part of this node and its children
6260 void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {
6261   if (!node.scope()) {
6262     return;  // error occurred creating scope
6263   }
6264   SetScope(*node.scope());
6265   if (const auto *exec{node.exec()}) {
6266     Walk(*exec);
6267   }
6268   PopScope();  // converts unclassified entities into objects
6269   for (const auto &child : node.children()) {
6270     ResolveExecutionParts(child);
6271   }
6272 }
6273
6274 void ResolveNamesVisitor::Post(const parser::Program &) {
6275   // ensure that all temps were deallocated
6276   CHECK(!attrs_);
6277   CHECK(!GetDeclTypeSpec());
6278 }
6279
6280 bool ResolveNames(SemanticsContext &context, const parser::Program &program) {
6281   ResolveNamesVisitor{context}.Walk(program);
6282   return !context.AnyFatalError();
6283 }
6284 }