brintos / llvm-project-archived public Read only

1//===-- lib/Semantics/resolve-names.cpp -----------------------------------===//2// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.3// See https://llvm.org/LICENSE.txt for license information.4// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception5//6//===----------------------------------------------------------------------===//7 8#include "resolve-names.h"9#include "assignment.h"10#include "data-to-inits.h"11#include "definable.h"12#include "mod-file.h"13#include "pointer-assignment.h"14#include "resolve-directives.h"15#include "resolve-names-utils.h"16#include "rewrite-parse-tree.h"17#include "flang/Common/indirection.h"18#include "flang/Common/restorer.h"19#include "flang/Common/visit.h"20#include "flang/Evaluate/characteristics.h"21#include "flang/Evaluate/check-expression.h"22#include "flang/Evaluate/common.h"23#include "flang/Evaluate/fold-designator.h"24#include "flang/Evaluate/fold.h"25#include "flang/Evaluate/intrinsics.h"26#include "flang/Evaluate/tools.h"27#include "flang/Evaluate/type.h"28#include "flang/Parser/openmp-utils.h"29#include "flang/Parser/parse-tree-visitor.h"30#include "flang/Parser/parse-tree.h"31#include "flang/Parser/tools.h"32#include "flang/Semantics/attr.h"33#include "flang/Semantics/expression.h"34#include "flang/Semantics/openmp-modifiers.h"35#include "flang/Semantics/openmp-utils.h"36#include "flang/Semantics/program-tree.h"37#include "flang/Semantics/scope.h"38#include "flang/Semantics/semantics.h"39#include "flang/Semantics/symbol.h"40#include "flang/Semantics/tools.h"41#include "flang/Semantics/type.h"42#include "flang/Support/Fortran.h"43#include "flang/Support/default-kinds.h"44#include "llvm/ADT/StringSwitch.h"45#include "llvm/Support/raw_ostream.h"46#include <list>47#include <map>48#include <set>49#include <stack>50 51namespace Fortran::semantics {52 53using namespace parser::literals;54 55template <typename T> using Indirection = common::Indirection<T>;56using Message = parser::Message;57using Messages = parser::Messages;58using MessageFixedText = parser::MessageFixedText;59using MessageFormattedText = parser::MessageFormattedText;60 61class ResolveNamesVisitor;62class ScopeHandler;63 64// ImplicitRules maps initial character of identifier to the DeclTypeSpec65// representing the implicit type; std::nullopt if none.66// It also records the presence of IMPLICIT NONE statements.67// When inheritFromParent is set, defaults come from the parent rules.68class ImplicitRules {69public:70  ImplicitRules(SemanticsContext &context, const ImplicitRules *parent)71      : parent_{parent}, context_{context},72        inheritFromParent_{parent != nullptr} {}73  bool isImplicitNoneType() const;74  bool isImplicitNoneExternal() const;75  void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }76  void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }77  void set_inheritFromParent(bool x) { inheritFromParent_ = x; }78  // Get the implicit type for this name. May be null.79  const DeclTypeSpec *GetType(80      SourceName, bool respectImplicitNone = true) const;81  // Record the implicit type for the range of characters [fromLetter,82  // toLetter].83  void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,84      parser::Location toLetter);85 86private:87  static char Incr(char ch);88 89  const ImplicitRules *parent_;90  SemanticsContext &context_;91  bool inheritFromParent_{false}; // look in parent if not specified here92  bool isImplicitNoneType_{93      context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)};94  bool isImplicitNoneExternal_{95      context_.IsEnabled(common::LanguageFeature::ImplicitNoneExternal)};96  // map_ contains the mapping between letters and types that were defined97  // by the IMPLICIT statements of the related scope. It does not contain98  // the default Fortran mappings nor the mapping defined in parents.99  std::map<char, common::Reference<const DeclTypeSpec>> map_;100 101  friend llvm::raw_ostream &operator<<(102      llvm::raw_ostream &, const ImplicitRules &);103  friend void ShowImplicitRule(104      llvm::raw_ostream &, const ImplicitRules &, char);105};106 107// scope -> implicit rules for that scope108using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>;109 110// Track statement source locations and save messages.111class MessageHandler {112public:113  MessageHandler() { DIE("MessageHandler: default-constructed"); }114  explicit MessageHandler(SemanticsContext &c) : context_{&c} {}115  Messages &messages() { return context_->messages(); };116  const std::optional<SourceName> &currStmtSource() {117    return context_->location();118  }119  void set_currStmtSource(const std::optional<SourceName> &source) {120    context_->set_location(source);121  }122 123  // Emit a message associated with the current statement source.124  Message &Say(MessageFixedText &&);125  Message &Say(MessageFormattedText &&);126  // Emit a message about a SourceName127  Message &Say(const SourceName &, MessageFixedText &&);128  // Emit a formatted message associated with a source location.129  template <typename... A>130  Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) {131    return context_->Say(source, std::move(msg), std::forward<A>(args)...);132  }133 134private:135  SemanticsContext *context_;136};137 138// Inheritance graph for the parse tree visitation classes that follow:139//   BaseVisitor140//   + AttrsVisitor141//   | + DeclTypeSpecVisitor142//   |   + ImplicitRulesVisitor143//   |     + ScopeHandler ------------------+144//   |       + ModuleVisitor -------------+ |145//   |       + GenericHandler -------+    | |146//   |       | + InterfaceVisitor    |    | |147//   |       +-+ SubprogramVisitor ==|==+ | |148//   + ArraySpecVisitor              |  | | |149//     + DeclarationVisitor <--------+  | | |150//       + ConstructVisitor             | | |151//         + ResolveNamesVisitor <------+-+-+152 153class BaseVisitor {154public:155  BaseVisitor() { DIE("BaseVisitor: default-constructed"); }156  BaseVisitor(157      SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)158      : implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {159  }160  template <typename T> void Walk(const T &);161 162  MessageHandler &messageHandler() { return messageHandler_; }163  const std::optional<SourceName> &currStmtSource() {164    return context_->location();165  }166  SemanticsContext &context() const { return *context_; }167  evaluate::FoldingContext &GetFoldingContext() const {168    return context_->foldingContext();169  }170  bool IsIntrinsic(171      const SourceName &name, std::optional<Symbol::Flag> flag) const {172    if (!flag) {173      return context_->intrinsics().IsIntrinsic(name.ToString());174    } else if (flag == Symbol::Flag::Function) {175      return context_->intrinsics().IsIntrinsicFunction(name.ToString());176    } else if (flag == Symbol::Flag::Subroutine) {177      return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());178    } else {179      DIE("expected Subroutine or Function flag");180    }181  }182 183  bool InModuleFile() const {184    return GetFoldingContext().moduleFileName().has_value();185  }186 187  // Make a placeholder symbol for a Name that otherwise wouldn't have one.188  // It is not in any scope and always has MiscDetails.189  void MakePlaceholder(const parser::Name &, MiscDetails::Kind);190 191  template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {192    return evaluate::Fold(GetFoldingContext(), std::move(expr));193  }194 195  template <typename T> MaybeExpr EvaluateExpr(const T &expr) {196    return FoldExpr(AnalyzeExpr(*context_, expr));197  }198 199  template <typename T>200  MaybeExpr EvaluateNonPointerInitializer(201      const Symbol &symbol, const T &expr, parser::CharBlock source) {202    if (!context().HasError(symbol)) {203      if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {204        auto restorer{GetFoldingContext().messages().SetLocation(source)};205        return evaluate::NonPointerInitializationExpr(206            symbol, std::move(*maybeExpr), GetFoldingContext());207      }208    }209    return std::nullopt;210  }211 212  template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {213    return semantics::EvaluateIntExpr(*context_, expr);214  }215 216  template <typename T>217  MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {218    if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {219      return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(220          std::move(*maybeIntExpr)));221    } else {222      return std::nullopt;223    }224  }225 226  template <typename... A> Message &Say(A &&...args) {227    return messageHandler_.Say(std::forward<A>(args)...);228  }229  template <typename... A>230  Message &Say(231      const parser::Name &name, MessageFixedText &&text, const A &...args) {232    return messageHandler_.Say(name.source, std::move(text), args...);233  }234 235protected:236  ImplicitRulesMap *implicitRulesMap_{nullptr};237 238private:239  ResolveNamesVisitor *this_;240  SemanticsContext *context_;241  MessageHandler messageHandler_;242};243 244// Provide Post methods to collect attributes into a member variable.245class AttrsVisitor : public virtual BaseVisitor {246public:247  bool BeginAttrs(); // always returns true248  Attrs GetAttrs();249  std::optional<common::CUDADataAttr> cudaDataAttr() { return cudaDataAttr_; }250  Attrs EndAttrs();251  bool SetPassNameOn(Symbol &);252  void SetBindNameOn(Symbol &);253  void Post(const parser::LanguageBindingSpec &);254  bool Pre(const parser::IntentSpec &);255  bool Pre(const parser::Pass &);256 257  bool CheckAndSet(Attr);258 259// Simple case: encountering CLASSNAME causes ATTRNAME to be set.260#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \261  bool Pre(const parser::CLASSNAME &) { \262    CheckAndSet(Attr::ATTRNAME); \263    return false; \264  }265  HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)266  HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)267  HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)268  HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)269  HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)270  HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)271  HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)272  HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)273  HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)274  HANDLE_ATTR_CLASS(Abstract, ABSTRACT)275  HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)276  HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)277  HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)278  HANDLE_ATTR_CLASS(External, EXTERNAL)279  HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)280  HANDLE_ATTR_CLASS(NoPass, NOPASS)281  HANDLE_ATTR_CLASS(Optional, OPTIONAL)282  HANDLE_ATTR_CLASS(Parameter, PARAMETER)283  HANDLE_ATTR_CLASS(Pointer, POINTER)284  HANDLE_ATTR_CLASS(Protected, PROTECTED)285  HANDLE_ATTR_CLASS(Save, SAVE)286  HANDLE_ATTR_CLASS(Target, TARGET)287  HANDLE_ATTR_CLASS(Value, VALUE)288  HANDLE_ATTR_CLASS(Volatile, VOLATILE)289#undef HANDLE_ATTR_CLASS290  bool Pre(const common::CUDADataAttr);291 292protected:293  std::optional<Attrs> attrs_;294  std::optional<common::CUDADataAttr> cudaDataAttr_;295 296  Attr AccessSpecToAttr(const parser::AccessSpec &x) {297    switch (x.v) {298    case parser::AccessSpec::Kind::Public:299      return Attr::PUBLIC;300    case parser::AccessSpec::Kind::Private:301      return Attr::PRIVATE;302    }303    llvm_unreachable("Switch covers all cases"); // suppress g++ warning304  }305  Attr IntentSpecToAttr(const parser::IntentSpec &x) {306    switch (x.v) {307    case parser::IntentSpec::Intent::In:308      return Attr::INTENT_IN;309    case parser::IntentSpec::Intent::Out:310      return Attr::INTENT_OUT;311    case parser::IntentSpec::Intent::InOut:312      return Attr::INTENT_INOUT;313    }314    llvm_unreachable("Switch covers all cases"); // suppress g++ warning315  }316 317private:318  bool IsDuplicateAttr(Attr);319  bool HaveAttrConflict(Attr, Attr, Attr);320  bool IsConflictingAttr(Attr);321 322  MaybeExpr bindName_; // from BIND(C, NAME="...")323  bool isCDefined_{false}; // BIND(C, NAME="...", CDEFINED) extension324  std::optional<SourceName> passName_; // from PASS(...)325};326 327// Find and create types from declaration-type-spec nodes.328class DeclTypeSpecVisitor : public AttrsVisitor {329public:330  using AttrsVisitor::Post;331  using AttrsVisitor::Pre;332  void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);333  void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);334  void Post(const parser::DeclarationTypeSpec::ClassStar &);335  void Post(const parser::DeclarationTypeSpec::TypeStar &);336  bool Pre(const parser::TypeGuardStmt &);337  void Post(const parser::TypeGuardStmt &);338  void Post(const parser::TypeSpec &);339 340  // Walk the parse tree of a type spec and return the DeclTypeSpec for it.341  template <typename T>342  const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {343    auto restorer{common::ScopedSet(state_, State{})};344    set_allowForwardReferenceToDerivedType(allowForward);345    BeginDeclTypeSpec();346    Walk(x);347    const auto *type{GetDeclTypeSpec()};348    EndDeclTypeSpec();349    return type;350  }351 352protected:353  struct State {354    bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true355    const DeclTypeSpec *declTypeSpec{nullptr};356    struct {357      DerivedTypeSpec *type{nullptr};358      DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};359    } derived;360    bool allowForwardReferenceToDerivedType{false};361    const parser::Expr *originalKindParameter{nullptr};362  };363 364  bool allowForwardReferenceToDerivedType() const {365    return state_.allowForwardReferenceToDerivedType;366  }367  void set_allowForwardReferenceToDerivedType(bool yes) {368    state_.allowForwardReferenceToDerivedType = yes;369  }370  void set_inPDTDefinition(bool yes) { inPDTDefinition_ = yes; }371 372  const DeclTypeSpec *GetDeclTypeSpec() const;373  const parser::Expr *GetOriginalKindParameter() const;374  void BeginDeclTypeSpec();375  void EndDeclTypeSpec();376  void SetDeclTypeSpec(const DeclTypeSpec &);377  void SetDeclTypeSpecCategory(DeclTypeSpec::Category);378  DeclTypeSpec::Category GetDeclTypeSpecCategory() const {379    return state_.derived.category;380  }381  KindExpr GetKindParamExpr(382      TypeCategory, const std::optional<parser::KindSelector> &);383  void CheckForAbstractType(const Symbol &typeSymbol);384 385private:386  State state_;387  bool inPDTDefinition_{false};388 389  void MakeNumericType(TypeCategory, int kind);390};391 392// Visit ImplicitStmt and related parse tree nodes and updates implicit rules.393class ImplicitRulesVisitor : public DeclTypeSpecVisitor {394public:395  using DeclTypeSpecVisitor::Post;396  using DeclTypeSpecVisitor::Pre;397  using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;398 399  void Post(const parser::ParameterStmt &);400  bool Pre(const parser::ImplicitStmt &);401  bool Pre(const parser::LetterSpec &);402  bool Pre(const parser::ImplicitSpec &);403  void Post(const parser::ImplicitSpec &);404 405  const DeclTypeSpec *GetType(406      SourceName name, bool respectImplicitNoneType = true) {407    return implicitRules_->GetType(name, respectImplicitNoneType);408  }409  bool isImplicitNoneType() const {410    return implicitRules_->isImplicitNoneType();411  }412  bool isImplicitNoneType(const Scope &scope) const {413    return implicitRulesMap_->at(&scope).isImplicitNoneType();414  }415  bool isImplicitNoneExternal() const {416    return implicitRules_->isImplicitNoneExternal();417  }418  void set_inheritFromParent(bool x) {419    implicitRules_->set_inheritFromParent(x);420  }421 422protected:423  void BeginScope(const Scope &);424  void SetScope(const Scope &);425 426private:427  // implicit rules in effect for current scope428  ImplicitRules *implicitRules_{nullptr};429  std::optional<SourceName> prevImplicit_;430  std::optional<SourceName> prevImplicitNone_;431  std::optional<SourceName> prevImplicitNoneType_;432  std::optional<SourceName> prevParameterStmt_;433 434  bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);435};436 437// Track array specifications. They can occur in AttrSpec, EntityDecl,438// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointer, and439// ComponentDecl.440// 1. INTEGER, DIMENSION(10) :: x441// 2. INTEGER :: x(10)442// 3. ALLOCATABLE :: x(:)443// 4. DIMENSION :: x(10)444// 5. COMMON x(10)445// 6. POINTER(p,x(10))446class ArraySpecVisitor : public virtual BaseVisitor {447public:448  void Post(const parser::ArraySpec &);449  void Post(const parser::ComponentArraySpec &);450  void Post(const parser::CoarraySpec &);451  void Post(const parser::AttrSpec &) { PostAttrSpec(); }452  void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }453 454protected:455  const ArraySpec &arraySpec();456  void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }457  const ArraySpec &coarraySpec();458  void BeginArraySpec();459  void EndArraySpec();460  void ClearArraySpec() { arraySpec_.clear(); }461  void ClearCoarraySpec() { coarraySpec_.clear(); }462 463private:464  // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec465  ArraySpec arraySpec_;466  ArraySpec coarraySpec_;467  // When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved468  // into attrArraySpec_469  ArraySpec attrArraySpec_;470  ArraySpec attrCoarraySpec_;471 472  void PostAttrSpec();473};474 475// Manages a stack of function result information.  We defer the processing476// of a type specification that appears in the prefix of a FUNCTION statement477// until the function result variable appears in the specification part478// or the end of the specification part.  This allows for forward references479// in the type specification to resolve to local names.480class FuncResultStack {481public:482  explicit FuncResultStack(ScopeHandler &scopeHandler)483      : scopeHandler_{scopeHandler} {}484  ~FuncResultStack();485 486  struct FuncInfo {487    FuncInfo(const Scope &s, SourceName at) : scope{s}, source{at} {}488    const Scope &scope;489    SourceName source;490    // Parse tree of the type specification in the FUNCTION prefix491    const parser::DeclarationTypeSpec *parsedType{nullptr};492    // Name of the function RESULT in the FUNCTION suffix, if any493    const parser::Name *resultName{nullptr};494    // Result symbol495    Symbol *resultSymbol{nullptr};496    bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt497    // Functions with previous implicitly-typed references get those types498    // checked against their later definitions.499    const DeclTypeSpec *previousImplicitType{nullptr};500    SourceName previousName;501  };502 503  // Completes the definition of the top function's result.504  void CompleteFunctionResultType();505  // Completes the definition of a symbol if it is the top function's result.506  void CompleteTypeIfFunctionResult(Symbol &);507 508  FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); }509  FuncInfo &Push(const Scope &scope, SourceName at) {510    return stack_.emplace_back(scope, at);511  }512  void Pop();513 514private:515  ScopeHandler &scopeHandler_;516  std::vector<FuncInfo> stack_;517};518 519// Manage a stack of Scopes520class ScopeHandler : public ImplicitRulesVisitor {521public:522  using ImplicitRulesVisitor::Post;523  using ImplicitRulesVisitor::Pre;524 525  Scope &currScope() { return DEREF(currScope_); }526  // The enclosing host procedure if current scope is in an internal procedure527  Scope *GetHostProcedure();528  // The innermost enclosing program unit scope, ignoring BLOCK and other529  // construct scopes.530  Scope &InclusiveScope();531  // The enclosing scope, skipping derived types.532  Scope &NonDerivedTypeScope();533 534  // Create a new scope and push it on the scope stack.535  void PushScope(Scope::Kind kind, Symbol *symbol);536  void PushScope(Scope &scope);537  void PopScope();538  void SetScope(Scope &);539 540  template <typename T> bool Pre(const parser::Statement<T> &x) {541    messageHandler().set_currStmtSource(x.source);542    currScope_->AddSourceRange(x.source);543    return true;544  }545  template <typename T> void Post(const parser::Statement<T> &) {546    messageHandler().set_currStmtSource(std::nullopt);547  }548 549  // Special messages: already declared; referencing symbol's declaration;550  // about a type; two names & locations551  void SayAlreadyDeclared(const parser::Name &, Symbol &);552  void SayAlreadyDeclared(const SourceName &, Symbol &);553  void SayAlreadyDeclared(const SourceName &, const SourceName &);554  void SayWithReason(555      const parser::Name &, Symbol &, MessageFixedText &&, Message &&);556  template <typename... A>557  Message &SayWithDecl(558      const parser::Name &, Symbol &, MessageFixedText &&, A &&...args);559  void SayLocalMustBeVariable(const parser::Name &, Symbol &);560  Message &SayDerivedType(561      const SourceName &, MessageFixedText &&, const Scope &);562  Message &Say2(const SourceName &, MessageFixedText &&, const SourceName &,563      MessageFixedText &&);564  Message &Say2(565      const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);566  Message &Say2(567      const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);568 569  // Search for symbol by name in current, parent derived type, and570  // containing scopes571  Symbol *FindSymbol(const parser::Name &);572  Symbol *FindSymbol(const Scope &, const parser::Name &);573  // Search for name only in scope, not in enclosing scopes.574  Symbol *FindInScope(const Scope &, const parser::Name &);575  Symbol *FindInScope(const Scope &, const SourceName &);576  template <typename T> Symbol *FindInScope(const T &name) {577    return FindInScope(currScope(), name);578  }579  // Search for name in a derived type scope and its parents.580  Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);581  Symbol *FindInTypeOrParents(const parser::Name &);582  Symbol *FindInScopeOrBlockConstructs(const Scope &, SourceName);583  Symbol *FindSeparateModuleProcedureInterface(const parser::Name &);584  void EraseSymbol(const parser::Name &);585  void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }586  // Make a new symbol with the name and attrs of an existing one587  Symbol &CopySymbol(const SourceName &, const Symbol &);588 589  // Make symbols in the current or named scope590  Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);591  Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});592  Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});593  Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);594 595  template <typename D>596  common::IfNoLvalue<Symbol &, D> MakeSymbol(597      const parser::Name &name, D &&details) {598    return MakeSymbol(name, Attrs{}, std::move(details));599  }600 601  template <typename D>602  common::IfNoLvalue<Symbol &, D> MakeSymbol(603      const parser::Name &name, const Attrs &attrs, D &&details) {604    return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));605  }606 607  template <typename D>608  common::IfNoLvalue<Symbol &, D> MakeSymbol(609      const SourceName &name, const Attrs &attrs, D &&details) {610    // Note: don't use FindSymbol here. If this is a derived type scope,611    // we want to detect whether the name is already declared as a component.612    auto *symbol{FindInScope(name)};613    if (!symbol) {614      symbol = &MakeSymbol(name, attrs);615      symbol->set_details(std::move(details));616      return *symbol;617    }618    if constexpr (std::is_same_v<DerivedTypeDetails, D>) {619      if (auto *d{symbol->detailsIf<GenericDetails>()}) {620        if (!d->specific()) {621          // derived type with same name as a generic622          auto *derivedType{d->derivedType()};623          if (!derivedType) {624            derivedType =625                &currScope().MakeSymbol(name, attrs, std::move(details));626            d->set_derivedType(*derivedType);627          } else if (derivedType->CanReplaceDetails(details)) {628            // was forward-referenced629            CheckDuplicatedAttrs(name, *symbol, attrs);630            SetExplicitAttrs(*derivedType, attrs);631            derivedType->set_details(std::move(details));632          } else {633            SayAlreadyDeclared(name, *derivedType);634          }635          return *derivedType;636        }637      }638    } else if constexpr (std::is_same_v<ProcEntityDetails, D>) {639      if (auto *d{symbol->detailsIf<GenericDetails>()}) {640        if (!d->derivedType()) {641          // procedure pointer with same name as a generic642          auto *specific{d->specific()};643          if (!specific) {644            specific = &currScope().MakeSymbol(name, attrs, std::move(details));645            d->set_specific(*specific);646          } else {647            SayAlreadyDeclared(name, *specific);648          }649          return *specific;650        }651      }652    }653    if (symbol->CanReplaceDetails(details)) {654      // update the existing symbol655      if constexpr (std::is_same_v<SubprogramDetails, D>) {656        // Dummy argument defined by explicit interface?657        details.set_isDummy(IsDummy(*symbol));658        if (symbol->has<ProcEntityDetails>()) {659          // Bare "EXTERNAL" dummy replaced with explicit INTERFACE660          context().Warn(common::LanguageFeature::RedundantAttribute, name,661              "Dummy argument '%s' was declared earlier as EXTERNAL"_warn_en_US,662              name);663        }664      }665      CheckDuplicatedAttrs(name, *symbol, attrs);666      SetExplicitAttrs(*symbol, attrs);667      symbol->set_details(std::move(details));668      return *symbol;669    } else if constexpr (std::is_same_v<UnknownDetails, D>) {670      CheckDuplicatedAttrs(name, *symbol, attrs);671      SetExplicitAttrs(*symbol, attrs);672      return *symbol;673    } else {674      if (!CheckPossibleBadForwardRef(*symbol)) {675        if (name.empty() && symbol->name().empty()) {676          // report the error elsewhere677          return *symbol;678        }679        Symbol &errSym{*symbol};680        if (auto *d{symbol->detailsIf<GenericDetails>()}) {681          if (d->specific()) {682            errSym = *d->specific();683          } else if (d->derivedType()) {684            errSym = *d->derivedType();685          }686        }687        SayAlreadyDeclared(name, errSym);688      }689      // replace the old symbol with a new one with correct details690      EraseSymbol(*symbol);691      auto &result{MakeSymbol(name, attrs, std::move(details))};692      context().SetError(result);693      return result;694    }695  }696 697  void MakeExternal(Symbol &);698 699  // C815 duplicated attribute checking; returns false on error700  bool CheckDuplicatedAttr(SourceName, Symbol &, Attr);701  bool CheckDuplicatedAttrs(SourceName, Symbol &, Attrs);702 703  void SetExplicitAttr(Symbol &symbol, Attr attr) const {704    symbol.attrs().set(attr);705    symbol.implicitAttrs().reset(attr);706  }707  void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const {708    symbol.attrs() |= attrs;709    symbol.implicitAttrs() &= ~attrs;710  }711  void SetImplicitAttr(Symbol &symbol, Attr attr) const {712    symbol.attrs().set(attr);713    symbol.implicitAttrs().set(attr);714  }715  void SetCUDADataAttr(716      SourceName, Symbol &, std::optional<common::CUDADataAttr>);717 718protected:719  FuncResultStack &funcResultStack() { return funcResultStack_; }720 721  // Apply the implicit type rules to this symbol.722  void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);723  bool ImplicitlyTypeForwardRef(Symbol &);724  void AcquireIntrinsicProcedureFlags(Symbol &);725  const DeclTypeSpec *GetImplicitType(726      Symbol &, bool respectImplicitNoneType = true);727  void CheckEntryDummyUse(SourceName, Symbol *);728  bool ConvertToObjectEntity(Symbol &);729  bool ConvertToProcEntity(Symbol &, std::optional<SourceName> = std::nullopt);730 731  const DeclTypeSpec &MakeNumericType(732      TypeCategory, const std::optional<parser::KindSelector> &);733  const DeclTypeSpec &MakeNumericType(TypeCategory, int);734  const DeclTypeSpec &MakeLogicalType(735      const std::optional<parser::KindSelector> &);736  const DeclTypeSpec &MakeLogicalType(int);737  void NotePossibleBadForwardRef(const parser::Name &);738  std::optional<SourceName> HadForwardRef(const Symbol &) const;739  bool CheckPossibleBadForwardRef(const Symbol &);740  bool ConvertToUseError(Symbol &, const SourceName &, const Symbol &used);741 742  bool inSpecificationPart_{false};743  bool deferImplicitTyping_{false};744  bool skipImplicitTyping_{false};745  bool inEquivalenceStmt_{false};746 747  // Some information is collected from a specification part for deferred748  // processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts())749  // that are called by ResolveNamesVisitor::FinishSpecificationPart().  Since750  // specification parts can nest (e.g., INTERFACE bodies), the collected751  // information that is not contained in the scope needs to be packaged752  // and restorable.753  struct SpecificationPartState {754    std::set<SourceName> forwardRefs;755    // Collect equivalence sets and process at end of specification part756    std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets;757    // Names of all common block objects in the scope758    std::set<SourceName> commonBlockObjects;759    // Names of all names that show in a declare target declaration760    std::set<SourceName> declareTargetNames;761    // Info about SAVE statements and attributes in current scope762    struct {763      std::optional<SourceName> saveAll; // "SAVE" without entity list764      std::set<SourceName> entities; // names of entities with save attr765      std::set<SourceName> commons; // names of common blocks with save attr766    } saveInfo;767  } specPartState_;768 769  // Some declaration processing can and should be deferred to770  // ResolveExecutionParts() to avoid prematurely creating implicitly-typed771  // local symbols that should be host associations.772  struct DeferredDeclarationState {773    // The content of each namelist group774    std::list<const parser::NamelistStmt::Group *> namelistGroups;775  };776  DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) {777    if (!add && deferred_.find(&currScope()) == deferred_.end()) {778      return nullptr;779    } else {780      return &deferred_.emplace(&currScope(), DeferredDeclarationState{})781                  .first->second;782    }783  }784 785  void SkipImplicitTyping(bool skip) {786    deferImplicitTyping_ = skipImplicitTyping_ = skip;787  }788 789  void NoteEarlyDeclaredDummyArgument(Symbol &symbol) {790    earlyDeclaredDummyArguments_.insert(symbol);791  }792  bool IsEarlyDeclaredDummyArgument(Symbol &symbol) {793    return earlyDeclaredDummyArguments_.find(symbol) !=794        earlyDeclaredDummyArguments_.end();795  }796  void ForgetEarlyDeclaredDummyArgument(Symbol &symbol) {797    earlyDeclaredDummyArguments_.erase(symbol);798  }799 800private:801  Scope *currScope_{nullptr};802  FuncResultStack funcResultStack_{*this};803  std::map<Scope *, DeferredDeclarationState> deferred_;804  UnorderedSymbolSet earlyDeclaredDummyArguments_;805};806 807class ModuleVisitor : public virtual ScopeHandler {808public:809  bool Pre(const parser::AccessStmt &);810  bool Pre(const parser::Only &);811  bool Pre(const parser::Rename::Names &);812  bool Pre(const parser::Rename::Operators &);813  bool Pre(const parser::UseStmt &);814  void Post(const parser::UseStmt &);815 816  void BeginModule(const parser::Name &, bool isSubmodule);817  bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);818  void ApplyDefaultAccess();819  Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);820  void AddAndCheckModuleUse(SourceName, bool isIntrinsic);821  void CollectUseRenames(const parser::UseStmt &);822  void ClearUseRenames() { useRenames_.clear(); }823  void ClearUseOnly() { useOnly_.clear(); }824  void ClearModuleUses() {825    intrinsicUses_.clear();826    nonIntrinsicUses_.clear();827  }828 829private:830  // The location of the last AccessStmt without access-ids, if any.831  std::optional<SourceName> prevAccessStmt_;832  // The scope of the module during a UseStmt833  Scope *useModuleScope_{nullptr};834  // Names that have appeared in a rename clause of USE statements835  std::set<std::pair<SourceName, SourceName>> useRenames_;836  // Names that have appeared in an ONLY clause of a USE statement837  std::set<std::pair<SourceName, Scope *>> useOnly_;838  // Intrinsic and non-intrinsic (explicit or not) module names that839  // have appeared in USE statements; used for C1406 warnings.840  std::set<SourceName> intrinsicUses_;841  std::set<SourceName> nonIntrinsicUses_;842 843  Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);844  // A rename in a USE statement: local => use845  struct SymbolRename {846    Symbol *local{nullptr};847    Symbol *use{nullptr};848  };849  // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol850  SymbolRename AddUse(const SourceName &localName, const SourceName &useName);851  SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);852  void DoAddUse(853      SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol);854  void AddUse(const GenericSpecInfo &);855  // Record a name appearing as the target of a USE rename clause856  void AddUseRename(SourceName name, SourceName moduleName) {857    useRenames_.emplace(std::make_pair(name, moduleName));858  }859  bool IsUseRenamed(const SourceName &name) const {860    return useModuleScope_ && useModuleScope_->symbol() &&861        useRenames_.find({name, useModuleScope_->symbol()->name()}) !=862        useRenames_.end();863  }864  // Record a name appearing in a USE ONLY clause865  void AddUseOnly(const SourceName &name) {866    useOnly_.emplace(std::make_pair(name, useModuleScope_));867  }868  bool IsUseOnly(const SourceName &name) const {869    return useOnly_.find({name, useModuleScope_}) != useOnly_.end();870  }871  Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic,872      Scope *ancestor = nullptr);873};874 875class GenericHandler : public virtual ScopeHandler {876protected:877  using ProcedureKind = parser::ProcedureStmt::Kind;878  void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart);879  void DeclaredPossibleSpecificProc(Symbol &);880 881  // Mappings of generics to their as-yet specific proc names and kinds882  using SpecificProcMapType =883      std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>;884  SpecificProcMapType specificsForGenericProcs_;885  // inversion of SpecificProcMapType: maps pending proc names to generics886  using GenericProcMapType = std::multimap<SourceName, Symbol *>;887  GenericProcMapType genericsForSpecificProcs_;888};889 890class InterfaceVisitor : public virtual ScopeHandler,891                         public virtual GenericHandler {892public:893  bool Pre(const parser::InterfaceStmt &);894  void Post(const parser::InterfaceStmt &);895  void Post(const parser::EndInterfaceStmt &);896  bool Pre(const parser::GenericSpec &);897  bool Pre(const parser::ProcedureStmt &);898  bool Pre(const parser::GenericStmt &);899  void Post(const parser::GenericStmt &);900 901  bool inInterfaceBlock() const;902  bool isGeneric() const;903  bool isAbstract() const;904 905protected:906  Symbol &GetGenericSymbol() { return DEREF(genericInfo_.top().symbol); }907  // Add to generic the symbol for the subprogram with the same name908  void CheckGenericProcedures(Symbol &);909 910private:911  // A new GenericInfo is pushed for each interface block and generic stmt912  struct GenericInfo {913    GenericInfo(bool isInterface, bool isAbstract = false)914        : isInterface{isInterface}, isAbstract{isAbstract} {}915    bool isInterface; // in interface block916    bool isAbstract; // in abstract interface block917    Symbol *symbol{nullptr}; // the generic symbol being defined918  };919  std::stack<GenericInfo> genericInfo_;920  const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }921  void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }922  void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);923  void ResolveNewSpecifics();924};925 926class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {927public:928  bool HandleStmtFunction(const parser::StmtFunctionStmt &);929  bool Pre(const parser::SubroutineStmt &);930  bool Pre(const parser::FunctionStmt &);931  void Post(const parser::FunctionStmt &);932  bool Pre(const parser::EntryStmt &);933  void Post(const parser::EntryStmt &);934  bool Pre(const parser::InterfaceBody::Subroutine &);935  void Post(const parser::InterfaceBody::Subroutine &);936  bool Pre(const parser::InterfaceBody::Function &);937  void Post(const parser::InterfaceBody::Function &);938  bool Pre(const parser::Suffix &);939  bool Pre(const parser::PrefixSpec &);940  bool Pre(const parser::PrefixSpec::Attributes &);941  void Post(const parser::PrefixSpec::Launch_Bounds &);942  void Post(const parser::PrefixSpec::Cluster_Dims &);943 944  bool BeginSubprogram(const parser::Name &, Symbol::Flag,945      bool hasModulePrefix = false,946      const parser::LanguageBindingSpec * = nullptr,947      const ProgramTree::EntryStmtList * = nullptr);948  bool BeginMpSubprogram(const parser::Name &);949  void PushBlockDataScope(const parser::Name &);950  void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt,951      const std::optional<parser::LanguageBindingSpec> * = nullptr,952      const ProgramTree::EntryStmtList * = nullptr);953 954protected:955  // Set when we see a stmt function that is really an array element assignment956  bool misparsedStmtFuncFound_{false};957 958private:959  // Edits an existing symbol created for earlier calls to a subprogram or ENTRY960  // so that it can be replaced by a later definition.961  bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);962  const Symbol *CheckExtantProc(const parser::Name &, Symbol::Flag);963  // Create a subprogram symbol in the current scope and push a new scope.964  Symbol *PushSubprogramScope(const parser::Name &, Symbol::Flag,965      const parser::LanguageBindingSpec * = nullptr,966      bool hasModulePrefix = false);967  Symbol *GetSpecificFromGeneric(const parser::Name &);968  Symbol &PostSubprogramStmt();969  void CreateDummyArgument(SubprogramDetails &, const parser::Name &);970  void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);971  void PostEntryStmt(const parser::EntryStmt &stmt);972  void HandleLanguageBinding(Symbol *,973      std::optional<parser::CharBlock> stmtSource,974      const std::optional<parser::LanguageBindingSpec> *);975};976 977class DeclarationVisitor : public ArraySpecVisitor,978                           public virtual GenericHandler {979public:980  using ArraySpecVisitor::Post;981  using ScopeHandler::Post;982  using ScopeHandler::Pre;983 984  bool Pre(const parser::Initialization &);985  void Post(const parser::EntityDecl &);986  void Post(const parser::ObjectDecl &);987  void Post(const parser::PointerDecl &);988  bool Pre(const parser::BindStmt &) { return BeginAttrs(); }989  void Post(const parser::BindStmt &) { EndAttrs(); }990  bool Pre(const parser::BindEntity &);991  bool Pre(const parser::OldParameterStmt &);992  bool Pre(const parser::NamedConstantDef &);993  bool Pre(const parser::NamedConstant &);994  void Post(const parser::EnumDef &);995  bool Pre(const parser::Enumerator &);996  bool Pre(const parser::AccessSpec &);997  bool Pre(const parser::AsynchronousStmt &);998  bool Pre(const parser::ContiguousStmt &);999  bool Pre(const parser::ExternalStmt &);1000  bool Pre(const parser::IntentStmt &);1001  bool Pre(const parser::IntrinsicStmt &);1002  bool Pre(const parser::OptionalStmt &);1003  bool Pre(const parser::ProtectedStmt &);1004  bool Pre(const parser::ValueStmt &);1005  bool Pre(const parser::VolatileStmt &);1006  bool Pre(const parser::AllocatableStmt &) {1007    objectDeclAttr_ = Attr::ALLOCATABLE;1008    return true;1009  }1010  void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }1011  bool Pre(const parser::TargetStmt &) {1012    objectDeclAttr_ = Attr::TARGET;1013    return true;1014  }1015  bool Pre(const parser::CUDAAttributesStmt &);1016  void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }1017  void Post(const parser::DimensionStmt::Declaration &);1018  void Post(const parser::CodimensionDecl &);1019  bool Pre(const parser::TypeDeclarationStmt &);1020  void Post(const parser::TypeDeclarationStmt &);1021  void Post(const parser::IntegerTypeSpec &);1022  void Post(const parser::UnsignedTypeSpec &);1023  void Post(const parser::IntrinsicTypeSpec::Real &);1024  void Post(const parser::IntrinsicTypeSpec::Complex &);1025  void Post(const parser::IntrinsicTypeSpec::Logical &);1026  void Post(const parser::IntrinsicTypeSpec::Character &);1027  void Post(const parser::CharSelector::LengthAndKind &);1028  void Post(const parser::CharLength &);1029  void Post(const parser::LengthSelector &);1030  bool Pre(const parser::KindParam &);1031  bool Pre(const parser::VectorTypeSpec &);1032  void Post(const parser::VectorTypeSpec &);1033  bool Pre(const parser::DeclarationTypeSpec::Type &);1034  void Post(const parser::DeclarationTypeSpec::Type &);1035  bool Pre(const parser::DeclarationTypeSpec::Class &);1036  void Post(const parser::DeclarationTypeSpec::Class &);1037  void Post(const parser::DeclarationTypeSpec::Record &);1038  void Post(const parser::DerivedTypeSpec &);1039  bool Pre(const parser::DerivedTypeDef &);1040  bool Pre(const parser::DerivedTypeStmt &);1041  void Post(const parser::DerivedTypeStmt &);1042  bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }1043  void Post(const parser::TypeParamDefStmt &);1044  bool Pre(const parser::TypeAttrSpec::Extends &);1045  bool Pre(const parser::PrivateStmt &);1046  bool Pre(const parser::SequenceStmt &);1047  bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }1048  void Post(const parser::ComponentDefStmt &) { EndDecl(); }1049  void Post(const parser::ComponentDecl &);1050  void Post(const parser::FillDecl &);1051  bool Pre(const parser::ProcedureDeclarationStmt &);1052  void Post(const parser::ProcedureDeclarationStmt &);1053  bool Pre(const parser::DataComponentDefStmt &); // returns false1054  bool Pre(const parser::ProcComponentDefStmt &);1055  void Post(const parser::ProcComponentDefStmt &);1056  bool Pre(const parser::ProcPointerInit &);1057  void Post(const parser::ProcInterface &);1058  void Post(const parser::ProcDecl &);1059  bool Pre(const parser::TypeBoundProcedurePart &);1060  void Post(const parser::TypeBoundProcedurePart &);1061  void Post(const parser::ContainsStmt &);1062  bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }1063  void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }1064  void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);1065  void Post(const parser::TypeBoundProcedureStmt::WithInterface &);1066  bool Pre(const parser::FinalProcedureStmt &);1067  bool Pre(const parser::TypeBoundGenericStmt &);1068  bool Pre(const parser::StructureDef &); // returns false1069  bool Pre(const parser::Union::UnionStmt &);1070  bool Pre(const parser::StructureField &);1071  void Post(const parser::StructureField &);1072  bool Pre(const parser::AllocateStmt &);1073  void Post(const parser::AllocateStmt &);1074  bool Pre(const parser::StructureConstructor &);1075  bool Pre(const parser::NamelistStmt::Group &);1076  bool Pre(const parser::IoControlSpec &);1077  bool Pre(const parser::CommonStmt::Block &);1078  bool Pre(const parser::CommonBlockObject &);1079  void Post(const parser::CommonBlockObject &);1080  bool Pre(const parser::EquivalenceStmt &);1081  bool Pre(const parser::SaveStmt &);1082  bool Pre(const parser::BasedPointer &);1083  void Post(const parser::BasedPointer &);1084 1085  void PointerInitialization(1086      const parser::Name &, const parser::InitialDataTarget &);1087  void PointerInitialization(1088      const parser::Name &, const parser::ProcPointerInit &);1089  bool CheckNonPointerInitialization(1090      const parser::Name &, bool inLegacyDataInitialization);1091  void NonPointerInitialization(1092      const parser::Name &, const parser::ConstantExpr &);1093  void LegacyDataInitialization(const parser::Name &,1094      const std::list<common::Indirection<parser::DataStmtValue>> &values);1095  void CheckExplicitInterface(const parser::Name &);1096  void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);1097 1098  const parser::Name *ResolveDesignator(const parser::Designator &);1099  int GetVectorElementKind(1100      TypeCategory category, const std::optional<parser::KindSelector> &kind);1101 1102protected:1103  bool BeginDecl();1104  void EndDecl();1105  Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});1106  // Make sure that there's an entity in an enclosing scope called Name1107  Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);1108  // Declare a LOCAL/LOCAL_INIT/REDUCE entity while setting a locality flag. If1109  // there isn't a type specified it comes from the entity in the containing1110  // scope, or implicit rules.1111  void DeclareLocalEntity(const parser::Name &, Symbol::Flag);1112  // Declare a statement entity (i.e., an implied DO loop index for1113  // a DATA statement or an array constructor).  If there isn't an explict1114  // type specified, implicit rules apply. Return pointer to the new symbol,1115  // or nullptr on error.1116  Symbol *DeclareStatementEntity(const parser::DoVariable &,1117      const std::optional<parser::IntegerTypeSpec> &);1118  Symbol &MakeCommonBlockSymbol(const parser::Name &, SourceName);1119  Symbol &MakeCommonBlockSymbol(1120      const std::optional<parser::Name> &, SourceName);1121  bool CheckUseError(const parser::Name &);1122  void CheckAccessibility(const SourceName &, bool, Symbol &);1123  void CheckCommonBlocks();1124  void CheckSaveStmts();1125  void CheckEquivalenceSets();1126  bool CheckNotInBlock(const char *);1127  bool NameIsKnownOrIntrinsic(const parser::Name &);1128  void FinishNamelists();1129 1130  // Each of these returns a pointer to a resolved Name (i.e. with symbol)1131  // or nullptr in case of error.1132  const parser::Name *ResolveStructureComponent(1133      const parser::StructureComponent &);1134  const parser::Name *ResolveDataRef(const parser::DataRef &);1135  const parser::Name *ResolveName(const parser::Name &);1136  bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);1137  Symbol *NoteInterfaceName(const parser::Name &);1138  bool IsUplevelReference(const Symbol &);1139 1140  std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(1141      const parser::DoVariable &name) {1142    std::optional<SourceName> result{checkIndexUseInOwnBounds_};1143    checkIndexUseInOwnBounds_ = parser::UnwrapRef<parser::Name>(name).source;1144    return result;1145  }1146  void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {1147    checkIndexUseInOwnBounds_ = restore;1148  }1149  void NoteScalarSpecificationArgument(const Symbol &symbol) {1150    mustBeScalar_.emplace(symbol);1151  }1152  // Declare an object or procedure entity.1153  // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails1154  template <typename T>1155  Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {1156    Symbol &symbol{MakeSymbol(name, attrs)};1157    if (context().HasError(symbol) || symbol.has<T>()) {1158      return symbol; // OK or error already reported1159    } else if (symbol.has<UnknownDetails>()) {1160      symbol.set_details(T{});1161      return symbol;1162    } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {1163      symbol.set_details(T{std::move(*details)});1164      return symbol;1165    } else if (std::is_same_v<EntityDetails, T> &&1166        (symbol.has<ObjectEntityDetails>() ||1167            symbol.has<ProcEntityDetails>())) {1168      return symbol; // OK1169    } else if (auto *details{symbol.detailsIf<UseDetails>()}) {1170      Say(name.source,1171          "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,1172          name.source, GetUsedModule(*details).name());1173    } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {1174      if (details->kind() == SubprogramKind::Module) {1175        Say2(name,1176            "Declaration of '%s' conflicts with its use as module procedure"_err_en_US,1177            symbol, "Module procedure definition"_en_US);1178      } else if (details->kind() == SubprogramKind::Internal) {1179        Say2(name,1180            "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,1181            symbol, "Internal procedure definition"_en_US);1182      } else {1183        DIE("unexpected kind");1184      }1185    } else if (std::is_same_v<ObjectEntityDetails, T> &&1186        symbol.has<ProcEntityDetails>()) {1187      SayWithDecl(1188          name, symbol, "'%s' is already declared as a procedure"_err_en_US);1189    } else if (std::is_same_v<ProcEntityDetails, T> &&1190        symbol.has<ObjectEntityDetails>()) {1191      if (FindCommonBlockContaining(symbol)) {1192        SayWithDecl(name, symbol,1193            "'%s' may not be a procedure as it is in a COMMON block"_err_en_US);1194      } else {1195        SayWithDecl(1196            name, symbol, "'%s' is already declared as an object"_err_en_US);1197      }1198    } else if (!CheckPossibleBadForwardRef(symbol)) {1199      SayAlreadyDeclared(name, symbol);1200    }1201    context().SetError(symbol);1202    return symbol;1203  }1204 1205private:1206  // The attribute corresponding to the statement containing an ObjectDecl1207  std::optional<Attr> objectDeclAttr_;1208  // Info about current character type while walking DeclTypeSpec.1209  // Also captures any "*length" specifier on an individual declaration.1210  struct {1211    std::optional<ParamValue> length;1212    std::optional<KindExpr> kind;1213  } charInfo_;1214  // Info about current derived type or STRUCTURE while walking1215  // DerivedTypeDef / StructureDef1216  struct {1217    const parser::Name *extends{nullptr}; // EXTENDS(name)1218    bool privateComps{false}; // components are private by default1219    bool privateBindings{false}; // bindings are private by default1220    bool sawContains{false}; // currently processing bindings1221    bool sequence{false}; // is a sequence type1222    const Symbol *type{nullptr}; // derived type being defined1223    bool isStructure{false}; // is a DEC STRUCTURE1224  } derivedTypeInfo_;1225  // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is1226  // the interface name, if any.1227  const parser::Name *interfaceName_{nullptr};1228  // Map type-bound generic to binding names of its specific bindings1229  std::multimap<Symbol *, const parser::Name *> genericBindings_;1230  // Info about current ENUM1231  struct EnumeratorState {1232    // Enum value must hold inside a C_INT (7.6.2).1233    std::optional<int> value{0};1234  } enumerationState_;1235  // Set for OldParameterStmt processing1236  bool inOldStyleParameterStmt_{false};1237  // Set when walking DATA & array constructor implied DO loop bounds1238  // to warn about use of the implied DO intex therein.1239  std::optional<SourceName> checkIndexUseInOwnBounds_;1240  bool isVectorType_{false};1241  UnorderedSymbolSet mustBeScalar_;1242 1243  bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);1244  Symbol &HandleAttributeStmt(Attr, const parser::Name &);1245  Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);1246  Symbol &DeclareProcEntity(1247      const parser::Name &, Attrs, const Symbol *interface);1248  void SetType(const parser::Name &, const DeclTypeSpec &);1249  std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);1250  std::optional<DerivedTypeSpec> ResolveExtendsType(1251      const parser::Name &, const parser::Name *);1252  Symbol *MakeTypeSymbol(const SourceName &, Details &&);1253  Symbol *MakeTypeSymbol(const parser::Name &, Details &&);1254  bool OkToAddComponent(const parser::Name &, const Symbol *extends = nullptr);1255  ParamValue GetParamValue(1256      const parser::TypeParamValue &, common::TypeParamAttr attr);1257  Attrs HandleSaveName(const SourceName &, Attrs);1258  void AddSaveName(std::set<SourceName> &, const SourceName &);1259  bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);1260  const parser::Name *FindComponent(const parser::Name *, const parser::Name &);1261  void Initialization(const parser::Name &, const parser::Initialization &,1262      bool inComponentDecl);1263  bool FindAndMarkDeclareTargetSymbol(const parser::Name &);1264  bool PassesLocalityChecks(1265      const parser::Name &name, Symbol &symbol, Symbol::Flag flag);1266  bool CheckForHostAssociatedImplicit(const parser::Name &);1267  bool HasCycle(const Symbol &, const Symbol *interface);1268  bool MustBeScalar(const Symbol &symbol) const {1269    return mustBeScalar_.find(symbol) != mustBeScalar_.end();1270  }1271  void DeclareIntrinsic(const parser::Name &);1272};1273 1274// Resolve construct entities and statement entities.1275// Check that construct names don't conflict with other names.1276class ConstructVisitor : public virtual DeclarationVisitor {1277public:1278  bool Pre(const parser::ConcurrentHeader &);1279  bool Pre(const parser::LocalitySpec::Local &);1280  bool Pre(const parser::LocalitySpec::LocalInit &);1281  bool Pre(const parser::LocalitySpec::Reduce &);1282  bool Pre(const parser::LocalitySpec::Shared &);1283  bool Pre(const parser::AcSpec &);1284  bool Pre(const parser::AcImpliedDo &);1285  bool Pre(const parser::DataImpliedDo &);1286  bool Pre(const parser::DataIDoObject &);1287  bool Pre(const parser::DataStmtObject &);1288  bool Pre(const parser::DataStmtValue &);1289  bool Pre(const parser::DoConstruct &);1290  void Post(const parser::DoConstruct &);1291  bool Pre(const parser::ForallConstruct &);1292  void Post(const parser::ForallConstruct &);1293  bool Pre(const parser::ForallStmt &);1294  void Post(const parser::ForallStmt &);1295  bool Pre(const parser::BlockConstruct &);1296  void Post(const parser::Selector &);1297  void Post(const parser::AssociateStmt &);1298  void Post(const parser::EndAssociateStmt &);1299  bool Pre(const parser::Association &);1300  void Post(const parser::SelectTypeStmt &);1301  void Post(const parser::SelectRankStmt &);1302  bool Pre(const parser::SelectTypeConstruct &);1303  void Post(const parser::SelectTypeConstruct &);1304  bool Pre(const parser::SelectTypeConstruct::TypeCase &);1305  void Post(const parser::SelectTypeConstruct::TypeCase &);1306  // Creates Block scopes with neither symbol name nor symbol details.1307  bool Pre(const parser::SelectRankConstruct::RankCase &);1308  void Post(const parser::SelectRankConstruct::RankCase &);1309  bool Pre(const parser::TypeGuardStmt::Guard &);1310  void Post(const parser::TypeGuardStmt::Guard &);1311  void Post(const parser::SelectRankCaseStmt::Rank &);1312  bool Pre(const parser::ChangeTeamStmt &);1313  void Post(const parser::EndChangeTeamStmt &);1314  void Post(const parser::CoarrayAssociation &);1315 1316  // Definitions of construct names1317  bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }1318  bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }1319  bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }1320  bool Pre(const parser::LabelDoStmt &) {1321    return false; // error recovery1322  }1323  bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }1324  bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }1325  bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }1326  bool Pre(const parser::SelectRankConstruct &);1327  void Post(const parser::SelectRankConstruct &);1328  bool Pre(const parser::SelectRankStmt &x) {1329    return CheckDef(std::get<0>(x.t));1330  }1331  bool Pre(const parser::SelectTypeStmt &x) {1332    return CheckDef(std::get<0>(x.t));1333  }1334 1335  // References to construct names1336  void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }1337  void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }1338  void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }1339  void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }1340  void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }1341  void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }1342  void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }1343  void Post(const parser::ElseStmt &x) { CheckRef(x.v); }1344  void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }1345  void Post(const parser::CaseStmt &x) { CheckRef(x.t); }1346  void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }1347  void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }1348  void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }1349  void Post(const parser::CycleStmt &x) { CheckRef(x.v); }1350  void Post(const parser::ExitStmt &x) { CheckRef(x.v); }1351 1352  void HandleImpliedAsynchronousInScope(const parser::Block &);1353 1354private:1355  // R1105 selector -> expr | variable1356  // expr is set in either case unless there were errors1357  struct Selector {1358    Selector() {}1359    Selector(const SourceName &source, MaybeExpr &&expr)1360        : source{source}, expr{std::move(expr)} {}1361    operator bool() const { return expr.has_value(); }1362    parser::CharBlock source;1363    MaybeExpr expr;1364  };1365  // association -> [associate-name =>] selector1366  struct Association {1367    const parser::Name *name{nullptr};1368    Selector selector;1369  };1370  std::vector<Association> associationStack_;1371  Association *currentAssociation_{nullptr};1372 1373  template <typename T> bool CheckDef(const T &t) {1374    return CheckDef(std::get<std::optional<parser::Name>>(t));1375  }1376  template <typename T> void CheckRef(const T &t) {1377    CheckRef(std::get<std::optional<parser::Name>>(t));1378  }1379  bool CheckDef(const std::optional<parser::Name> &);1380  void CheckRef(const std::optional<parser::Name> &);1381  const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);1382  const DeclTypeSpec &ToDeclTypeSpec(1383      evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);1384  Symbol *MakeAssocEntity();1385  void SetTypeFromAssociation(Symbol &);1386  void SetAttrsFromAssociation(Symbol &);1387  Selector ResolveSelector(const parser::Selector &);1388  void ResolveIndexName(const parser::ConcurrentControl &control);1389  void SetCurrentAssociation(std::size_t n);1390  Association &GetCurrentAssociation();1391  void PushAssociation();1392  void PopAssociation(std::size_t count = 1);1393};1394 1395// Create scopes for OpenACC constructs1396class AccVisitor : public virtual DeclarationVisitor {1397public:1398  explicit AccVisitor(SemanticsContext &context) : context_{context} {}1399 1400  void AddAccSourceRange(const parser::CharBlock &);1401 1402  static bool NeedsScope(const parser::OpenACCBlockConstruct &);1403 1404  bool Pre(const parser::OpenACCBlockConstruct &);1405  void Post(const parser::OpenACCBlockConstruct &);1406  bool Pre(const parser::OpenACCCombinedConstruct &);1407  void Post(const parser::OpenACCCombinedConstruct &);1408  bool Pre(const parser::AccClause::UseDevice &x);1409  bool Pre(const parser::AccBeginBlockDirective &x) {1410    AddAccSourceRange(x.source);1411    return true;1412  }1413  void Post(const parser::AccBeginBlockDirective &) {1414    messageHandler().set_currStmtSource(std::nullopt);1415  }1416  bool Pre(const parser::AccEndBlockDirective &x) {1417    AddAccSourceRange(x.source);1418    return true;1419  }1420  void Post(const parser::AccEndBlockDirective &) {1421    messageHandler().set_currStmtSource(std::nullopt);1422  }1423  bool Pre(const parser::AccBeginCombinedDirective &x) {1424    AddAccSourceRange(x.source);1425    return true;1426  }1427  void Post(const parser::AccBeginCombinedDirective &) {1428    messageHandler().set_currStmtSource(std::nullopt);1429  }1430  bool Pre(const parser::AccEndCombinedDirective &x) {1431    AddAccSourceRange(x.source);1432    return true;1433  }1434  void Post(const parser::AccEndCombinedDirective &) {1435    messageHandler().set_currStmtSource(std::nullopt);1436  }1437  bool Pre(const parser::AccBeginLoopDirective &x) {1438    AddAccSourceRange(x.source);1439    return true;1440  }1441  void Post(const parser::AccBeginLoopDirective &x) {1442    messageHandler().set_currStmtSource(std::nullopt);1443  }1444  bool Pre(const parser::OpenACCStandaloneConstruct &x) {1445    currScope().AddSourceRange(x.source);1446    return true;1447  }1448  bool Pre(const parser::OpenACCCacheConstruct &x) {1449    currScope().AddSourceRange(x.source);1450    return true;1451  }1452  bool Pre(const parser::OpenACCWaitConstruct &x) {1453    currScope().AddSourceRange(x.source);1454    return true;1455  }1456  bool Pre(const parser::OpenACCAtomicConstruct &x) {1457    currScope().AddSourceRange(x.source);1458    return true;1459  }1460  bool Pre(const parser::OpenACCEndConstruct &x) {1461    currScope().AddSourceRange(x.source);1462    return true;1463  }1464  bool Pre(const parser::OpenACCDeclarativeConstruct &x) {1465    currScope().AddSourceRange(x.source);1466    return true;1467  }1468 1469  void CopySymbolWithDevice(const parser::Name *name);1470 1471private:1472  SemanticsContext &context_;1473};1474 1475bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) {1476  const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};1477  const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};1478  switch (beginDir.v) {1479  case llvm::acc::Directive::ACCD_data:1480  case llvm::acc::Directive::ACCD_host_data:1481  case llvm::acc::Directive::ACCD_kernels:1482  case llvm::acc::Directive::ACCD_parallel:1483  case llvm::acc::Directive::ACCD_serial:1484    return true;1485  default:1486    return false;1487  }1488}1489 1490void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) {1491  messageHandler().set_currStmtSource(source);1492  currScope().AddSourceRange(source);1493}1494 1495bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) {1496  if (NeedsScope(x)) {1497    PushScope(Scope::Kind::OpenACCConstruct, nullptr);1498  }1499  return true;1500}1501 1502void AccVisitor::CopySymbolWithDevice(const parser::Name *name) {1503  // When CUDA Fortran is enabled together with OpenACC, new1504  // symbols are created for the one appearing in the use_device1505  // clause. These new symbols have the CUDA Fortran device1506  // attribute.1507  if (context_.languageFeatures().IsEnabled(common::LanguageFeature::CUDA) &&1508      name->symbol) {1509    name->symbol = currScope().CopySymbol(*name->symbol);1510    if (auto *object{name->symbol->detailsIf<ObjectEntityDetails>()}) {1511      object->set_cudaDataAttr(common::CUDADataAttr::Device);1512    }1513  }1514}1515 1516bool AccVisitor::Pre(const parser::AccClause::UseDevice &x) {1517  for (const auto &accObject : x.v.v) {1518    Walk(accObject);1519    common::visit(1520        common::visitors{1521            [&](const parser::Designator &designator) {1522              if (const auto *name{1523                      parser::GetDesignatorNameIfDataRef(designator)}) {1524                CopySymbolWithDevice(name);1525              } else {1526                if (const auto *dataRef{1527                        std::get_if<parser::DataRef>(&designator.u)}) {1528                  using ElementIndirection =1529                      common::Indirection<parser::ArrayElement>;1530                  if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {1531                    const parser::ArrayElement &arrayElement{ind->value()};1532                    const parser::DataRef &base{arrayElement.base};1533                    if (auto *name{std::get_if<parser::Name>(&base.u)}) {1534                      CopySymbolWithDevice(name);1535                    }1536                  }1537                }1538              }1539            },1540            [&](const parser::Name &name) {1541              // TODO: common block in use_device?1542            },1543        },1544        accObject.u);1545  }1546  return false;1547}1548 1549void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) {1550  if (NeedsScope(x)) {1551    PopScope();1552  }1553}1554 1555bool AccVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {1556  PushScope(Scope::Kind::OpenACCConstruct, nullptr);1557  currScope().AddSourceRange(x.source);1558  return true;1559}1560 1561void AccVisitor::Post(const parser::OpenACCCombinedConstruct &x) { PopScope(); }1562 1563// Create scopes for OpenMP constructs1564class OmpVisitor : public virtual DeclarationVisitor {1565public:1566  void AddOmpSourceRange(const parser::CharBlock &);1567 1568  static bool NeedsScope(const parser::OmpBlockConstruct &);1569  static bool NeedsScope(const parser::OmpClause &);1570 1571  bool Pre(const parser::OpenMPRequiresConstruct &x) {1572    AddOmpSourceRange(x.source);1573    return true;1574  }1575  bool Pre(const parser::OmpBlockConstruct &);1576  void Post(const parser::OmpBlockConstruct &);1577  bool Pre(const parser::OmpBeginDirective &x) {1578    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1579  }1580  void Post(const parser::OmpBeginDirective &x) {1581    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1582  }1583  bool Pre(const parser::OmpEndDirective &x) {1584    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1585  }1586  void Post(const parser::OmpEndDirective &x) {1587    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1588  }1589 1590  bool Pre(const parser::OpenMPLoopConstruct &) {1591    PushScope(Scope::Kind::OtherConstruct, nullptr);1592    return true;1593  }1594  void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }1595  bool Pre(const parser::OmpBeginLoopDirective &x) {1596    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1597  }1598  void Post(const parser::OmpBeginLoopDirective &x) {1599    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1600  }1601  bool Pre(const parser::OmpEndLoopDirective &x) {1602    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1603  }1604  void Post(const parser::OmpEndLoopDirective &x) {1605    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1606  }1607 1608  void Post(const parser::OmpTypeName &);1609  bool Pre(const parser::OmpStylizedDeclaration &);1610  void Post(const parser::OmpStylizedDeclaration &);1611  bool Pre(const parser::OmpStylizedInstance &);1612  void Post(const parser::OmpStylizedInstance &);1613 1614  bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {1615    AddOmpSourceRange(x.source);1616    return true;1617  }1618 1619  bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {1620    AddOmpSourceRange(x.source);1621    return true;1622  }1623 1624  bool Pre(const parser::OmpDeclareVariantDirective &x) {1625    AddOmpSourceRange(x.source);1626    return true;1627  }1628 1629  bool Pre(const parser::OpenMPDeclareReductionConstruct &x) {1630    AddOmpSourceRange(x.source);1631    return true;1632  }1633  bool Pre(const parser::OmpMapClause &);1634 1635  bool Pre(const parser::OpenMPSectionsConstruct &) {1636    PushScope(Scope::Kind::OtherConstruct, nullptr);1637    return true;1638  }1639  void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }1640  bool Pre(const parser::OmpBeginSectionsDirective &x) {1641    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1642  }1643  void Post(const parser::OmpBeginSectionsDirective &x) {1644    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1645  }1646  bool Pre(const parser::OmpEndSectionsDirective &x) {1647    return Pre(static_cast<const parser::OmpDirectiveSpecification &>(x));1648  }1649  void Post(const parser::OmpEndSectionsDirective &x) {1650    Post(static_cast<const parser::OmpDirectiveSpecification &>(x));1651  }1652  bool Pre(const parser::OpenMPThreadprivate &) {1653    SkipImplicitTyping(true);1654    return true;1655  }1656  void Post(const parser::OpenMPThreadprivate &) { SkipImplicitTyping(false); }1657  bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {1658    auto addObjectName{[&](const parser::OmpObject &object) {1659      common::visit(1660          common::visitors{1661              [&](const parser::Designator &designator) {1662                if (const auto *name{1663                        parser::GetDesignatorNameIfDataRef(designator)}) {1664                  specPartState_.declareTargetNames.insert(name->source);1665                }1666              },1667              [&](const parser::Name &name) {1668                specPartState_.declareTargetNames.insert(name.source);1669              },1670              [&](const parser::OmpObject::Invalid &invalid) {1671                switch (invalid.v) {1672                  SWITCH_COVERS_ALL_CASES1673                case parser::OmpObject::Invalid::Kind::BlankCommonBlock:1674                  context().Say(invalid.source,1675                      "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);1676                  break;1677                }1678              },1679          },1680          object.u);1681    }};1682 1683    for (const parser::OmpArgument &arg : x.v.Arguments().v) {1684      if (auto *object{omp::GetArgumentObject(arg)}) {1685        addObjectName(*object);1686      }1687    }1688 1689    for (const parser::OmpClause &clause : x.v.Clauses().v) {1690      if (auto *objects{parser::omp::GetOmpObjectList(clause)}) {1691        for (const parser::OmpObject &object : objects->v) {1692          addObjectName(object);1693        }1694      }1695    }1696 1697    SkipImplicitTyping(true);1698    return true;1699  }1700  void Post(const parser::OpenMPDeclareTargetConstruct &) {1701    SkipImplicitTyping(false);1702  }1703  bool Pre(const parser::OmpAllocateDirective &x) {1704    AddOmpSourceRange(x.source);1705    SkipImplicitTyping(true);1706    return true;1707  }1708  void Post(const parser::OmpAllocateDirective &) {1709    SkipImplicitTyping(false);1710    messageHandler().set_currStmtSource(std::nullopt);1711  }1712  bool Pre(const parser::OpenMPDeclarativeConstruct &x) {1713    AddOmpSourceRange(x.source);1714    // Without skipping implicit typing, declarative constructs1715    // can implicitly declare variables instead of only using the1716    // ones already declared in the Fortran sources.1717    SkipImplicitTyping(true);1718    declaratives_.push_back(&x);1719    return true;1720  }1721  void Post(const parser::OpenMPDeclarativeConstruct &) {1722    declaratives_.pop_back();1723    SkipImplicitTyping(false);1724    messageHandler().set_currStmtSource(std::nullopt);1725  }1726  bool Pre(const parser::OpenMPDepobjConstruct &x) {1727    AddOmpSourceRange(x.source);1728    return true;1729  }1730  void Post(const parser::OpenMPDepobjConstruct &x) {1731    messageHandler().set_currStmtSource(std::nullopt);1732  }1733  bool Pre(const parser::OpenMPAtomicConstruct &x) {1734    AddOmpSourceRange(x.source);1735    return true;1736  }1737  void Post(const parser::OpenMPAtomicConstruct &) {1738    messageHandler().set_currStmtSource(std::nullopt);1739  }1740  bool Pre(const parser::OmpClause &x) {1741    if (NeedsScope(x)) {1742      PushScope(Scope::Kind::OtherClause, nullptr);1743    }1744    return true;1745  }1746  void Post(const parser::OmpClause &x) {1747    if (NeedsScope(x)) {1748      PopScope();1749    }1750  }1751 1752  // These objects are handled explicitly, and the AST traversal should not1753  // reach a point where it calls the Pre functions for them.1754  bool Pre(const parser::OmpMapperSpecifier &x) {1755    llvm_unreachable("This function should not be reached by AST traversal");1756  }1757  bool Pre(const parser::OmpReductionSpecifier &x) {1758    llvm_unreachable("This function should not be reached by AST traversal");1759  }1760  bool Pre(const parser::OmpBaseVariantNames &x) {1761    llvm_unreachable("This function should not be reached by AST traversal");1762  }1763 1764  bool Pre(const parser::OmpDirectiveSpecification &x);1765  void Post(const parser::OmpDirectiveSpecification &) {1766    messageHandler().set_currStmtSource(std::nullopt);1767  }1768 1769  bool Pre(const parser::OpenMPConstruct &x) {1770    // Indicate that the current directive is not a declarative one.1771    declaratives_.push_back(nullptr);1772    return true;1773  }1774  void Post(const parser::OpenMPConstruct &) {1775    // Pop the null pointer.1776    declaratives_.pop_back();1777  }1778 1779private:1780  void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,1781      const parser::OmpClauseList &clauses);1782  void ProcessReductionSpecifier(const parser::OmpReductionSpecifier &spec,1783      const parser::OmpClauseList &clauses);1784 1785  void ResolveCriticalName(const parser::OmpArgument &arg);1786 1787  std::vector<const parser::OpenMPDeclarativeConstruct *> declaratives_;1788};1789 1790bool OmpVisitor::NeedsScope(const parser::OmpBlockConstruct &x) {1791  switch (x.BeginDir().DirId()) {1792  case llvm::omp::Directive::OMPD_master:1793  case llvm::omp::Directive::OMPD_ordered:1794    return false;1795  default:1796    return true;1797  }1798}1799 1800bool OmpVisitor::NeedsScope(const parser::OmpClause &x) {1801  // Iterators contain declarations, whose scope extends until the end1802  // the clause.1803  return llvm::omp::canHaveIterator(x.Id());1804}1805 1806void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {1807  messageHandler().set_currStmtSource(source);1808  currScope().AddSourceRange(source);1809}1810 1811bool OmpVisitor::Pre(const parser::OmpBlockConstruct &x) {1812  if (NeedsScope(x)) {1813    PushScope(Scope::Kind::OtherConstruct, nullptr);1814  }1815  return true;1816}1817 1818void OmpVisitor::Post(const parser::OmpBlockConstruct &x) {1819  if (NeedsScope(x)) {1820    PopScope();1821  }1822}1823 1824void OmpVisitor::Post(const parser::OmpTypeName &x) {1825  x.declTypeSpec = GetDeclTypeSpec();1826}1827 1828bool OmpVisitor::Pre(const parser::OmpStylizedDeclaration &x) {1829  BeginDecl();1830  Walk(x.type.get());1831  Walk(x.var);1832  return true;1833}1834 1835void OmpVisitor::Post(const parser::OmpStylizedDeclaration &x) { //1836  EndDecl();1837}1838 1839bool OmpVisitor::Pre(const parser::OmpStylizedInstance &x) {1840  PushScope(Scope::Kind::OtherConstruct, nullptr);1841  return true;1842}1843 1844void OmpVisitor::Post(const parser::OmpStylizedInstance &x) { //1845  PopScope();1846}1847 1848bool OmpVisitor::Pre(const parser::OmpMapClause &x) {1849  auto &mods{OmpGetModifiers(x)};1850  if (auto *mapper{OmpGetUniqueModifier<parser::OmpMapper>(mods)}) {1851    if (auto *symbol{FindSymbol(currScope(), mapper->v)}) {1852      // TODO: Do we need a specific flag or type here, to distinghuish against1853      // other ConstructName things? Leaving this for the full implementation1854      // of mapper lowering.1855      auto &ultimate{symbol->GetUltimate()};1856      auto *misc{ultimate.detailsIf<MiscDetails>()};1857      auto *md{ultimate.detailsIf<MapperDetails>()};1858      if (!md && (!misc || misc->kind() != MiscDetails::Kind::ConstructName))1859        context().Say(mapper->v.source,1860            "Name '%s' should be a mapper name"_err_en_US, mapper->v.source);1861      else1862        mapper->v.symbol = symbol;1863    } else {1864      // Allow the special 'default' mapper identifier without prior1865      // declaration so lowering can recognize and handle it. Emit an1866      // error for any other missing mapper identifier.1867      if (mapper->v.source.ToString() == "default") {1868        mapper->v.symbol = &MakeSymbol(1869            mapper->v, MiscDetails{MiscDetails::Kind::ConstructName});1870      } else {1871        context().Say(1872            mapper->v.source, "'%s' not declared"_err_en_US, mapper->v.source);1873      }1874    }1875  }1876  return true;1877}1878 1879void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,1880    const parser::OmpClauseList &clauses) {1881  // This "manually" walks the tree of the construct, because we need1882  // to resolve the type before the map clauses are processed - when1883  // just following the natural flow, the map clauses gets processed before1884  // the type has been fully processed.1885  BeginDeclTypeSpec();1886  auto &mapperName{std::get<std::string>(spec.t)};1887  // Create or update the mapper symbol with MapperDetails and1888  // keep track of the declarative construct for module emission.1889  SourceName mapperSource{context().SaveTempName(std::string{mapperName})};1890  Symbol &mapperSym{MakeSymbol(mapperSource, Attrs{})};1891  if (!mapperSym.detailsIf<MapperDetails>()) {1892    mapperSym.set_details(MapperDetails{});1893  }1894  if (!context().langOptions().OpenMPSimd) {1895    mapperSym.get<MapperDetails>().AddDecl(declaratives_.back());1896  }1897  PushScope(Scope::Kind::OtherConstruct, nullptr);1898  Walk(std::get<parser::TypeSpec>(spec.t));1899  auto &varName{std::get<parser::Name>(spec.t)};1900  DeclareObjectEntity(varName);1901  EndDeclTypeSpec();1902 1903  Walk(clauses);1904  PopScope();1905}1906 1907parser::CharBlock MakeNameFromOperator(1908    const parser::DefinedOperator::IntrinsicOperator &op,1909    SemanticsContext &context) {1910  switch (op) {1911  case parser::DefinedOperator::IntrinsicOperator::Multiply:1912    return parser::CharBlock{"op.*", 4};1913  case parser::DefinedOperator::IntrinsicOperator::Add:1914    return parser::CharBlock{"op.+", 4};1915  case parser::DefinedOperator::IntrinsicOperator::Subtract:1916    return parser::CharBlock{"op.-", 4};1917 1918  case parser::DefinedOperator::IntrinsicOperator::AND:1919    return parser::CharBlock{"op.AND", 6};1920  case parser::DefinedOperator::IntrinsicOperator::OR:1921    return parser::CharBlock{"op.OR", 6};1922  case parser::DefinedOperator::IntrinsicOperator::EQV:1923    return parser::CharBlock{"op.EQV", 7};1924  case parser::DefinedOperator::IntrinsicOperator::NEQV:1925    return parser::CharBlock{"op.NEQV", 8};1926 1927  default:1928    context.Say("Unsupported operator in DECLARE REDUCTION"_err_en_US);1929    return parser::CharBlock{"op.?", 4};1930  }1931}1932 1933parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name) {1934  return llvm::StringSwitch<parser::CharBlock>(name.ToString())1935      .Case("max", {"op.max", 6})1936      .Case("min", {"op.min", 6})1937      .Case("iand", {"op.iand", 7})1938      .Case("ior", {"op.ior", 6})1939      .Case("ieor", {"op.ieor", 7})1940      .Default(name);1941}1942 1943std::string MangleDefinedOperator(const parser::CharBlock &name) {1944  CHECK(name[0] == '.' && name[name.size() - 1] == '.');1945  return "op" + name.ToString();1946}1947 1948void OmpVisitor::ProcessReductionSpecifier(1949    const parser::OmpReductionSpecifier &spec,1950    const parser::OmpClauseList &clauses) {1951  const parser::Name *name{nullptr};1952  parser::CharBlock mangledName;1953  UserReductionDetails reductionDetailsTemp;1954  const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};1955  if (auto *procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {1956    name = std::get_if<parser::Name>(&procDes->u);1957    // This shouldn't be a procedure component: this is the name of the1958    // reduction being declared.1959    CHECK(name);1960    // Prevent the symbol from conflicting with the builtin function name1961    mangledName = MangleSpecialFunctions(name->source);1962    // Note: the Name inside the parse tree is not updated because it is const.1963    // All lookups must use MangleSpecialFunctions.1964  } else {1965    const auto &defOp{std::get<parser::DefinedOperator>(id.u)};1966    if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {1967      name = &definedOp->v;1968      mangledName = context().SaveTempName(MangleDefinedOperator(name->source));1969    } else {1970      mangledName = MakeNameFromOperator(1971          std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),1972          context());1973    }1974  }1975 1976  // Use reductionDetailsTemp if we can't find the symbol (this is1977  // the first, or only, instance with this name). The details then1978  // gets stored in the symbol when it's created.1979  UserReductionDetails *reductionDetails{&reductionDetailsTemp};1980  Symbol *symbol{currScope().FindSymbol(mangledName)};1981  if (symbol) {1982    // If we found a symbol, we append the type info to the1983    // existing reductionDetails.1984    reductionDetails = symbol->detailsIf<UserReductionDetails>();1985 1986    if (!reductionDetails) {1987      context().Say(1988          "Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,1989          mangledName);1990      return;1991    }1992  }1993 1994  reductionDetails->AddDecl(declaratives_.back());1995 1996  // Do not walk OmpTypeNameList. The types on the list will be visited1997  // during procesing of OmpCombinerExpression.1998  Walk(std::get<std::optional<parser::OmpCombinerExpression>>(spec.t));1999  Walk(clauses);2000 2001  for (auto &type : std::get<parser::OmpTypeNameList>(spec.t).v) {2002    // The declTypeSpec can be null if there is some semantic error.2003    if (type.declTypeSpec) {2004      reductionDetails->AddType(*type.declTypeSpec);2005    }2006  }2007 2008  if (!symbol) {2009    symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));2010  }2011  if (name) {2012    name->symbol = symbol;2013  }2014}2015 2016void OmpVisitor::ResolveCriticalName(const parser::OmpArgument &arg) {2017  auto &globalScope{[&]() -> Scope & {2018    for (Scope *s{&currScope()};; s = &s->parent()) {2019      if (s->IsTopLevel()) {2020        return *s;2021      }2022    }2023    llvm_unreachable("Cannot find global scope");2024  }()};2025 2026  if (auto *object{parser::Unwrap<parser::OmpObject>(arg.u)}) {2027    if (auto *desg{omp::GetDesignatorFromObj(*object)}) {2028      if (auto *name{parser::GetDesignatorNameIfDataRef(*desg)}) {2029        if (auto *symbol{FindInScope(globalScope, *name)}) {2030          if (!symbol->test(Symbol::Flag::OmpCriticalLock)) {2031            SayWithDecl(*name, *symbol,2032                "CRITICAL construct name '%s' conflicts with a previous declaration"_warn_en_US,2033                name->ToString());2034          }2035        } else {2036          name->symbol = &MakeSymbol(globalScope, name->source, Attrs{});2037          name->symbol->set(Symbol::Flag::OmpCriticalLock);2038        }2039      }2040    }2041  }2042}2043 2044bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {2045  AddOmpSourceRange(x.source);2046 2047  const parser::OmpArgumentList &args{x.Arguments()};2048  const parser::OmpClauseList &clauses{x.Clauses()};2049  bool visitClauses{true};2050 2051  for (const parser::OmpArgument &arg : args.v) {2052    common::visit( //2053        common::visitors{2054            [&](const parser::OmpMapperSpecifier &spec) {2055              ProcessMapperSpecifier(spec, clauses);2056              visitClauses = false;2057            },2058            [&](const parser::OmpReductionSpecifier &spec) {2059              ProcessReductionSpecifier(spec, clauses);2060              visitClauses = false;2061            },2062            [&](const parser::OmpBaseVariantNames &names) {2063              Walk(std::get<0>(names.t));2064              Walk(std::get<1>(names.t));2065            },2066            [&](const parser::OmpLocator &locator) {2067              // Manually resolve names in CRITICAL directives. This is because2068              // these names do not denote Fortran objects, and the CRITICAL2069              // directive causes them to be "auto-declared", i.e. inserted into2070              // the global scope. More specifically, they are not expected to2071              // have explicit declarations, and if they do the behavior is2072              // unspeficied.2073              if (x.DirId() == llvm::omp::Directive::OMPD_critical) {2074                ResolveCriticalName(arg);2075              } else {2076                Walk(locator);2077              }2078            },2079        },2080        arg.u);2081  }2082 2083  if (visitClauses) {2084    Walk(clauses);2085  }2086 2087  return false;2088}2089 2090// Walk the parse tree and resolve names to symbols.2091class ResolveNamesVisitor : public virtual ScopeHandler,2092                            public ModuleVisitor,2093                            public SubprogramVisitor,2094                            public ConstructVisitor,2095                            public OmpVisitor,2096                            public AccVisitor {2097public:2098  using AccVisitor::Post;2099  using AccVisitor::Pre;2100  using ArraySpecVisitor::Post;2101  using ConstructVisitor::Post;2102  using ConstructVisitor::Pre;2103  using DeclarationVisitor::Post;2104  using DeclarationVisitor::Pre;2105  using ImplicitRulesVisitor::Post;2106  using ImplicitRulesVisitor::Pre;2107  using InterfaceVisitor::Post;2108  using InterfaceVisitor::Pre;2109  using ModuleVisitor::Post;2110  using ModuleVisitor::Pre;2111  using OmpVisitor::Post;2112  using OmpVisitor::Pre;2113  using ScopeHandler::Post;2114  using ScopeHandler::Pre;2115  using SubprogramVisitor::Post;2116  using SubprogramVisitor::Pre;2117 2118  ResolveNamesVisitor(2119      SemanticsContext &context, ImplicitRulesMap &rules, Scope &top)2120      : BaseVisitor{context, *this, rules}, AccVisitor(context),2121        topScope_{top} {2122    PushScope(top);2123  }2124 2125  Scope &topScope() const { return topScope_; }2126 2127  // Default action for a parse tree node is to visit children.2128  template <typename T> bool Pre(const T &) { return true; }2129  template <typename T> void Post(const T &) {}2130 2131  bool Pre(const parser::SpecificationPart &);2132  bool Pre(const parser::Program &);2133  void Post(const parser::Program &);2134  bool Pre(const parser::ImplicitStmt &);2135  void Post(const parser::PointerObject &);2136  void Post(const parser::AllocateObject &);2137  bool Pre(const parser::PointerAssignmentStmt &);2138  void Post(const parser::Designator &);2139  void Post(const parser::SubstringInquiry &);2140  template <typename A, typename B>2141  void Post(const parser::LoopBounds<A, B> &x) {2142    ResolveName(parser::UnwrapRef<parser::Name>(x.name));2143  }2144  void Post(const parser::ProcComponentRef &);2145  bool Pre(const parser::FunctionReference &);2146  bool Pre(const parser::CallStmt &);2147  bool Pre(const parser::ImportStmt &);2148  void Post(const parser::TypeGuardStmt &);2149  bool Pre(const parser::StmtFunctionStmt &);2150  bool Pre(const parser::DefinedOpName &);2151  bool Pre(const parser::ProgramUnit &);2152  void Post(const parser::AssignStmt &);2153  void Post(const parser::AssignedGotoStmt &);2154  void Post(const parser::CompilerDirective &);2155 2156  // These nodes should never be reached: they are handled in ProgramUnit2157  bool Pre(const parser::MainProgram &) {2158    llvm_unreachable("This node is handled in ProgramUnit");2159  }2160  bool Pre(const parser::FunctionSubprogram &) {2161    llvm_unreachable("This node is handled in ProgramUnit");2162  }2163  bool Pre(const parser::SubroutineSubprogram &) {2164    llvm_unreachable("This node is handled in ProgramUnit");2165  }2166  bool Pre(const parser::SeparateModuleSubprogram &) {2167    llvm_unreachable("This node is handled in ProgramUnit");2168  }2169  bool Pre(const parser::Module &) {2170    llvm_unreachable("This node is handled in ProgramUnit");2171  }2172  bool Pre(const parser::Submodule &) {2173    llvm_unreachable("This node is handled in ProgramUnit");2174  }2175  bool Pre(const parser::BlockData &) {2176    llvm_unreachable("This node is handled in ProgramUnit");2177  }2178 2179  void NoteExecutablePartCall(Symbol::Flag, SourceName, bool hasCUDAChevrons);2180 2181  friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);2182 2183private:2184  // Kind of procedure we are expecting to see in a ProcedureDesignator2185  std::optional<Symbol::Flag> expectedProcFlag_;2186  std::optional<SourceName> prevImportStmt_;2187  Scope &topScope_;2188 2189  void PreSpecificationConstruct(const parser::SpecificationConstruct &);2190  void EarlyDummyTypeDeclaration(2191      const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>2192          &);2193  void CreateCommonBlockSymbols(const parser::CommonStmt &);2194  void CreateObjectSymbols(const std::list<parser::ObjectDecl> &, Attr);2195  void CreateGeneric(const parser::GenericSpec &);2196  void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);2197  void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);2198  void CheckImports();2199  void CheckImport(const SourceName &, const SourceName &);2200  void HandleCall(Symbol::Flag, const parser::Call &);2201  void HandleProcedureName(Symbol::Flag, const parser::Name &);2202  bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);2203  bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);2204  void ResolveSpecificationParts(ProgramTree &);2205  void AddSubpNames(ProgramTree &);2206  bool BeginScopeForNode(const ProgramTree &);2207  void EndScopeForNode(const ProgramTree &);2208  void FinishSpecificationParts(const ProgramTree &);2209  void FinishExecutionParts(const ProgramTree &);2210  void FinishDerivedTypeInstantiation(Scope &);2211  void ResolveExecutionParts(const ProgramTree &);2212  void UseCUDABuiltinNames();2213  void HandleDerivedTypesInImplicitStmts(const parser::ImplicitPart &,2214      const std::list<parser::DeclarationConstruct> &);2215};2216 2217// ImplicitRules implementation2218 2219bool ImplicitRules::isImplicitNoneType() const {2220  if (isImplicitNoneType_) {2221    return true;2222  } else if (map_.empty() && inheritFromParent_) {2223    return parent_->isImplicitNoneType();2224  } else {2225    return false; // default if not specified2226  }2227}2228 2229bool ImplicitRules::isImplicitNoneExternal() const {2230  if (isImplicitNoneExternal_) {2231    return true;2232  } else if (inheritFromParent_) {2233    return parent_->isImplicitNoneExternal();2234  } else {2235    return false; // default if not specified2236  }2237}2238 2239const DeclTypeSpec *ImplicitRules::GetType(2240    SourceName name, bool respectImplicitNoneType) const {2241  char ch{name.front()};2242  if (isImplicitNoneType_ && respectImplicitNoneType) {2243    return nullptr;2244  } else if (auto it{map_.find(ch)}; it != map_.end()) {2245    return &*it->second;2246  } else if (inheritFromParent_) {2247    return parent_->GetType(name, respectImplicitNoneType);2248  } else if (ch >= 'i' && ch <= 'n') {2249    return &context_.MakeNumericType(TypeCategory::Integer);2250  } else if (ch >= 'a' && ch <= 'z') {2251    return &context_.MakeNumericType(TypeCategory::Real);2252  } else {2253    return nullptr;2254  }2255}2256 2257void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,2258    parser::Location fromLetter, parser::Location toLetter) {2259  for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {2260    auto res{map_.emplace(ch, type)};2261    if (!res.second) {2262      context_.Say(parser::CharBlock{fromLetter},2263          "More than one implicit type specified for '%c'"_err_en_US, ch);2264    }2265    if (ch == *toLetter) {2266      break;2267    }2268  }2269}2270 2271// Return the next char after ch in a way that works for ASCII or EBCDIC.2272// Return '\0' for the char after 'z'.2273char ImplicitRules::Incr(char ch) {2274  switch (ch) {2275  case 'i':2276    return 'j';2277  case 'r':2278    return 's';2279  case 'z':2280    return '\0';2281  default:2282    return ch + 1;2283  }2284}2285 2286llvm::raw_ostream &operator<<(2287    llvm::raw_ostream &o, const ImplicitRules &implicitRules) {2288  o << "ImplicitRules:\n";2289  for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {2290    ShowImplicitRule(o, implicitRules, ch);2291  }2292  ShowImplicitRule(o, implicitRules, '_');2293  ShowImplicitRule(o, implicitRules, '$');2294  ShowImplicitRule(o, implicitRules, '@');2295  return o;2296}2297void ShowImplicitRule(2298    llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {2299  auto it{implicitRules.map_.find(ch)};2300  if (it != implicitRules.map_.end()) {2301    o << "  " << ch << ": " << *it->second << '\n';2302  }2303}2304 2305template <typename T> void BaseVisitor::Walk(const T &x) {2306  parser::Walk(x, *this_);2307}2308 2309void BaseVisitor::MakePlaceholder(2310    const parser::Name &name, MiscDetails::Kind kind) {2311  if (!name.symbol) {2312    name.symbol = &context_->globalScope().MakeSymbol(2313        name.source, Attrs{}, MiscDetails{kind});2314  }2315}2316 2317// AttrsVisitor implementation2318 2319bool AttrsVisitor::BeginAttrs() {2320  CHECK(!attrs_ && !cudaDataAttr_);2321  attrs_ = Attrs{};2322  return true;2323}2324Attrs AttrsVisitor::GetAttrs() {2325  CHECK(attrs_);2326  return *attrs_;2327}2328Attrs AttrsVisitor::EndAttrs() {2329  Attrs result{GetAttrs()};2330  attrs_.reset();2331  cudaDataAttr_.reset();2332  passName_ = std::nullopt;2333  bindName_.reset();2334  isCDefined_ = false;2335  return result;2336}2337 2338bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {2339  if (!passName_) {2340    return false;2341  }2342  common::visit(common::visitors{2343                    [&](ProcEntityDetails &x) { x.set_passName(*passName_); },2344                    [&](ProcBindingDetails &x) { x.set_passName(*passName_); },2345                    [](auto &) { common::die("unexpected pass name"); },2346                },2347      symbol.details());2348  return true;2349}2350 2351void AttrsVisitor::SetBindNameOn(Symbol &symbol) {2352  if ((!attrs_ || !attrs_->test(Attr::BIND_C)) &&2353      !symbol.attrs().test(Attr::BIND_C)) {2354    return;2355  }2356  symbol.SetIsCDefined(isCDefined_);2357  std::optional<std::string> label{2358      evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};2359  // 18.9.2(2): discard leading and trailing blanks2360  if (label) {2361    symbol.SetIsExplicitBindName(true);2362    auto first{label->find_first_not_of(" ")};2363    if (first == std::string::npos) {2364      // Empty NAME= means no binding at all (18.10.2p2)2365      return;2366    }2367    auto last{label->find_last_not_of(" ")};2368    label = label->substr(first, last - first + 1);2369  } else if (symbol.GetIsExplicitBindName()) {2370    // don't try to override explicit binding name with default2371    return;2372  } else if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) {2373    // BIND(C) does not give an implicit binding label to internal procedures.2374    return;2375  } else {2376    label = symbol.name().ToString();2377  }2378  // Checks whether a symbol has two Bind names.2379  std::string oldBindName;2380  if (const auto *bindName{symbol.GetBindName()}) {2381    oldBindName = *bindName;2382  }2383  symbol.SetBindName(std::move(*label));2384  if (!oldBindName.empty()) {2385    if (const std::string * newBindName{symbol.GetBindName()}) {2386      if (oldBindName != *newBindName) {2387        Say(symbol.name(),2388            "The entity '%s' has multiple BIND names ('%s' and '%s')"_err_en_US,2389            symbol.name(), oldBindName, *newBindName);2390      }2391    }2392  }2393}2394 2395void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {2396  if (CheckAndSet(Attr::BIND_C)) {2397    if (const auto &name{2398            std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(2399                x.t)}) {2400      bindName_ = EvaluateExpr(*name);2401    }2402    isCDefined_ = std::get<bool>(x.t);2403  }2404}2405bool AttrsVisitor::Pre(const parser::IntentSpec &x) {2406  CheckAndSet(IntentSpecToAttr(x));2407  return false;2408}2409bool AttrsVisitor::Pre(const parser::Pass &x) {2410  if (CheckAndSet(Attr::PASS)) {2411    if (x.v) {2412      passName_ = x.v->source;2413      MakePlaceholder(*x.v, MiscDetails::Kind::PassName);2414    }2415  }2416  return false;2417}2418 2419// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions2420bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {2421  CHECK(attrs_);2422  if (attrs_->test(attrName)) {2423    context().Warn(common::LanguageFeature::RedundantAttribute,2424        currStmtSource().value(),2425        "Attribute '%s' cannot be used more than once"_warn_en_US,2426        AttrToString(attrName));2427    return true;2428  }2429  return false;2430}2431 2432// See if attrName violates a constraint cause by a conflict.  attr1 and attr22433// name attributes that cannot be used on the same declaration2434bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {2435  CHECK(attrs_);2436  if ((attrName == attr1 && attrs_->test(attr2)) ||2437      (attrName == attr2 && attrs_->test(attr1))) {2438    Say(currStmtSource().value(),2439        "Attributes '%s' and '%s' conflict with each other"_err_en_US,2440        AttrToString(attr1), AttrToString(attr2));2441    return true;2442  }2443  return false;2444}2445// C759, C15432446bool AttrsVisitor::IsConflictingAttr(Attr attrName) {2447  return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||2448      HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||2449      HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||2450      HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C7812451      HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||2452      HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||2453      HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE) ||2454      HaveAttrConflict(attrName, Attr::INTRINSIC, Attr::EXTERNAL);2455}2456bool AttrsVisitor::CheckAndSet(Attr attrName) {2457  if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {2458    return false;2459  }2460  attrs_->set(attrName);2461  return true;2462}2463bool AttrsVisitor::Pre(const common::CUDADataAttr x) {2464  if (cudaDataAttr_.value_or(x) != x) {2465    Say(currStmtSource().value(),2466        "CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,2467        common::EnumToString(*cudaDataAttr_), common::EnumToString(x));2468  }2469  cudaDataAttr_ = x;2470  return false;2471}2472 2473// DeclTypeSpecVisitor implementation2474 2475const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() const {2476  return state_.declTypeSpec;2477}2478const parser::Expr *DeclTypeSpecVisitor::GetOriginalKindParameter() const {2479  return state_.originalKindParameter;2480}2481 2482void DeclTypeSpecVisitor::BeginDeclTypeSpec() {2483  CHECK(!state_.expectDeclTypeSpec);2484  CHECK(!state_.declTypeSpec);2485  state_.expectDeclTypeSpec = true;2486}2487void DeclTypeSpecVisitor::EndDeclTypeSpec() {2488  CHECK(state_.expectDeclTypeSpec);2489  state_ = {};2490}2491 2492void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(2493    DeclTypeSpec::Category category) {2494  CHECK(state_.expectDeclTypeSpec);2495  state_.derived.category = category;2496}2497 2498bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {2499  BeginDeclTypeSpec();2500  return true;2501}2502void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {2503  EndDeclTypeSpec();2504}2505 2506void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {2507  // Record the resolved DeclTypeSpec in the parse tree for use by2508  // expression semantics if the DeclTypeSpec is a valid TypeSpec.2509  // The grammar ensures that it's an intrinsic or derived type spec,2510  // not TYPE(*) or CLASS(*) or CLASS(T).2511  if (const DeclTypeSpec * spec{state_.declTypeSpec}) {2512    switch (spec->category()) {2513    case DeclTypeSpec::Numeric:2514    case DeclTypeSpec::Logical:2515    case DeclTypeSpec::Character:2516      typeSpec.declTypeSpec = spec;2517      break;2518    case DeclTypeSpec::TypeDerived:2519      if (const DerivedTypeSpec * derived{spec->AsDerived()}) {2520        CheckForAbstractType(derived->typeSymbol()); // C7032521        typeSpec.declTypeSpec = spec;2522      }2523      break;2524    default:2525      CRASH_NO_CASE;2526    }2527  }2528}2529 2530void DeclTypeSpecVisitor::Post(2531    const parser::IntrinsicTypeSpec::DoublePrecision &) {2532  MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());2533}2534void DeclTypeSpecVisitor::Post(2535    const parser::IntrinsicTypeSpec::DoubleComplex &) {2536  MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());2537}2538void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {2539  SetDeclTypeSpec(context().MakeNumericType(category, kind));2540}2541 2542void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {2543  if (typeSymbol.attrs().test(Attr::ABSTRACT)) {2544    Say("ABSTRACT derived type may not be used here"_err_en_US);2545  }2546}2547 2548void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {2549  SetDeclTypeSpec(context().globalScope().MakeClassStarType());2550}2551void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {2552  SetDeclTypeSpec(context().globalScope().MakeTypeStarType());2553}2554 2555// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)2556// and save it in state_.declTypeSpec.2557void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {2558  CHECK(state_.expectDeclTypeSpec);2559  CHECK(!state_.declTypeSpec);2560  state_.declTypeSpec = &declTypeSpec;2561}2562 2563KindExpr DeclTypeSpecVisitor::GetKindParamExpr(2564    TypeCategory category, const std::optional<parser::KindSelector> &kind) {2565  if (inPDTDefinition_) {2566    if (category != TypeCategory::Derived && kind) {2567      if (const auto *expr{2568              std::get_if<parser::ScalarIntConstantExpr>(&kind->u)}) {2569        CHECK(!state_.originalKindParameter);2570        // Save a pointer to the KIND= expression in the parse tree2571        // in case we need to reanalyze it during PDT instantiation.2572        state_.originalKindParameter = parser::Unwrap<parser::Expr>(expr);2573      }2574    }2575    // Inhibit some errors now that will be caught later during instantiations.2576    auto restorer{2577        context().foldingContext().AnalyzingPDTComponentKindSelector()};2578    return AnalyzeKindSelector(context(), category, kind);2579  }2580  return AnalyzeKindSelector(context(), category, kind);2581}2582 2583// MessageHandler implementation2584 2585Message &MessageHandler::Say(MessageFixedText &&msg) {2586  return context_->Say(currStmtSource().value(), std::move(msg));2587}2588Message &MessageHandler::Say(MessageFormattedText &&msg) {2589  return context_->Say(currStmtSource().value(), std::move(msg));2590}2591Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {2592  return Say(name, std::move(msg), name);2593}2594 2595// ImplicitRulesVisitor implementation2596 2597void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {2598  prevParameterStmt_ = currStmtSource();2599}2600 2601bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {2602  bool result{2603      common::visit(common::visitors{2604                        [&](const std::list<ImplicitNoneNameSpec> &y) {2605                          return HandleImplicitNone(y);2606                        },2607                        [&](const std::list<parser::ImplicitSpec> &) {2608                          if (prevImplicitNoneType_) {2609                            Say("IMPLICIT statement after IMPLICIT NONE or "2610                                "IMPLICIT NONE(TYPE) statement"_err_en_US);2611                            return false;2612                          }2613                          implicitRules_->set_isImplicitNoneType(false);2614                          return true;2615                        },2616                    },2617          x.u)};2618  prevImplicit_ = currStmtSource();2619  return result;2620}2621 2622bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {2623  auto loLoc{std::get<parser::Location>(x.t)};2624  auto hiLoc{loLoc};2625  if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {2626    hiLoc = *hiLocOpt;2627    if (*hiLoc < *loLoc) {2628      Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,2629          std::string(hiLoc, 1), std::string(loLoc, 1));2630      return false;2631    }2632  }2633  implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);2634  return false;2635}2636 2637bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {2638  BeginDeclTypeSpec();2639  set_allowForwardReferenceToDerivedType(true);2640  return true;2641}2642 2643void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {2644  set_allowForwardReferenceToDerivedType(false);2645  EndDeclTypeSpec();2646}2647 2648void ImplicitRulesVisitor::SetScope(const Scope &scope) {2649  implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);2650  prevImplicit_ = std::nullopt;2651  prevImplicitNone_ = std::nullopt;2652  prevImplicitNoneType_ = std::nullopt;2653  prevParameterStmt_ = std::nullopt;2654}2655void ImplicitRulesVisitor::BeginScope(const Scope &scope) {2656  // find or create implicit rules for this scope2657  DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);2658  SetScope(scope);2659}2660 2661// TODO: for all of these errors, reference previous statement too2662bool ImplicitRulesVisitor::HandleImplicitNone(2663    const std::list<ImplicitNoneNameSpec> &nameSpecs) {2664  if (prevImplicitNone_) {2665    Say("More than one IMPLICIT NONE statement"_err_en_US);2666    Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);2667    return false;2668  }2669  if (prevParameterStmt_) {2670    Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);2671    return false;2672  }2673  prevImplicitNone_ = currStmtSource();2674  bool implicitNoneTypeNever{2675      context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};2676  if (nameSpecs.empty()) {2677    if (!implicitNoneTypeNever) {2678      prevImplicitNoneType_ = currStmtSource();2679      implicitRules_->set_isImplicitNoneType(true);2680      if (prevImplicit_) {2681        Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);2682        return false;2683      }2684    }2685  } else {2686    int sawType{0};2687    int sawExternal{0};2688    for (const auto noneSpec : nameSpecs) {2689      switch (noneSpec) {2690      case ImplicitNoneNameSpec::External:2691        implicitRules_->set_isImplicitNoneExternal(true);2692        ++sawExternal;2693        break;2694      case ImplicitNoneNameSpec::Type:2695        if (!implicitNoneTypeNever) {2696          prevImplicitNoneType_ = currStmtSource();2697          implicitRules_->set_isImplicitNoneType(true);2698          if (prevImplicit_) {2699            Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);2700            return false;2701          }2702          ++sawType;2703        }2704        break;2705      }2706    }2707    if (sawType > 1) {2708      Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);2709      return false;2710    }2711    if (sawExternal > 1) {2712      Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);2713      return false;2714    }2715  }2716  return true;2717}2718 2719// ArraySpecVisitor implementation2720 2721void ArraySpecVisitor::Post(const parser::ArraySpec &x) {2722  CHECK(arraySpec_.empty());2723  arraySpec_ = AnalyzeArraySpec(context(), x);2724}2725void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {2726  CHECK(arraySpec_.empty());2727  arraySpec_ = AnalyzeArraySpec(context(), x);2728}2729void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {2730  CHECK(coarraySpec_.empty());2731  coarraySpec_ = AnalyzeCoarraySpec(context(), x);2732}2733 2734const ArraySpec &ArraySpecVisitor::arraySpec() {2735  return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;2736}2737const ArraySpec &ArraySpecVisitor::coarraySpec() {2738  return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;2739}2740void ArraySpecVisitor::BeginArraySpec() {2741  CHECK(arraySpec_.empty());2742  CHECK(coarraySpec_.empty());2743  CHECK(attrArraySpec_.empty());2744  CHECK(attrCoarraySpec_.empty());2745}2746void ArraySpecVisitor::EndArraySpec() {2747  CHECK(arraySpec_.empty());2748  CHECK(coarraySpec_.empty());2749  attrArraySpec_.clear();2750  attrCoarraySpec_.clear();2751}2752void ArraySpecVisitor::PostAttrSpec() {2753  // Save dimension/codimension from attrs so we can process array/coarray-spec2754  // on the entity-decl2755  if (!arraySpec_.empty()) {2756    if (attrArraySpec_.empty()) {2757      attrArraySpec_ = arraySpec_;2758      arraySpec_.clear();2759    } else {2760      Say(currStmtSource().value(),2761          "Attribute 'DIMENSION' cannot be used more than once"_err_en_US);2762    }2763  }2764  if (!coarraySpec_.empty()) {2765    if (attrCoarraySpec_.empty()) {2766      attrCoarraySpec_ = coarraySpec_;2767      coarraySpec_.clear();2768    } else {2769      Say(currStmtSource().value(),2770          "Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);2771    }2772  }2773}2774 2775// FuncResultStack implementation2776 2777FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }2778 2779// True when either type is absent, or if they are both present and are2780// equivalent for interface compatibility purposes.2781static bool TypesMismatchIfNonNull(2782    const DeclTypeSpec *type1, const DeclTypeSpec *type2) {2783  if (auto t1{evaluate::DynamicType::From(type1)}) {2784    if (auto t2{evaluate::DynamicType::From(type2)}) {2785      return !t1->IsEquivalentTo(*t2);2786    }2787  }2788  return false;2789}2790 2791void FuncResultStack::CompleteFunctionResultType() {2792  // If the function has a type in the prefix, process it now.2793  FuncInfo *info{Top()};2794  if (info && &info->scope == &scopeHandler_.currScope() &&2795      info->resultSymbol) {2796    if (info->parsedType) {2797      scopeHandler_.messageHandler().set_currStmtSource(info->source);2798      if (const auto *type{2799              scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {2800        Symbol &symbol{*info->resultSymbol};2801        if (!scopeHandler_.context().HasError(symbol)) {2802          if (symbol.GetType()) {2803            scopeHandler_.Say(symbol.name(),2804                "Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US);2805            scopeHandler_.context().SetError(symbol);2806          } else {2807            symbol.SetType(*type);2808          }2809        }2810      }2811      info->parsedType = nullptr;2812    }2813    if (TypesMismatchIfNonNull(2814            info->resultSymbol->GetType(), info->previousImplicitType)) {2815      scopeHandler_2816          .Say(info->resultSymbol->name(),2817              "Function '%s' has a result type that differs from the implicit type it obtained in a previous reference"_err_en_US,2818              info->previousName)2819          .Attach(info->previousName,2820              "Previous reference implicitly typed as %s\n"_en_US,2821              info->previousImplicitType->AsFortran());2822    }2823  }2824}2825 2826// Called from ConvertTo{Object/Proc}Entity to cope with any appearance2827// of the function result in a specification expression.2828void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {2829  if (FuncInfo * info{Top()}) {2830    if (info->resultSymbol == &symbol) {2831      CompleteFunctionResultType();2832    }2833  }2834}2835 2836void FuncResultStack::Pop() {2837  if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {2838    stack_.pop_back();2839  }2840}2841 2842// ScopeHandler implementation2843 2844void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {2845  SayAlreadyDeclared(name.source, prev);2846}2847void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {2848  if (context().HasError(prev)) {2849    // don't report another error about prev2850  } else {2851    if (const auto *details{prev.detailsIf<UseDetails>()}) {2852      Say(name, "'%s' is already declared in this scoping unit"_err_en_US)2853          .Attach(details->location(),2854              "It is use-associated with '%s' in module '%s'"_en_US,2855              details->symbol().name(), GetUsedModule(*details).name());2856    } else {2857      SayAlreadyDeclared(name, prev.name());2858    }2859    context().SetError(prev);2860  }2861}2862void ScopeHandler::SayAlreadyDeclared(2863    const SourceName &name1, const SourceName &name2) {2864  if (name1.begin() < name2.begin()) {2865    SayAlreadyDeclared(name2, name1);2866  } else {2867    Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)2868        .Attach(name2, "Previous declaration of '%s'"_en_US, name2);2869  }2870}2871 2872void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,2873    MessageFixedText &&msg1, Message &&msg2) {2874  bool isFatal{msg1.IsFatal()};2875  Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));2876  context().SetError(symbol, isFatal);2877}2878 2879template <typename... A>2880Message &ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,2881    MessageFixedText &&msg, A &&...args) {2882  auto &message{2883      Say(name.source, std::move(msg), symbol.name(), std::forward<A>(args)...)2884          .Attach(symbol.name(),2885              symbol.test(Symbol::Flag::Implicit)2886                  ? "Implicit declaration of '%s'"_en_US2887                  : "Declaration of '%s'"_en_US,2888              name.source)};2889  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {2890    if (auto usedAsProc{proc->usedAsProcedureHere()}) {2891      if (usedAsProc->begin() != symbol.name().begin()) {2892        message.Attach(*usedAsProc, "Referenced as a procedure"_en_US);2893      }2894    }2895  }2896  return message;2897}2898 2899void ScopeHandler::SayLocalMustBeVariable(2900    const parser::Name &name, Symbol &symbol) {2901  SayWithDecl(name, symbol,2902      "The name '%s' must be a variable to appear"2903      " in a locality-spec"_err_en_US);2904}2905 2906Message &ScopeHandler::SayDerivedType(2907    const SourceName &name, MessageFixedText &&msg, const Scope &type) {2908  const Symbol &typeSymbol{DEREF(type.GetSymbol())};2909  return Say(name, std::move(msg), name, typeSymbol.name())2910      .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,2911          typeSymbol.name());2912}2913Message &ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,2914    const SourceName &name2, MessageFixedText &&msg2) {2915  return Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);2916}2917Message &ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,2918    Symbol &symbol, MessageFixedText &&msg2) {2919  bool isFatal{msg1.IsFatal()};2920  Message &result{Say2(name, std::move(msg1), symbol.name(), std::move(msg2))};2921  context().SetError(symbol, isFatal);2922  return result;2923}2924Message &ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,2925    Symbol &symbol, MessageFixedText &&msg2) {2926  bool isFatal{msg1.IsFatal()};2927  Message &result{2928      Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2))};2929  context().SetError(symbol, isFatal);2930  return result;2931}2932 2933// This is essentially GetProgramUnitContaining(), but it can return2934// a mutable Scope &, it ignores statement functions, and it fails2935// gracefully for error recovery (returning the original Scope).2936template <typename T> static T &GetInclusiveScope(T &scope) {2937  for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {2938    switch (s->kind()) {2939    case Scope::Kind::Module:2940    case Scope::Kind::MainProgram:2941    case Scope::Kind::Subprogram:2942    case Scope::Kind::BlockData:2943      if (!s->IsStmtFunction()) {2944        return *s;2945      }2946      break;2947    default:;2948    }2949  }2950  return scope;2951}2952 2953Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); }2954 2955Scope *ScopeHandler::GetHostProcedure() {2956  Scope &parent{InclusiveScope().parent()};2957  switch (parent.kind()) {2958  case Scope::Kind::Subprogram:2959    return &parent;2960  case Scope::Kind::MainProgram:2961    return &parent;2962  default:2963    return nullptr;2964  }2965}2966 2967Scope &ScopeHandler::NonDerivedTypeScope() {2968  return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;2969}2970 2971static void SetImplicitCUDADevice(Symbol &symbol) {2972  if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {2973    if (!object->cudaDataAttr() && !IsValue(symbol) &&2974        !IsFunctionResult(symbol)) {2975      // Implicitly set device attribute if none is set in device context.2976      object->set_cudaDataAttr(common::CUDADataAttr::Device);2977    }2978  }2979}2980 2981void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {2982  PushScope(currScope().MakeScope(kind, symbol));2983}2984void ScopeHandler::PushScope(Scope &scope) {2985  currScope_ = &scope;2986  auto kind{currScope_->kind()};2987  if (kind != Scope::Kind::BlockConstruct &&2988      kind != Scope::Kind::OtherConstruct && kind != Scope::Kind::OtherClause) {2989    BeginScope(scope);2990  }2991  // The name of a module or submodule cannot be "used" in its scope,2992  // as we read 19.3.1(2), so we allow the name to be used as a local2993  // identifier in the module or submodule too.  Same with programs2994  // (14.1(3)) and BLOCK DATA.2995  if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&2996      kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {2997    if (auto *symbol{scope.symbol()}) {2998      // Create a dummy symbol so we can't create another one with the same2999      // name. It might already be there if we previously pushed the scope.3000      SourceName name{symbol->name()};3001      if (!FindInScope(scope, name)) {3002        auto &newSymbol{MakeSymbol(name)};3003        if (kind == Scope::Kind::Subprogram) {3004          // Allow for recursive references.  If this symbol is a function3005          // without an explicit RESULT(), this new symbol will be discarded3006          // and replaced with an object of the same name.3007          newSymbol.set_details(HostAssocDetails{*symbol});3008        } else {3009          newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});3010        }3011      }3012    }3013  }3014}3015void ScopeHandler::PopScope() {3016  CHECK(currScope_ && !currScope_->IsGlobal());3017  // Entities that are not yet classified as objects or procedures are now3018  // assumed to be objects.3019  // TODO: Statement functions3020  bool inDeviceSubprogram{false};3021  const Symbol *scopeSym{currScope().GetSymbol()};3022  if (currScope().kind() == Scope::Kind::BlockConstruct) {3023    scopeSym = GetProgramUnitContaining(currScope()).GetSymbol();3024  }3025  if (scopeSym) {3026    if (auto *details{scopeSym->detailsIf<SubprogramDetails>()}) {3027      // Check the current procedure is a device procedure to apply implicit3028      // attribute at the end.3029      if (auto attrs{details->cudaSubprogramAttrs()}) {3030        if (*attrs == common::CUDASubprogramAttrs::Device ||3031            *attrs == common::CUDASubprogramAttrs::Global ||3032            *attrs == common::CUDASubprogramAttrs::Grid_Global) {3033          inDeviceSubprogram = true;3034        }3035      }3036    }3037  }3038  for (auto &pair : currScope()) {3039    ConvertToObjectEntity(*pair.second);3040  }3041 3042  // Apply CUDA device attributes if in a device subprogram3043  if (inDeviceSubprogram && currScope().kind() == Scope::Kind::BlockConstruct) {3044    for (auto &pair : currScope()) {3045      SetImplicitCUDADevice(*pair.second);3046    }3047  }3048 3049  funcResultStack_.Pop();3050  // If popping back into a global scope, pop back to the top scope.3051  Scope *hermetic{context().currentHermeticModuleFileScope()};3052  SetScope(currScope_->parent().IsGlobal()3053          ? (hermetic ? *hermetic : context().globalScope())3054          : currScope_->parent());3055}3056void ScopeHandler::SetScope(Scope &scope) {3057  currScope_ = &scope;3058  ImplicitRulesVisitor::SetScope(InclusiveScope());3059}3060 3061Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {3062  return FindSymbol(currScope(), name);3063}3064Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {3065  if (scope.IsDerivedType()) {3066    if (Symbol * symbol{scope.FindComponent(name.source)}) {3067      if (symbol->has<TypeParamDetails>()) {3068        return Resolve(name, symbol);3069      }3070    }3071    return FindSymbol(scope.parent(), name);3072  } else if (scope.kind() == Scope::Kind::ImpliedDos) {3073    if (Symbol * symbol{FindInScope(scope, name)}) {3074      return Resolve(name, symbol);3075    } else {3076      // Don't use scope.FindSymbol() as below, since implied DO scopes3077      // can be parts of initializers in derived type components.3078      return FindSymbol(scope.parent(), name);3079    }3080  } else if (inEquivalenceStmt_) {3081    // In EQUIVALENCE statements only resolve names in the local scope, see3082    // 19.5.1.4, paragraph 2, item (10)3083    return Resolve(name, FindInScope(scope, name));3084  } else {3085    return Resolve(name, scope.FindSymbol(name.source));3086  }3087}3088 3089Symbol &ScopeHandler::MakeSymbol(3090    Scope &scope, const SourceName &name, Attrs attrs) {3091  if (Symbol * symbol{FindInScope(scope, name)}) {3092    CheckDuplicatedAttrs(name, *symbol, attrs);3093    SetExplicitAttrs(*symbol, attrs);3094    return *symbol;3095  } else {3096    const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};3097    CHECK(pair.second); // name was not found, so must be able to add3098    return *pair.first->second;3099  }3100}3101Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {3102  return MakeSymbol(currScope(), name, attrs);3103}3104Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {3105  return Resolve(name, MakeSymbol(name.source, attrs));3106}3107Symbol &ScopeHandler::MakeHostAssocSymbol(3108    const parser::Name &name, const Symbol &hostSymbol) {3109  Symbol &symbol{*NonDerivedTypeScope()3110                      .try_emplace(name.source, HostAssocDetails{hostSymbol})3111                      .first->second};3112  name.symbol = &symbol;3113  symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?3114  // These attributes can be redundantly reapplied without error3115  // on the host-associated name, at most once (C815).3116  symbol.implicitAttrs() =3117      symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};3118  // SAVE statement in the inner scope will create a new symbol.3119  // If the host variable is used via host association,3120  // we have to propagate whether SAVE is implicit in the host scope.3121  // Otherwise, verifications that do not allow explicit SAVE3122  // attribute would fail.3123  symbol.implicitAttrs() |= hostSymbol.implicitAttrs() & Attrs{Attr::SAVE};3124  symbol.flags() = hostSymbol.flags();3125  return symbol;3126}3127Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {3128  CHECK(!FindInScope(name));3129  return MakeSymbol(currScope(), name, symbol.attrs());3130}3131 3132// Look for name only in scope, not in enclosing scopes.3133 3134Symbol *ScopeHandler::FindInScope(3135    const Scope &scope, const parser::Name &name) {3136  return Resolve(name, FindInScope(scope, name.source));3137}3138Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {3139  // all variants of names, e.g. "operator(.ne.)" for "operator(/=)"3140  for (const std::string &n : GetAllNames(context(), name)) {3141    auto it{scope.find(SourceName{n})};3142    if (it != scope.end()) {3143      return &*it->second;3144    }3145  }3146  return nullptr;3147}3148 3149// Find a component or type parameter by name in a derived type or its parents.3150Symbol *ScopeHandler::FindInTypeOrParents(3151    const Scope &scope, const parser::Name &name) {3152  return Resolve(name, scope.FindComponent(name.source));3153}3154Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {3155  return FindInTypeOrParents(currScope(), name);3156}3157Symbol *ScopeHandler::FindInScopeOrBlockConstructs(3158    const Scope &scope, SourceName name) {3159  if (Symbol * symbol{FindInScope(scope, name)}) {3160    return symbol;3161  }3162  for (const Scope &child : scope.children()) {3163    if (child.kind() == Scope::Kind::BlockConstruct) {3164      if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) {3165        return symbol;3166      }3167    }3168  }3169  return nullptr;3170}3171 3172void ScopeHandler::EraseSymbol(const parser::Name &name) {3173  currScope().erase(name.source);3174  name.symbol = nullptr;3175}3176 3177static bool NeedsType(const Symbol &symbol) {3178  return !symbol.GetType() &&3179      common::visit(common::visitors{3180                        [](const EntityDetails &) { return true; },3181                        [](const ObjectEntityDetails &) { return true; },3182                        [](const AssocEntityDetails &) { return true; },3183                        [&](const ProcEntityDetails &p) {3184                          return symbol.test(Symbol::Flag::Function) &&3185                              !symbol.attrs().test(Attr::INTRINSIC) &&3186                              !p.type() && !p.procInterface();3187                        },3188                        [](const auto &) { return false; },3189                    },3190          symbol.details());3191}3192 3193void ScopeHandler::ApplyImplicitRules(3194    Symbol &symbol, bool allowForwardReference) {3195  funcResultStack_.CompleteTypeIfFunctionResult(symbol);3196  if (context().HasError(symbol) || !NeedsType(symbol)) {3197    return;3198  }3199  if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {3200    if (!skipImplicitTyping_) {3201      symbol.set(Symbol::Flag::Implicit);3202      symbol.SetType(*type);3203    }3204    return;3205  }3206  if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {3207    std::optional<Symbol::Flag> functionOrSubroutineFlag;3208    if (symbol.test(Symbol::Flag::Function)) {3209      functionOrSubroutineFlag = Symbol::Flag::Function;3210    } else if (symbol.test(Symbol::Flag::Subroutine)) {3211      functionOrSubroutineFlag = Symbol::Flag::Subroutine;3212    }3213    if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {3214      // type will be determined in expression semantics3215      AcquireIntrinsicProcedureFlags(symbol);3216      return;3217    }3218  }3219  if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {3220    return;3221  }3222  if (const auto *entity{symbol.detailsIf<EntityDetails>()};3223      entity && entity->isDummy()) {3224    // Dummy argument, no declaration or reference; if it turns3225    // out to be a subroutine, it's fine, and if it is a function3226    // or object, it'll be caught later.3227    return;3228  }3229  if (deferImplicitTyping_) {3230    return;3231  }3232  if (!context().HasError(symbol)) {3233    Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);3234    context().SetError(symbol);3235  }3236}3237 3238// Extension: Allow forward references to scalar integer dummy arguments3239// or variables in COMMON to appear in specification expressions under3240// IMPLICIT NONE(TYPE) when what would otherwise have been their implicit3241// type is default INTEGER.3242bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {3243  if (!inSpecificationPart_ || context().HasError(symbol) ||3244      !(IsDummy(symbol) || FindCommonBlockContaining(symbol)) ||3245      symbol.Rank() != 0 ||3246      !context().languageFeatures().IsEnabled(3247          common::LanguageFeature::ForwardRefImplicitNone)) {3248    return false;3249  }3250  const DeclTypeSpec *type{3251      GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};3252  if (!type || !type->IsNumeric(TypeCategory::Integer)) {3253    return false;3254  }3255  auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};3256  if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {3257    return false;3258  }3259  if (!ConvertToObjectEntity(symbol)) {3260    return false;3261  }3262  // TODO: check no INTENT(OUT) if dummy?3263  context().Warn(common::LanguageFeature::ForwardRefImplicitNone, symbol.name(),3264      "'%s' was used without (or before) being explicitly typed"_warn_en_US,3265      symbol.name());3266  symbol.set(Symbol::Flag::Implicit);3267  symbol.SetType(*type);3268  return true;3269}3270 3271// Ensure that the symbol for an intrinsic procedure is marked with3272// the INTRINSIC attribute.  Also set PURE &/or ELEMENTAL as3273// appropriate.3274void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {3275  SetImplicitAttr(symbol, Attr::INTRINSIC);3276  switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {3277  case evaluate::IntrinsicClass::elementalFunction:3278  case evaluate::IntrinsicClass::elementalSubroutine:3279    SetExplicitAttr(symbol, Attr::ELEMENTAL);3280    SetExplicitAttr(symbol, Attr::PURE);3281    break;3282  case evaluate::IntrinsicClass::impureSubroutine:3283    break;3284  default:3285    SetExplicitAttr(symbol, Attr::PURE);3286  }3287}3288 3289const DeclTypeSpec *ScopeHandler::GetImplicitType(3290    Symbol &symbol, bool respectImplicitNoneType) {3291  const Scope *scope{&symbol.owner()};3292  if (scope->IsGlobal()) {3293    scope = &currScope();3294  }3295  scope = &GetInclusiveScope(*scope);3296  const auto *type{implicitRulesMap_->at(scope).GetType(3297      symbol.name(), respectImplicitNoneType)};3298  if (type) {3299    if (const DerivedTypeSpec * derived{type->AsDerived()}) {3300      // Resolve any forward-referenced derived type; a quick no-op else.3301      auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};3302      instantiatable.Instantiate(currScope());3303    }3304  }3305  return type;3306}3307 3308void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) {3309  if (!inSpecificationPart_ && symbol &&3310      symbol->test(Symbol::Flag::EntryDummyArgument)) {3311    Say(source,3312        "Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US,3313        symbol->name());3314    symbol->set(Symbol::Flag::EntryDummyArgument, false);3315  }3316}3317 3318// Convert symbol to be a ObjectEntity or return false if it can't be.3319bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {3320  if (symbol.has<ObjectEntityDetails>()) {3321    // nothing to do3322  } else if (symbol.has<UnknownDetails>()) {3323    // These are attributes that a name could have picked up from3324    // an attribute statement or type declaration statement.3325    if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {3326      return false;3327    }3328    symbol.set_details(ObjectEntityDetails{});3329  } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {3330    if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {3331      return false;3332    }3333    funcResultStack_.CompleteTypeIfFunctionResult(symbol);3334    symbol.set_details(ObjectEntityDetails{std::move(*details)});3335  } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {3336    return useDetails->symbol().has<ObjectEntityDetails>();3337  } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {3338    return hostDetails->symbol().has<ObjectEntityDetails>();3339  } else {3340    return false;3341  }3342  return true;3343}3344// Convert symbol to be a ProcEntity or return false if it can't be.3345bool ScopeHandler::ConvertToProcEntity(3346    Symbol &symbol, std::optional<SourceName> usedHere) {3347  if (symbol.has<ProcEntityDetails>()) {3348  } else if (symbol.has<UnknownDetails>()) {3349    symbol.set_details(ProcEntityDetails{});3350  } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {3351    if (IsFunctionResult(symbol) &&3352        !(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {3353      // Don't turn function result into a procedure pointer unless both3354      // POINTER and EXTERNAL3355      return false;3356    }3357    funcResultStack_.CompleteTypeIfFunctionResult(symbol);3358    symbol.set_details(ProcEntityDetails{std::move(*details)});3359    if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {3360      CHECK(!symbol.test(Symbol::Flag::Subroutine));3361      symbol.set(Symbol::Flag::Function);3362    }3363  } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {3364    return useDetails->symbol().has<ProcEntityDetails>();3365  } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {3366    return hostDetails->symbol().has<ProcEntityDetails>();3367  } else {3368    return false;3369  }3370  auto &proc{symbol.get<ProcEntityDetails>()};3371  if (usedHere && !proc.usedAsProcedureHere()) {3372    proc.set_usedAsProcedureHere(*usedHere);3373  }3374  return true;3375}3376 3377const DeclTypeSpec &ScopeHandler::MakeNumericType(3378    TypeCategory category, const std::optional<parser::KindSelector> &kind) {3379  KindExpr value{GetKindParamExpr(category, kind)};3380  if (auto known{evaluate::ToInt64(value)}) {3381    return MakeNumericType(category, static_cast<int>(*known));3382  } else {3383    return currScope_->MakeNumericType(category, std::move(value));3384  }3385}3386 3387const DeclTypeSpec &ScopeHandler::MakeNumericType(3388    TypeCategory category, int kind) {3389  return context().MakeNumericType(category, kind);3390}3391 3392const DeclTypeSpec &ScopeHandler::MakeLogicalType(3393    const std::optional<parser::KindSelector> &kind) {3394  KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};3395  if (auto known{evaluate::ToInt64(value)}) {3396    return MakeLogicalType(static_cast<int>(*known));3397  } else {3398    return currScope_->MakeLogicalType(std::move(value));3399  }3400}3401 3402const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {3403  return context().MakeLogicalType(kind);3404}3405 3406void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {3407  if (inSpecificationPart_ && !deferImplicitTyping_ && name.symbol) {3408    auto kind{currScope().kind()};3409    if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||3410        kind == Scope::Kind::BlockConstruct) {3411      bool isHostAssociated{&name.symbol->owner() == &currScope()3412              ? name.symbol->has<HostAssocDetails>()3413              : name.symbol->owner().Contains(currScope())};3414      if (isHostAssociated) {3415        specPartState_.forwardRefs.insert(name.source);3416      }3417    }3418  }3419}3420 3421std::optional<SourceName> ScopeHandler::HadForwardRef(3422    const Symbol &symbol) const {3423  auto iter{specPartState_.forwardRefs.find(symbol.name())};3424  if (iter != specPartState_.forwardRefs.end()) {3425    return *iter;3426  }3427  return std::nullopt;3428}3429 3430bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {3431  if (!context().HasError(symbol)) {3432    if (auto fwdRef{HadForwardRef(symbol)}) {3433      const Symbol *outer{symbol.owner().FindSymbol(symbol.name())};3434      if (outer && symbol.has<UseDetails>() &&3435          &symbol.GetUltimate() == &outer->GetUltimate()) {3436        // e.g. IMPORT of host's USE association3437        return false;3438      }3439      Say(*fwdRef,3440          "Forward reference to '%s' is not allowed in the same specification part"_err_en_US,3441          *fwdRef)3442          .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);3443      context().SetError(symbol);3444      return true;3445    }3446    if ((IsDummy(symbol) ||3447            (!symbol.has<UseDetails>() && FindCommonBlockContaining(symbol))) &&3448        isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) &&3449        !context().HasError(symbol)) {3450      // Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in3451      // ApplyImplicitRules() due to use in a specification expression,3452      // and no explicit type declaration appeared later.3453      Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);3454      context().SetError(symbol);3455      return true;3456    }3457  }3458  return false;3459}3460 3461void ScopeHandler::MakeExternal(Symbol &symbol) {3462  if (!symbol.attrs().test(Attr::EXTERNAL)) {3463    SetImplicitAttr(symbol, Attr::EXTERNAL);3464    if (symbol.attrs().test(Attr::INTRINSIC)) { // C8403465      Say(symbol.name(),3466          "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,3467          symbol.name());3468    }3469  }3470}3471 3472bool ScopeHandler::CheckDuplicatedAttr(3473    SourceName name, Symbol &symbol, Attr attr) {3474  if (attr == Attr::SAVE) {3475    // checked elsewhere3476  } else if (symbol.attrs().test(attr)) { // C8153477    if (symbol.implicitAttrs().test(attr)) {3478      // Implied attribute is now confirmed explicitly3479      symbol.implicitAttrs().reset(attr);3480    } else {3481      Say(name, "%s attribute was already specified on '%s'"_err_en_US,3482          EnumToString(attr), name);3483      return false;3484    }3485  }3486  return true;3487}3488 3489bool ScopeHandler::CheckDuplicatedAttrs(3490    SourceName name, Symbol &symbol, Attrs attrs) {3491  bool ok{true};3492  attrs.IterateOverMembers(3493      [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });3494  return ok;3495}3496 3497void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,3498    std::optional<common::CUDADataAttr> attr) {3499  if (attr) {3500    ConvertToObjectEntity(symbol);3501    if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {3502      if (*attr != object->cudaDataAttr().value_or(*attr)) {3503        Say(source,3504            "'%s' already has another CUDA data attribute ('%s')"_err_en_US,3505            symbol.name(),3506            std::string{common::EnumToString(*object->cudaDataAttr())}.c_str());3507      } else {3508        object->set_cudaDataAttr(attr);3509      }3510    } else {3511      Say(source,3512          "'%s' is not an object and may not have a CUDA data attribute"_err_en_US,3513          symbol.name());3514    }3515  }3516}3517 3518// ModuleVisitor implementation3519 3520bool ModuleVisitor::Pre(const parser::Only &x) {3521  common::visit(common::visitors{3522                    [&](const Indirection<parser::GenericSpec> &generic) {3523                      GenericSpecInfo genericSpecInfo{generic.value()};3524                      AddUseOnly(genericSpecInfo.symbolName());3525                      AddUse(genericSpecInfo);3526                    },3527                    [&](const parser::Name &name) {3528                      AddUseOnly(name.source);3529                      Resolve(name, AddUse(name.source, name.source).use);3530                    },3531                    [&](const parser::Rename &rename) { Walk(rename); },3532                },3533      x.u);3534  return false;3535}3536 3537void ModuleVisitor::CollectUseRenames(const parser::UseStmt &useStmt) {3538  auto doRename{[&](const parser::Rename &rename) {3539    if (const auto *names{std::get_if<parser::Rename::Names>(&rename.u)}) {3540      AddUseRename(std::get<1>(names->t).source, useStmt.moduleName.source);3541    }3542  }};3543  common::visit(3544      common::visitors{3545          [&](const std::list<parser::Rename> &renames) {3546            for (const auto &rename : renames) {3547              doRename(rename);3548            }3549          },3550          [&](const std::list<parser::Only> &onlys) {3551            for (const auto &only : onlys) {3552              if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {3553                doRename(*rename);3554              }3555            }3556          },3557      },3558      useStmt.u);3559}3560 3561bool ModuleVisitor::Pre(const parser::Rename::Names &x) {3562  const auto &localName{std::get<0>(x.t)};3563  const auto &useName{std::get<1>(x.t)};3564  SymbolRename rename{AddUse(localName.source, useName.source)};3565  Resolve(useName, rename.use);3566  Resolve(localName, rename.local);3567  return false;3568}3569bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {3570  const parser::DefinedOpName &local{std::get<0>(x.t)};3571  const parser::DefinedOpName &use{std::get<1>(x.t)};3572  GenericSpecInfo localInfo{local};3573  GenericSpecInfo useInfo{use};3574  if (IsIntrinsicOperator(context(), local.v.source)) {3575    Say(local.v,3576        "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);3577  } else if (IsLogicalConstant(context(), local.v.source)) {3578    Say(local.v,3579        "Logical constant '%s' may not be used as a defined operator"_err_en_US);3580  } else {3581    SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())};3582    useInfo.Resolve(rename.use);3583    localInfo.Resolve(rename.local);3584  }3585  return false;3586}3587 3588// Set useModuleScope_ to the Scope of the module being used.3589bool ModuleVisitor::Pre(const parser::UseStmt &x) {3590  std::optional<bool> isIntrinsic;3591  if (x.nature) {3592    isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic;3593  } else if (currScope().IsModule() && currScope().symbol() &&3594      currScope().symbol()->attrs().test(Attr::INTRINSIC)) {3595    // Intrinsic modules USE only other intrinsic modules3596    isIntrinsic = true;3597  }3598  useModuleScope_ = FindModule(x.moduleName, isIntrinsic);3599  if (!useModuleScope_) {3600    return false;3601  }3602  AddAndCheckModuleUse(x.moduleName.source,3603      useModuleScope_->parent().kind() == Scope::Kind::IntrinsicModules);3604  // use the name from this source file3605  useModuleScope_->symbol()->ReplaceName(x.moduleName.source);3606  return true;3607}3608 3609void ModuleVisitor::Post(const parser::UseStmt &x) {3610  if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {3611    // Not a use-only: collect the names that were used in renames,3612    // then add a use for each public name that was not renamed.3613    std::set<SourceName> useNames;3614    for (const auto &rename : *list) {3615      common::visit(common::visitors{3616                        [&](const parser::Rename::Names &names) {3617                          useNames.insert(std::get<1>(names.t).source);3618                        },3619                        [&](const parser::Rename::Operators &ops) {3620                          useNames.insert(std::get<1>(ops.t).v.source);3621                        },3622                    },3623          rename.u);3624    }3625    for (const auto &[name, symbol] : *useModuleScope_) {3626      // Default USE imports public names, excluding intrinsic-only and most3627      // miscellaneous details. Allow OpenMP mapper identifiers represented3628      // as MapperDetails, and also legacy MiscDetails::ConstructName.3629      bool isMapper{symbol->has<MapperDetails>()};3630      if (!isMapper) {3631        if (const auto *misc{symbol->detailsIf<MiscDetails>()}) {3632          isMapper = misc->kind() == MiscDetails::Kind::ConstructName;3633        }3634      }3635      if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&3636          (!symbol->implicitAttrs().test(Attr::INTRINSIC) ||3637              symbol->has<UseDetails>()) &&3638          (!symbol->has<MiscDetails>() || isMapper) &&3639          useNames.count(name) == 0) {3640        SourceName location{x.moduleName.source};3641        if (auto *localSymbol{FindInScope(name)}) {3642          DoAddUse(location, localSymbol->name(), *localSymbol, *symbol);3643        } else {3644          DoAddUse(location, location, CopySymbol(name, *symbol), *symbol);3645        }3646      }3647    }3648  }3649  // Go through the list of COMMON block symbols in the module scope and add3650  // their USE association to the current scope's USE-associated COMMON blocks.3651  for (const auto &[name, symbol] : useModuleScope_->commonBlocks()) {3652    if (!currScope().FindCommonBlockInVisibleScopes(name)) {3653      currScope().AddCommonBlockUse(3654          name, symbol->attrs(), symbol->GetUltimate());3655    }3656  }3657  // Go through the list of USE-associated COMMON block symbols in the module3658  // scope and add USE associations to their ultimate symbols to the current3659  // scope's USE-associated COMMON blocks.3660  for (const auto &[name, symbol] : useModuleScope_->commonBlockUses()) {3661    currScope().AddCommonBlockUse(name, symbol->attrs(), symbol->GetUltimate());3662  }3663  useModuleScope_ = nullptr;3664}3665 3666ModuleVisitor::SymbolRename ModuleVisitor::AddUse(3667    const SourceName &localName, const SourceName &useName) {3668  return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));3669}3670 3671ModuleVisitor::SymbolRename ModuleVisitor::AddUse(3672    const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {3673  if (!useModuleScope_) {3674    return {}; // error occurred finding module3675  }3676  if (!useSymbol) {3677    Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName),3678        useModuleScope_->GetName().value());3679    return {};3680  }3681  if (useSymbol->attrs().test(Attr::PRIVATE) &&3682      !FindModuleFileContaining(currScope())) {3683    // Privacy is not enforced in module files so that generic interfaces3684    // can be resolved to private specific procedures in specification3685    // expressions.3686    // Local names that contain currency symbols ('$') are created by the3687    // module file writer when a private name in another module is needed to3688    // process a local declaration.  These can show up in the output of3689    // -fdebug-unparse-with-modules, too, so go easy on them.3690    if (currScope().IsModule() &&3691        localName.ToString().find("$") != std::string::npos) {3692      Say(useName, "'%s' is PRIVATE in '%s'"_warn_en_US, MakeOpName(useName),3693          useModuleScope_->GetName().value());3694    } else {3695      Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),3696          useModuleScope_->GetName().value());3697      return {};3698    }3699  }3700  auto &localSymbol{MakeSymbol(localName)};3701  DoAddUse(useName, localName, localSymbol, *useSymbol);3702  return {&localSymbol, useSymbol};3703}3704 3705// symbol must be either a Use or a Generic formed by merging two uses.3706// Convert it to a UseError with this additional location.3707bool ScopeHandler::ConvertToUseError(3708    Symbol &symbol, const SourceName &location, const Symbol &used) {3709  if (auto *ued{symbol.detailsIf<UseErrorDetails>()}) {3710    ued->add_occurrence(location, used);3711    return true;3712  }3713  const auto *useDetails{symbol.detailsIf<UseDetails>()};3714  if (!useDetails) {3715    if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {3716      if (!genericDetails->uses().empty()) {3717        useDetails = &genericDetails->uses().at(0)->get<UseDetails>();3718      }3719    }3720  }3721  if (useDetails) {3722    symbol.set_details(3723        UseErrorDetails{*useDetails}.add_occurrence(location, used));3724    return true;3725  }3726  if (const auto *hostAssocDetails{symbol.detailsIf<HostAssocDetails>()};3727      hostAssocDetails && hostAssocDetails->symbol().has<SubprogramDetails>() &&3728      &symbol.owner() == &currScope() &&3729      &hostAssocDetails->symbol() == currScope().symbol()) {3730    // Handle USE-association of procedure FOO into function/subroutine FOO,3731    // replacing its place-holding HostAssocDetails symbol.3732    context().Warn(common::UsageWarning::UseAssociationIntoSameNameSubprogram,3733        location,3734        "'%s' is use-associated into a subprogram of the same name"_port_en_US,3735        used.name());3736    SourceName created{context().GetTempName(currScope())};3737    Symbol &tmpUse{MakeSymbol(created, Attrs(), UseDetails{location, used})};3738    UseErrorDetails useError{tmpUse.get<UseDetails>()};3739    useError.add_occurrence(location, hostAssocDetails->symbol());3740    symbol.set_details(std::move(useError));3741    return true;3742  }3743  return false;3744}3745 3746// Two ultimate symbols are distinct, but they have the same name and come3747// from modules with the same name.  At link time, their mangled names3748// would conflict, so they had better resolve to the same definition.3749// Check whether the two ultimate symbols have compatible definitions.3750// Returns true if no further processing is required in DoAddUse().3751static bool CheckCompatibleDistinctUltimates(SemanticsContext &context,3752    SourceName location, SourceName localName, const Symbol &localSymbol,3753    const Symbol &localUltimate, const Symbol &useUltimate, bool &isError) {3754  isError = false;3755  if (localUltimate.has<GenericDetails>()) {3756    if (useUltimate.has<GenericDetails>() ||3757        useUltimate.has<SubprogramDetails>() ||3758        useUltimate.has<DerivedTypeDetails>()) {3759      return false; // can try to merge them3760    } else {3761      isError = true;3762    }3763  } else if (useUltimate.has<GenericDetails>()) {3764    if (localUltimate.has<SubprogramDetails>() ||3765        localUltimate.has<DerivedTypeDetails>()) {3766      return false; // can try to merge them3767    } else {3768      isError = true;3769    }3770  } else if (localUltimate.has<SubprogramDetails>()) {3771    if (useUltimate.has<SubprogramDetails>()) {3772      auto localCharacteristics{3773          evaluate::characteristics::Procedure::Characterize(3774              localUltimate, context.foldingContext())};3775      auto useCharacteristics{3776          evaluate::characteristics::Procedure::Characterize(3777              useUltimate, context.foldingContext())};3778      if ((localCharacteristics &&3779              (!useCharacteristics ||3780                  *localCharacteristics != *useCharacteristics)) ||3781          (!localCharacteristics && useCharacteristics)) {3782        isError = true;3783      }3784    } else {3785      isError = true;3786    }3787  } else if (useUltimate.has<SubprogramDetails>()) {3788    isError = true;3789  } else if (const auto *localObject{3790                 localUltimate.detailsIf<ObjectEntityDetails>()}) {3791    if (const auto *useObject{useUltimate.detailsIf<ObjectEntityDetails>()}) {3792      auto localType{evaluate::DynamicType::From(localUltimate)};3793      auto useType{evaluate::DynamicType::From(useUltimate)};3794      if (localUltimate.size() != useUltimate.size() ||3795          (localType &&3796              (!useType || !localType->IsTkLenCompatibleWith(*useType) ||3797                  !useType->IsTkLenCompatibleWith(*localType))) ||3798          (!localType && useType)) {3799        isError = true;3800      } else if (IsNamedConstant(localUltimate)) {3801        isError = !IsNamedConstant(useUltimate) ||3802            !(*localObject->init() == *useObject->init());3803      } else {3804        isError = IsNamedConstant(useUltimate);3805      }3806    } else {3807      isError = true;3808    }3809  } else if (useUltimate.has<ObjectEntityDetails>()) {3810    isError = true;3811  } else if (IsProcedurePointer(localUltimate)) {3812    isError = !IsProcedurePointer(useUltimate);3813  } else if (IsProcedurePointer(useUltimate)) {3814    isError = true;3815  } else if (localUltimate.has<DerivedTypeDetails>()) {3816    isError = !(useUltimate.has<DerivedTypeDetails>() &&3817        evaluate::AreSameDerivedTypeIgnoringSequence(3818            DerivedTypeSpec{localUltimate.name(), localUltimate},3819            DerivedTypeSpec{useUltimate.name(), useUltimate}));3820  } else if (useUltimate.has<DerivedTypeDetails>()) {3821    isError = true;3822  } else if (localUltimate.has<NamelistDetails>() &&3823      useUltimate.has<NamelistDetails>()) {3824  } else if (localUltimate.has<CommonBlockDetails>() &&3825      useUltimate.has<CommonBlockDetails>()) {3826  } else {3827    isError = true;3828  }3829  return true; // don't try to merge generics (or whatever)3830}3831 3832void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,3833    Symbol &originalLocal, const Symbol &useSymbol) {3834  Symbol *localSymbol{&originalLocal};3835  if (auto *details{localSymbol->detailsIf<UseErrorDetails>()}) {3836    details->add_occurrence(location, useSymbol);3837    return;3838  }3839  const Symbol &useUltimate{useSymbol.GetUltimate()};3840  const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};3841  if (localSymbol->has<UnknownDetails>()) {3842    if (useGeneric &&3843        ((useGeneric->specific() &&3844             IsProcedurePointer(*useGeneric->specific())) ||3845            (useGeneric->derivedType() &&3846                useUltimate.name() != localSymbol->name()))) {3847      // We are use-associating a generic that either shadows a procedure3848      // pointer or shadows a derived type with a distinct name.3849      // Local references that might be made to the procedure pointer should3850      // use a UseDetails symbol for proper data addressing, and a derived3851      // type needs to be in scope with its local name.  So create an3852      // empty local generic now into which the use-associated generic may3853      // be copied.3854      localSymbol->set_details(GenericDetails{});3855      localSymbol->get<GenericDetails>().set_kind(useGeneric->kind());3856    } else { // just create UseDetails3857      localSymbol->set_details(UseDetails{localName, useSymbol});3858      localSymbol->attrs() =3859          useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};3860      localSymbol->implicitAttrs() =3861          localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};3862      localSymbol->flags() = useSymbol.flags();3863      return;3864    }3865  }3866 3867  Symbol &localUltimate{localSymbol->GetUltimate()};3868  if (&localUltimate == &useUltimate) {3869    // use-associating the same symbol again -- ok3870    return;3871  }3872  if (useUltimate.owner().IsModule() && localUltimate.owner().IsSubmodule() &&3873      DoesScopeContain(&useUltimate.owner(), localUltimate)) {3874    // Within a submodule, USE'ing a symbol that comes indirectly3875    // from the ancestor module, e.g. foo in:3876    //  MODULE m1; INTERFACE; MODULE SUBROUTINE foo; END INTERFACE; END3877    //  MODULE m2; USE m1; END3878    //  SUBMODULE m1(sm); USE m2; CONTAINS; MODULE PROCEDURE foo; END; END3879    return; // ok, ignore it3880  }3881 3882  if (localUltimate.name() == useUltimate.name() &&3883      localUltimate.owner().IsModule() && useUltimate.owner().IsModule() &&3884      localUltimate.owner().GetName() &&3885      localUltimate.owner().GetName() == useUltimate.owner().GetName()) {3886    bool isError{false};3887    if (CheckCompatibleDistinctUltimates(context(), location, localName,3888            *localSymbol, localUltimate, useUltimate, isError)) {3889      if (isError) {3890        // Convert the local symbol to a UseErrorDetails, if possible;3891        // otherwise emit a fatal error.3892        if (!ConvertToUseError(*localSymbol, location, useSymbol)) {3893          context()3894              .Say(location,3895                  "'%s' use-associated from '%s' in module '%s' is incompatible with '%s' from another module"_err_en_US,3896                  localName, useUltimate.name(),3897                  useUltimate.owner().GetName().value(), localUltimate.name())3898              .Attach(useUltimate.name(), "First declaration"_en_US)3899              .Attach(localUltimate.name(), "Other declaration"_en_US);3900          return;3901        }3902      }3903      if (auto *msg{context().Warn(3904              common::UsageWarning::CompatibleDeclarationsFromDistinctModules,3905              location,3906              "'%s' is use-associated from '%s' in two distinct instances of module '%s'"_warn_en_US,3907              localName, localUltimate.name(),3908              localUltimate.owner().GetName().value())}) {3909        msg->Attach(localUltimate.name(), "Previous declaration"_en_US)3910            .Attach(useUltimate.name(), "Later declaration"_en_US);3911      }3912      return;3913    }3914  }3915 3916  // There are many possible combinations of symbol types that could arrive3917  // with the same (local) name vie USE association from distinct modules.3918  // Fortran allows a generic interface to share its name with a derived type,3919  // or with the name of a non-generic procedure (which should be one of the3920  // generic's specific procedures).  Implementing all these possibilities is3921  // complicated.3922  // Error cases are converted into UseErrorDetails symbols to trigger error3923  // messages when/if bad combinations are actually used later in the program.3924  // The error cases are:3925  //   - two distinct derived types3926  //   - two distinct non-generic procedures3927  //   - a generic and a non-generic that is not already one of its specifics3928  //   - anything other than a derived type, non-generic procedure, or3929  //     generic procedure being combined with something other than an3930  //     prior USE association of itself3931  auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};3932  Symbol *localDerivedType{nullptr};3933  if (localUltimate.has<DerivedTypeDetails>()) {3934    localDerivedType = &localUltimate;3935  } else if (localGeneric) {3936    if (auto *dt{localGeneric->derivedType()};3937        dt && !dt->attrs().test(Attr::PRIVATE)) {3938      localDerivedType = dt;3939    }3940  }3941  const Symbol *useDerivedType{nullptr};3942  if (useUltimate.has<DerivedTypeDetails>()) {3943    useDerivedType = &useUltimate;3944  } else if (useGeneric) {3945    if (const auto *dt{useGeneric->derivedType()};3946        dt && !dt->attrs().test(Attr::PRIVATE)) {3947      useDerivedType = dt;3948    }3949  }3950 3951  Symbol *localProcedure{nullptr};3952  if (localGeneric) {3953    if (localGeneric->specific() &&3954        !localGeneric->specific()->attrs().test(Attr::PRIVATE)) {3955      localProcedure = localGeneric->specific();3956    }3957  } else if (IsProcedure(localUltimate)) {3958    localProcedure = &localUltimate;3959  }3960  const Symbol *useProcedure{nullptr};3961  if (useGeneric) {3962    if (useGeneric->specific() &&3963        !useGeneric->specific()->attrs().test(Attr::PRIVATE)) {3964      useProcedure = useGeneric->specific();3965    }3966  } else if (IsProcedure(useUltimate)) {3967    useProcedure = &useUltimate;3968  }3969 3970  // When two derived types arrived, try to combine them.3971  const Symbol *combinedDerivedType{nullptr};3972  if (!useDerivedType) {3973    combinedDerivedType = localDerivedType;3974  } else if (!localDerivedType) {3975    if (useDerivedType->name() == localName) {3976      combinedDerivedType = useDerivedType;3977    } else {3978      combinedDerivedType =3979          &currScope().MakeSymbol(localSymbol->name(), useDerivedType->attrs(),3980              UseDetails{localSymbol->name(), *useDerivedType});3981    }3982  } else if (&localDerivedType->GetUltimate() ==3983      &useDerivedType->GetUltimate()) {3984    combinedDerivedType = localDerivedType;3985  } else {3986    const Scope *localScope{localDerivedType->GetUltimate().scope()};3987    const Scope *useScope{useDerivedType->GetUltimate().scope()};3988    if (localScope && useScope && localScope->derivedTypeSpec() &&3989        useScope->derivedTypeSpec() &&3990        evaluate::AreSameDerivedType(3991            *localScope->derivedTypeSpec(), *useScope->derivedTypeSpec())) {3992      combinedDerivedType = localDerivedType;3993    } else {3994      // Create a local UseErrorDetails for the ambiguous derived type3995      if (localSymbol->has<UseDetails>() && localGeneric) {3996        // Creates a UseErrorDetails symbol in the current scope for a3997        // current UseDetails symbol, but leaves the UseDetails in the3998        // scope's name map.3999        UseErrorDetails details{localSymbol->get<UseDetails>()};4000        EraseSymbol(*localSymbol);4001        details.add_occurrence(location, useSymbol);4002        Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))};4003        // Restore *localSymbol in currScope4004        auto iter{currScope().find(localName)};4005        CHECK(iter != currScope().end() && &*iter->second == newSymbol);4006        iter->second = MutableSymbolRef{*localSymbol};4007        combinedDerivedType = newSymbol;4008      } else {4009        ConvertToUseError(*localSymbol, location, useSymbol);4010        localDerivedType = nullptr;4011        localGeneric = nullptr;4012        combinedDerivedType = localSymbol;4013      }4014    }4015    if (!localGeneric && !useGeneric) {4016      return; // both symbols are derived types; done4017    }4018  }4019 4020  auto AreSameModuleProcOrBothInterfaces{[](const Symbol &p1,4021                                             const Symbol &p2) {4022    if (IsProcedure(p1) && !IsPointer(p1) && IsProcedure(p2) &&4023        !IsPointer(p2)) {4024      auto classification{ClassifyProcedure(p1)};4025      if (classification == ClassifyProcedure(p2)) {4026        if (classification == ProcedureDefinitionClass::External) {4027          const auto *subp1{p1.detailsIf<SubprogramDetails>()};4028          const auto *subp2{p2.detailsIf<SubprogramDetails>()};4029          return subp1 && subp1->isInterface() && subp2 && subp2->isInterface();4030        } else if (classification == ProcedureDefinitionClass::Module) {4031          return AreSameModuleSymbol(p1, p2);4032        }4033      }4034    }4035    return false;4036  }};4037 4038  auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) {4039    if (&p1.GetUltimate() == &p2.GetUltimate()) {4040      return true;4041    } else if (p1.name() != p2.name()) {4042      return false;4043    } else if (p1.attrs().test(Attr::INTRINSIC) ||4044        p2.attrs().test(Attr::INTRINSIC)) {4045      return p1.attrs().test(Attr::INTRINSIC) &&4046          p2.attrs().test(Attr::INTRINSIC);4047    } else if (AreSameModuleProcOrBothInterfaces(p1, p2)) {4048      // Both are external interfaces, perhaps to the same procedure,4049      // or both are module procedures from modules with the same name.4050      auto p1Chars{evaluate::characteristics::Procedure::Characterize(4051          p1, GetFoldingContext())};4052      auto p2Chars{evaluate::characteristics::Procedure::Characterize(4053          p2, GetFoldingContext())};4054      return p1Chars && p2Chars && *p1Chars == *p2Chars;4055    } else {4056      return false;4057    }4058  }};4059 4060  // When two non-generic procedures arrived, try to combine them.4061  const Symbol *combinedProcedure{nullptr};4062  if (!localProcedure) {4063    combinedProcedure = useProcedure;4064  } else if (!useProcedure) {4065    combinedProcedure = localProcedure;4066  } else {4067    if (AreSameProcedure(4068            localProcedure->GetUltimate(), useProcedure->GetUltimate())) {4069      if (!localGeneric && !useGeneric) {4070        return; // both symbols are non-generic procedures4071      }4072      combinedProcedure = localProcedure;4073    }4074  }4075 4076  // Prepare to merge generics4077  bool cantCombine{false};4078  if (localGeneric) {4079    if (useGeneric || useDerivedType) {4080    } else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {4081      return; // nothing to do; used subprogram is local's specific4082    } else if (useUltimate.attrs().test(Attr::INTRINSIC) &&4083        useUltimate.name() == localSymbol->name()) {4084      return; // local generic can extend intrinsic4085    } else {4086      for (const auto &ref : localGeneric->specificProcs()) {4087        if (&ref->GetUltimate() == &useUltimate) {4088          return; // used non-generic is already a specific of local generic4089        }4090      }4091      cantCombine = true;4092    }4093  } else if (useGeneric) {4094    if (localDerivedType) {4095    } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate() ||4096        (localSymbol->attrs().test(Attr::INTRINSIC) &&4097            localUltimate.name() == useUltimate.name())) {4098      // Local is the specific of the used generic or an intrinsic with the4099      // same name; replace it.4100      EraseSymbol(*localSymbol);4101      Symbol &newSymbol{MakeSymbol(localName,4102          useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},4103          UseDetails{localName, useUltimate})};4104      newSymbol.flags() = useSymbol.flags();4105      return;4106    } else {4107      for (const auto &ref : useGeneric->specificProcs()) {4108        if (&ref->GetUltimate() == &localUltimate) {4109          return; // local non-generic is already a specific of used generic4110        }4111      }4112      cantCombine = true;4113    }4114  } else {4115    cantCombine = true;4116  }4117 4118  // If symbols are not combinable, create a use error.4119  if (cantCombine) {4120    if (!ConvertToUseError(*localSymbol, location, useSymbol)) {4121      Say(location,4122          "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,4123          localName)4124          .Attach(localSymbol->name(), "Previous declaration of '%s'"_en_US,4125              localName);4126    }4127    return;4128  }4129 4130  // At this point, there must be at least one generic interface.4131  CHECK(localGeneric || (useGeneric && (localDerivedType || localProcedure)));4132 4133  // Ensure that a use-associated specific procedure that is a procedure4134  // pointer is properly represented as a USE association of an entity.4135  if (IsProcedurePointer(useProcedure)) {4136    Symbol &combined{currScope().MakeSymbol(localSymbol->name(),4137        useProcedure->attrs(), UseDetails{localName, *useProcedure})};4138    combined.flags() |= useProcedure->flags();4139    combinedProcedure = &combined;4140  }4141 4142  if (localGeneric) {4143    // Create a local copy of a previously use-associated generic so that4144    // it can be locally extended without corrupting the original.4145    if (localSymbol->has<UseDetails>()) {4146      GenericDetails generic;4147      generic.CopyFrom(DEREF(localGeneric));4148      EraseSymbol(*localSymbol);4149      Symbol &newSymbol{MakeSymbol(4150          localSymbol->name(), localSymbol->attrs(), std::move(generic))};4151      newSymbol.flags() = localSymbol->flags();4152      localGeneric = &newSymbol.get<GenericDetails>();4153      localGeneric->AddUse(*localSymbol);4154      localSymbol = &newSymbol;4155    }4156    if (useGeneric) {4157      // Combine two use-associated generics.4158      localSymbol->attrs() =4159          useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};4160      localSymbol->flags() = useSymbol.flags();4161      AddGenericUse(*localGeneric, localName, useUltimate);4162      // Don't duplicate specific procedures.4163      std::size_t originalLocalSpecifics{localGeneric->specificProcs().size()};4164      std::size_t useSpecifics{useGeneric->specificProcs().size()};4165      CHECK(originalLocalSpecifics == localGeneric->bindingNames().size());4166      CHECK(useSpecifics == useGeneric->bindingNames().size());4167      std::size_t j{0};4168      for (const Symbol &useSpecific : useGeneric->specificProcs()) {4169        SourceName useBindingName{useGeneric->bindingNames()[j++]};4170        bool isDuplicate{false};4171        std::size_t k{0};4172        for (const Symbol &localSpecific : localGeneric->specificProcs()) {4173          if (localGeneric->bindingNames()[k++] == useBindingName &&4174              AreSameProcedure(localSpecific, useSpecific)) {4175            isDuplicate = true;4176            break;4177          }4178        }4179        if (!isDuplicate) {4180          localGeneric->AddSpecificProc(useSpecific, useBindingName);4181        }4182      }4183    }4184    localGeneric->clear_derivedType();4185    if (combinedDerivedType) {4186      localGeneric->set_derivedType(*const_cast<Symbol *>(combinedDerivedType));4187    }4188    localGeneric->clear_specific();4189    if (combinedProcedure) {4190      localGeneric->set_specific(*const_cast<Symbol *>(combinedProcedure));4191    }4192  } else {4193    CHECK(localSymbol->has<UseDetails>());4194    // Create a local copy of the use-associated generic, then extend it4195    // with the combined derived type &/or non-generic procedure.4196    GenericDetails generic;4197    generic.CopyFrom(*useGeneric);4198    EraseSymbol(*localSymbol);4199    Symbol &newSymbol{MakeSymbol(localName,4200        useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},4201        std::move(generic))};4202    newSymbol.flags() = useUltimate.flags();4203    auto &newUseGeneric{newSymbol.get<GenericDetails>()};4204    AddGenericUse(newUseGeneric, localName, useUltimate);4205    newUseGeneric.AddUse(*localSymbol);4206    if (combinedDerivedType) {4207      if (const auto *oldDT{newUseGeneric.derivedType()}) {4208        CHECK(&oldDT->GetUltimate() == &combinedDerivedType->GetUltimate());4209      } else {4210        newUseGeneric.set_derivedType(4211            *const_cast<Symbol *>(combinedDerivedType));4212      }4213    }4214    if (combinedProcedure) {4215      newUseGeneric.set_specific(*const_cast<Symbol *>(combinedProcedure));4216    }4217  }4218}4219 4220void ModuleVisitor::AddUse(const GenericSpecInfo &info) {4221  if (useModuleScope_) {4222    const auto &name{info.symbolName()};4223    auto rename{AddUse(name, name, FindInScope(*useModuleScope_, name))};4224    info.Resolve(rename.use);4225  }4226}4227 4228// Create a UseDetails symbol for this USE and add it to generic4229Symbol &ModuleVisitor::AddGenericUse(4230    GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {4231  Symbol &newSymbol{4232      currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})};4233  generic.AddUse(newSymbol);4234  return newSymbol;4235}4236 4237// Enforce F'2023 C1406 as a warning4238void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) {4239  if (isIntrinsic) {4240    if (auto iter{nonIntrinsicUses_.find(name)};4241        iter != nonIntrinsicUses_.end()) {4242      if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,4243              name,4244              "Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,4245              name)}) {4246        msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);4247      }4248    }4249    intrinsicUses_.insert(name);4250  } else {4251    if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) {4252      if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,4253              name,4254              "Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,4255              name)}) {4256        msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);4257      }4258    }4259    nonIntrinsicUses_.insert(name);4260  }4261}4262 4263bool ModuleVisitor::BeginSubmodule(4264    const parser::Name &name, const parser::ParentIdentifier &parentId) {4265  const auto &ancestorName{std::get<parser::Name>(parentId.t)};4266  Scope *parentScope{nullptr};4267  Scope *ancestor{FindModule(ancestorName, false /*not intrinsic*/)};4268  if (ancestor) {4269    if (const auto &parentName{4270            std::get<std::optional<parser::Name>>(parentId.t)}) {4271      parentScope = FindModule(*parentName, false /*not intrinsic*/, ancestor);4272    } else {4273      parentScope = ancestor;4274    }4275  }4276  if (parentScope) {4277    PushScope(*parentScope);4278  } else {4279    // Error recovery: there's no ancestor scope, so create a dummy one to4280    // hold the submodule's scope.4281    SourceName dummyName{context().GetTempName(currScope())};4282    Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})};4283    PushScope(Scope::Kind::Module, &dummySymbol);4284    parentScope = &currScope();4285  }4286  BeginModule(name, true);4287  set_inheritFromParent(false); // submodules don't inherit parents' implicits4288  if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) {4289    Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,4290        ancestorName.source, name.source);4291  }4292  return true;4293}4294 4295void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {4296  // Submodule symbols are not visible in their parents' scopes.4297  Symbol &symbol{isSubmodule ? Resolve(name,4298                                   currScope().MakeSymbol(name.source, Attrs{},4299                                       ModuleDetails{true}))4300                             : MakeSymbol(name, ModuleDetails{false})};4301  auto &details{symbol.get<ModuleDetails>()};4302  PushScope(Scope::Kind::Module, &symbol);4303  details.set_scope(&currScope());4304  prevAccessStmt_ = std::nullopt;4305}4306 4307// Find a module or submodule by name and return its scope.4308// If ancestor is present, look for a submodule of that ancestor module.4309// May have to read a .mod file to find it.4310// If an error occurs, report it and return nullptr.4311Scope *ModuleVisitor::FindModule(const parser::Name &name,4312    std::optional<bool> isIntrinsic, Scope *ancestor) {4313  ModFileReader reader{context()};4314  Scope *scope{4315      reader.Read(name.source, isIntrinsic, ancestor, /*silent=*/false)};4316  if (scope) {4317    if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)4318      std::optional<SourceName> submoduleName;4319      if (const Scope * container{FindModuleOrSubmoduleContaining(currScope())};4320          container && container->IsSubmodule()) {4321        submoduleName = container->GetName();4322      }4323      if (submoduleName) {4324        Say(name.source,4325            "Module '%s' cannot USE itself from its own submodule '%s'"_err_en_US,4326            name.source, *submoduleName);4327      } else {4328        Say(name, "Module '%s' cannot USE itself"_err_en_US);4329      }4330    }4331    Resolve(name, scope->symbol());4332  }4333  return scope;4334}4335 4336void ModuleVisitor::ApplyDefaultAccess() {4337  const auto *moduleDetails{4338      DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};4339  CHECK(moduleDetails);4340  Attr defaultAttr{4341      DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE : Attr::PUBLIC};4342  for (auto &pair : currScope()) {4343    Symbol &symbol{*pair.second};4344    if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {4345      Attr attr{defaultAttr};4346      if (auto *generic{symbol.detailsIf<GenericDetails>()}) {4347        if (generic->derivedType()) {4348          // If a generic interface has a derived type of the same4349          // name that has an explicit accessibility attribute, then4350          // the generic must have the same accessibility.4351          if (generic->derivedType()->attrs().test(Attr::PUBLIC)) {4352            attr = Attr::PUBLIC;4353          } else if (generic->derivedType()->attrs().test(Attr::PRIVATE)) {4354            attr = Attr::PRIVATE;4355          }4356        }4357      }4358      SetImplicitAttr(symbol, attr);4359    }4360  }4361}4362 4363// InterfaceVistor implementation4364 4365bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {4366  bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};4367  genericInfo_.emplace(/*isInterface*/ true, isAbstract);4368  return BeginAttrs();4369}4370 4371void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }4372 4373void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {4374  ResolveNewSpecifics();4375  genericInfo_.pop();4376}4377 4378// Create a symbol in genericSymbol_ for this GenericSpec.4379bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {4380  if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) {4381    SetGenericSymbol(*symbol);4382  }4383  return false;4384}4385 4386bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {4387  if (!isGeneric()) {4388    Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);4389  } else {4390    auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};4391    const auto &names{std::get<std::list<parser::Name>>(x.t)};4392    AddSpecificProcs(names, kind);4393  }4394  return false;4395}4396 4397bool InterfaceVisitor::Pre(const parser::GenericStmt &) {4398  genericInfo_.emplace(/*isInterface*/ false);4399  return BeginAttrs();4400}4401void InterfaceVisitor::Post(const parser::GenericStmt &x) {4402  auto attrs{EndAttrs()};4403  if (Symbol * symbol{GetGenericInfo().symbol}) {4404    SetExplicitAttrs(*symbol, attrs);4405  }4406  const auto &names{std::get<std::list<parser::Name>>(x.t)};4407  AddSpecificProcs(names, ProcedureKind::Procedure);4408  ResolveNewSpecifics();4409  genericInfo_.pop();4410}4411 4412bool InterfaceVisitor::inInterfaceBlock() const {4413  return !genericInfo_.empty() && GetGenericInfo().isInterface;4414}4415bool InterfaceVisitor::isGeneric() const {4416  return !genericInfo_.empty() && GetGenericInfo().symbol;4417}4418bool InterfaceVisitor::isAbstract() const {4419  return !genericInfo_.empty() && GetGenericInfo().isAbstract;4420}4421 4422void InterfaceVisitor::AddSpecificProcs(4423    const std::list<parser::Name> &names, ProcedureKind kind) {4424  if (Symbol * symbol{GetGenericInfo().symbol};4425      symbol && symbol->has<GenericDetails>()) {4426    for (const auto &name : names) {4427      specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));4428      genericsForSpecificProcs_.emplace(name.source, symbol);4429    }4430  }4431}4432 4433// By now we should have seen all specific procedures referenced by name in4434// this generic interface. Resolve those names to symbols.4435void GenericHandler::ResolveSpecificsInGeneric(4436    Symbol &generic, bool isEndOfSpecificationPart) {4437  auto &details{generic.get<GenericDetails>()};4438  UnorderedSymbolSet symbolsSeen;4439  for (const Symbol &symbol : details.specificProcs()) {4440    symbolsSeen.insert(symbol.GetUltimate());4441  }4442  auto range{specificsForGenericProcs_.equal_range(&generic)};4443  SpecificProcMapType retain;4444  for (auto it{range.first}; it != range.second; ++it) {4445    const parser::Name *name{it->second.first};4446    auto kind{it->second.second};4447    const Symbol *symbol{isEndOfSpecificationPart4448            ? FindSymbol(*name)4449            : FindInScope(generic.owner(), *name)};4450    ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None};4451    const Symbol *specific{symbol};4452    const Symbol *ultimate{nullptr};4453    if (symbol) {4454      // Subtlety: when *symbol is a use- or host-association, the specific4455      // procedure that is recorded in the GenericDetails below must be *symbol,4456      // not the specific procedure shadowed by a generic, because that specific4457      // procedure may be a symbol from another module and its name unavailable4458      // to emit to a module file.4459      const Symbol &bypassed{BypassGeneric(*symbol)};4460      if (symbol == &symbol->GetUltimate()) {4461        specific = &bypassed;4462      }4463      ultimate = &bypassed.GetUltimate();4464      defClass = ClassifyProcedure(*ultimate);4465    }4466    std::optional<MessageFixedText> error;4467    if (defClass == ProcedureDefinitionClass::Module) {4468      // ok4469    } else if (kind == ProcedureKind::ModuleProcedure) {4470      error = "'%s' is not a module procedure"_err_en_US;4471    } else {4472      switch (defClass) {4473      case ProcedureDefinitionClass::Intrinsic:4474      case ProcedureDefinitionClass::External:4475      case ProcedureDefinitionClass::Internal:4476      case ProcedureDefinitionClass::Dummy:4477      case ProcedureDefinitionClass::Pointer:4478        break;4479      case ProcedureDefinitionClass::None:4480        error = "'%s' is not a procedure"_err_en_US;4481        break;4482      default:4483        error =4484            "'%s' is not a procedure that can appear in a generic interface"_err_en_US;4485        break;4486      }4487    }4488    if (error) {4489      if (isEndOfSpecificationPart) {4490        Say(*name, std::move(*error));4491      } else {4492        // possible forward reference, catch it later4493        retain.emplace(&generic, std::make_pair(name, kind));4494      }4495    } else if (!ultimate) {4496    } else if (symbolsSeen.insert(*ultimate).second /*true if added*/) {4497      // When a specific procedure is a USE association, that association4498      // is saved in the generic's specifics, not its ultimate symbol,4499      // so that module file output of interfaces can distinguish them.4500      details.AddSpecificProc(*specific, name->source);4501    } else if (specific == ultimate) {4502      Say(name->source,4503          "Procedure '%s' is already specified in generic '%s'"_err_en_US,4504          name->source, MakeOpName(generic.name()));4505    } else {4506      Say(name->source,4507          "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,4508          ultimate->name(), ultimate->owner().GetName().value(),4509          MakeOpName(generic.name()));4510    }4511  }4512  specificsForGenericProcs_.erase(range.first, range.second);4513  specificsForGenericProcs_.merge(std::move(retain));4514}4515 4516void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {4517  auto range{genericsForSpecificProcs_.equal_range(proc.name())};4518  for (auto iter{range.first}; iter != range.second; ++iter) {4519    ResolveSpecificsInGeneric(*iter->second, false);4520  }4521}4522 4523void InterfaceVisitor::ResolveNewSpecifics() {4524  if (Symbol * generic{genericInfo_.top().symbol};4525      generic && generic->has<GenericDetails>()) {4526    ResolveSpecificsInGeneric(*generic, false);4527  }4528}4529 4530// Mixed interfaces are allowed by the standard.4531// If there is a derived type with the same name, they must all be functions.4532void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {4533  ResolveSpecificsInGeneric(generic, true);4534  auto &details{generic.get<GenericDetails>()};4535  if (auto *proc{details.CheckSpecific()}) {4536    context().Warn(common::UsageWarning::HomonymousSpecific,4537        proc->name().begin() > generic.name().begin() ? proc->name()4538                                                      : generic.name(),4539        "'%s' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic"_warn_en_US,4540        generic.name());4541  }4542  auto &specifics{details.specificProcs()};4543  if (specifics.empty()) {4544    if (details.derivedType()) {4545      generic.set(Symbol::Flag::Function);4546    }4547    return;4548  }4549  const Symbol *function{nullptr};4550  const Symbol *subroutine{nullptr};4551  for (const Symbol &specific : specifics) {4552    if (!function && specific.test(Symbol::Flag::Function)) {4553      function = &specific;4554    } else if (!subroutine && specific.test(Symbol::Flag::Subroutine)) {4555      subroutine = &specific;4556      if (details.derivedType() &&4557          context().ShouldWarn(4558              common::LanguageFeature::SubroutineAndFunctionSpecifics) &&4559          !InModuleFile()) {4560        SayDerivedType(generic.name(),4561            "Generic interface '%s' should only contain functions due to derived type with same name"_warn_en_US,4562            *details.derivedType()->GetUltimate().scope())4563            .set_languageFeature(4564                common::LanguageFeature::SubroutineAndFunctionSpecifics);4565      }4566    }4567    if (function && subroutine) { // F'2023 C15144568      if (auto *msg{context().Warn(4569              common::LanguageFeature::SubroutineAndFunctionSpecifics,4570              generic.name(),4571              "Generic interface '%s' has both a function and a subroutine"_warn_en_US,4572              generic.name())}) {4573        msg->Attach(function->name(), "Function declaration"_en_US)4574            .Attach(subroutine->name(), "Subroutine declaration"_en_US);4575      }4576      break;4577    }4578  }4579  if (function && !subroutine) {4580    generic.set(Symbol::Flag::Function);4581  } else if (subroutine && !function) {4582    generic.set(Symbol::Flag::Subroutine);4583  }4584}4585 4586// SubprogramVisitor implementation4587 4588// Return false if it is actually an assignment statement.4589bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {4590  const auto &name{std::get<parser::Name>(x.t)};4591  const DeclTypeSpec *resultType{nullptr};4592  // Look up name: provides return type or tells us if it's an array4593  if (auto *symbol{FindSymbol(name)}) {4594    Symbol &ultimate{symbol->GetUltimate()};4595    if (ultimate.has<ObjectEntityDetails>() ||4596        ultimate.has<AssocEntityDetails>() ||4597        CouldBeDataPointerValuedFunction(&ultimate) ||4598        (&symbol->owner() == &currScope() && IsFunctionResult(*symbol))) {4599      misparsedStmtFuncFound_ = true;4600      return false;4601    }4602    if (IsHostAssociated(*symbol, currScope())) {4603      context().Warn(common::LanguageFeature::StatementFunctionExtensions,4604          name.source,4605          "Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US,4606          name.source);4607      MakeSymbol(name, Attrs{}, UnknownDetails{});4608    } else if (auto *entity{ultimate.detailsIf<EntityDetails>()};4609               entity && !ultimate.has<ProcEntityDetails>()) {4610      resultType = entity->type();4611      ultimate.details() = UnknownDetails{}; // will be replaced below4612    } else {4613      misparsedStmtFuncFound_ = true;4614    }4615  }4616  if (misparsedStmtFuncFound_) {4617    Say(name,4618        "'%s' has not been declared as an array or pointer-valued function"_err_en_US);4619    return false;4620  }4621  Symbol *symbol{PushSubprogramScope(name, Symbol::Flag::Function)};4622  if (!symbol) {4623    return false;4624  }4625  symbol->set(Symbol::Flag::StmtFunction);4626  EraseSymbol(*symbol); // removes symbol added by PushSubprogramScope4627  auto &details{symbol->get<SubprogramDetails>()};4628  for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {4629    ObjectEntityDetails dummyDetails{true};4630    if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {4631      if (auto *d{dummySymbol->GetType()}) {4632        dummyDetails.set_type(*d);4633      }4634    }4635    Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};4636    ApplyImplicitRules(dummy);4637    details.add_dummyArg(dummy);4638  }4639  ObjectEntityDetails resultDetails;4640  if (resultType) {4641    resultDetails.set_type(*resultType);4642  }4643  resultDetails.set_funcResult(true);4644  Symbol &result{MakeSymbol(name, std::move(resultDetails))};4645  result.flags().set(Symbol::Flag::StmtFunction);4646  ApplyImplicitRules(result);4647  details.set_result(result);4648  // The analysis of the expression that constitutes the body of the4649  // statement function is deferred to FinishSpecificationPart() so that4650  // all declarations and implicit typing are complete.4651  PopScope();4652  return true;4653}4654 4655bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {4656  if (suffix.resultName) {4657    if (IsFunction(currScope())) {4658      if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {4659        if (info->inFunctionStmt) {4660          info->resultName = &suffix.resultName.value();4661        } else {4662          // will check the result name in Post(EntryStmt)4663        }4664      }4665    } else {4666      Message &msg{Say(*suffix.resultName,4667          "RESULT(%s) may appear only in a function"_err_en_US)};4668      if (const Symbol * subprogram{InclusiveScope().symbol()}) {4669        msg.Attach(subprogram->name(), "Containing subprogram"_en_US);4670      }4671    }4672  }4673  // LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt,4674  // all the way to EndSubprogram().4675  return false;4676}4677 4678bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {4679  // Save this to process after UseStmt and ImplicitPart4680  if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {4681    if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {4682      if (info->parsedType) { // C15434683        Say(currStmtSource().value_or(info->source),4684            "FUNCTION prefix cannot specify the type more than once"_err_en_US);4685      } else {4686        info->parsedType = parsedType;4687        if (auto at{currStmtSource()}) {4688          info->source = *at;4689        }4690      }4691    } else {4692      Say(currStmtSource().value(),4693          "SUBROUTINE prefix cannot specify a type"_err_en_US);4694    }4695    return false;4696  } else {4697    return true;4698  }4699}4700 4701bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {4702  if (auto *subp{currScope().symbol()4703              ? currScope().symbol()->detailsIf<SubprogramDetails>()4704              : nullptr}) {4705    for (auto attr : attrs.v) {4706      if (auto current{subp->cudaSubprogramAttrs()}) {4707        if (attr == *current ||4708            (*current == common::CUDASubprogramAttrs::HostDevice &&4709                (attr == common::CUDASubprogramAttrs::Host ||4710                    attr == common::CUDASubprogramAttrs::Device))) {4711          context().Warn(common::LanguageFeature::RedundantAttribute,4712              currStmtSource().value(),4713              "ATTRIBUTES(%s) appears more than once"_warn_en_US,4714              common::EnumToString(attr));4715        } else if ((attr == common::CUDASubprogramAttrs::Host ||4716                       attr == common::CUDASubprogramAttrs::Device) &&4717            (*current == common::CUDASubprogramAttrs::Host ||4718                *current == common::CUDASubprogramAttrs::Device ||4719                *current == common::CUDASubprogramAttrs::HostDevice)) {4720          // HOST,DEVICE or DEVICE,HOST -> HostDevice4721          subp->set_cudaSubprogramAttrs(4722              common::CUDASubprogramAttrs::HostDevice);4723        } else {4724          Say(currStmtSource().value(),4725              "ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,4726              common::EnumToString(attr), common::EnumToString(*current));4727        }4728      } else {4729        subp->set_cudaSubprogramAttrs(attr);4730      }4731    }4732    if (auto attrs{subp->cudaSubprogramAttrs()}) {4733      if (*attrs == common::CUDASubprogramAttrs::Global ||4734          *attrs == common::CUDASubprogramAttrs::Grid_Global ||4735          *attrs == common::CUDASubprogramAttrs::Device ||4736          *attrs == common::CUDASubprogramAttrs::HostDevice) {4737        const Scope &scope{currScope()};4738        const Scope *mod{FindModuleContaining(scope)};4739        if (mod &&4740            (mod->GetName().value() == "cudadevice" ||4741                mod->GetName().value() == "__cuda_device")) {4742          return false;4743        }4744        // Implicitly USE the cudadevice module by copying its symbols in the4745        // current scope.4746        const Scope &cudaDeviceScope{context().GetCUDADeviceScope()};4747        for (auto sym : cudaDeviceScope.GetSymbols()) {4748          if (!currScope().FindSymbol(sym->name())) {4749            auto &localSymbol{MakeSymbol(4750                sym->name(), Attrs{}, UseDetails{sym->name(), *sym})};4751            localSymbol.flags() = sym->flags();4752          }4753        }4754      }4755    }4756  }4757  return false;4758}4759 4760void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {4761  std::vector<std::int64_t> bounds;4762  bool ok{true};4763  for (const auto &sicx : x.v) {4764    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {4765      bounds.push_back(*value);4766    } else {4767      ok = false;4768    }4769  }4770  if (!ok || bounds.size() < 2 || bounds.size() > 3) {4771    Say(currStmtSource().value(),4772        "Operands of LAUNCH_BOUNDS() must be 2 or 3 integer constants"_err_en_US);4773  } else if (auto *subp{currScope().symbol()4774                     ? currScope().symbol()->detailsIf<SubprogramDetails>()4775                     : nullptr}) {4776    if (subp->cudaLaunchBounds().empty()) {4777      subp->set_cudaLaunchBounds(std::move(bounds));4778    } else {4779      Say(currStmtSource().value(),4780          "LAUNCH_BOUNDS() may only appear once"_err_en_US);4781    }4782  }4783}4784 4785void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {4786  std::vector<std::int64_t> dims;4787  bool ok{true};4788  for (const auto &sicx : x.v) {4789    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {4790      dims.push_back(*value);4791    } else {4792      ok = false;4793    }4794  }4795  if (!ok || dims.size() != 3) {4796    Say(currStmtSource().value(),4797        "Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);4798  } else if (auto *subp{currScope().symbol()4799                     ? currScope().symbol()->detailsIf<SubprogramDetails>()4800                     : nullptr}) {4801    if (subp->cudaClusterDims().empty()) {4802      subp->set_cudaClusterDims(std::move(dims));4803    } else {4804      Say(currStmtSource().value(),4805          "CLUSTER_DIMS() may only appear once"_err_en_US);4806    }4807  }4808}4809 4810static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {4811  for (const auto &prefix : prefixes) {4812    if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {4813      return true;4814    }4815  }4816  return false;4817}4818 4819bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {4820  const auto &stmtTuple{4821      std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};4822  return BeginSubprogram(std::get<parser::Name>(stmtTuple),4823      Symbol::Flag::Subroutine,4824      HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));4825}4826void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {4827  const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};4828  EndSubprogram(stmt.source,4829      &std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t));4830}4831bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {4832  const auto &stmtTuple{4833      std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};4834  return BeginSubprogram(std::get<parser::Name>(stmtTuple),4835      Symbol::Flag::Function,4836      HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));4837}4838void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {4839  const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};4840  const auto &maybeSuffix{4841      std::get<std::optional<parser::Suffix>>(stmt.statement.t)};4842  EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr);4843}4844 4845bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {4846  BeginAttrs();4847  Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t));4848  Walk(std::get<parser::Name>(stmt.t));4849  Walk(std::get<std::list<parser::DummyArg>>(stmt.t));4850  // Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram.4851  Symbol &symbol{PostSubprogramStmt()};4852  SubprogramDetails &details{symbol.get<SubprogramDetails>()};4853  for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {4854    if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {4855      CreateDummyArgument(details, *dummyName);4856    } else {4857      details.add_alternateReturn();4858    }4859  }4860  return false;4861}4862bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {4863  FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};4864  CHECK(!info.inFunctionStmt);4865  info.inFunctionStmt = true;4866  if (auto at{currStmtSource()}) {4867    info.source = *at;4868  }4869  return BeginAttrs();4870}4871bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }4872 4873void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {4874  const auto &name{std::get<parser::Name>(stmt.t)};4875  Symbol &symbol{PostSubprogramStmt()};4876  SubprogramDetails &details{symbol.get<SubprogramDetails>()};4877  for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {4878    CreateDummyArgument(details, dummyName);4879  }4880  const parser::Name *funcResultName;4881  FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};4882  CHECK(info.inFunctionStmt);4883  info.inFunctionStmt = false;4884  bool distinctResultName{4885      info.resultName && info.resultName->source != name.source};4886  if (distinctResultName) {4887    // Note that RESULT is ignored if it has the same name as the function.4888    // The symbol created by PushScope() is retained as a place-holder4889    // for error detection.4890    funcResultName = info.resultName;4891  } else {4892    EraseSymbol(name); // was added by PushScope()4893    funcResultName = &name;4894  }4895  if (details.isFunction()) {4896    CHECK(context().HasError(currScope().symbol()));4897  } else {4898    // RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY4899    // statement.4900    Symbol *result{nullptr};4901    if (distinctResultName) {4902      if (auto iter{currScope().find(funcResultName->source)};4903          iter != currScope().end()) {4904        Symbol &entryResult{*iter->second};4905        if (IsFunctionResult(entryResult)) {4906          result = &entryResult;4907        }4908      }4909    }4910    if (result) {4911      Resolve(*funcResultName, *result);4912    } else {4913      // add function result to function scope4914      EntityDetails funcResultDetails;4915      funcResultDetails.set_funcResult(true);4916      result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));4917    }4918    info.resultSymbol = result;4919    details.set_result(*result);4920  }4921  // C1560.4922  if (info.resultName && !distinctResultName) {4923    context().Warn(common::UsageWarning::HomonymousResult,4924        info.resultName->source,4925        "The function name should not appear in RESULT; references to '%s' inside the function will be considered as references to the result only"_warn_en_US,4926        name.source);4927    // RESULT name was ignored above, the only side effect from doing so will be4928    // the inability to make recursive calls. The related parser::Name is still4929    // resolved to the created function result symbol because every parser::Name4930    // should be resolved to avoid internal errors.4931    Resolve(*info.resultName, info.resultSymbol);4932  }4933  name.symbol = &symbol; // must not be function result symbol4934  // Clear the RESULT() name now in case an ENTRY statement in the implicit-part4935  // has a RESULT() suffix.4936  info.resultName = nullptr;4937}4938 4939Symbol &SubprogramVisitor::PostSubprogramStmt() {4940  Symbol &symbol{*currScope().symbol()};4941  SetExplicitAttrs(symbol, EndAttrs());4942  if (symbol.attrs().test(Attr::MODULE)) {4943    symbol.attrs().set(Attr::EXTERNAL, false);4944    symbol.implicitAttrs().set(Attr::EXTERNAL, false);4945  }4946  return symbol;4947}4948 4949void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {4950  if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) {4951    Walk(suffix->binding);4952  }4953  PostEntryStmt(stmt);4954  EndAttrs();4955}4956 4957void SubprogramVisitor::CreateDummyArgument(4958    SubprogramDetails &details, const parser::Name &name) {4959  Symbol *dummy{FindInScope(name)};4960  if (dummy) {4961    if (IsDummy(*dummy)) {4962      if (dummy->test(Symbol::Flag::EntryDummyArgument)) {4963        dummy->set(Symbol::Flag::EntryDummyArgument, false);4964      } else {4965        Say(name,4966            "'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US,4967            name.source);4968        return;4969      }4970    } else {4971      SayWithDecl(name, *dummy,4972          "'%s' may not appear as a dummy argument name in this subprogram"_err_en_US);4973      return;4974    }4975  } else {4976    dummy = &MakeSymbol(name, EntityDetails{true});4977  }4978  details.add_dummyArg(DEREF(dummy));4979}4980 4981void SubprogramVisitor::CreateEntry(4982    const parser::EntryStmt &stmt, Symbol &subprogram) {4983  const auto &entryName{std::get<parser::Name>(stmt.t)};4984  Scope &outer{currScope().parent()};4985  Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)4986          ? Symbol::Flag::Function4987          : Symbol::Flag::Subroutine};4988  Attrs attrs;4989  const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};4990  bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding &&4991      std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(4992          suffix->binding->t)4993          .has_value()};4994  if (!hasGlobalBindingName) {4995    if (Symbol * extant{FindSymbol(outer, entryName)}) {4996      if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {4997        if (outer.IsTopLevel()) {4998          Say2(entryName,4999              "'%s' is already defined as a global identifier"_err_en_US,5000              *extant, "Previous definition of '%s'"_en_US);5001        } else {5002          SayAlreadyDeclared(entryName, *extant);5003        }5004        return;5005      }5006      attrs = extant->attrs();5007    }5008  }5009  std::optional<SourceName> distinctResultName;5010  if (suffix && suffix->resultName &&5011      suffix->resultName->source != entryName.source) {5012    distinctResultName = suffix->resultName->source;5013  }5014  if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {5015    attrs.set(Attr::PUBLIC);5016  }5017  Symbol *entrySymbol{nullptr};5018  if (hasGlobalBindingName) {5019    // Hide the entry's symbol in a new anonymous global scope so5020    // that its name doesn't clash with anything.5021    Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})};5022    symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});5023    Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)};5024    entrySymbol = &MakeSymbol(hidden, entryName.source, attrs);5025  } else {5026    entrySymbol = FindInScope(outer, entryName.source);5027    if (entrySymbol) {5028      if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {5029        if (auto *specific{generic->specific()}) {5030          // Forward reference to ENTRY from a generic interface5031          entrySymbol = specific;5032          CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs);5033          SetExplicitAttrs(*entrySymbol, attrs);5034        }5035      }5036    } else {5037      entrySymbol = &MakeSymbol(outer, entryName.source, attrs);5038    }5039  }5040  SubprogramDetails entryDetails;5041  entryDetails.set_entryScope(currScope());5042  entrySymbol->set(subpFlag);5043  if (subpFlag == Symbol::Flag::Function) {5044    Symbol *result{nullptr};5045    EntityDetails resultDetails;5046    resultDetails.set_funcResult(true);5047    if (distinctResultName) {5048      // An explicit RESULT() can also be an explicit RESULT()5049      // of the function or another ENTRY.5050      if (auto iter{currScope().find(suffix->resultName->source)};5051          iter != currScope().end()) {5052        result = &*iter->second;5053      }5054      if (!result) {5055        result =5056            &MakeSymbol(*distinctResultName, Attrs{}, std::move(resultDetails));5057      } else if (!result->has<EntityDetails>()) {5058        Say(*distinctResultName,5059            "ENTRY cannot have RESULT(%s) that is not a variable"_err_en_US,5060            *distinctResultName)5061            .Attach(result->name(), "Existing declaration of '%s'"_en_US,5062                result->name());5063        result = nullptr;5064      }5065      if (result) {5066        Resolve(*suffix->resultName, *result);5067      }5068    } else {5069      result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));5070    }5071    if (result) {5072      entryDetails.set_result(*result);5073    }5074  }5075  if (subpFlag == Symbol::Flag::Subroutine || distinctResultName) {5076    Symbol &assoc{MakeSymbol(entryName.source)};5077    assoc.set_details(HostAssocDetails{*entrySymbol});5078    assoc.set(Symbol::Flag::Subroutine);5079  }5080  Resolve(entryName, *entrySymbol);5081  std::set<SourceName> dummies;5082  for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {5083    if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {5084      auto pair{dummies.insert(dummyName->source)};5085      if (!pair.second) {5086        Say(*dummyName,5087            "'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US,5088            dummyName->source);5089        continue;5090      }5091      Symbol *dummy{FindInScope(*dummyName)};5092      if (dummy) {5093        if (!IsDummy(*dummy)) {5094          evaluate::AttachDeclaration(5095              Say(*dummyName,5096                  "'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US,5097                  dummyName->source),5098              *dummy);5099          continue;5100        }5101      } else {5102        dummy = &MakeSymbol(*dummyName, EntityDetails{true});5103        dummy->set(Symbol::Flag::EntryDummyArgument);5104      }5105      entryDetails.add_dummyArg(DEREF(dummy));5106    } else if (subpFlag == Symbol::Flag::Function) { // C15735107      Say(entryName,5108          "ENTRY in a function may not have an alternate return dummy argument"_err_en_US);5109      break;5110    } else {5111      entryDetails.add_alternateReturn();5112    }5113  }5114  entrySymbol->set_details(std::move(entryDetails));5115}5116 5117void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {5118  // The entry symbol should have already been created and resolved5119  // in CreateEntry(), called by BeginSubprogram(), with one exception (below).5120  const auto &name{std::get<parser::Name>(stmt.t)};5121  Scope &inclusiveScope{InclusiveScope()};5122  if (!name.symbol) {5123    if (inclusiveScope.kind() != Scope::Kind::Subprogram) {5124      Say(name.source,5125          "ENTRY '%s' may appear only in a subroutine or function"_err_en_US,5126          name.source);5127    } else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {5128      Say(name.source,5129          "ENTRY '%s' may not appear in a separate module procedure"_err_en_US,5130          name.source);5131    } else {5132      // C1571 - entry is nested, so was not put into the program tree; error5133      // is emitted from MiscChecker in semantics.cpp.5134    }5135    return;5136  }5137  Symbol &entrySymbol{*name.symbol};5138  if (context().HasError(entrySymbol)) {5139    return;5140  }5141  if (!entrySymbol.has<SubprogramDetails>()) {5142    SayAlreadyDeclared(name, entrySymbol);5143    return;5144  }5145  SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};5146  CHECK(entryDetails.entryScope() == &inclusiveScope);5147  SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());5148  entrySymbol.attrs() |= GetAttrs();5149  SetBindNameOn(entrySymbol);5150  for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {5151    if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {5152      if (Symbol * dummy{FindInScope(*dummyName)}) {5153        if (dummy->test(Symbol::Flag::EntryDummyArgument)) {5154          const auto *subp{dummy->detailsIf<SubprogramDetails>()};5155          if (subp && subp->isInterface()) { // ok5156          } else if (!dummy->has<EntityDetails>() &&5157              !dummy->has<ObjectEntityDetails>() &&5158              !dummy->has<ProcEntityDetails>()) {5159            SayWithDecl(*dummyName, *dummy,5160                "ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US);5161          }5162          dummy->set(Symbol::Flag::EntryDummyArgument, false);5163        }5164      }5165    }5166  }5167}5168 5169Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(5170    const parser::Name &name) {5171  auto *symbol{FindSymbol(name)};5172  if (symbol && symbol->has<SubprogramNameDetails>()) {5173    const Scope *parent{nullptr};5174    if (currScope().IsSubmodule()) {5175      parent = currScope().symbol()->get<ModuleDetails>().parent();5176    }5177    symbol = parent ? FindSymbol(*parent, name) : nullptr;5178  }5179  if (symbol) {5180    if (auto *generic{symbol->detailsIf<GenericDetails>()}) {5181      symbol = generic->specific();5182    }5183  }5184  if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {5185    // Error recovery in case of multiple definitions5186    symbol = const_cast<Symbol *>(defnIface);5187  }5188  if (!IsSeparateModuleProcedureInterface(symbol)) {5189    Say(name, "'%s' was not declared a separate module procedure"_err_en_US);5190    symbol = nullptr;5191  }5192  return symbol;5193}5194 5195// A subprogram declared with MODULE PROCEDURE5196bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {5197  Symbol *symbol{FindSeparateModuleProcedureInterface(name)};5198  if (!symbol) {5199    return false;5200  }5201  if (symbol->owner() == currScope() && symbol->scope()) {5202    // This is a MODULE PROCEDURE whose interface appears in its host.5203    // Convert the module procedure's interface into a subprogram.5204    SetScope(DEREF(symbol->scope()));5205    symbol->get<SubprogramDetails>().set_isInterface(false);5206    name.symbol = symbol;5207  } else {5208    // Copy the interface into a new subprogram scope.5209    EraseSymbol(name);5210    Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};5211    PushScope(Scope::Kind::Subprogram, &newSymbol);5212    auto &newSubprogram{newSymbol.get<SubprogramDetails>()};5213    newSubprogram.set_moduleInterface(*symbol);5214    auto &subprogram{symbol->get<SubprogramDetails>()};5215    if (const auto *name{subprogram.bindName()}) {5216      newSubprogram.set_bindName(std::string{*name});5217    }5218    newSymbol.attrs() |= symbol->attrs();5219    newSymbol.set(symbol->test(Symbol::Flag::Subroutine)5220            ? Symbol::Flag::Subroutine5221            : Symbol::Flag::Function);5222    MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());5223  }5224  return true;5225}5226 5227// A subprogram or interface declared with SUBROUTINE or FUNCTION5228bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,5229    Symbol::Flag subpFlag, bool hasModulePrefix,5230    const parser::LanguageBindingSpec *bindingSpec,5231    const ProgramTree::EntryStmtList *entryStmts) {5232  bool isValid{true};5233  if (hasModulePrefix && !currScope().IsModule() &&5234      !currScope().IsSubmodule()) { // C15475235    Say(name,5236        "'%s' is a MODULE procedure which must be declared within a MODULE or SUBMODULE"_err_en_US);5237    // Don't return here because it can be useful to have the scope set for5238    // other semantic checks run before we print the errors5239    isValid = false;5240  }5241  Symbol *moduleInterface{nullptr};5242  if (isValid && hasModulePrefix && !inInterfaceBlock()) {5243    moduleInterface = FindSeparateModuleProcedureInterface(name);5244    if (moduleInterface && &moduleInterface->owner() == &currScope()) {5245      // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface5246      // previously defined in the same scope.5247      if (GenericDetails *5248          generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {5249        generic->clear_specific();5250        name.symbol = nullptr;5251      } else {5252        EraseSymbol(name);5253      }5254    }5255  }5256  Symbol *newSymbol{5257      PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};5258  if (!newSymbol) {5259    return false;5260  }5261  if (moduleInterface) {5262    newSymbol->get<SubprogramDetails>().set_moduleInterface(*moduleInterface);5263    if (moduleInterface->attrs().test(Attr::PRIVATE)) {5264      SetImplicitAttr(*newSymbol, Attr::PRIVATE);5265    } else if (moduleInterface->attrs().test(Attr::PUBLIC)) {5266      SetImplicitAttr(*newSymbol, Attr::PUBLIC);5267    }5268  }5269  if (entryStmts) {5270    for (const auto &ref : *entryStmts) {5271      CreateEntry(*ref, *newSymbol);5272    }5273  }5274  return true;5275}5276 5277void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol,5278    std::optional<parser::CharBlock> stmtSource,5279    const std::optional<parser::LanguageBindingSpec> *binding) {5280  if (binding && *binding && symbol) {5281    // Finally process the BIND(C,NAME=name) now that symbols in the name5282    // expression will resolve to local names if needed.5283    auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};5284    auto originalStmtSource{messageHandler().currStmtSource()};5285    messageHandler().set_currStmtSource(stmtSource);5286    BeginAttrs();5287    Walk(**binding);5288    SetBindNameOn(*symbol);5289    symbol->attrs() |= EndAttrs();5290    messageHandler().set_currStmtSource(originalStmtSource);5291  }5292}5293 5294void SubprogramVisitor::EndSubprogram(5295    std::optional<parser::CharBlock> stmtSource,5296    const std::optional<parser::LanguageBindingSpec> *binding,5297    const ProgramTree::EntryStmtList *entryStmts) {5298  HandleLanguageBinding(currScope().symbol(), stmtSource, binding);5299  if (entryStmts) {5300    for (const auto &ref : *entryStmts) {5301      const parser::EntryStmt &entryStmt{*ref};5302      if (const auto &suffix{5303              std::get<std::optional<parser::Suffix>>(entryStmt.t)}) {5304        const auto &name{std::get<parser::Name>(entryStmt.t)};5305        HandleLanguageBinding(name.symbol, name.source, &suffix->binding);5306      }5307    }5308  }5309  if (inInterfaceBlock() && currScope().symbol()) {5310    DeclaredPossibleSpecificProc(*currScope().symbol());5311  }5312  PopScope();5313}5314 5315bool SubprogramVisitor::HandlePreviousCalls(5316    const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {5317  // If the extant symbol is a generic, check its homonymous specific5318  // procedure instead if it has one.5319  if (auto *generic{symbol.detailsIf<GenericDetails>()}) {5320    return generic->specific() &&5321        HandlePreviousCalls(name, *generic->specific(), subpFlag);5322  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&5323             !proc->isDummy() &&5324             !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {5325    // There's a symbol created for previous calls to this subprogram or5326    // ENTRY's name.  We have to replace that symbol in situ to avoid the5327    // obligation to rewrite symbol pointers in the parse tree.5328    if (!symbol.test(subpFlag)) {5329      auto other{subpFlag == Symbol::Flag::Subroutine5330              ? Symbol::Flag::Function5331              : Symbol::Flag::Subroutine};5332      // External statements issue an explicit EXTERNAL attribute.5333      if (symbol.attrs().test(Attr::EXTERNAL) &&5334          !symbol.implicitAttrs().test(Attr::EXTERNAL)) {5335        // Warn if external statement previously declared.5336        context().Warn(common::LanguageFeature::RedundantAttribute, name.source,5337            "EXTERNAL attribute was already specified on '%s'"_warn_en_US,5338            name.source);5339      } else if (symbol.test(other)) {5340        Say2(name,5341            subpFlag == Symbol::Flag::Function5342                ? "'%s' was previously called as a subroutine"_err_en_US5343                : "'%s' was previously called as a function"_err_en_US,5344            symbol, "Previous call of '%s'"_en_US);5345      } else {5346        symbol.set(subpFlag);5347      }5348    }5349    EntityDetails entity;5350    if (proc->type()) {5351      entity.set_type(*proc->type());5352    }5353    symbol.details() = std::move(entity);5354    return true;5355  } else {5356    return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();5357  }5358}5359 5360const Symbol *SubprogramVisitor::CheckExtantProc(5361    const parser::Name &name, Symbol::Flag subpFlag) {5362  Symbol *prev{FindSymbol(name)};5363  if (prev) {5364    if (IsDummy(*prev)) {5365    } else if (auto *entity{prev->detailsIf<EntityDetails>()};5366               IsPointer(*prev) && entity && !entity->type()) {5367      // POINTER attribute set before interface5368    } else if (inInterfaceBlock() && currScope() != prev->owner()) {5369      // Procedures in an INTERFACE block do not resolve to symbols5370      // in scopes between the global scope and the current scope.5371    } else if (!HandlePreviousCalls(name, *prev, subpFlag)) {5372      SayAlreadyDeclared(name, *prev);5373    }5374  }5375  return prev;5376}5377 5378Symbol *SubprogramVisitor::PushSubprogramScope(const parser::Name &name,5379    Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,5380    bool hasModulePrefix) {5381  Symbol *symbol{GetSpecificFromGeneric(name)};5382  const DeclTypeSpec *previousImplicitType{nullptr};5383  SourceName previousName;5384  if (symbol && inInterfaceBlock() && !symbol->has<SubprogramDetails>()) {5385    SayAlreadyDeclared(name, *symbol);5386    return nullptr;5387  }5388  if (!symbol) {5389    if (bindingSpec && currScope().IsGlobal() &&5390        std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(5391            bindingSpec->t)5392            .has_value()) {5393      // Create this new top-level subprogram with a binding label5394      // in a new global scope, so that its symbol's name won't clash5395      // with another symbol that has a distinct binding label.5396      PushScope(Scope::Kind::Global,5397          &MakeSymbol(context().GetTempName(currScope()), Attrs{},5398              MiscDetails{MiscDetails::Kind::ScopeName}));5399    }5400    if (const Symbol *previous{CheckExtantProc(name, subpFlag)}) {5401      if (previous->test(Symbol::Flag::Function) &&5402          previous->test(Symbol::Flag::Implicit)) {5403        // Function was implicitly typed in previous compilation unit.5404        previousImplicitType = previous->GetType();5405        previousName = previous->name();5406      }5407    }5408    symbol = &MakeSymbol(name, SubprogramDetails{});5409  }5410  symbol->ReplaceName(name.source);5411  symbol->set(subpFlag);5412  PushScope(Scope::Kind::Subprogram, symbol);5413  if (subpFlag == Symbol::Flag::Function) {5414    auto &funcResultTop{funcResultStack().Push(currScope(), name.source)};5415    funcResultTop.previousImplicitType = previousImplicitType;5416    funcResultTop.previousName = previousName;5417  }5418  if (inInterfaceBlock()) {5419    auto &details{symbol->get<SubprogramDetails>()};5420    details.set_isInterface();5421    if (isAbstract()) {5422      SetExplicitAttr(*symbol, Attr::ABSTRACT);5423    } else if (hasModulePrefix) {5424      SetExplicitAttr(*symbol, Attr::MODULE);5425    } else {5426      MakeExternal(*symbol);5427    }5428    if (isGeneric()) {5429      Symbol &genericSymbol{GetGenericSymbol()};5430      if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {5431        details->AddSpecificProc(*symbol, name.source);5432      } else {5433        CHECK(context().HasError(genericSymbol));5434      }5435    }5436    set_inheritFromParent(false); // interfaces don't inherit, even if MODULE5437  }5438  if (Symbol * found{FindSymbol(name)};5439      found && found->has<HostAssocDetails>()) {5440    found->set(subpFlag); // PushScope() created symbol5441  }5442  return symbol;5443}5444 5445void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {5446  if (auto *prev{FindSymbol(name)}) {5447    if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {5448      if (prev->test(Symbol::Flag::Subroutine) ||5449          prev->test(Symbol::Flag::Function)) {5450        Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,5451            "Previous call of '%s'"_en_US);5452      }5453      EraseSymbol(name);5454    }5455  }5456  if (name.source.empty()) {5457    // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM5458    PushScope(Scope::Kind::BlockData, nullptr);5459  } else {5460    PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));5461  }5462}5463 5464// If name is a generic in the same scope, return its specific subprogram with5465// the same name, if any.5466Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {5467  // Search for the name but don't resolve it5468  if (auto *symbol{currScope().FindSymbol(name.source)}) {5469    if (symbol->has<SubprogramNameDetails>()) {5470      if (inInterfaceBlock()) {5471        // Subtle: clear any MODULE flag so that the new interface5472        // symbol doesn't inherit it and ruin the ability to check it.5473        symbol->attrs().reset(Attr::MODULE);5474      }5475    } else if (&symbol->owner() != &currScope() && inInterfaceBlock() &&5476        !isGeneric()) {5477      // non-generic interface shadows outer definition5478    } else if (auto *details{symbol->detailsIf<GenericDetails>()}) {5479      // found generic, want specific procedure5480      auto *specific{details->specific()};5481      Attrs moduleAttr;5482      if (inInterfaceBlock()) {5483        if (specific) {5484          // Defining an interface in a generic of the same name which is5485          // already shadowing another procedure.  In some cases, the shadowed5486          // procedure is about to be replaced.5487          if (specific->has<SubprogramNameDetails>() &&5488              specific->attrs().test(Attr::MODULE)) {5489            // The shadowed procedure is a separate module procedure that is5490            // actually defined later in this (sub)module.5491            // Define its interface now as a new symbol.5492            moduleAttr.set(Attr::MODULE);5493            specific = nullptr;5494          } else if (&specific->owner() != &symbol->owner()) {5495            // The shadowed procedure was from an enclosing scope and will be5496            // overridden by this interface definition.5497            specific = nullptr;5498          }5499          if (!specific) {5500            details->clear_specific();5501          }5502        } else if (const auto *dType{details->derivedType()}) {5503          if (&dType->owner() != &symbol->owner()) {5504            // The shadowed derived type was from an enclosing scope and5505            // will be overridden by this interface definition.5506            details->clear_derivedType();5507          }5508        }5509      }5510      if (!specific) {5511        specific = &currScope().MakeSymbol(5512            name.source, std::move(moduleAttr), SubprogramDetails{});5513        if (details->derivedType()) {5514          // A specific procedure with the same name as a derived type5515          SayAlreadyDeclared(name, *details->derivedType());5516        } else {5517          details->set_specific(Resolve(name, *specific));5518        }5519      } else if (isGeneric()) {5520        SayAlreadyDeclared(name, *specific);5521      }5522      if (specific->has<SubprogramNameDetails>()) {5523        specific->set_details(Details{SubprogramDetails{}});5524      }5525      return specific;5526    }5527  }5528  return nullptr;5529}5530 5531// DeclarationVisitor implementation5532 5533bool DeclarationVisitor::BeginDecl() {5534  BeginDeclTypeSpec();5535  BeginArraySpec();5536  return BeginAttrs();5537}5538void DeclarationVisitor::EndDecl() {5539  EndDeclTypeSpec();5540  EndArraySpec();5541  EndAttrs();5542}5543 5544bool DeclarationVisitor::CheckUseError(const parser::Name &name) {5545  return HadUseError(context(), name.source, name.symbol);5546}5547 5548// Report error if accessibility of symbol doesn't match isPrivate.5549void DeclarationVisitor::CheckAccessibility(5550    const SourceName &name, bool isPrivate, Symbol &symbol) {5551  if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {5552    Say2(name,5553        "'%s' does not have the same accessibility as its previous declaration"_err_en_US,5554        symbol, "Previous declaration of '%s'"_en_US);5555  }5556}5557 5558bool DeclarationVisitor::Pre(const parser::TypeDeclarationStmt &x) {5559  BeginDecl();5560  // If INTRINSIC appears as an attr-spec, handle it now as if the5561  // names had appeared on an INTRINSIC attribute statement beforehand.5562  for (const auto &attr : std::get<std::list<parser::AttrSpec>>(x.t)) {5563    if (std::holds_alternative<parser::Intrinsic>(attr.u)) {5564      for (const auto &decl : std::get<std::list<parser::EntityDecl>>(x.t)) {5565        DeclareIntrinsic(parser::GetFirstName(decl));5566      }5567      break;5568    }5569  }5570  return true;5571}5572void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {5573  EndDecl();5574}5575 5576void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {5577  DeclareObjectEntity(std::get<parser::Name>(x.t));5578}5579void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {5580  DeclareObjectEntity(std::get<parser::Name>(x.t));5581}5582 5583bool DeclarationVisitor::Pre(const parser::Initialization &) {5584  // Defer inspection of initializers to Initialization() so that the5585  // symbol being initialized will be available within the initialization5586  // expression.5587  return false;5588}5589 5590void DeclarationVisitor::Post(const parser::EntityDecl &x) {5591  const auto &name{std::get<parser::ObjectName>(x.t)};5592  Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};5593  attrs.set(Attr::INTRINSIC, false); // dealt with in Pre(TypeDeclarationStmt)5594  Symbol &symbol{DeclareUnknownEntity(name, attrs)};5595  symbol.ReplaceName(name.source);5596  SetCUDADataAttr(name.source, symbol, cudaDataAttr());5597  if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {5598    ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);5599    symbol.set(5600        Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors5601    Initialization(name, *init, /*inComponentDecl=*/false);5602  } else if (attrs.test(Attr::PARAMETER)) { // C882, C8835603    Say(name, "Missing initialization for parameter '%s'"_err_en_US);5604  }5605  if (auto *scopeSymbol{currScope().symbol()}) {5606    if (auto *details{scopeSymbol->detailsIf<DerivedTypeDetails>()}) {5607      if (details->isDECStructure()) {5608        details->add_component(symbol);5609      }5610    }5611  }5612}5613 5614void DeclarationVisitor::Post(const parser::PointerDecl &x) {5615  const auto &name{std::get<parser::Name>(x.t)};5616  if (const auto &deferredShapeSpecs{5617          std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {5618    CHECK(arraySpec().empty());5619    BeginArraySpec();5620    set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));5621    Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};5622    symbol.ReplaceName(name.source);5623    EndArraySpec();5624  } else {5625    if (const auto *symbol{FindInScope(name)}) {5626      const auto *subp{symbol->detailsIf<SubprogramDetails>()};5627      if (!symbol->has<UseDetails>() && // error caught elsewhere5628          !symbol->has<ObjectEntityDetails>() &&5629          !symbol->has<ProcEntityDetails>() &&5630          !symbol->CanReplaceDetails(ObjectEntityDetails{}) &&5631          !symbol->CanReplaceDetails(ProcEntityDetails{}) &&5632          !(subp && subp->isInterface())) {5633        Say(name, "'%s' cannot have the POINTER attribute"_err_en_US);5634      }5635    }5636    HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t));5637  }5638}5639 5640bool DeclarationVisitor::Pre(const parser::BindEntity &x) {5641  auto kind{std::get<parser::BindEntity::Kind>(x.t)};5642  auto &name{std::get<parser::Name>(x.t)};5643  Symbol *symbol;5644  if (kind == parser::BindEntity::Kind::Object) {5645    symbol = &HandleAttributeStmt(Attr::BIND_C, name);5646  } else {5647    symbol = &MakeCommonBlockSymbol(name, name.source);5648    SetExplicitAttr(*symbol, Attr::BIND_C);5649  }5650  // 8.6.4(1)5651  // Some entities such as named constant or module name need to checked5652  // elsewhere. This is to skip the ICE caused by setting Bind name for non-name5653  // things such as data type and also checks for procedures.5654  if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() ||5655      symbol->has<EntityDetails>()) {5656    SetBindNameOn(*symbol);5657  } else {5658    Say(name,5659        "Only variable and named common block can be in BIND statement"_err_en_US);5660  }5661  return false;5662}5663bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) {5664  inOldStyleParameterStmt_ = true;5665  Walk(x.v);5666  inOldStyleParameterStmt_ = false;5667  return false;5668}5669bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {5670  auto &name{std::get<parser::NamedConstant>(x.t).v};5671  auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};5672  ConvertToObjectEntity(symbol);5673  auto *details{symbol.detailsIf<ObjectEntityDetails>()};5674  if (!details || symbol.test(Symbol::Flag::CrayPointer) ||5675      symbol.test(Symbol::Flag::CrayPointee)) {5676    SayWithDecl(5677        name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);5678    return false;5679  }5680  const auto &expr{std::get<parser::ConstantExpr>(x.t)};5681  if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {5682    Say(name, "Named constant '%s' already has a value"_err_en_US);5683  }5684  parser::CharBlock at{parser::UnwrapRef<parser::Expr>(expr).source};5685  if (inOldStyleParameterStmt_) {5686    // non-standard extension PARAMETER statement (no parentheses)5687    Walk(expr);5688    auto folded{EvaluateExpr(expr)};5689    if (details->type()) {5690      SayWithDecl(name, symbol,5691          "Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US);5692    } else if (folded) {5693      if (evaluate::IsActuallyConstant(*folded)) {5694        if (const auto *type{currScope().GetType(*folded)}) {5695          if (type->IsPolymorphic()) {5696            Say(at, "The expression must not be polymorphic"_err_en_US);5697          } else if (auto shape{ToArraySpec(5698                         GetFoldingContext(), evaluate::GetShape(*folded))}) {5699            // The type of the named constant is assumed from the expression.5700            details->set_type(*type);5701            details->set_init(std::move(*folded));5702            details->set_shape(std::move(*shape));5703          } else {5704            Say(at, "The expression must have constant shape"_err_en_US);5705          }5706        } else {5707          Say(at, "The expression must have a known type"_err_en_US);5708        }5709      } else {5710        Say(at, "The expression must be a constant of known type"_err_en_US);5711      }5712    }5713  } else {5714    // standard-conforming PARAMETER statement (with parentheses)5715    ApplyImplicitRules(symbol);5716    Walk(expr);5717    if (auto converted{EvaluateNonPointerInitializer(symbol, expr, at)}) {5718      details->set_init(std::move(*converted));5719    }5720  }5721  return false;5722}5723bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {5724  const parser::Name &name{x.v};5725  if (!FindSymbol(name)) {5726    Say(name, "Named constant '%s' not found"_err_en_US);5727  } else {5728    CheckUseError(name);5729  }5730  return false;5731}5732 5733bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {5734  const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};5735  Symbol *symbol{FindInScope(name)};5736  if (symbol && !symbol->has<UnknownDetails>()) {5737    // Contrary to named constants appearing in a PARAMETER statement,5738    // enumerator names should not have their type, dimension or any other5739    // attributes defined before they are declared in the enumerator statement,5740    // with the exception of accessibility.5741    // This is not explicitly forbidden by the standard, but they are scalars5742    // which type is left for the compiler to chose, so do not let users try to5743    // tamper with that.5744    SayAlreadyDeclared(name, *symbol);5745    symbol = nullptr;5746  } else {5747    // Enumerators are treated as PARAMETER (section 7.6 paragraph (4))5748    symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});5749    symbol->SetType(context().MakeNumericType(5750        TypeCategory::Integer, evaluate::CInteger::kind));5751  }5752 5753  if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(5754          enumerator.t)}) {5755    Walk(*init); // Resolve names in expression before evaluation.5756    if (auto value{EvaluateInt64(context(), *init)}) {5757      // Cast all init expressions to C_INT so that they can then be5758      // safely incremented (see 7.6 Note 2).5759      enumerationState_.value = static_cast<int>(*value);5760    } else {5761      Say(name,5762          "Enumerator value could not be computed "5763          "from the given expression"_err_en_US);5764      // Prevent resolution of next enumerators value5765      enumerationState_.value = std::nullopt;5766    }5767  }5768 5769  if (symbol) {5770    if (enumerationState_.value) {5771      symbol->get<ObjectEntityDetails>().set_init(SomeExpr{5772          evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});5773    } else {5774      context().SetError(*symbol);5775    }5776  }5777 5778  if (enumerationState_.value) {5779    (*enumerationState_.value)++;5780  }5781  return false;5782}5783 5784void DeclarationVisitor::Post(const parser::EnumDef &) {5785  enumerationState_ = EnumeratorState{};5786}5787 5788bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {5789  Attr attr{AccessSpecToAttr(x)};5790  if (!NonDerivedTypeScope().IsModule()) { // C8175791    Say(currStmtSource().value(),5792        "%s attribute may only appear in the specification part of a module"_err_en_US,5793        EnumToString(attr));5794  }5795  CheckAndSet(attr);5796  return false;5797}5798 5799bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {5800  return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);5801}5802bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {5803  return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);5804}5805bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {5806  HandleAttributeStmt(Attr::EXTERNAL, x.v);5807  for (const auto &name : x.v) {5808    auto *symbol{FindSymbol(name)};5809    if (!ConvertToProcEntity(DEREF(symbol), name.source)) {5810      // Check if previous symbol is an interface.5811      if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {5812        if (details->isInterface()) {5813          // Warn if interface previously declared.5814          context().Warn(common::LanguageFeature::RedundantAttribute,5815              name.source,5816              "EXTERNAL attribute was already specified on '%s'"_warn_en_US,5817              name.source);5818        }5819      } else {5820        SayWithDecl(5821            name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);5822      }5823    } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C8405824      Say(symbol->name(),5825          "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,5826          symbol->name());5827    }5828  }5829  return false;5830}5831bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {5832  auto &intentSpec{std::get<parser::IntentSpec>(x.t)};5833  auto &names{std::get<std::list<parser::Name>>(x.t)};5834  return CheckNotInBlock("INTENT") && // C11075835      HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);5836}5837bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {5838  for (const auto &name : x.v) {5839    DeclareIntrinsic(name);5840  }5841  return false;5842}5843void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {5844  HandleAttributeStmt(Attr::INTRINSIC, name);5845  if (!IsIntrinsic(name.source, std::nullopt)) {5846    Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);5847  }5848  auto &symbol{DEREF(FindSymbol(name))};5849  if (symbol.has<GenericDetails>()) {5850    // Generic interface is extending intrinsic; ok5851  } else if (!ConvertToProcEntity(symbol, name.source)) {5852    SayWithDecl(5853        name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);5854  } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C8405855    Say(symbol.name(),5856        "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,5857        symbol.name());5858  } else {5859    if (symbol.GetType()) {5860      // These warnings are worded so that they should make sense in either5861      // order.5862      if (auto *msg{context().Warn(5863              common::UsageWarning::IgnoredIntrinsicFunctionType, symbol.name(),5864              "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,5865              symbol.name())}) {5866        msg->Attach(name.source,5867            "INTRINSIC statement for explicitly-typed '%s'"_en_US, name.source);5868      }5869    }5870    if (!symbol.test(Symbol::Flag::Function) &&5871        !symbol.test(Symbol::Flag::Subroutine) &&5872        !context().intrinsics().IsDualIntrinsic(name.source.ToString())) {5873      if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) {5874        symbol.set(Symbol::Flag::Function);5875      } else if (context().intrinsics().IsIntrinsicSubroutine(5876                     name.source.ToString())) {5877        symbol.set(Symbol::Flag::Subroutine);5878      }5879    }5880  }5881}5882bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {5883  return CheckNotInBlock("OPTIONAL") && // C11075884      HandleAttributeStmt(Attr::OPTIONAL, x.v);5885}5886bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {5887  return HandleAttributeStmt(Attr::PROTECTED, x.v);5888}5889bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {5890  return CheckNotInBlock("VALUE") && // C11075891      HandleAttributeStmt(Attr::VALUE, x.v);5892}5893bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {5894  return HandleAttributeStmt(Attr::VOLATILE, x.v);5895}5896bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {5897  auto attr{std::get<common::CUDADataAttr>(x.t)};5898  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {5899    auto *symbol{FindInScope(name)};5900    if (symbol && symbol->has<UseDetails>()) {5901      Say(currStmtSource().value(),5902          "Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,5903          name.source);5904    } else {5905      if (!symbol) {5906        symbol = &MakeSymbol(name, ObjectEntityDetails{});5907      }5908      SetCUDADataAttr(name.source, *symbol, attr);5909    }5910  }5911  return false;5912}5913// Handle a statement that sets an attribute on a list of names.5914bool DeclarationVisitor::HandleAttributeStmt(5915    Attr attr, const std::list<parser::Name> &names) {5916  for (const auto &name : names) {5917    HandleAttributeStmt(attr, name);5918  }5919  return false;5920}5921Symbol &DeclarationVisitor::HandleAttributeStmt(5922    Attr attr, const parser::Name &name) {5923  auto *symbol{FindInScope(name)};5924  if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {5925    // these can be set on a symbol that is host-assoc or use-assoc5926    if (!symbol &&5927        (currScope().kind() == Scope::Kind::Subprogram ||5928            currScope().kind() == Scope::Kind::BlockConstruct)) {5929      if (auto *hostSymbol{FindSymbol(name)}) {5930        symbol = &MakeHostAssocSymbol(name, *hostSymbol);5931      }5932    }5933  } else if (symbol && symbol->has<UseDetails>()) {5934    if (symbol->GetUltimate().attrs().test(attr)) {5935      context().Warn(common::LanguageFeature::RedundantAttribute,5936          currStmtSource().value(),5937          "Use-associated '%s' already has '%s' attribute"_warn_en_US,5938          name.source, EnumToString(attr));5939    } else {5940      Say(currStmtSource().value(),5941          "Cannot change %s attribute on use-associated '%s'"_err_en_US,5942          EnumToString(attr), name.source);5943    }5944    return *symbol;5945  }5946  if (!symbol) {5947    symbol = &MakeSymbol(name, EntityDetails{});5948  }5949  if (CheckDuplicatedAttr(name.source, *symbol, attr)) {5950    HandleSaveName(name.source, Attrs{attr});5951    SetExplicitAttr(*symbol, attr);5952  }5953  return *symbol;5954}5955// C11075956bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {5957  if (currScope().kind() == Scope::Kind::BlockConstruct) {5958    Say(MessageFormattedText{5959        "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});5960    return false;5961  } else {5962    return true;5963  }5964}5965 5966void DeclarationVisitor::Post(const parser::ObjectDecl &x) {5967  CHECK(objectDeclAttr_);5968  const auto &name{std::get<parser::ObjectName>(x.t)};5969  DeclareObjectEntity(name, Attrs{*objectDeclAttr_});5970}5971 5972// Declare an entity not yet known to be an object or proc.5973Symbol &DeclarationVisitor::DeclareUnknownEntity(5974    const parser::Name &name, Attrs attrs) {5975  if (!arraySpec().empty() || !coarraySpec().empty()) {5976    return DeclareObjectEntity(name, attrs);5977  } else {5978    Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};5979    if (auto *type{GetDeclTypeSpec()}) {5980      ForgetEarlyDeclaredDummyArgument(symbol);5981      SetType(name, *type);5982    }5983    charInfo_.length.reset();5984    if (symbol.attrs().test(Attr::EXTERNAL)) {5985      ConvertToProcEntity(symbol);5986    } else if (symbol.attrs().HasAny(Attrs{Attr::ALLOCATABLE,5987                   Attr::ASYNCHRONOUS, Attr::CONTIGUOUS, Attr::PARAMETER,5988                   Attr::SAVE, Attr::TARGET, Attr::VALUE, Attr::VOLATILE})) {5989      ConvertToObjectEntity(symbol);5990    }5991    if (attrs.test(Attr::BIND_C)) {5992      SetBindNameOn(symbol);5993    }5994    return symbol;5995  }5996}5997 5998bool DeclarationVisitor::HasCycle(5999    const Symbol &procSymbol, const Symbol *interface) {6000  SourceOrderedSymbolSet procsInCycle;6001  procsInCycle.insert(procSymbol);6002  while (interface) {6003    if (procsInCycle.count(*interface) > 0) {6004      for (const auto &procInCycle : procsInCycle) {6005        Say(procInCycle->name(),6006            "The interface for procedure '%s' is recursively defined"_err_en_US,6007            procInCycle->name());6008        context().SetError(*procInCycle);6009      }6010      return true;6011    } else if (const auto *procDetails{6012                   interface->detailsIf<ProcEntityDetails>()}) {6013      procsInCycle.insert(*interface);6014      interface = procDetails->procInterface();6015    } else {6016      break;6017    }6018  }6019  return false;6020}6021 6022Symbol &DeclarationVisitor::DeclareProcEntity(6023    const parser::Name &name, Attrs attrs, const Symbol *interface) {6024  Symbol *proc{nullptr};6025  if (auto *extant{FindInScope(name)}) {6026    if (auto *d{extant->detailsIf<GenericDetails>()}; d && !d->derivedType()) {6027      // procedure pointer with same name as a generic6028      if (auto *specific{d->specific()}) {6029        SayAlreadyDeclared(name, *specific);6030      } else {6031        // Create the ProcEntityDetails symbol in the scope as the "specific()"6032        // symbol behind an existing GenericDetails symbol of the same name.6033        proc = &Resolve(name,6034            currScope().MakeSymbol(name.source, attrs, ProcEntityDetails{}));6035        d->set_specific(*proc);6036      }6037    }6038  }6039  Symbol &symbol{proc ? *proc : DeclareEntity<ProcEntityDetails>(name, attrs)};6040  if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {6041    if (context().HasError(symbol)) {6042    } else if (HasCycle(symbol, interface)) {6043      return symbol;6044    } else if (interface && (details->procInterface() || details->type())) {6045      SayWithDecl(name, symbol,6046          "The interface for procedure '%s' has already been declared"_err_en_US);6047      context().SetError(symbol);6048    } else if (interface) {6049      details->set_procInterfaces(6050          *interface, BypassGeneric(interface->GetUltimate()));6051      if (interface->test(Symbol::Flag::Function)) {6052        symbol.set(Symbol::Flag::Function);6053      } else if (interface->test(Symbol::Flag::Subroutine)) {6054        symbol.set(Symbol::Flag::Subroutine);6055      }6056    } else if (auto *type{GetDeclTypeSpec()}) {6057      ForgetEarlyDeclaredDummyArgument(symbol);6058      SetType(name, *type);6059      symbol.set(Symbol::Flag::Function);6060    }6061    SetBindNameOn(symbol);6062    SetPassNameOn(symbol);6063  }6064  return symbol;6065}6066 6067Symbol &DeclarationVisitor::DeclareObjectEntity(6068    const parser::Name &name, Attrs attrs) {6069  Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};6070  if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {6071    if (auto *type{GetDeclTypeSpec()}) {6072      ForgetEarlyDeclaredDummyArgument(symbol);6073      SetType(name, *type);6074    }6075    if (!arraySpec().empty()) {6076      if (details->IsArray()) {6077        if (!context().HasError(symbol)) {6078          Say(name,6079              "The dimensions of '%s' have already been declared"_err_en_US);6080          context().SetError(symbol);6081        }6082      } else if (MustBeScalar(symbol)) {6083        if (!context().HasError(symbol)) {6084          context().Warn(common::UsageWarning::PreviousScalarUse, name.source,6085              "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US,6086              name.source);6087        }6088      } else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {6089        Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);6090      } else {6091        details->set_shape(arraySpec());6092      }6093    }6094    if (!coarraySpec().empty()) {6095      if (details->IsCoarray()) {6096        if (!context().HasError(symbol)) {6097          Say(name,6098              "The codimensions of '%s' have already been declared"_err_en_US);6099          context().SetError(symbol);6100        }6101      } else {6102        details->set_coshape(coarraySpec());6103      }6104    }6105    SetBindNameOn(symbol);6106  }6107  ClearArraySpec();6108  ClearCoarraySpec();6109  charInfo_.length.reset();6110  return symbol;6111}6112 6113void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {6114  if (!isVectorType_) {6115    SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));6116  }6117}6118void DeclarationVisitor::Post(const parser::UnsignedTypeSpec &x) {6119  if (!isVectorType_) {6120    if (!context().IsEnabled(common::LanguageFeature::Unsigned) &&6121        !context().AnyFatalError()) {6122      context().Say("-funsigned is required to enable UNSIGNED type"_err_en_US);6123    }6124    SetDeclTypeSpec(MakeNumericType(TypeCategory::Unsigned, x.v));6125  }6126}6127void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {6128  if (!isVectorType_) {6129    SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));6130  }6131}6132void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {6133  SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));6134}6135void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {6136  SetDeclTypeSpec(MakeLogicalType(x.kind));6137}6138void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {6139  if (!charInfo_.length) {6140    charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};6141  }6142  if (!charInfo_.kind) {6143    charInfo_.kind =6144        KindExpr{context().GetDefaultKind(TypeCategory::Character)};6145  }6146  SetDeclTypeSpec(currScope().MakeCharacterType(6147      std::move(*charInfo_.length), std::move(*charInfo_.kind)));6148  charInfo_ = {};6149}6150void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {6151  charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);6152  std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};6153  if (intKind &&6154      !context().targetCharacteristics().IsTypeEnabled(6155          TypeCategory::Character, *intKind)) { // C715, C7196156    Say(currStmtSource().value(),6157        "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);6158    charInfo_.kind = std::nullopt; // prevent further errors6159  }6160  if (x.length) {6161    charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);6162  }6163}6164void DeclarationVisitor::Post(const parser::CharLength &x) {6165  if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {6166    charInfo_.length = ParamValue{6167        static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};6168  } else {6169    charInfo_.length = GetParamValue(6170        std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);6171  }6172}6173void DeclarationVisitor::Post(const parser::LengthSelector &x) {6174  if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {6175    charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);6176  }6177}6178 6179bool DeclarationVisitor::Pre(const parser::KindParam &x) {6180  if (const auto *kind{std::get_if<6181          parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(6182          &x.u)}) {6183    const auto &name{parser::UnwrapRef<parser::Name>(kind)};6184    if (!FindSymbol(name)) {6185      Say(name, "Parameter '%s' not found"_err_en_US);6186    }6187  }6188  return false;6189}6190 6191int DeclarationVisitor::GetVectorElementKind(6192    TypeCategory category, const std::optional<parser::KindSelector> &kind) {6193  KindExpr value{GetKindParamExpr(category, kind)};6194  if (auto known{evaluate::ToInt64(value)}) {6195    return static_cast<int>(*known);6196  }6197  common::die("Vector element kind must be known at compile-time");6198}6199 6200bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) {6201  // PowerPC vector types are allowed only on Power architectures.6202  if (!currScope().context().targetCharacteristics().isPPC()) {6203    Say(currStmtSource().value(),6204        "Vector type is only supported for PowerPC"_err_en_US);6205    isVectorType_ = false;6206    return false;6207  }6208  isVectorType_ = true;6209  return true;6210}6211// Create semantic::DerivedTypeSpec for Vector types here.6212void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {6213  llvm::StringRef typeName;6214  llvm::SmallVector<ParamValue> typeParams;6215  DerivedTypeSpec::Category vectorCategory;6216 6217  isVectorType_ = false;6218  common::visit(6219      common::visitors{6220          [&](const parser::IntrinsicVectorTypeSpec &y) {6221            vectorCategory = DerivedTypeSpec::Category::IntrinsicVector;6222            int vecElemKind = 0;6223            typeName = "__builtin_ppc_intrinsic_vector";6224            common::visit(6225                common::visitors{6226                    [&](const parser::IntegerTypeSpec &z) {6227                      vecElemKind = GetVectorElementKind(6228                          TypeCategory::Integer, std::move(z.v));6229                      typeParams.push_back(ParamValue(6230                          static_cast<common::ConstantSubscript>(6231                              common::VectorElementCategory::Integer),6232                          common::TypeParamAttr::Kind));6233                    },6234                    [&](const parser::IntrinsicTypeSpec::Real &z) {6235                      vecElemKind = GetVectorElementKind(6236                          TypeCategory::Real, std::move(z.kind));6237                      typeParams.push_back(6238                          ParamValue(static_cast<common::ConstantSubscript>(6239                                         common::VectorElementCategory::Real),6240                              common::TypeParamAttr::Kind));6241                    },6242                    [&](const parser::UnsignedTypeSpec &z) {6243                      vecElemKind = GetVectorElementKind(6244                          TypeCategory::Integer, std::move(z.v));6245                      typeParams.push_back(ParamValue(6246                          static_cast<common::ConstantSubscript>(6247                              common::VectorElementCategory::Unsigned),6248                          common::TypeParamAttr::Kind));6249                    },6250                },6251                y.v.u);6252            typeParams.push_back(6253                ParamValue(static_cast<common::ConstantSubscript>(vecElemKind),6254                    common::TypeParamAttr::Kind));6255          },6256          [&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) {6257            vectorCategory = DerivedTypeSpec::Category::PairVector;6258            typeName = "__builtin_ppc_pair_vector";6259          },6260          [&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) {6261            vectorCategory = DerivedTypeSpec::Category::QuadVector;6262            typeName = "__builtin_ppc_quad_vector";6263          },6264      },6265      x.u);6266 6267  auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope();6268  if (!ppcBuiltinTypesScope) {6269    common::die("INTERNAL: The __ppc_types module was not found ");6270  }6271 6272  auto iter{ppcBuiltinTypesScope->find(6273      semantics::SourceName{typeName.data(), typeName.size()})};6274  if (iter == ppcBuiltinTypesScope->cend()) {6275    common::die("INTERNAL: The __ppc_types module does not define "6276                "the type '%s'",6277        typeName.data());6278  }6279 6280  const semantics::Symbol &typeSymbol{*iter->second};6281  DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol};6282  vectorDerivedType.set_category(vectorCategory);6283  if (typeParams.size()) {6284    vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0]));6285    vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1]));6286    vectorDerivedType.CookParameters(GetFoldingContext());6287  }6288 6289  if (const DeclTypeSpec *6290      extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(6291          vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {6292    // This derived type and parameter expressions (if any) are already present6293    // in the __ppc_intrinsics scope.6294    SetDeclTypeSpec(*extant);6295  } else {6296    DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType(6297        DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))};6298    DerivedTypeSpec &derived{type.derivedTypeSpec()};6299    auto restorer{6300        GetFoldingContext().messages().SetLocation(currStmtSource().value())};6301    derived.Instantiate(*ppcBuiltinTypesScope);6302    SetDeclTypeSpec(type);6303  }6304}6305 6306bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {6307  CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);6308  return true;6309}6310 6311void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {6312  const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)};6313  if (const Symbol * derivedSymbol{derivedName.symbol}) {6314    CheckForAbstractType(*derivedSymbol); // C7066315  }6316}6317 6318bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) {6319  SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);6320  return true;6321}6322 6323void DeclarationVisitor::Post(6324    const parser::DeclarationTypeSpec::Class &parsedClass) {6325  const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)};6326  if (auto spec{ResolveDerivedType(typeName)};6327      spec && !IsExtensibleType(&*spec)) { // C7056328    SayWithDecl(typeName, *typeName.symbol,6329        "Non-extensible derived type '%s' may not be used with CLASS"6330        " keyword"_err_en_US);6331  }6332}6333 6334void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {6335  const auto &typeName{std::get<parser::Name>(x.t)};6336  auto spec{ResolveDerivedType(typeName)};6337  if (!spec) {6338    return;6339  }6340  bool seenAnyName{false};6341  for (const auto &typeParamSpec :6342      std::get<std::list<parser::TypeParamSpec>>(x.t)) {6343    const auto &optKeyword{6344        std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};6345    std::optional<SourceName> name;6346    if (optKeyword) {6347      seenAnyName = true;6348      name = optKeyword->v.source;6349    } else if (seenAnyName) {6350      Say(typeName.source, "Type parameter value must have a name"_err_en_US);6351      continue;6352    }6353    const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};6354    // The expressions in a derived type specifier whose values define6355    // non-defaulted type parameters are evaluated (folded) in the enclosing6356    // scope.  The KIND/LEN distinction is resolved later in6357    // DerivedTypeSpec::CookParameters().6358    ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};6359    if (!param.isExplicit() || param.GetExplicit()) {6360      spec->AddRawParamValue(6361          common::GetPtrFromOptional(optKeyword), std::move(param));6362    }6363  }6364  // The DerivedTypeSpec *spec is used initially as a search key.6365  // If it turns out to have the same name and actual parameter6366  // value expressions as another DerivedTypeSpec in the current6367  // scope does, then we'll use that extant spec; otherwise, when this6368  // spec is distinct from all derived types previously instantiated6369  // in the current scope, this spec will be moved into that collection.6370  const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};6371  auto category{GetDeclTypeSpecCategory()};6372  if (dtDetails.isForwardReferenced()) {6373    DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};6374    SetDeclTypeSpec(type);6375    return;6376  }6377  // Normalize parameters to produce a better search key.6378  spec->CookParameters(GetFoldingContext());6379  if (!spec->MightBeParameterized()) {6380    spec->EvaluateParameters(context());6381  }6382  if (const DeclTypeSpec *6383      extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {6384    // This derived type and parameter expressions (if any) are already present6385    // in this scope.6386    SetDeclTypeSpec(*extant);6387  } else {6388    DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};6389    DerivedTypeSpec &derived{type.derivedTypeSpec()};6390    if (derived.MightBeParameterized() &&6391        currScope().IsParameterizedDerivedType()) {6392      // Defer instantiation; use the derived type's definition's scope.6393      derived.set_scope(DEREF(spec->typeSymbol().scope()));6394    } else if (&currScope() == spec->typeSymbol().scope()) {6395      // Direct recursive use of a type in the definition of one of its6396      // components: defer instantiation6397    } else {6398      auto restorer{6399          GetFoldingContext().messages().SetLocation(currStmtSource().value())};6400      derived.Instantiate(currScope());6401    }6402    SetDeclTypeSpec(type);6403  }6404  // Capture the DerivedTypeSpec in the parse tree for use in building6405  // structure constructor expressions.6406  x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();6407}6408 6409void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {6410  const auto &typeName{rec.v};6411  if (auto spec{ResolveDerivedType(typeName)}) {6412    spec->CookParameters(GetFoldingContext());6413    spec->EvaluateParameters(context());6414    if (const DeclTypeSpec *6415        extant{currScope().FindInstantiatedDerivedType(6416            *spec, DeclTypeSpec::TypeDerived)}) {6417      SetDeclTypeSpec(*extant);6418    } else {6419      Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,6420          typeName.source);6421    }6422  }6423}6424 6425// The descendents of DerivedTypeDef in the parse tree are visited directly6426// in this Pre() routine so that recursive use of the derived type can be6427// supported in the components.6428bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {6429  auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};6430  Walk(stmt);6431  Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));6432  auto &scope{currScope()};6433  CHECK(scope.symbol());6434  CHECK(scope.symbol()->scope() == &scope);6435  auto &details{scope.symbol()->get<DerivedTypeDetails>()};6436  for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {6437    if (auto *symbol{FindInScope(scope, paramName)}) {6438      if (auto *details{symbol->detailsIf<TypeParamDetails>()}) {6439        if (!details->attr()) {6440          Say(paramName,6441              "No definition found for type parameter '%s'"_err_en_US); // C7426442        }6443      }6444    }6445  }6446  Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t));6447  const auto &componentDefs{6448      std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)};6449  Walk(componentDefs);6450  if (derivedTypeInfo_.sequence) {6451    details.set_sequence(true);6452    if (componentDefs.empty()) {6453      // F'2023 C745 - not enforced by any compiler6454      context().Warn(common::LanguageFeature::EmptySequenceType, stmt.source,6455          "A sequence type should have at least one component"_warn_en_US);6456    }6457    if (!details.paramDeclOrder().empty()) { // C7406458      Say(stmt.source,6459          "A sequence type may not have type parameters"_err_en_US);6460    }6461    if (derivedTypeInfo_.extends) { // C7356462      Say(stmt.source,6463          "A sequence type may not have the EXTENDS attribute"_err_en_US);6464    }6465  }6466  Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));6467  Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));6468  details.set_isForwardReferenced(false);6469  derivedTypeInfo_ = {};6470  PopScope();6471  set_inPDTDefinition(false);6472  return false;6473}6474 6475bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {6476  return BeginAttrs();6477}6478void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {6479  auto &name{std::get<parser::Name>(x.t)};6480  // Resolve the EXTENDS() clause before creating the derived6481  // type's symbol to foil attempts to recursively extend a type.6482  auto *extendsName{derivedTypeInfo_.extends};6483  std::optional<DerivedTypeSpec> extendsType{6484      ResolveExtendsType(name, extendsName)};6485  DerivedTypeDetails derivedTypeDetails;6486  // Catch any premature structure constructors within the definition6487  derivedTypeDetails.set_isForwardReferenced(true);6488  auto &symbol{MakeSymbol(name, GetAttrs(), std::move(derivedTypeDetails))};6489  symbol.ReplaceName(name.source);6490  derivedTypeInfo_.type = &symbol;6491  PushScope(Scope::Kind::DerivedType, &symbol);6492  if (extendsType) {6493    // Declare the "parent component"; private if the type is.6494    // Any symbol stored in the EXTENDS() clause is temporarily6495    // hidden so that a new symbol can be created for the parent6496    // component without producing spurious errors about already6497    // existing.6498    const Symbol &extendsSymbol{extendsType->typeSymbol()};6499    if (extendsSymbol.scope() &&6500        extendsSymbol.scope()->IsParameterizedDerivedType()) {6501      set_inPDTDefinition(true);6502    }6503    auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};6504    if (OkToAddComponent(*extendsName, &extendsSymbol)) {6505      auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};6506      comp.attrs().set(6507          Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE));6508      comp.implicitAttrs().set(6509          Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE));6510      comp.set(Symbol::Flag::ParentComp);6511      DeclTypeSpec &type{currScope().MakeDerivedType(6512          DeclTypeSpec::TypeDerived, std::move(*extendsType))};6513      type.derivedTypeSpec().set_scope(DEREF(extendsSymbol.scope()));6514      comp.SetType(type);6515      DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};6516      details.add_component(comp);6517    }6518  }6519  // Create symbols now for type parameters so that they shadow names6520  // from the enclosing specification part.6521  const auto &paramNames{std::get<std::list<parser::Name>>(x.t)};6522  if (!paramNames.empty()) {6523    set_inPDTDefinition(true);6524  }6525  if (auto *details{symbol.detailsIf<DerivedTypeDetails>()}) {6526    for (const auto &name : paramNames) {6527      if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{})}) {6528        details->add_paramNameOrder(*symbol);6529      }6530    }6531  }6532  EndAttrs();6533}6534 6535void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {6536  auto *type{GetDeclTypeSpec()};6537  DerivedTypeDetails *derivedDetails{nullptr};6538  if (Symbol * dtSym{currScope().symbol()}) {6539    derivedDetails = dtSym->detailsIf<DerivedTypeDetails>();6540  }6541  auto attr{std::get<common::TypeParamAttr>(x.t)};6542  for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {6543    auto &name{std::get<parser::Name>(decl.t)};6544    if (Symbol * symbol{FindInScope(currScope(), name)}) {6545      if (auto *paramDetails{symbol->detailsIf<TypeParamDetails>()}) {6546        if (!paramDetails->attr()) {6547          paramDetails->set_attr(attr);6548          SetType(name, *type);6549          if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(6550                  decl.t)}) {6551            if (auto maybeExpr{AnalyzeExpr(context(), *init)}) {6552              if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) {6553                paramDetails->set_init(std::move(*intExpr));6554              }6555            }6556          }6557          if (derivedDetails) {6558            derivedDetails->add_paramDeclOrder(*symbol);6559          }6560        } else {6561          Say(name,6562              "Type parameter '%s' was already declared in this derived type"_err_en_US);6563        }6564      }6565    } else {6566      Say(name, "'%s' is not a parameter of this derived type"_err_en_US);6567    }6568  }6569  EndDecl();6570}6571bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {6572  if (derivedTypeInfo_.extends) {6573    Say(currStmtSource().value(),6574        "Attribute 'EXTENDS' cannot be used more than once"_err_en_US);6575  } else {6576    derivedTypeInfo_.extends = &x.v;6577  }6578  return false;6579}6580 6581bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {6582  if (!currScope().parent().IsModule()) {6583    Say("PRIVATE is only allowed in a derived type that is"6584        " in a module"_err_en_US); // C7666585  } else if (derivedTypeInfo_.sawContains) {6586    derivedTypeInfo_.privateBindings = true;6587  } else if (!derivedTypeInfo_.privateComps) {6588    derivedTypeInfo_.privateComps = true;6589  } else { // C7386590    context().Warn(common::LanguageFeature::RedundantAttribute,6591        "PRIVATE should not appear more than once in derived type components"_warn_en_US);6592  }6593  return false;6594}6595bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {6596  if (derivedTypeInfo_.sequence) { // C7386597    context().Warn(common::LanguageFeature::RedundantAttribute,6598        "SEQUENCE should not appear more than once in derived type components"_warn_en_US);6599  }6600  derivedTypeInfo_.sequence = true;6601  return false;6602}6603void DeclarationVisitor::Post(const parser::ComponentDecl &x) {6604  const auto &name{std::get<parser::Name>(x.t)};6605  auto attrs{GetAttrs()};6606  if (derivedTypeInfo_.privateComps &&6607      !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {6608    attrs.set(Attr::PRIVATE);6609  }6610  if (const auto *declType{GetDeclTypeSpec()}) {6611    if (const auto *derived{declType->AsDerived()}) {6612      if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {6613        if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C7446614          Say("Recursive use of the derived type requires POINTER or ALLOCATABLE"_err_en_US);6615        }6616      }6617    }6618  }6619  if (OkToAddComponent(name)) {6620    auto &symbol{DeclareObjectEntity(name, attrs)};6621    SetCUDADataAttr(name.source, symbol, cudaDataAttr());6622    if (symbol.has<ObjectEntityDetails>()) {6623      if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {6624        Initialization(name, *init, /*inComponentDecl=*/true);6625      }6626    }6627    auto &details{currScope().symbol()->get<DerivedTypeDetails>()};6628    details.add_component(symbol);6629    if (const parser::Expr *kindExpr{GetOriginalKindParameter()}) {6630      details.add_originalKindParameter(name.source, kindExpr);6631    }6632  }6633  ClearArraySpec();6634  ClearCoarraySpec();6635}6636void DeclarationVisitor::Post(const parser::FillDecl &x) {6637  // Replace "%FILL" with a distinct generated name6638  const auto &name{std::get<parser::Name>(x.t)};6639  const_cast<SourceName &>(name.source) = context().GetTempName(currScope());6640  if (OkToAddComponent(name)) {6641    auto &symbol{DeclareObjectEntity(name, GetAttrs())};6642    currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);6643  }6644  ClearArraySpec();6645}6646bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {6647  CHECK(!interfaceName_);6648  const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};6649  for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {6650    if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {6651      if (std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(6652              bindC->t)6653              .has_value()) {6654        if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {6655          Say(context().location().value(),6656              "A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);6657        }6658        break;6659      }6660    }6661  }6662  return BeginDecl();6663}6664void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {6665  interfaceName_ = nullptr;6666  EndDecl();6667}6668bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {6669  // Overrides parse tree traversal so as to handle attributes first,6670  // so POINTER & ALLOCATABLE enable forward references to derived types.6671  Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));6672  set_allowForwardReferenceToDerivedType(6673      GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));6674  Walk(std::get<parser::DeclarationTypeSpec>(x.t));6675  set_allowForwardReferenceToDerivedType(false);6676  if (derivedTypeInfo_.sequence) { // C7406677    if (const auto *declType{GetDeclTypeSpec()}) {6678      if (!declType->AsIntrinsic() && !declType->IsSequenceType() &&6679          !InModuleFile()) {6680        if (GetAttrs().test(Attr::POINTER) &&6681            context().IsEnabled(common::LanguageFeature::PointerInSeqType)) {6682          context().Warn(common::LanguageFeature::PointerInSeqType,6683              "A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);6684        } else {6685          Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US);6686        }6687      }6688    }6689  }6690  Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));6691  return false;6692}6693bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {6694  CHECK(!interfaceName_);6695  return true;6696}6697void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {6698  interfaceName_ = nullptr;6699}6700bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {6701  if (auto *name{std::get_if<parser::Name>(&x.u)}) {6702    return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(*name);6703  } else {6704    const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))};6705    Walk(null);6706    if (auto nullInit{EvaluateExpr(null)}) {6707      if (!evaluate::IsNullProcedurePointer(&*nullInit) &&6708          !evaluate::IsBareNullPointer(&*nullInit)) {6709        Say(null.v.value().source,6710            "Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US);6711      }6712    }6713    return false;6714  }6715}6716void DeclarationVisitor::Post(const parser::ProcInterface &x) {6717  if (auto *name{std::get_if<parser::Name>(&x.u)}) {6718    interfaceName_ = name;6719    NoteInterfaceName(*name);6720  }6721}6722void DeclarationVisitor::Post(const parser::ProcDecl &x) {6723  const auto &name{std::get<parser::Name>(x.t)};6724  // Don't use BypassGeneric or GetUltimate on this symbol, they can6725  // lead to unusable names in module files.6726  const Symbol *procInterface{6727      interfaceName_ ? interfaceName_->symbol : nullptr};6728  auto attrs{HandleSaveName(name.source, GetAttrs())};6729  DerivedTypeDetails *dtDetails{nullptr};6730  if (Symbol * symbol{currScope().symbol()}) {6731    dtDetails = symbol->detailsIf<DerivedTypeDetails>();6732  }6733  if (!dtDetails) {6734    attrs.set(Attr::EXTERNAL);6735  }6736  if (derivedTypeInfo_.privateComps &&6737      !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {6738    attrs.set(Attr::PRIVATE);6739  }6740  Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};6741  SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error6742  symbol.ReplaceName(name.source);6743  if (dtDetails) {6744    dtDetails->add_component(symbol);6745  }6746  DeclaredPossibleSpecificProc(symbol);6747}6748 6749bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {6750  derivedTypeInfo_.sawContains = true;6751  return true;6752}6753 6754// Resolve binding names from type-bound generics, saved in genericBindings_.6755void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) {6756  // track specifics seen for the current generic to detect duplicates:6757  const Symbol *currGeneric{nullptr};6758  std::set<SourceName> specifics;6759  for (const auto &[generic, bindingName] : genericBindings_) {6760    if (generic != currGeneric) {6761      currGeneric = generic;6762      specifics.clear();6763    }6764    auto [it, inserted]{specifics.insert(bindingName->source)};6765    if (!inserted) {6766      Say(*bindingName, // C7736767          "Binding name '%s' was already specified for generic '%s'"_err_en_US,6768          bindingName->source, generic->name())6769          .Attach(*it, "Previous specification of '%s'"_en_US, *it);6770      continue;6771    }6772    auto *symbol{FindInTypeOrParents(*bindingName)};6773    if (!symbol) {6774      Say(*bindingName, // C7726775          "Binding name '%s' not found in this derived type"_err_en_US);6776    } else if (!symbol->has<ProcBindingDetails>()) {6777      SayWithDecl(*bindingName, *symbol, // C7726778          "'%s' is not the name of a specific binding of this type"_err_en_US);6779    } else {6780      generic->get<GenericDetails>().AddSpecificProc(6781          *symbol, bindingName->source);6782    }6783  }6784  genericBindings_.clear();6785}6786 6787void DeclarationVisitor::Post(const parser::ContainsStmt &) {6788  if (derivedTypeInfo_.sequence) {6789    Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C7406790  }6791}6792 6793void DeclarationVisitor::Post(6794    const parser::TypeBoundProcedureStmt::WithoutInterface &x) {6795  if (GetAttrs().test(Attr::DEFERRED)) { // C7836796    Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US);6797  }6798  for (auto &declaration : x.declarations) {6799    auto &bindingName{std::get<parser::Name>(declaration.t)};6800    auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};6801    const parser::Name &procedureName{optName ? *optName : bindingName};6802    Symbol *procedure{FindSymbol(procedureName)};6803    if (!procedure) {6804      procedure = NoteInterfaceName(procedureName);6805    }6806    if (procedure) {6807      const Symbol &bindTo{BypassGeneric(*procedure)};6808      if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) {6809        SetPassNameOn(*s);6810        if (GetAttrs().test(Attr::DEFERRED)) {6811          context().SetError(*s);6812        }6813      }6814    }6815  }6816}6817 6818void DeclarationVisitor::CheckBindings(6819    const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {6820  CHECK(currScope().IsDerivedType());6821  for (auto &declaration : tbps.declarations) {6822    auto &bindingName{std::get<parser::Name>(declaration.t)};6823    if (Symbol * binding{FindInScope(bindingName)}) {6824      if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {6825        const Symbol &ultimate{details->symbol().GetUltimate()};6826        const Symbol &procedure{BypassGeneric(ultimate)};6827        if (&procedure != &ultimate) {6828          details->ReplaceSymbol(procedure);6829        }6830        if (!CanBeTypeBoundProc(procedure)) {6831          if (details->symbol().name() != binding->name()) {6832            Say(binding->name(),6833                "The binding of '%s' ('%s') must be either an accessible "6834                "module procedure or an external procedure with "6835                "an explicit interface"_err_en_US,6836                binding->name(), details->symbol().name());6837          } else {6838            Say(binding->name(),6839                "'%s' must be either an accessible module procedure "6840                "or an external procedure with an explicit interface"_err_en_US,6841                binding->name());6842          }6843          context().SetError(*binding);6844        }6845      }6846    }6847  }6848}6849 6850void DeclarationVisitor::Post(6851    const parser::TypeBoundProcedureStmt::WithInterface &x) {6852  if (!GetAttrs().test(Attr::DEFERRED)) { // C7836853    Say("DEFERRED is required when an interface-name is provided"_err_en_US);6854  }6855  if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) {6856    for (auto &bindingName : x.bindingNames) {6857      if (auto *s{6858              MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) {6859        SetPassNameOn(*s);6860        if (!GetAttrs().test(Attr::DEFERRED)) {6861          context().SetError(*s);6862        }6863      }6864    }6865  }6866}6867 6868bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) {6869  if (currScope().IsDerivedType() && currScope().symbol()) {6870    if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) {6871      for (const auto &subrName : x.v) {6872        Symbol *symbol{FindSymbol(subrName)};6873        if (!symbol) {6874          // FINAL procedures must be module subroutines6875          symbol = &MakeSymbol(6876              currScope().parent(), subrName.source, Attrs{Attr::MODULE});6877          Resolve(subrName, symbol);6878          symbol->set_details(ProcEntityDetails{});6879          symbol->set(Symbol::Flag::Subroutine);6880        }6881        if (auto pair{details->finals().emplace(subrName.source, *symbol)};6882            !pair.second) { // C7876883          Say(subrName.source,6884              "FINAL subroutine '%s' already appeared in this derived type"_err_en_US,6885              subrName.source)6886              .Attach(pair.first->first,6887                  "earlier appearance of this FINAL subroutine"_en_US);6888        }6889      }6890    }6891  }6892  return false;6893}6894 6895bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {6896  const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)};6897  const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};6898  const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)};6899  GenericSpecInfo info{genericSpec.value()};6900  SourceName symbolName{info.symbolName()};6901  bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private6902                            : derivedTypeInfo_.privateBindings};6903  auto *genericSymbol{FindInScope(symbolName)};6904  if (genericSymbol) {6905    if (!genericSymbol->has<GenericDetails>()) {6906      genericSymbol = nullptr; // MakeTypeSymbol will report the error below6907    }6908  } else {6909    // look in ancestor types for a generic of the same name6910    for (const auto &name : GetAllNames(context(), symbolName)) {6911      if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) {6912        if (inherited->has<GenericDetails>()) {6913          CheckAccessibility(symbolName, isPrivate, *inherited); // C7716914        } else {6915          Say(symbolName,6916              "Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US)6917              .Attach(inherited->name(), "Inherited symbol"_en_US);6918        }6919        break;6920      }6921    }6922  }6923  if (genericSymbol) {6924    CheckAccessibility(symbolName, isPrivate, *genericSymbol); // C7716925  } else {6926    genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{});6927    if (!genericSymbol) {6928      return false;6929    }6930    if (isPrivate) {6931      SetExplicitAttr(*genericSymbol, Attr::PRIVATE);6932    }6933  }6934  for (const parser::Name &bindingName : bindingNames) {6935    genericBindings_.emplace(genericSymbol, &bindingName);6936  }6937  info.Resolve(genericSymbol);6938  return false;6939}6940 6941// DEC STRUCTUREs are handled thus to allow for nested definitions.6942bool DeclarationVisitor::Pre(const parser::StructureDef &def) {6943  const auto &structureStatement{6944      std::get<parser::Statement<parser::StructureStmt>>(def.t)};6945  auto saveDerivedTypeInfo{derivedTypeInfo_};6946  derivedTypeInfo_ = {};6947  derivedTypeInfo_.isStructure = true;6948  derivedTypeInfo_.sequence = true;6949  Scope *previousStructure{nullptr};6950  if (saveDerivedTypeInfo.isStructure) {6951    previousStructure = &currScope();6952    PopScope();6953  }6954  const parser::StructureStmt &structStmt{structureStatement.statement};6955  const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};6956  if (!name) {6957    // Construct a distinct generated name for an anonymous structure6958    auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};6959    mutableName.emplace(6960        parser::Name{context().GetTempName(currScope()), nullptr});6961  }6962  auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};6963  symbol.ReplaceName(name->source);6964  symbol.get<DerivedTypeDetails>().set_sequence(true);6965  symbol.get<DerivedTypeDetails>().set_isDECStructure(true);6966  derivedTypeInfo_.type = &symbol;6967  PushScope(Scope::Kind::DerivedType, &symbol);6968  const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};6969  Walk(fields);6970  PopScope();6971  // Complete the definition6972  DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};6973  derivedTypeSpec.set_scope(DEREF(symbol.scope()));6974  derivedTypeSpec.CookParameters(GetFoldingContext());6975  derivedTypeSpec.EvaluateParameters(context());6976  DeclTypeSpec &type{currScope().MakeDerivedType(6977      DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};6978  type.derivedTypeSpec().Instantiate(currScope());6979  // Restore previous structure definition context, if any6980  derivedTypeInfo_ = saveDerivedTypeInfo;6981  if (previousStructure) {6982    PushScope(*previousStructure);6983  }6984  // Handle any entity declarations on the STRUCTURE statement6985  const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};6986  if (!decls.empty()) {6987    BeginDecl();6988    SetDeclTypeSpec(type);6989    Walk(decls);6990    EndDecl();6991  }6992  return false;6993}6994 6995bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {6996  Say("support for UNION"_todo_en_US); // TODO6997  return true;6998}6999 7000bool DeclarationVisitor::Pre(const parser::StructureField &x) {7001  if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(7002          x.u)) {7003    BeginDecl();7004  }7005  return true;7006}7007 7008void DeclarationVisitor::Post(const parser::StructureField &x) {7009  if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(7010          x.u)) {7011    EndDecl();7012  }7013}7014 7015bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {7016  BeginDeclTypeSpec();7017  return true;7018}7019void DeclarationVisitor::Post(const parser::AllocateStmt &) {7020  EndDeclTypeSpec();7021}7022 7023bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {7024  auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};7025  const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};7026  if (!type) {7027    return false;7028  }7029  const DerivedTypeSpec *spec{type->AsDerived()};7030  const Scope *typeScope{spec ? spec->scope() : nullptr};7031  if (!typeScope) {7032    return false;7033  }7034 7035  // N.B C7102 is implicitly enforced by having inaccessible types not7036  // being found in resolution.7037  // More constraints are enforced in expression.cpp so that they7038  // can apply to structure constructors that have been converted7039  // from misparsed function references.7040  for (const auto &component :7041      std::get<std::list<parser::ComponentSpec>>(x.t)) {7042    // Visit the component spec expression, but not the keyword, since7043    // we need to resolve its symbol in the scope of the derived type.7044    Walk(std::get<parser::ComponentDataSource>(component.t));7045    if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {7046      FindInTypeOrParents(*typeScope, kw->v);7047    }7048  }7049  return false;7050}7051 7052bool DeclarationVisitor::Pre(const parser::BasedPointer &) {7053  BeginArraySpec();7054  return true;7055}7056 7057void DeclarationVisitor::Post(const parser::BasedPointer &bp) {7058  const parser::ObjectName &pointerName{std::get<0>(bp.t)};7059  auto *pointer{FindInScope(pointerName)};7060  if (!pointer) {7061    pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});7062  } else if (!ConvertToObjectEntity(*pointer)) {7063    SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);7064  } else if (IsNamedConstant(*pointer)) {7065    SayWithDecl(pointerName, *pointer,7066        "'%s' is a named constant and may not be a Cray pointer"_err_en_US);7067  } else if (pointer->Rank() > 0) {7068    SayWithDecl(7069        pointerName, *pointer, "Cray pointer '%s' must be a scalar"_err_en_US);7070  } else if (pointer->test(Symbol::Flag::CrayPointee)) {7071    Say(pointerName,7072        "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);7073  }7074  pointer->set(Symbol::Flag::CrayPointer);7075  const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer,7076      context().targetCharacteristics().integerKindForPointer())};7077  const auto *type{pointer->GetType()};7078  if (!type) {7079    pointer->SetType(pointerType);7080  } else if (*type != pointerType) {7081    Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,7082        pointerName.source, pointerType.AsFortran());7083  }7084  const parser::ObjectName &pointeeName{std::get<1>(bp.t)};7085  DeclareObjectEntity(pointeeName);7086  if (Symbol * pointee{pointeeName.symbol}) {7087    if (!ConvertToObjectEntity(*pointee)) {7088      return;7089    }7090    if (IsNamedConstant(*pointee)) {7091      Say(pointeeName,7092          "'%s' is a named constant and may not be a Cray pointee"_err_en_US);7093      return;7094    }7095    if (pointee->test(Symbol::Flag::CrayPointer)) {7096      Say(pointeeName,7097          "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);7098    } else if (pointee->test(Symbol::Flag::CrayPointee)) {7099      Say(pointeeName, "'%s' was already declared as a Cray pointee"_err_en_US);7100    } else {7101      pointee->set(Symbol::Flag::CrayPointee);7102    }7103    if (const auto *pointeeType{pointee->GetType()}) {7104      if (const auto *derived{pointeeType->AsDerived()}) {7105        if (!IsSequenceOrBindCType(derived)) {7106          context().Warn(common::LanguageFeature::NonSequenceCrayPointee,7107              pointeeName.source,7108              "Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US,7109              pointeeName.source);7110        }7111      }7112    }7113    currScope().add_crayPointer(pointeeName.source, *pointer);7114  }7115}7116 7117bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {7118  if (!CheckNotInBlock("NAMELIST")) { // C11077119    return false;7120  }7121  const auto &groupName{std::get<parser::Name>(x.t)};7122  auto *groupSymbol{FindInScope(groupName)};7123  if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) {7124    groupSymbol = &MakeSymbol(groupName, NamelistDetails{});7125    groupSymbol->ReplaceName(groupName.source);7126  }7127  // Name resolution of group items is deferred to FinishNamelists()7128  // so that host association is handled correctly.7129  GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x);7130  return false;7131}7132 7133void DeclarationVisitor::FinishNamelists() {7134  if (auto *deferred{GetDeferredDeclarationState()}) {7135    for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) {7136      if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) {7137        if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) {7138          for (const auto &name : std::get<std::list<parser::Name>>(group->t)) {7139            auto *symbol{FindSymbol(name)};7140            if (!symbol) {7141              symbol = &MakeSymbol(name, ObjectEntityDetails{});7142              ApplyImplicitRules(*symbol);7143            } else if (!ConvertToObjectEntity(symbol->GetUltimate())) {7144              SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);7145              context().SetError(*groupSymbol);7146            }7147            symbol->GetUltimate().set(Symbol::Flag::InNamelist);7148            details->add_object(*symbol);7149          }7150        }7151      }7152    }7153    deferred->namelistGroups.clear();7154  }7155}7156 7157bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {7158  if (const auto *name{std::get_if<parser::Name>(&x.u)}) {7159    auto *symbol{FindSymbol(*name)};7160    if (!symbol) {7161      Say(*name, "Namelist group '%s' not found"_err_en_US);7162    } else if (!symbol->GetUltimate().has<NamelistDetails>()) {7163      SayWithDecl(7164          *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);7165    }7166  }7167  return true;7168}7169 7170bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {7171  CheckNotInBlock("COMMON"); // C11077172  return true;7173}7174 7175bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {7176  BeginArraySpec();7177  return true;7178}7179 7180void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {7181  const auto &name{std::get<parser::Name>(x.t)};7182  if (auto *symbol{FindSymbol(name)}) {7183    symbol->set(Symbol::Flag::InCommonBlock);7184  }7185  DeclareObjectEntity(name);7186  auto pair{specPartState_.commonBlockObjects.insert(name.source)};7187  if (!pair.second) {7188    const SourceName &prev{*pair.first};7189    Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,7190        "Previous occurrence of '%s' in a COMMON block"_en_US);7191  }7192}7193 7194bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {7195  // save equivalence sets to be processed after specification part7196  if (CheckNotInBlock("EQUIVALENCE")) { // C11077197    for (const std::list<parser::EquivalenceObject> &set : x.v) {7198      specPartState_.equivalenceSets.push_back(&set);7199    }7200  }7201  return false; // don't implicitly declare names yet7202}7203 7204void DeclarationVisitor::CheckEquivalenceSets() {7205  EquivalenceSets equivSets{context()};7206  inEquivalenceStmt_ = true;7207  for (const auto *set : specPartState_.equivalenceSets) {7208    const auto &source{set->front().v.value().source};7209    if (set->size() <= 1) { // R8717210      Say(source, "Equivalence set must have more than one object"_err_en_US);7211    }7212    for (const parser::EquivalenceObject &object : *set) {7213      const auto &designator{object.v.value()};7214      // The designator was not resolved when it was encountered, so do it now.7215      // AnalyzeExpr causes array sections to be changed to substrings as needed7216      Walk(designator);7217      if (AnalyzeExpr(context(), designator)) {7218        equivSets.AddToSet(designator);7219      }7220    }7221    equivSets.FinishSet(source);7222  }7223  inEquivalenceStmt_ = false;7224  for (auto &set : equivSets.sets()) {7225    if (!set.empty()) {7226      currScope().add_equivalenceSet(std::move(set));7227    }7228  }7229  specPartState_.equivalenceSets.clear();7230}7231 7232bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {7233  if (x.v.empty()) {7234    specPartState_.saveInfo.saveAll = currStmtSource();7235    currScope().set_hasSAVE();7236  } else {7237    for (const parser::SavedEntity &y : x.v) {7238      auto kind{std::get<parser::SavedEntity::Kind>(y.t)};7239      const auto &name{std::get<parser::Name>(y.t)};7240      if (kind == parser::SavedEntity::Kind::Common) {7241        MakeCommonBlockSymbol(name, name.source);7242        AddSaveName(specPartState_.saveInfo.commons, name.source);7243      } else {7244        HandleAttributeStmt(Attr::SAVE, name);7245      }7246    }7247  }7248  return false;7249}7250 7251void DeclarationVisitor::CheckSaveStmts() {7252  for (const SourceName &name : specPartState_.saveInfo.entities) {7253    auto *symbol{FindInScope(name)};7254    if (!symbol) {7255      // error was reported7256    } else if (specPartState_.saveInfo.saveAll) {7257      // C889 - note that pgi, ifort, xlf do not enforce this constraint7258      if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {7259        Say2(name,7260            "Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US,7261            *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US)7262            .set_languageFeature(common::LanguageFeature::RedundantAttribute);7263      }7264    } else if (!IsSaved(*symbol)) {7265      SetExplicitAttr(*symbol, Attr::SAVE);7266    }7267  }7268  for (const SourceName &name : specPartState_.saveInfo.commons) {7269    if (auto *symbol{currScope().FindCommonBlock(name)}) {7270      auto &objects{symbol->get<CommonBlockDetails>().objects()};7271      if (objects.empty()) {7272        if (currScope().kind() != Scope::Kind::BlockConstruct) {7273          Say(name,7274              "'%s' appears as a COMMON block in a SAVE statement but not in"7275              " a COMMON statement"_err_en_US);7276        } else { // C11087277          Say(name,7278              "SAVE statement in BLOCK construct may not contain a"7279              " common block name '%s'"_err_en_US);7280        }7281      } else {7282        for (auto &object : symbol->get<CommonBlockDetails>().objects()) {7283          if (!IsSaved(*object)) {7284            SetImplicitAttr(*object, Attr::SAVE);7285          }7286        }7287      }7288    }7289  }7290  specPartState_.saveInfo = {};7291}7292 7293// Record SAVEd names in specPartState_.saveInfo.entities.7294Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) {7295  if (attrs.test(Attr::SAVE)) {7296    AddSaveName(specPartState_.saveInfo.entities, name);7297  }7298  return attrs;7299}7300 7301// Record a name in a set of those to be saved.7302void DeclarationVisitor::AddSaveName(7303    std::set<SourceName> &set, const SourceName &name) {7304  auto pair{set.insert(name)};7305  if (!pair.second &&7306      context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {7307    Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US,7308        *pair.first, "Previous specification of SAVE attribute"_en_US)7309        .set_languageFeature(common::LanguageFeature::RedundantAttribute);7310  }7311}7312 7313// Check types of common block objects, now that they are known.7314void DeclarationVisitor::CheckCommonBlocks() {7315  // check for empty common blocks7316  for (const auto &pair : currScope().commonBlocks()) {7317    const auto &symbol{*pair.second};7318    if (symbol.get<CommonBlockDetails>().objects().empty() &&7319        symbol.attrs().test(Attr::BIND_C)) {7320      Say(symbol.name(),7321          "'%s' appears as a COMMON block in a BIND statement but not in a COMMON statement"_err_en_US);7322    }7323  }7324  specPartState_.commonBlockObjects = {};7325}7326 7327Symbol &DeclarationVisitor::MakeCommonBlockSymbol(7328    const parser::Name &name, SourceName location) {7329  return Resolve(name, currScope().MakeCommonBlock(name.source, location));7330}7331Symbol &DeclarationVisitor::MakeCommonBlockSymbol(7332    const std::optional<parser::Name> &name, SourceName location) {7333  if (name) {7334    return MakeCommonBlockSymbol(*name, location);7335  } else {7336    return MakeCommonBlockSymbol(parser::Name{}, location);7337  }7338}7339 7340bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {7341  return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);7342}7343 7344bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(7345    const parser::Name &name) {7346  if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(7347          name.source.ToString())}) {7348    // Unrestricted specific intrinsic function names (e.g., "cos")7349    // are acceptable as procedure interfaces.  The presence of the7350    // INTRINSIC flag will cause this symbol to have a complete interface7351    // recreated for it later on demand, but capturing its result type here7352    // will make GetType() return a correct result without having to7353    // probe the intrinsics table again.7354    Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};7355    SetImplicitAttr(symbol, Attr::INTRINSIC);7356    CHECK(interface->functionResult.has_value());7357    evaluate::DynamicType dyType{7358        DEREF(interface->functionResult->GetTypeAndShape()).type()};7359    CHECK(common::IsNumericTypeCategory(dyType.category()));7360    const DeclTypeSpec &typeSpec{7361        MakeNumericType(dyType.category(), dyType.kind())};7362    ProcEntityDetails details;7363    details.set_type(typeSpec);7364    symbol.set_details(std::move(details));7365    symbol.set(Symbol::Flag::Function);7366    if (interface->IsElemental()) {7367      SetExplicitAttr(symbol, Attr::ELEMENTAL);7368    }7369    if (interface->IsPure()) {7370      SetExplicitAttr(symbol, Attr::PURE);7371    }7372    Resolve(name, symbol);7373    return true;7374  } else {7375    return false;7376  }7377}7378 7379// Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED7380bool DeclarationVisitor::PassesSharedLocalityChecks(7381    const parser::Name &name, Symbol &symbol) {7382  if (!IsVariableName(symbol)) {7383    SayLocalMustBeVariable(name, symbol); // C11247384    return false;7385  }7386  if (symbol.owner() == currScope()) { // C1125 and C11267387    SayAlreadyDeclared(name, symbol);7388    return false;7389  }7390  return true;7391}7392 7393// Checks for locality-specs LOCAL, LOCAL_INIT, and REDUCE7394bool DeclarationVisitor::PassesLocalityChecks(7395    const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {7396  bool isReduce{flag == Symbol::Flag::LocalityReduce};7397  const char *specName{7398      flag == Symbol::Flag::LocalityLocalInit ? "LOCAL_INIT" : "LOCAL"};7399  if (IsAllocatable(symbol) && !isReduce) { // F'2023 C11307400    SayWithDecl(name, symbol,7401        "ALLOCATABLE variable '%s' not allowed in a %s locality-spec"_err_en_US,7402        specName);7403    return false;7404  }7405  if (IsOptional(symbol)) { // F'2023 C1130-C11317406    SayWithDecl(name, symbol,7407        "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);7408    return false;7409  }7410  if (IsIntentIn(symbol)) { // F'2023 C1130-C11317411    SayWithDecl(name, symbol,7412        "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);7413    return false;7414  }7415  if (IsFinalizable(symbol) && !isReduce) { // F'2023 C11307416    SayWithDecl(name, symbol,7417        "Finalizable variable '%s' not allowed in a %s locality-spec"_err_en_US,7418        specName);7419    return false;7420  }7421  if (evaluate::IsCoarray(symbol) && !isReduce) { // F'2023 C11307422    SayWithDecl(name, symbol,7423        "Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);7424    return false;7425  }7426  if (const DeclTypeSpec * type{symbol.GetType()}) {7427    if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&7428        !isReduce) { // F'2023 C11307429      SayWithDecl(name, symbol,7430          "Nonpointer polymorphic argument '%s' not allowed in a %s locality-spec"_err_en_US,7431          specName);7432      return false;7433    }7434    if (const DerivedTypeSpec *derived{type->AsDerived()}) { // F'2023 C11307435      if (auto bad{FindAllocatableUltimateComponent(*derived)}) {7436        SayWithDecl(name, symbol,7437            "Derived type variable '%s' with ultimate ALLOCATABLE component '%s' not allowed in a %s locality-spec"_err_en_US,7438            bad.BuildResultDesignatorName(), specName);7439        return false;7440      }7441    }7442  }7443  if (symbol.attrs().test(Attr::ASYNCHRONOUS) && isReduce) { // F'2023 C11317444    SayWithDecl(name, symbol,7445        "ASYNCHRONOUS variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);7446    return false;7447  }7448  if (symbol.attrs().test(Attr::VOLATILE) && isReduce) { // F'2023 C11317449    SayWithDecl(name, symbol,7450        "VOLATILE variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);7451    return false;7452  }7453  if (IsAssumedSizeArray(symbol)) { // F'2023 C1130-C11317454    SayWithDecl(name, symbol,7455        "Assumed size array '%s' not allowed in a locality-spec"_err_en_US);7456    return false;7457  }7458  if (std::optional<Message> whyNot{WhyNotDefinable(7459          name.source, currScope(), DefinabilityFlags{}, symbol)}) {7460    SayWithReason(name, symbol,7461        "'%s' may not appear in a locality-spec because it is not definable"_err_en_US,7462        std::move(whyNot->set_severity(parser::Severity::Because)));7463    return false;7464  }7465  return PassesSharedLocalityChecks(name, symbol);7466}7467 7468Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(7469    const parser::Name &name) {7470  Symbol *prev{FindSymbol(name)};7471  if (!prev) {7472    // Declare the name as an object in the enclosing scope so that7473    // the name can't be repurposed there later as something else.7474    prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{});7475    ConvertToObjectEntity(*prev);7476    ApplyImplicitRules(*prev);7477  }7478  return *prev;7479}7480 7481void DeclarationVisitor::DeclareLocalEntity(7482    const parser::Name &name, Symbol::Flag flag) {7483  Symbol &prev{FindOrDeclareEnclosingEntity(name)};7484  if (PassesLocalityChecks(name, prev, flag)) {7485    if (auto *symbol{&MakeHostAssocSymbol(name, prev)}) {7486      symbol->set(flag);7487    }7488  }7489}7490 7491Symbol *DeclarationVisitor::DeclareStatementEntity(7492    const parser::DoVariable &doVar,7493    const std::optional<parser::IntegerTypeSpec> &type) {7494  const auto &name{parser::UnwrapRef<parser::Name>(doVar)};7495  const DeclTypeSpec *declTypeSpec{nullptr};7496  if (auto *prev{FindSymbol(name)}) {7497    if (prev->owner() == currScope()) {7498      SayAlreadyDeclared(name, *prev);7499      return nullptr;7500    }7501    name.symbol = nullptr;7502    // F'2023 19.4 p5 ambiguous rule about outer declarations7503    declTypeSpec = prev->GetType();7504  }7505  Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};7506  if (!symbol.has<ObjectEntityDetails>()) {7507    return nullptr; // error was reported in DeclareEntity7508  }7509  if (type) {7510    declTypeSpec = ProcessTypeSpec(*type);7511  }7512  if (declTypeSpec) {7513    // Subtlety: Don't let a "*length" specifier (if any is pending) affect the7514    // declaration of this implied DO loop control variable.7515    auto restorer{7516        common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};7517    SetType(name, *declTypeSpec);7518  } else {7519    ApplyImplicitRules(symbol);7520  }7521  return Resolve(name, &symbol);7522}7523 7524// Set the type of an entity or report an error.7525void DeclarationVisitor::SetType(7526    const parser::Name &name, const DeclTypeSpec &type) {7527  CHECK(name.symbol);7528  auto &symbol{*name.symbol};7529  if (charInfo_.length) { // Declaration has "*length" (R723)7530    auto length{std::move(*charInfo_.length)};7531    charInfo_.length.reset();7532    if (type.category() == DeclTypeSpec::Character) {7533      auto kind{type.characterTypeSpec().kind()};7534      // Recurse with correct type.7535      SetType(name,7536          currScope().MakeCharacterType(std::move(length), std::move(kind)));7537      return;7538    } else { // C7537539      Say(name,7540          "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);7541    }7542  }7543  if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {7544    if (proc->procInterface()) {7545      Say(name,7546          "'%s' has an explicit interface and may not also have a type"_err_en_US);7547      context().SetError(symbol);7548      return;7549    }7550  }7551  auto *prevType{symbol.GetType()};7552  if (!prevType) {7553    if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType()) {7554      context().Warn(common::LanguageFeature::ForwardRefImplicitNoneData,7555          name.source,7556          "'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US,7557          name.source);7558    }7559    symbol.SetType(type);7560  } else if (symbol.has<UseDetails>()) {7561    // error recovery case, redeclaration of use-associated name7562  } else if (HadForwardRef(symbol)) {7563    // error recovery after use of host-associated name7564  } else if (!symbol.test(Symbol::Flag::Implicit)) {7565    SayWithDecl(7566        name, symbol, "The type of '%s' has already been declared"_err_en_US);7567    context().SetError(symbol);7568  } else if (type != *prevType) {7569    SayWithDecl(name, symbol,7570        "The type of '%s' has already been implicitly declared"_err_en_US);7571    context().SetError(symbol);7572  } else {7573    symbol.set(Symbol::Flag::Implicit, false);7574  }7575}7576 7577std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(7578    const parser::Name &name) {7579  Scope &outer{NonDerivedTypeScope()};7580  Symbol *symbol{FindSymbol(outer, name)};7581  Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};7582  auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};7583  if (generic) {7584    if (Symbol * genDT{generic->derivedType()}) {7585      symbol = genDT;7586      generic = nullptr;7587    }7588  }7589  if (!symbol || symbol->has<UnknownDetails>() ||7590      (generic && &ultimate->owner() == &outer)) {7591    if (allowForwardReferenceToDerivedType()) {7592      if (!symbol) {7593        symbol = &MakeSymbol(outer, name.source, Attrs{});7594        Resolve(name, *symbol);7595      } else if (generic) {7596        // forward ref to type with later homonymous generic7597        symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});7598        generic->set_derivedType(*symbol);7599        name.symbol = symbol;7600      }7601      DerivedTypeDetails details;7602      details.set_isForwardReferenced(true);7603      symbol->set_details(std::move(details));7604    } else { // C7327605      Say(name, "Derived type '%s' not found"_err_en_US);7606      return std::nullopt;7607    }7608  } else if (&DEREF(symbol).owner() != &outer &&7609      !ultimate->has<GenericDetails>()) {7610    // Prevent a later declaration in this scope of a host-associated7611    // type name.7612    outer.add_importName(name.source);7613  }7614  if (CheckUseError(name)) {7615    return std::nullopt;7616  } else if (symbol->GetUltimate().has<DerivedTypeDetails>()) {7617    return DerivedTypeSpec{name.source, *symbol};7618  } else {7619    Say(name, "'%s' is not a derived type"_err_en_US);7620    return std::nullopt;7621  }7622}7623 7624std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(7625    const parser::Name &typeName, const parser::Name *extendsName) {7626  if (extendsName) {7627    if (typeName.source == extendsName->source) {7628      Say(extendsName->source,7629          "Derived type '%s' cannot extend itself"_err_en_US);7630    } else if (auto dtSpec{ResolveDerivedType(*extendsName)}) {7631      if (!dtSpec->IsForwardReferenced()) {7632        return dtSpec;7633      }7634      Say(typeName.source,7635          "Derived type '%s' cannot extend type '%s' that has not yet been defined"_err_en_US,7636          typeName.source, extendsName->source);7637    }7638  }7639  return std::nullopt;7640}7641 7642Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {7643  // The symbol is checked later by CheckExplicitInterface() and7644  // CheckBindings().  It can be a forward reference.7645  if (!NameIsKnownOrIntrinsic(name)) {7646    Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};7647    Resolve(name, symbol);7648  }7649  return name.symbol;7650}7651 7652void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {7653  if (const Symbol * symbol{name.symbol}) {7654    const Symbol &ultimate{symbol->GetUltimate()};7655    if (!context().HasError(*symbol) && !context().HasError(ultimate) &&7656        !BypassGeneric(ultimate).HasExplicitInterface()) {7657      Say(name,7658          "'%s' must be an abstract interface or a procedure with an explicit interface"_err_en_US,7659          symbol->name());7660    }7661  }7662}7663 7664// Create a symbol for a type parameter, component, or procedure binding in7665// the current derived type scope. Return false on error.7666Symbol *DeclarationVisitor::MakeTypeSymbol(7667    const parser::Name &name, Details &&details) {7668  return Resolve(name, MakeTypeSymbol(name.source, std::move(details)));7669}7670Symbol *DeclarationVisitor::MakeTypeSymbol(7671    const SourceName &name, Details &&details) {7672  Scope &derivedType{currScope()};7673  CHECK(derivedType.IsDerivedType());7674  if (auto *symbol{FindInScope(derivedType, name)}) { // C7427675    Say2(name,7676        "Type parameter, component, or procedure binding '%s'"7677        " already defined in this type"_err_en_US,7678        *symbol, "Previous definition of '%s'"_en_US);7679    return nullptr;7680  } else {7681    auto attrs{GetAttrs()};7682    // Apply binding-private-stmt if present and this is a procedure binding7683    if (derivedTypeInfo_.privateBindings &&7684        !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&7685        std::holds_alternative<ProcBindingDetails>(details)) {7686      attrs.set(Attr::PRIVATE);7687    }7688    Symbol &result{MakeSymbol(name, attrs, std::move(details))};7689    SetCUDADataAttr(name, result, cudaDataAttr());7690    return &result;7691  }7692}7693 7694// Return true if it is ok to declare this component in the current scope.7695// Otherwise, emit an error and return false.7696bool DeclarationVisitor::OkToAddComponent(7697    const parser::Name &name, const Symbol *extends) {7698  for (const Scope *scope{&currScope()}; scope;) {7699    CHECK(scope->IsDerivedType());7700    if (auto *prev{FindInScope(*scope, name.source)}) {7701      std::optional<parser::MessageFixedText> msg;7702      std::optional<common::UsageWarning> warning;7703      if (context().HasError(*prev)) { // don't pile on7704      } else if (CheckAccessibleSymbol(currScope(), *prev)) {7705        // inaccessible component -- redeclaration is ok7706        if (extends) {7707          // The parent type has a component of same name, but it remains7708          // extensible outside its module since that component is PRIVATE.7709        } else if (context().ShouldWarn(7710                       common::UsageWarning::RedeclaredInaccessibleComponent)) {7711          msg =7712              "Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US;7713          warning = common::UsageWarning::RedeclaredInaccessibleComponent;7714        }7715      } else if (extends) {7716        msg =7717            "Type cannot be extended as it has a component named '%s'"_err_en_US;7718      } else if (prev->test(Symbol::Flag::ParentComp)) {7719        msg =7720            "'%s' is a parent type of this type and so cannot be a component"_err_en_US;7721      } else if (scope == &currScope()) {7722        msg =7723            "Component '%s' is already declared in this derived type"_err_en_US;7724      } else {7725        msg =7726            "Component '%s' is already declared in a parent of this derived type"_err_en_US;7727      }7728      if (msg) {7729        auto &said{Say2(name, std::move(*msg), *prev,7730            "Previous declaration of '%s'"_en_US)};7731        if (msg->severity() == parser::Severity::Error) {7732          Resolve(name, *prev);7733          return false;7734        }7735        if (warning) {7736          said.set_usageWarning(*warning);7737        }7738      }7739    }7740    if (scope == &currScope() && extends) {7741      // The parent component has not yet been added to the scope.7742      scope = extends->scope();7743    } else {7744      scope = scope->GetDerivedTypeParent();7745    }7746  }7747  return true;7748}7749 7750ParamValue DeclarationVisitor::GetParamValue(7751    const parser::TypeParamValue &x, common::TypeParamAttr attr) {7752  return common::visit(7753      common::visitors{7754          [=](const parser::ScalarIntExpr &x) { // C7047755            return ParamValue{EvaluateIntExpr(x), attr};7756          },7757          [=](const parser::Star &) { return ParamValue::Assumed(attr); },7758          [=](const parser::TypeParamValue::Deferred &) {7759            return ParamValue::Deferred(attr);7760          },7761      },7762      x.u);7763}7764 7765// ConstructVisitor implementation7766 7767void ConstructVisitor::ResolveIndexName(7768    const parser::ConcurrentControl &control) {7769  const parser::Name &name{std::get<parser::Name>(control.t)};7770  auto *prev{FindSymbol(name)};7771  if (prev) {7772    if (prev->owner() == currScope()) {7773      SayAlreadyDeclared(name, *prev);7774      return;7775    } else if (prev->owner().kind() == Scope::Kind::Forall &&7776        context().ShouldWarn(7777            common::LanguageFeature::OddIndexVariableRestrictions)) {7778      SayWithDecl(name, *prev,7779          "Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US)7780          .set_languageFeature(7781              common::LanguageFeature::OddIndexVariableRestrictions);7782    }7783    name.symbol = nullptr;7784  }7785  auto &symbol{DeclareObjectEntity(name)};7786  if (symbol.GetType()) {7787    // type came from explicit type-spec7788  } else if (!prev) {7789    ApplyImplicitRules(symbol);7790  } else {7791    // Odd rules in F'2023 19.4 paras 6 & 8.7792    Symbol &prevRoot{prev->GetUltimate()};7793    if (const auto *type{prevRoot.GetType()}) {7794      symbol.SetType(*type);7795    } else {7796      ApplyImplicitRules(symbol);7797    }7798    if (prevRoot.has<ObjectEntityDetails>() ||7799        ConvertToObjectEntity(prevRoot)) {7800      if (prevRoot.IsObjectArray() &&7801          context().ShouldWarn(7802              common::LanguageFeature::OddIndexVariableRestrictions)) {7803        SayWithDecl(name, *prev,7804            "Index variable '%s' should be scalar in the enclosing scope"_port_en_US)7805            .set_languageFeature(7806                common::LanguageFeature::OddIndexVariableRestrictions);7807      }7808    } else if (!prevRoot.has<CommonBlockDetails>() &&7809        context().ShouldWarn(7810            common::LanguageFeature::OddIndexVariableRestrictions)) {7811      SayWithDecl(name, *prev,7812          "Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US)7813          .set_languageFeature(7814              common::LanguageFeature::OddIndexVariableRestrictions);7815    }7816  }7817  EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});7818}7819 7820// We need to make sure that all of the index-names get declared before the7821// expressions in the loop control are evaluated so that references to the7822// index-names in the expressions are correctly detected.7823bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {7824  BeginDeclTypeSpec();7825  Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t));7826  const auto &controls{7827      std::get<std::list<parser::ConcurrentControl>>(header.t)};7828  for (const auto &control : controls) {7829    ResolveIndexName(control);7830  }7831  Walk(controls);7832  Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t));7833  EndDeclTypeSpec();7834  return false;7835}7836 7837bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {7838  for (auto &name : x.v) {7839    DeclareLocalEntity(name, Symbol::Flag::LocalityLocal);7840  }7841  return false;7842}7843 7844bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {7845  for (auto &name : x.v) {7846    DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit);7847  }7848  return false;7849}7850 7851bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {7852  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {7853    DeclareLocalEntity(name, Symbol::Flag::LocalityReduce);7854  }7855  return false;7856}7857 7858bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {7859  for (const auto &name : x.v) {7860    if (!FindSymbol(name)) {7861      context().Warn(common::UsageWarning::ImplicitShared, name.source,7862          "Variable '%s' with SHARED locality implicitly declared"_warn_en_US,7863          name.source);7864    }7865    Symbol &prev{FindOrDeclareEnclosingEntity(name)};7866    if (PassesSharedLocalityChecks(name, prev)) {7867      MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);7868    }7869  }7870  return false;7871}7872 7873bool ConstructVisitor::Pre(const parser::AcSpec &x) {7874  ProcessTypeSpec(x.type);7875  Walk(x.values);7876  return false;7877}7878 7879// Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the7880// enclosing ac-implied-do7881bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {7882  auto &values{std::get<std::list<parser::AcValue>>(x.t)};7883  auto &control{std::get<parser::AcImpliedDoControl>(x.t)};7884  auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};7885  auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};7886  // F'2018 has the scope of the implied DO variable covering the entire7887  // implied DO production (19.4(5)), which seems wrong in cases where the name7888  // of the implied DO variable appears in one of the bound expressions. Thus7889  // this extension, which shrinks the scope of the variable to exclude the7890  // expressions in the bounds.7891  auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};7892  Walk(bounds.lower);7893  Walk(bounds.upper);7894  Walk(bounds.step);7895  EndCheckOnIndexUseInOwnBounds(restore);7896  PushScope(Scope::Kind::ImpliedDos, nullptr);7897  DeclareStatementEntity(bounds.name, type);7898  Walk(values);7899  PopScope();7900  return false;7901}7902 7903bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {7904  auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};7905  auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};7906  auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};7907  // See comment in Pre(AcImpliedDo) above.7908  auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};7909  Walk(bounds.lower);7910  Walk(bounds.upper);7911  Walk(bounds.step);7912  EndCheckOnIndexUseInOwnBounds(restore);7913  PushScope(Scope::Kind::ImpliedDos, nullptr);7914  DeclareStatementEntity(bounds.name, type);7915  Walk(objects);7916  PopScope();7917  return false;7918}7919 7920// Sets InDataStmt flag on a variable (or misidentified function) in a DATA7921// statement so that the predicate IsInitialized() will be true7922// during semantic analysis before the symbol's initializer is constructed.7923bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {7924  common::visit(7925      common::visitors{7926          [&](const parser::Scalar<Indirection<parser::Designator>> &y) {7927            const auto &designator{parser::UnwrapRef<parser::Designator>(y)};7928            Walk(designator);7929            const parser::Name &first{parser::GetFirstName(designator)};7930            if (first.symbol) {7931              first.symbol->set(Symbol::Flag::InDataStmt);7932            }7933          },7934          [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y); },7935      },7936      x.u);7937  return false;7938}7939 7940bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {7941  // Subtle: DATA statements may appear in both the specification and7942  // execution parts, but should be treated as if in the execution part7943  // for purposes of implicit variable declaration vs. host association.7944  // When a name first appears as an object in a DATA statement, it should7945  // be implicitly declared locally as if it had been assigned.7946  auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};7947  common::visit(7948      common::visitors{7949          [&](const Indirection<parser::Variable> &y) {7950            auto restorer{common::ScopedSet(deferImplicitTyping_, true)};7951            Walk(y.value());7952            const parser::Name &first{parser::GetFirstName(y.value())};7953            if (first.symbol) {7954              first.symbol->set(Symbol::Flag::InDataStmt);7955            }7956          },7957          [&](const parser::DataImpliedDo &y) {7958            // Don't push scope here, since it's done when visiting7959            // DataImpliedDo.7960            Walk(y);7961          },7962      },7963      x.u);7964  return false;7965}7966 7967bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {7968  const auto &data{std::get<parser::DataStmtConstant>(x.t)};7969  auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};7970  if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {7971    if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {7972      if (const Symbol * symbol{FindSymbol(*name)};7973          symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {7974        mutableData.u = elem->ConvertToStructureConstructor(7975            DerivedTypeSpec{name->source, *symbol});7976      }7977    }7978  }7979  return true;7980}7981 7982bool ConstructVisitor::Pre(const parser::DoConstruct &x) {7983  if (x.IsDoConcurrent()) {7984    // The new scope has Kind::Forall for index variable name conflict7985    // detection with nested FORALL/DO CONCURRENT constructs in7986    // ResolveIndexName().7987    PushScope(Scope::Kind::Forall, nullptr);7988  }7989  return true;7990}7991void ConstructVisitor::Post(const parser::DoConstruct &x) {7992  if (x.IsDoConcurrent()) {7993    PopScope();7994  }7995}7996 7997bool ConstructVisitor::Pre(const parser::ForallConstruct &) {7998  PushScope(Scope::Kind::Forall, nullptr);7999  return true;8000}8001void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }8002bool ConstructVisitor::Pre(const parser::ForallStmt &) {8003  PushScope(Scope::Kind::Forall, nullptr);8004  return true;8005}8006void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }8007 8008bool ConstructVisitor::Pre(const parser::BlockConstruct &x) {8009  const auto &[blockStmt, specPart, execPart, endBlockStmt] = x.t;8010  Walk(blockStmt);8011  CheckDef(blockStmt.statement.v);8012  PushScope(Scope::Kind::BlockConstruct, nullptr);8013  Walk(specPart);8014  HandleImpliedAsynchronousInScope(execPart);8015  Walk(execPart);8016  Walk(endBlockStmt);8017  PopScope();8018  CheckRef(endBlockStmt.statement.v);8019  return false;8020}8021 8022void ConstructVisitor::Post(const parser::Selector &x) {8023  GetCurrentAssociation().selector = ResolveSelector(x);8024}8025 8026void ConstructVisitor::Post(const parser::AssociateStmt &x) {8027  CheckDef(x.t);8028  PushScope(Scope::Kind::OtherConstruct, nullptr);8029  const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()};8030  for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) {8031    SetCurrentAssociation(nthLastAssoc);8032    if (auto *symbol{MakeAssocEntity()}) {8033      const MaybeExpr &expr{GetCurrentAssociation().selector.expr};8034      if (ExtractCoarrayRef(expr)) { // C11038035        Say("Selector must not be a coindexed object"_err_en_US);8036      }8037      if (IsAssumedRank(expr)) {8038        Say("Selector must not be assumed-rank"_err_en_US);8039      }8040      SetTypeFromAssociation(*symbol);8041      SetAttrsFromAssociation(*symbol);8042    }8043  }8044  PopAssociation(assocCount);8045}8046 8047void ConstructVisitor::Post(const parser::EndAssociateStmt &x) {8048  PopScope();8049  CheckRef(x.v);8050}8051 8052bool ConstructVisitor::Pre(const parser::Association &x) {8053  PushAssociation();8054  const auto &name{std::get<parser::Name>(x.t)};8055  GetCurrentAssociation().name = &name;8056  return true;8057}8058 8059bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) {8060  CheckDef(x.t);8061  PushScope(Scope::Kind::OtherConstruct, nullptr);8062  PushAssociation();8063  return true;8064}8065 8066void ConstructVisitor::Post(const parser::CoarrayAssociation &x) {8067  const auto &decl{std::get<parser::CodimensionDecl>(x.t)};8068  const auto &name{std::get<parser::Name>(decl.t)};8069  if (auto *symbol{FindInScope(name)}) {8070    const auto &selector{std::get<parser::Selector>(x.t)};8071    if (auto sel{ResolveSelector(selector)}) {8072      const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)};8073      if (!whole || whole->Corank() == 0) {8074        Say(sel.source, // C11168075            "Selector in coarray association must name a coarray"_err_en_US);8076      } else if (auto dynType{sel.expr->GetType()}) {8077        if (!symbol->GetType()) {8078          symbol->SetType(ToDeclTypeSpec(std::move(*dynType)));8079        }8080      }8081    }8082  }8083}8084 8085void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) {8086  PopAssociation();8087  PopScope();8088  CheckRef(x.t);8089}8090 8091bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) {8092  PushAssociation();8093  return true;8094}8095 8096void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {8097  PopAssociation();8098}8099 8100void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {8101  auto &association{GetCurrentAssociation()};8102  if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {8103    // This isn't a name in the current scope, it is in each TypeGuardStmt8104    MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);8105    association.name = &*name;8106    if (ExtractCoarrayRef(association.selector.expr)) { // C11038107      Say("Selector must not be a coindexed object"_err_en_US);8108    }8109    if (association.selector.expr) {8110      auto exprType{association.selector.expr->GetType()};8111      if (exprType && !exprType->IsPolymorphic()) { // C11598112        Say(association.selector.source,8113            "Selector '%s' in SELECT TYPE statement must be "8114            "polymorphic"_err_en_US);8115      }8116    }8117  } else {8118    if (const Symbol *8119        whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {8120      ConvertToObjectEntity(const_cast<Symbol &>(*whole));8121      if (!IsVariableName(*whole)) {8122        Say(association.selector.source, // C9018123            "Selector is not a variable"_err_en_US);8124        association = {};8125      }8126      if (const DeclTypeSpec * type{whole->GetType()}) {8127        if (!type->IsPolymorphic()) { // C11598128          Say(association.selector.source,8129              "Selector '%s' in SELECT TYPE statement must be "8130              "polymorphic"_err_en_US);8131        }8132      }8133    } else {8134      Say(association.selector.source, // C11578135          "Selector is not a named variable: 'associate-name =>' is required"_err_en_US);8136      association = {};8137    }8138  }8139}8140 8141void ConstructVisitor::Post(const parser::SelectRankStmt &x) {8142  auto &association{GetCurrentAssociation()};8143  if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {8144    // This isn't a name in the current scope, it is in each SelectRankCaseStmt8145    MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName);8146    association.name = &*name;8147  }8148}8149 8150bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {8151  PushScope(Scope::Kind::OtherConstruct, nullptr);8152  return true;8153}8154void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {8155  PopScope();8156}8157 8158bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) {8159  PushScope(Scope::Kind::OtherConstruct, nullptr);8160  return true;8161}8162void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) {8163  PopScope();8164}8165 8166bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) {8167  if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) {8168    // CLASS IS (t)8169    SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);8170  }8171  return true;8172}8173 8174void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {8175  if (auto *symbol{MakeAssocEntity()}) {8176    if (std::holds_alternative<parser::Default>(x.u)) {8177      SetTypeFromAssociation(*symbol);8178    } else if (const auto *type{GetDeclTypeSpec()}) {8179      symbol->SetType(*type);8180      symbol->get<AssocEntityDetails>().set_isTypeGuard();8181    }8182    SetAttrsFromAssociation(*symbol);8183  }8184}8185 8186void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {8187  if (auto *symbol{MakeAssocEntity()}) {8188    SetTypeFromAssociation(*symbol);8189    auto &details{symbol->get<AssocEntityDetails>()};8190    // Don't call SetAttrsFromAssociation() for SELECT RANK.8191    Attrs selectorAttrs{8192        evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};8193    Attrs attrsToKeep{Attr::ASYNCHRONOUS, Attr::TARGET, Attr::VOLATILE};8194    if (const auto *rankValue{8195            std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {8196      // RANK(n)8197      if (auto expr{EvaluateIntExpr(*rankValue)}) {8198        if (auto val{evaluate::ToInt64(*expr)}) {8199          details.set_rank(*val);8200          attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};8201        } else {8202          Say("RANK() expression must be constant"_err_en_US);8203        }8204      }8205    } else if (std::holds_alternative<parser::Star>(x.u)) {8206      // RANK(*): assumed-size8207      details.set_IsAssumedSize();8208    } else {8209      CHECK(std::holds_alternative<parser::Default>(x.u));8210      // RANK DEFAULT: assumed-rank8211      details.set_IsAssumedRank();8212      attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};8213    }8214    symbol->attrs() |= selectorAttrs & attrsToKeep;8215  }8216}8217 8218bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {8219  PushAssociation();8220  return true;8221}8222 8223void ConstructVisitor::Post(const parser::SelectRankConstruct &) {8224  PopAssociation();8225}8226 8227bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {8228  if (x && !x->symbol) {8229    // Construct names are not scoped by BLOCK in the standard, but many,8230    // but not all, compilers do treat them as if they were so scoped.8231    if (Symbol * inner{FindInScope(currScope(), *x)}) {8232      SayAlreadyDeclared(*x, *inner);8233    } else {8234      if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {8235        if (Symbol *8236            other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) {8237          SayWithDecl(*x, *other,8238              "The construct name '%s' should be distinct at the subprogram level"_port_en_US)8239              .set_languageFeature(common::LanguageFeature::BenignNameClash);8240        }8241      }8242      MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});8243    }8244  }8245  return true;8246}8247 8248void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {8249  if (x) {8250    // Just add an occurrence of this name; checking is done in ValidateLabels8251    FindSymbol(*x);8252  }8253}8254 8255// Make a symbol for the associating entity of the current association.8256Symbol *ConstructVisitor::MakeAssocEntity() {8257  Symbol *symbol{nullptr};8258  auto &association{GetCurrentAssociation()};8259  if (association.name) {8260    symbol = &MakeSymbol(*association.name, UnknownDetails{});8261    if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) {8262      Say(*association.name, // C11028263          "The associate name '%s' is already used in this associate statement"_err_en_US);8264      return nullptr;8265    }8266  } else if (const Symbol *8267      whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {8268    symbol = &MakeSymbol(whole->name());8269  } else {8270    return nullptr;8271  }8272  if (auto &expr{association.selector.expr}) {8273    symbol->set_details(AssocEntityDetails{common::Clone(*expr)});8274  } else {8275    symbol->set_details(AssocEntityDetails{});8276  }8277  return symbol;8278}8279 8280// Set the type of symbol based on the current association selector.8281void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {8282  auto &details{symbol.get<AssocEntityDetails>()};8283  const MaybeExpr *pexpr{&details.expr()};8284  if (!*pexpr) {8285    pexpr = &GetCurrentAssociation().selector.expr;8286  }8287  if (*pexpr) {8288    const SomeExpr &expr{**pexpr};8289    if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {8290      if (const auto *charExpr{8291              evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>(8292                  expr)}) {8293        symbol.SetType(ToDeclTypeSpec(std::move(*type),8294            FoldExpr(common::visit(8295                [](const auto &kindChar) { return kindChar.LEN(); },8296                charExpr->u))));8297      } else {8298        symbol.SetType(ToDeclTypeSpec(std::move(*type)));8299      }8300    } else {8301      // BOZ literals, procedure designators, &c. are not acceptable8302      Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);8303    }8304  }8305}8306 8307// If current selector is a variable, set some of its attributes on symbol.8308// For ASSOCIATE, CHANGE TEAM, and SELECT TYPE only; not SELECT RANK.8309void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {8310  Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};8311  symbol.attrs() |=8312      attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE};8313  if (attrs.test(Attr::POINTER)) {8314    SetImplicitAttr(symbol, Attr::TARGET);8315  }8316}8317 8318ConstructVisitor::Selector ConstructVisitor::ResolveSelector(8319    const parser::Selector &x) {8320  return common::visit(common::visitors{8321                           [&](const parser::Expr &expr) {8322                             return Selector{expr.source, EvaluateExpr(x)};8323                           },8324                           [&](const parser::Variable &var) {8325                             return Selector{var.GetSource(), EvaluateExpr(x)};8326                           },8327                       },8328      x.u);8329}8330 8331// Set the current association to the nth to the last association on the8332// association stack.  The top of the stack is at n = 1.  This allows access8333// to the interior of a list of associations at the top of the stack.8334void ConstructVisitor::SetCurrentAssociation(std::size_t n) {8335  CHECK(n > 0 && n <= associationStack_.size());8336  currentAssociation_ = &associationStack_[associationStack_.size() - n];8337}8338 8339ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() {8340  CHECK(currentAssociation_);8341  return *currentAssociation_;8342}8343 8344void ConstructVisitor::PushAssociation() {8345  associationStack_.emplace_back(Association{});8346  currentAssociation_ = &associationStack_.back();8347}8348 8349void ConstructVisitor::PopAssociation(std::size_t count) {8350  CHECK(count > 0 && count <= associationStack_.size());8351  associationStack_.resize(associationStack_.size() - count);8352  currentAssociation_ =8353      associationStack_.empty() ? nullptr : &associationStack_.back();8354}8355 8356const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(8357    evaluate::DynamicType &&type) {8358  switch (type.category()) {8359    SWITCH_COVERS_ALL_CASES8360  case common::TypeCategory::Integer:8361  case common::TypeCategory::Unsigned:8362  case common::TypeCategory::Real:8363  case common::TypeCategory::Complex:8364    return context().MakeNumericType(type.category(), type.kind());8365  case common::TypeCategory::Logical:8366    return context().MakeLogicalType(type.kind());8367  case common::TypeCategory::Derived:8368    if (type.IsAssumedType()) {8369      return currScope().MakeTypeStarType();8370    } else if (type.IsUnlimitedPolymorphic()) {8371      return currScope().MakeClassStarType();8372    } else {8373      return currScope().MakeDerivedType(8374          type.IsPolymorphic() ? DeclTypeSpec::ClassDerived8375                               : DeclTypeSpec::TypeDerived,8376          common::Clone(type.GetDerivedTypeSpec())8377 8378      );8379    }8380  case common::TypeCategory::Character:8381    CRASH_NO_CASE;8382  }8383}8384 8385const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(8386    evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {8387  CHECK(type.category() == common::TypeCategory::Character);8388  if (length) {8389    return currScope().MakeCharacterType(8390        ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},8391        KindExpr{type.kind()});8392  } else {8393    return currScope().MakeCharacterType(8394        ParamValue::Deferred(common::TypeParamAttr::Len),8395        KindExpr{type.kind()});8396  }8397}8398 8399class ExecutionPartSkimmerBase {8400public:8401  template <typename A> bool Pre(const A &) { return true; }8402  template <typename A> void Post(const A &) {}8403 8404  bool InNestedBlockConstruct() const { return blockDepth_ > 0; }8405 8406  bool Pre(const parser::AssociateConstruct &) {8407    PushScope();8408    return true;8409  }8410  void Post(const parser::AssociateConstruct &) { PopScope(); }8411  bool Pre(const parser::Association &x) {8412    Hide(std::get<parser::Name>(x.t));8413    return true;8414  }8415  bool Pre(const parser::BlockConstruct &) {8416    PushScope();8417    ++blockDepth_;8418    return true;8419  }8420  void Post(const parser::BlockConstruct &) {8421    --blockDepth_;8422    PopScope();8423  }8424  // Note declarations of local names in BLOCK constructs.8425  // Don't have to worry about INTENT(), VALUE, or OPTIONAL8426  // (pertinent only to dummy arguments), ASYNCHRONOUS/VOLATILE,8427  // or accessibility attributes,8428  bool Pre(const parser::EntityDecl &x) {8429    Hide(std::get<parser::ObjectName>(x.t));8430    return true;8431  }8432  bool Pre(const parser::ObjectDecl &x) {8433    Hide(std::get<parser::ObjectName>(x.t));8434    return true;8435  }8436  bool Pre(const parser::PointerDecl &x) {8437    Hide(std::get<parser::Name>(x.t));8438    return true;8439  }8440  bool Pre(const parser::BindEntity &x) {8441    Hide(std::get<parser::Name>(x.t));8442    return true;8443  }8444  bool Pre(const parser::ContiguousStmt &x) {8445    for (const parser::Name &name : x.v) {8446      Hide(name);8447    }8448    return true;8449  }8450  bool Pre(const parser::DimensionStmt::Declaration &x) {8451    Hide(std::get<parser::Name>(x.t));8452    return true;8453  }8454  bool Pre(const parser::ExternalStmt &x) {8455    for (const parser::Name &name : x.v) {8456      Hide(name);8457    }8458    return true;8459  }8460  bool Pre(const parser::IntrinsicStmt &x) {8461    for (const parser::Name &name : x.v) {8462      Hide(name);8463    }8464    return true;8465  }8466  bool Pre(const parser::CodimensionStmt &x) {8467    for (const parser::CodimensionDecl &decl : x.v) {8468      Hide(std::get<parser::Name>(decl.t));8469    }8470    return true;8471  }8472  void Post(const parser::ImportStmt &x) {8473    if (x.kind == common::ImportKind::None ||8474        x.kind == common::ImportKind::Only) {8475      if (!nestedScopes_.front().importOnly.has_value()) {8476        nestedScopes_.front().importOnly.emplace();8477      }8478      for (const auto &name : x.names) {8479        nestedScopes_.front().importOnly->emplace(name.source);8480      }8481    } else {8482      // no special handling needed for explicit names or IMPORT, ALL8483    }8484  }8485  void Post(const parser::UseStmt &x) {8486    if (const auto *onlyList{std::get_if<std::list<parser::Only>>(&x.u)}) {8487      for (const auto &only : *onlyList) {8488        if (const auto *name{std::get_if<parser::Name>(&only.u)}) {8489          Hide(*name);8490        } else if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {8491          if (const auto *names{8492                  std::get_if<parser::Rename::Names>(&rename->u)}) {8493            Hide(std::get<0>(names->t));8494          }8495        }8496      }8497    } else {8498      // USE may or may not shadow symbols in host scopes8499      nestedScopes_.front().hasUseWithoutOnly = true;8500    }8501  }8502  bool Pre(const parser::DerivedTypeStmt &x) {8503    Hide(std::get<parser::Name>(x.t));8504    PushScope();8505    return true;8506  }8507  void Post(const parser::DerivedTypeDef &) { PopScope(); }8508  bool Pre(const parser::SelectTypeConstruct &) {8509    PushScope();8510    return true;8511  }8512  void Post(const parser::SelectTypeConstruct &) { PopScope(); }8513  bool Pre(const parser::SelectTypeStmt &x) {8514    if (const auto &maybeName{std::get<1>(x.t)}) {8515      Hide(*maybeName);8516    }8517    return true;8518  }8519  bool Pre(const parser::SelectRankConstruct &) {8520    PushScope();8521    return true;8522  }8523  void Post(const parser::SelectRankConstruct &) { PopScope(); }8524  bool Pre(const parser::SelectRankStmt &x) {8525    if (const auto &maybeName{std::get<1>(x.t)}) {8526      Hide(*maybeName);8527    }8528    return true;8529  }8530 8531  // Iterator-modifiers contain variable declarations, and do introduce8532  // a new scope. These variables can only have integer types, and their8533  // scope only extends until the end of the clause. A potential alternative8534  // to the code below may be to ignore OpenMP clauses, but it's not clear8535  // if OMP-specific checks can be avoided altogether.8536  bool Pre(const parser::OmpClause &x) {8537    if (OmpVisitor::NeedsScope(x)) {8538      PushScope();8539    }8540    return true;8541  }8542  void Post(const parser::OmpClause &x) {8543    if (OmpVisitor::NeedsScope(x)) {8544      PopScope();8545    }8546  }8547 8548protected:8549  bool IsHidden(SourceName name) {8550    for (const auto &scope : nestedScopes_) {8551      if (scope.locals.find(name) != scope.locals.end()) {8552        return true; // shadowed by nested declaration8553      }8554      if (scope.hasUseWithoutOnly) {8555        break;8556      }8557      if (scope.importOnly &&8558          scope.importOnly->find(name) == scope.importOnly->end()) {8559        return true; // not imported8560      }8561    }8562    return false;8563  }8564 8565  void EndWalk() { CHECK(nestedScopes_.empty()); }8566 8567private:8568  void PushScope() { nestedScopes_.emplace_front(); }8569  void PopScope() { nestedScopes_.pop_front(); }8570  void Hide(const parser::Name &name) {8571    nestedScopes_.front().locals.emplace(name.source);8572  }8573 8574  int blockDepth_{0};8575  struct NestedScopeInfo {8576    bool hasUseWithoutOnly{false};8577    std::set<SourceName> locals;8578    std::optional<std::set<SourceName>> importOnly;8579  };8580  std::list<NestedScopeInfo> nestedScopes_;8581};8582 8583class ExecutionPartAsyncIOSkimmer : public ExecutionPartSkimmerBase {8584public:8585  explicit ExecutionPartAsyncIOSkimmer(SemanticsContext &context)8586      : context_{context} {}8587 8588  void Walk(const parser::Block &block) {8589    parser::Walk(block, *this);8590    EndWalk();8591  }8592 8593  const std::set<SourceName> asyncIONames() const { return asyncIONames_; }8594 8595  using ExecutionPartSkimmerBase::Post;8596  using ExecutionPartSkimmerBase::Pre;8597 8598  bool Pre(const parser::IoControlSpec::Asynchronous &async) {8599    if (auto folded{evaluate::Fold(8600            context_.foldingContext(), AnalyzeExpr(context_, async.v))}) {8601      if (auto str{8602              evaluate::GetScalarConstantValue<evaluate::Ascii>(*folded)}) {8603        for (char ch : *str) {8604          if (ch != ' ') {8605            inAsyncIO_ = ch == 'y' || ch == 'Y';8606            break;8607          }8608        }8609      }8610    }8611    return true;8612  }8613  void Post(const parser::ReadStmt &) { inAsyncIO_ = false; }8614  void Post(const parser::WriteStmt &) { inAsyncIO_ = false; }8615  void Post(const parser::IoControlSpec::Size &size) {8616    if (const auto *designator{8617            parser::Unwrap<common::Indirection<parser::Designator>>(size)}) {8618      NoteAsyncIODesignator(designator->value());8619    }8620  }8621  void Post(const parser::InputItem &x) {8622    if (const auto *var{std::get_if<parser::Variable>(&x.u)}) {8623      if (const auto *designator{8624              std::get_if<common::Indirection<parser::Designator>>(&var->u)}) {8625        NoteAsyncIODesignator(designator->value());8626      }8627    }8628  }8629  void Post(const parser::OutputItem &x) {8630    if (const auto *expr{std::get_if<parser::Expr>(&x.u)}) {8631      if (const auto *designator{8632              std::get_if<common::Indirection<parser::Designator>>(&expr->u)}) {8633        NoteAsyncIODesignator(designator->value());8634      }8635    }8636  }8637 8638private:8639  void NoteAsyncIODesignator(const parser::Designator &designator) {8640    if (inAsyncIO_ && !InNestedBlockConstruct()) {8641      const parser::Name &name{parser::GetFirstName(designator)};8642      if (!IsHidden(name.source)) {8643        asyncIONames_.insert(name.source);8644      }8645    }8646  }8647 8648  SemanticsContext &context_;8649  bool inAsyncIO_{false};8650  std::set<SourceName> asyncIONames_;8651};8652 8653// Any data list item or SIZE= specifier of an I/O data transfer statement8654// with ASYNCHRONOUS="YES" implicitly has the ASYNCHRONOUS attribute in the8655// local scope.8656void ConstructVisitor::HandleImpliedAsynchronousInScope(8657    const parser::Block &block) {8658  ExecutionPartAsyncIOSkimmer skimmer{context()};8659  skimmer.Walk(block);8660  for (auto name : skimmer.asyncIONames()) {8661    if (Symbol * symbol{currScope().FindSymbol(name)}) {8662      if (!symbol->attrs().test(Attr::ASYNCHRONOUS)) {8663        if (&symbol->owner() != &currScope()) {8664          symbol = &*currScope()8665                         .try_emplace(name, HostAssocDetails{*symbol})8666                         .first->second;8667        }8668        if (symbol->has<AssocEntityDetails>()) {8669          symbol = const_cast<Symbol *>(&GetAssociationRoot(*symbol));8670        }8671        SetImplicitAttr(*symbol, Attr::ASYNCHRONOUS);8672      }8673    }8674  }8675}8676 8677// ResolveNamesVisitor implementation8678 8679bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {8680  HandleCall(Symbol::Flag::Function, x.v);8681  return false;8682}8683bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {8684  HandleCall(Symbol::Flag::Subroutine, x.call);8685  Walk(x.chevrons);8686  return false;8687}8688 8689bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {8690  auto &scope{currScope()};8691  // Check C896 and C899: where IMPORT statements are allowed8692  switch (scope.kind()) {8693  case Scope::Kind::Module:8694    if (scope.IsModule()) {8695      Say("IMPORT is not allowed in a module scoping unit"_err_en_US);8696      return false;8697    } else if (x.kind == common::ImportKind::None) {8698      Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US);8699      return false;8700    }8701    break;8702  case Scope::Kind::MainProgram:8703    Say("IMPORT is not allowed in a main program scoping unit"_err_en_US);8704    return false;8705  case Scope::Kind::Subprogram:8706    if (scope.parent().IsGlobal()) {8707      Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US);8708      return false;8709    }8710    break;8711  case Scope::Kind::BlockData: // C1415 (in part)8712    Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);8713    return false;8714  default:;8715  }8716  if (auto error{scope.SetImportKind(x.kind)}) {8717    Say(std::move(*error));8718  }8719  for (auto &name : x.names) {8720    if (Symbol * outer{FindSymbol(scope.parent(), name)}) {8721      scope.add_importName(name.source);8722      if (Symbol * symbol{FindInScope(name)}) {8723        if (outer->GetUltimate() == symbol->GetUltimate()) {8724          context().Warn(common::LanguageFeature::BenignNameClash, name.source,8725              "The same '%s' is already present in this scope"_port_en_US,8726              name.source);8727        } else {8728          Say(name,8729              "A distinct '%s' is already present in this scope"_err_en_US)8730              .Attach(symbol->name(), "Previous declaration of '%s'"_en_US,8731                  symbol->name().ToString())8732              .Attach(outer->name(), "Declaration of '%s' in host scope"_en_US,8733                  outer->name().ToString());8734        }8735      }8736    } else {8737      Say(name, "'%s' not found in host scope"_err_en_US);8738    }8739  }8740  prevImportStmt_ = currStmtSource();8741  return false;8742}8743 8744const parser::Name *DeclarationVisitor::ResolveStructureComponent(8745    const parser::StructureComponent &x) {8746  return FindComponent(ResolveDataRef(x.base), x.component);8747}8748 8749const parser::Name *DeclarationVisitor::ResolveDesignator(8750    const parser::Designator &x) {8751  return common::visit(8752      common::visitors{8753          [&](const parser::DataRef &x) { return ResolveDataRef(x); },8754          [&](const parser::Substring &x) {8755            Walk(std::get<parser::SubstringRange>(x.t).t);8756            return ResolveDataRef(std::get<parser::DataRef>(x.t));8757          },8758      },8759      x.u);8760}8761 8762const parser::Name *DeclarationVisitor::ResolveDataRef(8763    const parser::DataRef &x) {8764  return common::visit(8765      common::visitors{8766          [=](const parser::Name &y) { return ResolveName(y); },8767          [=](const Indirection<parser::StructureComponent> &y) {8768            return ResolveStructureComponent(y.value());8769          },8770          [&](const Indirection<parser::ArrayElement> &y) {8771            Walk(y.value().subscripts);8772            const parser::Name *name{ResolveDataRef(y.value().base)};8773            if (name && name->symbol) {8774              if (!IsProcedure(*name->symbol)) {8775                ConvertToObjectEntity(*name->symbol);8776              } else if (!context().HasError(*name->symbol)) {8777                SayWithDecl(*name, *name->symbol,8778                    "Cannot reference function '%s' as data"_err_en_US);8779                context().SetError(*name->symbol);8780              }8781            }8782            return name;8783          },8784          [&](const Indirection<parser::CoindexedNamedObject> &y) {8785            Walk(y.value().imageSelector);8786            return ResolveDataRef(y.value().base);8787          },8788      },8789      x.u);8790}8791 8792// If implicit types are allowed, ensure name is in the symbol table.8793// Otherwise, report an error if it hasn't been declared.8794const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {8795  if (!FindSymbol(name)) {8796    if (FindAndMarkDeclareTargetSymbol(name)) {8797      return &name;8798    }8799  }8800  if (CheckForHostAssociatedImplicit(name)) {8801    NotePossibleBadForwardRef(name);8802    return &name;8803  }8804  if (Symbol * symbol{name.symbol}) {8805    if (CheckUseError(name)) {8806      return nullptr; // reported an error8807    }8808    NotePossibleBadForwardRef(name);8809    symbol->set(Symbol::Flag::ImplicitOrError, false);8810    if (IsUplevelReference(*symbol)) {8811      MakeHostAssocSymbol(name, *symbol);8812    } else if (IsDummy(*symbol)) {8813      CheckEntryDummyUse(name.source, symbol);8814      ConvertToObjectEntity(*symbol);8815      if (IsEarlyDeclaredDummyArgument(*symbol)) {8816        ForgetEarlyDeclaredDummyArgument(*symbol);8817        if (isImplicitNoneType()) {8818          context().Warn(common::LanguageFeature::ForwardRefImplicitNone,8819              name.source,8820              "'%s' was used under IMPLICIT NONE(TYPE) before being explicitly typed"_warn_en_US,8821              name.source);8822        } else if (TypesMismatchIfNonNull(8823                       symbol->GetType(), GetImplicitType(*symbol))) {8824          context().Warn(common::LanguageFeature::ForwardRefExplicitTypeDummy,8825              name.source,8826              "'%s' was used before being explicitly typed (and its implicit type would differ)"_warn_en_US,8827              name.source);8828        }8829      }8830      ApplyImplicitRules(*symbol);8831    } else if (!symbol->GetType() && FindCommonBlockContaining(*symbol)) {8832      ConvertToObjectEntity(*symbol);8833      ApplyImplicitRules(*symbol);8834    } else if (const auto *tpd{symbol->detailsIf<TypeParamDetails>()};8835        tpd && !tpd->attr()) {8836      Say(name,8837          "Type parameter '%s' was referenced before being declared"_err_en_US,8838          name.source);8839      context().SetError(*symbol);8840    }8841    if (checkIndexUseInOwnBounds_ &&8842        *checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) {8843      context().Warn(common::LanguageFeature::ImpliedDoIndexScope, name.source,8844          "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,8845          name.source);8846    }8847    return &name;8848  }8849  if (isImplicitNoneType() && !deferImplicitTyping_) {8850    Say(name, "No explicit type declared for '%s'"_err_en_US);8851    return nullptr;8852  }8853  // Create the symbol, then ensure that it is accessible8854  if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {8855    Say(name,8856        "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,8857        name.source);8858  }8859  MakeSymbol(InclusiveScope(), name.source, Attrs{});8860  auto *symbol{FindSymbol(name)};8861  if (!symbol) {8862    Say(name,8863        "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);8864    return nullptr;8865  }8866  ConvertToObjectEntity(*symbol);8867  ApplyImplicitRules(*symbol);8868  NotePossibleBadForwardRef(name);8869  return &name;8870}8871 8872// A specification expression may refer to a symbol in the host procedure that8873// is implicitly typed. Because specification parts are processed before8874// execution parts, this may be the first time we see the symbol. It can't be a8875// local in the current scope (because it's in a specification expression) so8876// either it is implicitly declared in the host procedure or it is an error.8877// We create a symbol in the host assuming it is the former; if that proves to8878// be wrong we report an error later in CheckDeclarations().8879bool DeclarationVisitor::CheckForHostAssociatedImplicit(8880    const parser::Name &name) {8881  if (!inSpecificationPart_ || inEquivalenceStmt_) {8882    return false;8883  }8884  if (name.symbol) {8885    ApplyImplicitRules(*name.symbol, true);8886  }8887  if (Scope * host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {8888    Symbol *hostSymbol{nullptr};8889    if (!name.symbol) {8890      if (currScope().CanImport(name.source)) {8891        hostSymbol = &MakeSymbol(*host, name.source, Attrs{});8892        ConvertToObjectEntity(*hostSymbol);8893        ApplyImplicitRules(*hostSymbol);8894        hostSymbol->set(Symbol::Flag::ImplicitOrError);8895      }8896    } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {8897      hostSymbol = name.symbol;8898    }8899    if (hostSymbol) {8900      Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)};8901      if (auto *assoc{symbol.detailsIf<HostAssocDetails>()}) {8902        if (isImplicitNoneType()) {8903          assoc->implicitOrExplicitTypeError = true;8904        } else {8905          assoc->implicitOrSpecExprError = true;8906        }8907        return true;8908      }8909    }8910  }8911  return false;8912}8913 8914bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {8915  if (symbol.owner().IsTopLevel()) {8916    return false;8917  }8918  const Scope &symbolUnit{GetProgramUnitContaining(symbol)};8919  if (symbolUnit == GetProgramUnitContaining(currScope())) {8920    return false;8921  } else {8922    Scope::Kind kind{symbolUnit.kind()};8923    return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;8924  }8925}8926 8927// base is a part-ref of a derived type; find the named component in its type.8928// Also handles intrinsic type parameter inquiries (%kind, %len) and8929// COMPLEX component references (%re, %im).8930const parser::Name *DeclarationVisitor::FindComponent(8931    const parser::Name *base, const parser::Name &component) {8932  if (!base || !base->symbol) {8933    return nullptr;8934  }8935  if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) {8936    if (component.source == "kind") {8937      if (misc->kind() == MiscDetails::Kind::ComplexPartRe ||8938          misc->kind() == MiscDetails::Kind::ComplexPartIm ||8939          misc->kind() == MiscDetails::Kind::KindParamInquiry ||8940          misc->kind() == MiscDetails::Kind::LenParamInquiry) {8941        // x%{re,im,kind,len}%kind8942        MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry);8943        return &component;8944      }8945    }8946  }8947  CheckEntryDummyUse(base->source, base->symbol);8948  auto &symbol{base->symbol->GetUltimate()};8949  if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) {8950    SayWithDecl(*base, symbol,8951        "'%s' is not an object and may not be used as the base of a component reference or type parameter inquiry"_err_en_US);8952    return nullptr;8953  }8954  auto *type{symbol.GetType()};8955  if (!type) {8956    return nullptr; // should have already reported error8957  }8958  if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {8959    auto category{intrinsic->category()};8960    MiscDetails::Kind miscKind{MiscDetails::Kind::None};8961    if (component.source == "kind") {8962      miscKind = MiscDetails::Kind::KindParamInquiry;8963    } else if (category == TypeCategory::Character) {8964      if (component.source == "len") {8965        miscKind = MiscDetails::Kind::LenParamInquiry;8966      }8967    } else if (category == TypeCategory::Complex) {8968      if (component.source == "re") {8969        miscKind = MiscDetails::Kind::ComplexPartRe;8970      } else if (component.source == "im") {8971        miscKind = MiscDetails::Kind::ComplexPartIm;8972      }8973    }8974    if (miscKind != MiscDetails::Kind::None) {8975      MakePlaceholder(component, miscKind);8976      return &component;8977    }8978  } else if (DerivedTypeSpec * derived{type->AsDerived()}) {8979    derived->Instantiate(currScope()); // in case of forward referenced type8980    if (const Scope * scope{derived->scope()}) {8981      if (Resolve(component, scope->FindComponent(component.source))) {8982        if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {8983          context().Say(component.source, *msg);8984        }8985        return &component;8986      } else {8987        SayDerivedType(component.source,8988            "Component '%s' not found in derived type '%s'"_err_en_US, *scope);8989      }8990    }8991    return nullptr;8992  }8993  if (symbol.test(Symbol::Flag::Implicit)) {8994    Say(*base,8995        "'%s' is not an object of derived type; it is implicitly typed"_err_en_US);8996  } else {8997    SayWithDecl(8998        *base, symbol, "'%s' is not an object of derived type"_err_en_US);8999  }9000  return nullptr;9001}9002 9003bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(9004    const parser::Name &name) {9005  if (!specPartState_.declareTargetNames.empty()) {9006    if (specPartState_.declareTargetNames.count(name.source)) {9007      if (!currScope().IsTopLevel()) {9008        // Search preceding scopes until we find a matching symbol or run out9009        // of scopes to search, we skip the current scope as it's already been9010        // designated as implicit here.9011        for (auto *scope = &currScope().parent();; scope = &scope->parent()) {9012          if (Symbol * symbol{scope->FindSymbol(name.source)}) {9013            if (symbol->test(Symbol::Flag::Subroutine) ||9014                symbol->test(Symbol::Flag::Function)) {9015              const auto [sym, success]{currScope().try_emplace(9016                  symbol->name(), Attrs{}, HostAssocDetails{*symbol})};9017              assert(success &&9018                  "FindAndMarkDeclareTargetSymbol could not emplace new "9019                  "subroutine/function symbol");9020              name.symbol = &*sym->second;9021              symbol->test(Symbol::Flag::Subroutine)9022                  ? name.symbol->set(Symbol::Flag::Subroutine)9023                  : name.symbol->set(Symbol::Flag::Function);9024              return true;9025            }9026            // if we find a symbol that is not a function or subroutine, we9027            // currently escape without doing anything.9028            break;9029          }9030 9031          // This is our loop exit condition, as parent() has an inbuilt assert9032          // if you call it on a top level scope, rather than returning a null9033          // value.9034          if (scope->IsTopLevel()) {9035            return false;9036          }9037        }9038      }9039    }9040  }9041  return false;9042}9043 9044void DeclarationVisitor::Initialization(const parser::Name &name,9045    const parser::Initialization &init, bool inComponentDecl) {9046  // Traversal of the initializer was deferred to here so that the9047  // symbol being declared can be available for use in the expression, e.g.:9048  //   real, parameter :: x = tiny(x)9049  if (!name.symbol) {9050    return;9051  }9052  Symbol &ultimate{name.symbol->GetUltimate()};9053  // TODO: check C762 - all bounds and type parameters of component9054  // are colons or constant expressions if component is initialized9055  common::visit(9056      common::visitors{9057          [&](const parser::ConstantExpr &expr) {9058            Walk(expr);9059            if (IsNamedConstant(ultimate) || inComponentDecl) {9060              NonPointerInitialization(name, expr);9061            } else {9062              // Defer analysis so forward references to nested subprograms9063              // can be properly resolved when they appear in structure9064              // constructors.9065              ultimate.set(Symbol::Flag::InDataStmt);9066            }9067          },9068          [&](const std::list<Indirection<parser::DataStmtValue>> &values) {9069            Walk(values);9070            if (inComponentDecl) {9071              LegacyDataInitialization(name, values);9072            } else {9073              ultimate.set(Symbol::Flag::InDataStmt);9074            }9075          },9076          [&](const parser::NullInit &null) { // => NULL()9077            Walk(null);9078            if (auto nullInit{EvaluateExpr(null)}) {9079              if (!evaluate::IsNullPointer(&*nullInit)) { // C8139080                Say(null.v.value().source,9081                    "Pointer initializer must be intrinsic NULL()"_err_en_US);9082              } else if (IsPointer(ultimate)) {9083                if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {9084                  CHECK(!object->init());9085                  object->set_init(std::move(*nullInit));9086                } else if (auto *procPtr{9087                               ultimate.detailsIf<ProcEntityDetails>()}) {9088                  CHECK(!procPtr->init());9089                  procPtr->set_init(nullptr);9090                }9091              } else {9092                Say(name,9093                    "Non-pointer component '%s' initialized with null pointer"_err_en_US);9094              }9095            }9096          },9097          [&](const parser::InitialDataTarget &target) {9098            // Defer analysis to the end of the specification part9099            // so that forward references and attribute checks like SAVE9100            // work better.9101            if (inComponentDecl) {9102              PointerInitialization(name, target);9103            } else {9104              auto restorer{common::ScopedSet(deferImplicitTyping_, true)};9105              Walk(target);9106              ultimate.set(Symbol::Flag::InDataStmt);9107            }9108          },9109      },9110      init.u);9111}9112 9113void DeclarationVisitor::PointerInitialization(9114    const parser::Name &name, const parser::InitialDataTarget &target) {9115  if (name.symbol) {9116    Symbol &ultimate{name.symbol->GetUltimate()};9117    if (!context().HasError(ultimate)) {9118      if (IsPointer(ultimate)) {9119        Walk(target);9120        if (MaybeExpr expr{EvaluateExpr(target)}) {9121          // Validation is done in declaration checking.9122          if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {9123            CHECK(!details->init());9124            details->set_init(std::move(*expr));9125            ultimate.set(Symbol::Flag::InDataStmt, false);9126          } else if (auto *details{ultimate.detailsIf<ProcEntityDetails>()}) {9127            // something like "REAL, EXTERNAL, POINTER :: p => t"9128            if (evaluate::IsNullProcedurePointer(&*expr)) {9129              CHECK(!details->init());9130              details->set_init(nullptr);9131            } else if (const Symbol *9132                targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {9133              CHECK(!details->init());9134              details->set_init(*targetSymbol);9135            } else {9136              Say(name,9137                  "Procedure pointer '%s' must be initialized with a procedure name or NULL()"_err_en_US);9138              context().SetError(ultimate);9139            }9140          }9141        }9142      } else {9143        Say(name,9144            "'%s' is not a pointer but is initialized like one"_err_en_US);9145        context().SetError(ultimate);9146      }9147    }9148  }9149}9150void DeclarationVisitor::PointerInitialization(9151    const parser::Name &name, const parser::ProcPointerInit &target) {9152  if (name.symbol) {9153    Symbol &ultimate{name.symbol->GetUltimate()};9154    if (!context().HasError(ultimate)) {9155      if (IsProcedurePointer(ultimate)) {9156        auto &details{ultimate.get<ProcEntityDetails>()};9157        if (details.init()) {9158          Say(name, "'%s' was previously initialized"_err_en_US);9159          context().SetError(ultimate);9160        } else if (const auto *targetName{9161                       std::get_if<parser::Name>(&target.u)}) {9162          Walk(target);9163          if (!CheckUseError(*targetName) && targetName->symbol) {9164            // Validation is done in declaration checking.9165            details.set_init(*targetName->symbol);9166          }9167        } else { // explicit NULL9168          details.set_init(nullptr);9169        }9170      } else {9171        Say(name,9172            "'%s' is not a procedure pointer but is initialized like one"_err_en_US);9173        context().SetError(ultimate);9174      }9175    }9176  }9177}9178 9179bool DeclarationVisitor::CheckNonPointerInitialization(9180    const parser::Name &name, bool inLegacyDataInitialization) {9181  if (!context().HasError(name.symbol)) {9182    Symbol &ultimate{name.symbol->GetUltimate()};9183    if (!context().HasError(ultimate)) {9184      if (IsPointer(ultimate) && !inLegacyDataInitialization) {9185        Say(name,9186            "'%s' is a pointer but is not initialized like one"_err_en_US);9187      } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {9188        if (details->init()) {9189          SayWithDecl(name, *name.symbol,9190              "'%s' has already been initialized"_err_en_US);9191        } else if (IsAllocatable(ultimate)) {9192          Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);9193        } else if (details->isCDefined()) {9194          // CDEFINED variables cannot have initializer, because their storage9195          // may come outside of Fortran.9196          Say(name, "CDEFINED variable cannot be initialized"_err_en_US);9197        } else {9198          return true;9199        }9200      } else {9201        Say(name, "'%s' is not an object that can be initialized"_err_en_US);9202      }9203    }9204  }9205  return false;9206}9207 9208void DeclarationVisitor::NonPointerInitialization(9209    const parser::Name &name, const parser::ConstantExpr &constExpr) {9210  if (CheckNonPointerInitialization(9211          name, /*inLegacyDataInitialization=*/false)) {9212    Symbol &ultimate{name.symbol->GetUltimate()};9213    auto &details{ultimate.get<ObjectEntityDetails>()};9214    const auto &expr{parser::UnwrapRef<parser::Expr>(constExpr)};9215    if (ultimate.owner().IsParameterizedDerivedType()) {9216      // Save the expression for per-instantiation analysis.9217      details.set_unanalyzedPDTComponentInit(&expr);9218    } else if (MaybeExpr folded{EvaluateNonPointerInitializer(9219                   ultimate, constExpr, expr.source)}) {9220      details.set_init(std::move(*folded));9221      ultimate.set(Symbol::Flag::InDataStmt, false);9222    }9223  }9224}9225 9226void DeclarationVisitor::LegacyDataInitialization(const parser::Name &name,9227    const std::list<common::Indirection<parser::DataStmtValue>> &values) {9228  if (CheckNonPointerInitialization(9229          name, /*inLegacyDataInitialization=*/true)) {9230    Symbol &ultimate{name.symbol->GetUltimate()};9231    if (ultimate.owner().IsParameterizedDerivedType()) {9232      Say(name,9233          "Component '%s' in a parameterized data type may not be initialized with a legacy DATA-style value list"_err_en_US,9234          name.source);9235    } else {9236      evaluate::ExpressionAnalyzer exprAnalyzer{context()};9237      for (const auto &value : values) {9238        exprAnalyzer.Analyze(value.value());9239      }9240      DataInitializations inits;9241      auto oldSize{ultimate.size()};9242      if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(9243              ultimate, GetFoldingContext())}) {9244        if (auto size{evaluate::ToInt64(9245                chars->MeasureSizeInBytes(GetFoldingContext()))}) {9246          // Temporarily set the byte size of the component so that we don't9247          // get bogus "initialization out of range" errors below.9248          ultimate.set_size(*size);9249        }9250      }9251      AccumulateDataInitializations(inits, exprAnalyzer, ultimate, values);9252      ConvertToInitializers(inits, exprAnalyzer);9253      ultimate.set_size(oldSize);9254    }9255  }9256}9257 9258void ResolveNamesVisitor::HandleCall(9259    Symbol::Flag procFlag, const parser::Call &call) {9260  common::visit(9261      common::visitors{9262          [&](const parser::Name &x) { HandleProcedureName(procFlag, x); },9263          [&](const parser::ProcComponentRef &x) {9264            Walk(x);9265            const parser::Name &name{x.v.thing.component};9266            if (Symbol * symbol{name.symbol}) {9267              if (IsProcedure(*symbol)) {9268                SetProcFlag(name, *symbol, procFlag);9269              }9270            }9271          },9272      },9273      std::get<parser::ProcedureDesignator>(call.t).u);9274  const auto &arguments{std::get<std::list<parser::ActualArgSpec>>(call.t)};9275  Walk(arguments);9276  // Once an object has appeared in a specification function reference as9277  // a whole scalar actual argument, it cannot be (re)dimensioned later.9278  // The fact that it appeared to be a scalar may determine the resolution9279  // or the result of an inquiry intrinsic function or generic procedure.9280  if (inSpecificationPart_) {9281    for (const auto &argSpec : arguments) {9282      const auto &actual{std::get<parser::ActualArg>(argSpec.t)};9283      if (const auto *expr{9284              std::get_if<common::Indirection<parser::Expr>>(&actual.u)}) {9285        if (const auto *designator{9286                std::get_if<common::Indirection<parser::Designator>>(9287                    &expr->value().u)}) {9288          if (const auto *dataRef{9289                  std::get_if<parser::DataRef>(&designator->value().u)}) {9290            if (const auto *name{std::get_if<parser::Name>(&dataRef->u)};9291                name && name->symbol) {9292              const Symbol &symbol{*name->symbol};9293              const auto *object{symbol.detailsIf<ObjectEntityDetails>()};9294              if (symbol.has<EntityDetails>() ||9295                  (object && !object->IsArray())) {9296                NoteScalarSpecificationArgument(symbol);9297              }9298            }9299          }9300        }9301      }9302    }9303  }9304}9305 9306void ResolveNamesVisitor::HandleProcedureName(9307    Symbol::Flag flag, const parser::Name &name) {9308  CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);9309  auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};9310  if (!symbol) {9311    if (IsIntrinsic(name.source, flag)) {9312      symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});9313      SetImplicitAttr(*symbol, Attr::INTRINSIC);9314    } else if (const auto ppcBuiltinScope =9315                   currScope().context().GetPPCBuiltinsScope()) {9316      // Check if it is a builtin from the predefined module9317      symbol = FindSymbol(*ppcBuiltinScope, name);9318      if (!symbol) {9319        symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});9320      }9321    } else {9322      symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});9323    }9324    Resolve(name, *symbol);9325    ConvertToProcEntity(*symbol, name.source);9326    if (!symbol->attrs().test(Attr::INTRINSIC)) {9327      if (CheckImplicitNoneExternal(name.source, *symbol)) {9328        MakeExternal(*symbol);9329        // Create a place-holder HostAssocDetails symbol to preclude later9330        // use of this name as a local symbol; but don't actually use this new9331        // HostAssocDetails symbol in expressions.9332        MakeHostAssocSymbol(name, *symbol);9333        name.symbol = symbol;9334      }9335    }9336    CheckEntryDummyUse(name.source, symbol);9337    SetProcFlag(name, *symbol, flag);9338  } else if (CheckUseError(name)) {9339    // error was reported9340  } else {9341    symbol = &symbol->GetUltimate();9342    if (!name.symbol ||9343        (name.symbol->has<HostAssocDetails>() && symbol->owner().IsGlobal() &&9344            (symbol->has<ProcEntityDetails>() ||9345                (symbol->has<SubprogramDetails>() &&9346                    symbol->scope() /*not ENTRY*/)))) {9347      name.symbol = symbol;9348    }9349    CheckEntryDummyUse(name.source, symbol);9350    bool convertedToProcEntity{ConvertToProcEntity(*symbol, name.source)};9351    if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&9352        IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {9353      AcquireIntrinsicProcedureFlags(*symbol);9354    }9355    if (!SetProcFlag(name, *symbol, flag)) {9356      return; // reported error9357    }9358    CheckImplicitNoneExternal(name.source, *symbol);9359    if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||9360        symbol->has<AssocEntityDetails>()) {9361      // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted9362      // here as procedure-designators because this means the related9363      // FunctionReference are mis-parsed structure constructors or array9364      // references that will be fixed later when analyzing expressions.9365    } else if (symbol->has<ObjectEntityDetails>()) {9366      // Symbols with ObjectEntityDetails are also accepted because this can be9367      // a mis-parsed array reference that will be fixed later. Ensure that if9368      // this is a symbol from a host procedure, a symbol with HostAssocDetails9369      // is created for the current scope.9370      // Operate on non ultimate symbol so that HostAssocDetails are also9371      // created for symbols used associated in the host procedure.9372      ResolveName(name);9373    } else if (symbol->test(Symbol::Flag::Implicit)) {9374      Say(name,9375          "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);9376    } else {9377      SayWithDecl(name, *symbol,9378          "Use of '%s' as a procedure conflicts with its declaration"_err_en_US);9379    }9380  }9381}9382 9383bool ResolveNamesVisitor::CheckImplicitNoneExternal(9384    const SourceName &name, const Symbol &symbol) {9385  if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&9386      !symbol.attrs().test(Attr::EXTERNAL) &&9387      !symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) {9388    Say(name,9389        "'%s' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);9390    return false;9391  }9392  return true;9393}9394 9395// Variant of HandleProcedureName() for use while skimming the executable9396// part of a subprogram to catch calls to dummy procedures that are part9397// of the subprogram's interface, and to mark as procedures any symbols9398// that might otherwise have been miscategorized as objects.9399void ResolveNamesVisitor::NoteExecutablePartCall(9400    Symbol::Flag flag, SourceName name, bool hasCUDAChevrons) {9401  // Subtlety: The symbol pointers in the parse tree are not set, because9402  // they might end up resolving elsewhere (e.g., construct entities in9403  // SELECT TYPE).9404  if (Symbol * symbol{currScope().FindSymbol(name)}) {9405    Symbol::Flag other{flag == Symbol::Flag::Subroutine9406            ? Symbol::Flag::Function9407            : Symbol::Flag::Subroutine};9408    if (!symbol->test(other)) {9409      ConvertToProcEntity(*symbol, name);9410      if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {9411        symbol->set(flag);9412        if (IsDummy(*symbol)) {9413          SetImplicitAttr(*symbol, Attr::EXTERNAL);9414        }9415        ApplyImplicitRules(*symbol);9416        if (hasCUDAChevrons) {9417          details->set_isCUDAKernel();9418        }9419      }9420    }9421  }9422}9423 9424static bool IsLocallyImplicitGlobalSymbol(9425    const Symbol &symbol, const parser::Name &localName) {9426  if (symbol.owner().IsGlobal()) {9427    const auto *subp{symbol.detailsIf<SubprogramDetails>()};9428    const Scope *scope{9429        subp && subp->entryScope() ? subp->entryScope() : symbol.scope()};9430    return !(scope && scope->sourceRange().Contains(localName.source));9431  }9432  return false;9433}9434 9435// Check and set the Function or Subroutine flag on symbol; false on error.9436bool ResolveNamesVisitor::SetProcFlag(9437    const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {9438  if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {9439    SayWithDecl(9440        name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);9441    context().SetError(symbol);9442    return false;9443  } else if (symbol.test(Symbol::Flag::Subroutine) &&9444      flag == Symbol::Flag::Function) {9445    SayWithDecl(9446        name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);9447    context().SetError(symbol);9448    return false;9449  } else if (flag == Symbol::Flag::Function &&9450      IsLocallyImplicitGlobalSymbol(symbol, name) &&9451      TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) {9452    SayWithDecl(name, symbol,9453        "Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);9454    return false;9455  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {9456    if (IsPointer(symbol) && !proc->type() && !proc->procInterface()) {9457      // PROCEDURE(), POINTER -- errors will be emitted later about a lack9458      // of known characteristics if used as a function9459    } else {9460      symbol.set(flag); // in case it hasn't been set yet9461      if (flag == Symbol::Flag::Function) {9462        ApplyImplicitRules(symbol);9463      }9464      if (symbol.attrs().test(Attr::INTRINSIC)) {9465        AcquireIntrinsicProcedureFlags(symbol);9466      }9467    }9468  } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {9469    SayWithDecl(9470        name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);9471    context().SetError(symbol);9472  } else if (symbol.attrs().test(Attr::INTRINSIC)) {9473    AcquireIntrinsicProcedureFlags(symbol);9474  }9475  return true;9476}9477 9478bool ModuleVisitor::Pre(const parser::AccessStmt &x) {9479  Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))};9480  if (!currScope().IsModule()) { // C8699481    Say(currStmtSource().value(),9482        "%s statement may only appear in the specification part of a module"_err_en_US,9483        EnumToString(accessAttr));9484    return false;9485  }9486  const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)};9487  if (accessIds.empty()) {9488    if (prevAccessStmt_) { // C8699489      Say("The default accessibility of this module has already been declared"_err_en_US)9490          .Attach(*prevAccessStmt_, "Previous declaration"_en_US);9491    }9492    prevAccessStmt_ = currStmtSource();9493    auto *moduleDetails{DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};9494    DEREF(moduleDetails).set_isDefaultPrivate(accessAttr == Attr::PRIVATE);9495  } else {9496    for (const auto &accessId : accessIds) {9497      GenericSpecInfo info{accessId.v.value()};9498      auto *symbol{FindInScope(info.symbolName())};9499      if (!symbol && !info.kind().IsName()) {9500        symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{});9501      }9502      info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol));9503    }9504  }9505  return false;9506}9507 9508// Set the access specification for this symbol.9509Symbol &ModuleVisitor::SetAccess(9510    const SourceName &name, Attr attr, Symbol *symbol) {9511  if (!symbol) {9512    symbol = &MakeSymbol(name);9513  }9514  Attrs &attrs{symbol->attrs()};9515  if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {9516    // PUBLIC/PRIVATE already set: make it a fatal error if it changed9517    Attr prev{attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE};9518    if (attr != prev) {9519      Say(name,9520          "The accessibility of '%s' has already been specified as %s"_err_en_US,9521          MakeOpName(name), EnumToString(prev));9522    } else {9523      context().Warn(common::LanguageFeature::RedundantAttribute, name,9524          "The accessibility of '%s' has already been specified as %s"_warn_en_US,9525          MakeOpName(name), EnumToString(prev));9526    }9527  } else {9528    attrs.set(attr);9529  }9530  return *symbol;9531}9532 9533static bool NeedsExplicitType(const Symbol &symbol) {9534  if (symbol.has<UnknownDetails>()) {9535    return true;9536  } else if (const auto *details{symbol.detailsIf<EntityDetails>()}) {9537    return !details->type();9538  } else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {9539    return !details->type();9540  } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {9541    return !details->procInterface() && !details->type();9542  } else {9543    return false;9544  }9545}9546 9547void ResolveNamesVisitor::HandleDerivedTypesInImplicitStmts(9548    const parser::ImplicitPart &implicitPart,9549    const std::list<parser::DeclarationConstruct> &decls) {9550  // Detect derived type definitions and create symbols for them now if9551  // they appear in IMPLICIT statements so that these forward-looking9552  // references will not be ambiguous with host associations.9553  std::set<SourceName> implicitDerivedTypes;9554  for (const auto &ipStmt : implicitPart.v) {9555    if (const auto *impl{std::get_if<9556            parser::Statement<common::Indirection<parser::ImplicitStmt>>>(9557            &ipStmt.u)}) {9558      if (const auto *specs{std::get_if<std::list<parser::ImplicitSpec>>(9559              &impl->statement.value().u)}) {9560        for (const auto &spec : *specs) {9561          const auto &declTypeSpec{9562              std::get<parser::DeclarationTypeSpec>(spec.t)};9563          if (const auto *dtSpec{common::visit(9564                  common::visitors{9565                      [](const parser::DeclarationTypeSpec::Type &x) {9566                        return &x.derived;9567                      },9568                      [](const parser::DeclarationTypeSpec::Class &x) {9569                        return &x.derived;9570                      },9571                      [](const auto &) -> const parser::DerivedTypeSpec * {9572                        return nullptr;9573                      }},9574                  declTypeSpec.u)}) {9575            implicitDerivedTypes.emplace(9576                std::get<parser::Name>(dtSpec->t).source);9577          }9578        }9579      }9580    }9581  }9582  if (!implicitDerivedTypes.empty()) {9583    for (const auto &decl : decls) {9584      if (const auto *spec{9585              std::get_if<parser::SpecificationConstruct>(&decl.u)}) {9586        if (const auto *dtDef{9587                std::get_if<common::Indirection<parser::DerivedTypeDef>>(9588                    &spec->u)}) {9589          const parser::DerivedTypeStmt &dtStmt{9590              std::get<parser::Statement<parser::DerivedTypeStmt>>(9591                  dtDef->value().t)9592                  .statement};9593          const parser::Name &name{std::get<parser::Name>(dtStmt.t)};9594          if (implicitDerivedTypes.find(name.source) !=9595                  implicitDerivedTypes.end() &&9596              !FindInScope(name)) {9597            DerivedTypeDetails details;9598            details.set_isForwardReferenced(true);9599            Resolve(name, MakeSymbol(name, std::move(details)));9600            implicitDerivedTypes.erase(name.source);9601          }9602        }9603      }9604    }9605  }9606}9607 9608bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {9609  const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,9610      implicitPart, decls] = x.t;9611  auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};9612  auto stateRestorer{9613      common::ScopedSet(specPartState_, SpecificationPartState{})};9614  Walk(accDecls);9615  Walk(ompDecls);9616  Walk(compilerDirectives);9617  for (const auto &useStmt : useStmts) {9618    CollectUseRenames(useStmt.statement.value());9619  }9620  Walk(useStmts);9621  UseCUDABuiltinNames();9622  ClearUseRenames();9623  ClearUseOnly();9624  ClearModuleUses();9625  Walk(importStmts);9626  HandleDerivedTypesInImplicitStmts(implicitPart, decls);9627  Walk(implicitPart);9628  for (const auto &decl : decls) {9629    if (const auto *spec{9630            std::get_if<parser::SpecificationConstruct>(&decl.u)}) {9631      PreSpecificationConstruct(*spec);9632    }9633  }9634  Walk(decls);9635  FinishSpecificationPart(decls);9636  return false;9637}9638 9639void ResolveNamesVisitor::UseCUDABuiltinNames() {9640  if (FindCUDADeviceContext(&currScope())) {9641    for (const auto &[name, symbol] : context().GetCUDABuiltinsScope()) {9642      if (!FindInScope(name)) {9643        auto &localSymbol{MakeSymbol(name)};9644        localSymbol.set_details(UseDetails{name, *symbol});9645        localSymbol.flags() = symbol->flags();9646      }9647    }9648  }9649}9650 9651// Initial processing on specification constructs, before visiting them.9652void ResolveNamesVisitor::PreSpecificationConstruct(9653    const parser::SpecificationConstruct &spec) {9654  common::visit(9655      common::visitors{9656          [&](const parser::Statement<9657              common::Indirection<parser::TypeDeclarationStmt>> &y) {9658            EarlyDummyTypeDeclaration(y);9659          },9660          [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {9661            CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));9662          },9663          [&](const Indirection<parser::InterfaceBlock> &y) {9664            const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(9665                y.value().t)};9666            if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) {9667              CreateGeneric(*spec);9668            }9669          },9670          [&](const parser::Statement<parser::OtherSpecificationStmt> &y) {9671            common::visit(9672                common::visitors{9673                    [&](const common::Indirection<parser::CommonStmt> &z) {9674                      CreateCommonBlockSymbols(z.value());9675                    },9676                    [&](const common::Indirection<parser::TargetStmt> &z) {9677                      CreateObjectSymbols(z.value().v, Attr::TARGET);9678                    },9679                    [](const auto &) {},9680                },9681                y.statement.u);9682          },9683          [](const auto &) {},9684      },9685      spec.u);9686}9687 9688void ResolveNamesVisitor::EarlyDummyTypeDeclaration(9689    const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>9690        &stmt) {9691  context().set_location(stmt.source);9692  const auto &[declTypeSpec, attrs, entities] = stmt.statement.value().t;9693  if (const auto *intrin{9694          std::get_if<parser::IntrinsicTypeSpec>(&declTypeSpec.u)}) {9695    if (const auto *intType{std::get_if<parser::IntegerTypeSpec>(&intrin->u)}) {9696      if (const auto &kind{intType->v}) {9697        if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&9698            !parser::Unwrap<parser::IntLiteralConstant>(*kind)) {9699          return;9700        }9701      }9702      const DeclTypeSpec *type{nullptr};9703      for (const auto &ent : entities) {9704        const auto &objName{std::get<parser::ObjectName>(ent.t)};9705        Resolve(objName, FindInScope(currScope(), objName));9706        if (Symbol * symbol{objName.symbol};9707            symbol && IsDummy(*symbol) && NeedsType(*symbol)) {9708          if (!type) {9709            type = ProcessTypeSpec(declTypeSpec);9710            if (!type || !type->IsNumeric(TypeCategory::Integer)) {9711              break;9712            }9713          }9714          symbol->SetType(*type);9715          NoteEarlyDeclaredDummyArgument(*symbol);9716          // Set the Implicit flag to disable bogus errors from9717          // being emitted later when this declaration is processed9718          // again normally.9719          symbol->set(Symbol::Flag::Implicit);9720        }9721      }9722    }9723  }9724}9725 9726void ResolveNamesVisitor::CreateCommonBlockSymbols(9727    const parser::CommonStmt &commonStmt) {9728  for (const parser::CommonStmt::Block &block : commonStmt.blocks) {9729    const auto &[name, objects] = block.t;9730    Symbol &commonBlock{MakeCommonBlockSymbol(name, commonStmt.source)};9731    for (const auto &object : objects) {9732      Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};9733      if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {9734        details->set_commonBlock(commonBlock);9735        commonBlock.get<CommonBlockDetails>().add_object(obj);9736      }9737    }9738  }9739}9740 9741void ResolveNamesVisitor::CreateObjectSymbols(9742    const std::list<parser::ObjectDecl> &decls, Attr attr) {9743  for (const parser::ObjectDecl &decl : decls) {9744    SetImplicitAttr(DeclareEntity<ObjectEntityDetails>(9745                        std::get<parser::ObjectName>(decl.t), Attrs{}),9746        attr);9747  }9748}9749 9750void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {9751  auto info{GenericSpecInfo{x}};9752  SourceName symbolName{info.symbolName()};9753  if (IsLogicalConstant(context(), symbolName)) {9754    Say(symbolName,9755        "Logical constant '%s' may not be used as a defined operator"_err_en_US);9756    return;9757  }9758  GenericDetails genericDetails;9759  Symbol *existing{nullptr};9760  // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"9761  for (const std::string &n : GetAllNames(context(), symbolName)) {9762    existing = currScope().FindSymbol(SourceName{n});9763    if (existing) {9764      break;9765    }9766  }9767  if (existing) {9768    Symbol &ultimate{existing->GetUltimate()};9769    if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {9770      if (&existing->owner() == &currScope()) {9771        if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {9772          // Create a local copy of a use associated generic so that9773          // it can be locally extended without corrupting the original.9774          genericDetails.CopyFrom(*existingGeneric);9775          if (existingGeneric->specific()) {9776            genericDetails.set_specific(*existingGeneric->specific());9777          }9778          AddGenericUse(9779              genericDetails, existing->name(), existingUse->symbol());9780        } else if (existing == &ultimate) {9781          // Extending an extant generic in the same scope9782          info.Resolve(existing);9783          return;9784        } else {9785          // Host association of a generic is handled elsewhere9786          CHECK(existing->has<HostAssocDetails>());9787        }9788      } else {9789        // Create a new generic for this scope.9790      }9791    } else if (ultimate.has<SubprogramDetails>() ||9792        ultimate.has<SubprogramNameDetails>()) {9793      genericDetails.set_specific(*existing);9794    } else if (ultimate.has<ProcEntityDetails>()) {9795      if (existing->name() != symbolName ||9796          !ultimate.attrs().test(Attr::INTRINSIC)) {9797        genericDetails.set_specific(*existing);9798      }9799    } else if (ultimate.has<DerivedTypeDetails>()) {9800      genericDetails.set_derivedType(*existing);9801    } else if (&existing->owner() == &currScope()) {9802      SayAlreadyDeclared(symbolName, *existing);9803      return;9804    }9805    if (&existing->owner() == &currScope()) {9806      EraseSymbol(*existing);9807    }9808  }9809  info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));9810}9811 9812void ResolveNamesVisitor::FinishSpecificationPart(9813    const std::list<parser::DeclarationConstruct> &decls) {9814  misparsedStmtFuncFound_ = false;9815  funcResultStack().CompleteFunctionResultType();9816  CheckImports();9817  for (auto &pair : currScope()) {9818    auto &symbol{*pair.second};9819    if (inInterfaceBlock()) {9820      ConvertToObjectEntity(symbol);9821    }9822    if (NeedsExplicitType(symbol)) {9823      ApplyImplicitRules(symbol);9824    }9825    if (IsDummy(symbol) && isImplicitNoneType() &&9826        symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {9827      Say(symbol.name(),9828          "No explicit type declared for dummy argument '%s'"_err_en_US);9829      context().SetError(symbol);9830    }9831    if (symbol.has<GenericDetails>()) {9832      CheckGenericProcedures(symbol);9833    }9834    if (!symbol.has<HostAssocDetails>()) {9835      CheckPossibleBadForwardRef(symbol);9836    }9837    // Propagate BIND(C) attribute to procedure entities from their interfaces,9838    // but not the NAME=, even if it is empty (which would be a reasonable9839    // and useful behavior, actually).  This interpretation is not at all9840    // clearly described in the standard, but matches the behavior of several9841    // other compilers.9842    if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&9843        !proc->isDummy() && !IsPointer(symbol) &&9844        !symbol.attrs().test(Attr::BIND_C)) {9845      if (const Symbol * iface{proc->procInterface()};9846          iface && IsBindCProcedure(*iface)) {9847        SetImplicitAttr(symbol, Attr::BIND_C);9848        SetBindNameOn(symbol);9849      }9850    }9851  }9852  currScope().InstantiateDerivedTypes();9853  for (const auto &decl : decls) {9854    if (const auto *statement{std::get_if<9855            parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(9856            &decl.u)}) {9857      messageHandler().set_currStmtSource(statement->source);9858      AnalyzeStmtFunctionStmt(statement->statement.value());9859    }9860  }9861  // TODO: what about instantiations in BLOCK?9862  CheckSaveStmts();9863  CheckCommonBlocks();9864  if (!inInterfaceBlock()) {9865    // TODO: warn for the case where the EQUIVALENCE statement is in a9866    // procedure declaration in an interface block9867    CheckEquivalenceSets();9868  }9869}9870 9871// Analyze the bodies of statement functions now that the symbols in this9872// specification part have been fully declared and implicitly typed.9873// (Statement function references are not allowed in specification9874// expressions, so it's safe to defer processing their definitions.)9875void ResolveNamesVisitor::AnalyzeStmtFunctionStmt(9876    const parser::StmtFunctionStmt &stmtFunc) {9877  const auto &name{std::get<parser::Name>(stmtFunc.t)};9878  Symbol *symbol{name.symbol};9879  auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr};9880  if (!details || !symbol->scope() ||9881      &symbol->scope()->parent() != &currScope() || details->isInterface() ||9882      details->isDummy() || details->entryScope() ||9883      details->moduleInterface() || symbol->test(Symbol::Flag::Subroutine)) {9884    return; // error recovery9885  }9886  // Resolve the symbols on the RHS of the statement function.9887  PushScope(*symbol->scope());9888  const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)};9889  Walk(parsedExpr);9890  PopScope();9891  if (auto expr{AnalyzeExpr(context(), stmtFunc)}) {9892    if (auto type{evaluate::DynamicType::From(*symbol)}) {9893      if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) {9894        details->set_stmtFunction(std::move(*converted));9895      } else {9896        Say(name.source,9897            "Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US,9898            name.source, type->AsFortran());9899      }9900    } else {9901      details->set_stmtFunction(std::move(*expr));9902    }9903  }9904  if (!details->stmtFunction()) {9905    context().SetError(*symbol);9906  }9907}9908 9909void ResolveNamesVisitor::CheckImports() {9910  auto &scope{currScope()};9911  switch (scope.GetImportKind()) {9912  case common::ImportKind::None:9913    break;9914  case common::ImportKind::All:9915    // C8102: all entities in host must not be hidden9916    for (const auto &pair : scope.parent()) {9917      auto &name{pair.first};9918      std::optional<SourceName> scopeName{scope.GetName()};9919      if (!scopeName || name != *scopeName) {9920        CheckImport(prevImportStmt_.value(), name);9921      }9922    }9923    break;9924  case common::ImportKind::Default:9925  case common::ImportKind::Only:9926    // C8102: entities named in IMPORT must not be hidden9927    for (auto &name : scope.importNames()) {9928      CheckImport(name, name);9929    }9930    break;9931  }9932}9933 9934void ResolveNamesVisitor::CheckImport(9935    const SourceName &location, const SourceName &name) {9936  if (auto *symbol{FindInScope(name)}) {9937    const Symbol &ultimate{symbol->GetUltimate()};9938    if (&ultimate.owner() == &currScope()) {9939      Say(location, "'%s' from host is not accessible"_err_en_US, name)9940          .Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US,9941              symbol->name());9942    }9943  }9944}9945 9946bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {9947  return CheckNotInBlock("IMPLICIT") && // C11079948      ImplicitRulesVisitor::Pre(x);9949}9950 9951void ResolveNamesVisitor::Post(const parser::PointerObject &x) {9952  common::visit(common::visitors{9953                    [&](const parser::Name &x) { ResolveName(x); },9954                    [&](const parser::StructureComponent &x) {9955                      ResolveStructureComponent(x);9956                    },9957                },9958      x.u);9959}9960void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {9961  common::visit(common::visitors{9962                    [&](const parser::Name &x) { ResolveName(x); },9963                    [&](const parser::StructureComponent &x) {9964                      ResolveStructureComponent(x);9965                    },9966                },9967      x.u);9968}9969 9970bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {9971  const auto &dataRef{std::get<parser::DataRef>(x.t)};9972  const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};9973  const auto &expr{std::get<parser::Expr>(x.t)};9974  ResolveDataRef(dataRef);9975  Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};9976  Walk(bounds);9977  // Resolve unrestricted specific intrinsic procedures as in "p => cos".9978  if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {9979    if (NameIsKnownOrIntrinsic(*name)) {9980      if (Symbol * symbol{name->symbol}) {9981        if (IsProcedurePointer(ptrSymbol) &&9982            !ptrSymbol->test(Symbol::Flag::Function) &&9983            !ptrSymbol->test(Symbol::Flag::Subroutine)) {9984          if (symbol->test(Symbol::Flag::Function)) {9985            ApplyImplicitRules(*ptrSymbol);9986          }9987        }9988        // If the name is known because it is an object entity from a host9989        // procedure, create a host associated symbol.9990        if (symbol->GetUltimate().has<ObjectEntityDetails>() &&9991            IsUplevelReference(*symbol)) {9992          MakeHostAssocSymbol(*name, *symbol);9993        }9994      }9995      return false;9996    }9997    // Can also reference a global external procedure here9998    if (auto it{context().globalScope().find(name->source)};9999        it != context().globalScope().end()) {10000      Symbol &global{*it->second};10001      if (IsProcedure(global)) {10002        Resolve(*name, global);10003        return false;10004      }10005    }10006    if (IsProcedurePointer(parser::GetLastName(dataRef).symbol) &&10007        !FindSymbol(*name)) {10008      // Unknown target of procedure pointer must be an external procedure10009      Symbol &symbol{MakeSymbol(10010          context().globalScope(), name->source, Attrs{Attr::EXTERNAL})};10011      symbol.implicitAttrs().set(Attr::EXTERNAL);10012      Resolve(*name, symbol);10013      ConvertToProcEntity(symbol, name->source);10014      return false;10015    }10016  }10017  Walk(expr);10018  return false;10019}10020void ResolveNamesVisitor::Post(const parser::Designator &x) {10021  ResolveDesignator(x);10022}10023void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) {10024  Walk(std::get<parser::SubstringRange>(x.v.t).t);10025  ResolveDataRef(std::get<parser::DataRef>(x.v.t));10026}10027 10028void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {10029  ResolveStructureComponent(x.v.thing);10030}10031void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {10032  DeclTypeSpecVisitor::Post(x);10033  ConstructVisitor::Post(x);10034}10035bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {10036  if (HandleStmtFunction(x)) {10037    return false;10038  } else {10039    // This is an array element or pointer-valued function assignment:10040    // resolve the names of indices/arguments10041    const auto &names{std::get<std::list<parser::Name>>(x.t)};10042    for (auto &name : names) {10043      ResolveName(name);10044    }10045    return true;10046  }10047}10048 10049bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {10050  const parser::Name &name{x.v};10051  if (FindSymbol(name)) {10052    // OK10053  } else if (IsLogicalConstant(context(), name.source)) {10054    Say(name,10055        "Logical constant '%s' may not be used as a defined operator"_err_en_US);10056  } else {10057    // Resolved later in expression semantics10058    MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);10059  }10060  return false;10061}10062 10063void ResolveNamesVisitor::Post(const parser::AssignStmt &x) {10064  if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {10065    CheckEntryDummyUse(name->source, name->symbol);10066    ConvertToObjectEntity(DEREF(name->symbol));10067  }10068}10069void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {10070  if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {10071    CheckEntryDummyUse(name->source, name->symbol);10072    ConvertToObjectEntity(DEREF(name->symbol));10073  }10074}10075 10076void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {10077  if (std::holds_alternative<parser::CompilerDirective::VectorAlways>(x.u) ||10078      std::holds_alternative<parser::CompilerDirective::Unroll>(x.u) ||10079      std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(x.u) ||10080      std::holds_alternative<parser::CompilerDirective::NoVector>(x.u) ||10081      std::holds_alternative<parser::CompilerDirective::NoUnroll>(x.u) ||10082      std::holds_alternative<parser::CompilerDirective::NoUnrollAndJam>(x.u) ||10083      std::holds_alternative<parser::CompilerDirective::ForceInline>(x.u) ||10084      std::holds_alternative<parser::CompilerDirective::Inline>(x.u) ||10085      std::holds_alternative<parser::CompilerDirective::Prefetch>(x.u) ||10086      std::holds_alternative<parser::CompilerDirective::NoInline>(x.u) ||10087      std::holds_alternative<parser::CompilerDirective::IVDep>(x.u)) {10088    return;10089  }10090  if (const auto *tkr{10091          std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) {10092    if (currScope().IsTopLevel() ||10093        GetProgramUnitContaining(currScope()).kind() !=10094            Scope::Kind::Subprogram) {10095      Say(x.source,10096          "!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US);10097      return;10098    }10099    if (!inSpecificationPart_) {10100      Say(x.source,10101          "!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US);10102      return;10103    }10104    if (tkr->empty()) {10105      Symbol *symbol{currScope().symbol()};10106      if (SubprogramDetails *10107          subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) {10108        subp->set_defaultIgnoreTKR(true);10109      }10110    } else {10111      for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) {10112        common::IgnoreTKRSet set;10113        if (const auto &maybeList{10114                std::get<std::optional<std::list<const char *>>>(item.t)}) {10115          for (const char *p : *maybeList) {10116            if (p) {10117              switch (*p) {10118              case 't':10119                set.set(common::IgnoreTKR::Type);10120                break;10121              case 'k':10122                set.set(common::IgnoreTKR::Kind);10123                break;10124              case 'r':10125                set.set(common::IgnoreTKR::Rank);10126                break;10127              case 'd':10128                set.set(common::IgnoreTKR::Device);10129                break;10130              case 'm':10131                set.set(common::IgnoreTKR::Managed);10132                break;10133              case 'c':10134                set.set(common::IgnoreTKR::Contiguous);10135                break;10136              case 'p':10137                set.set(common::IgnoreTKR::Pointer);10138                break;10139              case 'a':10140                set = common::ignoreTKRAll;10141                break;10142              default:10143                Say(x.source,10144                    "'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US,10145                    *p);10146                set = common::ignoreTKRAll;10147                break;10148              }10149            }10150          }10151          if (set.empty()) {10152            Say(x.source,10153                "!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US);10154          }10155        } else { // no (list)10156          set = common::ignoreTKRAll;10157          ;10158        }10159        const auto &name{std::get<parser::Name>(item.t)};10160        Symbol *symbol{FindSymbol(name)};10161        if (!symbol) {10162          symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{});10163        }10164        if (symbol->owner() != currScope()) {10165          SayWithDecl(10166              name, *symbol, "'%s' must be local to this subprogram"_err_en_US);10167        } else {10168          ConvertToObjectEntity(*symbol);10169          if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) {10170            object->set_ignoreTKR(set);10171          } else {10172            SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US);10173          }10174        }10175      }10176    }10177  } else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) {10178    Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US)10179        .set_usageWarning(common::UsageWarning::IgnoredDirective);10180  }10181}10182 10183bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {10184  if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(10185          x.u)) {10186    // TODO: global directives10187    return true;10188  }10189  if (std::holds_alternative<10190          common::Indirection<parser::OpenACCRoutineConstruct>>(x.u)) {10191    ResolveAccParts(context(), x, &topScope_);10192    return false;10193  }10194  ProgramTree &root{ProgramTree::Build(x, context())};10195  SetScope(topScope_);10196  ResolveSpecificationParts(root);10197  FinishSpecificationParts(root);10198  ResolveExecutionParts(root);10199  FinishExecutionParts(root);10200  ResolveAccParts(context(), x, /*topScope=*/nullptr);10201  ResolveOmpParts(context(), x);10202  return false;10203}10204 10205template <typename A> std::set<SourceName> GetUses(const A &x) {10206  std::set<SourceName> uses;10207  if constexpr (!std::is_same_v<A, parser::CompilerDirective> &&10208      !std::is_same_v<A, parser::OpenACCRoutineConstruct>) {10209    const auto &spec{std::get<parser::SpecificationPart>(x.t)};10210    const auto &unitUses{std::get<10211        std::list<parser::Statement<common::Indirection<parser::UseStmt>>>>(10212        spec.t)};10213    for (const auto &u : unitUses) {10214      uses.insert(u.statement.value().moduleName.source);10215    }10216  }10217  return uses;10218}10219 10220bool ResolveNamesVisitor::Pre(const parser::Program &x) {10221  if (Scope * hermetic{context().currentHermeticModuleFileScope()}) {10222    // Processing either the dependent modules or first module of a10223    // hermetic module file; ensure that the hermetic module scope has10224    // its implicit rules map entry.10225    ImplicitRulesVisitor::BeginScope(*hermetic);10226  }10227  std::map<SourceName, const parser::ProgramUnit *> modules;10228  std::set<SourceName> uses;10229  bool disordered{false};10230  for (const auto &progUnit : x.v) {10231    if (const auto *indMod{10232            std::get_if<common::Indirection<parser::Module>>(&progUnit.u)}) {10233      const parser::Module &mod{indMod->value()};10234      const auto &moduleStmt{10235          std::get<parser::Statement<parser::ModuleStmt>>(mod.t)};10236      const SourceName &name{moduleStmt.statement.v.source};10237      if (auto iter{modules.find(name)}; iter != modules.end()) {10238        Say(name,10239            "Module '%s' appears multiple times in a compilation unit"_err_en_US)10240            .Attach(iter->first, "First definition of module"_en_US);10241        return true;10242      }10243      modules.emplace(name, &progUnit);10244      if (auto iter{uses.find(name)}; iter != uses.end()) {10245        if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {10246          Say(name,10247              "A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US,10248              name)10249              .Attach(*iter, "First USE of module"_en_US);10250        }10251        disordered = true;10252      }10253    }10254    for (SourceName used : common::visit(10255             [](const auto &indUnit) { return GetUses(indUnit.value()); },10256             progUnit.u)) {10257      uses.insert(used);10258    }10259  }10260  if (!disordered) {10261    return true;10262  }10263  // Process modules in topological order10264  std::vector<const parser::ProgramUnit *> moduleOrder;10265  while (!modules.empty()) {10266    bool ok;10267    for (const auto &pair : modules) {10268      const SourceName &name{pair.first};10269      const parser::ProgramUnit &progUnit{*pair.second};10270      const parser::Module &m{10271          std::get<common::Indirection<parser::Module>>(progUnit.u).value()};10272      ok = true;10273      for (const SourceName &use : GetUses(m)) {10274        if (modules.find(use) != modules.end()) {10275          ok = false;10276          break;10277        }10278      }10279      if (ok) {10280        moduleOrder.push_back(&progUnit);10281        modules.erase(name);10282        break;10283      }10284    }10285    if (!ok) {10286      Message *msg{nullptr};10287      for (const auto &pair : modules) {10288        if (msg) {10289          msg->Attach(pair.first, "Module in a cycle"_en_US);10290        } else {10291          msg = &Say(pair.first,10292              "Some modules in this compilation unit form one or more cycles of dependence"_err_en_US);10293        }10294      }10295      return false;10296    }10297  }10298  // Modules can be ordered.  Process them first, and then all of the other10299  // program units.10300  for (const parser::ProgramUnit *progUnit : moduleOrder) {10301    Walk(*progUnit);10302  }10303  for (const auto &progUnit : x.v) {10304    if (!std::get_if<common::Indirection<parser::Module>>(&progUnit.u)) {10305      Walk(progUnit);10306    }10307  }10308  return false;10309}10310 10311// References to procedures need to record that their symbols are known10312// to be procedures, so that they don't get converted to objects by default.10313class ExecutionPartCallSkimmer : public ExecutionPartSkimmerBase {10314public:10315  explicit ExecutionPartCallSkimmer(ResolveNamesVisitor &resolver)10316      : resolver_{resolver} {}10317 10318  void Walk(const parser::ExecutionPart &exec) {10319    parser::Walk(exec, *this);10320    EndWalk();10321  }10322 10323  using ExecutionPartSkimmerBase::Post;10324  using ExecutionPartSkimmerBase::Pre;10325 10326  void Post(const parser::FunctionReference &fr) {10327    NoteCall(Symbol::Flag::Function, fr.v, false);10328  }10329  void Post(const parser::CallStmt &cs) {10330    NoteCall(Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());10331  }10332 10333private:10334  void NoteCall(10335      Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {10336    auto &designator{std::get<parser::ProcedureDesignator>(call.t)};10337    if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {10338      if (!IsHidden(name->source)) {10339        resolver_.NoteExecutablePartCall(flag, name->source, hasCUDAChevrons);10340      }10341    }10342  }10343 10344  ResolveNamesVisitor &resolver_;10345};10346 10347// Build the scope tree and resolve names in the specification parts of this10348// node and its children10349void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {10350  if (node.isSpecificationPartResolved()) {10351    return; // been here already10352  }10353  node.set_isSpecificationPartResolved();10354  if (!BeginScopeForNode(node)) {10355    return; // an error prevented scope from being created10356  }10357  Scope &scope{currScope()};10358  node.set_scope(scope);10359  AddSubpNames(node);10360  common::visit(10361      [&](const auto *x) {10362        if (x) {10363          Walk(*x);10364        }10365      },10366      node.stmt());10367  Walk(node.spec());10368  bool inDeviceSubprogram{false};10369  // If this is a function, convert result to an object. This is to prevent the10370  // result from being converted later to a function symbol if it is called10371  // inside the function.10372  // If the result is function pointer, then ConvertToObjectEntity will not10373  // convert the result to an object, and calling the symbol inside the function10374  // will result in calls to the result pointer.10375  // A function cannot be called recursively if RESULT was not used to define a10376  // distinct result name (15.6.2.2 point 4.).10377  if (Symbol * symbol{scope.symbol()}) {10378    if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {10379      if (details->isFunction()) {10380        ConvertToObjectEntity(const_cast<Symbol &>(details->result()));10381      }10382      // Check the current procedure is a device procedure to apply implicit10383      // attribute at the end.10384      if (auto attrs{details->cudaSubprogramAttrs()}) {10385        if (*attrs == common::CUDASubprogramAttrs::Device ||10386            *attrs == common::CUDASubprogramAttrs::Global ||10387            *attrs == common::CUDASubprogramAttrs::Grid_Global) {10388          inDeviceSubprogram = true;10389        }10390      }10391    }10392  }10393  if (node.IsModule()) {10394    ApplyDefaultAccess();10395  }10396  for (auto &child : node.children()) {10397    ResolveSpecificationParts(child);10398  }10399  if (node.exec()) {10400    ExecutionPartCallSkimmer{*this}.Walk(*node.exec());10401    HandleImpliedAsynchronousInScope(node.exec()->v);10402  }10403  EndScopeForNode(node);10404  // Ensure that every object entity has a type.10405  bool inModule{node.GetKind() == ProgramTree::Kind::Module ||10406      node.GetKind() == ProgramTree::Kind::Submodule};10407  for (auto &pair : *node.scope()) {10408    Symbol &symbol{*pair.second};10409    if (inModule && symbol.attrs().test(Attr::EXTERNAL) && !IsPointer(symbol) &&10410        !symbol.test(Symbol::Flag::Function) &&10411        !symbol.test(Symbol::Flag::Subroutine)) {10412      // in a module, external proc without return type is subroutine10413      symbol.set(10414          symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);10415    }10416    ApplyImplicitRules(symbol);10417    // Apply CUDA implicit attributes if needed.10418    if (inDeviceSubprogram) {10419      SetImplicitCUDADevice(symbol);10420    }10421    // Main program local objects usually don't have an implied SAVE attribute,10422    // as one might think, but in the exceptional case of a derived type10423    // local object that contains a coarray, we have to mark it as an10424    // implied SAVE so that evaluate::IsSaved() will return true.10425    if (node.scope()->kind() == Scope::Kind::MainProgram) {10426      if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {10427        if (const DeclTypeSpec * type{object->type()}) {10428          if (const DerivedTypeSpec * derived{type->AsDerived()}) {10429            if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {10430              SetImplicitAttr(symbol, Attr::SAVE);10431            }10432          }10433        }10434      }10435    }10436  }10437}10438 10439// Add SubprogramNameDetails symbols for module and internal subprograms and10440// their ENTRY statements.10441void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {10442  auto kind{10443      node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};10444  for (auto &child : node.children()) {10445    auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};10446    if (child.HasModulePrefix()) {10447      SetExplicitAttr(symbol, Attr::MODULE);10448    }10449    if (child.bindingSpec()) {10450      SetExplicitAttr(symbol, Attr::BIND_C);10451    }10452    auto childKind{child.GetKind()};10453    if (childKind == ProgramTree::Kind::Function) {10454      symbol.set(Symbol::Flag::Function);10455    } else if (childKind == ProgramTree::Kind::Subroutine) {10456      symbol.set(Symbol::Flag::Subroutine);10457    } else {10458      continue; // make ENTRY symbols only where valid10459    }10460    for (const auto &entryStmt : child.entryStmts()) {10461      SubprogramNameDetails details{kind, child};10462      auto &symbol{10463          MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};10464      symbol.set(child.GetSubpFlag());10465      if (child.HasModulePrefix()) {10466        SetExplicitAttr(symbol, Attr::MODULE);10467      }10468      if (child.bindingSpec()) {10469        SetExplicitAttr(symbol, Attr::BIND_C);10470      }10471    }10472  }10473  for (const auto &generic : node.genericSpecs()) {10474    if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {10475      if (currScope().find(name->source) != currScope().end()) {10476        // If this scope has both a generic interface and a contained10477        // subprogram with the same name, create the generic's symbol10478        // now so that any other generics of the same name that are pulled10479        // into scope later via USE association will properly merge instead10480        // of raising a bogus error due a conflict with the subprogram.10481        CreateGeneric(*generic);10482      }10483    }10484  }10485}10486 10487// Push a new scope for this node or return false on error.10488bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {10489  switch (node.GetKind()) {10490    SWITCH_COVERS_ALL_CASES10491  case ProgramTree::Kind::Program:10492    PushScope(Scope::Kind::MainProgram,10493        &MakeSymbol(node.name(), MainProgramDetails{}));10494    return true;10495  case ProgramTree::Kind::Function:10496  case ProgramTree::Kind::Subroutine:10497    return BeginSubprogram(node.name(), node.GetSubpFlag(),10498        node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts());10499  case ProgramTree::Kind::MpSubprogram:10500    return BeginMpSubprogram(node.name());10501  case ProgramTree::Kind::Module:10502    BeginModule(node.name(), false);10503    return true;10504  case ProgramTree::Kind::Submodule:10505    return BeginSubmodule(node.name(), node.GetParentId());10506  case ProgramTree::Kind::BlockData:10507    PushBlockDataScope(node.name());10508    return true;10509  }10510}10511 10512void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) {10513  std::optional<parser::CharBlock> stmtSource;10514  const std::optional<parser::LanguageBindingSpec> *binding{nullptr};10515  common::visit(10516      common::visitors{10517          [&](const parser::Statement<parser::FunctionStmt> *stmt) {10518            if (stmt) {10519              stmtSource = stmt->source;10520              if (const auto &maybeSuffix{10521                      std::get<std::optional<parser::Suffix>>(10522                          stmt->statement.t)}) {10523                binding = &maybeSuffix->binding;10524              }10525            }10526          },10527          [&](const parser::Statement<parser::SubroutineStmt> *stmt) {10528            if (stmt) {10529              stmtSource = stmt->source;10530              binding = &std::get<std::optional<parser::LanguageBindingSpec>>(10531                  stmt->statement.t);10532            }10533          },10534          [](const auto *) {},10535      },10536      node.stmt());10537  EndSubprogram(stmtSource, binding, &node.entryStmts());10538}10539 10540// Some analyses and checks, such as the processing of initializers of10541// pointers, are deferred until all of the pertinent specification parts10542// have been visited.  This deferred processing enables the use of forward10543// references in these circumstances.10544// Data statement objects with implicit derived types are finally10545// resolved here.10546class DeferredCheckVisitor {10547public:10548  explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)10549      : resolver_{resolver} {}10550 10551  template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }10552 10553  template <typename A> bool Pre(const A &) { return true; }10554  template <typename A> void Post(const A &) {}10555 10556  void Post(const parser::DerivedTypeStmt &x) {10557    const auto &name{std::get<parser::Name>(x.t)};10558    if (Symbol * symbol{name.symbol}) {10559      if (Scope * scope{symbol->scope()}) {10560        if (scope->IsDerivedType()) {10561          CHECK(outerScope_ == nullptr);10562          outerScope_ = &resolver_.currScope();10563          resolver_.SetScope(*scope);10564        }10565      }10566    }10567  }10568  void Post(const parser::EndTypeStmt &) {10569    if (outerScope_) {10570      resolver_.SetScope(*outerScope_);10571      outerScope_ = nullptr;10572    }10573  }10574 10575  void Post(const parser::ProcInterface &pi) {10576    if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {10577      resolver_.CheckExplicitInterface(*name);10578    }10579  }10580  bool Pre(const parser::EntityDecl &decl) {10581    Init(std::get<parser::Name>(decl.t),10582        std::get<std::optional<parser::Initialization>>(decl.t));10583    return false;10584  }10585  bool Pre(const parser::ProcDecl &decl) {10586    if (const auto &init{10587            std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {10588      resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init);10589    }10590    return false;10591  }10592  void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) {10593    resolver_.CheckExplicitInterface(tbps.interfaceName);10594  }10595  void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {10596    if (outerScope_) {10597      resolver_.CheckBindings(tbps);10598    }10599  }10600  bool Pre(const parser::DataStmtObject &) {10601    ++dataStmtObjectNesting_;10602    return true;10603  }10604  void Post(const parser::DataStmtObject &) { --dataStmtObjectNesting_; }10605  void Post(const parser::Designator &x) {10606    if (dataStmtObjectNesting_ > 0) {10607      resolver_.ResolveDesignator(x);10608    }10609  }10610 10611private:10612  void Init(const parser::Name &name,10613      const std::optional<parser::Initialization> &init) {10614    if (init) {10615      if (const auto *target{10616              std::get_if<parser::InitialDataTarget>(&init->u)}) {10617        resolver_.PointerInitialization(name, *target);10618      } else if (name.symbol) {10619        if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};10620            !object || !object->init()) {10621          if (const auto *expr{std::get_if<parser::ConstantExpr>(&init->u)}) {10622            resolver_.NonPointerInitialization(name, *expr);10623          } else {10624            // Don't check legacy DATA /initialization/ here.  Component10625            // initializations will have already been handled, and variable10626            // initializations need to be done in DATA checking so that10627            // EQUIVALENCE storage association can be handled.10628          }10629        }10630      }10631    }10632  }10633 10634  ResolveNamesVisitor &resolver_;10635  Scope *outerScope_{nullptr};10636  int dataStmtObjectNesting_{0};10637};10638 10639// Perform checks and completions that need to happen after all of10640// the specification parts but before any of the execution parts.10641void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {10642  if (!node.scope()) {10643    return; // error occurred creating scope10644  }10645  auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};10646  SetScope(*node.scope());10647  // The initializers of pointers and non-PARAMETER objects, the default10648  // initializers of components, and non-deferred type-bound procedure10649  // bindings have not yet been traversed.10650  // We do that now, when any forward references that appeared10651  // in those initializers will resolve to the right symbols without10652  // incurring spurious errors with IMPLICIT NONE or forward references10653  // to nested subprograms.10654  DeferredCheckVisitor{*this}.Walk(node.spec());10655  for (Scope &childScope : currScope().children()) {10656    if (childScope.IsParameterizedDerivedTypeInstantiation()) {10657      FinishDerivedTypeInstantiation(childScope);10658    }10659  }10660  for (const auto &child : node.children()) {10661    FinishSpecificationParts(child);10662  }10663}10664 10665void ResolveNamesVisitor::FinishExecutionParts(const ProgramTree &node) {10666  if (node.scope()) {10667    SetScope(*node.scope());10668    if (node.exec()) {10669      DeferredCheckVisitor{*this}.Walk(*node.exec());10670    }10671    for (const auto &child : node.children()) {10672      FinishExecutionParts(child);10673    }10674  }10675}10676 10677// Duplicate and fold component object pointer default initializer designators10678// using the actual type parameter values of each particular instantiation.10679// Validation is done later in declaration checking.10680void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {10681  CHECK(scope.IsDerivedType() && !scope.symbol());10682  if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {10683    spec->Instantiate(currScope());10684    const Symbol &origTypeSymbol{spec->typeSymbol()};10685    if (const Scope * origTypeScope{origTypeSymbol.scope()}) {10686      CHECK(origTypeScope->IsDerivedType() &&10687          origTypeScope->symbol() == &origTypeSymbol);10688      auto &foldingContext{GetFoldingContext()};10689      auto restorer{foldingContext.WithPDTInstance(*spec)};10690      for (auto &pair : scope) {10691        Symbol &comp{*pair.second};10692        const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};10693        if (IsPointer(comp)) {10694          if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {10695            auto origDetails{origComp.get<ObjectEntityDetails>()};10696            if (const MaybeExpr & init{origDetails.init()}) {10697              SomeExpr newInit{*init};10698              MaybeExpr folded{FoldExpr(std::move(newInit))};10699              details->set_init(std::move(folded));10700            }10701          }10702        }10703      }10704    }10705  }10706}10707 10708// Resolve names in the execution part of this node and its children10709void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {10710  if (!node.scope()) {10711    return; // error occurred creating scope10712  }10713  SetScope(*node.scope());10714  if (const auto *exec{node.exec()}) {10715    Walk(*exec);10716  }10717  FinishNamelists();10718  if (node.IsModule()) {10719    // A second final pass to catch new symbols added from implicitly10720    // typed names in NAMELIST groups or the specification parts of10721    // module subprograms.10722    ApplyDefaultAccess();10723  }10724  PopScope(); // converts unclassified entities into objects10725  for (const auto &child : node.children()) {10726    ResolveExecutionParts(child);10727  }10728}10729 10730void ResolveNamesVisitor::Post(const parser::Program &x) {10731  // ensure that all temps were deallocated10732  CHECK(!attrs_);10733  CHECK(!cudaDataAttr_);10734  CHECK(!GetDeclTypeSpec());10735}10736 10737// A singleton instance of the scope -> IMPLICIT rules mapping is10738// shared by all instances of ResolveNamesVisitor and accessed by this10739// pointer when the visitors (other than the top-level original) are10740// constructed.10741static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};10742 10743bool ResolveNames(10744    SemanticsContext &context, const parser::Program &program, Scope &top) {10745  ImplicitRulesMap implicitRulesMap;10746  auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)};10747  ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program);10748  return !context.AnyFatalError();10749}10750 10751// Processes a module (but not internal) function when it is referenced10752// in a specification expression in a sibling procedure.10753void ResolveSpecificationParts(10754    SemanticsContext &context, const Symbol &subprogram) {10755  auto originalLocation{context.location()};10756  ImplicitRulesMap implicitRulesMap;10757  bool localImplicitRulesMap{false};10758  if (!sharedImplicitRulesMap) {10759    sharedImplicitRulesMap = &implicitRulesMap;10760    localImplicitRulesMap = true;10761  }10762  ResolveNamesVisitor visitor{10763      context, *sharedImplicitRulesMap, context.globalScope()};10764  const auto &details{subprogram.get<SubprogramNameDetails>()};10765  ProgramTree &node{details.node()};10766  const Scope &moduleScope{subprogram.owner()};10767  if (localImplicitRulesMap) {10768    visitor.BeginScope(const_cast<Scope &>(moduleScope));10769  } else {10770    visitor.SetScope(const_cast<Scope &>(moduleScope));10771  }10772  visitor.ResolveSpecificationParts(node);10773  context.set_location(std::move(originalLocation));10774  if (localImplicitRulesMap) {10775    sharedImplicitRulesMap = nullptr;10776  }10777}10778 10779} // namespace Fortran::semantics10780