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