[flang] Fix creation of deferred shape arrays by POINTER statement
[lldb.git] / flang / lib / Semantics / resolve-names.cpp
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(SourceName) const;
73   // Record the implicit type for the range of characters [fromLetter,
74   // toLetter].
75   void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
76       parser::Location toLetter);
77
78 private:
79   static char Incr(char ch);
80
81   ImplicitRules *parent_;
82   SemanticsContext &context_;
83   bool inheritFromParent_{false}; // look in parent if not specified here
84   bool isImplicitNoneType_{
85       context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)};
86   bool isImplicitNoneExternal_{false};
87   // map_ contains the mapping between letters and types that were defined
88   // by the IMPLICIT statements of the related scope. It does not contain
89   // the default Fortran mappings nor the mapping defined in parents.
90   std::map<char, common::Reference<const DeclTypeSpec>> map_;
91
92   friend llvm::raw_ostream &operator<<(
93       llvm::raw_ostream &, const ImplicitRules &);
94   friend void ShowImplicitRule(
95       llvm::raw_ostream &, const ImplicitRules &, char);
96 };
97
98 // scope -> implicit rules for that scope
99 using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>;
100
101 // Track statement source locations and save messages.
102 class MessageHandler {
103 public:
104   MessageHandler() { DIE("MessageHandler: default-constructed"); }
105   explicit MessageHandler(SemanticsContext &c) : context_{&c} {}
106   Messages &messages() { return context_->messages(); };
107   const std::optional<SourceName> &currStmtSource() {
108     return context_->location();
109   }
110   void set_currStmtSource(const std::optional<SourceName> &source) {
111     context_->set_location(source);
112   }
113
114   // Emit a message associated with the current statement source.
115   Message &Say(MessageFixedText &&);
116   Message &Say(MessageFormattedText &&);
117   // Emit a message about a SourceName
118   Message &Say(const SourceName &, MessageFixedText &&);
119   // Emit a formatted message associated with a source location.
120   template <typename... A>
121   Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) {
122     return context_->Say(source, std::move(msg), std::forward<A>(args)...);
123   }
124
125 private:
126   SemanticsContext *context_;
127 };
128
129 // Inheritance graph for the parse tree visitation classes that follow:
130 //   BaseVisitor
131 //   + AttrsVisitor
132 //   | + DeclTypeSpecVisitor
133 //   |   + ImplicitRulesVisitor
134 //   |     + ScopeHandler -----------+--+
135 //   |       + ModuleVisitor ========|==+
136 //   |       + InterfaceVisitor      |  |
137 //   |       +-+ SubprogramVisitor ==|==+
138 //   + ArraySpecVisitor              |  |
139 //     + DeclarationVisitor <--------+  |
140 //       + ConstructVisitor             |
141 //         + ResolveNamesVisitor <------+
142
143 class BaseVisitor {
144 public:
145   BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
146   BaseVisitor(
147       SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)
148       : implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {
149   }
150   template <typename T> void Walk(const T &);
151
152   MessageHandler &messageHandler() { return messageHandler_; }
153   const std::optional<SourceName> &currStmtSource() {
154     return context_->location();
155   }
156   SemanticsContext &context() const { return *context_; }
157   evaluate::FoldingContext &GetFoldingContext() const {
158     return context_->foldingContext();
159   }
160   bool IsIntrinsic(
161       const SourceName &name, std::optional<Symbol::Flag> flag) const {
162     if (!flag) {
163       return context_->intrinsics().IsIntrinsic(name.ToString());
164     } else if (flag == Symbol::Flag::Function) {
165       return context_->intrinsics().IsIntrinsicFunction(name.ToString());
166     } else if (flag == Symbol::Flag::Subroutine) {
167       return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());
168     } else {
169       DIE("expected Subroutine or Function flag");
170     }
171   }
172
173   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
174   // It is not in any scope and always has MiscDetails.
175   void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
176
177   template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
178     return evaluate::Fold(GetFoldingContext(), std::move(expr));
179   }
180
181   template <typename T> MaybeExpr EvaluateExpr(const T &expr) {
182     return FoldExpr(AnalyzeExpr(*context_, expr));
183   }
184
185   template <typename T>
186   MaybeExpr EvaluateNonPointerInitializer(
187       const Symbol &symbol, const T &expr, parser::CharBlock source) {
188     if (!context().HasError(symbol)) {
189       if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
190         auto restorer{GetFoldingContext().messages().SetLocation(source)};
191         return evaluate::NonPointerInitializationExpr(
192             symbol, std::move(*maybeExpr), GetFoldingContext());
193       }
194     }
195     return std::nullopt;
196   }
197
198   template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
199     return semantics::EvaluateIntExpr(*context_, expr);
200   }
201
202   template <typename T>
203   MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
204     if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
205       return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
206           std::move(*maybeIntExpr)));
207     } else {
208       return std::nullopt;
209     }
210   }
211
212   template <typename... A> Message &Say(A &&...args) {
213     return messageHandler_.Say(std::forward<A>(args)...);
214   }
215   template <typename... A>
216   Message &Say(
217       const parser::Name &name, MessageFixedText &&text, const A &...args) {
218     return messageHandler_.Say(name.source, std::move(text), args...);
219   }
220
221 protected:
222   ImplicitRulesMap *implicitRulesMap_{nullptr};
223
224 private:
225   ResolveNamesVisitor *this_;
226   SemanticsContext *context_;
227   MessageHandler messageHandler_;
228 };
229
230 // Provide Post methods to collect attributes into a member variable.
231 class AttrsVisitor : public virtual BaseVisitor {
232 public:
233   bool BeginAttrs(); // always returns true
234   Attrs GetAttrs();
235   Attrs EndAttrs();
236   bool SetPassNameOn(Symbol &);
237   bool SetBindNameOn(Symbol &);
238   void Post(const parser::LanguageBindingSpec &);
239   bool Pre(const parser::IntentSpec &);
240   bool Pre(const parser::Pass &);
241
242   bool CheckAndSet(Attr);
243
244 // Simple case: encountering CLASSNAME causes ATTRNAME to be set.
245 #define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
246   bool Pre(const parser::CLASSNAME &) { \
247     CheckAndSet(Attr::ATTRNAME); \
248     return false; \
249   }
250   HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
251   HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
252   HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
253   HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
254   HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
255   HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
256   HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
257   HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
258   HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
259   HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
260   HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
261   HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
262   HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
263   HANDLE_ATTR_CLASS(External, EXTERNAL)
264   HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
265   HANDLE_ATTR_CLASS(NoPass, NOPASS)
266   HANDLE_ATTR_CLASS(Optional, OPTIONAL)
267   HANDLE_ATTR_CLASS(Parameter, PARAMETER)
268   HANDLE_ATTR_CLASS(Pointer, POINTER)
269   HANDLE_ATTR_CLASS(Protected, PROTECTED)
270   HANDLE_ATTR_CLASS(Save, SAVE)
271   HANDLE_ATTR_CLASS(Target, TARGET)
272   HANDLE_ATTR_CLASS(Value, VALUE)
273   HANDLE_ATTR_CLASS(Volatile, VOLATILE)
274 #undef HANDLE_ATTR_CLASS
275
276 protected:
277   std::optional<Attrs> attrs_;
278
279   Attr AccessSpecToAttr(const parser::AccessSpec &x) {
280     switch (x.v) {
281     case parser::AccessSpec::Kind::Public:
282       return Attr::PUBLIC;
283     case parser::AccessSpec::Kind::Private:
284       return Attr::PRIVATE;
285     }
286     llvm_unreachable("Switch covers all cases"); // suppress g++ warning
287   }
288   Attr IntentSpecToAttr(const parser::IntentSpec &x) {
289     switch (x.v) {
290     case parser::IntentSpec::Intent::In:
291       return Attr::INTENT_IN;
292     case parser::IntentSpec::Intent::Out:
293       return Attr::INTENT_OUT;
294     case parser::IntentSpec::Intent::InOut:
295       return Attr::INTENT_INOUT;
296     }
297     llvm_unreachable("Switch covers all cases"); // suppress g++ warning
298   }
299
300 private:
301   bool IsDuplicateAttr(Attr);
302   bool HaveAttrConflict(Attr, Attr, Attr);
303   bool IsConflictingAttr(Attr);
304
305   MaybeExpr bindName_; // from BIND(C, NAME="...")
306   std::optional<SourceName> passName_; // from PASS(...)
307 };
308
309 // Find and create types from declaration-type-spec nodes.
310 class DeclTypeSpecVisitor : public AttrsVisitor {
311 public:
312   using AttrsVisitor::Post;
313   using AttrsVisitor::Pre;
314   void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
315   void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
316   void Post(const parser::DeclarationTypeSpec::ClassStar &);
317   void Post(const parser::DeclarationTypeSpec::TypeStar &);
318   bool Pre(const parser::TypeGuardStmt &);
319   void Post(const parser::TypeGuardStmt &);
320   void Post(const parser::TypeSpec &);
321
322 protected:
323   struct State {
324     bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true
325     const DeclTypeSpec *declTypeSpec{nullptr};
326     struct {
327       DerivedTypeSpec *type{nullptr};
328       DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
329     } derived;
330     bool allowForwardReferenceToDerivedType{false};
331   };
332
333   bool allowForwardReferenceToDerivedType() const {
334     return state_.allowForwardReferenceToDerivedType;
335   }
336   void set_allowForwardReferenceToDerivedType(bool yes) {
337     state_.allowForwardReferenceToDerivedType = yes;
338   }
339
340   // Walk the parse tree of a type spec and return the DeclTypeSpec for it.
341   template <typename T>
342   const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
343     auto restorer{common::ScopedSet(state_, State{})};
344     set_allowForwardReferenceToDerivedType(allowForward);
345     BeginDeclTypeSpec();
346     Walk(x);
347     const auto *type{GetDeclTypeSpec()};
348     EndDeclTypeSpec();
349     return type;
350   }
351
352   const DeclTypeSpec *GetDeclTypeSpec();
353   void BeginDeclTypeSpec();
354   void EndDeclTypeSpec();
355   void SetDeclTypeSpec(const DeclTypeSpec &);
356   void SetDeclTypeSpecCategory(DeclTypeSpec::Category);
357   DeclTypeSpec::Category GetDeclTypeSpecCategory() const {
358     return state_.derived.category;
359   }
360   KindExpr GetKindParamExpr(
361       TypeCategory, const std::optional<parser::KindSelector> &);
362   void CheckForAbstractType(const Symbol &typeSymbol);
363
364 private:
365   State state_;
366
367   void MakeNumericType(TypeCategory, int kind);
368 };
369
370 // Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
371 class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
372 public:
373   using DeclTypeSpecVisitor::Post;
374   using DeclTypeSpecVisitor::Pre;
375   using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
376
377   void Post(const parser::ParameterStmt &);
378   bool Pre(const parser::ImplicitStmt &);
379   bool Pre(const parser::LetterSpec &);
380   bool Pre(const parser::ImplicitSpec &);
381   void Post(const parser::ImplicitSpec &);
382
383   const DeclTypeSpec *GetType(SourceName name) {
384     return implicitRules_->GetType(name);
385   }
386   bool isImplicitNoneType() const {
387     return implicitRules_->isImplicitNoneType();
388   }
389   bool isImplicitNoneType(const Scope &scope) const {
390     return implicitRulesMap_->at(&scope).isImplicitNoneType();
391   }
392   bool isImplicitNoneExternal() const {
393     return implicitRules_->isImplicitNoneExternal();
394   }
395   void set_inheritFromParent(bool x) {
396     implicitRules_->set_inheritFromParent(x);
397   }
398
399 protected:
400   void BeginScope(const Scope &);
401   void SetScope(const Scope &);
402
403 private:
404   // implicit rules in effect for current scope
405   ImplicitRules *implicitRules_{nullptr};
406   std::optional<SourceName> prevImplicit_;
407   std::optional<SourceName> prevImplicitNone_;
408   std::optional<SourceName> prevImplicitNoneType_;
409   std::optional<SourceName> prevParameterStmt_;
410
411   bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
412 };
413
414 // Track array specifications. They can occur in AttrSpec, EntityDecl,
415 // ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt.
416 // 1. INTEGER, DIMENSION(10) :: x
417 // 2. INTEGER :: x(10)
418 // 3. ALLOCATABLE :: x(:)
419 // 4. DIMENSION :: x(10)
420 // 5. COMMON x(10)
421 // 6. BasedPointerStmt
422 class ArraySpecVisitor : public virtual BaseVisitor {
423 public:
424   void Post(const parser::ArraySpec &);
425   void Post(const parser::ComponentArraySpec &);
426   void Post(const parser::CoarraySpec &);
427   void Post(const parser::AttrSpec &) { PostAttrSpec(); }
428   void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
429
430 protected:
431   const ArraySpec &arraySpec();
432   void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }
433   const ArraySpec &coarraySpec();
434   void BeginArraySpec();
435   void EndArraySpec();
436   void ClearArraySpec() { arraySpec_.clear(); }
437   void ClearCoarraySpec() { coarraySpec_.clear(); }
438
439 private:
440   // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
441   ArraySpec arraySpec_;
442   ArraySpec coarraySpec_;
443   // When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
444   // into attrArraySpec_
445   ArraySpec attrArraySpec_;
446   ArraySpec attrCoarraySpec_;
447
448   void PostAttrSpec();
449 };
450
451 // Manage a stack of Scopes
452 class ScopeHandler : public ImplicitRulesVisitor {
453 public:
454   using ImplicitRulesVisitor::Post;
455   using ImplicitRulesVisitor::Pre;
456
457   Scope &currScope() { return DEREF(currScope_); }
458   // The enclosing host procedure if current scope is in an internal procedure
459   Scope *GetHostProcedure();
460   // The enclosing scope, skipping blocks and derived types.
461   // TODO: Will return the scope of a FORALL or implied DO loop; is this ok?
462   // If not, should call FindProgramUnitContaining() instead.
463   Scope &InclusiveScope();
464   // The enclosing scope, skipping derived types.
465   Scope &NonDerivedTypeScope();
466
467   // Create a new scope and push it on the scope stack.
468   void PushScope(Scope::Kind kind, Symbol *symbol);
469   void PushScope(Scope &scope);
470   void PopScope();
471   void SetScope(Scope &);
472
473   template <typename T> bool Pre(const parser::Statement<T> &x) {
474     messageHandler().set_currStmtSource(x.source);
475     currScope_->AddSourceRange(x.source);
476     return true;
477   }
478   template <typename T> void Post(const parser::Statement<T> &) {
479     messageHandler().set_currStmtSource(std::nullopt);
480   }
481
482   // Special messages: already declared; referencing symbol's declaration;
483   // about a type; two names & locations
484   void SayAlreadyDeclared(const parser::Name &, Symbol &);
485   void SayAlreadyDeclared(const SourceName &, Symbol &);
486   void SayAlreadyDeclared(const SourceName &, const SourceName &);
487   void SayWithReason(
488       const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&);
489   void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
490   void SayLocalMustBeVariable(const parser::Name &, Symbol &);
491   void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
492   void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
493       MessageFixedText &&);
494   void Say2(
495       const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
496   void Say2(
497       const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
498
499   // Search for symbol by name in current, parent derived type, and
500   // containing scopes
501   Symbol *FindSymbol(const parser::Name &);
502   Symbol *FindSymbol(const Scope &, const parser::Name &);
503   // Search for name only in scope, not in enclosing scopes.
504   Symbol *FindInScope(const Scope &, const parser::Name &);
505   Symbol *FindInScope(const Scope &, const SourceName &);
506   template <typename T> Symbol *FindInScope(const T &name) {
507     return FindInScope(currScope(), name);
508   }
509   // Search for name in a derived type scope and its parents.
510   Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
511   Symbol *FindInTypeOrParents(const parser::Name &);
512   void EraseSymbol(const parser::Name &);
513   void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
514   // Make a new symbol with the name and attrs of an existing one
515   Symbol &CopySymbol(const SourceName &, const Symbol &);
516
517   // Make symbols in the current or named scope
518   Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
519   Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
520   Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
521   Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);
522
523   template <typename D>
524   common::IfNoLvalue<Symbol &, D> MakeSymbol(
525       const parser::Name &name, D &&details) {
526     return MakeSymbol(name, Attrs{}, std::move(details));
527   }
528
529   template <typename D>
530   common::IfNoLvalue<Symbol &, D> MakeSymbol(
531       const parser::Name &name, const Attrs &attrs, D &&details) {
532     return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
533   }
534
535   template <typename D>
536   common::IfNoLvalue<Symbol &, D> MakeSymbol(
537       const SourceName &name, const Attrs &attrs, D &&details) {
538     // Note: don't use FindSymbol here. If this is a derived type scope,
539     // we want to detect whether the name is already declared as a component.
540     auto *symbol{FindInScope(name)};
541     if (!symbol) {
542       symbol = &MakeSymbol(name, attrs);
543       symbol->set_details(std::move(details));
544       return *symbol;
545     }
546     if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
547       if (auto *d{symbol->detailsIf<GenericDetails>()}) {
548         if (!d->specific()) {
549           // derived type with same name as a generic
550           auto *derivedType{d->derivedType()};
551           if (!derivedType) {
552             derivedType =
553                 &currScope().MakeSymbol(name, attrs, std::move(details));
554             d->set_derivedType(*derivedType);
555           } else {
556             SayAlreadyDeclared(name, *derivedType);
557           }
558           return *derivedType;
559         }
560       }
561     }
562     if (symbol->CanReplaceDetails(details)) {
563       // update the existing symbol
564       symbol->attrs() |= attrs;
565       symbol->set_details(std::move(details));
566       return *symbol;
567     } else if constexpr (std::is_same_v<UnknownDetails, D>) {
568       symbol->attrs() |= attrs;
569       return *symbol;
570     } else {
571       if (!CheckPossibleBadForwardRef(*symbol)) {
572         SayAlreadyDeclared(name, *symbol);
573       }
574       // replace the old symbol with a new one with correct details
575       EraseSymbol(*symbol);
576       auto &result{MakeSymbol(name, attrs, std::move(details))};
577       context().SetError(result);
578       return result;
579     }
580   }
581
582   void MakeExternal(Symbol &);
583
584 protected:
585   // Apply the implicit type rules to this symbol.
586   void ApplyImplicitRules(Symbol &);
587   const DeclTypeSpec *GetImplicitType(Symbol &, const Scope &);
588   bool ConvertToObjectEntity(Symbol &);
589   bool ConvertToProcEntity(Symbol &);
590
591   const DeclTypeSpec &MakeNumericType(
592       TypeCategory, const std::optional<parser::KindSelector> &);
593   const DeclTypeSpec &MakeLogicalType(
594       const std::optional<parser::KindSelector> &);
595   void NotePossibleBadForwardRef(const parser::Name &);
596   std::optional<SourceName> HadForwardRef(const Symbol &) const;
597   bool CheckPossibleBadForwardRef(const Symbol &);
598
599   bool inExecutionPart_{false};
600   bool inSpecificationPart_{false};
601   bool inEquivalenceStmt_{false};
602   std::set<SourceName> specPartForwardRefs_;
603
604 private:
605   Scope *currScope_{nullptr};
606 };
607
608 class ModuleVisitor : public virtual ScopeHandler {
609 public:
610   bool Pre(const parser::AccessStmt &);
611   bool Pre(const parser::Only &);
612   bool Pre(const parser::Rename::Names &);
613   bool Pre(const parser::Rename::Operators &);
614   bool Pre(const parser::UseStmt &);
615   void Post(const parser::UseStmt &);
616
617   void BeginModule(const parser::Name &, bool isSubmodule);
618   bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
619   void ApplyDefaultAccess();
620   void AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
621
622 private:
623   // The default access spec for this module.
624   Attr defaultAccess_{Attr::PUBLIC};
625   // The location of the last AccessStmt without access-ids, if any.
626   std::optional<SourceName> prevAccessStmt_;
627   // The scope of the module during a UseStmt
628   Scope *useModuleScope_{nullptr};
629
630   Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
631   // A rename in a USE statement: local => use
632   struct SymbolRename {
633     Symbol *local{nullptr};
634     Symbol *use{nullptr};
635   };
636   // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
637   SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
638   SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
639   void DoAddUse(const SourceName &, const SourceName &, Symbol &localSymbol,
640       const Symbol &useSymbol);
641   void AddUse(const GenericSpecInfo &);
642   Scope *FindModule(const parser::Name &, Scope *ancestor = nullptr);
643 };
644
645 class InterfaceVisitor : public virtual ScopeHandler {
646 public:
647   bool Pre(const parser::InterfaceStmt &);
648   void Post(const parser::InterfaceStmt &);
649   void Post(const parser::EndInterfaceStmt &);
650   bool Pre(const parser::GenericSpec &);
651   bool Pre(const parser::ProcedureStmt &);
652   bool Pre(const parser::GenericStmt &);
653   void Post(const parser::GenericStmt &);
654
655   bool inInterfaceBlock() const;
656   bool isGeneric() const;
657   bool isAbstract() const;
658
659 protected:
660   GenericDetails &GetGenericDetails();
661   // Add to generic the symbol for the subprogram with the same name
662   void CheckGenericProcedures(Symbol &);
663
664 private:
665   // A new GenericInfo is pushed for each interface block and generic stmt
666   struct GenericInfo {
667     GenericInfo(bool isInterface, bool isAbstract = false)
668         : isInterface{isInterface}, isAbstract{isAbstract} {}
669     bool isInterface; // in interface block
670     bool isAbstract; // in abstract interface block
671     Symbol *symbol{nullptr}; // the generic symbol being defined
672   };
673   std::stack<GenericInfo> genericInfo_;
674   const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }
675   void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }
676
677   using ProcedureKind = parser::ProcedureStmt::Kind;
678   // mapping of generic to its specific proc names and kinds
679   std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>
680       specificProcs_;
681
682   void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
683   void ResolveSpecificsInGeneric(Symbol &generic);
684 };
685
686 class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
687 public:
688   bool HandleStmtFunction(const parser::StmtFunctionStmt &);
689   bool Pre(const parser::SubroutineStmt &);
690   void Post(const parser::SubroutineStmt &);
691   bool Pre(const parser::FunctionStmt &);
692   void Post(const parser::FunctionStmt &);
693   bool Pre(const parser::EntryStmt &);
694   void Post(const parser::EntryStmt &);
695   bool Pre(const parser::InterfaceBody::Subroutine &);
696   void Post(const parser::InterfaceBody::Subroutine &);
697   bool Pre(const parser::InterfaceBody::Function &);
698   void Post(const parser::InterfaceBody::Function &);
699   bool Pre(const parser::Suffix &);
700   bool Pre(const parser::PrefixSpec &);
701   void Post(const parser::ImplicitPart &);
702
703   bool BeginSubprogram(
704       const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
705   bool BeginMpSubprogram(const parser::Name &);
706   void PushBlockDataScope(const parser::Name &);
707   void EndSubprogram();
708
709 protected:
710   // Set when we see a stmt function that is really an array element assignment
711   bool badStmtFuncFound_{false};
712
713 private:
714   // Info about the current function: parse tree of the type in the PrefixSpec;
715   // name and symbol of the function result from the Suffix; source location.
716   struct {
717     const parser::DeclarationTypeSpec *parsedType{nullptr};
718     const parser::Name *resultName{nullptr};
719     Symbol *resultSymbol{nullptr};
720     std::optional<SourceName> source;
721   } funcInfo_;
722
723   // Create a subprogram symbol in the current scope and push a new scope.
724   void CheckExtantExternal(const parser::Name &, Symbol::Flag);
725   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
726   Symbol *GetSpecificFromGeneric(const parser::Name &);
727   SubprogramDetails &PostSubprogramStmt(const parser::Name &);
728 };
729
730 class DeclarationVisitor : public ArraySpecVisitor,
731                            public virtual ScopeHandler {
732 public:
733   using ArraySpecVisitor::Post;
734   using ScopeHandler::Post;
735   using ScopeHandler::Pre;
736
737   bool Pre(const parser::Initialization &);
738   void Post(const parser::EntityDecl &);
739   void Post(const parser::ObjectDecl &);
740   void Post(const parser::PointerDecl &);
741   bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
742   void Post(const parser::BindStmt &) { EndAttrs(); }
743   bool Pre(const parser::BindEntity &);
744   bool Pre(const parser::NamedConstantDef &);
745   bool Pre(const parser::NamedConstant &);
746   void Post(const parser::EnumDef &);
747   bool Pre(const parser::Enumerator &);
748   bool Pre(const parser::AccessSpec &);
749   bool Pre(const parser::AsynchronousStmt &);
750   bool Pre(const parser::ContiguousStmt &);
751   bool Pre(const parser::ExternalStmt &);
752   bool Pre(const parser::IntentStmt &);
753   bool Pre(const parser::IntrinsicStmt &);
754   bool Pre(const parser::OptionalStmt &);
755   bool Pre(const parser::ProtectedStmt &);
756   bool Pre(const parser::ValueStmt &);
757   bool Pre(const parser::VolatileStmt &);
758   bool Pre(const parser::AllocatableStmt &) {
759     objectDeclAttr_ = Attr::ALLOCATABLE;
760     return true;
761   }
762   void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
763   bool Pre(const parser::TargetStmt &) {
764     objectDeclAttr_ = Attr::TARGET;
765     return true;
766   }
767   void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
768   void Post(const parser::DimensionStmt::Declaration &);
769   void Post(const parser::CodimensionDecl &);
770   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
771   void Post(const parser::TypeDeclarationStmt &);
772   void Post(const parser::IntegerTypeSpec &);
773   void Post(const parser::IntrinsicTypeSpec::Real &);
774   void Post(const parser::IntrinsicTypeSpec::Complex &);
775   void Post(const parser::IntrinsicTypeSpec::Logical &);
776   void Post(const parser::IntrinsicTypeSpec::Character &);
777   void Post(const parser::CharSelector::LengthAndKind &);
778   void Post(const parser::CharLength &);
779   void Post(const parser::LengthSelector &);
780   bool Pre(const parser::KindParam &);
781   bool Pre(const parser::DeclarationTypeSpec::Type &);
782   void Post(const parser::DeclarationTypeSpec::Type &);
783   bool Pre(const parser::DeclarationTypeSpec::Class &);
784   void Post(const parser::DeclarationTypeSpec::Class &);
785   bool Pre(const parser::DeclarationTypeSpec::Record &);
786   void Post(const parser::DerivedTypeSpec &);
787   bool Pre(const parser::DerivedTypeDef &);
788   bool Pre(const parser::DerivedTypeStmt &);
789   void Post(const parser::DerivedTypeStmt &);
790   bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
791   void Post(const parser::TypeParamDefStmt &);
792   bool Pre(const parser::TypeAttrSpec::Extends &);
793   bool Pre(const parser::PrivateStmt &);
794   bool Pre(const parser::SequenceStmt &);
795   bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
796   void Post(const parser::ComponentDefStmt &) { EndDecl(); }
797   void Post(const parser::ComponentDecl &);
798   bool Pre(const parser::ProcedureDeclarationStmt &);
799   void Post(const parser::ProcedureDeclarationStmt &);
800   bool Pre(const parser::DataComponentDefStmt &); // returns false
801   bool Pre(const parser::ProcComponentDefStmt &);
802   void Post(const parser::ProcComponentDefStmt &);
803   bool Pre(const parser::ProcPointerInit &);
804   void Post(const parser::ProcInterface &);
805   void Post(const parser::ProcDecl &);
806   bool Pre(const parser::TypeBoundProcedurePart &);
807   void Post(const parser::TypeBoundProcedurePart &);
808   void Post(const parser::ContainsStmt &);
809   bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
810   void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
811   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
812   void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
813   void Post(const parser::FinalProcedureStmt &);
814   bool Pre(const parser::TypeBoundGenericStmt &);
815   bool Pre(const parser::AllocateStmt &);
816   void Post(const parser::AllocateStmt &);
817   bool Pre(const parser::StructureConstructor &);
818   bool Pre(const parser::NamelistStmt::Group &);
819   bool Pre(const parser::IoControlSpec &);
820   bool Pre(const parser::CommonStmt::Block &);
821   bool Pre(const parser::CommonBlockObject &);
822   void Post(const parser::CommonBlockObject &);
823   bool Pre(const parser::EquivalenceStmt &);
824   bool Pre(const parser::SaveStmt &);
825   bool Pre(const parser::BasedPointerStmt &);
826
827   void PointerInitialization(
828       const parser::Name &, const parser::InitialDataTarget &);
829   void PointerInitialization(
830       const parser::Name &, const parser::ProcPointerInit &);
831   void NonPointerInitialization(
832       const parser::Name &, const parser::ConstantExpr &);
833   void CheckExplicitInterface(const parser::Name &);
834   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
835
836   const parser::Name *ResolveDesignator(const parser::Designator &);
837
838 protected:
839   bool BeginDecl();
840   void EndDecl();
841   Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
842   // Make sure that there's an entity in an enclosing scope called Name
843   Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
844   // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
845   // it comes from the entity in the containing scope, or implicit rules.
846   // Return pointer to the new symbol, or nullptr on error.
847   Symbol *DeclareLocalEntity(const parser::Name &);
848   // Declare a statement entity (e.g., an implied DO loop index).
849   // If there isn't a type specified, implicit rules apply.
850   // Return pointer to the new symbol, or nullptr on error.
851   Symbol *DeclareStatementEntity(
852       const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
853   Symbol &MakeCommonBlockSymbol(const parser::Name &);
854   Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
855   bool CheckUseError(const parser::Name &);
856   void CheckAccessibility(const SourceName &, bool, Symbol &);
857   void CheckCommonBlocks();
858   void CheckSaveStmts();
859   void CheckEquivalenceSets();
860   bool CheckNotInBlock(const char *);
861   bool NameIsKnownOrIntrinsic(const parser::Name &);
862
863   // Each of these returns a pointer to a resolved Name (i.e. with symbol)
864   // or nullptr in case of error.
865   const parser::Name *ResolveStructureComponent(
866       const parser::StructureComponent &);
867   const parser::Name *ResolveDataRef(const parser::DataRef &);
868   const parser::Name *ResolveName(const parser::Name &);
869   bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
870   Symbol *NoteInterfaceName(const parser::Name &);
871
872 private:
873   // The attribute corresponding to the statement containing an ObjectDecl
874   std::optional<Attr> objectDeclAttr_;
875   // Info about current character type while walking DeclTypeSpec.
876   // Also captures any "*length" specifier on an individual declaration.
877   struct {
878     std::optional<ParamValue> length;
879     std::optional<KindExpr> kind;
880   } charInfo_;
881   // Info about current derived type while walking DerivedTypeDef
882   struct {
883     const parser::Name *extends{nullptr}; // EXTENDS(name)
884     bool privateComps{false}; // components are private by default
885     bool privateBindings{false}; // bindings are private by default
886     bool sawContains{false}; // currently processing bindings
887     bool sequence{false}; // is a sequence type
888     const Symbol *type{nullptr}; // derived type being defined
889   } derivedTypeInfo_;
890   // Collect equivalence sets and process at end of specification part
891   std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets_;
892   // Names of all common block objects in the scope
893   std::set<SourceName> commonBlockObjects_;
894   // Info about about SAVE statements and attributes in current scope
895   struct {
896     std::optional<SourceName> saveAll; // "SAVE" without entity list
897     std::set<SourceName> entities; // names of entities with save attr
898     std::set<SourceName> commons; // names of common blocks with save attr
899   } saveInfo_;
900   // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
901   // the interface name, if any.
902   const parser::Name *interfaceName_{nullptr};
903   // Map type-bound generic to binding names of its specific bindings
904   std::multimap<Symbol *, const parser::Name *> genericBindings_;
905   // Info about current ENUM
906   struct EnumeratorState {
907     // Enum value must hold inside a C_INT (7.6.2).
908     std::optional<int> value{0};
909   } enumerationState_;
910
911   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
912   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
913   Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
914   Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &);
915   void SetType(const parser::Name &, const DeclTypeSpec &);
916   std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
917   std::optional<DerivedTypeSpec> ResolveExtendsType(
918       const parser::Name &, const parser::Name *);
919   Symbol *MakeTypeSymbol(const SourceName &, Details &&);
920   Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
921   bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
922   ParamValue GetParamValue(
923       const parser::TypeParamValue &, common::TypeParamAttr attr);
924   void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
925   std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
926   Attrs HandleSaveName(const SourceName &, Attrs);
927   void AddSaveName(std::set<SourceName> &, const SourceName &);
928   void SetSaveAttr(Symbol &);
929   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
930   bool IsUplevelReference(const Symbol &);
931   const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
932   void Initialization(const parser::Name &, const parser::Initialization &,
933       bool inComponentDecl);
934   bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
935   bool CheckForHostAssociatedImplicit(const parser::Name &);
936
937   // Declare an object or procedure entity.
938   // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
939   template <typename T>
940   Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
941     Symbol &symbol{MakeSymbol(name, attrs)};
942     if (context().HasError(symbol) || symbol.has<T>()) {
943       return symbol; // OK or error already reported
944     } else if (symbol.has<UnknownDetails>()) {
945       symbol.set_details(T{});
946       return symbol;
947     } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
948       symbol.set_details(T{std::move(*details)});
949       return symbol;
950     } else if (std::is_same_v<EntityDetails, T> &&
951         (symbol.has<ObjectEntityDetails>() ||
952             symbol.has<ProcEntityDetails>())) {
953       return symbol; // OK
954     } else if (auto *details{symbol.detailsIf<UseDetails>()}) {
955       Say(name.source,
956           "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
957           name.source, GetUsedModule(*details).name());
958     } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
959       if (details->kind() == SubprogramKind::Module) {
960         Say2(name,
961             "Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
962             symbol, "Module procedure definition"_en_US);
963       } else if (details->kind() == SubprogramKind::Internal) {
964         Say2(name,
965             "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
966             symbol, "Internal procedure definition"_en_US);
967       } else {
968         DIE("unexpected kind");
969       }
970     } else if (std::is_same_v<ObjectEntityDetails, T> &&
971         symbol.has<ProcEntityDetails>()) {
972       SayWithDecl(
973           name, symbol, "'%s' is already declared as a procedure"_err_en_US);
974     } else if (std::is_same_v<ProcEntityDetails, T> &&
975         symbol.has<ObjectEntityDetails>()) {
976       if (InCommonBlock(symbol)) {
977         SayWithDecl(name, symbol,
978             "'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
979       } else {
980         SayWithDecl(
981             name, symbol, "'%s' is already declared as an object"_err_en_US);
982       }
983     } else if (!CheckPossibleBadForwardRef(symbol)) {
984       SayAlreadyDeclared(name, symbol);
985     }
986     context().SetError(symbol);
987     return symbol;
988   }
989 };
990
991 // Resolve construct entities and statement entities.
992 // Check that construct names don't conflict with other names.
993 class ConstructVisitor : public virtual DeclarationVisitor {
994 public:
995   bool Pre(const parser::ConcurrentHeader &);
996   bool Pre(const parser::LocalitySpec::Local &);
997   bool Pre(const parser::LocalitySpec::LocalInit &);
998   bool Pre(const parser::LocalitySpec::Shared &);
999   bool Pre(const parser::AcSpec &);
1000   bool Pre(const parser::AcImpliedDo &);
1001   bool Pre(const parser::DataImpliedDo &);
1002   bool Pre(const parser::DataIDoObject &);
1003   bool Pre(const parser::DataStmtObject &);
1004   bool Pre(const parser::DataStmtValue &);
1005   bool Pre(const parser::DoConstruct &);
1006   void Post(const parser::DoConstruct &);
1007   bool Pre(const parser::ForallConstruct &);
1008   void Post(const parser::ForallConstruct &);
1009   bool Pre(const parser::ForallStmt &);
1010   void Post(const parser::ForallStmt &);
1011   bool Pre(const parser::BlockStmt &);
1012   bool Pre(const parser::EndBlockStmt &);
1013   void Post(const parser::Selector &);
1014   void Post(const parser::AssociateStmt &);
1015   void Post(const parser::EndAssociateStmt &);
1016   bool Pre(const parser::Association &);
1017   void Post(const parser::SelectTypeStmt &);
1018   void Post(const parser::SelectRankStmt &);
1019   bool Pre(const parser::SelectTypeConstruct &);
1020   void Post(const parser::SelectTypeConstruct &);
1021   bool Pre(const parser::SelectTypeConstruct::TypeCase &);
1022   void Post(const parser::SelectTypeConstruct::TypeCase &);
1023   // Creates Block scopes with neither symbol name nor symbol details.
1024   bool Pre(const parser::SelectRankConstruct::RankCase &);
1025   void Post(const parser::SelectRankConstruct::RankCase &);
1026   void Post(const parser::TypeGuardStmt::Guard &);
1027   void Post(const parser::SelectRankCaseStmt::Rank &);
1028   bool Pre(const parser::ChangeTeamStmt &);
1029   void Post(const parser::EndChangeTeamStmt &);
1030   void Post(const parser::CoarrayAssociation &);
1031
1032   // Definitions of construct names
1033   bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
1034   bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
1035   bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
1036   bool Pre(const parser::LabelDoStmt &) {
1037     return false; // error recovery
1038   }
1039   bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
1040   bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
1041   bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
1042   bool Pre(const parser::SelectRankConstruct &);
1043   void Post(const parser::SelectRankConstruct &);
1044   bool Pre(const parser::SelectRankStmt &x) {
1045     return CheckDef(std::get<0>(x.t));
1046   }
1047   bool Pre(const parser::SelectTypeStmt &x) {
1048     return CheckDef(std::get<0>(x.t));
1049   }
1050
1051   // References to construct names
1052   void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }
1053   void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }
1054   void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
1055   void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
1056   void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
1057   void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
1058   void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }
1059   void Post(const parser::ElseStmt &x) { CheckRef(x.v); }
1060   void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }
1061   void Post(const parser::CaseStmt &x) { CheckRef(x.t); }
1062   void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }
1063   void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }
1064   void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }
1065   void Post(const parser::CycleStmt &x) { CheckRef(x.v); }
1066   void Post(const parser::ExitStmt &x) { CheckRef(x.v); }
1067
1068 private:
1069   // R1105 selector -> expr | variable
1070   // expr is set in either case unless there were errors
1071   struct Selector {
1072     Selector() {}
1073     Selector(const SourceName &source, MaybeExpr &&expr)
1074         : source{source}, expr{std::move(expr)} {}
1075     operator bool() const { return expr.has_value(); }
1076     parser::CharBlock source;
1077     MaybeExpr expr;
1078   };
1079   // association -> [associate-name =>] selector
1080   struct Association {
1081     const parser::Name *name{nullptr};
1082     Selector selector;
1083   };
1084   std::vector<Association> associationStack_;
1085   Association *currentAssociation_{nullptr};
1086
1087   template <typename T> bool CheckDef(const T &t) {
1088     return CheckDef(std::get<std::optional<parser::Name>>(t));
1089   }
1090   template <typename T> void CheckRef(const T &t) {
1091     CheckRef(std::get<std::optional<parser::Name>>(t));
1092   }
1093   bool CheckDef(const std::optional<parser::Name> &);
1094   void CheckRef(const std::optional<parser::Name> &);
1095   const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
1096   const DeclTypeSpec &ToDeclTypeSpec(
1097       evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
1098   Symbol *MakeAssocEntity();
1099   void SetTypeFromAssociation(Symbol &);
1100   void SetAttrsFromAssociation(Symbol &);
1101   Selector ResolveSelector(const parser::Selector &);
1102   void ResolveIndexName(const parser::ConcurrentControl &control);
1103   void SetCurrentAssociation(std::size_t n);
1104   Association &GetCurrentAssociation();
1105   void PushAssociation();
1106   void PopAssociation(std::size_t count = 1);
1107 };
1108
1109 // Create scopes for OpenACC constructs
1110 class AccVisitor : public virtual DeclarationVisitor {
1111 public:
1112   void AddAccSourceRange(const parser::CharBlock &);
1113
1114   static bool NeedsScope(const parser::OpenACCBlockConstruct &);
1115
1116   bool Pre(const parser::OpenACCBlockConstruct &);
1117   void Post(const parser::OpenACCBlockConstruct &);
1118   bool Pre(const parser::AccBeginBlockDirective &x) {
1119     AddAccSourceRange(x.source);
1120     return true;
1121   }
1122   void Post(const parser::AccBeginBlockDirective &) {
1123     messageHandler().set_currStmtSource(std::nullopt);
1124   }
1125   bool Pre(const parser::AccEndBlockDirective &x) {
1126     AddAccSourceRange(x.source);
1127     return true;
1128   }
1129   void Post(const parser::AccEndBlockDirective &) {
1130     messageHandler().set_currStmtSource(std::nullopt);
1131   }
1132   bool Pre(const parser::AccBeginLoopDirective &x) {
1133     AddAccSourceRange(x.source);
1134     return true;
1135   }
1136   void Post(const parser::AccBeginLoopDirective &x) {
1137     messageHandler().set_currStmtSource(std::nullopt);
1138   }
1139 };
1140
1141 bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) {
1142   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
1143   const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
1144   switch (beginDir.v) {
1145   case llvm::acc::Directive::ACCD_data:
1146   case llvm::acc::Directive::ACCD_host_data:
1147   case llvm::acc::Directive::ACCD_kernels:
1148   case llvm::acc::Directive::ACCD_parallel:
1149   case llvm::acc::Directive::ACCD_serial:
1150     return true;
1151   default:
1152     return false;
1153   }
1154 }
1155
1156 void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) {
1157   messageHandler().set_currStmtSource(source);
1158   currScope().AddSourceRange(source);
1159 }
1160
1161 bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
1162   if (NeedsScope(x)) {
1163     PushScope(Scope::Kind::Block, nullptr);
1164   }
1165   return true;
1166 }
1167
1168 void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) {
1169   if (NeedsScope(x)) {
1170     PopScope();
1171   }
1172 }
1173
1174 // Create scopes for OpenMP constructs
1175 class OmpVisitor : public virtual DeclarationVisitor {
1176 public:
1177   void AddOmpSourceRange(const parser::CharBlock &);
1178
1179   static bool NeedsScope(const parser::OpenMPBlockConstruct &);
1180
1181   bool Pre(const parser::OpenMPBlockConstruct &);
1182   void Post(const parser::OpenMPBlockConstruct &);
1183   bool Pre(const parser::OmpBeginBlockDirective &x) {
1184     AddOmpSourceRange(x.source);
1185     return true;
1186   }
1187   void Post(const parser::OmpBeginBlockDirective &) {
1188     messageHandler().set_currStmtSource(std::nullopt);
1189   }
1190   bool Pre(const parser::OmpEndBlockDirective &x) {
1191     AddOmpSourceRange(x.source);
1192     return true;
1193   }
1194   void Post(const parser::OmpEndBlockDirective &) {
1195     messageHandler().set_currStmtSource(std::nullopt);
1196   }
1197
1198   bool Pre(const parser::OpenMPLoopConstruct &) {
1199     PushScope(Scope::Kind::Block, nullptr);
1200     return true;
1201   }
1202   void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
1203   bool Pre(const parser::OmpBeginLoopDirective &x) {
1204     AddOmpSourceRange(x.source);
1205     return true;
1206   }
1207   void Post(const parser::OmpBeginLoopDirective &) {
1208     messageHandler().set_currStmtSource(std::nullopt);
1209   }
1210   bool Pre(const parser::OmpEndLoopDirective &x) {
1211     AddOmpSourceRange(x.source);
1212     return true;
1213   }
1214   void Post(const parser::OmpEndLoopDirective &) {
1215     messageHandler().set_currStmtSource(std::nullopt);
1216   }
1217
1218   bool Pre(const parser::OpenMPSectionsConstruct &) {
1219     PushScope(Scope::Kind::Block, nullptr);
1220     return true;
1221   }
1222   void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
1223   bool Pre(const parser::OmpBeginSectionsDirective &x) {
1224     AddOmpSourceRange(x.source);
1225     return true;
1226   }
1227   void Post(const parser::OmpBeginSectionsDirective &) {
1228     messageHandler().set_currStmtSource(std::nullopt);
1229   }
1230   bool Pre(const parser::OmpEndSectionsDirective &x) {
1231     AddOmpSourceRange(x.source);
1232     return true;
1233   }
1234   void Post(const parser::OmpEndSectionsDirective &) {
1235     messageHandler().set_currStmtSource(std::nullopt);
1236   }
1237 };
1238
1239 bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
1240   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1241   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1242   switch (beginDir.v) {
1243   case llvm::omp::Directive::OMPD_target_data:
1244   case llvm::omp::Directive::OMPD_master:
1245   case llvm::omp::Directive::OMPD_ordered:
1246     return false;
1247   default:
1248     return true;
1249   }
1250 }
1251
1252 void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
1253   messageHandler().set_currStmtSource(source);
1254   currScope().AddSourceRange(source);
1255 }
1256
1257 bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1258   if (NeedsScope(x)) {
1259     PushScope(Scope::Kind::Block, nullptr);
1260   }
1261   return true;
1262 }
1263
1264 void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1265   if (NeedsScope(x)) {
1266     PopScope();
1267   }
1268 }
1269
1270 // Walk the parse tree and resolve names to symbols.
1271 class ResolveNamesVisitor : public virtual ScopeHandler,
1272                             public ModuleVisitor,
1273                             public SubprogramVisitor,
1274                             public ConstructVisitor,
1275                             public OmpVisitor,
1276                             public AccVisitor {
1277 public:
1278   using AccVisitor::Post;
1279   using AccVisitor::Pre;
1280   using ArraySpecVisitor::Post;
1281   using ConstructVisitor::Post;
1282   using ConstructVisitor::Pre;
1283   using DeclarationVisitor::Post;
1284   using DeclarationVisitor::Pre;
1285   using ImplicitRulesVisitor::Post;
1286   using ImplicitRulesVisitor::Pre;
1287   using InterfaceVisitor::Post;
1288   using InterfaceVisitor::Pre;
1289   using ModuleVisitor::Post;
1290   using ModuleVisitor::Pre;
1291   using OmpVisitor::Post;
1292   using OmpVisitor::Pre;
1293   using ScopeHandler::Post;
1294   using ScopeHandler::Pre;
1295   using SubprogramVisitor::Post;
1296   using SubprogramVisitor::Pre;
1297
1298   ResolveNamesVisitor(SemanticsContext &context, ImplicitRulesMap &rules)
1299       : BaseVisitor{context, *this, rules} {
1300     PushScope(context.globalScope());
1301   }
1302
1303   // Default action for a parse tree node is to visit children.
1304   template <typename T> bool Pre(const T &) { return true; }
1305   template <typename T> void Post(const T &) {}
1306
1307   bool Pre(const parser::SpecificationPart &);
1308   void Post(const parser::Program &);
1309   bool Pre(const parser::ImplicitStmt &);
1310   void Post(const parser::PointerObject &);
1311   void Post(const parser::AllocateObject &);
1312   bool Pre(const parser::PointerAssignmentStmt &);
1313   void Post(const parser::Designator &);
1314   template <typename A, typename B>
1315   void Post(const parser::LoopBounds<A, B> &x) {
1316     ResolveName(*parser::Unwrap<parser::Name>(x.name));
1317   }
1318   void Post(const parser::ProcComponentRef &);
1319   bool Pre(const parser::FunctionReference &);
1320   bool Pre(const parser::CallStmt &);
1321   bool Pre(const parser::ImportStmt &);
1322   void Post(const parser::TypeGuardStmt &);
1323   bool Pre(const parser::StmtFunctionStmt &);
1324   bool Pre(const parser::DefinedOpName &);
1325   bool Pre(const parser::ProgramUnit &);
1326   void Post(const parser::AssignStmt &);
1327   void Post(const parser::AssignedGotoStmt &);
1328
1329   // These nodes should never be reached: they are handled in ProgramUnit
1330   bool Pre(const parser::MainProgram &) {
1331     llvm_unreachable("This node is handled in ProgramUnit");
1332   }
1333   bool Pre(const parser::FunctionSubprogram &) {
1334     llvm_unreachable("This node is handled in ProgramUnit");
1335   }
1336   bool Pre(const parser::SubroutineSubprogram &) {
1337     llvm_unreachable("This node is handled in ProgramUnit");
1338   }
1339   bool Pre(const parser::SeparateModuleSubprogram &) {
1340     llvm_unreachable("This node is handled in ProgramUnit");
1341   }
1342   bool Pre(const parser::Module &) {
1343     llvm_unreachable("This node is handled in ProgramUnit");
1344   }
1345   bool Pre(const parser::Submodule &) {
1346     llvm_unreachable("This node is handled in ProgramUnit");
1347   }
1348   bool Pre(const parser::BlockData &) {
1349     llvm_unreachable("This node is handled in ProgramUnit");
1350   }
1351
1352   void NoteExecutablePartCall(Symbol::Flag, const parser::Call &);
1353
1354   friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
1355
1356 private:
1357   // Kind of procedure we are expecting to see in a ProcedureDesignator
1358   std::optional<Symbol::Flag> expectedProcFlag_;
1359   std::optional<SourceName> prevImportStmt_;
1360
1361   void PreSpecificationConstruct(const parser::SpecificationConstruct &);
1362   void CreateCommonBlockSymbols(const parser::CommonStmt &);
1363   void CreateGeneric(const parser::GenericSpec &);
1364   void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
1365   void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
1366   void CheckImports();
1367   void CheckImport(const SourceName &, const SourceName &);
1368   void HandleCall(Symbol::Flag, const parser::Call &);
1369   void HandleProcedureName(Symbol::Flag, const parser::Name &);
1370   bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
1371   bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
1372   void ResolveSpecificationParts(ProgramTree &);
1373   void AddSubpNames(ProgramTree &);
1374   bool BeginScopeForNode(const ProgramTree &);
1375   void FinishSpecificationParts(const ProgramTree &);
1376   void FinishDerivedTypeInstantiation(Scope &);
1377   void ResolveExecutionParts(const ProgramTree &);
1378 };
1379
1380 // ImplicitRules implementation
1381
1382 bool ImplicitRules::isImplicitNoneType() const {
1383   if (isImplicitNoneType_) {
1384     return true;
1385   } else if (map_.empty() && inheritFromParent_) {
1386     return parent_->isImplicitNoneType();
1387   } else {
1388     return false; // default if not specified
1389   }
1390 }
1391
1392 bool ImplicitRules::isImplicitNoneExternal() const {
1393   if (isImplicitNoneExternal_) {
1394     return true;
1395   } else if (inheritFromParent_) {
1396     return parent_->isImplicitNoneExternal();
1397   } else {
1398     return false; // default if not specified
1399   }
1400 }
1401
1402 const DeclTypeSpec *ImplicitRules::GetType(SourceName name) const {
1403   char ch{name.begin()[0]};
1404   if (isImplicitNoneType_) {
1405     return nullptr;
1406   } else if (auto it{map_.find(ch)}; it != map_.end()) {
1407     return &*it->second;
1408   } else if (inheritFromParent_) {
1409     return parent_->GetType(name);
1410   } else if (ch >= 'i' && ch <= 'n') {
1411     return &context_.MakeNumericType(TypeCategory::Integer);
1412   } else if (ch >= 'a' && ch <= 'z') {
1413     return &context_.MakeNumericType(TypeCategory::Real);
1414   } else {
1415     return nullptr;
1416   }
1417 }
1418
1419 void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
1420     parser::Location fromLetter, parser::Location toLetter) {
1421   for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
1422     auto res{map_.emplace(ch, type)};
1423     if (!res.second) {
1424       context_.Say(parser::CharBlock{fromLetter},
1425           "More than one implicit type specified for '%c'"_err_en_US, ch);
1426     }
1427     if (ch == *toLetter) {
1428       break;
1429     }
1430   }
1431 }
1432
1433 // Return the next char after ch in a way that works for ASCII or EBCDIC.
1434 // Return '\0' for the char after 'z'.
1435 char ImplicitRules::Incr(char ch) {
1436   switch (ch) {
1437   case 'i':
1438     return 'j';
1439   case 'r':
1440     return 's';
1441   case 'z':
1442     return '\0';
1443   default:
1444     return ch + 1;
1445   }
1446 }
1447
1448 llvm::raw_ostream &operator<<(
1449     llvm::raw_ostream &o, const ImplicitRules &implicitRules) {
1450   o << "ImplicitRules:\n";
1451   for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
1452     ShowImplicitRule(o, implicitRules, ch);
1453   }
1454   ShowImplicitRule(o, implicitRules, '_');
1455   ShowImplicitRule(o, implicitRules, '$');
1456   ShowImplicitRule(o, implicitRules, '@');
1457   return o;
1458 }
1459 void ShowImplicitRule(
1460     llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {
1461   auto it{implicitRules.map_.find(ch)};
1462   if (it != implicitRules.map_.end()) {
1463     o << "  " << ch << ": " << *it->second << '\n';
1464   }
1465 }
1466
1467 template <typename T> void BaseVisitor::Walk(const T &x) {
1468   parser::Walk(x, *this_);
1469 }
1470
1471 void BaseVisitor::MakePlaceholder(
1472     const parser::Name &name, MiscDetails::Kind kind) {
1473   if (!name.symbol) {
1474     name.symbol = &context_->globalScope().MakeSymbol(
1475         name.source, Attrs{}, MiscDetails{kind});
1476   }
1477 }
1478
1479 // AttrsVisitor implementation
1480
1481 bool AttrsVisitor::BeginAttrs() {
1482   CHECK(!attrs_);
1483   attrs_ = std::make_optional<Attrs>();
1484   return true;
1485 }
1486 Attrs AttrsVisitor::GetAttrs() {
1487   CHECK(attrs_);
1488   return *attrs_;
1489 }
1490 Attrs AttrsVisitor::EndAttrs() {
1491   Attrs result{GetAttrs()};
1492   attrs_.reset();
1493   passName_ = std::nullopt;
1494   bindName_.reset();
1495   return result;
1496 }
1497
1498 bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
1499   if (!passName_) {
1500     return false;
1501   }
1502   std::visit(common::visitors{
1503                  [&](ProcEntityDetails &x) { x.set_passName(*passName_); },
1504                  [&](ProcBindingDetails &x) { x.set_passName(*passName_); },
1505                  [](auto &) { common::die("unexpected pass name"); },
1506              },
1507       symbol.details());
1508   return true;
1509 }
1510
1511 bool AttrsVisitor::SetBindNameOn(Symbol &symbol) {
1512   if (!bindName_) {
1513     return false;
1514   }
1515   std::visit(
1516       common::visitors{
1517           [&](EntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1518           [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1519           [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
1520           [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); },
1521           [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); },
1522           [](auto &) { common::die("unexpected bind name"); },
1523       },
1524       symbol.details());
1525   return true;
1526 }
1527
1528 void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
1529   CHECK(attrs_);
1530   if (CheckAndSet(Attr::BIND_C)) {
1531     if (x.v) {
1532       bindName_ = EvaluateExpr(*x.v);
1533     }
1534   }
1535 }
1536 bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
1537   CHECK(attrs_);
1538   CheckAndSet(IntentSpecToAttr(x));
1539   return false;
1540 }
1541 bool AttrsVisitor::Pre(const parser::Pass &x) {
1542   if (CheckAndSet(Attr::PASS)) {
1543     if (x.v) {
1544       passName_ = x.v->source;
1545       MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
1546     }
1547   }
1548   return false;
1549 }
1550
1551 // C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
1552 bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
1553   if (attrs_->test(attrName)) {
1554     Say(currStmtSource().value(),
1555         "Attribute '%s' cannot be used more than once"_en_US,
1556         AttrToString(attrName));
1557     return true;
1558   }
1559   return false;
1560 }
1561
1562 // See if attrName violates a constraint cause by a conflict.  attr1 and attr2
1563 // name attributes that cannot be used on the same declaration
1564 bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
1565   if ((attrName == attr1 && attrs_->test(attr2)) ||
1566       (attrName == attr2 && attrs_->test(attr1))) {
1567     Say(currStmtSource().value(),
1568         "Attributes '%s' and '%s' conflict with each other"_err_en_US,
1569         AttrToString(attr1), AttrToString(attr2));
1570     return true;
1571   }
1572   return false;
1573 }
1574 // C759, C1543
1575 bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
1576   return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
1577       HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
1578       HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
1579       HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
1580       HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
1581       HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
1582       HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
1583 }
1584 bool AttrsVisitor::CheckAndSet(Attr attrName) {
1585   CHECK(attrs_);
1586   if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
1587     return false;
1588   }
1589   attrs_->set(attrName);
1590   return true;
1591 }
1592
1593 // DeclTypeSpecVisitor implementation
1594
1595 const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
1596   return state_.declTypeSpec;
1597 }
1598
1599 void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
1600   CHECK(!state_.expectDeclTypeSpec);
1601   CHECK(!state_.declTypeSpec);
1602   state_.expectDeclTypeSpec = true;
1603 }
1604 void DeclTypeSpecVisitor::EndDeclTypeSpec() {
1605   CHECK(state_.expectDeclTypeSpec);
1606   state_ = {};
1607 }
1608
1609 void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
1610     DeclTypeSpec::Category category) {
1611   CHECK(state_.expectDeclTypeSpec);
1612   state_.derived.category = category;
1613 }
1614
1615 bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
1616   BeginDeclTypeSpec();
1617   return true;
1618 }
1619 void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
1620   EndDeclTypeSpec();
1621 }
1622
1623 void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
1624   // Record the resolved DeclTypeSpec in the parse tree for use by
1625   // expression semantics if the DeclTypeSpec is a valid TypeSpec.
1626   // The grammar ensures that it's an intrinsic or derived type spec,
1627   // not TYPE(*) or CLASS(*) or CLASS(T).
1628   if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
1629     switch (spec->category()) {
1630     case DeclTypeSpec::Numeric:
1631     case DeclTypeSpec::Logical:
1632     case DeclTypeSpec::Character:
1633       typeSpec.declTypeSpec = spec;
1634       break;
1635     case DeclTypeSpec::TypeDerived:
1636       if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
1637         CheckForAbstractType(derived->typeSymbol()); // C703
1638         typeSpec.declTypeSpec = spec;
1639       }
1640       break;
1641     default:
1642       CRASH_NO_CASE;
1643     }
1644   }
1645 }
1646
1647 void DeclTypeSpecVisitor::Post(
1648     const parser::IntrinsicTypeSpec::DoublePrecision &) {
1649   MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
1650 }
1651 void DeclTypeSpecVisitor::Post(
1652     const parser::IntrinsicTypeSpec::DoubleComplex &) {
1653   MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
1654 }
1655 void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
1656   SetDeclTypeSpec(context().MakeNumericType(category, kind));
1657 }
1658
1659 void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {
1660   if (typeSymbol.attrs().test(Attr::ABSTRACT)) {
1661     Say("ABSTRACT derived type may not be used here"_err_en_US);
1662   }
1663 }
1664
1665 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
1666   SetDeclTypeSpec(context().globalScope().MakeClassStarType());
1667 }
1668 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
1669   SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
1670 }
1671
1672 // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
1673 // and save it in state_.declTypeSpec.
1674 void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
1675   CHECK(state_.expectDeclTypeSpec);
1676   CHECK(!state_.declTypeSpec);
1677   state_.declTypeSpec = &declTypeSpec;
1678 }
1679
1680 KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
1681     TypeCategory category, const std::optional<parser::KindSelector> &kind) {
1682   return AnalyzeKindSelector(context(), category, kind);
1683 }
1684
1685 // MessageHandler implementation
1686
1687 Message &MessageHandler::Say(MessageFixedText &&msg) {
1688   return context_->Say(currStmtSource().value(), std::move(msg));
1689 }
1690 Message &MessageHandler::Say(MessageFormattedText &&msg) {
1691   return context_->Say(currStmtSource().value(), std::move(msg));
1692 }
1693 Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
1694   return Say(name, std::move(msg), name);
1695 }
1696
1697 // ImplicitRulesVisitor implementation
1698
1699 void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
1700   prevParameterStmt_ = currStmtSource();
1701 }
1702
1703 bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
1704   bool result{
1705       std::visit(common::visitors{
1706                      [&](const std::list<ImplicitNoneNameSpec> &y) {
1707                        return HandleImplicitNone(y);
1708                      },
1709                      [&](const std::list<parser::ImplicitSpec> &) {
1710                        if (prevImplicitNoneType_) {
1711                          Say("IMPLICIT statement after IMPLICIT NONE or "
1712                              "IMPLICIT NONE(TYPE) statement"_err_en_US);
1713                          return false;
1714                        }
1715                        implicitRules_->set_isImplicitNoneType(false);
1716                        return true;
1717                      },
1718                  },
1719           x.u)};
1720   prevImplicit_ = currStmtSource();
1721   return result;
1722 }
1723
1724 bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
1725   auto loLoc{std::get<parser::Location>(x.t)};
1726   auto hiLoc{loLoc};
1727   if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
1728     hiLoc = *hiLocOpt;
1729     if (*hiLoc < *loLoc) {
1730       Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
1731           std::string(hiLoc, 1), std::string(loLoc, 1));
1732       return false;
1733     }
1734   }
1735   implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
1736   return false;
1737 }
1738
1739 bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
1740   BeginDeclTypeSpec();
1741   set_allowForwardReferenceToDerivedType(true);
1742   return true;
1743 }
1744
1745 void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
1746   EndDeclTypeSpec();
1747 }
1748
1749 void ImplicitRulesVisitor::SetScope(const Scope &scope) {
1750   implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);
1751   prevImplicit_ = std::nullopt;
1752   prevImplicitNone_ = std::nullopt;
1753   prevImplicitNoneType_ = std::nullopt;
1754   prevParameterStmt_ = std::nullopt;
1755 }
1756 void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
1757   // find or create implicit rules for this scope
1758   DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);
1759   SetScope(scope);
1760 }
1761
1762 // TODO: for all of these errors, reference previous statement too
1763 bool ImplicitRulesVisitor::HandleImplicitNone(
1764     const std::list<ImplicitNoneNameSpec> &nameSpecs) {
1765   if (prevImplicitNone_) {
1766     Say("More than one IMPLICIT NONE statement"_err_en_US);
1767     Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
1768     return false;
1769   }
1770   if (prevParameterStmt_) {
1771     Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
1772     return false;
1773   }
1774   prevImplicitNone_ = currStmtSource();
1775   bool implicitNoneTypeNever{
1776       context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
1777   if (nameSpecs.empty()) {
1778     if (!implicitNoneTypeNever) {
1779       prevImplicitNoneType_ = currStmtSource();
1780       implicitRules_->set_isImplicitNoneType(true);
1781       if (prevImplicit_) {
1782         Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
1783         return false;
1784       }
1785     }
1786   } else {
1787     int sawType{0};
1788     int sawExternal{0};
1789     for (const auto noneSpec : nameSpecs) {
1790       switch (noneSpec) {
1791       case ImplicitNoneNameSpec::External:
1792         implicitRules_->set_isImplicitNoneExternal(true);
1793         ++sawExternal;
1794         break;
1795       case ImplicitNoneNameSpec::Type:
1796         if (!implicitNoneTypeNever) {
1797           prevImplicitNoneType_ = currStmtSource();
1798           implicitRules_->set_isImplicitNoneType(true);
1799           if (prevImplicit_) {
1800             Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
1801             return false;
1802           }
1803           ++sawType;
1804         }
1805         break;
1806       }
1807     }
1808     if (sawType > 1) {
1809       Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
1810       return false;
1811     }
1812     if (sawExternal > 1) {
1813       Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
1814       return false;
1815     }
1816   }
1817   return true;
1818 }
1819
1820 // ArraySpecVisitor implementation
1821
1822 void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
1823   CHECK(arraySpec_.empty());
1824   arraySpec_ = AnalyzeArraySpec(context(), x);
1825 }
1826 void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
1827   CHECK(arraySpec_.empty());
1828   arraySpec_ = AnalyzeArraySpec(context(), x);
1829 }
1830 void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
1831   CHECK(coarraySpec_.empty());
1832   coarraySpec_ = AnalyzeCoarraySpec(context(), x);
1833 }
1834
1835 const ArraySpec &ArraySpecVisitor::arraySpec() {
1836   return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
1837 }
1838 const ArraySpec &ArraySpecVisitor::coarraySpec() {
1839   return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
1840 }
1841 void ArraySpecVisitor::BeginArraySpec() {
1842   CHECK(arraySpec_.empty());
1843   CHECK(coarraySpec_.empty());
1844   CHECK(attrArraySpec_.empty());
1845   CHECK(attrCoarraySpec_.empty());
1846 }
1847 void ArraySpecVisitor::EndArraySpec() {
1848   CHECK(arraySpec_.empty());
1849   CHECK(coarraySpec_.empty());
1850   attrArraySpec_.clear();
1851   attrCoarraySpec_.clear();
1852 }
1853 void ArraySpecVisitor::PostAttrSpec() {
1854   // Save dimension/codimension from attrs so we can process array/coarray-spec
1855   // on the entity-decl
1856   if (!arraySpec_.empty()) {
1857     if (attrArraySpec_.empty()) {
1858       attrArraySpec_ = arraySpec_;
1859       arraySpec_.clear();
1860     } else {
1861       Say(currStmtSource().value(),
1862           "Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
1863     }
1864   }
1865   if (!coarraySpec_.empty()) {
1866     if (attrCoarraySpec_.empty()) {
1867       attrCoarraySpec_ = coarraySpec_;
1868       coarraySpec_.clear();
1869     } else {
1870       Say(currStmtSource().value(),
1871           "Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
1872     }
1873   }
1874 }
1875
1876 // ScopeHandler implementation
1877
1878 void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
1879   SayAlreadyDeclared(name.source, prev);
1880 }
1881 void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
1882   if (context().HasError(prev)) {
1883     // don't report another error about prev
1884   } else {
1885     if (const auto *details{prev.detailsIf<UseDetails>()}) {
1886       Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
1887           .Attach(details->location(),
1888               "It is use-associated with '%s' in module '%s'"_err_en_US,
1889               details->symbol().name(), GetUsedModule(*details).name());
1890     } else {
1891       SayAlreadyDeclared(name, prev.name());
1892     }
1893     context().SetError(prev);
1894   }
1895 }
1896 void ScopeHandler::SayAlreadyDeclared(
1897     const SourceName &name1, const SourceName &name2) {
1898   if (name1.begin() < name2.begin()) {
1899     SayAlreadyDeclared(name2, name1);
1900   } else {
1901     Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
1902         .Attach(name2, "Previous declaration of '%s'"_en_US, name2);
1903   }
1904 }
1905
1906 void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
1907     MessageFixedText &&msg1, MessageFixedText &&msg2) {
1908   Say2(name, std::move(msg1), symbol, std::move(msg2));
1909   context().SetError(symbol, msg1.isFatal());
1910 }
1911
1912 void ScopeHandler::SayWithDecl(
1913     const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
1914   SayWithReason(name, symbol, std::move(msg),
1915       symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US
1916                                           : "Declaration of '%s'"_en_US);
1917 }
1918
1919 void ScopeHandler::SayLocalMustBeVariable(
1920     const parser::Name &name, Symbol &symbol) {
1921   SayWithDecl(name, symbol,
1922       "The name '%s' must be a variable to appear"
1923       " in a locality-spec"_err_en_US);
1924 }
1925
1926 void ScopeHandler::SayDerivedType(
1927     const SourceName &name, MessageFixedText &&msg, const Scope &type) {
1928   const Symbol &typeSymbol{DEREF(type.GetSymbol())};
1929   Say(name, std::move(msg), name, typeSymbol.name())
1930       .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
1931           typeSymbol.name());
1932 }
1933 void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
1934     const SourceName &name2, MessageFixedText &&msg2) {
1935   Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
1936 }
1937 void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
1938     Symbol &symbol, MessageFixedText &&msg2) {
1939   Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
1940   context().SetError(symbol, msg1.isFatal());
1941 }
1942 void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
1943     Symbol &symbol, MessageFixedText &&msg2) {
1944   Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
1945   context().SetError(symbol, msg1.isFatal());
1946 }
1947
1948 // T may be `Scope` or `const Scope`
1949 template <typename T> static T &GetInclusiveScope(T &scope) {
1950   for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
1951     if (s->kind() != Scope::Kind::Block && !s->IsDerivedType() &&
1952         !s->IsStmtFunction()) {
1953       return *s;
1954     }
1955   }
1956   return scope;
1957 }
1958
1959 Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); }
1960
1961 Scope *ScopeHandler::GetHostProcedure() {
1962   Scope &parent{InclusiveScope().parent()};
1963   return parent.kind() == Scope::Kind::Subprogram ? &parent : nullptr;
1964 }
1965
1966 Scope &ScopeHandler::NonDerivedTypeScope() {
1967   return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
1968 }
1969
1970 void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
1971   PushScope(currScope().MakeScope(kind, symbol));
1972 }
1973 void ScopeHandler::PushScope(Scope &scope) {
1974   currScope_ = &scope;
1975   auto kind{currScope_->kind()};
1976   if (kind != Scope::Kind::Block) {
1977     BeginScope(scope);
1978   }
1979   // The name of a module or submodule cannot be "used" in its scope,
1980   // as we read 19.3.1(2), so we allow the name to be used as a local
1981   // identifier in the module or submodule too.  Same with programs
1982   // (14.1(3)) and BLOCK DATA.
1983   if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
1984       kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
1985     if (auto *symbol{scope.symbol()}) {
1986       // Create a dummy symbol so we can't create another one with the same
1987       // name. It might already be there if we previously pushed the scope.
1988       if (!FindInScope(scope, symbol->name())) {
1989         auto &newSymbol{MakeSymbol(symbol->name())};
1990         if (kind == Scope::Kind::Subprogram) {
1991           // Allow for recursive references.  If this symbol is a function
1992           // without an explicit RESULT(), this new symbol will be discarded
1993           // and replaced with an object of the same name.
1994           newSymbol.set_details(HostAssocDetails{*symbol});
1995         } else {
1996           newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
1997         }
1998       }
1999     }
2000   }
2001 }
2002 void ScopeHandler::PopScope() {
2003   // Entities that are not yet classified as objects or procedures are now
2004   // assumed to be objects.
2005   // TODO: Statement functions
2006   for (auto &pair : currScope()) {
2007     ConvertToObjectEntity(*pair.second);
2008   }
2009   SetScope(currScope_->parent());
2010 }
2011 void ScopeHandler::SetScope(Scope &scope) {
2012   currScope_ = &scope;
2013   ImplicitRulesVisitor::SetScope(InclusiveScope());
2014 }
2015
2016 Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
2017   return FindSymbol(currScope(), name);
2018 }
2019 Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
2020   if (scope.IsDerivedType()) {
2021     if (Symbol * symbol{scope.FindComponent(name.source)}) {
2022       if (!symbol->has<ProcBindingDetails>() &&
2023           !symbol->test(Symbol::Flag::ParentComp)) {
2024         return Resolve(name, symbol);
2025       }
2026     }
2027     return FindSymbol(scope.parent(), name);
2028   } else {
2029     // In EQUIVALENCE statements only resolve names in the local scope, see
2030     // 19.5.1.4, paragraph 2, item (10)
2031     return Resolve(name,
2032         inEquivalenceStmt_ ? FindInScope(scope, name)
2033                            : scope.FindSymbol(name.source));
2034   }
2035 }
2036
2037 Symbol &ScopeHandler::MakeSymbol(
2038     Scope &scope, const SourceName &name, Attrs attrs) {
2039   if (Symbol * symbol{FindInScope(scope, name)}) {
2040     symbol->attrs() |= attrs;
2041     return *symbol;
2042   } else {
2043     const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
2044     CHECK(pair.second); // name was not found, so must be able to add
2045     return *pair.first->second;
2046   }
2047 }
2048 Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
2049   return MakeSymbol(currScope(), name, attrs);
2050 }
2051 Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
2052   return Resolve(name, MakeSymbol(name.source, attrs));
2053 }
2054 Symbol &ScopeHandler::MakeHostAssocSymbol(
2055     const parser::Name &name, const Symbol &hostSymbol) {
2056   Symbol &symbol{*NonDerivedTypeScope()
2057                       .try_emplace(name.source, HostAssocDetails{hostSymbol})
2058                       .first->second};
2059   name.symbol = &symbol;
2060   symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
2061   symbol.flags() = hostSymbol.flags();
2062   return symbol;
2063 }
2064 Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
2065   CHECK(!FindInScope(name));
2066   return MakeSymbol(currScope(), name, symbol.attrs());
2067 }
2068
2069 // Look for name only in scope, not in enclosing scopes.
2070 Symbol *ScopeHandler::FindInScope(
2071     const Scope &scope, const parser::Name &name) {
2072   return Resolve(name, FindInScope(scope, name.source));
2073 }
2074 Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
2075   // all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
2076   for (const std::string &n : GetAllNames(context(), name)) {
2077     auto it{scope.find(SourceName{n})};
2078     if (it != scope.end()) {
2079       return &*it->second;
2080     }
2081   }
2082   return nullptr;
2083 }
2084
2085 // Find a component or type parameter by name in a derived type or its parents.
2086 Symbol *ScopeHandler::FindInTypeOrParents(
2087     const Scope &scope, const parser::Name &name) {
2088   return Resolve(name, scope.FindComponent(name.source));
2089 }
2090 Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
2091   return FindInTypeOrParents(currScope(), name);
2092 }
2093
2094 void ScopeHandler::EraseSymbol(const parser::Name &name) {
2095   currScope().erase(name.source);
2096   name.symbol = nullptr;
2097 }
2098
2099 static bool NeedsType(const Symbol &symbol) {
2100   return !symbol.GetType() &&
2101       std::visit(common::visitors{
2102                      [](const EntityDetails &) { return true; },
2103                      [](const ObjectEntityDetails &) { return true; },
2104                      [](const AssocEntityDetails &) { return true; },
2105                      [&](const ProcEntityDetails &p) {
2106                        return symbol.test(Symbol::Flag::Function) &&
2107                            !symbol.attrs().test(Attr::INTRINSIC) &&
2108                            !p.interface().type() && !p.interface().symbol();
2109                      },
2110                      [](const auto &) { return false; },
2111                  },
2112           symbol.details());
2113 }
2114
2115 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
2116   if (NeedsType(symbol)) {
2117     const Scope *scope{&symbol.owner()};
2118     if (scope->IsGlobal()) {
2119       scope = &currScope();
2120     }
2121     if (const DeclTypeSpec *
2122         type{GetImplicitType(symbol, GetInclusiveScope(*scope))}) {
2123       symbol.set(Symbol::Flag::Implicit);
2124       symbol.SetType(*type);
2125       return;
2126     }
2127     if (symbol.has<ProcEntityDetails>() &&
2128         !symbol.attrs().test(Attr::EXTERNAL)) {
2129       std::optional<Symbol::Flag> functionOrSubroutineFlag;
2130       if (symbol.test(Symbol::Flag::Function)) {
2131         functionOrSubroutineFlag = Symbol::Flag::Function;
2132       } else if (symbol.test(Symbol::Flag::Subroutine)) {
2133         functionOrSubroutineFlag = Symbol::Flag::Subroutine;
2134       }
2135       if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
2136         // type will be determined in expression semantics
2137         symbol.attrs().set(Attr::INTRINSIC);
2138         return;
2139       }
2140     }
2141     if (!context().HasError(symbol)) {
2142       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
2143       context().SetError(symbol);
2144     }
2145   }
2146 }
2147
2148 const DeclTypeSpec *ScopeHandler::GetImplicitType(
2149     Symbol &symbol, const Scope &scope) {
2150   const auto *type{implicitRulesMap_->at(&scope).GetType(symbol.name())};
2151   if (type) {
2152     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
2153       // Resolve any forward-referenced derived type; a quick no-op else.
2154       auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
2155       instantiatable.Instantiate(currScope(), context());
2156     }
2157   }
2158   return type;
2159 }
2160
2161 // Convert symbol to be a ObjectEntity or return false if it can't be.
2162 bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
2163   if (symbol.has<ObjectEntityDetails>()) {
2164     // nothing to do
2165   } else if (symbol.has<UnknownDetails>()) {
2166     symbol.set_details(ObjectEntityDetails{});
2167   } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2168     symbol.set_details(ObjectEntityDetails{std::move(*details)});
2169   } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
2170     return useDetails->symbol().has<ObjectEntityDetails>();
2171   } else {
2172     return false;
2173   }
2174   return true;
2175 }
2176 // Convert symbol to be a ProcEntity or return false if it can't be.
2177 bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
2178   if (symbol.has<ProcEntityDetails>()) {
2179     // nothing to do
2180   } else if (symbol.has<UnknownDetails>()) {
2181     symbol.set_details(ProcEntityDetails{});
2182   } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2183     symbol.set_details(ProcEntityDetails{std::move(*details)});
2184     if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
2185       CHECK(!symbol.test(Symbol::Flag::Subroutine));
2186       symbol.set(Symbol::Flag::Function);
2187     }
2188   } else {
2189     return false;
2190   }
2191   return true;
2192 }
2193
2194 const DeclTypeSpec &ScopeHandler::MakeNumericType(
2195     TypeCategory category, const std::optional<parser::KindSelector> &kind) {
2196   KindExpr value{GetKindParamExpr(category, kind)};
2197   if (auto known{evaluate::ToInt64(value)}) {
2198     return context().MakeNumericType(category, static_cast<int>(*known));
2199   } else {
2200     return currScope_->MakeNumericType(category, std::move(value));
2201   }
2202 }
2203
2204 const DeclTypeSpec &ScopeHandler::MakeLogicalType(
2205     const std::optional<parser::KindSelector> &kind) {
2206   KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
2207   if (auto known{evaluate::ToInt64(value)}) {
2208     return context().MakeLogicalType(static_cast<int>(*known));
2209   } else {
2210     return currScope_->MakeLogicalType(std::move(value));
2211   }
2212 }
2213
2214 void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
2215   if (inSpecificationPart_ && name.symbol) {
2216     auto kind{currScope().kind()};
2217     if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
2218         kind == Scope::Kind::Block) {
2219       bool isHostAssociated{&name.symbol->owner() == &currScope()
2220               ? name.symbol->has<HostAssocDetails>()
2221               : name.symbol->owner().Contains(currScope())};
2222       if (isHostAssociated) {
2223         specPartForwardRefs_.insert(name.source);
2224       }
2225     }
2226   }
2227 }
2228
2229 std::optional<SourceName> ScopeHandler::HadForwardRef(
2230     const Symbol &symbol) const {
2231   auto iter{specPartForwardRefs_.find(symbol.name())};
2232   if (iter != specPartForwardRefs_.end()) {
2233     return *iter;
2234   }
2235   return std::nullopt;
2236 }
2237
2238 bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
2239   if (!context().HasError(symbol)) {
2240     if (auto fwdRef{HadForwardRef(symbol)}) {
2241       Say(*fwdRef,
2242           "Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
2243           *fwdRef)
2244           .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
2245       context().SetError(symbol);
2246       return true;
2247     }
2248   }
2249   return false;
2250 }
2251
2252 void ScopeHandler::MakeExternal(Symbol &symbol) {
2253   if (!symbol.attrs().test(Attr::EXTERNAL)) {
2254     symbol.attrs().set(Attr::EXTERNAL);
2255     if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
2256       Say(symbol.name(),
2257           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
2258           symbol.name());
2259     }
2260   }
2261 }
2262
2263 // ModuleVisitor implementation
2264
2265 bool ModuleVisitor::Pre(const parser::Only &x) {
2266   std::visit(common::visitors{
2267                  [&](const Indirection<parser::GenericSpec> &generic) {
2268                    AddUse(GenericSpecInfo{generic.value()});
2269                  },
2270                  [&](const parser::Name &name) {
2271                    Resolve(name, AddUse(name.source, name.source).use);
2272                  },
2273                  [&](const parser::Rename &rename) { Walk(rename); },
2274              },
2275       x.u);
2276   return false;
2277 }
2278
2279 bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
2280   const auto &localName{std::get<0>(x.t)};
2281   const auto &useName{std::get<1>(x.t)};
2282   SymbolRename rename{AddUse(localName.source, useName.source)};
2283   Resolve(useName, rename.use);
2284   Resolve(localName, rename.local);
2285   return false;
2286 }
2287 bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
2288   const parser::DefinedOpName &local{std::get<0>(x.t)};
2289   const parser::DefinedOpName &use{std::get<1>(x.t)};
2290   GenericSpecInfo localInfo{local};
2291   GenericSpecInfo useInfo{use};
2292   if (IsIntrinsicOperator(context(), local.v.source)) {
2293     Say(local.v,
2294         "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
2295   } else if (IsLogicalConstant(context(), local.v.source)) {
2296     Say(local.v,
2297         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
2298   } else {
2299     SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())};
2300     useInfo.Resolve(rename.use);
2301     localInfo.Resolve(rename.local);
2302   }
2303   return false;
2304 }
2305
2306 // Set useModuleScope_ to the Scope of the module being used.
2307 bool ModuleVisitor::Pre(const parser::UseStmt &x) {
2308   useModuleScope_ = FindModule(x.moduleName);
2309   if (!useModuleScope_) {
2310     return false;
2311   }
2312   // use the name from this source file
2313   useModuleScope_->symbol()->ReplaceName(x.moduleName.source);
2314   return true;
2315 }
2316
2317 void ModuleVisitor::Post(const parser::UseStmt &x) {
2318   if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
2319     // Not a use-only: collect the names that were used in renames,
2320     // then add a use for each public name that was not renamed.
2321     std::set<SourceName> useNames;
2322     for (const auto &rename : *list) {
2323       std::visit(common::visitors{
2324                      [&](const parser::Rename::Names &names) {
2325                        useNames.insert(std::get<1>(names.t).source);
2326                      },
2327                      [&](const parser::Rename::Operators &ops) {
2328                        useNames.insert(std::get<1>(ops.t).v.source);
2329                      },
2330                  },
2331           rename.u);
2332     }
2333     for (const auto &[name, symbol] : *useModuleScope_) {
2334       if (symbol->attrs().test(Attr::PUBLIC) &&
2335           !symbol->attrs().test(Attr::INTRINSIC) &&
2336           !symbol->has<MiscDetails>() && useNames.count(name) == 0) {
2337         SourceName location{x.moduleName.source};
2338         if (auto *localSymbol{FindInScope(name)}) {
2339           DoAddUse(location, localSymbol->name(), *localSymbol, *symbol);
2340         } else {
2341           DoAddUse(location, location, CopySymbol(name, *symbol), *symbol);
2342         }
2343       }
2344     }
2345   }
2346   useModuleScope_ = nullptr;
2347 }
2348
2349 ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2350     const SourceName &localName, const SourceName &useName) {
2351   return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));
2352 }
2353
2354 ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2355     const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {
2356   if (!useModuleScope_) {
2357     return {}; // error occurred finding module
2358   }
2359   if (!useSymbol) {
2360     Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName),
2361         useModuleScope_->GetName().value());
2362     return {};
2363   }
2364   if (useSymbol->attrs().test(Attr::PRIVATE) &&
2365       !FindModuleFileContaining(currScope())) {
2366     // Privacy is not enforced in module files so that generic interfaces
2367     // can be resolved to private specific procedures in specification
2368     // expressions.
2369     Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),
2370         useModuleScope_->GetName().value());
2371     return {};
2372   }
2373   auto &localSymbol{MakeSymbol(localName)};
2374   DoAddUse(useName, localName, localSymbol, *useSymbol);
2375   return {&localSymbol, useSymbol};
2376 }
2377
2378 // symbol must be either a Use or a Generic formed by merging two uses.
2379 // Convert it to a UseError with this additional location.
2380 static void ConvertToUseError(
2381     Symbol &symbol, const SourceName &location, const Scope &module) {
2382   const auto *useDetails{symbol.detailsIf<UseDetails>()};
2383   if (!useDetails) {
2384     auto &genericDetails{symbol.get<GenericDetails>()};
2385     useDetails = &genericDetails.uses().at(0)->get<UseDetails>();
2386   }
2387   symbol.set_details(
2388       UseErrorDetails{*useDetails}.add_occurrence(location, module));
2389 }
2390
2391 void ModuleVisitor::DoAddUse(const SourceName &location,
2392     const SourceName &localName, Symbol &localSymbol, const Symbol &useSymbol) {
2393   localSymbol.attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
2394   localSymbol.flags() = useSymbol.flags();
2395   const Symbol &useUltimate{useSymbol.GetUltimate()};
2396   if (auto *useDetails{localSymbol.detailsIf<UseDetails>()}) {
2397     const Symbol &localUltimate{localSymbol.GetUltimate()};
2398     if (localUltimate == useUltimate) {
2399       // use-associating the same symbol again -- ok
2400     } else if (localUltimate.has<GenericDetails>() &&
2401         useUltimate.has<GenericDetails>()) {
2402       // use-associating generics with the same names: merge them into a
2403       // new generic in this scope
2404       auto generic1{localUltimate.get<GenericDetails>()};
2405       AddGenericUse(generic1, localName, useUltimate);
2406       generic1.AddUse(localSymbol);
2407       // useSymbol has specific g and so does generic1
2408       auto &generic2{useUltimate.get<GenericDetails>()};
2409       if (generic1.derivedType() && generic2.derivedType() &&
2410           generic1.derivedType() != generic2.derivedType()) {
2411         Say(location,
2412             "Generic interface '%s' has ambiguous derived types"
2413             " from modules '%s' and '%s'"_err_en_US,
2414             localSymbol.name(), GetUsedModule(*useDetails).name(),
2415             useUltimate.owner().GetName().value());
2416         context().SetError(localSymbol);
2417       } else {
2418         generic1.CopyFrom(generic2);
2419       }
2420       EraseSymbol(localSymbol);
2421       MakeSymbol(localSymbol.name(), localSymbol.attrs(), std::move(generic1));
2422     } else {
2423       ConvertToUseError(localSymbol, location, *useModuleScope_);
2424     }
2425   } else if (auto *genericDetails{localSymbol.detailsIf<GenericDetails>()}) {
2426     if (const auto *useDetails{useUltimate.detailsIf<GenericDetails>()}) {
2427       AddGenericUse(*genericDetails, localName, useUltimate);
2428       if (genericDetails->derivedType() && useDetails->derivedType() &&
2429           genericDetails->derivedType() != useDetails->derivedType()) {
2430         Say(location,
2431             "Generic interface '%s' has ambiguous derived types"
2432             " from modules '%s' and '%s'"_err_en_US,
2433             localSymbol.name(),
2434             genericDetails->derivedType()->owner().GetName().value(),
2435             useDetails->derivedType()->owner().GetName().value());
2436       } else {
2437         genericDetails->CopyFrom(*useDetails);
2438       }
2439     } else {
2440       ConvertToUseError(localSymbol, location, *useModuleScope_);
2441     }
2442   } else if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) {
2443     details->add_occurrence(location, *useModuleScope_);
2444   } else if (!localSymbol.has<UnknownDetails>()) {
2445     Say(location,
2446         "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
2447         localName)
2448         .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US,
2449             localName);
2450   } else {
2451     localSymbol.set_details(UseDetails{localName, useSymbol});
2452   }
2453 }
2454
2455 void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
2456   if (useModuleScope_) {
2457     const auto &name{info.symbolName()};
2458     auto rename{AddUse(name, name, FindInScope(*useModuleScope_, name))};
2459     info.Resolve(rename.use);
2460   }
2461 }
2462
2463 // Create a UseDetails symbol for this USE and add it to generic
2464 void ModuleVisitor::AddGenericUse(
2465     GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {
2466   generic.AddUse(currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol}));
2467 }
2468
2469 bool ModuleVisitor::BeginSubmodule(
2470     const parser::Name &name, const parser::ParentIdentifier &parentId) {
2471   auto &ancestorName{std::get<parser::Name>(parentId.t)};
2472   auto &parentName{std::get<std::optional<parser::Name>>(parentId.t)};
2473   Scope *ancestor{FindModule(ancestorName)};
2474   if (!ancestor) {
2475     return false;
2476   }
2477   Scope *parentScope{parentName ? FindModule(*parentName, ancestor) : ancestor};
2478   if (!parentScope) {
2479     return false;
2480   }
2481   PushScope(*parentScope); // submodule is hosted in parent
2482   BeginModule(name, true);
2483   if (!ancestor->AddSubmodule(name.source, currScope())) {
2484     Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
2485         ancestorName.source, name.source);
2486   }
2487   return true;
2488 }
2489
2490 void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
2491   auto &symbol{MakeSymbol(name, ModuleDetails{isSubmodule})};
2492   auto &details{symbol.get<ModuleDetails>()};
2493   PushScope(Scope::Kind::Module, &symbol);
2494   details.set_scope(&currScope());
2495   defaultAccess_ = Attr::PUBLIC;
2496   prevAccessStmt_ = std::nullopt;
2497 }
2498
2499 // Find a module or submodule by name and return its scope.
2500 // If ancestor is present, look for a submodule of that ancestor module.
2501 // May have to read a .mod file to find it.
2502 // If an error occurs, report it and return nullptr.
2503 Scope *ModuleVisitor::FindModule(const parser::Name &name, Scope *ancestor) {
2504   ModFileReader reader{context()};
2505   Scope *scope{reader.Read(name.source, ancestor)};
2506   if (!scope) {
2507     return nullptr;
2508   }
2509   if (scope->kind() != Scope::Kind::Module) {
2510     Say(name, "'%s' is not a module"_err_en_US);
2511     return nullptr;
2512   }
2513   if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
2514     Say(name, "Module '%s' cannot USE itself"_err_en_US);
2515   }
2516   Resolve(name, scope->symbol());
2517   return scope;
2518 }
2519
2520 void ModuleVisitor::ApplyDefaultAccess() {
2521   for (auto &pair : currScope()) {
2522     Symbol &symbol = *pair.second;
2523     if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
2524       symbol.attrs().set(defaultAccess_);
2525     }
2526   }
2527 }
2528
2529 // InterfaceVistor implementation
2530
2531 bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
2532   bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
2533   genericInfo_.emplace(/*isInterface*/ true, isAbstract);
2534   return BeginAttrs();
2535 }
2536
2537 void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
2538
2539 void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
2540   genericInfo_.pop();
2541 }
2542
2543 // Create a symbol in genericSymbol_ for this GenericSpec.
2544 bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
2545   if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) {
2546     SetGenericSymbol(*symbol);
2547   }
2548   return false;
2549 }
2550
2551 bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
2552   if (!isGeneric()) {
2553     Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
2554     return false;
2555   }
2556   auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
2557   const auto &names{std::get<std::list<parser::Name>>(x.t)};
2558   AddSpecificProcs(names, kind);
2559   return false;
2560 }
2561
2562 bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
2563   genericInfo_.emplace(/*isInterface*/ false);
2564   return true;
2565 }
2566 void InterfaceVisitor::Post(const parser::GenericStmt &x) {
2567   if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) {
2568     GetGenericInfo().symbol->attrs().set(AccessSpecToAttr(*accessSpec));
2569   }
2570   const auto &names{std::get<std::list<parser::Name>>(x.t)};
2571   AddSpecificProcs(names, ProcedureKind::Procedure);
2572   genericInfo_.pop();
2573 }
2574
2575 bool InterfaceVisitor::inInterfaceBlock() const {
2576   return !genericInfo_.empty() && GetGenericInfo().isInterface;
2577 }
2578 bool InterfaceVisitor::isGeneric() const {
2579   return !genericInfo_.empty() && GetGenericInfo().symbol;
2580 }
2581 bool InterfaceVisitor::isAbstract() const {
2582   return !genericInfo_.empty() && GetGenericInfo().isAbstract;
2583 }
2584 GenericDetails &InterfaceVisitor::GetGenericDetails() {
2585   return GetGenericInfo().symbol->get<GenericDetails>();
2586 }
2587
2588 void InterfaceVisitor::AddSpecificProcs(
2589     const std::list<parser::Name> &names, ProcedureKind kind) {
2590   for (const auto &name : names) {
2591     specificProcs_.emplace(
2592         GetGenericInfo().symbol, std::make_pair(&name, kind));
2593   }
2594 }
2595
2596 // By now we should have seen all specific procedures referenced by name in
2597 // this generic interface. Resolve those names to symbols.
2598 void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
2599   auto &details{generic.get<GenericDetails>()};
2600   SymbolSet symbolsSeen;
2601   for (const Symbol &symbol : details.specificProcs()) {
2602     symbolsSeen.insert(symbol);
2603   }
2604   auto range{specificProcs_.equal_range(&generic)};
2605   for (auto it{range.first}; it != range.second; ++it) {
2606     auto *name{it->second.first};
2607     auto kind{it->second.second};
2608     const auto *symbol{FindSymbol(*name)};
2609     if (!symbol) {
2610       Say(*name, "Procedure '%s' not found"_err_en_US);
2611       continue;
2612     }
2613     if (symbol == &generic) {
2614       if (auto *specific{generic.get<GenericDetails>().specific()}) {
2615         symbol = specific;
2616       }
2617     }
2618     const Symbol &ultimate{symbol->GetUltimate()};
2619     if (!ultimate.has<SubprogramDetails>() &&
2620         !ultimate.has<SubprogramNameDetails>()) {
2621       Say(*name, "'%s' is not a subprogram"_err_en_US);
2622       continue;
2623     }
2624     if (kind == ProcedureKind::ModuleProcedure) {
2625       if (const auto *nd{ultimate.detailsIf<SubprogramNameDetails>()}) {
2626         if (nd->kind() != SubprogramKind::Module) {
2627           Say(*name, "'%s' is not a module procedure"_err_en_US);
2628         }
2629       } else {
2630         // USE-associated procedure
2631         const auto *sd{ultimate.detailsIf<SubprogramDetails>()};
2632         CHECK(sd);
2633         if (ultimate.owner().kind() != Scope::Kind::Module ||
2634             sd->isInterface()) {
2635           Say(*name, "'%s' is not a module procedure"_err_en_US);
2636         }
2637       }
2638     }
2639     if (!symbolsSeen.insert(ultimate).second) {
2640       if (symbol == &ultimate) {
2641         Say(name->source,
2642             "Procedure '%s' is already specified in generic '%s'"_err_en_US,
2643             name->source, MakeOpName(generic.name()));
2644       } else {
2645         Say(name->source,
2646             "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
2647             ultimate.name(), ultimate.owner().GetName().value(),
2648             MakeOpName(generic.name()));
2649       }
2650       continue;
2651     }
2652     details.AddSpecificProc(*symbol, name->source);
2653   }
2654   specificProcs_.erase(range.first, range.second);
2655 }
2656
2657 // Check that the specific procedures are all functions or all subroutines.
2658 // If there is a derived type with the same name they must be functions.
2659 // Set the corresponding flag on generic.
2660 void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
2661   ResolveSpecificsInGeneric(generic);
2662   auto &details{generic.get<GenericDetails>()};
2663   if (auto *proc{details.CheckSpecific()}) {
2664     auto msg{
2665         "'%s' may not be the name of both a generic interface and a"
2666         " procedure unless it is a specific procedure of the generic"_err_en_US};
2667     if (proc->name().begin() > generic.name().begin()) {
2668       Say(proc->name(), std::move(msg));
2669     } else {
2670       Say(generic.name(), std::move(msg));
2671     }
2672   }
2673   auto &specifics{details.specificProcs()};
2674   if (specifics.empty()) {
2675     if (details.derivedType()) {
2676       generic.set(Symbol::Flag::Function);
2677     }
2678     return;
2679   }
2680   const Symbol &firstSpecific{specifics.front()};
2681   bool isFunction{firstSpecific.test(Symbol::Flag::Function)};
2682   for (const Symbol &specific : specifics) {
2683     if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514
2684       auto &msg{Say(generic.name(),
2685           "Generic interface '%s' has both a function and a subroutine"_err_en_US)};
2686       if (isFunction) {
2687         msg.Attach(firstSpecific.name(), "Function declaration"_en_US);
2688         msg.Attach(specific.name(), "Subroutine declaration"_en_US);
2689       } else {
2690         msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US);
2691         msg.Attach(specific.name(), "Function declaration"_en_US);
2692       }
2693     }
2694   }
2695   if (!isFunction && details.derivedType()) {
2696     SayDerivedType(generic.name(),
2697         "Generic interface '%s' may only contain functions due to derived type"
2698         " with same name"_err_en_US,
2699         *details.derivedType()->scope());
2700   }
2701   generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
2702 }
2703
2704 // SubprogramVisitor implementation
2705
2706 // Return false if it is actually an assignment statement.
2707 bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
2708   const auto &name{std::get<parser::Name>(x.t)};
2709   const DeclTypeSpec *resultType{nullptr};
2710   // Look up name: provides return type or tells us if it's an array
2711   if (auto *symbol{FindSymbol(name)}) {
2712     auto *details{symbol->detailsIf<EntityDetails>()};
2713     if (!details) {
2714       badStmtFuncFound_ = true;
2715       return false;
2716     }
2717     // TODO: check that attrs are compatible with stmt func
2718     resultType = details->type();
2719     symbol->details() = UnknownDetails{}; // will be replaced below
2720   }
2721   if (badStmtFuncFound_) {
2722     Say(name, "'%s' has not been declared as an array"_err_en_US);
2723     return true;
2724   }
2725   auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
2726   symbol.set(Symbol::Flag::StmtFunction);
2727   EraseSymbol(symbol); // removes symbol added by PushSubprogramScope
2728   auto &details{symbol.get<SubprogramDetails>()};
2729   for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {
2730     ObjectEntityDetails dummyDetails{true};
2731     if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {
2732       if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) {
2733         if (d->type()) {
2734           dummyDetails.set_type(*d->type());
2735         }
2736       }
2737     }
2738     Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};
2739     ApplyImplicitRules(dummy);
2740     details.add_dummyArg(dummy);
2741   }
2742   ObjectEntityDetails resultDetails;
2743   if (resultType) {
2744     resultDetails.set_type(*resultType);
2745   }
2746   resultDetails.set_funcResult(true);
2747   Symbol &result{MakeSymbol(name, std::move(resultDetails))};
2748   ApplyImplicitRules(result);
2749   details.set_result(result);
2750   const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
2751   Walk(parsedExpr);
2752   // The analysis of the expression that constitutes the body of the
2753   // statement function is deferred to FinishSpecificationPart() so that
2754   // all declarations and implicit typing are complete.
2755   PopScope();
2756   return true;
2757 }
2758
2759 bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
2760   if (suffix.resultName) {
2761     funcInfo_.resultName = &suffix.resultName.value();
2762   }
2763   return true;
2764 }
2765
2766 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
2767   // Save this to process after UseStmt and ImplicitPart
2768   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
2769     if (funcInfo_.parsedType) { // C1543
2770       Say(currStmtSource().value(),
2771           "FUNCTION prefix cannot specify the type more than once"_err_en_US);
2772       return false;
2773     } else {
2774       funcInfo_.parsedType = parsedType;
2775       funcInfo_.source = currStmtSource();
2776       return false;
2777     }
2778   } else {
2779     return true;
2780   }
2781 }
2782
2783 void SubprogramVisitor::Post(const parser::ImplicitPart &) {
2784   // If the function has a type in the prefix, process it now
2785   if (funcInfo_.parsedType) {
2786     messageHandler().set_currStmtSource(funcInfo_.source);
2787     if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) {
2788       funcInfo_.resultSymbol->SetType(*type);
2789     }
2790   }
2791   funcInfo_ = {};
2792 }
2793
2794 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
2795   const auto &name{std::get<parser::Name>(
2796       std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
2797   return BeginSubprogram(name, Symbol::Flag::Subroutine);
2798 }
2799 void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &) {
2800   EndSubprogram();
2801 }
2802 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
2803   const auto &name{std::get<parser::Name>(
2804       std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)};
2805   return BeginSubprogram(name, Symbol::Flag::Function);
2806 }
2807 void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) {
2808   EndSubprogram();
2809 }
2810
2811 bool SubprogramVisitor::Pre(const parser::SubroutineStmt &) {
2812   return BeginAttrs();
2813 }
2814 bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
2815   return BeginAttrs();
2816 }
2817 bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
2818
2819 void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
2820   const auto &name{std::get<parser::Name>(stmt.t)};
2821   auto &details{PostSubprogramStmt(name)};
2822   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
2823     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
2824       Symbol &dummy{MakeSymbol(*dummyName, EntityDetails(true))};
2825       details.add_dummyArg(dummy);
2826     } else {
2827       details.add_alternateReturn();
2828     }
2829   }
2830 }
2831
2832 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
2833   const auto &name{std::get<parser::Name>(stmt.t)};
2834   auto &details{PostSubprogramStmt(name)};
2835   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
2836     Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))};
2837     details.add_dummyArg(dummy);
2838   }
2839   const parser::Name *funcResultName;
2840   if (funcInfo_.resultName && funcInfo_.resultName->source != name.source) {
2841     // Note that RESULT is ignored if it has the same name as the function.
2842     funcResultName = funcInfo_.resultName;
2843   } else {
2844     EraseSymbol(name); // was added by PushSubprogramScope
2845     funcResultName = &name;
2846   }
2847   // add function result to function scope
2848   EntityDetails funcResultDetails;
2849   funcResultDetails.set_funcResult(true);
2850   funcInfo_.resultSymbol =
2851       &MakeSymbol(*funcResultName, std::move(funcResultDetails));
2852   details.set_result(*funcInfo_.resultSymbol);
2853
2854   // C1560.
2855   if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) {
2856     Say(funcInfo_.resultName->source,
2857         "The function name should not appear in RESULT, references to '%s' "
2858         "inside"
2859         " the function will be considered as references to the result only"_en_US,
2860         name.source);
2861     // RESULT name was ignored above, the only side effect from doing so will be
2862     // the inability to make recursive calls. The related parser::Name is still
2863     // resolved to the created function result symbol because every parser::Name
2864     // should be resolved to avoid internal errors.
2865     Resolve(*funcInfo_.resultName, funcInfo_.resultSymbol);
2866   }
2867   name.symbol = currScope().symbol(); // must not be function result symbol
2868   // Clear the RESULT() name now in case an ENTRY statement in the implicit-part
2869   // has a RESULT() suffix.
2870   funcInfo_.resultName = nullptr;
2871 }
2872
2873 SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
2874     const parser::Name &name) {
2875   Symbol &symbol{*currScope().symbol()};
2876   CHECK(name.source == symbol.name());
2877   SetBindNameOn(symbol);
2878   symbol.attrs() |= EndAttrs();
2879   if (symbol.attrs().test(Attr::MODULE)) {
2880     symbol.attrs().set(Attr::EXTERNAL, false);
2881   }
2882   return symbol.get<SubprogramDetails>();
2883 }
2884
2885 void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
2886   auto attrs{EndAttrs()}; // needs to be called even if early return
2887   Scope &inclusiveScope{InclusiveScope()};
2888   const Symbol *subprogram{inclusiveScope.symbol()};
2889   if (!subprogram) {
2890     CHECK(context().AnyFatalError());
2891     return;
2892   }
2893   const auto &name{std::get<parser::Name>(stmt.t)};
2894   const auto *parentDetails{subprogram->detailsIf<SubprogramDetails>()};
2895   bool inFunction{parentDetails && parentDetails->isFunction()};
2896   const parser::Name *resultName{funcInfo_.resultName};
2897   if (resultName) { // RESULT(result) is present
2898     funcInfo_.resultName = nullptr;
2899     if (!inFunction) {
2900       Say2(resultName->source,
2901           "RESULT(%s) may appear only in a function"_err_en_US,
2902           subprogram->name(), "Containing subprogram"_en_US);
2903     } else if (resultName->source == subprogram->name()) { // C1574
2904       Say2(resultName->source,
2905           "RESULT(%s) may not have the same name as the function"_err_en_US,
2906           subprogram->name(), "Containing function"_en_US);
2907     } else if (const Symbol *
2908         symbol{FindSymbol(inclusiveScope.parent(), *resultName)}) { // C1574
2909       if (const auto *details{symbol->detailsIf<SubprogramDetails>()}) {
2910         if (details->entryScope() == &inclusiveScope) {
2911           Say2(resultName->source,
2912               "RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US,
2913               symbol->name(), "Conflicting ENTRY"_en_US);
2914         }
2915       }
2916     }
2917     if (Symbol * symbol{FindSymbol(name)}) { // C1570
2918       // When RESULT() appears, ENTRY name can't have been already declared
2919       if (inclusiveScope.Contains(symbol->owner())) {
2920         Say2(name,
2921             "ENTRY name '%s' may not be declared when RESULT() is present"_err_en_US,
2922             *symbol, "Previous declaration of '%s'"_en_US);
2923       }
2924     }
2925     if (resultName->source == name.source) {
2926       // ignore RESULT() hereafter when it's the same name as the ENTRY
2927       resultName = nullptr;
2928     }
2929   }
2930   SubprogramDetails entryDetails;
2931   entryDetails.set_entryScope(inclusiveScope);
2932   if (inFunction) {
2933     // Create the entity to hold the function result, if necessary.
2934     Symbol *resultSymbol{nullptr};
2935     auto &effectiveResultName{*(resultName ? resultName : &name)};
2936     resultSymbol = FindInScope(currScope(), effectiveResultName);
2937     if (resultSymbol) { // C1574
2938       std::visit(
2939           common::visitors{[](EntityDetails &x) { x.set_funcResult(true); },
2940               [](ObjectEntityDetails &x) { x.set_funcResult(true); },
2941               [](ProcEntityDetails &x) { x.set_funcResult(true); },
2942               [&](const auto &) {
2943                 Say2(effectiveResultName.source,
2944                     "'%s' was previously declared as an item that may not be used as a function result"_err_en_US,
2945                     resultSymbol->name(), "Previous declaration of '%s'"_en_US);
2946               }},
2947           resultSymbol->details());
2948     } else if (inExecutionPart_) {
2949       ObjectEntityDetails entity;
2950       entity.set_funcResult(true);
2951       resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
2952       ApplyImplicitRules(*resultSymbol);
2953     } else {
2954       EntityDetails entity;
2955       entity.set_funcResult(true);
2956       resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
2957     }
2958     if (!resultName) {
2959       name.symbol = nullptr; // symbol will be used for entry point below
2960     }
2961     entryDetails.set_result(*resultSymbol);
2962   }
2963
2964   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
2965     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
2966       Symbol *dummy{FindSymbol(*dummyName)};
2967       if (dummy) {
2968         std::visit(
2969             common::visitors{[](EntityDetails &x) { x.set_isDummy(); },
2970                 [](ObjectEntityDetails &x) { x.set_isDummy(); },
2971                 [](ProcEntityDetails &x) { x.set_isDummy(); },
2972                 [&](const auto &) {
2973                   Say2(dummyName->source,
2974                       "ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US,
2975                       dummy->name(), "Previous declaration of '%s'"_en_US);
2976                 }},
2977             dummy->details());
2978       } else {
2979         dummy = &MakeSymbol(*dummyName, EntityDetails(true));
2980       }
2981       entryDetails.add_dummyArg(*dummy);
2982     } else {
2983       if (inFunction) { // C1573
2984         Say(name,
2985             "ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
2986         break;
2987       }
2988       entryDetails.add_alternateReturn();
2989     }
2990   }
2991
2992   Symbol::Flag subpFlag{
2993       inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
2994   CheckExtantExternal(name, subpFlag);
2995   Scope &outer{inclusiveScope.parent()}; // global or module scope
2996   if (Symbol * extant{FindSymbol(outer, name)}) {
2997     if (extant->has<ProcEntityDetails>()) {
2998       if (!extant->test(subpFlag)) {
2999         Say2(name,
3000             subpFlag == Symbol::Flag::Function
3001                 ? "'%s' was previously called as a subroutine"_err_en_US
3002                 : "'%s' was previously called as a function"_err_en_US,
3003             *extant, "Previous call of '%s'"_en_US);
3004       }
3005       if (extant->attrs().test(Attr::PRIVATE)) {
3006         attrs.set(Attr::PRIVATE);
3007       }
3008       outer.erase(extant->name());
3009     } else {
3010       if (outer.IsGlobal()) {
3011         Say2(name, "'%s' is already defined as a global identifier"_err_en_US,
3012             *extant, "Previous definition of '%s'"_en_US);
3013       } else {
3014         SayAlreadyDeclared(name, *extant);
3015       }
3016       return;
3017     }
3018   }
3019   if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
3020     attrs.set(Attr::PUBLIC);
3021   }
3022   Symbol &entrySymbol{MakeSymbol(outer, name.source, attrs)};
3023   entrySymbol.set_details(std::move(entryDetails));
3024   if (outer.IsGlobal()) {
3025     MakeExternal(entrySymbol);
3026   }
3027   SetBindNameOn(entrySymbol);
3028   entrySymbol.set(subpFlag);
3029   Resolve(name, entrySymbol);
3030 }
3031
3032 // A subprogram declared with MODULE PROCEDURE
3033 bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
3034   auto *symbol{FindSymbol(name)};
3035   if (symbol && symbol->has<SubprogramNameDetails>()) {
3036     symbol = FindSymbol(currScope().parent(), name);
3037   }
3038   if (!IsSeparateModuleProcedureInterface(symbol)) {
3039     Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
3040     return false;
3041   }
3042   if (symbol->owner() == currScope()) {
3043     PushScope(Scope::Kind::Subprogram, symbol);
3044   } else {
3045     Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
3046     PushScope(Scope::Kind::Subprogram, &newSymbol);
3047     const auto &details{symbol->get<SubprogramDetails>()};
3048     auto &newDetails{newSymbol.get<SubprogramDetails>()};
3049     for (const Symbol *dummyArg : details.dummyArgs()) {
3050       if (!dummyArg) {
3051         newDetails.add_alternateReturn();
3052       } else if (Symbol * copy{currScope().CopySymbol(*dummyArg)}) {
3053         newDetails.add_dummyArg(*copy);
3054       }
3055     }
3056     if (details.isFunction()) {
3057       currScope().erase(symbol->name());
3058       newDetails.set_result(*currScope().CopySymbol(details.result()));
3059     }
3060   }
3061   return true;
3062 }
3063
3064 // A subprogram declared with SUBROUTINE or FUNCTION
3065 bool SubprogramVisitor::BeginSubprogram(
3066     const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) {
3067   if (hasModulePrefix && !inInterfaceBlock() &&
3068       !IsSeparateModuleProcedureInterface(
3069           FindSymbol(currScope().parent(), name))) {
3070     Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
3071     return false;
3072   }
3073   PushSubprogramScope(name, subpFlag);
3074   return true;
3075 }
3076
3077 void SubprogramVisitor::EndSubprogram() { PopScope(); }
3078
3079 void SubprogramVisitor::CheckExtantExternal(
3080     const parser::Name &name, Symbol::Flag subpFlag) {
3081   if (auto *prev{FindSymbol(name)}) {
3082     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
3083       // this subprogram was previously called, now being declared
3084       if (!prev->test(subpFlag)) {
3085         Say2(name,
3086             subpFlag == Symbol::Flag::Function
3087                 ? "'%s' was previously called as a subroutine"_err_en_US
3088                 : "'%s' was previously called as a function"_err_en_US,
3089             *prev, "Previous call of '%s'"_en_US);
3090       }
3091       EraseSymbol(name);
3092     }
3093   }
3094 }
3095
3096 Symbol &SubprogramVisitor::PushSubprogramScope(
3097     const parser::Name &name, Symbol::Flag subpFlag) {
3098   auto *symbol{GetSpecificFromGeneric(name)};
3099   if (!symbol) {
3100     CheckExtantExternal(name, subpFlag);
3101     symbol = &MakeSymbol(name, SubprogramDetails{});
3102   }
3103   symbol->set(subpFlag);
3104   symbol->ReplaceName(name.source);
3105   PushScope(Scope::Kind::Subprogram, symbol);
3106   auto &details{symbol->get<SubprogramDetails>()};
3107   if (inInterfaceBlock()) {
3108     details.set_isInterface();
3109     if (isAbstract()) {
3110       symbol->attrs().set(Attr::ABSTRACT);
3111     } else {
3112       MakeExternal(*symbol);
3113     }
3114     if (isGeneric()) {
3115       GetGenericDetails().AddSpecificProc(*symbol, name.source);
3116     }
3117     set_inheritFromParent(false);
3118   }
3119   FindSymbol(name)->set(subpFlag); // PushScope() created symbol
3120   return *symbol;
3121 }
3122
3123 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
3124   if (auto *prev{FindSymbol(name)}) {
3125     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
3126       if (prev->test(Symbol::Flag::Subroutine) ||
3127           prev->test(Symbol::Flag::Function)) {
3128         Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,
3129             "Previous call of '%s'"_en_US);
3130       }
3131       EraseSymbol(name);
3132     }
3133   }
3134   if (name.source.empty()) {
3135     // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM
3136     PushScope(Scope::Kind::BlockData, nullptr);
3137   } else {
3138     PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
3139   }
3140 }
3141
3142 // If name is a generic, return specific subprogram with the same name.
3143 Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
3144   if (auto *symbol{FindSymbol(name)}) {
3145     if (auto *details{symbol->detailsIf<GenericDetails>()}) {
3146       // found generic, want subprogram
3147       auto *specific{details->specific()};
3148       if (!specific) {
3149         specific =
3150             &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
3151         details->set_specific(Resolve(name, *specific));
3152       } else if (isGeneric()) {
3153         SayAlreadyDeclared(name, *specific);
3154       }
3155       if (!specific->has<SubprogramDetails>()) {
3156         specific->set_details(SubprogramDetails{});
3157       }
3158       return specific;
3159     }
3160   }
3161   return nullptr;
3162 }
3163
3164 // DeclarationVisitor implementation
3165
3166 bool DeclarationVisitor::BeginDecl() {
3167   BeginDeclTypeSpec();
3168   BeginArraySpec();
3169   return BeginAttrs();
3170 }
3171 void DeclarationVisitor::EndDecl() {
3172   EndDeclTypeSpec();
3173   EndArraySpec();
3174   EndAttrs();
3175 }
3176
3177 bool DeclarationVisitor::CheckUseError(const parser::Name &name) {
3178   const auto *details{name.symbol->detailsIf<UseErrorDetails>()};
3179   if (!details) {
3180     return false;
3181   }
3182   Message &msg{Say(name, "Reference to '%s' is ambiguous"_err_en_US)};
3183   for (const auto &[location, module] : details->occurrences()) {
3184     msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US,
3185         name.source, module->GetName().value());
3186   }
3187   return true;
3188 }
3189
3190 // Report error if accessibility of symbol doesn't match isPrivate.
3191 void DeclarationVisitor::CheckAccessibility(
3192     const SourceName &name, bool isPrivate, Symbol &symbol) {
3193   if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
3194     Say2(name,
3195         "'%s' does not have the same accessibility as its previous declaration"_err_en_US,
3196         symbol, "Previous declaration of '%s'"_en_US);
3197   }
3198 }
3199
3200 void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
3201   if (!GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { // C702
3202     if (const auto *typeSpec{GetDeclTypeSpec()}) {
3203       if (typeSpec->category() == DeclTypeSpec::Character) {
3204         if (typeSpec->characterTypeSpec().length().isDeferred()) {
3205           Say("The type parameter LEN cannot be deferred without"
3206               " the POINTER or ALLOCATABLE attribute"_err_en_US);
3207         }
3208       } else if (const DerivedTypeSpec * derivedSpec{typeSpec->AsDerived()}) {
3209         for (const auto &pair : derivedSpec->parameters()) {
3210           if (pair.second.isDeferred()) {
3211             Say(currStmtSource().value(),
3212                 "The value of type parameter '%s' cannot be deferred"
3213                 " without the POINTER or ALLOCATABLE attribute"_err_en_US,
3214                 pair.first);
3215           }
3216         }
3217       }
3218     }
3219   }
3220   EndDecl();
3221 }
3222
3223 void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
3224   DeclareObjectEntity(std::get<parser::Name>(x.t));
3225 }
3226 void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
3227   DeclareObjectEntity(std::get<parser::Name>(x.t));
3228 }
3229
3230 bool DeclarationVisitor::Pre(const parser::Initialization &) {
3231   // Defer inspection of initializers to Initialization() so that the
3232   // symbol being initialized will be available within the initialization
3233   // expression.
3234   return false;
3235 }
3236
3237 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
3238   // TODO: may be under StructureStmt
3239   const auto &name{std::get<parser::ObjectName>(x.t)};
3240   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
3241   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
3242   symbol.ReplaceName(name.source);
3243   if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
3244     if (ConvertToObjectEntity(symbol)) {
3245       Initialization(name, *init, false);
3246     }
3247   } else if (attrs.test(Attr::PARAMETER)) { // C882, C883
3248     Say(name, "Missing initialization for parameter '%s'"_err_en_US);
3249   }
3250 }
3251
3252 void DeclarationVisitor::Post(const parser::PointerDecl &x) {
3253   const auto &name{std::get<parser::Name>(x.t)};
3254   if (const auto &deferredShapeSpecs{
3255           std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
3256     CHECK(arraySpec().empty());
3257     BeginArraySpec();
3258     set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
3259     Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
3260     symbol.ReplaceName(name.source);
3261     EndArraySpec();
3262   } else {
3263     Symbol &symbol{DeclareUnknownEntity(name, Attrs{Attr::POINTER})};
3264     symbol.ReplaceName(name.source);
3265   }
3266 }
3267
3268 bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
3269   auto kind{std::get<parser::BindEntity::Kind>(x.t)};
3270   auto &name{std::get<parser::Name>(x.t)};
3271   Symbol *symbol;
3272   if (kind == parser::BindEntity::Kind::Object) {
3273     symbol = &HandleAttributeStmt(Attr::BIND_C, name);
3274   } else {
3275     symbol = &MakeCommonBlockSymbol(name);
3276     symbol->attrs().set(Attr::BIND_C);
3277   }
3278   SetBindNameOn(*symbol);
3279   return false;
3280 }
3281 bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
3282   auto &name{std::get<parser::NamedConstant>(x.t).v};
3283   auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
3284   if (!ConvertToObjectEntity(symbol) ||
3285       symbol.test(Symbol::Flag::CrayPointer) ||
3286       symbol.test(Symbol::Flag::CrayPointee)) {
3287     SayWithDecl(
3288         name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);
3289     return false;
3290   }
3291   const auto &expr{std::get<parser::ConstantExpr>(x.t)};
3292   ApplyImplicitRules(symbol);
3293   Walk(expr);
3294   if (auto converted{EvaluateNonPointerInitializer(
3295           symbol, expr, expr.thing.value().source)}) {
3296     symbol.get<ObjectEntityDetails>().set_init(std::move(*converted));
3297   }
3298   return false;
3299 }
3300 bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
3301   const parser::Name &name{x.v};
3302   if (!FindSymbol(name)) {
3303     Say(name, "Named constant '%s' not found"_err_en_US);
3304   } else {
3305     CheckUseError(name);
3306   }
3307   return false;
3308 }
3309
3310 bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
3311   const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
3312   Symbol *symbol{FindSymbol(name)};
3313   if (symbol) {
3314     // Contrary to named constants appearing in a PARAMETER statement,
3315     // enumerator names should not have their type, dimension or any other
3316     // attributes defined before they are declared in the enumerator statement.
3317     // This is not explicitly forbidden by the standard, but they are scalars
3318     // which type is left for the compiler to chose, so do not let users try to
3319     // tamper with that.
3320     SayAlreadyDeclared(name, *symbol);
3321     symbol = nullptr;
3322   } else {
3323     // Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
3324     symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
3325     symbol->SetType(context().MakeNumericType(
3326         TypeCategory::Integer, evaluate::CInteger::kind));
3327   }
3328
3329   if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
3330           enumerator.t)}) {
3331     Walk(*init); // Resolve names in expression before evaluation.
3332     if (auto value{EvaluateInt64(context(), *init)}) {
3333       // Cast all init expressions to C_INT so that they can then be
3334       // safely incremented (see 7.6 Note 2).
3335       enumerationState_.value = static_cast<int>(*value);
3336     } else {
3337       Say(name,
3338           "Enumerator value could not be computed "
3339           "from the given expression"_err_en_US);
3340       // Prevent resolution of next enumerators value
3341       enumerationState_.value = std::nullopt;
3342     }
3343   }
3344
3345   if (symbol) {
3346     if (enumerationState_.value) {
3347       symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
3348           evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
3349     } else {
3350       context().SetError(*symbol);
3351     }
3352   }
3353
3354   if (enumerationState_.value) {
3355     (*enumerationState_.value)++;
3356   }
3357   return false;
3358 }
3359
3360 void DeclarationVisitor::Post(const parser::EnumDef &) {
3361   enumerationState_ = EnumeratorState{};
3362 }
3363
3364 bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {
3365   Attr attr{AccessSpecToAttr(x)};
3366   if (!NonDerivedTypeScope().IsModule()) { // C817
3367     Say(currStmtSource().value(),
3368         "%s attribute may only appear in the specification part of a module"_err_en_US,
3369         EnumToString(attr));
3370   }
3371   CheckAndSet(attr);
3372   return false;
3373 }
3374
3375 bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
3376   return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
3377 }
3378 bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {
3379   return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);
3380 }
3381 bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
3382   HandleAttributeStmt(Attr::EXTERNAL, x.v);
3383   for (const auto &name : x.v) {
3384     auto *symbol{FindSymbol(name)};
3385     if (!ConvertToProcEntity(*symbol)) {
3386       SayWithDecl(
3387           name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
3388     } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840
3389       Say(symbol->name(),
3390           "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,
3391           symbol->name());
3392     }
3393   }
3394   return false;
3395 }
3396 bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
3397   auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
3398   auto &names{std::get<std::list<parser::Name>>(x.t)};
3399   return CheckNotInBlock("INTENT") && // C1107
3400       HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
3401 }
3402 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
3403   HandleAttributeStmt(Attr::INTRINSIC, x.v);
3404   for (const auto &name : x.v) {
3405     auto *symbol{FindSymbol(name)};
3406     if (!ConvertToProcEntity(*symbol)) {
3407       SayWithDecl(
3408           name, *symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
3409     } else if (symbol->attrs().test(Attr::EXTERNAL)) { // C840
3410       Say(symbol->name(),
3411           "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
3412           symbol->name());
3413     }
3414   }
3415   return false;
3416 }
3417 bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
3418   return CheckNotInBlock("OPTIONAL") && // C1107
3419       HandleAttributeStmt(Attr::OPTIONAL, x.v);
3420 }
3421 bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {
3422   return HandleAttributeStmt(Attr::PROTECTED, x.v);
3423 }
3424 bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
3425   return CheckNotInBlock("VALUE") && // C1107
3426       HandleAttributeStmt(Attr::VALUE, x.v);
3427 }
3428 bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
3429   return HandleAttributeStmt(Attr::VOLATILE, x.v);
3430 }
3431 // Handle a statement that sets an attribute on a list of names.
3432 bool DeclarationVisitor::HandleAttributeStmt(
3433     Attr attr, const std::list<parser::Name> &names) {
3434   for (const auto &name : names) {
3435     HandleAttributeStmt(attr, name);
3436   }
3437   return false;
3438 }
3439 Symbol &DeclarationVisitor::HandleAttributeStmt(
3440     Attr attr, const parser::Name &name) {
3441   if (attr == Attr::INTRINSIC && !IsIntrinsic(name.source, std::nullopt)) {
3442     Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
3443   }
3444   auto *symbol{FindInScope(name)};
3445   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
3446     // these can be set on a symbol that is host-assoc or use-assoc
3447     if (!symbol &&
3448         (currScope().kind() == Scope::Kind::Subprogram ||
3449             currScope().kind() == Scope::Kind::Block)) {
3450       if (auto *hostSymbol{FindSymbol(name)}) {
3451         symbol = &MakeHostAssocSymbol(name, *hostSymbol);
3452       }
3453     }
3454   } else if (symbol && symbol->has<UseDetails>()) {
3455     Say(currStmtSource().value(),
3456         "Cannot change %s attribute on use-associated '%s'"_err_en_US,
3457         EnumToString(attr), name.source);
3458     return *symbol;
3459   }
3460   if (!symbol) {
3461     symbol = &MakeSymbol(name, EntityDetails{});
3462   }
3463   symbol->attrs().set(attr);
3464   symbol->attrs() = HandleSaveName(name.source, symbol->attrs());
3465   return *symbol;
3466 }
3467 // C1107
3468 bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {
3469   if (currScope().kind() == Scope::Kind::Block) {
3470     Say(MessageFormattedText{
3471         "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});
3472     return false;
3473   } else {
3474     return true;
3475   }
3476 }
3477
3478 void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
3479   CHECK(objectDeclAttr_);
3480   const auto &name{std::get<parser::ObjectName>(x.t)};
3481   DeclareObjectEntity(name, Attrs{*objectDeclAttr_});
3482 }
3483
3484 // Declare an entity not yet known to be an object or proc.
3485 Symbol &DeclarationVisitor::DeclareUnknownEntity(
3486     const parser::Name &name, Attrs attrs) {
3487   if (!arraySpec().empty() || !coarraySpec().empty()) {
3488     return DeclareObjectEntity(name, attrs);
3489   } else {
3490     Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
3491     if (auto *type{GetDeclTypeSpec()}) {
3492       SetType(name, *type);
3493     }
3494     charInfo_.length.reset();
3495     SetBindNameOn(symbol);
3496     if (symbol.attrs().test(Attr::EXTERNAL)) {
3497       ConvertToProcEntity(symbol);
3498     }
3499     return symbol;
3500   }
3501 }
3502
3503 Symbol &DeclarationVisitor::DeclareProcEntity(
3504     const parser::Name &name, Attrs attrs, const ProcInterface &interface) {
3505   Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
3506   if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
3507     if (details->IsInterfaceSet()) {
3508       SayWithDecl(name, symbol,
3509           "The interface for procedure '%s' has already been "
3510           "declared"_err_en_US);
3511       context().SetError(symbol);
3512     } else {
3513       if (interface.type()) {
3514         symbol.set(Symbol::Flag::Function);
3515       } else if (interface.symbol()) {
3516         if (interface.symbol()->test(Symbol::Flag::Function)) {
3517           symbol.set(Symbol::Flag::Function);
3518         } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
3519           symbol.set(Symbol::Flag::Subroutine);
3520         }
3521       }
3522       details->set_interface(interface);
3523       SetBindNameOn(symbol);
3524       SetPassNameOn(symbol);
3525     }
3526   }
3527   return symbol;
3528 }
3529
3530 Symbol &DeclarationVisitor::DeclareObjectEntity(
3531     const parser::Name &name, Attrs attrs) {
3532   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
3533   if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
3534     if (auto *type{GetDeclTypeSpec()}) {
3535       SetType(name, *type);
3536     }
3537     if (!arraySpec().empty()) {
3538       if (details->IsArray()) {
3539         if (!context().HasError(symbol)) {
3540           Say(name,
3541               "The dimensions of '%s' have already been declared"_err_en_US);
3542           context().SetError(symbol);
3543         }
3544       } else {
3545         details->set_shape(arraySpec());
3546       }
3547     }
3548     if (!coarraySpec().empty()) {
3549       if (details->IsCoarray()) {
3550         if (!context().HasError(symbol)) {
3551           Say(name,
3552               "The codimensions of '%s' have already been declared"_err_en_US);
3553           context().SetError(symbol);
3554         }
3555       } else {
3556         details->set_coshape(coarraySpec());
3557       }
3558     }
3559     SetBindNameOn(symbol);
3560   }
3561   ClearArraySpec();
3562   ClearCoarraySpec();
3563   charInfo_.length.reset();
3564   return symbol;
3565 }
3566
3567 void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
3568   SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
3569 }
3570 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
3571   SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
3572 }
3573 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
3574   SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
3575 }
3576 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
3577   SetDeclTypeSpec(MakeLogicalType(x.kind));
3578 }
3579 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
3580   if (!charInfo_.length) {
3581     charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};
3582   }
3583   if (!charInfo_.kind) {
3584     charInfo_.kind =
3585         KindExpr{context().GetDefaultKind(TypeCategory::Character)};
3586   }
3587   SetDeclTypeSpec(currScope().MakeCharacterType(
3588       std::move(*charInfo_.length), std::move(*charInfo_.kind)));
3589   charInfo_ = {};
3590 }
3591 void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
3592   charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
3593   std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};
3594   if (intKind &&
3595       !evaluate::IsValidKindOfIntrinsicType(
3596           TypeCategory::Character, *intKind)) { // C715, C719
3597     Say(currStmtSource().value(),
3598         "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);
3599     charInfo_.kind = std::nullopt; // prevent further errors
3600   }
3601   if (x.length) {
3602     charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
3603   }
3604 }
3605 void DeclarationVisitor::Post(const parser::CharLength &x) {
3606   if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {
3607     charInfo_.length = ParamValue{
3608         static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};
3609   } else {
3610     charInfo_.length = GetParamValue(
3611         std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);
3612   }
3613 }
3614 void DeclarationVisitor::Post(const parser::LengthSelector &x) {
3615   if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {
3616     charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);
3617   }
3618 }
3619
3620 bool DeclarationVisitor::Pre(const parser::KindParam &x) {
3621   if (const auto *kind{std::get_if<
3622           parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
3623           &x.u)}) {
3624     const parser::Name &name{kind->thing.thing.thing};
3625     if (!FindSymbol(name)) {
3626       Say(name, "Parameter '%s' not found"_err_en_US);
3627     }
3628   }
3629   return false;
3630 }
3631
3632 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
3633   CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);