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