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