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 "definable.h"
11	#include "mod-file.h"
12	#include "pointer-assignment.h"
13	#include "program-tree.h"
14	#include "resolve-directives.h"
15	#include "resolve-names-utils.h"
16	#include "rewrite-parse-tree.h"
17	#include "flang/Common/Fortran.h"
18	#include "flang/Common/default-kinds.h"
19	#include "flang/Common/indirection.h"
20	#include "flang/Common/restorer.h"
21	#include "flang/Common/visit.h"
22	#include "flang/Evaluate/characteristics.h"
23	#include "flang/Evaluate/check-expression.h"
24	#include "flang/Evaluate/common.h"
25	#include "flang/Evaluate/fold-designator.h"
26	#include "flang/Evaluate/fold.h"
27	#include "flang/Evaluate/intrinsics.h"
28	#include "flang/Evaluate/tools.h"
29	#include "flang/Evaluate/type.h"
30	#include "flang/Parser/parse-tree-visitor.h"
31	#include "flang/Parser/parse-tree.h"
32	#include "flang/Parser/tools.h"
33	#include "flang/Semantics/attr.h"
34	#include "flang/Semantics/expression.h"
35	#include "flang/Semantics/scope.h"
36	#include "flang/Semantics/semantics.h"
37	#include "flang/Semantics/symbol.h"
38	#include "flang/Semantics/tools.h"
39	#include "flang/Semantics/type.h"
40	#include "llvm/Support/raw_ostream.h"
41	#include <list>
42	#include <map>
43	#include <set>
44	#include <stack>
45
46	namespace Fortran::semantics {
47
48	using namespace parser::literals;
49
50	template <typename T> using Indirection = common::Indirection<T>;
51	using Message = parser::Message;
52	using Messages = parser::Messages;
53	using MessageFixedText = parser::MessageFixedText;
54	using MessageFormattedText = parser::MessageFormattedText;
55
56	class ResolveNamesVisitor;
57	class ScopeHandler;
58
59	// ImplicitRules maps initial character of identifier to the DeclTypeSpec
60	// representing the implicit type; std::nullopt if none.
61	// It also records the presence of IMPLICIT NONE statements.
62	// When inheritFromParent is set, defaults come from the parent rules.
63	class ImplicitRules {
64	public:
65	ImplicitRules(SemanticsContext &context, ImplicitRules *parent)
66	: parent_{parent}, context_{context} {
67	inheritFromParent_ = parent != nullptr;
68	}
69	bool isImplicitNoneType() const;
70	bool isImplicitNoneExternal() const;
71	void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
72	void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
73	void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
74	// Get the implicit type for this name. May be null.
75	const DeclTypeSpec *GetType(
76	SourceName, bool respectImplicitNone = true) const;
77	// Record the implicit type for the range of characters [fromLetter,
78	// toLetter].
79	void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
80	parser::Location toLetter);
81
82	private:
83	static char Incr(char ch);
84
85	ImplicitRules *parent_;
86	SemanticsContext &context_;
87	bool inheritFromParent_{false}; // look in parent if not specified here
88	bool isImplicitNoneType_{
89	context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)};
90	bool isImplicitNoneExternal_{false};
91	// map_ contains the mapping between letters and types that were defined
92	// by the IMPLICIT statements of the related scope. It does not contain
93	// the default Fortran mappings nor the mapping defined in parents.
94	std::map<char, common::Reference<const DeclTypeSpec>> map_;
95
96	friend llvm::raw_ostream &operator<<(
97	llvm::raw_ostream &, const ImplicitRules &);
98	friend void ShowImplicitRule(
99	llvm::raw_ostream &, const ImplicitRules &, char);
100	};
101
102	// scope -> implicit rules for that scope
103	using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>;
104
105	// Track statement source locations and save messages.
106	class MessageHandler {
107	public:
108	MessageHandler() { DIE("MessageHandler: default-constructed"); }
109	explicit MessageHandler(SemanticsContext &c) : context_{&c} {}
110	Messages &messages() { return context_->messages(); };
111	const std::optional<SourceName> &currStmtSource() {
112	return context_->location();
113	}
114	void set_currStmtSource(const std::optional<SourceName> &source) {
115	context_->set_location(source);
116	}
117
118	// Emit a message associated with the current statement source.
119	Message &Say(MessageFixedText &&);
120	Message &Say(MessageFormattedText &&);
121	// Emit a message about a SourceName
122	Message &Say(const SourceName &, MessageFixedText &&);
123	// Emit a formatted message associated with a source location.
124	template <typename... A>
125	Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) {
126	return context_->Say(source, std::move(msg), std::forward<A>(args)...);
127	}
128
129	private:
130	SemanticsContext *context_;
131	};
132
133	// Inheritance graph for the parse tree visitation classes that follow:
134	// BaseVisitor
135	// + AttrsVisitor
136	// | + DeclTypeSpecVisitor
137	// | + ImplicitRulesVisitor
138	// | + ScopeHandler ------------------+
139	// | + ModuleVisitor -------------+ |
140	// | + GenericHandler -------+ | |
141	// | | + InterfaceVisitor | | |
142	// | +-+ SubprogramVisitor ==|==+ | |
143	// + ArraySpecVisitor | | | |
144	// + DeclarationVisitor <--------+ | | |
145	// + ConstructVisitor | | |
146	// + ResolveNamesVisitor <------+-+-+
147
148	class BaseVisitor {
149	public:
150	BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
151	BaseVisitor(
152	SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)
153	: implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {
154	}
155	template <typename T> void Walk(const T &);
156
157	MessageHandler &messageHandler() { return messageHandler_; }
158	const std::optional<SourceName> &currStmtSource() {
159	return context_->location();
160	}
161	SemanticsContext &context() const { return *context_; }
162	evaluate::FoldingContext &GetFoldingContext() const {
163	return context_->foldingContext();
164	}
165	bool IsIntrinsic(
166	const SourceName &name, std::optional<Symbol::Flag> flag) const {
167	if (!flag) {
168	return context_->intrinsics().IsIntrinsic(name.ToString());
169	} else if (flag == Symbol::Flag::Function) {
170	return context_->intrinsics().IsIntrinsicFunction(name.ToString());
171	} else if (flag == Symbol::Flag::Subroutine) {
172	return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());
173	} else {
174	DIE("expected Subroutine or Function flag");
175	}
176	}
177
178	bool InModuleFile() const {
179	return GetFoldingContext().moduleFileName().has_value();
180	}
181
182	// Make a placeholder symbol for a Name that otherwise wouldn't have one.
183	// It is not in any scope and always has MiscDetails.
184	void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
185
186	template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
187	return evaluate::Fold(GetFoldingContext(), std::move(expr));
188	}
189
190	template <typename T> MaybeExpr EvaluateExpr(const T &expr) {
191	return FoldExpr(AnalyzeExpr(*context_, expr));
192	}
193
194	template <typename T>
195	MaybeExpr EvaluateNonPointerInitializer(
196	const Symbol &symbol, const T &expr, parser::CharBlock source) {
197	if (!context().HasError(symbol)) {
198	if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
199	auto restorer{GetFoldingContext().messages().SetLocation(source)};
200	return evaluate::NonPointerInitializationExpr(
201	symbol, std::move(*maybeExpr), GetFoldingContext());
202	}
203	}
204	return std::nullopt;
205	}
206
207	template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
208	return semantics::EvaluateIntExpr(*context_, expr);
209	}
210
211	template <typename T>
212	MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
213	if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
214	return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
215	std::move(*maybeIntExpr)));
216	} else {
217	return std::nullopt;
218	}
219	}
220
221	template <typename... A> Message &Say(A &&...args) {
222	return messageHandler_.Say(std::forward<A>(args)...);
223	}
224	template <typename... A>
225	Message &Say(
226	const parser::Name &name, MessageFixedText &&text, const A &...args) {
227	return messageHandler_.Say(name.source, std::move(text), args...);
228	}
229
230	protected:
231	ImplicitRulesMap *implicitRulesMap_{nullptr};
232
233	private:
234	ResolveNamesVisitor *this_;
235	SemanticsContext *context_;
236	MessageHandler messageHandler_;
237	};
238
239	// Provide Post methods to collect attributes into a member variable.
240	class AttrsVisitor : public virtual BaseVisitor {
241	public:
242	bool BeginAttrs(); // always returns true
243	Attrs GetAttrs();
244	std::optional<common::CUDADataAttr> cudaDataAttr() { return cudaDataAttr_; }
245	Attrs EndAttrs();
246	bool SetPassNameOn(Symbol &);
247	void SetBindNameOn(Symbol &);
248	void Post(const parser::LanguageBindingSpec &);
249	bool Pre(const parser::IntentSpec &);
250	bool Pre(const parser::Pass &);
251
252	bool CheckAndSet(Attr);
253
254	// Simple case: encountering CLASSNAME causes ATTRNAME to be set.
255	#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
256	bool Pre(const parser::CLASSNAME &) { \
257	CheckAndSet(Attr::ATTRNAME); \
258	return false; \
259	}
260	HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
261	HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
262	HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
263	HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
264	HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
265	HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
266	HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
267	HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
268	HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
269	HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
270	HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
271	HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
272	HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
273	HANDLE_ATTR_CLASS(External, EXTERNAL)
274	HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
275	HANDLE_ATTR_CLASS(NoPass, NOPASS)
276	HANDLE_ATTR_CLASS(Optional, OPTIONAL)
277	HANDLE_ATTR_CLASS(Parameter, PARAMETER)
278	HANDLE_ATTR_CLASS(Pointer, POINTER)
279	HANDLE_ATTR_CLASS(Protected, PROTECTED)
280	HANDLE_ATTR_CLASS(Save, SAVE)
281	HANDLE_ATTR_CLASS(Target, TARGET)
282	HANDLE_ATTR_CLASS(Value, VALUE)
283	HANDLE_ATTR_CLASS(Volatile, VOLATILE)
284	#undef HANDLE_ATTR_CLASS
285	bool Pre(const common::CUDADataAttr);
286
287	protected:
288	std::optional<Attrs> attrs_;
289	std::optional<common::CUDADataAttr> cudaDataAttr_;
290
291	Attr AccessSpecToAttr(const parser::AccessSpec &x) {
292	switch (x.v) {
293	case parser::AccessSpec::Kind::Public:
294	return Attr::PUBLIC;
295	case parser::AccessSpec::Kind::Private:
296	return Attr::PRIVATE;
297	}
298	llvm_unreachable("Switch covers all cases"); // suppress g++ warning
299	}
300	Attr IntentSpecToAttr(const parser::IntentSpec &x) {
301	switch (x.v) {
302	case parser::IntentSpec::Intent::In:
303	return Attr::INTENT_IN;
304	case parser::IntentSpec::Intent::Out:
305	return Attr::INTENT_OUT;
306	case parser::IntentSpec::Intent::InOut:
307	return Attr::INTENT_INOUT;
308	}
309	llvm_unreachable("Switch covers all cases"); // suppress g++ warning
310	}
311
312	private:
313	bool IsDuplicateAttr(Attr);
314	bool HaveAttrConflict(Attr, Attr, Attr);
315	bool IsConflictingAttr(Attr);
316
317	MaybeExpr bindName_; // from BIND(C, NAME="...")
318	std::optional<SourceName> passName_; // from PASS(...)
319	};
320
321	// Find and create types from declaration-type-spec nodes.
322	class DeclTypeSpecVisitor : public AttrsVisitor {
323	public:
324	using AttrsVisitor::Post;
325	using AttrsVisitor::Pre;
326	void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
327	void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
328	void Post(const parser::DeclarationTypeSpec::ClassStar &);
329	void Post(const parser::DeclarationTypeSpec::TypeStar &);
330	bool Pre(const parser::TypeGuardStmt &);
331	void Post(const parser::TypeGuardStmt &);
332	void Post(const parser::TypeSpec &);
333
334	// Walk the parse tree of a type spec and return the DeclTypeSpec for it.
335	template <typename T>
336	const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
337	auto restorer{common::ScopedSet(state_, State{})};
338	set_allowForwardReferenceToDerivedType(allowForward);
339	BeginDeclTypeSpec();
340	Walk(x);
341	const auto *type{GetDeclTypeSpec()};
342	EndDeclTypeSpec();
343	return type;
344	}
345
346	protected:
347	struct State {
348	bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true
349	const DeclTypeSpec *declTypeSpec{nullptr};
350	struct {
351	DerivedTypeSpec *type{nullptr};
352	DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
353	} derived;
354	bool allowForwardReferenceToDerivedType{false};
355	};
356
357	bool allowForwardReferenceToDerivedType() const {
358	return state_.allowForwardReferenceToDerivedType;
359	}
360	void set_allowForwardReferenceToDerivedType(bool yes) {
361	state_.allowForwardReferenceToDerivedType = yes;
362	}
363
364	const DeclTypeSpec *GetDeclTypeSpec();
365	void BeginDeclTypeSpec();
366	void EndDeclTypeSpec();
367	void SetDeclTypeSpec(const DeclTypeSpec &);
368	void SetDeclTypeSpecCategory(DeclTypeSpec::Category);
369	DeclTypeSpec::Category GetDeclTypeSpecCategory() const {
370	return state_.derived.category;
371	}
372	KindExpr GetKindParamExpr(
373	TypeCategory, const std::optional<parser::KindSelector> &);
374	void CheckForAbstractType(const Symbol &typeSymbol);
375
376	private:
377	State state_;
378
379	void MakeNumericType(TypeCategory, int kind);
380	};
381
382	// Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
383	class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
384	public:
385	using DeclTypeSpecVisitor::Post;
386	using DeclTypeSpecVisitor::Pre;
387	using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
388
389	void Post(const parser::ParameterStmt &);
390	bool Pre(const parser::ImplicitStmt &);
391	bool Pre(const parser::LetterSpec &);
392	bool Pre(const parser::ImplicitSpec &);
393	void Post(const parser::ImplicitSpec &);
394
395	const DeclTypeSpec *GetType(
396	SourceName name, bool respectImplicitNoneType = true) {
397	return implicitRules_->GetType(name, respectImplicitNoneType);
398	}
399	bool isImplicitNoneType() const {
400	return implicitRules_->isImplicitNoneType();
401	}
402	bool isImplicitNoneType(const Scope &scope) const {
403	return implicitRulesMap_->at(k: &scope).isImplicitNoneType();
404	}
405	bool isImplicitNoneExternal() const {
406	return implicitRules_->isImplicitNoneExternal();
407	}
408	void set_inheritFromParent(bool x) {
409	implicitRules_->set_inheritFromParent(x);
410	}
411
412	protected:
413	void BeginScope(const Scope &);
414	void SetScope(const Scope &);
415
416	private:
417	// implicit rules in effect for current scope
418	ImplicitRules *implicitRules_{nullptr};
419	std::optional<SourceName> prevImplicit_;
420	std::optional<SourceName> prevImplicitNone_;
421	std::optional<SourceName> prevImplicitNoneType_;
422	std::optional<SourceName> prevParameterStmt_;
423
424	bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
425	};
426
427	// Track array specifications. They can occur in AttrSpec, EntityDecl,
428	// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointer, and
429	// ComponentDecl.
430	// 1. INTEGER, DIMENSION(10) :: x
431	// 2. INTEGER :: x(10)
432	// 3. ALLOCATABLE :: x(:)
433	// 4. DIMENSION :: x(10)
434	// 5. COMMON x(10)
435	// 6. POINTER(p,x(10))
436	class ArraySpecVisitor : public virtual BaseVisitor {
437	public:
438	void Post(const parser::ArraySpec &);
439	void Post(const parser::ComponentArraySpec &);
440	void Post(const parser::CoarraySpec &);
441	void Post(const parser::AttrSpec &) { PostAttrSpec(); }
442	void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
443
444	protected:
445	const ArraySpec &arraySpec();
446	void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }
447	const ArraySpec &coarraySpec();
448	void BeginArraySpec();
449	void EndArraySpec();
450	void ClearArraySpec() { arraySpec_.clear(); }
451	void ClearCoarraySpec() { coarraySpec_.clear(); }
452
453	private:
454	// arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
455	ArraySpec arraySpec_;
456	ArraySpec coarraySpec_;
457	// When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
458	// into attrArraySpec_
459	ArraySpec attrArraySpec_;
460	ArraySpec attrCoarraySpec_;
461
462	void PostAttrSpec();
463	};
464
465	// Manages a stack of function result information. We defer the processing
466	// of a type specification that appears in the prefix of a FUNCTION statement
467	// until the function result variable appears in the specification part
468	// or the end of the specification part. This allows for forward references
469	// in the type specification to resolve to local names.
470	class FuncResultStack {
471	public:
472	explicit FuncResultStack(ScopeHandler &scopeHandler)
473	: scopeHandler_{scopeHandler} {}
474	~FuncResultStack();
475
476	struct FuncInfo {
477	explicit FuncInfo(const Scope &s) : scope{s} {}
478	const Scope &scope;
479	// Parse tree of the type specification in the FUNCTION prefix
480	const parser::DeclarationTypeSpec *parsedType{nullptr};
481	// Name of the function RESULT in the FUNCTION suffix, if any
482	const parser::Name *resultName{nullptr};
483	// Result symbol
484	Symbol *resultSymbol{nullptr};
485	std::optional<SourceName> source;
486	bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt
487	};
488
489	// Completes the definition of the top function's result.
490	void CompleteFunctionResultType();
491	// Completes the definition of a symbol if it is the top function's result.
492	void CompleteTypeIfFunctionResult(Symbol &);
493
494	FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); }
495	FuncInfo &Push(const Scope &scope) { return stack_.emplace_back(args: scope); }
496	void Pop();
497
498	private:
499	ScopeHandler &scopeHandler_;
500	std::vector<FuncInfo> stack_;
501	};
502
503	// Manage a stack of Scopes
504	class ScopeHandler : public ImplicitRulesVisitor {
505	public:
506	using ImplicitRulesVisitor::Post;
507	using ImplicitRulesVisitor::Pre;
508
509	Scope &currScope() { return DEREF(currScope_); }
510	// The enclosing host procedure if current scope is in an internal procedure
511	Scope *GetHostProcedure();
512	// The innermost enclosing program unit scope, ignoring BLOCK and other
513	// construct scopes.
514	Scope &InclusiveScope();
515	// The enclosing scope, skipping derived types.
516	Scope &NonDerivedTypeScope();
517
518	// Create a new scope and push it on the scope stack.
519	void PushScope(Scope::Kind kind, Symbol *symbol);
520	void PushScope(Scope &scope);
521	void PopScope();
522	void SetScope(Scope &);
523
524	template <typename T> bool Pre(const parser::Statement<T> &x) {
525	messageHandler().set_currStmtSource(x.source);
526	currScope_->AddSourceRange(x.source);
527	return true;
528	}
529	template <typename T> void Post(const parser::Statement<T> &) {
530	messageHandler().set_currStmtSource(std::nullopt);
531	}
532
533	// Special messages: already declared; referencing symbol's declaration;
534	// about a type; two names & locations
535	void SayAlreadyDeclared(const parser::Name &, Symbol &);
536	void SayAlreadyDeclared(const SourceName &, Symbol &);
537	void SayAlreadyDeclared(const SourceName &, const SourceName &);
538	void SayWithReason(
539	const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
540	void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
541	void SayLocalMustBeVariable(const parser::Name &, Symbol &);
542	void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
543	void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
544	MessageFixedText &&);
545	void Say2(
546	const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
547	void Say2(
548	const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
549
550	// Search for symbol by name in current, parent derived type, and
551	// containing scopes
552	Symbol *FindSymbol(const parser::Name &);
553	Symbol *FindSymbol(const Scope &, const parser::Name &);
554	// Search for name only in scope, not in enclosing scopes.
555	Symbol *FindInScope(const Scope &, const parser::Name &);
556	Symbol *FindInScope(const Scope &, const SourceName &);
557	template <typename T> Symbol *FindInScope(const T &name) {
558	return FindInScope(currScope(), name);
559	}
560	// Search for name in a derived type scope and its parents.
561	Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
562	Symbol *FindInTypeOrParents(const parser::Name &);
563	Symbol *FindInScopeOrBlockConstructs(const Scope &, SourceName);
564	Symbol *FindSeparateModuleProcedureInterface(const parser::Name &);
565	void EraseSymbol(const parser::Name &);
566	void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
567	// Make a new symbol with the name and attrs of an existing one
568	Symbol &CopySymbol(const SourceName &, const Symbol &);
569
570	// Make symbols in the current or named scope
571	Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
572	Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
573	Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
574	Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);
575
576	template <typename D>
577	common::IfNoLvalue<Symbol &, D> MakeSymbol(
578	const parser::Name &name, D &&details) {
579	return MakeSymbol(name, Attrs{}, std::move(details));
580	}
581
582	template <typename D>
583	common::IfNoLvalue<Symbol &, D> MakeSymbol(
584	const parser::Name &name, const Attrs &attrs, D &&details) {
585	return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
586	}
587
588	template <typename D>
589	common::IfNoLvalue<Symbol &, D> MakeSymbol(
590	const SourceName &name, const Attrs &attrs, D &&details) {
591	// Note: don't use FindSymbol here. If this is a derived type scope,
592	// we want to detect whether the name is already declared as a component.
593	auto *symbol{FindInScope(name)};
594	if (!symbol) {
595	symbol = &MakeSymbol(name, attrs);
596	symbol->set_details(std::move(details));
597	return *symbol;
598	}
599	if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
600	if (auto *d{symbol->detailsIf<GenericDetails>()}) {
601	if (!d->specific()) {
602	// derived type with same name as a generic
603	auto *derivedType{d->derivedType()};
604	if (!derivedType) {
605	derivedType =
606	&currScope().MakeSymbol(name, attrs, std::move(details));
607	d->set_derivedType(*derivedType);
608	} else if (derivedType->CanReplaceDetails(details)) {
609	// was forward-referenced
610	CheckDuplicatedAttrs(name, *symbol, attrs);
611	SetExplicitAttrs(*derivedType, attrs);
612	derivedType->set_details(std::move(details));
613	} else {
614	SayAlreadyDeclared(name, *derivedType);
615	}
616	return *derivedType;
617	}
618	}
619	}
620	if (symbol->CanReplaceDetails(details)) {
621	// update the existing symbol
622	CheckDuplicatedAttrs(name, *symbol, attrs);
623	SetExplicitAttrs(*symbol, attrs);
624	if constexpr (std::is_same_v<SubprogramDetails, D>) {
625	// Dummy argument defined by explicit interface?
626	details.set_isDummy(IsDummy(*symbol));
627	}
628	symbol->set_details(std::move(details));
629	return *symbol;
630	} else if constexpr (std::is_same_v<UnknownDetails, D>) {
631	CheckDuplicatedAttrs(name, *symbol, attrs);
632	SetExplicitAttrs(*symbol, attrs);
633	return *symbol;
634	} else {
635	if (!CheckPossibleBadForwardRef(*symbol)) {
636	if (name.empty() && symbol->name().empty()) {
637	// report the error elsewhere
638	return *symbol;
639	}
640	Symbol &errSym{*symbol};
641	if (auto *d{symbol->detailsIf<GenericDetails>()}) {
642	if (d->specific()) {
643	errSym = *d->specific();
644	} else if (d->derivedType()) {
645	errSym = *d->derivedType();
646	}
647	}
648	SayAlreadyDeclared(name, errSym);
649	}
650	// replace the old symbol with a new one with correct details
651	EraseSymbol(symbol: *symbol);
652	auto &result{MakeSymbol(name, attrs, std::move(details))};
653	context().SetError(result);
654	return result;
655	}
656	}
657
658	void MakeExternal(Symbol &);
659
660	// C815 duplicated attribute checking; returns false on error
661	bool CheckDuplicatedAttr(SourceName, const Symbol &, Attr);
662	bool CheckDuplicatedAttrs(SourceName, const Symbol &, Attrs);
663
664	void SetExplicitAttr(Symbol &symbol, Attr attr) const {
665	symbol.attrs().set(attr);
666	symbol.implicitAttrs().reset(attr);
667	}
668	void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const {
669	symbol.attrs() |= attrs;
670	symbol.implicitAttrs() &= ~attrs;
671	}
672	void SetImplicitAttr(Symbol &symbol, Attr attr) const {
673	symbol.attrs().set(attr);
674	symbol.implicitAttrs().set(attr);
675	}
676	void SetCUDADataAttr(
677	SourceName, Symbol &, std::optional<common::CUDADataAttr>);
678
679	protected:
680	FuncResultStack &funcResultStack() { return funcResultStack_; }
681
682	// Apply the implicit type rules to this symbol.
683	void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);
684	bool ImplicitlyTypeForwardRef(Symbol &);
685	void AcquireIntrinsicProcedureFlags(Symbol &);
686	const DeclTypeSpec *GetImplicitType(
687	Symbol &, bool respectImplicitNoneType = true);
688	void CheckEntryDummyUse(SourceName, Symbol *);
689	bool ConvertToObjectEntity(Symbol &);
690	bool ConvertToProcEntity(Symbol &, std::optional<SourceName> = std::nullopt);
691
692	const DeclTypeSpec &MakeNumericType(
693	TypeCategory, const std::optional<parser::KindSelector> &);
694	const DeclTypeSpec &MakeNumericType(TypeCategory, int);
695	const DeclTypeSpec &MakeLogicalType(
696	const std::optional<parser::KindSelector> &);
697	const DeclTypeSpec &MakeLogicalType(int);
698	void NotePossibleBadForwardRef(const parser::Name &);
699	std::optional<SourceName> HadForwardRef(const Symbol &) const;
700	bool CheckPossibleBadForwardRef(const Symbol &);
701
702	bool inSpecificationPart_{false};
703	bool deferImplicitTyping_{false};
704	bool inEquivalenceStmt_{false};
705
706	// Some information is collected from a specification part for deferred
707	// processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts())
708	// that are called by ResolveNamesVisitor::FinishSpecificationPart(). Since
709	// specification parts can nest (e.g., INTERFACE bodies), the collected
710	// information that is not contained in the scope needs to be packaged
711	// and restorable.
712	struct SpecificationPartState {
713	std::set<SourceName> forwardRefs;
714	// Collect equivalence sets and process at end of specification part
715	std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets;
716	// Names of all common block objects in the scope
717	std::set<SourceName> commonBlockObjects;
718	// Info about SAVE statements and attributes in current scope
719	struct {
720	std::optional<SourceName> saveAll; // "SAVE" without entity list
721	std::set<SourceName> entities; // names of entities with save attr
722	std::set<SourceName> commons; // names of common blocks with save attr
723	} saveInfo;
724	} specPartState_;
725
726	// Some declaration processing can and should be deferred to
727	// ResolveExecutionParts() to avoid prematurely creating implicitly-typed
728	// local symbols that should be host associations.
729	struct DeferredDeclarationState {
730	// The content of each namelist group
731	std::list<const parser::NamelistStmt::Group *> namelistGroups;
732	};
733	DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) {
734	if (!add && deferred_.find(x: &currScope()) == deferred_.end()) {
735	return nullptr;
736	} else {
737	return &deferred_.emplace(args: &currScope(), args: DeferredDeclarationState{})
738	.first->second;
739	}
740	}
741
742	private:
743	Scope *currScope_{nullptr};
744	FuncResultStack funcResultStack_{*this};
745	std::map<Scope *, DeferredDeclarationState> deferred_;
746	};
747
748	class ModuleVisitor : public virtual ScopeHandler {
749	public:
750	bool Pre(const parser::AccessStmt &);
751	bool Pre(const parser::Only &);
752	bool Pre(const parser::Rename::Names &);
753	bool Pre(const parser::Rename::Operators &);
754	bool Pre(const parser::UseStmt &);
755	void Post(const parser::UseStmt &);
756
757	void BeginModule(const parser::Name &, bool isSubmodule);
758	bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
759	void ApplyDefaultAccess();
760	Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
761	void AddAndCheckModuleUse(SourceName, bool isIntrinsic);
762	void CollectUseRenames(const parser::UseStmt &);
763	void ClearUseRenames() { useRenames_.clear(); }
764	void ClearUseOnly() { useOnly_.clear(); }
765	void ClearModuleUses() {
766	intrinsicUses_.clear();
767	nonIntrinsicUses_.clear();
768	}
769
770	private:
771	// The location of the last AccessStmt without access-ids, if any.
772	std::optional<SourceName> prevAccessStmt_;
773	// The scope of the module during a UseStmt
774	Scope *useModuleScope_{nullptr};
775	// Names that have appeared in a rename clause of USE statements
776	std::set<std::pair<SourceName, SourceName>> useRenames_;
777	// Names that have appeared in an ONLY clause of a USE statement
778	std::set<std::pair<SourceName, Scope *>> useOnly_;
779	// Intrinsic and non-intrinsic (explicit or not) module names that
780	// have appeared in USE statements; used for C1406 warnings.
781	std::set<SourceName> intrinsicUses_;
782	std::set<SourceName> nonIntrinsicUses_;
783
784	Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
785	// A rename in a USE statement: local => use
786	struct SymbolRename {
787	Symbol *local{nullptr};
788	Symbol *use{nullptr};
789	};
790	// Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
791	SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
792	SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
793	void DoAddUse(
794	SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol);
795	void AddUse(const GenericSpecInfo &);
796	// Record a name appearing as the target of a USE rename clause
797	void AddUseRename(SourceName name, SourceName moduleName) {
798	useRenames_.emplace(std::make_pair(name, moduleName));
799	}
800	bool IsUseRenamed(const SourceName &name) const {
801	return useModuleScope_ && useModuleScope_->symbol() &&
802	useRenames_.find({name, useModuleScope_->symbol()->name()}) !=
803	useRenames_.end();
804	}
805	// Record a name appearing in a USE ONLY clause
806	void AddUseOnly(const SourceName &name) {
807	useOnly_.emplace(args: std::make_pair(x: name, y&: useModuleScope_));
808	}
809	bool IsUseOnly(const SourceName &name) const {
810	return useOnly_.find({name, useModuleScope_}) != useOnly_.end();
811	}
812	Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic,
813	Scope *ancestor = nullptr);
814	};
815
816	class GenericHandler : public virtual ScopeHandler {
817	protected:
818	using ProcedureKind = parser::ProcedureStmt::Kind;
819	void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart);
820	void DeclaredPossibleSpecificProc(Symbol &);
821
822	// Mappings of generics to their as-yet specific proc names and kinds
823	using SpecificProcMapType =
824	std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>;
825	SpecificProcMapType specificsForGenericProcs_;
826	// inversion of SpecificProcMapType: maps pending proc names to generics
827	using GenericProcMapType = std::multimap<SourceName, Symbol *>;
828	GenericProcMapType genericsForSpecificProcs_;
829	};
830
831	class InterfaceVisitor : public virtual ScopeHandler,
832	public virtual GenericHandler {
833	public:
834	bool Pre(const parser::InterfaceStmt &);
835	void Post(const parser::InterfaceStmt &);
836	void Post(const parser::EndInterfaceStmt &);
837	bool Pre(const parser::GenericSpec &);
838	bool Pre(const parser::ProcedureStmt &);
839	bool Pre(const parser::GenericStmt &);
840	void Post(const parser::GenericStmt &);
841
842	bool inInterfaceBlock() const;
843	bool isGeneric() const;
844	bool isAbstract() const;
845
846	protected:
847	Symbol &GetGenericSymbol() { return DEREF(genericInfo_.top().symbol); }
848	// Add to generic the symbol for the subprogram with the same name
849	void CheckGenericProcedures(Symbol &);
850
851	private:
852	// A new GenericInfo is pushed for each interface block and generic stmt
853	struct GenericInfo {
854	GenericInfo(bool isInterface, bool isAbstract = false)
855	: isInterface{isInterface}, isAbstract{isAbstract} {}
856	bool isInterface; // in interface block
857	bool isAbstract; // in abstract interface block
858	Symbol *symbol{nullptr}; // the generic symbol being defined
859	};
860	std::stack<GenericInfo> genericInfo_;
861	const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }
862	void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }
863	void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
864	void ResolveNewSpecifics();
865	};
866
867	class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
868	public:
869	bool HandleStmtFunction(const parser::StmtFunctionStmt &);
870	bool Pre(const parser::SubroutineStmt &);
871	bool Pre(const parser::FunctionStmt &);
872	void Post(const parser::FunctionStmt &);
873	bool Pre(const parser::EntryStmt &);
874	void Post(const parser::EntryStmt &);
875	bool Pre(const parser::InterfaceBody::Subroutine &);
876	void Post(const parser::InterfaceBody::Subroutine &);
877	bool Pre(const parser::InterfaceBody::Function &);
878	void Post(const parser::InterfaceBody::Function &);
879	bool Pre(const parser::Suffix &);
880	bool Pre(const parser::PrefixSpec &);
881	bool Pre(const parser::PrefixSpec::Attributes &);
882	void Post(const parser::PrefixSpec::Launch_Bounds &);
883	void Post(const parser::PrefixSpec::Cluster_Dims &);
884
885	bool BeginSubprogram(const parser::Name &, Symbol::Flag,
886	bool hasModulePrefix = false,
887	const parser::LanguageBindingSpec * = nullptr,
888	const ProgramTree::EntryStmtList * = nullptr);
889	bool BeginMpSubprogram(const parser::Name &);
890	void PushBlockDataScope(const parser::Name &);
891	void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt,
892	const std::optional<parser::LanguageBindingSpec> * = nullptr,
893	const ProgramTree::EntryStmtList * = nullptr);
894
895	protected:
896	// Set when we see a stmt function that is really an array element assignment
897	bool misparsedStmtFuncFound_{false};
898
899	private:
900	// Edits an existing symbol created for earlier calls to a subprogram or ENTRY
901	// so that it can be replaced by a later definition.
902	bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
903	void CheckExtantProc(const parser::Name &, Symbol::Flag);
904	// Create a subprogram symbol in the current scope and push a new scope.
905	Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
906	const parser::LanguageBindingSpec * = nullptr,
907	bool hasModulePrefix = false);
908	Symbol *GetSpecificFromGeneric(const parser::Name &);
909	Symbol &PostSubprogramStmt();
910	void CreateDummyArgument(SubprogramDetails &, const parser::Name &);
911	void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);
912	void PostEntryStmt(const parser::EntryStmt &stmt);
913	void HandleLanguageBinding(Symbol *,
914	std::optional<parser::CharBlock> stmtSource,
915	const std::optional<parser::LanguageBindingSpec> *);
916	};
917
918	class DeclarationVisitor : public ArraySpecVisitor,
919	public virtual GenericHandler {
920	public:
921	using ArraySpecVisitor::Post;
922	using ScopeHandler::Post;
923	using ScopeHandler::Pre;
924
925	bool Pre(const parser::Initialization &);
926	void Post(const parser::EntityDecl &);
927	void Post(const parser::ObjectDecl &);
928	void Post(const parser::PointerDecl &);
929	bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
930	void Post(const parser::BindStmt &) { EndAttrs(); }
931	bool Pre(const parser::BindEntity &);
932	bool Pre(const parser::OldParameterStmt &);
933	bool Pre(const parser::NamedConstantDef &);
934	bool Pre(const parser::NamedConstant &);
935	void Post(const parser::EnumDef &);
936	bool Pre(const parser::Enumerator &);
937	bool Pre(const parser::AccessSpec &);
938	bool Pre(const parser::AsynchronousStmt &);
939	bool Pre(const parser::ContiguousStmt &);
940	bool Pre(const parser::ExternalStmt &);
941	bool Pre(const parser::IntentStmt &);
942	bool Pre(const parser::IntrinsicStmt &);
943	bool Pre(const parser::OptionalStmt &);
944	bool Pre(const parser::ProtectedStmt &);
945	bool Pre(const parser::ValueStmt &);
946	bool Pre(const parser::VolatileStmt &);
947	bool Pre(const parser::AllocatableStmt &) {
948	objectDeclAttr_ = Attr::ALLOCATABLE;
949	return true;
950	}
951	void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
952	bool Pre(const parser::TargetStmt &) {
953	objectDeclAttr_ = Attr::TARGET;
954	return true;
955	}
956	bool Pre(const parser::CUDAAttributesStmt &);
957	void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
958	void Post(const parser::DimensionStmt::Declaration &);
959	void Post(const parser::CodimensionDecl &);
960	bool Pre(const parser::TypeDeclarationStmt &);
961	void Post(const parser::TypeDeclarationStmt &);
962	void Post(const parser::IntegerTypeSpec &);
963	void Post(const parser::IntrinsicTypeSpec::Real &);
964	void Post(const parser::IntrinsicTypeSpec::Complex &);
965	void Post(const parser::IntrinsicTypeSpec::Logical &);
966	void Post(const parser::IntrinsicTypeSpec::Character &);
967	void Post(const parser::CharSelector::LengthAndKind &);
968	void Post(const parser::CharLength &);
969	void Post(const parser::LengthSelector &);
970	bool Pre(const parser::KindParam &);
971	bool Pre(const parser::VectorTypeSpec &);
972	void Post(const parser::VectorTypeSpec &);
973	bool Pre(const parser::DeclarationTypeSpec::Type &);
974	void Post(const parser::DeclarationTypeSpec::Type &);
975	bool Pre(const parser::DeclarationTypeSpec::Class &);
976	void Post(const parser::DeclarationTypeSpec::Class &);
977	void Post(const parser::DeclarationTypeSpec::Record &);
978	void Post(const parser::DerivedTypeSpec &);
979	bool Pre(const parser::DerivedTypeDef &);
980	bool Pre(const parser::DerivedTypeStmt &);
981	void Post(const parser::DerivedTypeStmt &);
982	bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
983	void Post(const parser::TypeParamDefStmt &);
984	bool Pre(const parser::TypeAttrSpec::Extends &);
985	bool Pre(const parser::PrivateStmt &);
986	bool Pre(const parser::SequenceStmt &);
987	bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
988	void Post(const parser::ComponentDefStmt &) { EndDecl(); }
989	void Post(const parser::ComponentDecl &);
990	void Post(const parser::FillDecl &);
991	bool Pre(const parser::ProcedureDeclarationStmt &);
992	void Post(const parser::ProcedureDeclarationStmt &);
993	bool Pre(const parser::DataComponentDefStmt &); // returns false
994	bool Pre(const parser::ProcComponentDefStmt &);
995	void Post(const parser::ProcComponentDefStmt &);
996	bool Pre(const parser::ProcPointerInit &);
997	void Post(const parser::ProcInterface &);
998	void Post(const parser::ProcDecl &);
999	bool Pre(const parser::TypeBoundProcedurePart &);
1000	void Post(const parser::TypeBoundProcedurePart &);
1001	void Post(const parser::ContainsStmt &);
1002	bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
1003	void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
1004	void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
1005	void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
1006	bool Pre(const parser::FinalProcedureStmt &);
1007	bool Pre(const parser::TypeBoundGenericStmt &);
1008	bool Pre(const parser::StructureDef &); // returns false
1009	bool Pre(const parser::Union::UnionStmt &);
1010	bool Pre(const parser::StructureField &);
1011	void Post(const parser::StructureField &);
1012	bool Pre(const parser::AllocateStmt &);
1013	void Post(const parser::AllocateStmt &);
1014	bool Pre(const parser::StructureConstructor &);
1015	bool Pre(const parser::NamelistStmt::Group &);
1016	bool Pre(const parser::IoControlSpec &);
1017	bool Pre(const parser::CommonStmt::Block &);
1018	bool Pre(const parser::CommonBlockObject &);
1019	void Post(const parser::CommonBlockObject &);
1020	bool Pre(const parser::EquivalenceStmt &);
1021	bool Pre(const parser::SaveStmt &);
1022	bool Pre(const parser::BasedPointer &);
1023	void Post(const parser::BasedPointer &);
1024
1025	void PointerInitialization(
1026	const parser::Name &, const parser::InitialDataTarget &);
1027	void PointerInitialization(
1028	const parser::Name &, const parser::ProcPointerInit &);
1029	void NonPointerInitialization(
1030	const parser::Name &, const parser::ConstantExpr &);
1031	void CheckExplicitInterface(const parser::Name &);
1032	void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
1033
1034	const parser::Name *ResolveDesignator(const parser::Designator &);
1035	int GetVectorElementKind(
1036	TypeCategory category, const std::optional<parser::KindSelector> &kind);
1037
1038	protected:
1039	bool BeginDecl();
1040	void EndDecl();
1041	Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
1042	// Make sure that there's an entity in an enclosing scope called Name
1043	Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
1044	// Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
1045	// it comes from the entity in the containing scope, or implicit rules.
1046	// Return pointer to the new symbol, or nullptr on error.
1047	Symbol *DeclareLocalEntity(const parser::Name &);
1048	// Declare a statement entity (i.e., an implied DO loop index for
1049	// a DATA statement or an array constructor). If there isn't an explict
1050	// type specified, implicit rules apply. Return pointer to the new symbol,
1051	// or nullptr on error.
1052	Symbol *DeclareStatementEntity(const parser::DoVariable &,
1053	const std::optional<parser::IntegerTypeSpec> &);
1054	Symbol &MakeCommonBlockSymbol(const parser::Name &);
1055	Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
1056	bool CheckUseError(const parser::Name &);
1057	void CheckAccessibility(const SourceName &, bool, Symbol &);
1058	void CheckCommonBlocks();
1059	void CheckSaveStmts();
1060	void CheckEquivalenceSets();
1061	bool CheckNotInBlock(const char *);
1062	bool NameIsKnownOrIntrinsic(const parser::Name &);
1063	void FinishNamelists();
1064
1065	// Each of these returns a pointer to a resolved Name (i.e. with symbol)
1066	// or nullptr in case of error.
1067	const parser::Name *ResolveStructureComponent(
1068	const parser::StructureComponent &);
1069	const parser::Name *ResolveDataRef(const parser::DataRef &);
1070	const parser::Name *ResolveName(const parser::Name &);
1071	bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
1072	Symbol *NoteInterfaceName(const parser::Name &);
1073	bool IsUplevelReference(const Symbol &);
1074
1075	std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(
1076	const parser::DoVariable &name) {
1077	std::optional<SourceName> result{checkIndexUseInOwnBounds_};
1078	checkIndexUseInOwnBounds_ = name.thing.thing.source;
1079	return result;
1080	}
1081	void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {
1082	checkIndexUseInOwnBounds_ = restore;
1083	}
1084	void NoteScalarSpecificationArgument(const Symbol &symbol) {
1085	mustBeScalar_.emplace(symbol);
1086	}
1087
1088	private:
1089	// The attribute corresponding to the statement containing an ObjectDecl
1090	std::optional<Attr> objectDeclAttr_;
1091	// Info about current character type while walking DeclTypeSpec.
1092	// Also captures any "*length" specifier on an individual declaration.
1093	struct {
1094	std::optional<ParamValue> length;
1095	std::optional<KindExpr> kind;
1096	} charInfo_;
1097	// Info about current derived type or STRUCTURE while walking
1098	// DerivedTypeDef / StructureDef
1099	struct {
1100	const parser::Name *extends{nullptr}; // EXTENDS(name)
1101	bool privateComps{false}; // components are private by default
1102	bool privateBindings{false}; // bindings are private by default
1103	bool sawContains{false}; // currently processing bindings
1104	bool sequence{false}; // is a sequence type
1105	const Symbol *type{nullptr}; // derived type being defined
1106	bool isStructure{false}; // is a DEC STRUCTURE
1107	} derivedTypeInfo_;
1108	// In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
1109	// the interface name, if any.
1110	const parser::Name *interfaceName_{nullptr};
1111	// Map type-bound generic to binding names of its specific bindings
1112	std::multimap<Symbol *, const parser::Name *> genericBindings_;
1113	// Info about current ENUM
1114	struct EnumeratorState {
1115	// Enum value must hold inside a C_INT (7.6.2).
1116	std::optional<int> value{0};
1117	} enumerationState_;
1118	// Set for OldParameterStmt processing
1119	bool inOldStyleParameterStmt_{false};
1120	// Set when walking DATA & array constructor implied DO loop bounds
1121	// to warn about use of the implied DO intex therein.
1122	std::optional<SourceName> checkIndexUseInOwnBounds_;
1123	bool isVectorType_{false};
1124	UnorderedSymbolSet mustBeScalar_;
1125
1126	bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
1127	Symbol &HandleAttributeStmt(Attr, const parser::Name &);
1128	Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
1129	Symbol &DeclareProcEntity(
1130	const parser::Name &, Attrs, const Symbol *interface);
1131	void SetType(const parser::Name &, const DeclTypeSpec &);
1132	std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
1133	std::optional<DerivedTypeSpec> ResolveExtendsType(
1134	const parser::Name &, const parser::Name *);
1135	Symbol *MakeTypeSymbol(const SourceName &, Details &&);
1136	Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
1137	bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
1138	ParamValue GetParamValue(
1139	const parser::TypeParamValue &, common::TypeParamAttr attr);
1140	void CheckCommonBlockDerivedType(
1141	const SourceName &, const Symbol &, UnorderedSymbolSet &);
1142	Attrs HandleSaveName(const SourceName &, Attrs);
1143	void AddSaveName(std::set<SourceName> &, const SourceName &);
1144	bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
1145	const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
1146	void Initialization(const parser::Name &, const parser::Initialization &,
1147	bool inComponentDecl);
1148	bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
1149	bool CheckForHostAssociatedImplicit(const parser::Name &);
1150
1151	// Declare an object or procedure entity.
1152	// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
1153	template <typename T>
1154	Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
1155	Symbol &symbol{MakeSymbol(name, attrs)};
1156	if (context().HasError(symbol) || symbol.has<T>()) {
1157	return symbol; // OK or error already reported
1158	} else if (symbol.has<UnknownDetails>()) {
1159	symbol.set_details(T{});
1160	return symbol;
1161	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
1162	symbol.set_details(T{std::move(*details)});
1163	return symbol;
1164	} else if (std::is_same_v<EntityDetails, T> &&
1165	(symbol.has<ObjectEntityDetails>() ||
1166	symbol.has<ProcEntityDetails>())) {
1167	return symbol; // OK
1168	} else if (auto *details{symbol.detailsIf<UseDetails>()}) {
1169	Say(name.source,
1170	"'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
1171	name.source, GetUsedModule(*details).name());
1172	} else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
1173	if (details->kind() == SubprogramKind::Module) {
1174	Say2(name,
1175	"Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
1176	symbol, "Module procedure definition"_en_US);
1177	} else if (details->kind() == SubprogramKind::Internal) {
1178	Say2(name,
1179	"Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
1180	symbol, "Internal procedure definition"_en_US);
1181	} else {
1182	DIE("unexpected kind");
1183	}
1184	} else if (std::is_same_v<ObjectEntityDetails, T> &&
1185	symbol.has<ProcEntityDetails>()) {
1186	SayWithDecl(
1187	name, symbol, "'%s' is already declared as a procedure"_err_en_US);
1188	} else if (std::is_same_v<ProcEntityDetails, T> &&
1189	symbol.has<ObjectEntityDetails>()) {
1190	if (FindCommonBlockContaining(symbol)) {
1191	SayWithDecl(name, symbol,
1192	"'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
1193	} else {
1194	SayWithDecl(
1195	name, symbol, "'%s' is already declared as an object"_err_en_US);
1196	}
1197	} else if (!CheckPossibleBadForwardRef(symbol)) {
1198	SayAlreadyDeclared(name, symbol);
1199	}
1200	context().SetError(symbol);
1201	return symbol;
1202	}
1203	bool HasCycle(const Symbol &, const Symbol *interface);
1204	bool MustBeScalar(const Symbol &symbol) const {
1205	return mustBeScalar_.find(symbol) != mustBeScalar_.end();
1206	}
1207	void DeclareIntrinsic(const parser::Name &);
1208	};
1209
1210	// Resolve construct entities and statement entities.
1211	// Check that construct names don't conflict with other names.
1212	class ConstructVisitor : public virtual DeclarationVisitor {
1213	public:
1214	bool Pre(const parser::ConcurrentHeader &);
1215	bool Pre(const parser::LocalitySpec::Local &);
1216	bool Pre(const parser::LocalitySpec::LocalInit &);
1217	bool Pre(const parser::LocalitySpec::Shared &);
1218	bool Pre(const parser::AcSpec &);
1219	bool Pre(const parser::AcImpliedDo &);
1220	bool Pre(const parser::DataImpliedDo &);
1221	bool Pre(const parser::DataIDoObject &);
1222	bool Pre(const parser::DataStmtObject &);
1223	bool Pre(const parser::DataStmtValue &);
1224	bool Pre(const parser::DoConstruct &);
1225	void Post(const parser::DoConstruct &);
1226	bool Pre(const parser::ForallConstruct &);
1227	void Post(const parser::ForallConstruct &);
1228	bool Pre(const parser::ForallStmt &);
1229	void Post(const parser::ForallStmt &);
1230	bool Pre(const parser::BlockConstruct &);
1231	void Post(const parser::Selector &);
1232	void Post(const parser::AssociateStmt &);
1233	void Post(const parser::EndAssociateStmt &);
1234	bool Pre(const parser::Association &);
1235	void Post(const parser::SelectTypeStmt &);
1236	void Post(const parser::SelectRankStmt &);
1237	bool Pre(const parser::SelectTypeConstruct &);
1238	void Post(const parser::SelectTypeConstruct &);
1239	bool Pre(const parser::SelectTypeConstruct::TypeCase &);
1240	void Post(const parser::SelectTypeConstruct::TypeCase &);
1241	// Creates Block scopes with neither symbol name nor symbol details.
1242	bool Pre(const parser::SelectRankConstruct::RankCase &);
1243	void Post(const parser::SelectRankConstruct::RankCase &);
1244	bool Pre(const parser::TypeGuardStmt::Guard &);
1245	void Post(const parser::TypeGuardStmt::Guard &);
1246	void Post(const parser::SelectRankCaseStmt::Rank &);
1247	bool Pre(const parser::ChangeTeamStmt &);
1248	void Post(const parser::EndChangeTeamStmt &);
1249	void Post(const parser::CoarrayAssociation &);
1250
1251	// Definitions of construct names
1252	bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
1253	bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
1254	bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
1255	bool Pre(const parser::LabelDoStmt &) {
1256	return false; // error recovery
1257	}
1258	bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
1259	bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
1260	bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
1261	bool Pre(const parser::SelectRankConstruct &);
1262	void Post(const parser::SelectRankConstruct &);
1263	bool Pre(const parser::SelectRankStmt &x) {
1264	return CheckDef(std::get<0>(x.t));
1265	}
1266	bool Pre(const parser::SelectTypeStmt &x) {
1267	return CheckDef(std::get<0>(x.t));
1268	}
1269
1270	// References to construct names
1271	void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }
1272	void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }
1273	void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
1274	void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
1275	void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
1276	void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
1277	void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }
1278	void Post(const parser::ElseStmt &x) { CheckRef(x.v); }
1279	void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }
1280	void Post(const parser::CaseStmt &x) { CheckRef(x.t); }
1281	void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }
1282	void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }
1283	void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }
1284	void Post(const parser::CycleStmt &x) { CheckRef(x.v); }
1285	void Post(const parser::ExitStmt &x) { CheckRef(x.v); }
1286
1287	void HandleImpliedAsynchronousInScope(const parser::Block &);
1288
1289	private:
1290	// R1105 selector -> expr | variable
1291	// expr is set in either case unless there were errors
1292	struct Selector {
1293	Selector() {}
1294	Selector(const SourceName &source, MaybeExpr &&expr)
1295	: source{source}, expr{std::move(expr)} {}
1296	operator bool() const { return expr.has_value(); }
1297	parser::CharBlock source;
1298	MaybeExpr expr;
1299	};
1300	// association -> [associate-name =>] selector
1301	struct Association {
1302	const parser::Name *name{nullptr};
1303	Selector selector;
1304	};
1305	std::vector<Association> associationStack_;
1306	Association *currentAssociation_{nullptr};
1307
1308	template <typename T> bool CheckDef(const T &t) {
1309	return CheckDef(std::get<std::optional<parser::Name>>(t));
1310	}
1311	template <typename T> void CheckRef(const T &t) {
1312	CheckRef(std::get<std::optional<parser::Name>>(t));
1313	}
1314	bool CheckDef(const std::optional<parser::Name> &);
1315	void CheckRef(const std::optional<parser::Name> &);
1316	const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
1317	const DeclTypeSpec &ToDeclTypeSpec(
1318	evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
1319	Symbol *MakeAssocEntity();
1320	void SetTypeFromAssociation(Symbol &);
1321	void SetAttrsFromAssociation(Symbol &);
1322	Selector ResolveSelector(const parser::Selector &);
1323	void ResolveIndexName(const parser::ConcurrentControl &control);
1324	void SetCurrentAssociation(std::size_t n);
1325	Association &GetCurrentAssociation();
1326	void PushAssociation();
1327	void PopAssociation(std::size_t count = 1);
1328	};
1329
1330	// Create scopes for OpenACC constructs
1331	class AccVisitor : public virtual DeclarationVisitor {
1332	public:
1333	void AddAccSourceRange(const parser::CharBlock &);
1334
1335	static bool NeedsScope(const parser::OpenACCBlockConstruct &);
1336
1337	bool Pre(const parser::OpenACCBlockConstruct &);
1338	void Post(const parser::OpenACCBlockConstruct &);
1339	bool Pre(const parser::OpenACCCombinedConstruct &);
1340	void Post(const parser::OpenACCCombinedConstruct &);
1341	bool Pre(const parser::AccBeginBlockDirective &x) {
1342	AddAccSourceRange(x.source);
1343	return true;
1344	}
1345	void Post(const parser::AccBeginBlockDirective &) {
1346	messageHandler().set_currStmtSource(std::nullopt);
1347	}
1348	bool Pre(const parser::AccEndBlockDirective &x) {
1349	AddAccSourceRange(x.source);
1350	return true;
1351	}
1352	void Post(const parser::AccEndBlockDirective &) {
1353	messageHandler().set_currStmtSource(std::nullopt);
1354	}
1355	bool Pre(const parser::AccBeginLoopDirective &x) {
1356	AddAccSourceRange(x.source);
1357	return true;
1358	}
1359	void Post(const parser::AccBeginLoopDirective &x) {
1360	messageHandler().set_currStmtSource(std::nullopt);
1361	}
1362	};
1363
1364	bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) {
1365	const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
1366	const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
1367	switch (beginDir.v) {
1368	case llvm::acc::Directive::ACCD_data:
1369	case llvm::acc::Directive::ACCD_host_data:
1370	case llvm::acc::Directive::ACCD_kernels:
1371	case llvm::acc::Directive::ACCD_parallel:
1372	case llvm::acc::Directive::ACCD_serial:
1373	return true;
1374	default:
1375	return false;
1376	}
1377	}
1378
1379	void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) {
1380	messageHandler().set_currStmtSource(source);
1381	currScope().AddSourceRange(source);
1382	}
1383
1384	bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
1385	if (NeedsScope(x)) {
1386	PushScope(Scope::Kind::OpenACCConstruct, nullptr);
1387	}
1388	return true;
1389	}
1390
1391	void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) {
1392	if (NeedsScope(x)) {
1393	PopScope();
1394	}
1395	}
1396
1397	bool AccVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
1398	PushScope(Scope::Kind::OpenACCConstruct, nullptr);
1399	return true;
1400	}
1401
1402	void AccVisitor::Post(const parser::OpenACCCombinedConstruct &x) { PopScope(); }
1403
1404	// Create scopes for OpenMP constructs
1405	class OmpVisitor : public virtual DeclarationVisitor {
1406	public:
1407	void AddOmpSourceRange(const parser::CharBlock &);
1408
1409	static bool NeedsScope(const parser::OpenMPBlockConstruct &);
1410
1411	bool Pre(const parser::OpenMPRequiresConstruct &x) {
1412	AddOmpSourceRange(x.source);
1413	return true;
1414	}
1415	bool Pre(const parser::OmpSimpleStandaloneDirective &x) {
1416	AddOmpSourceRange(x.source);
1417	return true;
1418	}
1419	bool Pre(const parser::OpenMPBlockConstruct &);
1420	void Post(const parser::OpenMPBlockConstruct &);
1421	bool Pre(const parser::OmpBeginBlockDirective &x) {
1422	AddOmpSourceRange(x.source);
1423	return true;
1424	}
1425	void Post(const parser::OmpBeginBlockDirective &) {
1426	messageHandler().set_currStmtSource(std::nullopt);
1427	}
1428	bool Pre(const parser::OmpEndBlockDirective &x) {
1429	AddOmpSourceRange(x.source);
1430	return true;
1431	}
1432	void Post(const parser::OmpEndBlockDirective &) {
1433	messageHandler().set_currStmtSource(std::nullopt);
1434	}
1435
1436	bool Pre(const parser::OpenMPLoopConstruct &) {
1437	PushScope(Scope::Kind::OtherConstruct, nullptr);
1438	return true;
1439	}
1440	void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
1441	bool Pre(const parser::OmpBeginLoopDirective &x) {
1442	AddOmpSourceRange(x.source);
1443	return true;
1444	}
1445	void Post(const parser::OmpBeginLoopDirective &) {
1446	messageHandler().set_currStmtSource(std::nullopt);
1447	}
1448	bool Pre(const parser::OmpEndLoopDirective &x) {
1449	AddOmpSourceRange(x.source);
1450	return true;
1451	}
1452	void Post(const parser::OmpEndLoopDirective &) {
1453	messageHandler().set_currStmtSource(std::nullopt);
1454	}
1455
1456	bool Pre(const parser::OpenMPSectionsConstruct &) {
1457	PushScope(Scope::Kind::OtherConstruct, nullptr);
1458	return true;
1459	}
1460	void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
1461	bool Pre(const parser::OmpBeginSectionsDirective &x) {
1462	AddOmpSourceRange(x.source);
1463	return true;
1464	}
1465	void Post(const parser::OmpBeginSectionsDirective &) {
1466	messageHandler().set_currStmtSource(std::nullopt);
1467	}
1468	bool Pre(const parser::OmpEndSectionsDirective &x) {
1469	AddOmpSourceRange(x.source);
1470	return true;
1471	}
1472	void Post(const parser::OmpEndSectionsDirective &) {
1473	messageHandler().set_currStmtSource(std::nullopt);
1474	}
1475	bool Pre(const parser::OmpCriticalDirective &x) {
1476	AddOmpSourceRange(x.source);
1477	return true;
1478	}
1479	void Post(const parser::OmpCriticalDirective &) {
1480	messageHandler().set_currStmtSource(std::nullopt);
1481	}
1482	bool Pre(const parser::OmpEndCriticalDirective &x) {
1483	AddOmpSourceRange(x.source);
1484	return true;
1485	}
1486	void Post(const parser::OmpEndCriticalDirective &) {
1487	messageHandler().set_currStmtSource(std::nullopt);
1488	}
1489	};
1490
1491	bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
1492	const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1493	const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1494	switch (beginDir.v) {
1495	case llvm::omp::Directive::OMPD_master:
1496	case llvm::omp::Directive::OMPD_ordered:
1497	case llvm::omp::Directive::OMPD_taskgroup:
1498	return false;
1499	default:
1500	return true;
1501	}
1502	}
1503
1504	void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
1505	messageHandler().set_currStmtSource(source);
1506	currScope().AddSourceRange(source);
1507	}
1508
1509	bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1510	if (NeedsScope(x)) {
1511	PushScope(Scope::Kind::OtherConstruct, nullptr);
1512	}
1513	return true;
1514	}
1515
1516	void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1517	if (NeedsScope(x)) {
1518	PopScope();
1519	}
1520	}
1521
1522	// Walk the parse tree and resolve names to symbols.
1523	class ResolveNamesVisitor : public virtual ScopeHandler,
1524	public ModuleVisitor,
1525	public SubprogramVisitor,
1526	public ConstructVisitor,
1527	public OmpVisitor,
1528	public AccVisitor {
1529	public:
1530	using AccVisitor::Post;
1531	using AccVisitor::Pre;
1532	using ArraySpecVisitor::Post;
1533	using ConstructVisitor::Post;
1534	using ConstructVisitor::Pre;
1535	using DeclarationVisitor::Post;
1536	using DeclarationVisitor::Pre;
1537	using ImplicitRulesVisitor::Post;
1538	using ImplicitRulesVisitor::Pre;
1539	using InterfaceVisitor::Post;
1540	using InterfaceVisitor::Pre;
1541	using ModuleVisitor::Post;
1542	using ModuleVisitor::Pre;
1543	using OmpVisitor::Post;
1544	using OmpVisitor::Pre;
1545	using ScopeHandler::Post;
1546	using ScopeHandler::Pre;
1547	using SubprogramVisitor::Post;
1548	using SubprogramVisitor::Pre;
1549
1550	ResolveNamesVisitor(
1551	SemanticsContext &context, ImplicitRulesMap &rules, Scope &top)
1552	: BaseVisitor{context, *this, rules}, topScope_{top} {
1553	PushScope(top);
1554	}
1555
1556	Scope &topScope() const { return topScope_; }
1557
1558	// Default action for a parse tree node is to visit children.
1559	template <typename T> bool Pre(const T &) { return true; }
1560	template <typename T> void Post(const T &) {}
1561
1562	bool Pre(const parser::SpecificationPart &);
1563	bool Pre(const parser::Program &);
1564	void Post(const parser::Program &);
1565	bool Pre(const parser::ImplicitStmt &);
1566	void Post(const parser::PointerObject &);
1567	void Post(const parser::AllocateObject &);
1568	bool Pre(const parser::PointerAssignmentStmt &);
1569	void Post(const parser::Designator &);
1570	void Post(const parser::SubstringInquiry &);
1571	template <typename A, typename B>
1572	void Post(const parser::LoopBounds<A, B> &x) {
1573	ResolveName(*parser::Unwrap<parser::Name>(x.name));
1574	}
1575	void Post(const parser::ProcComponentRef &);
1576	bool Pre(const parser::FunctionReference &);
1577	bool Pre(const parser::CallStmt &);
1578	bool Pre(const parser::ImportStmt &);
1579	void Post(const parser::TypeGuardStmt &);
1580	bool Pre(const parser::StmtFunctionStmt &);
1581	bool Pre(const parser::DefinedOpName &);
1582	bool Pre(const parser::ProgramUnit &);
1583	void Post(const parser::AssignStmt &);
1584	void Post(const parser::AssignedGotoStmt &);
1585	void Post(const parser::CompilerDirective &);
1586
1587	// These nodes should never be reached: they are handled in ProgramUnit
1588	bool Pre(const parser::MainProgram &) {
1589	llvm_unreachable("This node is handled in ProgramUnit");
1590	}
1591	bool Pre(const parser::FunctionSubprogram &) {
1592	llvm_unreachable("This node is handled in ProgramUnit");
1593	}
1594	bool Pre(const parser::SubroutineSubprogram &) {
1595	llvm_unreachable("This node is handled in ProgramUnit");
1596	}
1597	bool Pre(const parser::SeparateModuleSubprogram &) {
1598	llvm_unreachable("This node is handled in ProgramUnit");
1599	}
1600	bool Pre(const parser::Module &) {
1601	llvm_unreachable("This node is handled in ProgramUnit");
1602	}
1603	bool Pre(const parser::Submodule &) {
1604	llvm_unreachable("This node is handled in ProgramUnit");
1605	}
1606	bool Pre(const parser::BlockData &) {
1607	llvm_unreachable("This node is handled in ProgramUnit");
1608	}
1609
1610	void NoteExecutablePartCall(Symbol::Flag, SourceName, bool hasCUDAChevrons);
1611
1612	friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
1613
1614	private:
1615	// Kind of procedure we are expecting to see in a ProcedureDesignator
1616	std::optional<Symbol::Flag> expectedProcFlag_;
1617	std::optional<SourceName> prevImportStmt_;
1618	Scope &topScope_;
1619
1620	void PreSpecificationConstruct(const parser::SpecificationConstruct &);
1621	void CreateCommonBlockSymbols(const parser::CommonStmt &);
1622	void CreateGeneric(const parser::GenericSpec &);
1623	void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
1624	void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
1625	void CheckImports();
1626	void CheckImport(const SourceName &, const SourceName &);
1627	void HandleCall(Symbol::Flag, const parser::Call &);
1628	void HandleProcedureName(Symbol::Flag, const parser::Name &);
1629	bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
1630	bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
1631	void ResolveSpecificationParts(ProgramTree &);
1632	void AddSubpNames(ProgramTree &);
1633	bool BeginScopeForNode(const ProgramTree &);
1634	void EndScopeForNode(const ProgramTree &);
1635	void FinishSpecificationParts(const ProgramTree &);
1636	void FinishExecutionParts(const ProgramTree &);
1637	void FinishDerivedTypeInstantiation(Scope &);
1638	void ResolveExecutionParts(const ProgramTree &);
1639	void UseCUDABuiltinNames();
1640	void HandleDerivedTypesInImplicitStmts(const parser::ImplicitPart &,
1641	const std::list<parser::DeclarationConstruct> &);
1642	};
1643
1644	// ImplicitRules implementation
1645
1646	bool ImplicitRules::isImplicitNoneType() const {
1647	if (isImplicitNoneType_) {
1648	return true;
1649	} else if (map_.empty() && inheritFromParent_) {
1650	return parent_->isImplicitNoneType();
1651	} else {
1652	return false; // default if not specified
1653	}
1654	}
1655
1656	bool ImplicitRules::isImplicitNoneExternal() const {
1657	if (isImplicitNoneExternal_) {
1658	return true;
1659	} else if (inheritFromParent_) {
1660	return parent_->isImplicitNoneExternal();
1661	} else {
1662	return false; // default if not specified
1663	}
1664	}
1665
1666	const DeclTypeSpec *ImplicitRules::GetType(
1667	SourceName name, bool respectImplicitNoneType) const {
1668	char ch{name.begin()[0]};
1669	if (isImplicitNoneType_ && respectImplicitNoneType) {
1670	return nullptr;
1671	} else if (auto it{map_.find(ch)}; it != map_.end()) {
1672	return &*it->second;
1673	} else if (inheritFromParent_) {
1674	return parent_->GetType(name, respectImplicitNoneType);
1675	} else if (ch >= 'i' && ch <= 'n') {
1676	return &context_.MakeNumericType(TypeCategory::Integer);
1677	} else if (ch >= 'a' && ch <= 'z') {
1678	return &context_.MakeNumericType(TypeCategory::Real);
1679	} else {
1680	return nullptr;
1681	}
1682	}
1683
1684	void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
1685	parser::Location fromLetter, parser::Location toLetter) {
1686	for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
1687	auto res{map_.emplace(ch, type)};
1688	if (!res.second) {
1689	context_.Say(parser::CharBlock{fromLetter},
1690	"More than one implicit type specified for '%c'"_err_en_US, ch);
1691	}
1692	if (ch == *toLetter) {
1693	break;
1694	}
1695	}
1696	}
1697
1698	// Return the next char after ch in a way that works for ASCII or EBCDIC.
1699	// Return '\0' for the char after 'z'.
1700	char ImplicitRules::Incr(char ch) {
1701	switch (ch) {
1702	case 'i':
1703	return 'j';
1704	case 'r':
1705	return 's';
1706	case 'z':
1707	return '\0';
1708	default:
1709	return ch + 1;
1710	}
1711	}
1712
1713	llvm::raw_ostream &operator<<(
1714	llvm::raw_ostream &o, const ImplicitRules &implicitRules) {
1715	o << "ImplicitRules:\n";
1716	for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
1717	ShowImplicitRule(o, implicitRules, ch);
1718	}
1719	ShowImplicitRule(o, implicitRules, '_');
1720	ShowImplicitRule(o, implicitRules, '$');
1721	ShowImplicitRule(o, implicitRules, '@');
1722	return o;
1723	}
1724	void ShowImplicitRule(
1725	llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {
1726	auto it{implicitRules.map_.find(ch)};
1727	if (it != implicitRules.map_.end()) {
1728	o << " " << ch << ": " << *it->second << '\n';
1729	}
1730	}
1731
1732	template <typename T> void BaseVisitor::Walk(const T &x) {
1733	parser::Walk(x, *this_);
1734	}
1735
1736	void BaseVisitor::MakePlaceholder(
1737	const parser::Name &name, MiscDetails::Kind kind) {
1738	if (!name.symbol) {
1739	name.symbol = &context_->globalScope().MakeSymbol(
1740	name.source, Attrs{}, MiscDetails{kind});
1741	}
1742	}
1743
1744	// AttrsVisitor implementation
1745
1746	bool AttrsVisitor::BeginAttrs() {
1747	CHECK(!attrs_ && !cudaDataAttr_);
1748	attrs_ = Attrs{};
1749	return true;
1750	}
1751	Attrs AttrsVisitor::GetAttrs() {
1752	CHECK(attrs_);
1753	return *attrs_;
1754	}
1755	Attrs AttrsVisitor::EndAttrs() {
1756	Attrs result{GetAttrs()};
1757	attrs_.reset();
1758	cudaDataAttr_.reset();
1759	passName_ = std::nullopt;
1760	bindName_.reset();
1761	return result;
1762	}
1763
1764	bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
1765	if (!passName_) {
1766	return false;
1767	}
1768	common::visit(common::visitors{
1769	[&](ProcEntityDetails &x) { x.set_passName(*passName_); },
1770	[&](ProcBindingDetails &x) { x.set_passName(*passName_); },
1771	[](auto &) { common::die("unexpected pass name"); },
1772	},
1773	symbol.details());
1774	return true;
1775	}
1776
1777	void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
1778	if ((!attrs_ || !attrs_->test(Attr::BIND_C)) &&
1779	!symbol.attrs().test(Attr::BIND_C)) {
1780	return;
1781	}
1782
1783	std::optional<std::string> label{
1784	evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
1785	// 18.9.2(2): discard leading and trailing blanks
1786	if (label) {
1787	symbol.SetIsExplicitBindName(true);
1788	auto first{label->find_first_not_of(s: " ")};
1789	if (first == std::string::npos) {
1790	// Empty NAME= means no binding at all (18.10.2p2)
1791	return;
1792	}
1793	auto last{label->find_last_not_of(s: " ")};
1794	label = label->substr(pos: first, n: last - first + 1);
1795	} else if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) {
1796	// BIND(C) does not give an implicit binding label to internal procedures.
1797	return;
1798	} else {
1799	label = symbol.name().ToString();
1800	}
1801	// Check if a symbol has two Bind names.
1802	std::string oldBindName;
1803	if (symbol.GetBindName()) {
1804	oldBindName = *symbol.GetBindName();
1805	}
1806	symbol.SetBindName(std::move(*label));
1807	if (!oldBindName.empty()) {
1808	if (const std::string * newBindName{symbol.GetBindName()}) {
1809	if (oldBindName != *newBindName) {
1810	Say(symbol.name(), "The entity '%s' has multiple BIND names"_err_en_US);
1811	}
1812	}
1813	}
1814	}
1815
1816	void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
1817	if (CheckAndSet(Attr::BIND_C)) {
1818	if (x.v) {
1819	bindName_ = EvaluateExpr(*x.v);
1820	}
1821	}
1822	}
1823	bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
1824	CheckAndSet(IntentSpecToAttr(x));
1825	return false;
1826	}
1827	bool AttrsVisitor::Pre(const parser::Pass &x) {
1828	if (CheckAndSet(Attr::PASS)) {
1829	if (x.v) {
1830	passName_ = x.v->source;
1831	MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
1832	}
1833	}
1834	return false;
1835	}
1836
1837	// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
1838	bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
1839	CHECK(attrs_);
1840	if (attrs_->test(attrName)) {
1841	Say(currStmtSource().value(),
1842	"Attribute '%s' cannot be used more than once"_warn_en_US,
1843	AttrToString(attrName));
1844	return true;
1845	}
1846	return false;
1847	}
1848
1849	// See if attrName violates a constraint cause by a conflict. attr1 and attr2
1850	// name attributes that cannot be used on the same declaration
1851	bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
1852	CHECK(attrs_);
1853	if ((attrName == attr1 && attrs_->test(attr2)) ||
1854	(attrName == attr2 && attrs_->test(attr1))) {
1855	Say(currStmtSource().value(),
1856	"Attributes '%s' and '%s' conflict with each other"_err_en_US,
1857	AttrToString(attr1), AttrToString(attr2));
1858	return true;
1859	}
1860	return false;
1861	}
1862	// C759, C1543
1863	bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
1864	return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
1865	HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
1866	HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
1867	HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
1868	HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
1869	HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
1870	HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
1871	}
1872	bool AttrsVisitor::CheckAndSet(Attr attrName) {
1873	if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
1874	return false;
1875	}
1876	attrs_->set(attrName);
1877	return true;
1878	}
1879	bool AttrsVisitor::Pre(const common::CUDADataAttr x) {
1880	if (cudaDataAttr_.value_or(x) != x) {
1881	Say(currStmtSource().value(),
1882	"CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,
1883	common::EnumToString(*cudaDataAttr_), common::EnumToString(x));
1884	}
1885	cudaDataAttr_ = x;
1886	return false;
1887	}
1888
1889	// DeclTypeSpecVisitor implementation
1890
1891	const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
1892	return state_.declTypeSpec;
1893	}
1894
1895	void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
1896	CHECK(!state_.expectDeclTypeSpec);
1897	CHECK(!state_.declTypeSpec);
1898	state_.expectDeclTypeSpec = true;
1899	}
1900	void DeclTypeSpecVisitor::EndDeclTypeSpec() {
1901	CHECK(state_.expectDeclTypeSpec);
1902	state_ = {};
1903	}
1904
1905	void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
1906	DeclTypeSpec::Category category) {
1907	CHECK(state_.expectDeclTypeSpec);
1908	state_.derived.category = category;
1909	}
1910
1911	bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
1912	BeginDeclTypeSpec();
1913	return true;
1914	}
1915	void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
1916	EndDeclTypeSpec();
1917	}
1918
1919	void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
1920	// Record the resolved DeclTypeSpec in the parse tree for use by
1921	// expression semantics if the DeclTypeSpec is a valid TypeSpec.
1922	// The grammar ensures that it's an intrinsic or derived type spec,
1923	// not TYPE(*) or CLASS(*) or CLASS(T).
1924	if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
1925	switch (spec->category()) {
1926	case DeclTypeSpec::Numeric:
1927	case DeclTypeSpec::Logical:
1928	case DeclTypeSpec::Character:
1929	typeSpec.declTypeSpec = spec;
1930	break;
1931	case DeclTypeSpec::TypeDerived:
1932	if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
1933	CheckForAbstractType(typeSymbol: derived->typeSymbol()); // C703
1934	typeSpec.declTypeSpec = spec;
1935	}
1936	break;
1937	default:
1938	CRASH_NO_CASE;
1939	}
1940	}
1941	}
1942
1943	void DeclTypeSpecVisitor::Post(
1944	const parser::IntrinsicTypeSpec::DoublePrecision &) {
1945	MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
1946	}
1947	void DeclTypeSpecVisitor::Post(
1948	const parser::IntrinsicTypeSpec::DoubleComplex &) {
1949	MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
1950	}
1951	void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
1952	SetDeclTypeSpec(context().MakeNumericType(category, kind));
1953	}
1954
1955	void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {
1956	if (typeSymbol.attrs().test(Attr::ABSTRACT)) {
1957	Say("ABSTRACT derived type may not be used here"_err_en_US);
1958	}
1959	}
1960
1961	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
1962	SetDeclTypeSpec(context().globalScope().MakeClassStarType());
1963	}
1964	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
1965	SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
1966	}
1967
1968	// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
1969	// and save it in state_.declTypeSpec.
1970	void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
1971	CHECK(state_.expectDeclTypeSpec);
1972	CHECK(!state_.declTypeSpec);
1973	state_.declTypeSpec = &declTypeSpec;
1974	}
1975
1976	KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
1977	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
1978	return AnalyzeKindSelector(context(), category, kind);
1979	}
1980
1981	// MessageHandler implementation
1982
1983	Message &MessageHandler::Say(MessageFixedText &&msg) {
1984	return context_->Say(currStmtSource().value(), std::move(msg));
1985	}
1986	Message &MessageHandler::Say(MessageFormattedText &&msg) {
1987	return context_->Say(currStmtSource().value(), std::move(msg));
1988	}
1989	Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
1990	return Say(source: name, msg: std::move(msg), args: name);
1991	}
1992
1993	// ImplicitRulesVisitor implementation
1994
1995	void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
1996	prevParameterStmt_ = currStmtSource();
1997	}
1998
1999	bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
2000	bool result{
2001	common::visit(common::visitors{
2002	[&](const std::list<ImplicitNoneNameSpec> &y) {
2003	return HandleImplicitNone(y);
2004	},
2005	[&](const std::list<parser::ImplicitSpec> &) {
2006	if (prevImplicitNoneType_) {
2007	Say("IMPLICIT statement after IMPLICIT NONE or "
2008	"IMPLICIT NONE(TYPE) statement"_err_en_US);
2009	return false;
2010	}
2011	implicitRules_->set_isImplicitNoneType(false);
2012	return true;
2013	},
2014	},
2015	x.u)};
2016	prevImplicit_ = currStmtSource();
2017	return result;
2018	}
2019
2020	bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
2021	auto loLoc{std::get<parser::Location>(x.t)};
2022	auto hiLoc{loLoc};
2023	if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
2024	hiLoc = *hiLocOpt;
2025	if (*hiLoc < *loLoc) {
2026	Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
2027	std::string(hiLoc, 1), std::string(loLoc, 1));
2028	return false;
2029	}
2030	}
2031	implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
2032	return false;
2033	}
2034
2035	bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
2036	BeginDeclTypeSpec();
2037	set_allowForwardReferenceToDerivedType(true);
2038	return true;
2039	}
2040
2041	void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
2042	set_allowForwardReferenceToDerivedType(false);
2043	EndDeclTypeSpec();
2044	}
2045
2046	void ImplicitRulesVisitor::SetScope(const Scope &scope) {
2047	implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);
2048	prevImplicit_ = std::nullopt;
2049	prevImplicitNone_ = std::nullopt;
2050	prevImplicitNoneType_ = std::nullopt;
2051	prevParameterStmt_ = std::nullopt;
2052	}
2053	void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
2054	// find or create implicit rules for this scope
2055	DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);
2056	SetScope(scope);
2057	}
2058
2059	// TODO: for all of these errors, reference previous statement too
2060	bool ImplicitRulesVisitor::HandleImplicitNone(
2061	const std::list<ImplicitNoneNameSpec> &nameSpecs) {
2062	if (prevImplicitNone_) {
2063	Say("More than one IMPLICIT NONE statement"_err_en_US);
2064	Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
2065	return false;
2066	}
2067	if (prevParameterStmt_) {
2068	Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
2069	return false;
2070	}
2071	prevImplicitNone_ = currStmtSource();
2072	bool implicitNoneTypeNever{
2073	context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
2074	if (nameSpecs.empty()) {
2075	if (!implicitNoneTypeNever) {
2076	prevImplicitNoneType_ = currStmtSource();
2077	implicitRules_->set_isImplicitNoneType(true);
2078	if (prevImplicit_) {
2079	Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
2080	return false;
2081	}
2082	}
2083	} else {
2084	int sawType{0};
2085	int sawExternal{0};
2086	for (const auto noneSpec : nameSpecs) {
2087	switch (noneSpec) {
2088	case ImplicitNoneNameSpec::External:
2089	implicitRules_->set_isImplicitNoneExternal(true);
2090	++sawExternal;
2091	break;
2092	case ImplicitNoneNameSpec::Type:
2093	if (!implicitNoneTypeNever) {
2094	prevImplicitNoneType_ = currStmtSource();
2095	implicitRules_->set_isImplicitNoneType(true);
2096	if (prevImplicit_) {
2097	Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
2098	return false;
2099	}
2100	++sawType;
2101	}
2102	break;
2103	}
2104	}
2105	if (sawType > 1) {
2106	Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
2107	return false;
2108	}
2109	if (sawExternal > 1) {
2110	Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
2111	return false;
2112	}
2113	}
2114	return true;
2115	}
2116
2117	// ArraySpecVisitor implementation
2118
2119	void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
2120	CHECK(arraySpec_.empty());
2121	arraySpec_ = AnalyzeArraySpec(context(), x);
2122	}
2123	void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
2124	CHECK(arraySpec_.empty());
2125	arraySpec_ = AnalyzeArraySpec(context(), x);
2126	}
2127	void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
2128	CHECK(coarraySpec_.empty());
2129	coarraySpec_ = AnalyzeCoarraySpec(context(), x);
2130	}
2131
2132	const ArraySpec &ArraySpecVisitor::arraySpec() {
2133	return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
2134	}
2135	const ArraySpec &ArraySpecVisitor::coarraySpec() {
2136	return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
2137	}
2138	void ArraySpecVisitor::BeginArraySpec() {
2139	CHECK(arraySpec_.empty());
2140	CHECK(coarraySpec_.empty());
2141	CHECK(attrArraySpec_.empty());
2142	CHECK(attrCoarraySpec_.empty());
2143	}
2144	void ArraySpecVisitor::EndArraySpec() {
2145	CHECK(arraySpec_.empty());
2146	CHECK(coarraySpec_.empty());
2147	attrArraySpec_.clear();
2148	attrCoarraySpec_.clear();
2149	}
2150	void ArraySpecVisitor::PostAttrSpec() {
2151	// Save dimension/codimension from attrs so we can process array/coarray-spec
2152	// on the entity-decl
2153	if (!arraySpec_.empty()) {
2154	if (attrArraySpec_.empty()) {
2155	attrArraySpec_ = arraySpec_;
2156	arraySpec_.clear();
2157	} else {
2158	Say(currStmtSource().value(),
2159	"Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
2160	}
2161	}
2162	if (!coarraySpec_.empty()) {
2163	if (attrCoarraySpec_.empty()) {
2164	attrCoarraySpec_ = coarraySpec_;
2165	coarraySpec_.clear();
2166	} else {
2167	Say(currStmtSource().value(),
2168	"Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
2169	}
2170	}
2171	}
2172
2173	// FuncResultStack implementation
2174
2175	FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
2176
2177	void FuncResultStack::CompleteFunctionResultType() {
2178	// If the function has a type in the prefix, process it now.
2179	FuncInfo *info{Top()};
2180	if (info && &info->scope == &scopeHandler_.currScope()) {
2181	if (info->parsedType && info->resultSymbol) {
2182	scopeHandler_.messageHandler().set_currStmtSource(info->source);
2183	if (const auto *type{
2184	scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
2185	Symbol &symbol{*info->resultSymbol};
2186	if (!scopeHandler_.context().HasError(symbol)) {
2187	if (symbol.GetType()) {
2188	scopeHandler_.Say(symbol.name(),
2189	"Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US);
2190	scopeHandler_.context().SetError(symbol);
2191	} else {
2192	symbol.SetType(*type);
2193	}
2194	}
2195	}
2196	info->parsedType = nullptr;
2197	}
2198	}
2199	}
2200
2201	// Called from ConvertTo{Object/Proc}Entity to cope with any appearance
2202	// of the function result in a specification expression.
2203	void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {
2204	if (FuncInfo * info{Top()}) {
2205	if (info->resultSymbol == &symbol) {
2206	CompleteFunctionResultType();
2207	}
2208	}
2209	}
2210
2211	void FuncResultStack::Pop() {
2212	if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {
2213	stack_.pop_back();
2214	}
2215	}
2216
2217	// ScopeHandler implementation
2218
2219	void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
2220	SayAlreadyDeclared(name.source, prev);
2221	}
2222	void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
2223	if (context().HasError(prev)) {
2224	// don't report another error about prev
2225	} else {
2226	if (const auto *details{prev.detailsIf<UseDetails>()}) {
2227	Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
2228	.Attach(details->location(),
2229	"It is use-associated with '%s' in module '%s'"_en_US,
2230	details->symbol().name(), GetUsedModule(*details).name());
2231	} else {
2232	SayAlreadyDeclared(name, prev.name());
2233	}
2234	context().SetError(prev);
2235	}
2236	}
2237	void ScopeHandler::SayAlreadyDeclared(
2238	const SourceName &name1, const SourceName &name2) {
2239	if (name1.begin() < name2.begin()) {
2240	SayAlreadyDeclared(name1: name2, name2: name1);
2241	} else {
2242	Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
2243	.Attach(name2, "Previous declaration of '%s'"_en_US, name2);
2244	}
2245	}
2246
2247	void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
2248	MessageFixedText &&msg1, Message &&msg2) {
2249	bool isFatal{msg1.IsFatal()};
2250	Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));
2251	context().SetError(symbol, isFatal);
2252	}
2253
2254	void ScopeHandler::SayWithDecl(
2255	const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
2256	auto &message{Say(name, std::move(msg), symbol.name())
2257	.Attach(Message{symbol.name(),
2258	symbol.test(Symbol::Flag::Implicit)
2259	? "Implicit declaration of '%s'"_en_US
2260	: "Declaration of '%s'"_en_US,
2261	name.source})};
2262	if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
2263	if (auto usedAsProc{proc->usedAsProcedureHere()}) {
2264	if (usedAsProc->begin() != symbol.name().begin()) {
2265	message.Attach(Message{*usedAsProc, "Referenced as a procedure"_en_US});
2266	}
2267	}
2268	}
2269	}
2270
2271	void ScopeHandler::SayLocalMustBeVariable(
2272	const parser::Name &name, Symbol &symbol) {
2273	SayWithDecl(name, symbol,
2274	"The name '%s' must be a variable to appear"
2275	" in a locality-spec"_err_en_US);
2276	}
2277
2278	void ScopeHandler::SayDerivedType(
2279	const SourceName &name, MessageFixedText &&msg, const Scope &type) {
2280	const Symbol &typeSymbol{DEREF(type.GetSymbol())};
2281	Say(name, std::move(msg), name, typeSymbol.name())
2282	.Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
2283	typeSymbol.name());
2284	}
2285	void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
2286	const SourceName &name2, MessageFixedText &&msg2) {
2287	Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
2288	}
2289	void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
2290	Symbol &symbol, MessageFixedText &&msg2) {
2291	bool isFatal{msg1.IsFatal()};
2292	Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
2293	context().SetError(symbol, isFatal);
2294	}
2295	void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
2296	Symbol &symbol, MessageFixedText &&msg2) {
2297	bool isFatal{msg1.IsFatal()};
2298	Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
2299	context().SetError(symbol, isFatal);
2300	}
2301
2302	// This is essentially GetProgramUnitContaining(), but it can return
2303	// a mutable Scope &, it ignores statement functions, and it fails
2304	// gracefully for error recovery (returning the original Scope).
2305	template <typename T> static T &GetInclusiveScope(T &scope) {
2306	for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
2307	switch (s->kind()) {
2308	case Scope::Kind::Module:
2309	case Scope::Kind::MainProgram:
2310	case Scope::Kind::Subprogram:
2311	case Scope::Kind::BlockData:
2312	if (!s->IsStmtFunction()) {
2313	return *s;
2314	}
2315	break;
2316	default:;
2317	}
2318	}
2319	return scope;
2320	}
2321
2322	Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(scope&: currScope()); }
2323
2324	Scope *ScopeHandler::GetHostProcedure() {
2325	Scope &parent{InclusiveScope().parent()};
2326	switch (parent.kind()) {
2327	case Scope::Kind::Subprogram:
2328	return &parent;
2329	case Scope::Kind::MainProgram:
2330	return &parent;
2331	default:
2332	return nullptr;
2333	}
2334	}
2335
2336	Scope &ScopeHandler::NonDerivedTypeScope() {
2337	return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
2338	}
2339
2340	void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
2341	PushScope(scope&: currScope().MakeScope(kind, symbol));
2342	}
2343	void ScopeHandler::PushScope(Scope &scope) {
2344	currScope_ = &scope;
2345	auto kind{currScope_->kind()};
2346	if (kind != Scope::Kind::BlockConstruct &&
2347	kind != Scope::Kind::OtherConstruct) {
2348	BeginScope(scope);
2349	}
2350	// The name of a module or submodule cannot be "used" in its scope,
2351	// as we read 19.3.1(2), so we allow the name to be used as a local
2352	// identifier in the module or submodule too. Same with programs
2353	// (14.1(3)) and BLOCK DATA.
2354	if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
2355	kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
2356	if (auto *symbol{scope.symbol()}) {
2357	// Create a dummy symbol so we can't create another one with the same
2358	// name. It might already be there if we previously pushed the scope.
2359	SourceName name{symbol->name()};
2360	if (!FindInScope(scope, name)) {
2361	auto &newSymbol{MakeSymbol(name)};
2362	if (kind == Scope::Kind::Subprogram) {
2363	// Allow for recursive references. If this symbol is a function
2364	// without an explicit RESULT(), this new symbol will be discarded
2365	// and replaced with an object of the same name.
2366	newSymbol.set_details(HostAssocDetails{*symbol});
2367	} else {
2368	newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
2369	}
2370	}
2371	}
2372	}
2373	}
2374	void ScopeHandler::PopScope() {
2375	CHECK(currScope_ && !currScope_->IsGlobal());
2376	// Entities that are not yet classified as objects or procedures are now
2377	// assumed to be objects.
2378	// TODO: Statement functions
2379	for (auto &pair : currScope()) {
2380	ConvertToObjectEntity(*pair.second);
2381	}
2382	funcResultStack_.Pop();
2383	// If popping back into a global scope, pop back to the main global scope.
2384	SetScope(currScope_->parent().IsGlobal() ? context().globalScope()
2385	: currScope_->parent());
2386	}
2387	void ScopeHandler::SetScope(Scope &scope) {
2388	currScope_ = &scope;
2389	ImplicitRulesVisitor::SetScope(InclusiveScope());
2390	}
2391
2392	Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
2393	return FindSymbol(currScope(), name);
2394	}
2395	Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
2396	if (scope.IsDerivedType()) {
2397	if (Symbol * symbol{scope.FindComponent(name.source)}) {
2398	if (symbol->has<TypeParamDetails>()) {
2399	return Resolve(name, symbol);
2400	}
2401	}
2402	return FindSymbol(scope.parent(), name);
2403	} else {
2404	// In EQUIVALENCE statements only resolve names in the local scope, see
2405	// 19.5.1.4, paragraph 2, item (10)
2406	return Resolve(name,
2407	inEquivalenceStmt_ ? FindInScope(scope, name)
2408	: scope.FindSymbol(name.source));
2409	}
2410	}
2411
2412	Symbol &ScopeHandler::MakeSymbol(
2413	Scope &scope, const SourceName &name, Attrs attrs) {
2414	if (Symbol * symbol{FindInScope(scope, name)}) {
2415	CheckDuplicatedAttrs(name, *symbol, attrs);
2416	SetExplicitAttrs(*symbol, attrs);
2417	return *symbol;
2418	} else {
2419	const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
2420	CHECK(pair.second); // name was not found, so must be able to add
2421	return *pair.first->second;
2422	}
2423	}
2424	Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
2425	return MakeSymbol(currScope(), name, attrs);
2426	}
2427	Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
2428	return Resolve(name, MakeSymbol(name.source, attrs));
2429	}
2430	Symbol &ScopeHandler::MakeHostAssocSymbol(
2431	const parser::Name &name, const Symbol &hostSymbol) {
2432	Symbol &symbol{*NonDerivedTypeScope()
2433	.try_emplace(name.source, HostAssocDetails{hostSymbol})
2434	.first->second};
2435	name.symbol = &symbol;
2436	symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
2437	// These attributes can be redundantly reapplied without error
2438	// on the host-associated name, at most once (C815).
2439	symbol.implicitAttrs() =
2440	symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
2441	// SAVE statement in the inner scope will create a new symbol.
2442	// If the host variable is used via host association,
2443	// we have to propagate whether SAVE is implicit in the host scope.
2444	// Otherwise, verifications that do not allow explicit SAVE
2445	// attribute would fail.
2446	symbol.implicitAttrs() |= hostSymbol.implicitAttrs() & Attrs{Attr::SAVE};
2447	symbol.flags() = hostSymbol.flags();
2448	return symbol;
2449	}
2450	Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
2451	CHECK(!FindInScope(name));
2452	return MakeSymbol(currScope(), name, symbol.attrs());
2453	}
2454
2455	// Look for name only in scope, not in enclosing scopes.
2456	Symbol *ScopeHandler::FindInScope(
2457	const Scope &scope, const parser::Name &name) {
2458	return Resolve(name, FindInScope(scope, name.source));
2459	}
2460	Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
2461	// all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
2462	for (const std::string &n : GetAllNames(context(), name)) {
2463	auto it{scope.find(SourceName{n})};
2464	if (it != scope.end()) {
2465	return &*it->second;
2466	}
2467	}
2468	return nullptr;
2469	}
2470
2471	// Find a component or type parameter by name in a derived type or its parents.
2472	Symbol *ScopeHandler::FindInTypeOrParents(
2473	const Scope &scope, const parser::Name &name) {
2474	return Resolve(name, scope.FindComponent(name.source));
2475	}
2476	Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
2477	return FindInTypeOrParents(scope: currScope(), name);
2478	}
2479	Symbol *ScopeHandler::FindInScopeOrBlockConstructs(
2480	const Scope &scope, SourceName name) {
2481	if (Symbol * symbol{FindInScope(scope, name)}) {
2482	return symbol;
2483	}
2484	for (const Scope &child : scope.children()) {
2485	if (child.kind() == Scope::Kind::BlockConstruct) {
2486	if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) {
2487	return symbol;
2488	}
2489	}
2490	}
2491	return nullptr;
2492	}
2493
2494	void ScopeHandler::EraseSymbol(const parser::Name &name) {
2495	currScope().erase(name.source);
2496	name.symbol = nullptr;
2497	}
2498
2499	static bool NeedsType(const Symbol &symbol) {
2500	return !symbol.GetType() &&
2501	common::visit(common::visitors{
2502	[](const EntityDetails &) { return true; },
2503	[](const ObjectEntityDetails &) { return true; },
2504	[](const AssocEntityDetails &) { return true; },
2505	[&](const ProcEntityDetails &p) {
2506	return symbol.test(Symbol::Flag::Function) &&
2507	!symbol.attrs().test(Attr::INTRINSIC) &&
2508	!p.type() && !p.procInterface();
2509	},
2510	[](const auto &) { return false; },
2511	},
2512	symbol.details());
2513	}
2514
2515	void ScopeHandler::ApplyImplicitRules(
2516	Symbol &symbol, bool allowForwardReference) {
2517	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
2518	if (context().HasError(symbol) || !NeedsType(symbol)) {
2519	return;
2520	}
2521	if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
2522	symbol.set(Symbol::Flag::Implicit);
2523	symbol.SetType(*type);
2524	return;
2525	}
2526	if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
2527	std::optional<Symbol::Flag> functionOrSubroutineFlag;
2528	if (symbol.test(Symbol::Flag::Function)) {
2529	functionOrSubroutineFlag = Symbol::Flag::Function;
2530	} else if (symbol.test(Symbol::Flag::Subroutine)) {
2531	functionOrSubroutineFlag = Symbol::Flag::Subroutine;
2532	}
2533	if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
2534	// type will be determined in expression semantics
2535	AcquireIntrinsicProcedureFlags(symbol);
2536	return;
2537	}
2538	}
2539	if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
2540	return;
2541	}
2542	if (const auto *entity{symbol.detailsIf<EntityDetails>()};
2543	entity && entity->isDummy()) {
2544	// Dummy argument, no declaration or reference; if it turns
2545	// out to be a subroutine, it's fine, and if it is a function
2546	// or object, it'll be caught later.
2547	return;
2548	}
2549	if (deferImplicitTyping_) {
2550	return;
2551	}
2552	if (!context().HasError(symbol)) {
2553	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
2554	context().SetError(symbol);
2555	}
2556	}
2557
2558	// Extension: Allow forward references to scalar integer dummy arguments
2559	// or variables in COMMON to appear in specification expressions under
2560	// IMPLICIT NONE(TYPE) when what would otherwise have been their implicit
2561	// type is default INTEGER.
2562	bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
2563	if (!inSpecificationPart_ || context().HasError(symbol) ||
2564	!(IsDummy(symbol) || FindCommonBlockContaining(symbol)) ||
2565	symbol.Rank() != 0 ||
2566	!context().languageFeatures().IsEnabled(
2567	common::LanguageFeature::ForwardRefImplicitNone)) {
2568	return false;
2569	}
2570	const DeclTypeSpec *type{
2571	GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
2572	if (!type || !type->IsNumeric(TypeCategory::Integer)) {
2573	return false;
2574	}
2575	auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
2576	if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
2577	return false;
2578	}
2579	if (!ConvertToObjectEntity(symbol)) {
2580	return false;
2581	}
2582	// TODO: check no INTENT(OUT) if dummy?
2583	if (context().ShouldWarn(common::LanguageFeature::ForwardRefImplicitNone)) {
2584	Say(symbol.name(),
2585	"'%s' was used without (or before) being explicitly typed"_warn_en_US,
2586	symbol.name());
2587	}
2588	symbol.set(Symbol::Flag::Implicit);
2589	symbol.SetType(*type);
2590	return true;
2591	}
2592
2593	// Ensure that the symbol for an intrinsic procedure is marked with
2594	// the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as
2595	// appropriate.
2596	void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
2597	SetImplicitAttr(symbol, Attr::INTRINSIC);
2598	switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {
2599	case evaluate::IntrinsicClass::elementalFunction:
2600	case evaluate::IntrinsicClass::elementalSubroutine:
2601	SetExplicitAttr(symbol, Attr::ELEMENTAL);
2602	SetExplicitAttr(symbol, Attr::PURE);
2603	break;
2604	case evaluate::IntrinsicClass::impureSubroutine:
2605	break;
2606	default:
2607	SetExplicitAttr(symbol, Attr::PURE);
2608	}
2609	}
2610
2611	const DeclTypeSpec *ScopeHandler::GetImplicitType(
2612	Symbol &symbol, bool respectImplicitNoneType) {
2613	const Scope *scope{&symbol.owner()};
2614	if (scope->IsGlobal()) {
2615	scope = &currScope();
2616	}
2617	scope = &GetInclusiveScope(scope: *scope);
2618	const auto *type{implicitRulesMap_->at(k: scope).GetType(
2619	symbol.name(), respectImplicitNoneType)};
2620	if (type) {
2621	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
2622	// Resolve any forward-referenced derived type; a quick no-op else.
2623	auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
2624	instantiatable.Instantiate(currScope());
2625	}
2626	}
2627	return type;
2628	}
2629
2630	void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) {
2631	if (!inSpecificationPart_ && symbol &&
2632	symbol->test(Symbol::Flag::EntryDummyArgument)) {
2633	Say(source,
2634	"Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US,
2635	symbol->name());
2636	symbol->set(Symbol::Flag::EntryDummyArgument, false);
2637	}
2638	}
2639
2640	// Convert symbol to be a ObjectEntity or return false if it can't be.
2641	bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
2642	if (symbol.has<ObjectEntityDetails>()) {
2643	// nothing to do
2644	} else if (symbol.has<UnknownDetails>()) {
2645	// These are attributes that a name could have picked up from
2646	// an attribute statement or type declaration statement.
2647	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
2648	return false;
2649	}
2650	symbol.set_details(ObjectEntityDetails{});
2651	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2652	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
2653	return false;
2654	}
2655	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
2656	symbol.set_details(ObjectEntityDetails{std::move(*details)});
2657	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
2658	return useDetails->symbol().has<ObjectEntityDetails>();
2659	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
2660	return hostDetails->symbol().has<ObjectEntityDetails>();
2661	} else {
2662	return false;
2663	}
2664	return true;
2665	}
2666	// Convert symbol to be a ProcEntity or return false if it can't be.
2667	bool ScopeHandler::ConvertToProcEntity(
2668	Symbol &symbol, std::optional<SourceName> usedHere) {
2669	if (symbol.has<ProcEntityDetails>()) {
2670	} else if (symbol.has<UnknownDetails>()) {
2671	symbol.set_details(ProcEntityDetails{});
2672	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
2673	if (IsFunctionResult(symbol) &&
2674	!(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
2675	// Don't turn function result into a procedure pointer unless both
2676	// POINTER and EXTERNAL
2677	return false;
2678	}
2679	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
2680	symbol.set_details(ProcEntityDetails{std::move(*details)});
2681	if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
2682	CHECK(!symbol.test(Symbol::Flag::Subroutine));
2683	symbol.set(Symbol::Flag::Function);
2684	}
2685	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
2686	return useDetails->symbol().has<ProcEntityDetails>();
2687	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
2688	return hostDetails->symbol().has<ProcEntityDetails>();
2689	} else {
2690	return false;
2691	}
2692	auto &proc{symbol.get<ProcEntityDetails>()};
2693	if (usedHere && !proc.usedAsProcedureHere()) {
2694	proc.set_usedAsProcedureHere(*usedHere);
2695	}
2696	return true;
2697	}
2698
2699	const DeclTypeSpec &ScopeHandler::MakeNumericType(
2700	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
2701	KindExpr value{GetKindParamExpr(category, kind)};
2702	if (auto known{evaluate::ToInt64(value)}) {
2703	return MakeNumericType(category, static_cast<int>(*known));
2704	} else {
2705	return currScope_->MakeNumericType(category, std::move(value));
2706	}
2707	}
2708
2709	const DeclTypeSpec &ScopeHandler::MakeNumericType(
2710	TypeCategory category, int kind) {
2711	return context().MakeNumericType(category, kind);
2712	}
2713
2714	const DeclTypeSpec &ScopeHandler::MakeLogicalType(
2715	const std::optional<parser::KindSelector> &kind) {
2716	KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
2717	if (auto known{evaluate::ToInt64(value)}) {
2718	return MakeLogicalType(static_cast<int>(*known));
2719	} else {
2720	return currScope_->MakeLogicalType(std::move(value));
2721	}
2722	}
2723
2724	const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
2725	return context().MakeLogicalType(kind);
2726	}
2727
2728	void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
2729	if (inSpecificationPart_ && !deferImplicitTyping_ && name.symbol) {
2730	auto kind{currScope().kind()};
2731	if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
2732	kind == Scope::Kind::BlockConstruct) {
2733	bool isHostAssociated{&name.symbol->owner() == &currScope()
2734	? name.symbol->has<HostAssocDetails>()
2735	: name.symbol->owner().Contains(currScope())};
2736	if (isHostAssociated) {
2737	specPartState_.forwardRefs.insert(name.source);
2738	}
2739	}
2740	}
2741	}
2742
2743	std::optional<SourceName> ScopeHandler::HadForwardRef(
2744	const Symbol &symbol) const {
2745	auto iter{specPartState_.forwardRefs.find(symbol.name())};
2746	if (iter != specPartState_.forwardRefs.end()) {
2747	return *iter;
2748	}
2749	return std::nullopt;
2750	}
2751
2752	bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
2753	if (!context().HasError(symbol)) {
2754	if (auto fwdRef{HadForwardRef(symbol)}) {
2755	const Symbol *outer{symbol.owner().FindSymbol(symbol.name())};
2756	if (outer && symbol.has<UseDetails>() &&
2757	&symbol.GetUltimate() == &outer->GetUltimate()) {
2758	// e.g. IMPORT of host's USE association
2759	return false;
2760	}
2761	Say(*fwdRef,
2762	"Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
2763	*fwdRef)
2764	.Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
2765	context().SetError(symbol);
2766	return true;
2767	}
2768	if ((IsDummy(symbol) || FindCommonBlockContaining(symbol)) &&
2769	isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) &&
2770	!context().HasError(symbol)) {
2771	// Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in
2772	// ApplyImplicitRules() due to use in a specification expression,
2773	// and no explicit type declaration appeared later.
2774	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
2775	context().SetError(symbol);
2776	return true;
2777	}
2778	}
2779	return false;
2780	}
2781
2782	void ScopeHandler::MakeExternal(Symbol &symbol) {
2783	if (!symbol.attrs().test(Attr::EXTERNAL)) {
2784	SetImplicitAttr(symbol, Attr::EXTERNAL);
2785	if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
2786	Say(symbol.name(),
2787	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
2788	symbol.name());
2789	}
2790	}
2791	}
2792
2793	bool ScopeHandler::CheckDuplicatedAttr(
2794	SourceName name, const Symbol &symbol, Attr attr) {
2795	if (attr == Attr::SAVE) {
2796	// checked elsewhere
2797	} else if (symbol.attrs().test(attr)) { // C815
2798	if (symbol.implicitAttrs().test(attr)) {
2799	// Implied attribute is now confirmed explicitly
2800	} else {
2801	Say(name, "%s attribute was already specified on '%s'"_err_en_US,
2802	EnumToString(attr), name);
2803	return false;
2804	}
2805	}
2806	return true;
2807	}
2808
2809	bool ScopeHandler::CheckDuplicatedAttrs(
2810	SourceName name, const Symbol &symbol, Attrs attrs) {
2811	bool ok{true};
2812	attrs.IterateOverMembers(
2813	[&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });
2814	return ok;
2815	}
2816
2817	void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,
2818	std::optional<common::CUDADataAttr> attr) {
2819	if (attr) {
2820	ConvertToObjectEntity(symbol);
2821	if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
2822	if (*attr != object->cudaDataAttr().value_or(*attr)) {
2823	Say(source,
2824	"'%s' already has another CUDA data attribute ('%s')"_err_en_US,
2825	symbol.name(),
2826	std::string{common::EnumToString(*object->cudaDataAttr())}.c_str());
2827	} else {
2828	object->set_cudaDataAttr(attr);
2829	}
2830	} else {
2831	Say(source,
2832	"'%s' is not an object and may not have a CUDA data attribute"_err_en_US,
2833	symbol.name());
2834	}
2835	}
2836	}
2837
2838	// ModuleVisitor implementation
2839
2840	bool ModuleVisitor::Pre(const parser::Only &x) {
2841	common::visit(common::visitors{
2842	[&](const Indirection<parser::GenericSpec> &generic) {
2843	GenericSpecInfo genericSpecInfo{generic.value()};
2844	AddUseOnly(genericSpecInfo.symbolName());
2845	AddUse(genericSpecInfo);
2846	},
2847	[&](const parser::Name &name) {
2848	AddUseOnly(name.source);
2849	Resolve(name, AddUse(name.source, name.source).use);
2850	},
2851	[&](const parser::Rename &rename) { Walk(rename); },
2852	},
2853	x.u);
2854	return false;
2855	}
2856
2857	void ModuleVisitor::CollectUseRenames(const parser::UseStmt &useStmt) {
2858	auto doRename{[&](const parser::Rename &rename) {
2859	if (const auto *names{std::get_if<parser::Rename::Names>(&rename.u)}) {
2860	AddUseRename(name: std::get<1>(names->t).source, moduleName: useStmt.moduleName.source);
2861	}
2862	}};
2863	common::visit(
2864	common::visitors{
2865	[&](const std::list<parser::Rename> &renames) {
2866	for (const auto &rename : renames) {
2867	doRename(rename);
2868	}
2869	},
2870	[&](const std::list<parser::Only> &onlys) {
2871	for (const auto &only : onlys) {
2872	if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
2873	doRename(*rename);
2874	}
2875	}
2876	},
2877	},
2878	useStmt.u);
2879	}
2880
2881	bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
2882	const auto &localName{std::get<0>(x.t)};
2883	const auto &useName{std::get<1>(x.t)};
2884	SymbolRename rename{AddUse(localName.source, useName.source)};
2885	Resolve(useName, rename.use);
2886	Resolve(localName, rename.local);
2887	return false;
2888	}
2889	bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
2890	const parser::DefinedOpName &local{std::get<0>(x.t)};
2891	const parser::DefinedOpName &use{std::get<1>(x.t)};
2892	GenericSpecInfo localInfo{local};
2893	GenericSpecInfo useInfo{use};
2894	if (IsIntrinsicOperator(context(), local.v.source)) {
2895	Say(local.v,
2896	"Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
2897	} else if (IsLogicalConstant(context(), local.v.source)) {
2898	Say(local.v,
2899	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
2900	} else {
2901	SymbolRename rename{AddUse(localName: localInfo.symbolName(), useName: useInfo.symbolName())};
2902	useInfo.Resolve(rename.use);
2903	localInfo.Resolve(rename.local);
2904	}
2905	return false;
2906	}
2907
2908	// Set useModuleScope_ to the Scope of the module being used.
2909	bool ModuleVisitor::Pre(const parser::UseStmt &x) {
2910	std::optional<bool> isIntrinsic;
2911	if (x.nature) {
2912	isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic;
2913	} else if (currScope().IsModule() && currScope().symbol() &&
2914	currScope().symbol()->attrs().test(Attr::INTRINSIC)) {
2915	// Intrinsic modules USE only other intrinsic modules
2916	isIntrinsic = true;
2917	}
2918	useModuleScope_ = FindModule(x.moduleName, isIntrinsic);
2919	if (!useModuleScope_) {
2920	return false;
2921	}
2922	AddAndCheckModuleUse(x.moduleName.source,
2923	useModuleScope_->parent().kind() == Scope::Kind::IntrinsicModules);
2924	// use the name from this source file
2925	useModuleScope_->symbol()->ReplaceName(x.moduleName.source);
2926	return true;
2927	}
2928
2929	void ModuleVisitor::Post(const parser::UseStmt &x) {
2930	if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
2931	// Not a use-only: collect the names that were used in renames,
2932	// then add a use for each public name that was not renamed.
2933	std::set<SourceName> useNames;
2934	for (const auto &rename : *list) {
2935	common::visit(common::visitors{
2936	[&](const parser::Rename::Names &names) {
2937	useNames.insert(std::get<1>(names.t).source);
2938	},
2939	[&](const parser::Rename::Operators &ops) {
2940	useNames.insert(std::get<1>(ops.t).v.source);
2941	},
2942	},
2943	rename.u);
2944	}
2945	for (const auto &[name, symbol] : *useModuleScope_) {
2946	if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&
2947	(!symbol->implicitAttrs().test(Attr::INTRINSIC) ||
2948	symbol->has<UseDetails>()) &&
2949	!symbol->has<MiscDetails>() && useNames.count(name) == 0) {
2950	SourceName location{x.moduleName.source};
2951	if (auto *localSymbol{FindInScope(name)}) {
2952	DoAddUse(location, localSymbol->name(), *localSymbol, *symbol);
2953	} else {
2954	DoAddUse(location, location, CopySymbol(name, *symbol), *symbol);
2955	}
2956	}
2957	}
2958	}
2959	useModuleScope_ = nullptr;
2960	}
2961
2962	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2963	const SourceName &localName, const SourceName &useName) {
2964	return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));
2965	}
2966
2967	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
2968	const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {
2969	if (!useModuleScope_) {
2970	return {}; // error occurred finding module
2971	}
2972	if (!useSymbol) {
2973	Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName),
2974	useModuleScope_->GetName().value());
2975	return {};
2976	}
2977	if (useSymbol->attrs().test(Attr::PRIVATE) &&
2978	!FindModuleFileContaining(currScope())) {
2979	// Privacy is not enforced in module files so that generic interfaces
2980	// can be resolved to private specific procedures in specification
2981	// expressions.
2982	Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),
2983	useModuleScope_->GetName().value());
2984	return {};
2985	}
2986	auto &localSymbol{MakeSymbol(localName)};
2987	DoAddUse(useName, localName, localSymbol&: localSymbol, useSymbol: *useSymbol);
2988	return {&localSymbol, useSymbol};
2989	}
2990
2991	// symbol must be either a Use or a Generic formed by merging two uses.
2992	// Convert it to a UseError with this additional location.
2993	static bool ConvertToUseError(
2994	Symbol &symbol, const SourceName &location, const Scope &module) {
2995	const auto *useDetails{symbol.detailsIf<UseDetails>()};
2996	if (!useDetails) {
2997	if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {
2998	if (!genericDetails->uses().empty()) {
2999	useDetails = &genericDetails->uses().at(0)->get<UseDetails>();
3000	}
3001	}
3002	}
3003	if (useDetails) {
3004	symbol.set_details(
3005	UseErrorDetails{*useDetails}.add_occurrence(location, module));
3006	return true;
3007	} else {
3008	return false;
3009	}
3010	}
3011
3012	void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
3013	Symbol &originalLocal, const Symbol &useSymbol) {
3014	Symbol *localSymbol{&originalLocal};
3015	if (auto *details{localSymbol->detailsIf<UseErrorDetails>()}) {
3016	details->add_occurrence(location, *useModuleScope_);
3017	return;
3018	}
3019	const Symbol &useUltimate{useSymbol.GetUltimate()};
3020	if (localSymbol->has<UnknownDetails>()) {
3021	localSymbol->set_details(UseDetails{localName, useSymbol});
3022	localSymbol->attrs() =
3023	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};
3024	localSymbol->implicitAttrs() =
3025	localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
3026	localSymbol->flags() = useSymbol.flags();
3027	return;
3028	}
3029
3030	Symbol &localUltimate{localSymbol->GetUltimate()};
3031	if (&localUltimate == &useUltimate) {
3032	// use-associating the same symbol again -- ok
3033	return;
3034	}
3035
3036	// There are many possible combinations of symbol types that could arrive
3037	// with the same (local) name vie USE association from distinct modules.
3038	// Fortran allows a generic interface to share its name with a derived type,
3039	// or with the name of a non-generic procedure (which should be one of the
3040	// generic's specific procedures). Implementing all these possibilities is
3041	// complicated.
3042	// Error cases are converted into UseErrorDetails symbols to trigger error
3043	// messages when/if bad combinations are actually used later in the program.
3044	// The error cases are:
3045	// - two distinct derived types
3046	// - two distinct non-generic procedures
3047	// - a generic and a non-generic that is not already one of its specifics
3048	// - anything other than a derived type, non-generic procedure, or
3049	// generic procedure being combined with something other than an
3050	// prior USE association of itself
3051
3052	auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
3053	const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
3054
3055	Symbol *localDerivedType{nullptr};
3056	if (localUltimate.has<DerivedTypeDetails>()) {
3057	localDerivedType = &localUltimate;
3058	} else if (localGeneric) {
3059	if (auto *dt{localGeneric->derivedType()};
3060	dt && !dt->attrs().test(Attr::PRIVATE)) {
3061	localDerivedType = dt;
3062	}
3063	}
3064	const Symbol *useDerivedType{nullptr};
3065	if (useUltimate.has<DerivedTypeDetails>()) {
3066	useDerivedType = &useUltimate;
3067	} else if (useGeneric) {
3068	if (const auto *dt{useGeneric->derivedType()};
3069	dt && !dt->attrs().test(Attr::PRIVATE)) {
3070	useDerivedType = dt;
3071	}
3072	}
3073
3074	Symbol *localProcedure{nullptr};
3075	if (localGeneric) {
3076	if (localGeneric->specific() &&
3077	!localGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3078	localProcedure = localGeneric->specific();
3079	}
3080	} else if (IsProcedure(localUltimate)) {
3081	localProcedure = &localUltimate;
3082	}
3083	const Symbol *useProcedure{nullptr};
3084	if (useGeneric) {
3085	if (useGeneric->specific() &&
3086	!useGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3087	useProcedure = useGeneric->specific();
3088	}
3089	} else if (IsProcedure(useUltimate)) {
3090	useProcedure = &useUltimate;
3091	}
3092
3093	// Creates a UseErrorDetails symbol in the current scope for a
3094	// current UseDetails symbol, but leaves the UseDetails in the
3095	// scope's name map.
3096	auto CreateLocalUseError{[&]() {
3097	EraseSymbol(*localSymbol);
3098	UseErrorDetails details{localSymbol->get<UseDetails>()};
3099	details.add_occurrence(location, *useModuleScope_);
3100	Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))};
3101	// Restore *localSymbol in currScope
3102	auto iter{currScope().find(localName)};
3103	CHECK(iter != currScope().end() && &*iter->second == newSymbol);
3104	iter->second = MutableSymbolRef{*localSymbol};
3105	return newSymbol;
3106	}};
3107
3108	// When two derived types arrived, try to combine them.
3109	const Symbol *combinedDerivedType{nullptr};
3110	if (!useDerivedType) {
3111	combinedDerivedType = localDerivedType;
3112	} else if (!localDerivedType) {
3113	combinedDerivedType = useDerivedType;
3114	} else {
3115	const Scope *localScope{localDerivedType->scope()};
3116	const Scope *useScope{useDerivedType->scope()};
3117	if (localScope && useScope && localScope->derivedTypeSpec() &&
3118	useScope->derivedTypeSpec() &&
3119	evaluate::AreSameDerivedType(
3120	*localScope->derivedTypeSpec(), *useScope->derivedTypeSpec())) {
3121	combinedDerivedType = localDerivedType;
3122	} else {
3123	// Create a local UseErrorDetails for the ambiguous derived type
3124	if (localGeneric) {
3125	combinedDerivedType = CreateLocalUseError();
3126	} else {
3127	ConvertToUseError(*localSymbol, location, *useModuleScope_);
3128	combinedDerivedType = localSymbol;
3129	}
3130	}
3131	if (!localGeneric && !useGeneric) {
3132	return; // both symbols are derived types; done
3133	}
3134	}
3135
3136	auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) {
3137	if (&p1 == &p2) {
3138	return true;
3139	} else if (p1.name() != p2.name()) {
3140	return false;
3141	} else if (p1.attrs().test(Attr::INTRINSIC) ||
3142	p2.attrs().test(Attr::INTRINSIC)) {
3143	return p1.attrs().test(Attr::INTRINSIC) &&
3144	p2.attrs().test(Attr::INTRINSIC);
3145	} else if (!IsProcedure(p1) || !IsProcedure(p2)) {
3146	return false;
3147	} else if (IsPointer(p1) || IsPointer(p2)) {
3148	return false;
3149	} else if (const auto *subp{p1.detailsIf<SubprogramDetails>()};
3150	subp && !subp->isInterface()) {
3151	return false; // defined in module, not an external
3152	} else if (const auto *subp{p2.detailsIf<SubprogramDetails>()};
3153	subp && !subp->isInterface()) {
3154	return false; // defined in module, not an external
3155	} else {
3156	// Both are external interfaces, perhaps to the same procedure
3157	auto class1{ClassifyProcedure(p1)};
3158	auto class2{ClassifyProcedure(p2)};
3159	if (class1 == ProcedureDefinitionClass::External &&
3160	class2 == ProcedureDefinitionClass::External) {
3161	auto chars1{evaluate::characteristics::Procedure::Characterize(
3162	p1, GetFoldingContext())};
3163	auto chars2{evaluate::characteristics::Procedure::Characterize(
3164	p2, GetFoldingContext())};
3165	// same procedure interface defined identically in two modules?
3166	return chars1 && chars2 && *chars1 == *chars2;
3167	} else {
3168	return false;
3169	}
3170	}
3171	}};
3172
3173	// When two non-generic procedures arrived, try to combine them.
3174	const Symbol *combinedProcedure{nullptr};
3175	if (!localProcedure) {
3176	combinedProcedure = useProcedure;
3177	} else if (!useProcedure) {
3178	combinedProcedure = localProcedure;
3179	} else {
3180	if (AreSameProcedure(
3181	localProcedure->GetUltimate(), useProcedure->GetUltimate())) {
3182	if (!localGeneric && !useGeneric) {
3183	return; // both symbols are non-generic procedures
3184	}
3185	combinedProcedure = localProcedure;
3186	}
3187	}
3188
3189	// Prepare to merge generics
3190	bool cantCombine{false};
3191	if (localGeneric) {
3192	if (useGeneric || useDerivedType) {
3193	} else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
3194	return; // nothing to do; used subprogram is local's specific
3195	} else if (useUltimate.attrs().test(Attr::INTRINSIC) &&
3196	useUltimate.name() == localSymbol->name()) {
3197	return; // local generic can extend intrinsic
3198	} else {
3199	for (const auto &ref : localGeneric->specificProcs()) {
3200	if (&ref->GetUltimate() == &useUltimate) {
3201	return; // used non-generic is already a specific of local generic
3202	}
3203	}
3204	cantCombine = true;
3205	}
3206	} else if (useGeneric) {
3207	if (localDerivedType) {
3208	} else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate() ||
3209	(localSymbol->attrs().test(Attr::INTRINSIC) &&
3210	localUltimate.name() == useUltimate.name())) {
3211	// Local is the specific of the used generic or an intrinsic with the
3212	// same name; replace it.
3213	EraseSymbol(*localSymbol);
3214	Symbol &newSymbol{MakeSymbol(localName,
3215	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
3216	UseDetails{localName, useUltimate})};
3217	newSymbol.flags() = useSymbol.flags();
3218	return;
3219	} else {
3220	for (const auto &ref : useGeneric->specificProcs()) {
3221	if (&ref->GetUltimate() == &localUltimate) {
3222	return; // local non-generic is already a specific of used generic
3223	}
3224	}
3225	cantCombine = true;
3226	}
3227	} else {
3228	cantCombine = true;
3229	}
3230
3231	// If symbols are not combinable, create a use error.
3232	if (cantCombine) {
3233	if (!ConvertToUseError(*localSymbol, location, *useModuleScope_)) {
3234	Say(location,
3235	"Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
3236	localName)
3237	.Attach(localSymbol->name(), "Previous declaration of '%s'"_en_US,
3238	localName);
3239	}
3240	return;
3241	}
3242
3243	// At this point, there must be at least one generic interface.
3244	CHECK(localGeneric || (useGeneric && (localDerivedType || localProcedure)));
3245
3246	if (localGeneric) {
3247	// Create a local copy of a previously use-associated generic so that
3248	// it can be locally extended without corrupting the original.
3249	if (localSymbol->has<UseDetails>()) {
3250	GenericDetails generic;
3251	generic.CopyFrom(DEREF(localGeneric));
3252	EraseSymbol(*localSymbol);
3253	Symbol &newSymbol{MakeSymbol(
3254	localSymbol->name(), localSymbol->attrs(), std::move(generic))};
3255	newSymbol.flags() = localSymbol->flags();
3256	localGeneric = &newSymbol.get<GenericDetails>();
3257	localGeneric->AddUse(*localSymbol);
3258	localSymbol = &newSymbol;
3259	}
3260	if (useGeneric) {
3261	// Combine two use-associated generics
3262	localSymbol->attrs() =
3263	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
3264	localSymbol->flags() = useSymbol.flags();
3265	AddGenericUse(*localGeneric, localName, useUltimate);
3266	localGeneric->clear_derivedType();
3267	localGeneric->CopyFrom(*useGeneric);
3268	}
3269	localGeneric->clear_derivedType();
3270	if (combinedDerivedType) {
3271	localGeneric->set_derivedType(*const_cast<Symbol *>(combinedDerivedType));
3272	}
3273	localGeneric->clear_specific();
3274	if (combinedProcedure) {
3275	localGeneric->set_specific(*const_cast<Symbol *>(combinedProcedure));
3276	}
3277	} else {
3278	CHECK(localSymbol->has<UseDetails>());
3279	// Create a local copy of the use-associated generic, then extend it
3280	// with the combined derived type &/or non-generic procedure.
3281	GenericDetails generic;
3282	generic.CopyFrom(*useGeneric);
3283	EraseSymbol(*localSymbol);
3284	Symbol &newSymbol{MakeSymbol(localName,
3285	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
3286	std::move(generic))};
3287	newSymbol.flags() = useUltimate.flags();
3288	auto &newUseGeneric{newSymbol.get<GenericDetails>()};
3289	AddGenericUse(newUseGeneric, localName, useUltimate);
3290	newUseGeneric.AddUse(*localSymbol);
3291	if (combinedDerivedType) {
3292	newUseGeneric.set_derivedType(*const_cast<Symbol *>(combinedDerivedType));
3293	}
3294	if (combinedProcedure) {
3295	newUseGeneric.set_specific(*const_cast<Symbol *>(combinedProcedure));
3296	}
3297	}
3298	}
3299
3300	void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
3301	if (useModuleScope_) {
3302	const auto &name{info.symbolName()};
3303	auto rename{AddUse(localName: name, useName: name, useSymbol: FindInScope(*useModuleScope_, name))};
3304	info.Resolve(rename.use);
3305	}
3306	}
3307
3308	// Create a UseDetails symbol for this USE and add it to generic
3309	Symbol &ModuleVisitor::AddGenericUse(
3310	GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {
3311	Symbol &newSymbol{
3312	currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})};
3313	generic.AddUse(newSymbol);
3314	return newSymbol;
3315	}
3316
3317	// Enforce F'2023 C1406 as a warning
3318	void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) {
3319	if (isIntrinsic) {
3320	if (auto iter{nonIntrinsicUses_.find(name)};
3321	iter != nonIntrinsicUses_.end()) {
3322	if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
3323	Say(name,
3324	"Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,
3325	name)
3326	.Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
3327	}
3328	}
3329	intrinsicUses_.insert(name);
3330	} else {
3331	if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) {
3332	if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
3333	Say(name,
3334	"Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,
3335	name)
3336	.Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
3337	}
3338	}
3339	nonIntrinsicUses_.insert(name);
3340	}
3341	}
3342
3343	bool ModuleVisitor::BeginSubmodule(
3344	const parser::Name &name, const parser::ParentIdentifier &parentId) {
3345	const auto &ancestorName{std::get<parser::Name>(parentId.t)};
3346	Scope *parentScope{nullptr};
3347	Scope *ancestor{FindModule(ancestorName, isIntrinsic: false /*not intrinsic*/)};
3348	if (ancestor) {
3349	if (const auto &parentName{
3350	std::get<std::optional<parser::Name>>(parentId.t)}) {
3351	parentScope = FindModule(*parentName, isIntrinsic: false /*not intrinsic*/, ancestor);
3352	} else {
3353	parentScope = ancestor;
3354	}
3355	}
3356	if (parentScope) {
3357	PushScope(*parentScope);
3358	} else {
3359	// Error recovery: there's no ancestor scope, so create a dummy one to
3360	// hold the submodule's scope.
3361	SourceName dummyName{context().GetTempName(currScope())};
3362	Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})};
3363	PushScope(Scope::Kind::Module, &dummySymbol);
3364	parentScope = &currScope();
3365	}
3366	BeginModule(name, isSubmodule: true);
3367	if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) {
3368	Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
3369	ancestorName.source, name.source);
3370	}
3371	return true;
3372	}
3373
3374	void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
3375	// Submodule symbols are not visible in their parents' scopes.
3376	Symbol &symbol{isSubmodule ? Resolve(name,
3377	currScope().MakeSymbol(name.source, Attrs{},
3378	ModuleDetails{true}))
3379	: MakeSymbol(name, ModuleDetails{false})};
3380	auto &details{symbol.get<ModuleDetails>()};
3381	PushScope(Scope::Kind::Module, &symbol);
3382	details.set_scope(&currScope());
3383	prevAccessStmt_ = std::nullopt;
3384	}
3385
3386	// Find a module or submodule by name and return its scope.
3387	// If ancestor is present, look for a submodule of that ancestor module.
3388	// May have to read a .mod file to find it.
3389	// If an error occurs, report it and return nullptr.
3390	Scope *ModuleVisitor::FindModule(const parser::Name &name,
3391	std::optional<bool> isIntrinsic, Scope *ancestor) {
3392	ModFileReader reader{context()};
3393	Scope *scope{
3394	reader.Read(name.source, isIntrinsic, ancestor, /*silent=*/false)};
3395	if (!scope) {
3396	return nullptr;
3397	}
3398	if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
3399	Say(name, "Module '%s' cannot USE itself"_err_en_US);
3400	}
3401	Resolve(name, scope->symbol());
3402	return scope;
3403	}
3404
3405	void ModuleVisitor::ApplyDefaultAccess() {
3406	const auto *moduleDetails{
3407	DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
3408	CHECK(moduleDetails);
3409	Attr defaultAttr{
3410	DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE : Attr::PUBLIC};
3411	for (auto &pair : currScope()) {
3412	Symbol &symbol{*pair.second};
3413	if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
3414	Attr attr{defaultAttr};
3415	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
3416	if (generic->derivedType()) {
3417	// If a generic interface has a derived type of the same
3418	// name that has an explicit accessibility attribute, then
3419	// the generic must have the same accessibility.
3420	if (generic->derivedType()->attrs().test(Attr::PUBLIC)) {
3421	attr = Attr::PUBLIC;
3422	} else if (generic->derivedType()->attrs().test(Attr::PRIVATE)) {
3423	attr = Attr::PRIVATE;
3424	}
3425	}
3426	}
3427	SetImplicitAttr(symbol, attr);
3428	}
3429	}
3430	}
3431
3432	// InterfaceVistor implementation
3433
3434	bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
3435	bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
3436	genericInfo_.emplace(/*isInterface*/ args: true, args&: isAbstract);
3437	return BeginAttrs();
3438	}
3439
3440	void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
3441
3442	void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
3443	ResolveNewSpecifics();
3444	genericInfo_.pop();
3445	}
3446
3447	// Create a symbol in genericSymbol_ for this GenericSpec.
3448	bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
3449	if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) {
3450	SetGenericSymbol(*symbol);
3451	}
3452	return false;
3453	}
3454
3455	bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
3456	if (!isGeneric()) {
3457	Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
3458	} else {
3459	auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
3460	const auto &names{std::get<std::list<parser::Name>>(x.t)};
3461	AddSpecificProcs(names, kind);
3462	}
3463	return false;
3464	}
3465
3466	bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
3467	genericInfo_.emplace(/*isInterface*/ args: false);
3468	return BeginAttrs();
3469	}
3470	void InterfaceVisitor::Post(const parser::GenericStmt &x) {
3471	auto attrs{EndAttrs()};
3472	if (Symbol * symbol{GetGenericInfo().symbol}) {
3473	SetExplicitAttrs(*symbol, attrs);
3474	}
3475	const auto &names{std::get<std::list<parser::Name>>(x.t)};
3476	AddSpecificProcs(names, ProcedureKind::Procedure);
3477	ResolveNewSpecifics();
3478	genericInfo_.pop();
3479	}
3480
3481	bool InterfaceVisitor::inInterfaceBlock() const {
3482	return !genericInfo_.empty() && GetGenericInfo().isInterface;
3483	}
3484	bool InterfaceVisitor::isGeneric() const {
3485	return !genericInfo_.empty() && GetGenericInfo().symbol;
3486	}
3487	bool InterfaceVisitor::isAbstract() const {
3488	return !genericInfo_.empty() && GetGenericInfo().isAbstract;
3489	}
3490
3491	void InterfaceVisitor::AddSpecificProcs(
3492	const std::list<parser::Name> &names, ProcedureKind kind) {
3493	if (Symbol * symbol{GetGenericInfo().symbol};
3494	symbol && symbol->has<GenericDetails>()) {
3495	for (const auto &name : names) {
3496	specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));
3497	genericsForSpecificProcs_.emplace(name.source, symbol);
3498	}
3499	}
3500	}
3501
3502	// By now we should have seen all specific procedures referenced by name in
3503	// this generic interface. Resolve those names to symbols.
3504	void GenericHandler::ResolveSpecificsInGeneric(
3505	Symbol &generic, bool isEndOfSpecificationPart) {
3506	auto &details{generic.get<GenericDetails>()};
3507	UnorderedSymbolSet symbolsSeen;
3508	for (const Symbol &symbol : details.specificProcs()) {
3509	symbolsSeen.insert(symbol.GetUltimate());
3510	}
3511	auto range{specificsForGenericProcs_.equal_range(&generic)};
3512	SpecificProcMapType retain;
3513	for (auto it{range.first}; it != range.second; ++it) {
3514	const parser::Name *name{it->second.first};
3515	auto kind{it->second.second};
3516	const Symbol *symbol{isEndOfSpecificationPart
3517	? FindSymbol(*name)
3518	: FindInScope(generic.owner(), *name)};
3519	ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None};
3520	const Symbol *specific{symbol};
3521	const Symbol *ultimate{nullptr};
3522	if (symbol) {
3523	// Subtlety: when *symbol is a use- or host-association, the specific
3524	// procedure that is recorded in the GenericDetails below must be *symbol,
3525	// not the specific procedure shadowed by a generic, because that specific
3526	// procedure may be a symbol from another module and its name unavailable
3527	// to emit to a module file.
3528	const Symbol &bypassed{BypassGeneric(*symbol)};
3529	if (symbol == &symbol->GetUltimate()) {
3530	specific = &bypassed;
3531	}
3532	ultimate = &bypassed.GetUltimate();
3533	defClass = ClassifyProcedure(*ultimate);
3534	}
3535	std::optional<MessageFixedText> error;
3536	if (defClass == ProcedureDefinitionClass::Module) {
3537	// ok
3538	} else if (kind == ProcedureKind::ModuleProcedure) {
3539	error = "'%s' is not a module procedure"_err_en_US;
3540	} else {
3541	switch (defClass) {
3542	case ProcedureDefinitionClass::Intrinsic:
3543	case ProcedureDefinitionClass::External:
3544	case ProcedureDefinitionClass::Internal:
3545	case ProcedureDefinitionClass::Dummy:
3546	case ProcedureDefinitionClass::Pointer:
3547	break;
3548	case ProcedureDefinitionClass::None:
3549	error = "'%s' is not a procedure"_err_en_US;
3550	break;
3551	default:
3552	error =
3553	"'%s' is not a procedure that can appear in a generic interface"_err_en_US;
3554	break;
3555	}
3556	}
3557	if (error) {
3558	if (isEndOfSpecificationPart) {
3559	Say(*name, std::move(*error));
3560	} else {
3561	// possible forward reference, catch it later
3562	retain.emplace(&generic, std::make_pair(name, kind));
3563	}
3564	} else if (!ultimate) {
3565	} else if (symbolsSeen.insert(*ultimate).second /*true if added*/) {
3566	// When a specific procedure is a USE association, that association
3567	// is saved in the generic's specifics, not its ultimate symbol,
3568	// so that module file output of interfaces can distinguish them.
3569	details.AddSpecificProc(*specific, name->source);
3570	} else if (specific == ultimate) {
3571	Say(name->source,
3572	"Procedure '%s' is already specified in generic '%s'"_err_en_US,
3573	name->source, MakeOpName(generic.name()));
3574	} else {
3575	Say(name->source,
3576	"Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
3577	ultimate->name(), ultimate->owner().GetName().value(),
3578	MakeOpName(generic.name()));
3579	}
3580	}
3581	specificsForGenericProcs_.erase(range.first, range.second);
3582	specificsForGenericProcs_.merge(std::move(retain));
3583	}
3584
3585	void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {
3586	auto range{genericsForSpecificProcs_.equal_range(proc.name())};
3587	for (auto iter{range.first}; iter != range.second; ++iter) {
3588	ResolveSpecificsInGeneric(generic&: *iter->second, isEndOfSpecificationPart: false);
3589	}
3590	}
3591
3592	void InterfaceVisitor::ResolveNewSpecifics() {
3593	if (Symbol * generic{genericInfo_.top().symbol};
3594	generic && generic->has<GenericDetails>()) {
3595	ResolveSpecificsInGeneric(*generic, false);
3596	}
3597	}
3598
3599	// Mixed interfaces are allowed by the standard.
3600	// If there is a derived type with the same name, they must all be functions.
3601	void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
3602	ResolveSpecificsInGeneric(generic, true);
3603	auto &details{generic.get<GenericDetails>()};
3604	if (auto *proc{details.CheckSpecific()}) {
3605	Say(proc->name().begin() > generic.name().begin() ? proc->name()
3606	: generic.name(),
3607	"'%s' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic"_warn_en_US);
3608	}
3609	auto &specifics{details.specificProcs()};
3610	if (specifics.empty()) {
3611	if (details.derivedType()) {
3612	generic.set(Symbol::Flag::Function);
3613	}
3614	return;
3615	}
3616	const Symbol &firstSpecific{specifics.front()};
3617	bool isFunction{firstSpecific.test(Symbol::Flag::Function)};
3618	bool isBoth{false};
3619	for (const Symbol &specific : specifics) {
3620	if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514
3621	auto &msg{Say(generic.name(),
3622	"Generic interface '%s' has both a function and a subroutine"_warn_en_US)};
3623	if (isFunction) {
3624	msg.Attach(firstSpecific.name(), "Function declaration"_en_US);
3625	msg.Attach(specific.name(), "Subroutine declaration"_en_US);
3626	} else {
3627	msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US);
3628	msg.Attach(specific.name(), "Function declaration"_en_US);
3629	}
3630	isFunction = false;
3631	isBoth = true;
3632	break;
3633	}
3634	}
3635	if (!isFunction && details.derivedType()) {
3636	SayDerivedType(generic.name(),
3637	"Generic interface '%s' may only contain functions due to derived type"
3638	" with same name"_err_en_US,
3639	*details.derivedType()->GetUltimate().scope());
3640	}
3641	if (!isBoth) {
3642	generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
3643	}
3644	}
3645
3646	// SubprogramVisitor implementation
3647
3648	// Return false if it is actually an assignment statement.
3649	bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
3650	const auto &name{std::get<parser::Name>(x.t)};
3651	const DeclTypeSpec *resultType{nullptr};
3652	// Look up name: provides return type or tells us if it's an array
3653	if (auto *symbol{FindSymbol(name)}) {
3654	Symbol &ultimate{symbol->GetUltimate()};
3655	if (ultimate.has<ObjectEntityDetails>() ||
3656	ultimate.has<AssocEntityDetails>() ||
3657	CouldBeDataPointerValuedFunction(&ultimate) ||
3658	(&symbol->owner() == &currScope() && IsFunctionResult(*symbol))) {
3659	misparsedStmtFuncFound_ = true;
3660	return false;
3661	}
3662	if (IsHostAssociated(*symbol, currScope())) {
3663	if (context().ShouldWarn(
3664	common::LanguageFeature::StatementFunctionExtensions)) {
3665	Say(name,
3666	"Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US);
3667	}
3668	MakeSymbol(name, Attrs{}, UnknownDetails{});
3669	} else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
3670	entity && !ultimate.has<ProcEntityDetails>()) {
3671	resultType = entity->type();
3672	ultimate.details() = UnknownDetails{}; // will be replaced below
3673	} else {
3674	misparsedStmtFuncFound_ = true;
3675	}
3676	}
3677	if (misparsedStmtFuncFound_) {
3678	Say(name,
3679	"'%s' has not been declared as an array or pointer-valued function"_err_en_US);
3680	return false;
3681	}
3682	auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
3683	symbol.set(Symbol::Flag::StmtFunction);
3684	EraseSymbol(symbol); // removes symbol added by PushSubprogramScope
3685	auto &details{symbol.get<SubprogramDetails>()};
3686	for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {
3687	ObjectEntityDetails dummyDetails{true};
3688	if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {
3689	if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) {
3690	if (d->type()) {
3691	dummyDetails.set_type(*d->type());
3692	}
3693	}
3694	}
3695	Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};
3696	ApplyImplicitRules(dummy);
3697	details.add_dummyArg(dummy);
3698	}
3699	ObjectEntityDetails resultDetails;
3700	if (resultType) {
3701	resultDetails.set_type(*resultType);
3702	}
3703	resultDetails.set_funcResult(true);
3704	Symbol &result{MakeSymbol(name, std::move(resultDetails))};
3705	result.flags().set(Symbol::Flag::StmtFunction);
3706	ApplyImplicitRules(result);
3707	details.set_result(result);
3708	// The analysis of the expression that constitutes the body of the
3709	// statement function is deferred to FinishSpecificationPart() so that
3710	// all declarations and implicit typing are complete.
3711	PopScope();
3712	return true;
3713	}
3714
3715	bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
3716	if (suffix.resultName) {
3717	if (IsFunction(currScope())) {
3718	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
3719	if (info->inFunctionStmt) {
3720	info->resultName = &suffix.resultName.value();
3721	} else {
3722	// will check the result name in Post(EntryStmt)
3723	}
3724	}
3725	} else {
3726	Message &msg{Say(*suffix.resultName,
3727	"RESULT(%s) may appear only in a function"_err_en_US)};
3728	if (const Symbol * subprogram{InclusiveScope().symbol()}) {
3729	msg.Attach(subprogram->name(), "Containing subprogram"_en_US);
3730	}
3731	}
3732	}
3733	// LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt,
3734	// all the way to EndSubprogram().
3735	return false;
3736	}
3737
3738	bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
3739	// Save this to process after UseStmt and ImplicitPart
3740	if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
3741	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
3742	if (info->parsedType) { // C1543
3743	Say(currStmtSource().value(),
3744	"FUNCTION prefix cannot specify the type more than once"_err_en_US);
3745	} else {
3746	info->parsedType = parsedType;
3747	info->source = currStmtSource();
3748	}
3749	} else {
3750	Say(currStmtSource().value(),
3751	"SUBROUTINE prefix cannot specify a type"_err_en_US);
3752	}
3753	return false;
3754	} else {
3755	return true;
3756	}
3757	}
3758
3759	bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
3760	if (auto *subp{currScope().symbol()
3761	? currScope().symbol()->detailsIf<SubprogramDetails>()
3762	: nullptr}) {
3763	for (auto attr : attrs.v) {
3764	if (auto current{subp->cudaSubprogramAttrs()}) {
3765	if (attr == *current ||
3766	(*current == common::CUDASubprogramAttrs::HostDevice &&
3767	(attr == common::CUDASubprogramAttrs::Host ||
3768	attr == common::CUDASubprogramAttrs::Device))) {
3769	Say(currStmtSource().value(),
3770	"ATTRIBUTES(%s) appears more than once"_warn_en_US,
3771	common::EnumToString(attr));
3772	} else if ((attr == common::CUDASubprogramAttrs::Host ||
3773	attr == common::CUDASubprogramAttrs::Device) &&
3774	(*current == common::CUDASubprogramAttrs::Host ||
3775	*current == common::CUDASubprogramAttrs::Device ||
3776	*current == common::CUDASubprogramAttrs::HostDevice)) {
3777	// HOST,DEVICE or DEVICE,HOST -> HostDevice
3778	subp->set_cudaSubprogramAttrs(
3779	common::CUDASubprogramAttrs::HostDevice);
3780	} else {
3781	Say(currStmtSource().value(),
3782	"ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,
3783	common::EnumToString(attr), common::EnumToString(*current));
3784	}
3785	} else {
3786	subp->set_cudaSubprogramAttrs(attr);
3787	}
3788	}
3789	}
3790	return false;
3791	}
3792
3793	void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {
3794	std::vector<std::int64_t> bounds;
3795	bool ok{true};
3796	for (const auto &sicx : x.v) {
3797	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
3798	bounds.push_back(*value);
3799	} else {
3800	ok = false;
3801	}
3802	}
3803	if (!ok || bounds.size() < 2 || bounds.size() > 3) {
3804	Say(currStmtSource().value(),
3805	"Operands of LAUNCH_BOUNDS() must be 2 or 3 integer constants"_err_en_US);
3806	} else if (auto *subp{currScope().symbol()
3807	? currScope().symbol()->detailsIf<SubprogramDetails>()
3808	: nullptr}) {
3809	if (subp->cudaLaunchBounds().empty()) {
3810	subp->set_cudaLaunchBounds(std::move(bounds));
3811	} else {
3812	Say(currStmtSource().value(),
3813	"LAUNCH_BOUNDS() may only appear once"_err_en_US);
3814	}
3815	}
3816	}
3817
3818	void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
3819	std::vector<std::int64_t> dims;
3820	bool ok{true};
3821	for (const auto &sicx : x.v) {
3822	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
3823	dims.push_back(*value);
3824	} else {
3825	ok = false;
3826	}
3827	}
3828	if (!ok || dims.size() != 3) {
3829	Say(currStmtSource().value(),
3830	"Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);
3831	} else if (auto *subp{currScope().symbol()
3832	? currScope().symbol()->detailsIf<SubprogramDetails>()
3833	: nullptr}) {
3834	if (subp->cudaClusterDims().empty()) {
3835	subp->set_cudaClusterDims(std::move(dims));
3836	} else {
3837	Say(currStmtSource().value(),
3838	"CLUSTER_DIMS() may only appear once"_err_en_US);
3839	}
3840	}
3841	}
3842
3843	static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {
3844	for (const auto &prefix : prefixes) {
3845	if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
3846	return true;
3847	}
3848	}
3849	return false;
3850	}
3851
3852	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
3853	const auto &stmtTuple{
3854	std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};
3855	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
3856	Symbol::Flag::Subroutine,
3857	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
3858	}
3859	void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
3860	const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
3861	EndSubprogram(stmt.source,
3862	&std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t));
3863	}
3864	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
3865	const auto &stmtTuple{
3866	std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};
3867	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
3868	Symbol::Flag::Function,
3869	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
3870	}
3871	void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
3872	const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
3873	const auto &maybeSuffix{
3874	std::get<std::optional<parser::Suffix>>(stmt.statement.t)};
3875	EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr);
3876	}
3877
3878	bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
3879	BeginAttrs();
3880	Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t));
3881	Walk(std::get<parser::Name>(stmt.t));
3882	Walk(std::get<std::list<parser::DummyArg>>(stmt.t));
3883	// Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram.
3884	Symbol &symbol{PostSubprogramStmt()};
3885	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
3886	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
3887	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
3888	CreateDummyArgument(details, *dummyName);
3889	} else {
3890	details.add_alternateReturn();
3891	}
3892	}
3893	return false;
3894	}
3895	bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
3896	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
3897	CHECK(!info.inFunctionStmt);
3898	info.inFunctionStmt = true;
3899	return BeginAttrs();
3900	}
3901	bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
3902
3903	void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
3904	const auto &name{std::get<parser::Name>(stmt.t)};
3905	Symbol &symbol{PostSubprogramStmt()};
3906	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
3907	for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
3908	CreateDummyArgument(details, dummyName);
3909	}
3910	const parser::Name *funcResultName;
3911	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
3912	CHECK(info.inFunctionStmt);
3913	info.inFunctionStmt = false;
3914	bool distinctResultName{
3915	info.resultName && info.resultName->source != name.source};
3916	if (distinctResultName) {
3917	// Note that RESULT is ignored if it has the same name as the function.
3918	// The symbol created by PushScope() is retained as a place-holder
3919	// for error detection.
3920	funcResultName = info.resultName;
3921	} else {
3922	EraseSymbol(name); // was added by PushScope()
3923	funcResultName = &name;
3924	}
3925	if (details.isFunction()) {
3926	CHECK(context().HasError(currScope().symbol()));
3927	} else {
3928	// RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY
3929	// statement.
3930	Symbol *result{nullptr};
3931	if (distinctResultName) {
3932	if (auto iter{currScope().find(funcResultName->source)};
3933	iter != currScope().end()) {
3934	Symbol &entryResult{*iter->second};
3935	if (IsFunctionResult(entryResult)) {
3936	result = &entryResult;
3937	}
3938	}
3939	}
3940	if (result) {
3941	Resolve(*funcResultName, *result);
3942	} else {
3943	// add function result to function scope
3944	EntityDetails funcResultDetails;
3945	funcResultDetails.set_funcResult(true);
3946	result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
3947	}
3948	info.resultSymbol = result;
3949	details.set_result(*result);
3950	}
3951	// C1560.
3952	if (info.resultName && !distinctResultName) {
3953	Say(info.resultName->source,
3954	"The function name should not appear in RESULT; references to '%s' "
3955	"inside the function will be considered as references to the "
3956	"result only"_warn_en_US,
3957	name.source);
3958	// RESULT name was ignored above, the only side effect from doing so will be
3959	// the inability to make recursive calls. The related parser::Name is still
3960	// resolved to the created function result symbol because every parser::Name
3961	// should be resolved to avoid internal errors.
3962	Resolve(*info.resultName, info.resultSymbol);
3963	}
3964	name.symbol = &symbol; // must not be function result symbol
3965	// Clear the RESULT() name now in case an ENTRY statement in the implicit-part
3966	// has a RESULT() suffix.
3967	info.resultName = nullptr;
3968	}
3969
3970	Symbol &SubprogramVisitor::PostSubprogramStmt() {
3971	Symbol &symbol{*currScope().symbol()};
3972	SetExplicitAttrs(symbol, EndAttrs());
3973	if (symbol.attrs().test(Attr::MODULE)) {
3974	symbol.attrs().set(Attr::EXTERNAL, false);
3975	symbol.implicitAttrs().set(Attr::EXTERNAL, false);
3976	}
3977	return symbol;
3978	}
3979
3980	void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
3981	if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) {
3982	Walk(suffix->binding);
3983	}
3984	PostEntryStmt(stmt);
3985	EndAttrs();
3986	}
3987
3988	void SubprogramVisitor::CreateDummyArgument(
3989	SubprogramDetails &details, const parser::Name &name) {
3990	Symbol *dummy{FindInScope(name)};
3991	if (dummy) {
3992	if (IsDummy(*dummy)) {
3993	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
3994	dummy->set(Symbol::Flag::EntryDummyArgument, false);
3995	} else {
3996	Say(name,
3997	"'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US,
3998	name.source);
3999	return;
4000	}
4001	} else {
4002	SayWithDecl(name, *dummy,
4003	"'%s' may not appear as a dummy argument name in this subprogram"_err_en_US);
4004	return;
4005	}
4006	} else {
4007	dummy = &MakeSymbol(name, EntityDetails{true});
4008	}
4009	details.add_dummyArg(DEREF(dummy));
4010	}
4011
4012	void SubprogramVisitor::CreateEntry(
4013	const parser::EntryStmt &stmt, Symbol &subprogram) {
4014	const auto &entryName{std::get<parser::Name>(stmt.t)};
4015	Scope &outer{currScope().parent()};
4016	Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)
4017	? Symbol::Flag::Function
4018	: Symbol::Flag::Subroutine};
4019	Attrs attrs;
4020	const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
4021	bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding &&
4022	suffix->binding->v.has_value()};
4023	if (!hasGlobalBindingName) {
4024	if (Symbol * extant{FindSymbol(outer, entryName)}) {
4025	if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
4026	if (outer.IsTopLevel()) {
4027	Say2(entryName,
4028	"'%s' is already defined as a global identifier"_err_en_US,
4029	*extant, "Previous definition of '%s'"_en_US);
4030	} else {
4031	SayAlreadyDeclared(entryName, *extant);
4032	}
4033	return;
4034	}
4035	attrs = extant->attrs();
4036	}
4037	}
4038	bool badResultName{false};
4039	std::optional<SourceName> distinctResultName;
4040	if (suffix && suffix->resultName &&
4041	suffix->resultName->source != entryName.source) {
4042	distinctResultName = suffix->resultName->source;
4043	const parser::Name &resultName{*suffix->resultName};
4044	if (resultName.source == subprogram.name()) { // C1574
4045	Say2(resultName.source,
4046	"RESULT(%s) may not have the same name as the function"_err_en_US,
4047	subprogram, "Containing function"_en_US);
4048	badResultName = true;
4049	} else if (const Symbol * extant{FindSymbol(outer, resultName)}) { // C1574
4050	if (const auto *details{extant->detailsIf<SubprogramDetails>()}) {
4051	if (details->entryScope() == &currScope()) {
4052	Say2(resultName.source,
4053	"RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US,
4054	extant->name(), "Conflicting ENTRY"_en_US);
4055	badResultName = true;
4056	}
4057	}
4058	}
4059	}
4060	if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
4061	attrs.set(Attr::PUBLIC);
4062	}
4063	Symbol *entrySymbol{nullptr};
4064	if (hasGlobalBindingName) {
4065	// Hide the entry's symbol in a new anonymous global scope so
4066	// that its name doesn't clash with anything.
4067	Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})};
4068	symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
4069	Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)};
4070	entrySymbol = &MakeSymbol(hidden, entryName.source, attrs);
4071	} else {
4072	entrySymbol = FindInScope(outer, entryName.source);
4073	if (entrySymbol) {
4074	if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {
4075	if (auto *specific{generic->specific()}) {
4076	// Forward reference to ENTRY from a generic interface
4077	entrySymbol = specific;
4078	CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs);
4079	SetExplicitAttrs(*entrySymbol, attrs);
4080	}
4081	}
4082	} else {
4083	entrySymbol = &MakeSymbol(outer, entryName.source, attrs);
4084	}
4085	}
4086	SubprogramDetails entryDetails;
4087	entryDetails.set_entryScope(currScope());
4088	entrySymbol->set(subpFlag);
4089	if (subpFlag == Symbol::Flag::Function) {
4090	Symbol *result{nullptr};
4091	EntityDetails resultDetails;
4092	resultDetails.set_funcResult(true);
4093	if (distinctResultName) {
4094	if (!badResultName) {
4095	// RESULT(x) can be the same explicitly-named RESULT(x) as
4096	// the enclosing function or another ENTRY.
4097	if (auto iter{currScope().find(suffix->resultName->source)};
4098	iter != currScope().end()) {
4099	result = &*iter->second;
4100	}
4101	if (!result) {
4102	result = &MakeSymbol(
4103	*distinctResultName, Attrs{}, std::move(resultDetails));
4104	}
4105	Resolve(*suffix->resultName, *result);
4106	}
4107	} else {
4108	result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));
4109	}
4110	if (result) {
4111	entryDetails.set_result(*result);
4112	}
4113	}
4114	if (subpFlag == Symbol::Flag::Subroutine ||
4115	(distinctResultName && !badResultName)) {
4116	Symbol &assoc{MakeSymbol(entryName.source)};
4117	assoc.set_details(HostAssocDetails{*entrySymbol});
4118	assoc.set(Symbol::Flag::Subroutine);
4119	}
4120	Resolve(entryName, *entrySymbol);
4121	std::set<SourceName> dummies;
4122	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4123	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4124	auto pair{dummies.insert(dummyName->source)};
4125	if (!pair.second) {
4126	Say(*dummyName,
4127	"'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US,
4128	dummyName->source);
4129	continue;
4130	}
4131	Symbol *dummy{FindInScope(*dummyName)};
4132	if (dummy) {
4133	if (!IsDummy(*dummy)) {
4134	evaluate::AttachDeclaration(
4135	Say(*dummyName,
4136	"'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US,
4137	dummyName->source),
4138	*dummy);
4139	continue;
4140	}
4141	} else {
4142	dummy = &MakeSymbol(*dummyName, EntityDetails{true});
4143	dummy->set(Symbol::Flag::EntryDummyArgument);
4144	}
4145	entryDetails.add_dummyArg(DEREF(dummy));
4146	} else if (subpFlag == Symbol::Flag::Function) { // C1573
4147	Say(entryName,
4148	"ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
4149	break;
4150	} else {
4151	entryDetails.add_alternateReturn();
4152	}
4153	}
4154	entrySymbol->set_details(std::move(entryDetails));
4155	}
4156
4157	void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
4158	// The entry symbol should have already been created and resolved
4159	// in CreateEntry(), called by BeginSubprogram(), with one exception (below).
4160	const auto &name{std::get<parser::Name>(stmt.t)};
4161	Scope &inclusiveScope{InclusiveScope()};
4162	if (!name.symbol) {
4163	if (inclusiveScope.kind() != Scope::Kind::Subprogram) {
4164	Say(name.source,
4165	"ENTRY '%s' may appear only in a subroutine or function"_err_en_US,
4166	name.source);
4167	} else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {
4168	Say(name.source,
4169	"ENTRY '%s' may not appear in a separate module procedure"_err_en_US,
4170	name.source);
4171	} else {
4172	// C1571 - entry is nested, so was not put into the program tree; error
4173	// is emitted from MiscChecker in semantics.cpp.
4174	}
4175	return;
4176	}
4177	Symbol &entrySymbol{*name.symbol};
4178	if (context().HasError(entrySymbol)) {
4179	return;
4180	}
4181	if (!entrySymbol.has<SubprogramDetails>()) {
4182	SayAlreadyDeclared(name, entrySymbol);
4183	return;
4184	}
4185	SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
4186	CHECK(entryDetails.entryScope() == &inclusiveScope);
4187	SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());
4188	entrySymbol.attrs() |= GetAttrs();
4189	SetBindNameOn(entrySymbol);
4190	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4191	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4192	if (Symbol * dummy{FindInScope(*dummyName)}) {
4193	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
4194	const auto *subp{dummy->detailsIf<SubprogramDetails>()};
4195	if (subp && subp->isInterface()) { // ok
4196	} else if (!dummy->has<EntityDetails>() &&
4197	!dummy->has<ObjectEntityDetails>() &&
4198	!dummy->has<ProcEntityDetails>()) {
4199	SayWithDecl(*dummyName, *dummy,
4200	"ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US);
4201	}
4202	dummy->set(Symbol::Flag::EntryDummyArgument, false);
4203	}
4204	}
4205	}
4206	}
4207	}
4208
4209	Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
4210	const parser::Name &name) {
4211	auto *symbol{FindSymbol(name)};
4212	if (symbol && symbol->has<SubprogramNameDetails>()) {
4213	const Scope *parent{nullptr};
4214	if (currScope().IsSubmodule()) {
4215	parent = currScope().symbol()->get<ModuleDetails>().parent();
4216	}
4217	symbol = parent ? FindSymbol(scope: *parent, name) : nullptr;
4218	}
4219	if (symbol) {
4220	if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
4221	symbol = generic->specific();
4222	}
4223	}
4224	if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
4225	// Error recovery in case of multiple definitions
4226	symbol = const_cast<Symbol *>(defnIface);
4227	}
4228	if (!IsSeparateModuleProcedureInterface(symbol)) {
4229	Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
4230	symbol = nullptr;
4231	}
4232	return symbol;
4233	}
4234
4235	// A subprogram declared with MODULE PROCEDURE
4236	bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
4237	Symbol *symbol{FindSeparateModuleProcedureInterface(name)};
4238	if (!symbol) {
4239	return false;
4240	}
4241	if (symbol->owner() == currScope() && symbol->scope()) {
4242	// This is a MODULE PROCEDURE whose interface appears in its host.
4243	// Convert the module procedure's interface into a subprogram.
4244	SetScope(DEREF(symbol->scope()));
4245	symbol->get<SubprogramDetails>().set_isInterface(false);
4246	name.symbol = symbol;
4247	} else {
4248	// Copy the interface into a new subprogram scope.
4249	EraseSymbol(name);
4250	Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
4251	PushScope(Scope::Kind::Subprogram, &newSymbol);
4252	auto &newSubprogram{newSymbol.get<SubprogramDetails>()};
4253	newSubprogram.set_moduleInterface(*symbol);
4254	auto &subprogram{symbol->get<SubprogramDetails>()};
4255	if (const auto *name{subprogram.bindName()}) {
4256	newSubprogram.set_bindName(std::string{*name});
4257	}
4258	newSymbol.attrs() |= symbol->attrs();
4259	newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
4260	? Symbol::Flag::Subroutine
4261	: Symbol::Flag::Function);
4262	MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());
4263	}
4264	return true;
4265	}
4266
4267	// A subprogram or interface declared with SUBROUTINE or FUNCTION
4268	bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
4269	Symbol::Flag subpFlag, bool hasModulePrefix,
4270	const parser::LanguageBindingSpec *bindingSpec,
4271	const ProgramTree::EntryStmtList *entryStmts) {
4272	if (hasModulePrefix && !currScope().IsModule() &&
4273	!currScope().IsSubmodule()) { // C1547
4274	Say(name,
4275	"'%s' is a MODULE procedure which must be declared within a "
4276	"MODULE or SUBMODULE"_err_en_US);
4277	return false;
4278	}
4279	Symbol *moduleInterface{nullptr};
4280	if (hasModulePrefix && !inInterfaceBlock()) {
4281	moduleInterface = FindSeparateModuleProcedureInterface(name);
4282	if (moduleInterface && &moduleInterface->owner() == &currScope()) {
4283	// Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
4284	// previously defined in the same scope.
4285	if (GenericDetails *
4286	generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {
4287	generic->clear_specific();
4288	name.symbol = nullptr;
4289	} else {
4290	EraseSymbol(name);
4291	}
4292	}
4293	}
4294	Symbol &newSymbol{
4295	PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};
4296	if (moduleInterface) {
4297	newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
4298	if (moduleInterface->attrs().test(Attr::PRIVATE)) {
4299	SetImplicitAttr(newSymbol, Attr::PRIVATE);
4300	} else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
4301	SetImplicitAttr(newSymbol, Attr::PUBLIC);
4302	}
4303	}
4304	if (entryStmts) {
4305	for (const auto &ref : *entryStmts) {
4306	CreateEntry(*ref, newSymbol);
4307	}
4308	}
4309	return true;
4310	}
4311
4312	void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol,
4313	std::optional<parser::CharBlock> stmtSource,
4314	const std::optional<parser::LanguageBindingSpec> *binding) {
4315	if (binding && *binding && symbol) {
4316	// Finally process the BIND(C,NAME=name) now that symbols in the name
4317	// expression will resolve to local names if needed.
4318	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
4319	auto originalStmtSource{messageHandler().currStmtSource()};
4320	messageHandler().set_currStmtSource(stmtSource);
4321	BeginAttrs();
4322	Walk(**binding);
4323	SetBindNameOn(*symbol);
4324	symbol->attrs() |= EndAttrs();
4325	messageHandler().set_currStmtSource(originalStmtSource);
4326	}
4327	}
4328
4329	void SubprogramVisitor::EndSubprogram(
4330	std::optional<parser::CharBlock> stmtSource,
4331	const std::optional<parser::LanguageBindingSpec> *binding,
4332	const ProgramTree::EntryStmtList *entryStmts) {
4333	HandleLanguageBinding(currScope().symbol(), stmtSource, binding);
4334	if (entryStmts) {
4335	for (const auto &ref : *entryStmts) {
4336	const parser::EntryStmt &entryStmt{*ref};
4337	if (const auto &suffix{
4338	std::get<std::optional<parser::Suffix>>(entryStmt.t)}) {
4339	const auto &name{std::get<parser::Name>(entryStmt.t)};
4340	HandleLanguageBinding(name.symbol, name.source, &suffix->binding);
4341	}
4342	}
4343	}
4344	if (inInterfaceBlock() && currScope().symbol()) {
4345	DeclaredPossibleSpecificProc(proc&: *currScope().symbol());
4346	}
4347	PopScope();
4348	}
4349
4350	bool SubprogramVisitor::HandlePreviousCalls(
4351	const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
4352	// If the extant symbol is a generic, check its homonymous specific
4353	// procedure instead if it has one.
4354	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
4355	return generic->specific() &&
4356	HandlePreviousCalls(name, *generic->specific(), subpFlag);
4357	} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
4358	!proc->isDummy() &&
4359	!symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
4360	// There's a symbol created for previous calls to this subprogram or
4361	// ENTRY's name. We have to replace that symbol in situ to avoid the
4362	// obligation to rewrite symbol pointers in the parse tree.
4363	if (!symbol.test(subpFlag)) {
4364	auto other{subpFlag == Symbol::Flag::Subroutine
4365	? Symbol::Flag::Function
4366	: Symbol::Flag::Subroutine};
4367	// External statements issue an explicit EXTERNAL attribute.
4368	if (symbol.attrs().test(Attr::EXTERNAL) &&
4369	!symbol.implicitAttrs().test(Attr::EXTERNAL)) {
4370	// Warn if external statement previously declared.
4371	Say(name,
4372	"EXTERNAL attribute was already specified on '%s'"_warn_en_US);
4373	} else if (symbol.test(other)) {
4374	Say2(name,
4375	subpFlag == Symbol::Flag::Function
4376	? "'%s' was previously called as a subroutine"_err_en_US
4377	: "'%s' was previously called as a function"_err_en_US,
4378	symbol, "Previous call of '%s'"_en_US);
4379	} else {
4380	symbol.set(subpFlag);
4381	}
4382	}
4383	EntityDetails entity;
4384	if (proc->type()) {
4385	entity.set_type(*proc->type());
4386	}
4387	symbol.details() = std::move(entity);
4388	return true;
4389	} else {
4390	return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();
4391	}
4392	}
4393
4394	void SubprogramVisitor::CheckExtantProc(
4395	const parser::Name &name, Symbol::Flag subpFlag) {
4396	if (auto *prev{FindSymbol(name)}) {
4397	if (IsDummy(*prev)) {
4398	} else if (auto *entity{prev->detailsIf<EntityDetails>()};
4399	IsPointer(*prev) && entity && !entity->type()) {
4400	// POINTER attribute set before interface
4401	} else if (inInterfaceBlock() && currScope() != prev->owner()) {
4402	// Procedures in an INTERFACE block do not resolve to symbols
4403	// in scopes between the global scope and the current scope.
4404	} else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
4405	SayAlreadyDeclared(name, *prev);
4406	}
4407	}
4408	}
4409
4410	Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
4411	Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
4412	bool hasModulePrefix) {
4413	Symbol *symbol{GetSpecificFromGeneric(name)};
4414	if (!symbol) {
4415	if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
4416	// Create this new top-level subprogram with a binding label
4417	// in a new global scope, so that its symbol's name won't clash
4418	// with another symbol that has a distinct binding label.
4419	PushScope(Scope::Kind::Global,
4420	&MakeSymbol(context().GetTempName(currScope()), Attrs{},
4421	MiscDetails{MiscDetails::Kind::ScopeName}));
4422	}
4423	CheckExtantProc(name, subpFlag);
4424	symbol = &MakeSymbol(name, SubprogramDetails{});
4425	}
4426	symbol->ReplaceName(name.source);
4427	symbol->set(subpFlag);
4428	PushScope(Scope::Kind::Subprogram, symbol);
4429	if (subpFlag == Symbol::Flag::Function) {
4430	funcResultStack().Push(currScope());
4431	}
4432	if (inInterfaceBlock()) {
4433	auto &details{symbol->get<SubprogramDetails>()};
4434	details.set_isInterface();
4435	if (isAbstract()) {
4436	SetExplicitAttr(*symbol, Attr::ABSTRACT);
4437	} else if (hasModulePrefix) {
4438	SetExplicitAttr(*symbol, Attr::MODULE);
4439	} else {
4440	MakeExternal(*symbol);
4441	}
4442	if (isGeneric()) {
4443	Symbol &genericSymbol{GetGenericSymbol()};
4444	if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {
4445	details->AddSpecificProc(*symbol, name.source);
4446	} else {
4447	CHECK(context().HasError(genericSymbol));
4448	}
4449	}
4450	set_inheritFromParent(hasModulePrefix);
4451	}
4452	if (Symbol * found{FindSymbol(name)};
4453	found && found->has<HostAssocDetails>()) {
4454	found->set(subpFlag); // PushScope() created symbol
4455	}
4456	return *symbol;
4457	}
4458
4459	void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
4460	if (auto *prev{FindSymbol(name)}) {
4461	if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
4462	if (prev->test(Symbol::Flag::Subroutine) ||
4463	prev->test(Symbol::Flag::Function)) {
4464	Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,
4465	"Previous call of '%s'"_en_US);
4466	}
4467	EraseSymbol(name);
4468	}
4469	}
4470	if (name.source.empty()) {
4471	// Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM
4472	PushScope(Scope::Kind::BlockData, nullptr);
4473	} else {
4474	PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
4475	}
4476	}
4477
4478	// If name is a generic, return specific subprogram with the same name.
4479	Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
4480	// Search for the name but don't resolve it
4481	if (auto *symbol{currScope().FindSymbol(name.source)}) {
4482	if (symbol->has<SubprogramNameDetails>()) {
4483	if (inInterfaceBlock()) {
4484	// Subtle: clear any MODULE flag so that the new interface
4485	// symbol doesn't inherit it and ruin the ability to check it.
4486	symbol->attrs().reset(Attr::MODULE);
4487	}
4488	} else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
4489	// found generic, want specific procedure
4490	auto *specific{details->specific()};
4491	Attrs moduleAttr;
4492	if (inInterfaceBlock()) {
4493	if (specific) {
4494	// Defining an interface in a generic of the same name which is
4495	// already shadowing another procedure. In some cases, the shadowed
4496	// procedure is about to be replaced.
4497	if (specific->has<SubprogramNameDetails>() &&
4498	specific->attrs().test(Attr::MODULE)) {
4499	// The shadowed procedure is a separate module procedure that is
4500	// actually defined later in this (sub)module.
4501	// Define its interface now as a new symbol.
4502	moduleAttr.set(Attr::MODULE);
4503	specific = nullptr;
4504	} else if (&specific->owner() != &symbol->owner()) {
4505	// The shadowed procedure was from an enclosing scope and will be
4506	// overridden by this interface definition.
4507	specific = nullptr;
4508	}
4509	if (!specific) {
4510	details->clear_specific();
4511	}
4512	} else if (const auto *dType{details->derivedType()}) {
4513	if (&dType->owner() != &symbol->owner()) {
4514	// The shadowed derived type was from an enclosing scope and
4515	// will be overridden by this interface definition.
4516	details->clear_derivedType();
4517	}
4518	}
4519	}
4520	if (!specific) {
4521	specific = &currScope().MakeSymbol(
4522	name.source, std::move(moduleAttr), SubprogramDetails{});
4523	if (details->derivedType()) {
4524	// A specific procedure with the same name as a derived type
4525	SayAlreadyDeclared(name, *details->derivedType());
4526	} else {
4527	details->set_specific(Resolve(name, *specific));
4528	}
4529	} else if (isGeneric()) {
4530	SayAlreadyDeclared(name, *specific);
4531	}
4532	if (specific->has<SubprogramNameDetails>()) {
4533	specific->set_details(Details{SubprogramDetails{}});
4534	}
4535	return specific;
4536	}
4537	}
4538	return nullptr;
4539	}
4540
4541	// DeclarationVisitor implementation
4542
4543	bool DeclarationVisitor::BeginDecl() {
4544	BeginDeclTypeSpec();
4545	BeginArraySpec();
4546	return BeginAttrs();
4547	}
4548	void DeclarationVisitor::EndDecl() {
4549	EndDeclTypeSpec();
4550	EndArraySpec();
4551	EndAttrs();
4552	}
4553
4554	bool DeclarationVisitor::CheckUseError(const parser::Name &name) {
4555	return HadUseError(context(), name.source, name.symbol);
4556	}
4557
4558	// Report error if accessibility of symbol doesn't match isPrivate.
4559	void DeclarationVisitor::CheckAccessibility(
4560	const SourceName &name, bool isPrivate, Symbol &symbol) {
4561	if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
4562	Say2(name,
4563	"'%s' does not have the same accessibility as its previous declaration"_err_en_US,
4564	symbol, "Previous declaration of '%s'"_en_US);
4565	}
4566	}
4567
4568	bool DeclarationVisitor::Pre(const parser::TypeDeclarationStmt &x) {
4569	BeginDecl();
4570	// If INTRINSIC appears as an attr-spec, handle it now as if the
4571	// names had appeared on an INTRINSIC attribute statement beforehand.
4572	for (const auto &attr : std::get<std::list<parser::AttrSpec>>(x.t)) {
4573	if (std::holds_alternative<parser::Intrinsic>(attr.u)) {
4574	for (const auto &decl : std::get<std::list<parser::EntityDecl>>(x.t)) {
4575	DeclareIntrinsic(parser::GetFirstName(decl));
4576	}
4577	break;
4578	}
4579	}
4580	return true;
4581	}
4582	void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
4583	EndDecl();
4584	}
4585
4586	void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
4587	DeclareObjectEntity(std::get<parser::Name>(x.t));
4588	}
4589	void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
4590	DeclareObjectEntity(std::get<parser::Name>(x.t));
4591	}
4592
4593	bool DeclarationVisitor::Pre(const parser::Initialization &) {
4594	// Defer inspection of initializers to Initialization() so that the
4595	// symbol being initialized will be available within the initialization
4596	// expression.
4597	return false;
4598	}
4599
4600	void DeclarationVisitor::Post(const parser::EntityDecl &x) {
4601	const auto &name{std::get<parser::ObjectName>(x.t)};
4602	Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
4603	attrs.set(Attr::INTRINSIC, false); // dealt with in Pre(TypeDeclarationStmt)
4604	Symbol &symbol{DeclareUnknownEntity(name, attrs)};
4605	symbol.ReplaceName(name.source);
4606	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
4607	if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
4608	ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
4609	symbol.set(
4610	Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
4611	Initialization(name, *init, false);
4612	} else if (attrs.test(Attr::PARAMETER)) { // C882, C883
4613	Say(name, "Missing initialization for parameter '%s'"_err_en_US);
4614	}
4615	if (auto *scopeSymbol{currScope().symbol()})
4616	if (auto *details{scopeSymbol->detailsIf<DerivedTypeDetails>()})
4617	if (details->isDECStructure())
4618	details->add_component(symbol);
4619	}
4620
4621	void DeclarationVisitor::Post(const parser::PointerDecl &x) {
4622	const auto &name{std::get<parser::Name>(x.t)};
4623	if (const auto &deferredShapeSpecs{
4624	std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
4625	CHECK(arraySpec().empty());
4626	BeginArraySpec();
4627	set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
4628	Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
4629	symbol.ReplaceName(name.source);
4630	EndArraySpec();
4631	} else {
4632	if (const auto *symbol{FindInScope(name)}) {
4633	const auto *subp{symbol->detailsIf<SubprogramDetails>()};
4634	if (!symbol->has<UseDetails>() && // error caught elsewhere
4635	!symbol->has<ObjectEntityDetails>() &&
4636	!symbol->has<ProcEntityDetails>() &&
4637	!symbol->CanReplaceDetails(ObjectEntityDetails{}) &&
4638	!symbol->CanReplaceDetails(ProcEntityDetails{}) &&
4639	!(subp && subp->isInterface())) {
4640	Say(name, "'%s' cannot have the POINTER attribute"_err_en_US);
4641	}
4642	}
4643	HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t));
4644	}
4645	}
4646
4647	bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
4648	auto kind{std::get<parser::BindEntity::Kind>(x.t)};
4649	auto &name{std::get<parser::Name>(x.t)};
4650	Symbol *symbol;
4651	if (kind == parser::BindEntity::Kind::Object) {
4652	symbol = &HandleAttributeStmt(Attr::BIND_C, name);
4653	} else {
4654	symbol = &MakeCommonBlockSymbol(name);
4655	SetExplicitAttr(*symbol, Attr::BIND_C);
4656	}
4657	// 8.6.4(1)
4658	// Some entities such as named constant or module name need to checked
4659	// elsewhere. This is to skip the ICE caused by setting Bind name for non-name
4660	// things such as data type and also checks for procedures.
4661	if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() ||
4662	symbol->has<EntityDetails>()) {
4663	SetBindNameOn(*symbol);
4664	} else {
4665	Say(name,
4666	"Only variable and named common block can be in BIND statement"_err_en_US);
4667	}
4668	return false;
4669	}
4670	bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) {
4671	inOldStyleParameterStmt_ = true;
4672	Walk(x.v);
4673	inOldStyleParameterStmt_ = false;
4674	return false;
4675	}
4676	bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
4677	auto &name{std::get<parser::NamedConstant>(x.t).v};
4678	auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
4679	ConvertToObjectEntity(symbol&: symbol);
4680	auto *details{symbol.detailsIf<ObjectEntityDetails>()};
4681	if (!details || symbol.test(Symbol::Flag::CrayPointer) ||
4682	symbol.test(Symbol::Flag::CrayPointee)) {
4683	SayWithDecl(
4684	name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);
4685	return false;
4686	}
4687	const auto &expr{std::get<parser::ConstantExpr>(x.t)};
4688	if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
4689	Say(name, "Named constant '%s' already has a value"_err_en_US);
4690	}
4691	if (inOldStyleParameterStmt_) {
4692	// non-standard extension PARAMETER statement (no parentheses)
4693	Walk(expr);
4694	auto folded{EvaluateExpr(expr)};
4695	if (details->type()) {
4696	SayWithDecl(name, symbol,
4697	"Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US);
4698	} else if (folded) {
4699	auto at{expr.thing.value().source};
4700	if (evaluate::IsActuallyConstant(*folded)) {
4701	if (const auto *type{currScope().GetType(*folded)}) {
4702	if (type->IsPolymorphic()) {
4703	Say(at, "The expression must not be polymorphic"_err_en_US);
4704	} else if (auto shape{ToArraySpec(
4705	GetFoldingContext(), evaluate::GetShape(*folded))}) {
4706	// The type of the named constant is assumed from the expression.
4707	details->set_type(*type);
4708	details->set_init(std::move(*folded));
4709	details->set_shape(std::move(*shape));
4710	} else {
4711	Say(at, "The expression must have constant shape"_err_en_US);
4712	}
4713	} else {
4714	Say(at, "The expression must have a known type"_err_en_US);
4715	}
4716	} else {
4717	Say(at, "The expression must be a constant of known type"_err_en_US);
4718	}
4719	}
4720	} else {
4721	// standard-conforming PARAMETER statement (with parentheses)
4722	ApplyImplicitRules(symbol&: symbol);
4723	Walk(expr);
4724	if (auto converted{EvaluateNonPointerInitializer(
4725	symbol, expr, expr.thing.value().source)}) {
4726	details->set_init(std::move(*converted));
4727	}
4728	}
4729	return false;
4730	}
4731	bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
4732	const parser::Name &name{x.v};
4733	if (!FindSymbol(name)) {
4734	Say(name, "Named constant '%s' not found"_err_en_US);
4735	} else {
4736	CheckUseError(name);
4737	}
4738	return false;
4739	}
4740
4741	bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
4742	const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
4743	Symbol *symbol{FindInScope(name)};
4744	if (symbol && !symbol->has<UnknownDetails>()) {
4745	// Contrary to named constants appearing in a PARAMETER statement,
4746	// enumerator names should not have their type, dimension or any other
4747	// attributes defined before they are declared in the enumerator statement,
4748	// with the exception of accessibility.
4749	// This is not explicitly forbidden by the standard, but they are scalars
4750	// which type is left for the compiler to chose, so do not let users try to
4751	// tamper with that.
4752	SayAlreadyDeclared(name, *symbol);
4753	symbol = nullptr;
4754	} else {
4755	// Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
4756	symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
4757	symbol->SetType(context().MakeNumericType(
4758	TypeCategory::Integer, evaluate::CInteger::kind));
4759	}
4760
4761	if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
4762	enumerator.t)}) {
4763	Walk(*init); // Resolve names in expression before evaluation.
4764	if (auto value{EvaluateInt64(context(), *init)}) {
4765	// Cast all init expressions to C_INT so that they can then be
4766	// safely incremented (see 7.6 Note 2).
4767	enumerationState_.value = static_cast<int>(*value);
4768	} else {
4769	Say(name,
4770	"Enumerator value could not be computed "
4771	"from the given expression"_err_en_US);
4772	// Prevent resolution of next enumerators value
4773	enumerationState_.value = std::nullopt;
4774	}
4775	}
4776
4777	if (symbol) {
4778	if (enumerationState_.value) {
4779	symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
4780	evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
4781	} else {
4782	context().SetError(*symbol);
4783	}
4784	}
4785
4786	if (enumerationState_.value) {
4787	(*enumerationState_.value)++;
4788	}
4789	return false;
4790	}
4791
4792	void DeclarationVisitor::Post(const parser::EnumDef &) {
4793	enumerationState_ = EnumeratorState{};
4794	}
4795
4796	bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {
4797	Attr attr{AccessSpecToAttr(x)};
4798	if (!NonDerivedTypeScope().IsModule()) { // C817
4799	Say(currStmtSource().value(),
4800	"%s attribute may only appear in the specification part of a module"_err_en_US,
4801	EnumToString(attr));
4802	}
4803	CheckAndSet(attr);
4804	return false;
4805	}
4806
4807	bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
4808	return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
4809	}
4810	bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {
4811	return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);
4812	}
4813	bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
4814	HandleAttributeStmt(Attr::EXTERNAL, x.v);
4815	for (const auto &name : x.v) {
4816	auto *symbol{FindSymbol(name)};
4817	if (!ConvertToProcEntity(DEREF(symbol), name.source)) {
4818	// Check if previous symbol is an interface.
4819	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
4820	if (details->isInterface()) {
4821	// Warn if interface previously declared.
4822	Say(name,
4823	"EXTERNAL attribute was already specified on '%s'"_warn_en_US);
4824	}
4825	} else {
4826	SayWithDecl(
4827	name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
4828	}
4829	} else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840
4830	Say(symbol->name(),
4831	"Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,
4832	symbol->name());
4833	}
4834	}
4835	return false;
4836	}
4837	bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
4838	auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
4839	auto &names{std::get<std::list<parser::Name>>(x.t)};
4840	return CheckNotInBlock("INTENT") && // C1107
4841	HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
4842	}
4843	bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
4844	for (const auto &name : x.v) {
4845	DeclareIntrinsic(name);
4846	}
4847	return false;
4848	}
4849	void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
4850	HandleAttributeStmt(Attr::INTRINSIC, name);
4851	if (!IsIntrinsic(name.source, std::nullopt)) {
4852	Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
4853	}
4854	auto &symbol{DEREF(FindSymbol(name))};
4855	if (symbol.has<GenericDetails>()) {
4856	// Generic interface is extending intrinsic; ok
4857	} else if (!ConvertToProcEntity(symbol&: symbol, usedHere: name.source)) {
4858	SayWithDecl(
4859	name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
4860	} else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
4861	Say(symbol.name(),
4862	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
4863	symbol.name());
4864	} else {
4865	if (symbol.GetType()) {
4866	// These warnings are worded so that they should make sense in either
4867	// order.
4868	Say(symbol.name(),
4869	"Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
4870	symbol.name())
4871	.Attach(name.source,
4872	"INTRINSIC statement for explicitly-typed '%s'"_en_US,
4873	name.source);
4874	}
4875	if (!symbol.test(Symbol::Flag::Function) &&
4876	!symbol.test(Symbol::Flag::Subroutine)) {
4877	if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) {
4878	symbol.set(Symbol::Flag::Function);
4879	} else if (context().intrinsics().IsIntrinsicSubroutine(
4880	name.source.ToString())) {
4881	symbol.set(Symbol::Flag::Subroutine);
4882	}
4883	}
4884	}
4885	}
4886	bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
4887	return CheckNotInBlock("OPTIONAL") && // C1107
4888	HandleAttributeStmt(Attr::OPTIONAL, x.v);
4889	}
4890	bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {
4891	return HandleAttributeStmt(Attr::PROTECTED, x.v);
4892	}
4893	bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
4894	return CheckNotInBlock("VALUE") && // C1107
4895	HandleAttributeStmt(Attr::VALUE, x.v);
4896	}
4897	bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
4898	return HandleAttributeStmt(Attr::VOLATILE, x.v);
4899	}
4900	bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {
4901	auto attr{std::get<common::CUDADataAttr>(x.t)};
4902	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
4903	auto *symbol{FindInScope(name)};
4904	if (symbol && symbol->has<UseDetails>()) {
4905	Say(currStmtSource().value(),
4906	"Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,
4907	name.source);
4908	} else {
4909	if (!symbol) {
4910	symbol = &MakeSymbol(name, ObjectEntityDetails{});
4911	}
4912	SetCUDADataAttr(name.source, *symbol, attr);
4913	}
4914	}
4915	return false;
4916	}
4917	// Handle a statement that sets an attribute on a list of names.
4918	bool DeclarationVisitor::HandleAttributeStmt(
4919	Attr attr, const std::list<parser::Name> &names) {
4920	for (const auto &name : names) {
4921	HandleAttributeStmt(attr, name);
4922	}
4923	return false;
4924	}
4925	Symbol &DeclarationVisitor::HandleAttributeStmt(
4926	Attr attr, const parser::Name &name) {
4927	auto *symbol{FindInScope(name)};
4928	if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
4929	// these can be set on a symbol that is host-assoc or use-assoc
4930	if (!symbol &&
4931	(currScope().kind() == Scope::Kind::Subprogram ||
4932	currScope().kind() == Scope::Kind::BlockConstruct)) {
4933	if (auto *hostSymbol{FindSymbol(name)}) {
4934	symbol = &MakeHostAssocSymbol(name, hostSymbol: *hostSymbol);
4935	}
4936	}
4937	} else if (symbol && symbol->has<UseDetails>()) {
4938	if (symbol->GetUltimate().attrs().test(attr)) {
4939	Say(currStmtSource().value(),
4940	"Use-associated '%s' already has '%s' attribute"_warn_en_US,
4941	name.source, EnumToString(attr));
4942	} else {
4943	Say(currStmtSource().value(),
4944	"Cannot change %s attribute on use-associated '%s'"_err_en_US,
4945	EnumToString(attr), name.source);
4946	}
4947	return *symbol;
4948	}
4949	if (!symbol) {
4950	symbol = &MakeSymbol(name, EntityDetails{});
4951	}
4952	if (CheckDuplicatedAttr(name.source, *symbol, attr)) {
4953	HandleSaveName(name.source, Attrs{attr});
4954	SetExplicitAttr(*symbol, attr);
4955	}
4956	return *symbol;
4957	}
4958	// C1107
4959	bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {
4960	if (currScope().kind() == Scope::Kind::BlockConstruct) {
4961	Say(MessageFormattedText{
4962	"%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});
4963	return false;
4964	} else {
4965	return true;
4966	}
4967	}
4968
4969	void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
4970	CHECK(objectDeclAttr_);
4971	const auto &name{std::get<parser::ObjectName>(x.t)};
4972	DeclareObjectEntity(name, Attrs{*objectDeclAttr_});
4973	}
4974
4975	// Declare an entity not yet known to be an object or proc.
4976	Symbol &DeclarationVisitor::DeclareUnknownEntity(
4977	const parser::Name &name, Attrs attrs) {
4978	if (!arraySpec().empty() || !coarraySpec().empty()) {
4979	return DeclareObjectEntity(name, attrs);
4980	} else {
4981	Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
4982	if (auto *type{GetDeclTypeSpec()}) {
4983	SetType(name, *type);
4984	}
4985	charInfo_.length.reset();
4986	if (symbol.attrs().test(Attr::EXTERNAL)) {
4987	ConvertToProcEntity(symbol);
4988	}
4989	SetBindNameOn(symbol);
4990	return symbol;
4991	}
4992	}
4993
4994	bool DeclarationVisitor::HasCycle(
4995	const Symbol &procSymbol, const Symbol *interface) {
4996	SourceOrderedSymbolSet procsInCycle;
4997	procsInCycle.insert(procSymbol);
4998	while (interface) {
4999	if (procsInCycle.count(*interface) > 0) {
5000	for (const auto &procInCycle : procsInCycle) {
5001	Say(procInCycle->name(),
5002	"The interface for procedure '%s' is recursively "
5003	"defined"_err_en_US,
5004	procInCycle->name());
5005	context().SetError(*procInCycle);
5006	}
5007	return true;
5008	} else if (const auto *procDetails{
5009	interface->detailsIf<ProcEntityDetails>()}) {
5010	procsInCycle.insert(*interface);
5011	interface = procDetails->procInterface();
5012	} else {
5013	break;
5014	}
5015	}
5016	return false;
5017	}
5018
5019	Symbol &DeclarationVisitor::DeclareProcEntity(
5020	const parser::Name &name, Attrs attrs, const Symbol *interface) {
5021	Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
5022	if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
5023	if (context().HasError(symbol)) {
5024	} else if (HasCycle(procSymbol: symbol, interface)) {
5025	return symbol;
5026	} else if (interface && (details->procInterface() || details->type())) {
5027	SayWithDecl(name, symbol,
5028	"The interface for procedure '%s' has already been declared"_err_en_US);
5029	context().SetError(symbol);
5030	} else if (interface) {
5031	details->set_procInterfaces(
5032	*interface, BypassGeneric(interface->GetUltimate()));
5033	if (interface->test(Symbol::Flag::Function)) {
5034	symbol.set(Symbol::Flag::Function);
5035	} else if (interface->test(Symbol::Flag::Subroutine)) {
5036	symbol.set(Symbol::Flag::Subroutine);
5037	}
5038	if (IsBindCProcedure(*interface) && !IsPointer(symbol) &&
5039	!IsDummy(symbol)) {
5040	// Inherit BIND_C attribute from the interface, but not the NAME="..."
5041	// if any. This is not clearly described in the standard, but matches
5042	// the behavior of other compilers.
5043	SetImplicitAttr(symbol, Attr::BIND_C);
5044	}
5045	} else if (auto *type{GetDeclTypeSpec()}) {
5046	SetType(name, *type);
5047	symbol.set(Symbol::Flag::Function);
5048	}
5049	SetBindNameOn(symbol);
5050	SetPassNameOn(symbol);
5051	}
5052	return symbol;
5053	}
5054
5055	Symbol &DeclarationVisitor::DeclareObjectEntity(
5056	const parser::Name &name, Attrs attrs) {
5057	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
5058	if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
5059	if (auto *type{GetDeclTypeSpec()}) {
5060	SetType(name, *type);
5061	}
5062	if (!arraySpec().empty()) {
5063	if (details->IsArray()) {
5064	if (!context().HasError(symbol)) {
5065	Say(name,
5066	"The dimensions of '%s' have already been declared"_err_en_US);
5067	context().SetError(symbol);
5068	}
5069	} else if (MustBeScalar(symbol)) {
5070	Say(name,
5071	"'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US);
5072	} else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
5073	Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);
5074	} else {
5075	details->set_shape(arraySpec());
5076	}
5077	}
5078	if (!coarraySpec().empty()) {
5079	if (details->IsCoarray()) {
5080	if (!context().HasError(symbol)) {
5081	Say(name,
5082	"The codimensions of '%s' have already been declared"_err_en_US);
5083	context().SetError(symbol);
5084	}
5085	} else {
5086	details->set_coshape(coarraySpec());
5087	}
5088	}
5089	SetBindNameOn(symbol);
5090	}
5091	ClearArraySpec();
5092	ClearCoarraySpec();
5093	charInfo_.length.reset();
5094	return symbol;
5095	}
5096
5097	void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
5098	if (!isVectorType_) {
5099	SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
5100	}
5101	}
5102	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
5103	if (!isVectorType_) {
5104	SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
5105	}
5106	}
5107	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
5108	SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
5109	}
5110	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
5111	SetDeclTypeSpec(MakeLogicalType(x.kind));
5112	}
5113	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
5114	if (!charInfo_.length) {
5115	charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};
5116	}
5117	if (!charInfo_.kind) {
5118	charInfo_.kind =
5119	KindExpr{context().GetDefaultKind(TypeCategory::Character)};
5120	}
5121	SetDeclTypeSpec(currScope().MakeCharacterType(
5122	std::move(*charInfo_.length), std::move(*charInfo_.kind)));
5123	charInfo_ = {};
5124	}
5125	void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
5126	charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
5127	std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};
5128	if (intKind &&
5129	!context().targetCharacteristics().IsTypeEnabled(
5130	TypeCategory::Character, *intKind)) { // C715, C719
5131	Say(currStmtSource().value(),
5132	"KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);
5133	charInfo_.kind = std::nullopt; // prevent further errors
5134	}
5135	if (x.length) {
5136	charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
5137	}
5138	}
5139	void DeclarationVisitor::Post(const parser::CharLength &x) {
5140	if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {
5141	charInfo_.length = ParamValue{
5142	static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};
5143	} else {
5144	charInfo_.length = GetParamValue(
5145	std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);
5146	}
5147	}
5148	void DeclarationVisitor::Post(const parser::LengthSelector &x) {
5149	if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {
5150	charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);
5151	}
5152	}
5153
5154	bool DeclarationVisitor::Pre(const parser::KindParam &x) {
5155	if (const auto *kind{std::get_if<
5156	parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
5157	&x.u)}) {
5158	const parser::Name &name{kind->thing.thing.thing};
5159	if (!FindSymbol(name)) {
5160	Say(name, "Parameter '%s' not found"_err_en_US);
5161	}
5162	}
5163	return false;
5164	}
5165
5166	int DeclarationVisitor::GetVectorElementKind(
5167	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
5168	KindExpr value{GetKindParamExpr(category, kind)};
5169	if (auto known{evaluate::ToInt64(value)}) {
5170	return static_cast<int>(*known);
5171	}
5172	common::die("Vector element kind must be known at compile-time");
5173	}
5174
5175	bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) {
5176	// PowerPC vector types are allowed only on Power architectures.
5177	if (!currScope().context().targetCharacteristics().isPPC()) {
5178	Say(currStmtSource().value(),
5179	"Vector type is only supported for PowerPC"_err_en_US);
5180	isVectorType_ = false;
5181	return false;
5182	}
5183	isVectorType_ = true;
5184	return true;
5185	}
5186	// Create semantic::DerivedTypeSpec for Vector types here.
5187	void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {
5188	llvm::StringRef typeName;
5189	llvm::SmallVector<ParamValue> typeParams;
5190	DerivedTypeSpec::Category vectorCategory;
5191
5192	isVectorType_ = false;
5193	common::visit(
5194	common::visitors{
5195	[&](const parser::IntrinsicVectorTypeSpec &y) {
5196	vectorCategory = DerivedTypeSpec::Category::IntrinsicVector;
5197	int vecElemKind = 0;
5198	typeName = "__builtin_ppc_intrinsic_vector";
5199	common::visit(
5200	common::visitors{
5201	[&](const parser::IntegerTypeSpec &z) {
5202	vecElemKind = GetVectorElementKind(
5203	TypeCategory::Integer, std::move(z.v));
5204	typeParams.push_back(ParamValue(
5205	static_cast<common::ConstantSubscript>(
5206	common::VectorElementCategory::Integer),
5207	common::TypeParamAttr::Kind));
5208	},
5209	[&](const parser::IntrinsicTypeSpec::Real &z) {
5210	vecElemKind = GetVectorElementKind(
5211	TypeCategory::Real, std::move(z.kind));
5212	typeParams.push_back(
5213	ParamValue(static_cast<common::ConstantSubscript>(
5214	common::VectorElementCategory::Real),
5215	common::TypeParamAttr::Kind));
5216	},
5217	[&](const parser::UnsignedTypeSpec &z) {
5218	vecElemKind = GetVectorElementKind(
5219	TypeCategory::Integer, std::move(z.v));
5220	typeParams.push_back(ParamValue(
5221	static_cast<common::ConstantSubscript>(
5222	common::VectorElementCategory::Unsigned),
5223	common::TypeParamAttr::Kind));
5224	},
5225	},
5226	y.v.u);
5227	typeParams.push_back(
5228	ParamValue(static_cast<common::ConstantSubscript>(vecElemKind),
5229	common::TypeParamAttr::Kind));
5230	},
5231	[&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) {
5232	vectorCategory = DerivedTypeSpec::Category::PairVector;
5233	typeName = "__builtin_ppc_pair_vector";
5234	},
5235	[&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) {
5236	vectorCategory = DerivedTypeSpec::Category::QuadVector;
5237	typeName = "__builtin_ppc_quad_vector";
5238	},
5239	},
5240	x.u);
5241
5242	auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope();
5243	if (!ppcBuiltinTypesScope) {
5244	common::die("INTERNAL: The __ppc_types module was not found ");
5245	}
5246
5247	auto iter{ppcBuiltinTypesScope->find(
5248	semantics::SourceName{typeName.data(), typeName.size()})};
5249	if (iter == ppcBuiltinTypesScope->cend()) {
5250	common::die("INTERNAL: The __ppc_types module does not define "
5251	"the type '%s'",
5252	typeName.data());
5253	}
5254
5255	const semantics::Symbol &typeSymbol{*iter->second};
5256	DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol};
5257	vectorDerivedType.set_category(vectorCategory);
5258	if (typeParams.size()) {
5259	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0]));
5260	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1]));
5261	vectorDerivedType.CookParameters(GetFoldingContext());
5262	}
5263
5264	if (const DeclTypeSpec *
5265	extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(
5266	vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
5267	// This derived type and parameter expressions (if any) are already present
5268	// in the __ppc_intrinsics scope.
5269	SetDeclTypeSpec(*extant);
5270	} else {
5271	DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType(
5272	DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))};
5273	DerivedTypeSpec &derived{type.derivedTypeSpec()};
5274	auto restorer{
5275	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
5276	derived.Instantiate(*ppcBuiltinTypesScope);
5277	SetDeclTypeSpec(type);
5278	}
5279	}
5280
5281	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
5282	CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
5283	return true;
5284	}
5285
5286	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
5287	const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)};
5288	if (const Symbol * derivedSymbol{derivedName.symbol}) {
5289	CheckForAbstractType(*derivedSymbol); // C706
5290	}
5291	}
5292
5293	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) {
5294	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
5295	return true;
5296	}
5297
5298	void DeclarationVisitor::Post(
5299	const parser::DeclarationTypeSpec::Class &parsedClass) {
5300	const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)};
5301	if (auto spec{ResolveDerivedType(typeName)};
5302	spec && !IsExtensibleType(&*spec)) { // C705
5303	SayWithDecl(typeName, *typeName.symbol,
5304	"Non-extensible derived type '%s' may not be used with CLASS"
5305	" keyword"_err_en_US);
5306	}
5307	}
5308
5309	void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
5310	const auto &typeName{std::get<parser::Name>(x.t)};
5311	auto spec{ResolveDerivedType(typeName)};
5312	if (!spec) {
5313	return;
5314	}
5315	bool seenAnyName{false};
5316	for (const auto &typeParamSpec :
5317	std::get<std::list<parser::TypeParamSpec>>(x.t)) {
5318	const auto &optKeyword{
5319	std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};
5320	std::optional<SourceName> name;
5321	if (optKeyword) {
5322	seenAnyName = true;
5323	name = optKeyword->v.source;
5324	} else if (seenAnyName) {
5325	Say(typeName.source, "Type parameter value must have a name"_err_en_US);
5326	continue;
5327	}
5328	const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
5329	// The expressions in a derived type specifier whose values define
5330	// non-defaulted type parameters are evaluated (folded) in the enclosing
5331	// scope. The KIND/LEN distinction is resolved later in
5332	// DerivedTypeSpec::CookParameters().
5333	ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
5334	if (!param.isExplicit() || param.GetExplicit()) {
5335	spec->AddRawParamValue(
5336	common::GetPtrFromOptional(optKeyword), std::move(param));
5337	}
5338	}
5339	// The DerivedTypeSpec *spec is used initially as a search key.
5340	// If it turns out to have the same name and actual parameter
5341	// value expressions as another DerivedTypeSpec in the current
5342	// scope does, then we'll use that extant spec; otherwise, when this
5343	// spec is distinct from all derived types previously instantiated
5344	// in the current scope, this spec will be moved into that collection.
5345	const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};
5346	auto category{GetDeclTypeSpecCategory()};
5347	if (dtDetails.isForwardReferenced()) {
5348	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
5349	SetDeclTypeSpec(type);
5350	return;
5351	}
5352	// Normalize parameters to produce a better search key.
5353	spec->CookParameters(GetFoldingContext());
5354	if (!spec->MightBeParameterized()) {
5355	spec->EvaluateParameters(context());
5356	}
5357	if (const DeclTypeSpec *
5358	extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
5359	// This derived type and parameter expressions (if any) are already present
5360	// in this scope.
5361	SetDeclTypeSpec(*extant);
5362	} else {
5363	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
5364	DerivedTypeSpec &derived{type.derivedTypeSpec()};
5365	if (derived.MightBeParameterized() &&
5366	currScope().IsParameterizedDerivedType()) {
5367	// Defer instantiation; use the derived type's definition's scope.
5368	derived.set_scope(DEREF(spec->typeSymbol().scope()));
5369	} else if (&currScope() == spec->typeSymbol().scope()) {
5370	// Direct recursive use of a type in the definition of one of its
5371	// components: defer instantiation
5372	} else {
5373	auto restorer{
5374	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
5375	derived.Instantiate(currScope());
5376	}
5377	SetDeclTypeSpec(type);
5378	}
5379	// Capture the DerivedTypeSpec in the parse tree for use in building
5380	// structure constructor expressions.
5381	x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
5382	}
5383
5384	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
5385	const auto &typeName{rec.v};
5386	if (auto spec{ResolveDerivedType(typeName)}) {
5387	spec->CookParameters(GetFoldingContext());
5388	spec->EvaluateParameters(context());
5389	if (const DeclTypeSpec *
5390	extant{currScope().FindInstantiatedDerivedType(
5391	*spec, DeclTypeSpec::TypeDerived)}) {
5392	SetDeclTypeSpec(*extant);
5393	} else {
5394	Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,
5395	typeName.source);
5396	}
5397	}
5398	}
5399
5400	// The descendents of DerivedTypeDef in the parse tree are visited directly
5401	// in this Pre() routine so that recursive use of the derived type can be
5402	// supported in the components.
5403	bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
5404	auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
5405	Walk(stmt);
5406	Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));
5407	auto &scope{currScope()};
5408	CHECK(scope.symbol());
5409	CHECK(scope.symbol()->scope() == &scope);
5410	auto &details{scope.symbol()->get<DerivedTypeDetails>()};
5411	std::set<SourceName> paramNames;
5412	for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
5413	details.add_paramName(paramName.source);
5414	auto *symbol{FindInScope(scope, paramName)};
5415	if (!symbol) {
5416	Say(paramName,
5417	"No definition found for type parameter '%s'"_err_en_US); // C742
5418	// No symbol for a type param. Create one and mark it as containing an
5419	// error to improve subsequent semantic processing
5420	BeginAttrs();
5421	Symbol *typeParam{MakeTypeSymbol(
5422	paramName, TypeParamDetails{common::TypeParamAttr::Len})};
5423	context().SetError(*typeParam);
5424	EndAttrs();
5425	} else if (!symbol->has<TypeParamDetails>()) {
5426	Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US,
5427	*symbol, "Definition of '%s'"_en_US); // C741
5428	}
5429	if (!paramNames.insert(paramName.source).second) {
5430	Say(paramName,
5431	"Duplicate type parameter name: '%s'"_err_en_US); // C731
5432	}
5433	}
5434	for (const auto &[name, symbol] : currScope()) {
5435	if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) {
5436	SayDerivedType(name,
5437	"'%s' is not a type parameter of this derived type"_err_en_US,
5438	currScope()); // C741
5439	}
5440	}
5441	Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t));
5442	const auto &componentDefs{
5443	std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)};
5444	Walk(componentDefs);
5445	if (derivedTypeInfo_.sequence) {
5446	details.set_sequence(true);
5447	if (componentDefs.empty()) {
5448	// F'2023 C745 - not enforced by any compiler
5449	Say(stmt.source,
5450	"A sequence type should have at least one component"_warn_en_US);
5451	}
5452	if (!details.paramNames().empty()) { // C740
5453	Say(stmt.source,
5454	"A sequence type may not have type parameters"_err_en_US);
5455	}
5456	if (derivedTypeInfo_.extends) { // C735
5457	Say(stmt.source,
5458	"A sequence type may not have the EXTENDS attribute"_err_en_US);
5459	}
5460	}
5461	Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
5462	Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));
5463	details.set_isForwardReferenced(false);
5464	derivedTypeInfo_ = {};
5465	PopScope();
5466	return false;
5467	}
5468
5469	bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
5470	return BeginAttrs();
5471	}
5472	void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
5473	auto &name{std::get<parser::Name>(x.t)};
5474	// Resolve the EXTENDS() clause before creating the derived
5475	// type's symbol to foil attempts to recursively extend a type.
5476	auto *extendsName{derivedTypeInfo_.extends};
5477	std::optional<DerivedTypeSpec> extendsType{
5478	ResolveExtendsType(name, extendsName)};
5479	DerivedTypeDetails derivedTypeDetails;
5480	if (Symbol *typeSymbol{FindInScope(currScope(), name)}; typeSymbol &&
5481	typeSymbol->has<DerivedTypeDetails>() &&
5482	typeSymbol->get<DerivedTypeDetails>().isForwardReferenced()) {
5483	derivedTypeDetails.set_isForwardReferenced(true);
5484	}
5485	auto &symbol{MakeSymbol(name, GetAttrs(), std::move(derivedTypeDetails))};
5486	symbol.ReplaceName(name.source);
5487	derivedTypeInfo_.type = &symbol;
5488	PushScope(Scope::Kind::DerivedType, &symbol);
5489	if (extendsType) {
5490	// Declare the "parent component"; private if the type is.
5491	// Any symbol stored in the EXTENDS() clause is temporarily
5492	// hidden so that a new symbol can be created for the parent
5493	// component without producing spurious errors about already
5494	// existing.
5495	const Symbol &extendsSymbol{extendsType->typeSymbol()};
5496	auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
5497	if (OkToAddComponent(*extendsName, &extendsSymbol)) {
5498	auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
5499	comp.attrs().set(
5500	Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE));
5501	comp.implicitAttrs().set(
5502	Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE));
5503	comp.set(Symbol::Flag::ParentComp);
5504	DeclTypeSpec &type{currScope().MakeDerivedType(
5505	DeclTypeSpec::TypeDerived, std::move(*extendsType))};
5506	type.derivedTypeSpec().set_scope(*extendsSymbol.scope());
5507	comp.SetType(type);
5508	DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
5509	details.add_component(comp);
5510	}
5511	}
5512	EndAttrs();
5513	}
5514
5515	void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
5516	auto *type{GetDeclTypeSpec()};
5517	auto attr{std::get<common::TypeParamAttr>(x.t)};
5518	for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
5519	auto &name{std::get<parser::Name>(decl.t)};
5520	if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{attr})}) {
5521	SetType(name, *type);
5522	if (auto &init{
5523	std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) {
5524	if (auto maybeExpr{EvaluateNonPointerInitializer(
5525	*symbol, *init, init->thing.thing.thing.value().source)}) {
5526	if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) {
5527	symbol->get<TypeParamDetails>().set_init(std::move(*intExpr));
5528	}
5529	}
5530	}
5531	}
5532	}
5533	EndDecl();
5534	}
5535	bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
5536	if (derivedTypeInfo_.extends) {
5537	Say(currStmtSource().value(),
5538	"Attribute 'EXTENDS' cannot be used more than once"_err_en_US);
5539	} else {
5540	derivedTypeInfo_.extends = &x.v;
5541	}
5542	return false;
5543	}
5544
5545	bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
5546	if (!currScope().parent().IsModule()) {
5547	Say("PRIVATE is only allowed in a derived type that is"
5548	" in a module"_err_en_US); // C766
5549	} else if (derivedTypeInfo_.sawContains) {
5550	derivedTypeInfo_.privateBindings = true;
5551	} else if (!derivedTypeInfo_.privateComps) {
5552	derivedTypeInfo_.privateComps = true;
5553	} else { // C738
5554	Say("PRIVATE should not appear more than once in derived type components"_warn_en_US);
5555	}
5556	return false;
5557	}
5558	bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {
5559	if (derivedTypeInfo_.sequence) { // C738
5560	Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US);
5561	}
5562	derivedTypeInfo_.sequence = true;
5563	return false;
5564	}
5565	void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
5566	const auto &name{std::get<parser::Name>(x.t)};
5567	auto attrs{GetAttrs()};
5568	if (derivedTypeInfo_.privateComps &&
5569	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
5570	attrs.set(Attr::PRIVATE);
5571	}
5572	if (const auto *declType{GetDeclTypeSpec()}) {
5573	if (const auto *derived{declType->AsDerived()}) {
5574	if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
5575	if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744
5576	Say("Recursive use of the derived type requires "
5577	"POINTER or ALLOCATABLE"_err_en_US);
5578	}
5579	}
5580	// TODO: This would be more appropriate in CheckDerivedType()
5581	if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748
5582	std::string ultimateName{it.BuildResultDesignatorName()};
5583	// Strip off the leading "%"
5584	if (ultimateName.length() > 1) {
5585	ultimateName.erase(pos: 0, n: 1);
5586	if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
5587	evaluate::AttachDeclaration(
5588	Say(name.source,
5589	"A component with a POINTER or ALLOCATABLE attribute may "
5590	"not "
5591	"be of a type with a coarray ultimate component (named "
5592	"'%s')"_err_en_US,
5593	ultimateName),
5594	derived->typeSymbol());
5595	}
5596	if (!arraySpec().empty() || !coarraySpec().empty()) {
5597	evaluate::AttachDeclaration(
5598	Say(name.source,
5599	"An array or coarray component may not be of a type with a "
5600	"coarray ultimate component (named '%s')"_err_en_US,
5601	ultimateName),
5602	derived->typeSymbol());
5603	}
5604	}
5605	}
5606	}
5607	}
5608	if (OkToAddComponent(name)) {
5609	auto &symbol{DeclareObjectEntity(name, attrs)};
5610	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
5611	if (symbol.has<ObjectEntityDetails>()) {
5612	if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
5613	Initialization(name, *init, true);
5614	}
5615	}
5616	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
5617	}
5618	ClearArraySpec();
5619	ClearCoarraySpec();
5620	}
5621	void DeclarationVisitor::Post(const parser::FillDecl &x) {
5622	// Replace "%FILL" with a distinct generated name
5623	const auto &name{std::get<parser::Name>(x.t)};
5624	const_cast<SourceName &>(name.source) = context().GetTempName(currScope());
5625	if (OkToAddComponent(name)) {
5626	auto &symbol{DeclareObjectEntity(name, GetAttrs())};
5627	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
5628	}
5629	ClearArraySpec();
5630	}
5631	bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
5632	CHECK(!interfaceName_);
5633	const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};
5634	for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
5635	if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
5636	if (bindC->v.has_value()) {
5637	if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {
5638	Say(context().location().value(),
5639	"A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);
5640	}
5641	break;
5642	}
5643	}
5644	}
5645	return BeginDecl();
5646	}
5647	void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
5648	interfaceName_ = nullptr;
5649	EndDecl();
5650	}
5651	bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
5652	// Overrides parse tree traversal so as to handle attributes first,
5653	// so POINTER & ALLOCATABLE enable forward references to derived types.
5654	Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
5655	set_allowForwardReferenceToDerivedType(
5656	GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
5657	Walk(std::get<parser::DeclarationTypeSpec>(x.t));
5658	set_allowForwardReferenceToDerivedType(false);
5659	if (derivedTypeInfo_.sequence) { // C740
5660	if (const auto *declType{GetDeclTypeSpec()}) {
5661	if (!declType->AsIntrinsic() && !declType->IsSequenceType() &&
5662	!InModuleFile()) {
5663	if (GetAttrs().test(Attr::POINTER) &&
5664	context().IsEnabled(common::LanguageFeature::PointerInSeqType)) {
5665	if (context().ShouldWarn(common::LanguageFeature::PointerInSeqType)) {
5666	Say("A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);
5667	}
5668	} else {
5669	Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US);
5670	}
5671	}
5672	}
5673	}
5674	Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));
5675	return false;
5676	}
5677	bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
5678	CHECK(!interfaceName_);
5679	return true;
5680	}
5681	void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
5682	interfaceName_ = nullptr;
5683	}
5684	bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
5685	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
5686	return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(name: *name);
5687	} else {
5688	const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))};
5689	Walk(null);
5690	if (auto nullInit{EvaluateExpr(null)}) {
5691	if (!evaluate::IsNullPointer(*nullInit)) {
5692	Say(null.v.value().source,
5693	"Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US);
5694	}
5695	}
5696	return false;
5697	}
5698	}
5699	void DeclarationVisitor::Post(const parser::ProcInterface &x) {
5700	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
5701	interfaceName_ = name;
5702	NoteInterfaceName(*name);
5703	}
5704	}
5705	void DeclarationVisitor::Post(const parser::ProcDecl &x) {
5706	const auto &name{std::get<parser::Name>(x.t)};
5707	// Don't use BypassGeneric or GetUltimate on this symbol, they can
5708	// lead to unusable names in module files.
5709	const Symbol *procInterface{
5710	interfaceName_ ? interfaceName_->symbol : nullptr};
5711	auto attrs{HandleSaveName(name.source, GetAttrs())};
5712	DerivedTypeDetails *dtDetails{nullptr};
5713	if (Symbol * symbol{currScope().symbol()}) {
5714	dtDetails = symbol->detailsIf<DerivedTypeDetails>();
5715	}
5716	if (!dtDetails) {
5717	attrs.set(Attr::EXTERNAL);
5718	}
5719	Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
5720	SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
5721	symbol.ReplaceName(name.source);
5722	if (dtDetails) {
5723	dtDetails->add_component(symbol);
5724	}
5725	DeclaredPossibleSpecificProc(symbol);
5726	}
5727
5728	bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {
5729	derivedTypeInfo_.sawContains = true;
5730	return true;
5731	}
5732
5733	// Resolve binding names from type-bound generics, saved in genericBindings_.
5734	void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) {
5735	// track specifics seen for the current generic to detect duplicates:
5736	const Symbol *currGeneric{nullptr};
5737	std::set<SourceName> specifics;
5738	for (const auto &[generic, bindingName] : genericBindings_) {
5739	if (generic != currGeneric) {
5740	currGeneric = generic;
5741	specifics.clear();
5742	}
5743	auto [it, inserted]{specifics.insert(bindingName->source)};
5744	if (!inserted) {
5745	Say(*bindingName, // C773
5746	"Binding name '%s' was already specified for generic '%s'"_err_en_US,
5747	bindingName->source, generic->name())
5748	.Attach(*it, "Previous specification of '%s'"_en_US, *it);
5749	continue;
5750	}
5751	auto *symbol{FindInTypeOrParents(*bindingName)};
5752	if (!symbol) {
5753	Say(*bindingName, // C772
5754	"Binding name '%s' not found in this derived type"_err_en_US);
5755	} else if (!symbol->has<ProcBindingDetails>()) {
5756	SayWithDecl(*bindingName, *symbol, // C772
5757	"'%s' is not the name of a specific binding of this type"_err_en_US);
5758	} else {
5759	generic->get<GenericDetails>().AddSpecificProc(
5760	*symbol, bindingName->source);
5761	}
5762	}
5763	genericBindings_.clear();
5764	}
5765
5766	void DeclarationVisitor::Post(const parser::ContainsStmt &) {
5767	if (derivedTypeInfo_.sequence) {
5768	Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740
5769	}
5770	}
5771
5772	void DeclarationVisitor::Post(
5773	const parser::TypeBoundProcedureStmt::WithoutInterface &x) {
5774	if (GetAttrs().test(Attr::DEFERRED)) { // C783
5775	Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US);
5776	}
5777	for (auto &declaration : x.declarations) {
5778	auto &bindingName{std::get<parser::Name>(declaration.t)};
5779	auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};
5780	const parser::Name &procedureName{optName ? *optName : bindingName};
5781	Symbol *procedure{FindSymbol(procedureName)};
5782	if (!procedure) {
5783	procedure = NoteInterfaceName(procedureName);
5784	}
5785	if (procedure) {
5786	const Symbol &bindTo{BypassGeneric(*procedure)};
5787	if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) {
5788	SetPassNameOn(*s);
5789	if (GetAttrs().test(Attr::DEFERRED)) {
5790	context().SetError(*s);
5791	}
5792	}
5793	}
5794	}
5795	}
5796
5797	void DeclarationVisitor::CheckBindings(
5798	const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
5799	CHECK(currScope().IsDerivedType());
5800	for (auto &declaration : tbps.declarations) {
5801	auto &bindingName{std::get<parser::Name>(declaration.t)};
5802	if (Symbol * binding{FindInScope(bindingName)}) {
5803	if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {
5804	const Symbol &ultimate{details->symbol().GetUltimate()};
5805	const Symbol &procedure{BypassGeneric(ultimate)};
5806	if (&procedure != &ultimate) {
5807	details->ReplaceSymbol(procedure);
5808	}
5809	if (!CanBeTypeBoundProc(procedure)) {
5810	if (details->symbol().name() != binding->name()) {
5811	Say(binding->name(),
5812	"The binding of '%s' ('%s') must be either an accessible "
5813	"module procedure or an external procedure with "
5814	"an explicit interface"_err_en_US,
5815	binding->name(), details->symbol().name());
5816	} else {
5817	Say(binding->name(),
5818	"'%s' must be either an accessible module procedure "
5819	"or an external procedure with an explicit interface"_err_en_US,
5820	binding->name());
5821	}
5822	context().SetError(*binding);
5823	}
5824	}
5825	}
5826	}
5827	}
5828
5829	void DeclarationVisitor::Post(
5830	const parser::TypeBoundProcedureStmt::WithInterface &x) {
5831	if (!GetAttrs().test(Attr::DEFERRED)) { // C783
5832	Say("DEFERRED is required when an interface-name is provided"_err_en_US);
5833	}
5834	if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) {
5835	for (auto &bindingName : x.bindingNames) {
5836	if (auto *s{
5837	MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) {
5838	SetPassNameOn(*s);
5839	if (!GetAttrs().test(Attr::DEFERRED)) {
5840	context().SetError(*s);
5841	}
5842	}
5843	}
5844	}
5845	}
5846
5847	bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) {
5848	if (currScope().IsDerivedType() && currScope().symbol()) {
5849	if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) {
5850	for (const auto &subrName : x.v) {
5851	Symbol *symbol{FindSymbol(subrName)};
5852	if (!symbol) {
5853	// FINAL procedures must be module subroutines
5854	symbol = &MakeSymbol(
5855	currScope().parent(), subrName.source, Attrs{Attr::MODULE});
5856	Resolve(subrName, symbol);
5857	symbol->set_details(ProcEntityDetails{});
5858	symbol->set(Symbol::Flag::Subroutine);
5859	}
5860	if (auto pair{details->finals().emplace(subrName.source, *symbol)};
5861	!pair.second) { // C787
5862	Say(subrName.source,
5863	"FINAL subroutine '%s' already appeared in this derived type"_err_en_US,
5864	subrName.source)
5865	.Attach(pair.first->first,
5866	"earlier appearance of this FINAL subroutine"_en_US);
5867	}
5868	}
5869	}
5870	}
5871	return false;
5872	}
5873
5874	bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
5875	const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)};
5876	const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};
5877	const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)};
5878	GenericSpecInfo info{genericSpec.value()};
5879	SourceName symbolName{info.symbolName()};
5880	bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private
5881	: derivedTypeInfo_.privateBindings};
5882	auto *genericSymbol{FindInScope(symbolName)};
5883	if (genericSymbol) {
5884	if (!genericSymbol->has<GenericDetails>()) {
5885	genericSymbol = nullptr; // MakeTypeSymbol will report the error below
5886	}
5887	} else {
5888	// look in ancestor types for a generic of the same name
5889	for (const auto &name : GetAllNames(context(), symbolName)) {
5890	if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) {
5891	if (inherited->has<GenericDetails>()) {
5892	CheckAccessibility(symbolName, isPrivate, *inherited); // C771
5893	} else {
5894	Say(symbolName,
5895	"Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US)
5896	.Attach(inherited->name(), "Inherited symbol"_en_US);
5897	}
5898	break;
5899	}
5900	}
5901	}
5902	if (genericSymbol) {
5903	CheckAccessibility(name: symbolName, isPrivate, symbol&: *genericSymbol); // C771
5904	} else {
5905	genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{});
5906	if (!genericSymbol) {
5907	return false;
5908	}
5909	if (isPrivate) {
5910	SetExplicitAttr(*genericSymbol, Attr::PRIVATE);
5911	}
5912	}
5913	for (const parser::Name &bindingName : bindingNames) {
5914	genericBindings_.emplace(genericSymbol, &bindingName);
5915	}
5916	info.Resolve(genericSymbol);
5917	return false;
5918	}
5919
5920	// DEC STRUCTUREs are handled thus to allow for nested definitions.
5921	bool DeclarationVisitor::Pre(const parser::StructureDef &def) {
5922	const auto &structureStatement{
5923	std::get<parser::Statement<parser::StructureStmt>>(def.t)};
5924	auto saveDerivedTypeInfo{derivedTypeInfo_};
5925	derivedTypeInfo_ = {};
5926	derivedTypeInfo_.isStructure = true;
5927	derivedTypeInfo_.sequence = true;
5928	Scope *previousStructure{nullptr};
5929	if (saveDerivedTypeInfo.isStructure) {
5930	previousStructure = &currScope();
5931	PopScope();
5932	}
5933	const parser::StructureStmt &structStmt{structureStatement.statement};
5934	const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};
5935	if (!name) {
5936	// Construct a distinct generated name for an anonymous structure
5937	auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};
5938	mutableName.emplace(
5939	parser::Name{context().GetTempName(currScope()), nullptr});
5940	}
5941	auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};
5942	symbol.ReplaceName(name->source);
5943	symbol.get<DerivedTypeDetails>().set_sequence(true);
5944	symbol.get<DerivedTypeDetails>().set_isDECStructure(true);
5945	derivedTypeInfo_.type = &symbol;
5946	PushScope(Scope::Kind::DerivedType, &symbol);
5947	const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};
5948	Walk(fields);
5949	PopScope();
5950	// Complete the definition
5951	DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};
5952	derivedTypeSpec.set_scope(DEREF(symbol.scope()));
5953	derivedTypeSpec.CookParameters(GetFoldingContext());
5954	derivedTypeSpec.EvaluateParameters(context());
5955	DeclTypeSpec &type{currScope().MakeDerivedType(
5956	DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};
5957	type.derivedTypeSpec().Instantiate(currScope());
5958	// Restore previous structure definition context, if any
5959	derivedTypeInfo_ = saveDerivedTypeInfo;
5960	if (previousStructure) {
5961	PushScope(*previousStructure);
5962	}
5963	// Handle any entity declarations on the STRUCTURE statement
5964	const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};
5965	if (!decls.empty()) {
5966	BeginDecl();
5967	SetDeclTypeSpec(type);
5968	Walk(decls);
5969	EndDecl();
5970	}
5971	return false;
5972	}
5973
5974	bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {
5975	Say("support for UNION"_todo_en_US); // TODO
5976	return true;
5977	}
5978
5979	bool DeclarationVisitor::Pre(const parser::StructureField &x) {
5980	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
5981	x.u)) {
5982	BeginDecl();
5983	}
5984	return true;
5985	}
5986
5987	void DeclarationVisitor::Post(const parser::StructureField &x) {
5988	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
5989	x.u)) {
5990	EndDecl();
5991	}
5992	}
5993
5994	bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
5995	BeginDeclTypeSpec();
5996	return true;
5997	}
5998	void DeclarationVisitor::Post(const parser::AllocateStmt &) {
5999	EndDeclTypeSpec();
6000	}
6001
6002	bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
6003	auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};
6004	const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};
6005	if (!type) {
6006	return false;
6007	}
6008	const DerivedTypeSpec *spec{type->AsDerived()};
6009	const Scope *typeScope{spec ? spec->scope() : nullptr};
6010	if (!typeScope) {
6011	return false;
6012	}
6013
6014	// N.B C7102 is implicitly enforced by having inaccessible types not
6015	// being found in resolution.
6016	// More constraints are enforced in expression.cpp so that they
6017	// can apply to structure constructors that have been converted
6018	// from misparsed function references.
6019	for (const auto &component :
6020	std::get<std::list<parser::ComponentSpec>>(x.t)) {
6021	// Visit the component spec expression, but not the keyword, since
6022	// we need to resolve its symbol in the scope of the derived type.
6023	Walk(std::get<parser::ComponentDataSource>(component.t));
6024	if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
6025	FindInTypeOrParents(*typeScope, kw->v);
6026	}
6027	}
6028	return false;
6029	}
6030
6031	bool DeclarationVisitor::Pre(const parser::BasedPointer &) {
6032	BeginArraySpec();
6033	return true;
6034	}
6035
6036	void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
6037	const parser::ObjectName &pointerName{std::get<0>(bp.t)};
6038	auto *pointer{FindSymbol(pointerName)};
6039	if (!pointer) {
6040	pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
6041	} else if (!ConvertToObjectEntity(symbol&: *pointer)) {
6042	SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
6043	} else if (IsNamedConstant(*pointer)) {
6044	SayWithDecl(pointerName, *pointer,
6045	"'%s' is a named constant and may not be a Cray pointer"_err_en_US);
6046	} else if (pointer->Rank() > 0) {
6047	SayWithDecl(
6048	pointerName, *pointer, "Cray pointer '%s' must be a scalar"_err_en_US);
6049	} else if (pointer->test(Symbol::Flag::CrayPointee)) {
6050	Say(pointerName,
6051	"'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
6052	}
6053	pointer->set(Symbol::Flag::CrayPointer);
6054	const DeclTypeSpec &pointerType{MakeNumericType(
6055	TypeCategory::Integer, context().defaultKinds().subscriptIntegerKind())};
6056	const auto *type{pointer->GetType()};
6057	if (!type) {
6058	pointer->SetType(pointerType);
6059	} else if (*type != pointerType) {
6060	Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
6061	pointerName.source, pointerType.AsFortran());
6062	}
6063	const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
6064	DeclareObjectEntity(pointeeName);
6065	if (Symbol * pointee{pointeeName.symbol}) {
6066	if (!ConvertToObjectEntity(*pointee)) {
6067	return;
6068	}
6069	if (IsNamedConstant(*pointee)) {
6070	Say(pointeeName,
6071	"'%s' is a named constant and may not be a Cray pointee"_err_en_US);
6072	return;
6073	}
6074	if (pointee->test(Symbol::Flag::CrayPointer)) {
6075	Say(pointeeName,
6076	"'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
6077	} else if (pointee->test(Symbol::Flag::CrayPointee)) {
6078	Say(pointeeName, "'%s' was already declared as a Cray pointee"_err_en_US);
6079	} else {
6080	pointee->set(Symbol::Flag::CrayPointee);
6081	}
6082	if (const auto *pointeeType{pointee->GetType()}) {
6083	if (const auto *derived{pointeeType->AsDerived()}) {
6084	if (!IsSequenceOrBindCType(derived)) {
6085	Say(pointeeName,
6086	"Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US);
6087	}
6088	}
6089	}
6090	currScope().add_crayPointer(pointeeName.source, *pointer);
6091	}
6092	}
6093
6094	bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
6095	if (!CheckNotInBlock(stmt: "NAMELIST")) { // C1107
6096	return false;
6097	}
6098	const auto &groupName{std::get<parser::Name>(x.t)};
6099	auto *groupSymbol{FindInScope(groupName)};
6100	if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) {
6101	groupSymbol = &MakeSymbol(groupName, NamelistDetails{});
6102	groupSymbol->ReplaceName(groupName.source);
6103	}
6104	// Name resolution of group items is deferred to FinishNamelists()
6105	// so that host association is handled correctly.
6106	GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x);
6107	return false;
6108	}
6109
6110	void DeclarationVisitor::FinishNamelists() {
6111	if (auto *deferred{GetDeferredDeclarationState()}) {
6112	for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) {
6113	if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) {
6114	if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) {
6115	for (const auto &name : std::get<std::list<parser::Name>>(group->t)) {
6116	auto *symbol{FindSymbol(name)};
6117	if (!symbol) {
6118	symbol = &MakeSymbol(name, ObjectEntityDetails{});
6119	ApplyImplicitRules(*symbol);
6120	} else if (!ConvertToObjectEntity(symbol->GetUltimate())) {
6121	SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
6122	context().SetError(*groupSymbol);
6123	}
6124	symbol->GetUltimate().set(Symbol::Flag::InNamelist);
6125	details->add_object(*symbol);
6126	}
6127	}
6128	}
6129	}
6130	deferred->namelistGroups.clear();
6131	}
6132	}
6133
6134	bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {
6135	if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
6136	auto *symbol{FindSymbol(*name)};
6137	if (!symbol) {
6138	Say(*name, "Namelist group '%s' not found"_err_en_US);
6139	} else if (!symbol->GetUltimate().has<NamelistDetails>()) {
6140	SayWithDecl(
6141	*name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
6142	}
6143	}
6144	return true;
6145	}
6146
6147	bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {
6148	CheckNotInBlock(stmt: "COMMON"); // C1107
6149	return true;
6150	}
6151
6152	bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {
6153	BeginArraySpec();
6154	return true;
6155	}
6156
6157	void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {
6158	const auto &name{std::get<parser::Name>(x.t)};
6159	DeclareObjectEntity(name);
6160	auto pair{specPartState_.commonBlockObjects.insert(name.source)};
6161	if (!pair.second) {
6162	const SourceName &prev{*pair.first};
6163	Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,
6164	"Previous occurrence of '%s' in a COMMON block"_en_US);
6165	}
6166	}
6167
6168	bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {
6169	// save equivalence sets to be processed after specification part
6170	if (CheckNotInBlock(stmt: "EQUIVALENCE")) { // C1107
6171	for (const std::list<parser::EquivalenceObject> &set : x.v) {
6172	specPartState_.equivalenceSets.push_back(&set);
6173	}
6174	}
6175	return false; // don't implicitly declare names yet
6176	}
6177
6178	void DeclarationVisitor::CheckEquivalenceSets() {
6179	EquivalenceSets equivSets{context()};
6180	inEquivalenceStmt_ = true;
6181	for (const auto *set : specPartState_.equivalenceSets) {
6182	const auto &source{set->front().v.value().source};
6183	if (set->size() <= 1) { // R871
6184	Say(source, "Equivalence set must have more than one object"_err_en_US);
6185	}
6186	for (const parser::EquivalenceObject &object : *set) {
6187	const auto &designator{object.v.value()};
6188	// The designator was not resolved when it was encountered so do it now.
6189	// AnalyzeExpr causes array sections to be changed to substrings as needed
6190	Walk(designator);
6191	if (AnalyzeExpr(context(), designator)) {
6192	equivSets.AddToSet(designator);
6193	}
6194	}
6195	equivSets.FinishSet(source);
6196	}
6197	inEquivalenceStmt_ = false;
6198	for (auto &set : equivSets.sets()) {
6199	if (!set.empty()) {
6200	currScope().add_equivalenceSet(std::move(set));
6201	}
6202	}
6203	specPartState_.equivalenceSets.clear();
6204	}
6205
6206	bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {
6207	if (x.v.empty()) {
6208	specPartState_.saveInfo.saveAll = currStmtSource();
6209	currScope().set_hasSAVE();
6210	} else {
6211	for (const parser::SavedEntity &y : x.v) {
6212	auto kind{std::get<parser::SavedEntity::Kind>(y.t)};
6213	const auto &name{std::get<parser::Name>(y.t)};
6214	if (kind == parser::SavedEntity::Kind::Common) {
6215	MakeCommonBlockSymbol(name);
6216	AddSaveName(specPartState_.saveInfo.commons, name.source);
6217	} else {
6218	HandleAttributeStmt(Attr::SAVE, name);
6219	}
6220	}
6221	}
6222	return false;
6223	}
6224
6225	void DeclarationVisitor::CheckSaveStmts() {
6226	for (const SourceName &name : specPartState_.saveInfo.entities) {
6227	auto *symbol{FindInScope(name)};
6228	if (!symbol) {
6229	// error was reported
6230	} else if (specPartState_.saveInfo.saveAll) {
6231	// C889 - note that pgi, ifort, xlf do not enforce this constraint
6232	Say2(name,
6233	"Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US,
6234	*specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US);
6235	} else if (!IsSaved(*symbol)) {
6236	SetExplicitAttr(*symbol, Attr::SAVE);
6237	}
6238	}
6239	for (const SourceName &name : specPartState_.saveInfo.commons) {
6240	if (auto *symbol{currScope().FindCommonBlock(name)}) {
6241	auto &objects{symbol->get<CommonBlockDetails>().objects()};
6242	if (objects.empty()) {
6243	if (currScope().kind() != Scope::Kind::BlockConstruct) {
6244	Say(name,
6245	"'%s' appears as a COMMON block in a SAVE statement but not in"
6246	" a COMMON statement"_err_en_US);
6247	} else { // C1108
6248	Say(name,
6249	"SAVE statement in BLOCK construct may not contain a"
6250	" common block name '%s'"_err_en_US);
6251	}
6252	} else {
6253	for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
6254	if (!IsSaved(*object)) {
6255	SetImplicitAttr(*object, Attr::SAVE);
6256	}
6257	}
6258	}
6259	}
6260	}
6261	specPartState_.saveInfo = {};
6262	}
6263
6264	// Record SAVEd names in specPartState_.saveInfo.entities.
6265	Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) {
6266	if (attrs.test(Attr::SAVE)) {
6267	AddSaveName(specPartState_.saveInfo.entities, name);
6268	}
6269	return attrs;
6270	}
6271
6272	// Record a name in a set of those to be saved.
6273	void DeclarationVisitor::AddSaveName(
6274	std::set<SourceName> &set, const SourceName &name) {
6275	auto pair{set.insert(x: name)};
6276	if (!pair.second) {
6277	Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US,
6278	*pair.first, "Previous specification of SAVE attribute"_en_US);
6279	}
6280	}
6281
6282	// Check types of common block objects, now that they are known.
6283	void DeclarationVisitor::CheckCommonBlocks() {
6284	// check for empty common blocks
6285	for (const auto &pair : currScope().commonBlocks()) {
6286	const auto &symbol{*pair.second};
6287	if (symbol.get<CommonBlockDetails>().objects().empty() &&
6288	symbol.attrs().test(Attr::BIND_C)) {
6289	Say(symbol.name(),
6290	"'%s' appears as a COMMON block in a BIND statement but not in"
6291	" a COMMON statement"_err_en_US);
6292	}
6293	}
6294	// check objects in common blocks
6295	for (const auto &name : specPartState_.commonBlockObjects) {
6296	const auto *symbol{currScope().FindSymbol(name)};
6297	if (!symbol) {
6298	continue;
6299	}
6300	const auto &attrs{symbol->attrs()};
6301	if (attrs.test(Attr::ALLOCATABLE)) {
6302	Say(name,
6303	"ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
6304	} else if (attrs.test(Attr::BIND_C)) {
6305	Say(name,
6306	"Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
6307	} else if (IsNamedConstant(*symbol)) {
6308	Say(name,
6309	"A named constant '%s' may not appear in a COMMON block"_err_en_US);
6310	} else if (IsDummy(*symbol)) {
6311	Say(name,
6312	"Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
6313	} else if (symbol->IsFuncResult()) {
6314	Say(name,
6315	"Function result '%s' may not appear in a COMMON block"_err_en_US);
6316	} else if (const DeclTypeSpec * type{symbol->GetType()}) {
6317	if (type->category() == DeclTypeSpec::ClassStar) {
6318	Say(name,
6319	"Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US);
6320	} else if (const auto *derived{type->AsDerived()}) {
6321	if (!IsSequenceOrBindCType(derived)) {
6322	Say(name,
6323	"Derived type '%s' in COMMON block must have the BIND or"
6324	" SEQUENCE attribute"_err_en_US);
6325	}
6326	UnorderedSymbolSet typeSet;
6327	CheckCommonBlockDerivedType(name, derived->typeSymbol(), typeSet);
6328	}
6329	}
6330	}
6331	specPartState_.commonBlockObjects = {};
6332	}
6333
6334	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
6335	return Resolve(name, currScope().MakeCommonBlock(name.source));
6336	}
6337	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
6338	const std::optional<parser::Name> &name) {
6339	if (name) {
6340	return MakeCommonBlockSymbol(name: *name);
6341	} else {
6342	return MakeCommonBlockSymbol(name: parser::Name{});
6343	}
6344	}
6345
6346	bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
6347	return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
6348	}
6349
6350	// Check if this derived type can be in a COMMON block.
6351	void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name,
6352	const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) {
6353	if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) {
6354	return;
6355	}
6356	typeSet.emplace(typeSymbol);
6357	if (const auto *scope{typeSymbol.scope()}) {
6358	for (const auto &pair : *scope) {
6359	const Symbol &component{*pair.second};
6360	if (component.attrs().test(Attr::ALLOCATABLE)) {
6361	Say2(name,
6362	"Derived type variable '%s' may not appear in a COMMON block"
6363	" due to ALLOCATABLE component"_err_en_US,
6364	component.name(), "Component with ALLOCATABLE attribute"_en_US);
6365	return;
6366	}
6367	const auto *details{component.detailsIf<ObjectEntityDetails>()};
6368	if (component.test(Symbol::Flag::InDataStmt) ||
6369	(details && details->init())) {
6370	Say2(name,
6371	"Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
6372	component.name(), "Component with default initialization"_en_US);
6373	return;
6374	}
6375	if (details) {
6376	if (const auto *type{details->type()}) {
6377	if (const auto *derived{type->AsDerived()}) {
6378	const Symbol &derivedTypeSymbol{derived->typeSymbol()};
6379	CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet);
6380	}
6381	}
6382	}
6383	}
6384	}
6385	}
6386
6387	bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
6388	const parser::Name &name) {
6389	if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
6390	name.source.ToString())}) {
6391	// Unrestricted specific intrinsic function names (e.g., "cos")
6392	// are acceptable as procedure interfaces. The presence of the
6393	// INTRINSIC flag will cause this symbol to have a complete interface
6394	// recreated for it later on demand, but capturing its result type here
6395	// will make GetType() return a correct result without having to
6396	// probe the intrinsics table again.
6397	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
6398	SetImplicitAttr(symbol, Attr::INTRINSIC);
6399	CHECK(interface->functionResult.has_value());
6400	evaluate::DynamicType dyType{
6401	DEREF(interface->functionResult->GetTypeAndShape()).type()};
6402	CHECK(common::IsNumericTypeCategory(dyType.category()));
6403	const DeclTypeSpec &typeSpec{
6404	MakeNumericType(dyType.category(), dyType.kind())};
6405	ProcEntityDetails details;
6406	details.set_type(typeSpec);
6407	symbol.set_details(std::move(details));
6408	symbol.set(Symbol::Flag::Function);
6409	if (interface->IsElemental()) {
6410	SetExplicitAttr(symbol, Attr::ELEMENTAL);
6411	}
6412	if (interface->IsPure()) {
6413	SetExplicitAttr(symbol, Attr::PURE);
6414	}
6415	Resolve(name, symbol);
6416	return true;
6417	} else {
6418	return false;
6419	}
6420	}
6421
6422	// Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED
6423	bool DeclarationVisitor::PassesSharedLocalityChecks(
6424	const parser::Name &name, Symbol &symbol) {
6425	if (!IsVariableName(symbol)) {
6426	SayLocalMustBeVariable(name, symbol); // C1124
6427	return false;
6428	}
6429	if (symbol.owner() == currScope()) { // C1125 and C1126
6430	SayAlreadyDeclared(name, symbol);
6431	return false;
6432	}
6433	return true;
6434	}
6435
6436	// Checks for locality-specs LOCAL and LOCAL_INIT
6437	bool DeclarationVisitor::PassesLocalityChecks(
6438	const parser::Name &name, Symbol &symbol) {
6439	if (IsAllocatable(symbol)) { // C1128
6440	SayWithDecl(name, symbol,
6441	"ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US);
6442	return false;
6443	}
6444	if (IsOptional(symbol)) { // C1128
6445	SayWithDecl(name, symbol,
6446	"OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
6447	return false;
6448	}
6449	if (IsIntentIn(symbol)) { // C1128
6450	SayWithDecl(name, symbol,
6451	"INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
6452	return false;
6453	}
6454	if (IsFinalizable(symbol)) { // C1128
6455	SayWithDecl(name, symbol,
6456	"Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
6457	return false;
6458	}
6459	if (evaluate::IsCoarray(symbol)) { // C1128
6460	SayWithDecl(
6461	name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US);
6462	return false;
6463	}
6464	if (const DeclTypeSpec * type{symbol.GetType()}) {
6465	if (type->IsPolymorphic() && IsDummy(symbol) &&
6466	!IsPointer(symbol)) { // C1128
6467	SayWithDecl(name, symbol,
6468	"Nonpointer polymorphic argument '%s' not allowed in a "
6469	"locality-spec"_err_en_US);
6470	return false;
6471	}
6472	}
6473	if (IsAssumedSizeArray(symbol)) { // C1128
6474	SayWithDecl(name, symbol,
6475	"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
6476	return false;
6477	}
6478	if (std::optional<Message> whyNot{WhyNotDefinable(
6479	name.source, currScope(), DefinabilityFlags{}, symbol)}) {
6480	SayWithReason(name, symbol,
6481	"'%s' may not appear in a locality-spec because it is not "
6482	"definable"_err_en_US,
6483	std::move(*whyNot));
6484	return false;
6485	}
6486	return PassesSharedLocalityChecks(name, symbol);
6487	}
6488
6489	Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
6490	const parser::Name &name) {
6491	Symbol *prev{FindSymbol(name)};
6492	if (!prev) {
6493	// Declare the name as an object in the enclosing scope so that
6494	// the name can't be repurposed there later as something else.
6495	prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
6496	ConvertToObjectEntity(*prev);
6497	ApplyImplicitRules(*prev);
6498	}
6499	return *prev;
6500	}
6501
6502	Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
6503	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
6504	if (!PassesLocalityChecks(name, symbol&: prev)) {
6505	return nullptr;
6506	}
6507	return &MakeHostAssocSymbol(name, prev);
6508	}
6509
6510	Symbol *DeclarationVisitor::DeclareStatementEntity(
6511	const parser::DoVariable &doVar,
6512	const std::optional<parser::IntegerTypeSpec> &type) {
6513	const parser::Name &name{doVar.thing.thing};
6514	const DeclTypeSpec *declTypeSpec{nullptr};
6515	if (auto *prev{FindSymbol(name)}) {
6516	if (prev->owner() == currScope()) {
6517	SayAlreadyDeclared(name, *prev);
6518	return nullptr;
6519	}
6520	name.symbol = nullptr;
6521	declTypeSpec = prev->GetType();
6522	}
6523	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
6524	if (!symbol.has<ObjectEntityDetails>()) {
6525	return nullptr; // error was reported in DeclareEntity
6526	}
6527	if (type) {
6528	declTypeSpec = ProcessTypeSpec(*type);
6529	}
6530	if (declTypeSpec) {
6531	// Subtlety: Don't let a "*length" specifier (if any is pending) affect the
6532	// declaration of this implied DO loop control variable.
6533	auto restorer{
6534	common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};
6535	SetType(name, *declTypeSpec);
6536	} else {
6537	ApplyImplicitRules(symbol);
6538	}
6539	Symbol *result{Resolve(name, &symbol)};
6540	AnalyzeExpr(context(), doVar); // enforce INTEGER type
6541	return result;
6542	}
6543
6544	// Set the type of an entity or report an error.
6545	void DeclarationVisitor::SetType(
6546	const parser::Name &name, const DeclTypeSpec &type) {
6547	CHECK(name.symbol);
6548	auto &symbol{*name.symbol};
6549	if (charInfo_.length) { // Declaration has "*length" (R723)
6550	auto length{std::move(*charInfo_.length)};
6551	charInfo_.length.reset();
6552	if (type.category() == DeclTypeSpec::Character) {
6553	auto kind{type.characterTypeSpec().kind()};
6554	// Recurse with correct type.
6555	SetType(name,
6556	currScope().MakeCharacterType(std::move(length), std::move(kind)));
6557	return;
6558	} else { // C753
6559	Say(name,
6560	"A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
6561	}
6562	}
6563	if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
6564	if (proc->procInterface()) {
6565	Say(name,
6566	"'%s' has an explicit interface and may not also have a type"_err_en_US);
6567	context().SetError(symbol);
6568	return;
6569	}
6570	}
6571	auto *prevType{symbol.GetType()};
6572	if (!prevType) {
6573	if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType() &&
6574	context().ShouldWarn(
6575	common::LanguageFeature::ForwardRefImplicitNoneData)) {
6576	Say(name,
6577	"'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US);
6578	}
6579	symbol.SetType(type);
6580	} else if (symbol.has<UseDetails>()) {
6581	// error recovery case, redeclaration of use-associated name
6582	} else if (HadForwardRef(symbol: symbol)) {
6583	// error recovery after use of host-associated name
6584	} else if (!symbol.test(Symbol::Flag::Implicit)) {
6585	SayWithDecl(
6586	name, symbol, "The type of '%s' has already been declared"_err_en_US);
6587	context().SetError(symbol);
6588	} else if (type != *prevType) {
6589	SayWithDecl(name, symbol,
6590	"The type of '%s' has already been implicitly declared"_err_en_US);
6591	context().SetError(symbol);
6592	} else {
6593	symbol.set(Symbol::Flag::Implicit, false);
6594	}
6595	}
6596
6597	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
6598	const parser::Name &name) {
6599	Scope &outer{NonDerivedTypeScope()};
6600	Symbol *symbol{FindSymbol(outer, name)};
6601	Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
6602	auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
6603	if (generic) {
6604	if (Symbol * genDT{generic->derivedType()}) {
6605	symbol = genDT;
6606	generic = nullptr;
6607	}
6608	}
6609	if (!symbol || symbol->has<UnknownDetails>() ||
6610	(generic && &ultimate->owner() == &outer)) {
6611	if (allowForwardReferenceToDerivedType()) {
6612	if (!symbol) {
6613	symbol = &MakeSymbol(outer, name.source, Attrs{});
6614	Resolve(name, *symbol);
6615	} else if (generic) {
6616	// forward ref to type with later homonymous generic
6617	symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
6618	generic->set_derivedType(*symbol);
6619	name.symbol = symbol;
6620	}
6621	DerivedTypeDetails details;
6622	details.set_isForwardReferenced(true);
6623	symbol->set_details(std::move(details));
6624	} else { // C732
6625	Say(name, "Derived type '%s' not found"_err_en_US);
6626	return std::nullopt;
6627	}
6628	} else if (&DEREF(symbol).owner() != &outer &&
6629	!ultimate->has<GenericDetails>()) {
6630	// Prevent a later declaration in this scope of a host-associated
6631	// type name.
6632	outer.add_importName(name.source);
6633	}
6634	if (CheckUseError(name)) {
6635	return std::nullopt;
6636	}
6637	symbol = &symbol->GetUltimate();
6638	if (symbol->has<DerivedTypeDetails>()) {
6639	return DerivedTypeSpec{name.source, *symbol};
6640	} else {
6641	Say(name, "'%s' is not a derived type"_err_en_US);
6642	return std::nullopt;
6643	}
6644	}
6645
6646	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
6647	const parser::Name &typeName, const parser::Name *extendsName) {
6648	if (!extendsName) {
6649	return std::nullopt;
6650	} else if (typeName.source == extendsName->source) {
6651	Say(extendsName->source,
6652	"Derived type '%s' cannot extend itself"_err_en_US);
6653	return std::nullopt;
6654	} else {
6655	return ResolveDerivedType(*extendsName);
6656	}
6657	}
6658
6659	Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
6660	// The symbol is checked later by CheckExplicitInterface() and
6661	// CheckBindings(). It can be a forward reference.
6662	if (!NameIsKnownOrIntrinsic(name)) {
6663	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
6664	Resolve(name, symbol);
6665	}
6666	return name.symbol;
6667	}
6668
6669	void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
6670	if (const Symbol * symbol{name.symbol}) {
6671	const Symbol &ultimate{symbol->GetUltimate()};
6672	if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
6673	!BypassGeneric(ultimate).HasExplicitInterface()) {
6674	Say(name,
6675	"'%s' must be an abstract interface or a procedure with an explicit interface"_err_en_US,
6676	symbol->name());
6677	}
6678	}
6679	}
6680
6681	// Create a symbol for a type parameter, component, or procedure binding in
6682	// the current derived type scope. Return false on error.
6683	Symbol *DeclarationVisitor::MakeTypeSymbol(
6684	const parser::Name &name, Details &&details) {
6685	return Resolve(name, MakeTypeSymbol(name.source, std::move(details)));
6686	}
6687	Symbol *DeclarationVisitor::MakeTypeSymbol(
6688	const SourceName &name, Details &&details) {
6689	Scope &derivedType{currScope()};
6690	CHECK(derivedType.IsDerivedType());
6691	if (auto *symbol{FindInScope(derivedType, name)}) { // C742
6692	Say2(name,
6693	"Type parameter, component, or procedure binding '%s'"
6694	" already defined in this type"_err_en_US,
6695	*symbol, "Previous definition of '%s'"_en_US);
6696	return nullptr;
6697	} else {
6698	auto attrs{GetAttrs()};
6699	// Apply binding-private-stmt if present and this is a procedure binding
6700	if (derivedTypeInfo_.privateBindings &&
6701	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
6702	std::holds_alternative<ProcBindingDetails>(details)) {
6703	attrs.set(Attr::PRIVATE);
6704	}
6705	Symbol &result{MakeSymbol(name, attrs, std::move(details))};
6706	SetCUDADataAttr(name, result, cudaDataAttr());
6707	if (result.has<TypeParamDetails>()) {
6708	derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result);
6709	}
6710	return &result;
6711	}
6712	}
6713
6714	// Return true if it is ok to declare this component in the current scope.
6715	// Otherwise, emit an error and return false.
6716	bool DeclarationVisitor::OkToAddComponent(
6717	const parser::Name &name, const Symbol *extends) {
6718	for (const Scope *scope{&currScope()}; scope;) {
6719	CHECK(scope->IsDerivedType());
6720	if (auto *prev{FindInScope(*scope, name.source)}) {
6721	std::optional<parser::MessageFixedText> msg;
6722	if (context().HasError(*prev)) { // don't pile on
6723	} else if (extends) {
6724	msg = "Type cannot be extended as it has a component named"
6725	" '%s'"_err_en_US;
6726	} else if (CheckAccessibleSymbol(currScope(), *prev)) {
6727	// inaccessible component -- redeclaration is ok
6728	msg = "Component '%s' is inaccessibly declared in or as a "
6729	"parent of this derived type"_warn_en_US;
6730	} else if (prev->test(Symbol::Flag::ParentComp)) {
6731	msg = "'%s' is a parent type of this type and so cannot be"
6732	" a component"_err_en_US;
6733	} else if (scope == &currScope()) {
6734	msg = "Component '%s' is already declared in this"
6735	" derived type"_err_en_US;
6736	} else {
6737	msg = "Component '%s' is already declared in a parent of this"
6738	" derived type"_err_en_US;
6739	}
6740	if (msg) {
6741	Say2(
6742	name, std::move(*msg), *prev, "Previous declaration of '%s'"_en_US);
6743	if (msg->severity() == parser::Severity::Error) {
6744	Resolve(name, *prev);
6745	return false;
6746	}
6747	}
6748	}
6749	if (scope == &currScope() && extends) {
6750	// The parent component has not yet been added to the scope.
6751	scope = extends->scope();
6752	} else {
6753	scope = scope->GetDerivedTypeParent();
6754	}
6755	}
6756	return true;
6757	}
6758
6759	ParamValue DeclarationVisitor::GetParamValue(
6760	const parser::TypeParamValue &x, common::TypeParamAttr attr) {
6761	return common::visit(
6762	common::visitors{
6763	[=](const parser::ScalarIntExpr &x) { // C704
6764	return ParamValue{EvaluateIntExpr(x), attr};
6765	},
6766	[=](const parser::Star &) { return ParamValue::Assumed(attr); },
6767	[=](const parser::TypeParamValue::Deferred &) {
6768	return ParamValue::Deferred(attr);
6769	},
6770	},
6771	x.u);
6772	}
6773
6774	// ConstructVisitor implementation
6775
6776	void ConstructVisitor::ResolveIndexName(
6777	const parser::ConcurrentControl &control) {
6778	const parser::Name &name{std::get<parser::Name>(control.t)};
6779	auto *prev{FindSymbol(name)};
6780	if (prev) {
6781	if (prev->owner() == currScope()) {
6782	SayAlreadyDeclared(name, *prev);
6783	return;
6784	} else if (prev->owner().kind() == Scope::Kind::Forall &&
6785	context().ShouldWarn(
6786	common::LanguageFeature::OddIndexVariableRestrictions)) {
6787	SayWithDecl(name, *prev,
6788	"Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US);
6789	}
6790	name.symbol = nullptr;
6791	}
6792	auto &symbol{DeclareObjectEntity(name)};
6793	if (symbol.GetType()) {
6794	// type came from explicit type-spec
6795	} else if (!prev) {
6796	ApplyImplicitRules(symbol&: symbol);
6797	} else {
6798	// Odd rules in F'2023 19.4 paras 6 & 8.
6799	Symbol &prevRoot{prev->GetUltimate()};
6800	if (const auto *type{prevRoot.GetType()}) {
6801	symbol.SetType(*type);
6802	} else {
6803	ApplyImplicitRules(symbol&: symbol);
6804	}
6805	if (prevRoot.has<ObjectEntityDetails>() ||
6806	ConvertToObjectEntity(prevRoot)) {
6807	if (prevRoot.IsObjectArray() &&
6808	context().ShouldWarn(
6809	common::LanguageFeature::OddIndexVariableRestrictions)) {
6810	SayWithDecl(name, *prev,
6811	"Index variable '%s' should be scalar in the enclosing scope"_port_en_US);
6812	}
6813	} else if (!prevRoot.has<CommonBlockDetails>() &&
6814	context().ShouldWarn(
6815	common::LanguageFeature::OddIndexVariableRestrictions)) {
6816	SayWithDecl(name, *prev,
6817	"Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US);
6818	}
6819	}
6820	EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
6821	}
6822
6823	// We need to make sure that all of the index-names get declared before the
6824	// expressions in the loop control are evaluated so that references to the
6825	// index-names in the expressions are correctly detected.
6826	bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
6827	BeginDeclTypeSpec();
6828	Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t));
6829	const auto &controls{
6830	std::get<std::list<parser::ConcurrentControl>>(header.t)};
6831	for (const auto &control : controls) {
6832	ResolveIndexName(control);
6833	}
6834	Walk(controls);
6835	Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t));
6836	EndDeclTypeSpec();
6837	return false;
6838	}
6839
6840	bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
6841	for (auto &name : x.v) {
6842	if (auto *symbol{DeclareLocalEntity(name)}) {
6843	symbol->set(Symbol::Flag::LocalityLocal);
6844	}
6845	}
6846	return false;
6847	}
6848
6849	bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
6850	for (auto &name : x.v) {
6851	if (auto *symbol{DeclareLocalEntity(name)}) {
6852	symbol->set(Symbol::Flag::LocalityLocalInit);
6853	}
6854	}
6855	return false;
6856	}
6857
6858	bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
6859	for (const auto &name : x.v) {
6860	if (!FindSymbol(name)) {
6861	Say(name,
6862	"Variable '%s' with SHARED locality implicitly declared"_warn_en_US);
6863	}
6864	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
6865	if (PassesSharedLocalityChecks(name, prev)) {
6866	MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);
6867	}
6868	}
6869	return false;
6870	}
6871
6872	bool ConstructVisitor::Pre(const parser::AcSpec &x) {
6873	ProcessTypeSpec(x.type);
6874	Walk(x.values);
6875	return false;
6876	}
6877
6878	// Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the
6879	// enclosing ac-implied-do
6880	bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
6881	auto &values{std::get<std::list<parser::AcValue>>(x.t)};
6882	auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
6883	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
6884	auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
6885	// F'2018 has the scope of the implied DO variable covering the entire
6886	// implied DO production (19.4(5)), which seems wrong in cases where the name
6887	// of the implied DO variable appears in one of the bound expressions. Thus
6888	// this extension, which shrinks the scope of the variable to exclude the
6889	// expressions in the bounds.
6890	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
6891	Walk(bounds.lower);
6892	Walk(bounds.upper);
6893	Walk(bounds.step);
6894	EndCheckOnIndexUseInOwnBounds(restore: restore);
6895	PushScope(Scope::Kind::ImpliedDos, nullptr);
6896	DeclareStatementEntity(bounds.name, type);
6897	Walk(values);
6898	PopScope();
6899	return false;
6900	}
6901
6902	bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
6903	auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
6904	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
6905	auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
6906	// See comment in Pre(AcImpliedDo) above.
6907	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
6908	Walk(bounds.lower);
6909	Walk(bounds.upper);
6910	Walk(bounds.step);
6911	EndCheckOnIndexUseInOwnBounds(restore: restore);
6912	bool pushScope{currScope().kind() != Scope::Kind::ImpliedDos};
6913	if (pushScope) {
6914	PushScope(Scope::Kind::ImpliedDos, nullptr);
6915	}
6916	DeclareStatementEntity(bounds.name, type);
6917	Walk(objects);
6918	if (pushScope) {
6919	PopScope();
6920	}
6921	return false;
6922	}
6923
6924	// Sets InDataStmt flag on a variable (or misidentified function) in a DATA
6925	// statement so that the predicate IsInitialized() will be true
6926	// during semantic analysis before the symbol's initializer is constructed.
6927	bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {
6928	common::visit(
6929	common::visitors{
6930	[&](const parser::Scalar<Indirection<parser::Designator>> &y) {
6931	Walk(y.thing.value());
6932	const parser::Name &first{parser::GetFirstName(y.thing.value())};
6933	if (first.symbol) {
6934	first.symbol->set(Symbol::Flag::InDataStmt);
6935	}
6936	},
6937	[&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); },
6938	},
6939	x.u);
6940	return false;
6941	}
6942
6943	bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
6944	// Subtle: DATA statements may appear in both the specification and
6945	// execution parts, but should be treated as if in the execution part
6946	// for purposes of implicit variable declaration vs. host association.
6947	// When a name first appears as an object in a DATA statement, it should
6948	// be implicitly declared locally as if it had been assigned.
6949	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
6950	common::visit(common::visitors{
6951	[&](const Indirection<parser::Variable> &y) {
6952	auto restorer{
6953	common::ScopedSet(deferImplicitTyping_, true)};
6954	Walk(y.value());
6955	const parser::Name &first{
6956	parser::GetFirstName(y.value())};
6957	if (first.symbol) {
6958	first.symbol->set(Symbol::Flag::InDataStmt);
6959	}
6960	},
6961	[&](const parser::DataImpliedDo &y) {
6962	PushScope(Scope::Kind::ImpliedDos, nullptr);
6963	Walk(y);
6964	PopScope();
6965	},
6966	},
6967	x.u);
6968	return false;
6969	}
6970
6971	bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
6972	const auto &data{std::get<parser::DataStmtConstant>(x.t)};
6973	auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
6974	if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
6975	if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {
6976	if (const Symbol * symbol{FindSymbol(*name)}) {
6977	const Symbol &ultimate{symbol->GetUltimate()};
6978	if (ultimate.has<DerivedTypeDetails>()) {
6979	mutableData.u = elem->ConvertToStructureConstructor(
6980	DerivedTypeSpec{name->source, ultimate});
6981	}
6982	}
6983	}
6984	}
6985	return true;
6986	}
6987
6988	bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
6989	if (x.IsDoConcurrent()) {
6990	// The new scope has Kind::Forall for index variable name conflict
6991	// detection with nested FORALL/DO CONCURRENT constructs in
6992	// ResolveIndexName().
6993	PushScope(Scope::Kind::Forall, nullptr);
6994	}
6995	return true;
6996	}
6997	void ConstructVisitor::Post(const parser::DoConstruct &x) {
6998	if (x.IsDoConcurrent()) {
6999	PopScope();
7000	}
7001	}
7002
7003	bool ConstructVisitor::Pre(const parser::ForallConstruct &) {
7004	PushScope(Scope::Kind::Forall, nullptr);
7005	return true;
7006	}
7007	void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }
7008	bool ConstructVisitor::Pre(const parser::ForallStmt &) {
7009	PushScope(Scope::Kind::Forall, nullptr);
7010	return true;
7011	}
7012	void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }
7013
7014	bool ConstructVisitor::Pre(const parser::BlockConstruct &x) {
7015	const auto &[blockStmt, specPart, execPart, endBlockStmt] = x.t;
7016	Walk(blockStmt);
7017	CheckDef(blockStmt.statement.v);
7018	PushScope(Scope::Kind::BlockConstruct, nullptr);
7019	Walk(specPart);
7020	HandleImpliedAsynchronousInScope(execPart);
7021	Walk(execPart);
7022	Walk(endBlockStmt);
7023	PopScope();
7024	CheckRef(endBlockStmt.statement.v);
7025	return false;
7026	}
7027
7028	void ConstructVisitor::Post(const parser::Selector &x) {
7029	GetCurrentAssociation().selector = ResolveSelector(x);
7030	}
7031
7032	void ConstructVisitor::Post(const parser::AssociateStmt &x) {
7033	CheckDef(x.t);
7034	PushScope(Scope::Kind::OtherConstruct, nullptr);
7035	const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()};
7036	for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) {
7037	SetCurrentAssociation(nthLastAssoc);
7038	if (auto *symbol{MakeAssocEntity()}) {
7039	if (ExtractCoarrayRef(GetCurrentAssociation().selector.expr)) { // C1103
7040	Say("Selector must not be a coindexed object"_err_en_US);
7041	}
7042	SetTypeFromAssociation(*symbol);
7043	SetAttrsFromAssociation(*symbol);
7044	}
7045	}
7046	PopAssociation(count: assocCount);
7047	}
7048
7049	void ConstructVisitor::Post(const parser::EndAssociateStmt &x) {
7050	PopScope();
7051	CheckRef(x.v);
7052	}
7053
7054	bool ConstructVisitor::Pre(const parser::Association &x) {
7055	PushAssociation();
7056	const auto &name{std::get<parser::Name>(x.t)};
7057	GetCurrentAssociation().name = &name;
7058	return true;
7059	}
7060
7061	bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) {
7062	CheckDef(x.t);
7063	PushScope(Scope::Kind::OtherConstruct, nullptr);
7064	PushAssociation();
7065	return true;
7066	}
7067
7068	void ConstructVisitor::Post(const parser::CoarrayAssociation &x) {
7069	const auto &decl{std::get<parser::CodimensionDecl>(x.t)};
7070	const auto &name{std::get<parser::Name>(decl.t)};
7071	if (auto *symbol{FindInScope(name)}) {
7072	const auto &selector{std::get<parser::Selector>(x.t)};
7073	if (auto sel{ResolveSelector(selector)}) {
7074	const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)};
7075	if (!whole || whole->Corank() == 0) {
7076	Say(sel.source, // C1116
7077	"Selector in coarray association must name a coarray"_err_en_US);
7078	} else if (auto dynType{sel.expr->GetType()}) {
7079	if (!symbol->GetType()) {
7080	symbol->SetType(ToDeclTypeSpec(std::move(*dynType)));
7081	}
7082	}
7083	}
7084	}
7085	}
7086
7087	void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) {
7088	PopAssociation();
7089	PopScope();
7090	CheckRef(x.t);
7091	}
7092
7093	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) {
7094	PushAssociation();
7095	return true;
7096	}
7097
7098	void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {
7099	PopAssociation();
7100	}
7101
7102	void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
7103	auto &association{GetCurrentAssociation()};
7104	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7105	// This isn't a name in the current scope, it is in each TypeGuardStmt
7106	MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);
7107	association.name = &*name;
7108	if (ExtractCoarrayRef(association.selector.expr)) { // C1103
7109	Say("Selector must not be a coindexed object"_err_en_US);
7110	}
7111	if (association.selector.expr) {
7112	auto exprType{association.selector.expr->GetType()};
7113	if (exprType && !exprType->IsPolymorphic()) { // C1159
7114	Say(association.selector.source,
7115	"Selector '%s' in SELECT TYPE statement must be "
7116	"polymorphic"_err_en_US);
7117	}
7118	}
7119	} else {
7120	if (const Symbol *
7121	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
7122	ConvertToObjectEntity(const_cast<Symbol &>(*whole));
7123	if (!IsVariableName(*whole)) {
7124	Say(association.selector.source, // C901
7125	"Selector is not a variable"_err_en_US);
7126	association = {};
7127	}
7128	if (const DeclTypeSpec * type{whole->GetType()}) {
7129	if (!type->IsPolymorphic()) { // C1159
7130	Say(association.selector.source,
7131	"Selector '%s' in SELECT TYPE statement must be "
7132	"polymorphic"_err_en_US);
7133	}
7134	}
7135	} else {
7136	Say(association.selector.source, // C1157
7137	"Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
7138	association = {};
7139	}
7140	}
7141	}
7142
7143	void ConstructVisitor::Post(const parser::SelectRankStmt &x) {
7144	auto &association{GetCurrentAssociation()};
7145	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7146	// This isn't a name in the current scope, it is in each SelectRankCaseStmt
7147	MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName);
7148	association.name = &*name;
7149	}
7150	}
7151
7152	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {
7153	PushScope(Scope::Kind::OtherConstruct, nullptr);
7154	return true;
7155	}
7156	void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {
7157	PopScope();
7158	}
7159
7160	bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) {
7161	PushScope(Scope::Kind::OtherConstruct, nullptr);
7162	return true;
7163	}
7164	void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) {
7165	PopScope();
7166	}
7167
7168	bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) {
7169	if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) {
7170	// CLASS IS (t)
7171	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
7172	}
7173	return true;
7174	}
7175
7176	void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
7177	if (auto *symbol{MakeAssocEntity()}) {
7178	if (std::holds_alternative<parser::Default>(x.u)) {
7179	SetTypeFromAssociation(*symbol);
7180	} else if (const auto *type{GetDeclTypeSpec()}) {
7181	symbol->SetType(*type);
7182	}
7183	SetAttrsFromAssociation(*symbol);
7184	}
7185	}
7186
7187	void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
7188	if (auto *symbol{MakeAssocEntity()}) {
7189	SetTypeFromAssociation(*symbol);
7190	auto &details{symbol->get<AssocEntityDetails>()};
7191	// Don't call SetAttrsFromAssociation() for SELECT RANK.
7192	Attrs selectorAttrs{
7193	evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
7194	Attrs attrsToKeep{Attr::ASYNCHRONOUS, Attr::TARGET, Attr::VOLATILE};
7195	if (const auto *rankValue{
7196	std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
7197	// RANK(n)
7198	if (auto expr{EvaluateIntExpr(*rankValue)}) {
7199	if (auto val{evaluate::ToInt64(*expr)}) {
7200	details.set_rank(*val);
7201	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
7202	} else {
7203	Say("RANK() expression must be constant"_err_en_US);
7204	}
7205	}
7206	} else if (std::holds_alternative<parser::Star>(x.u)) {
7207	// RANK(*): assumed-size
7208	details.set_IsAssumedSize();
7209	} else {
7210	CHECK(std::holds_alternative<parser::Default>(x.u));
7211	// RANK DEFAULT: assumed-rank
7212	details.set_IsAssumedRank();
7213	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
7214	}
7215	symbol->attrs() |= selectorAttrs & attrsToKeep;
7216	}
7217	}
7218
7219	bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
7220	PushAssociation();
7221	return true;
7222	}
7223
7224	void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
7225	PopAssociation();
7226	}
7227
7228	bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
7229	if (x && !x->symbol) {
7230	// Construct names are not scoped by BLOCK in the standard, but many,
7231	// but not all, compilers do treat them as if they were so scoped.
7232	if (Symbol * inner{FindInScope(currScope(), *x)}) {
7233	SayAlreadyDeclared(*x, *inner);
7234	} else {
7235	if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {
7236	if (Symbol *
7237	other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) {
7238	SayWithDecl(*x, *other,
7239	"The construct name '%s' should be distinct at the subprogram level"_port_en_US);
7240	}
7241	}
7242	MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
7243	}
7244	}
7245	return true;
7246	}
7247
7248	void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
7249	if (x) {
7250	// Just add an occurrence of this name; checking is done in ValidateLabels
7251	FindSymbol(*x);
7252	}
7253	}
7254
7255	// Make a symbol for the associating entity of the current association.
7256	Symbol *ConstructVisitor::MakeAssocEntity() {
7257	Symbol *symbol{nullptr};
7258	auto &association{GetCurrentAssociation()};
7259	if (association.name) {
7260	symbol = &MakeSymbol(*association.name, UnknownDetails{});
7261	if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) {
7262	Say(*association.name, // C1102
7263	"The associate name '%s' is already used in this associate statement"_err_en_US);
7264	return nullptr;
7265	}
7266	} else if (const Symbol *
7267	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
7268	symbol = &MakeSymbol(whole->name());
7269	} else {
7270	return nullptr;
7271	}
7272	if (auto &expr{association.selector.expr}) {
7273	symbol->set_details(AssocEntityDetails{common::Clone(*expr)});
7274	} else {
7275	symbol->set_details(AssocEntityDetails{});
7276	}
7277	return symbol;
7278	}
7279
7280	// Set the type of symbol based on the current association selector.
7281	void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {
7282	auto &details{symbol.get<AssocEntityDetails>()};
7283	const MaybeExpr *pexpr{&details.expr()};
7284	if (!*pexpr) {
7285	pexpr = &GetCurrentAssociation().selector.expr;
7286	}
7287	if (*pexpr) {
7288	const SomeExpr &expr{**pexpr};
7289	if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {
7290	if (const auto *charExpr{
7291	evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>(
7292	expr)}) {
7293	symbol.SetType(ToDeclTypeSpec(std::move(*type),
7294	FoldExpr(common::visit(
7295	[](const auto &kindChar) { return kindChar.LEN(); },
7296	charExpr->u))));
7297	} else {
7298	symbol.SetType(ToDeclTypeSpec(std::move(*type)));
7299	}
7300	} else {
7301	// BOZ literals, procedure designators, &c. are not acceptable
7302	Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);
7303	}
7304	}
7305	}
7306
7307	// If current selector is a variable, set some of its attributes on symbol.
7308	// For ASSOCIATE, CHANGE TEAM, and SELECT TYPE only; not SELECT RANK.
7309	void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
7310	Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
7311	symbol.attrs() |=
7312	attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE};
7313	if (attrs.test(Attr::POINTER)) {
7314	SetImplicitAttr(symbol, Attr::TARGET);
7315	}
7316	}
7317
7318	ConstructVisitor::Selector ConstructVisitor::ResolveSelector(
7319	const parser::Selector &x) {
7320	return common::visit(common::visitors{
7321	[&](const parser::Expr &expr) {
7322	return Selector{expr.source, EvaluateExpr(x)};
7323	},
7324	[&](const parser::Variable &var) {
7325	return Selector{var.GetSource(), EvaluateExpr(x)};
7326	},
7327	},
7328	x.u);
7329	}
7330
7331	// Set the current association to the nth to the last association on the
7332	// association stack. The top of the stack is at n = 1. This allows access
7333	// to the interior of a list of associations at the top of the stack.
7334	void ConstructVisitor::SetCurrentAssociation(std::size_t n) {
7335	CHECK(n > 0 && n <= associationStack_.size());
7336	currentAssociation_ = &associationStack_[associationStack_.size() - n];
7337	}
7338
7339	ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() {
7340	CHECK(currentAssociation_);
7341	return *currentAssociation_;
7342	}
7343
7344	void ConstructVisitor::PushAssociation() {
7345	associationStack_.emplace_back(args: Association{});
7346	currentAssociation_ = &associationStack_.back();
7347	}
7348
7349	void ConstructVisitor::PopAssociation(std::size_t count) {
7350	CHECK(count > 0 && count <= associationStack_.size());
7351	associationStack_.resize(new_size: associationStack_.size() - count);
7352	currentAssociation_ =
7353	associationStack_.empty() ? nullptr : &associationStack_.back();
7354	}
7355
7356	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
7357	evaluate::DynamicType &&type) {
7358	switch (type.category()) {
7359	SWITCH_COVERS_ALL_CASES
7360	case common::TypeCategory::Integer:
7361	case common::TypeCategory::Real:
7362	case common::TypeCategory::Complex:
7363	return context().MakeNumericType(type.category(), type.kind());
7364	case common::TypeCategory::Logical:
7365	return context().MakeLogicalType(type.kind());
7366	case common::TypeCategory::Derived:
7367	if (type.IsAssumedType()) {
7368	return currScope().MakeTypeStarType();
7369	} else if (type.IsUnlimitedPolymorphic()) {
7370	return currScope().MakeClassStarType();
7371	} else {
7372	return currScope().MakeDerivedType(
7373	type.IsPolymorphic() ? DeclTypeSpec::ClassDerived
7374	: DeclTypeSpec::TypeDerived,
7375	common::Clone(type.GetDerivedTypeSpec())
7376
7377	);
7378	}
7379	case common::TypeCategory::Character:
7380	CRASH_NO_CASE;
7381	}
7382	}
7383
7384	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
7385	evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
7386	CHECK(type.category() == common::TypeCategory::Character);
7387	if (length) {
7388	return currScope().MakeCharacterType(
7389	ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},
7390	KindExpr{type.kind()});
7391	} else {
7392	return currScope().MakeCharacterType(
7393	ParamValue::Deferred(common::TypeParamAttr::Len),
7394	KindExpr{type.kind()});
7395	}
7396	}
7397
7398	class ExecutionPartSkimmerBase {
7399	public:
7400	template <typename A> bool Pre(const A &) { return true; }
7401	template <typename A> void Post(const A &) {}
7402
7403	bool InNestedBlockConstruct() const { return blockDepth_ > 0; }
7404
7405	bool Pre(const parser::AssociateConstruct &) {
7406	PushScope();
7407	return true;
7408	}
7409	void Post(const parser::AssociateConstruct &) { PopScope(); }
7410	bool Pre(const parser::Association &x) {
7411	Hide(name: std::get<parser::Name>(x.t));
7412	return true;
7413	}
7414	bool Pre(const parser::BlockConstruct &) {
7415	PushScope();
7416	++blockDepth_;
7417	return true;
7418	}
7419	void Post(const parser::BlockConstruct &) {
7420	--blockDepth_;
7421	PopScope();
7422	}
7423	bool Pre(const parser::EntityDecl &x) {
7424	Hide(std::get<parser::ObjectName>(x.t));
7425	return true;
7426	}
7427	void Post(const parser::ImportStmt &x) {
7428	if (x.kind == common::ImportKind::None ||
7429	x.kind == common::ImportKind::Only) {
7430	if (!nestedScopes_.front().importOnly.has_value()) {
7431	nestedScopes_.front().importOnly.emplace();
7432	}
7433	for (const auto &name : x.names) {
7434	nestedScopes_.front().importOnly->emplace(name.source);
7435	}
7436	} else {
7437	// no special handling needed for explicit names or IMPORT, ALL
7438	}
7439	}
7440	void Post(const parser::UseStmt &x) {
7441	if (const auto *onlyList{std::get_if<std::list<parser::Only>>(&x.u)}) {
7442	for (const auto &only : *onlyList) {
7443	if (const auto *name{std::get_if<parser::Name>(&only.u)}) {
7444	Hide(*name);
7445	} else if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
7446	if (const auto *names{
7447	std::get_if<parser::Rename::Names>(&rename->u)}) {
7448	Hide(std::get<0>(names->t));
7449	}
7450	}
7451	}
7452	} else {
7453	// USE may or may not shadow symbols in host scopes
7454	nestedScopes_.front().hasUseWithoutOnly = true;
7455	}
7456	}
7457	bool Pre(const parser::DerivedTypeStmt &x) {
7458	Hide(name: std::get<parser::Name>(x.t));
7459	PushScope();
7460	return true;
7461	}
7462	void Post(const parser::DerivedTypeDef &) { PopScope(); }
7463	bool Pre(const parser::SelectTypeConstruct &) {
7464	PushScope();
7465	return true;
7466	}
7467	void Post(const parser::SelectTypeConstruct &) { PopScope(); }
7468	bool Pre(const parser::SelectTypeStmt &x) {
7469	if (const auto &maybeName{std::get<1>(x.t)}) {
7470	Hide(name: *maybeName);
7471	}
7472	return true;
7473	}
7474	bool Pre(const parser::SelectRankConstruct &) {
7475	PushScope();
7476	return true;
7477	}
7478	void Post(const parser::SelectRankConstruct &) { PopScope(); }
7479	bool Pre(const parser::SelectRankStmt &x) {
7480	if (const auto &maybeName{std::get<1>(x.t)}) {
7481	Hide(name: *maybeName);
7482	}
7483	return true;
7484	}
7485
7486	protected:
7487	bool IsHidden(SourceName name) {
7488	for (const auto &scope : nestedScopes_) {
7489	if (scope.locals.find(name) != scope.locals.end()) {
7490	return true; // shadowed by nested declaration
7491	}
7492	if (scope.hasUseWithoutOnly) {
7493	break;
7494	}
7495	if (scope.importOnly &&
7496	scope.importOnly->find(name) == scope.importOnly->end()) {
7497	return true; // not imported
7498	}
7499	}
7500	return false;
7501	}
7502
7503	void EndWalk() { CHECK(nestedScopes_.empty()); }
7504
7505	private:
7506	void PushScope() { nestedScopes_.emplace_front(); }
7507	void PopScope() { nestedScopes_.pop_front(); }
7508	void Hide(const parser::Name &name) {
7509	nestedScopes_.front().locals.emplace(name.source);
7510	}
7511
7512	int blockDepth_{0};
7513	struct NestedScopeInfo {
7514	bool hasUseWithoutOnly{false};
7515	std::set<SourceName> locals;
7516	std::optional<std::set<SourceName>> importOnly;
7517	};
7518	std::list<NestedScopeInfo> nestedScopes_;
7519	};
7520
7521	class ExecutionPartAsyncIOSkimmer : public ExecutionPartSkimmerBase {
7522	public:
7523	explicit ExecutionPartAsyncIOSkimmer(SemanticsContext &context)
7524	: context_{context} {}
7525
7526	void Walk(const parser::Block &block) {
7527	parser::Walk(block, *this);
7528	EndWalk();
7529	}
7530
7531	const std::set<SourceName> asyncIONames() const { return asyncIONames_; }
7532
7533	using ExecutionPartSkimmerBase::Post;
7534	using ExecutionPartSkimmerBase::Pre;
7535
7536	bool Pre(const parser::IoControlSpec::Asynchronous &async) {
7537	if (auto folded{evaluate::Fold(
7538	context_.foldingContext(), AnalyzeExpr(context_, async.v))}) {
7539	if (auto str{
7540	evaluate::GetScalarConstantValue<evaluate::Ascii>(*folded)}) {
7541	for (char ch : *str) {
7542	if (ch != ' ') {
7543	inAsyncIO_ = ch == 'y' || ch == 'Y';
7544	break;
7545	}
7546	}
7547	}
7548	}
7549	return true;
7550	}
7551	void Post(const parser::ReadStmt &) { inAsyncIO_ = false; }
7552	void Post(const parser::WriteStmt &) { inAsyncIO_ = false; }
7553	void Post(const parser::IoControlSpec::Size &size) {
7554	if (const auto *designator{
7555	std::get_if<common::Indirection<parser::Designator>>(
7556	&size.v.thing.thing.u)}) {
7557	NoteAsyncIODesignator(designator: designator->value());
7558	}
7559	}
7560	void Post(const parser::InputItem &x) {
7561	if (const auto *var{std::get_if<parser::Variable>(&x.u)}) {
7562	if (const auto *designator{
7563	std::get_if<common::Indirection<parser::Designator>>(&var->u)}) {
7564	NoteAsyncIODesignator(designator: designator->value());
7565	}
7566	}
7567	}
7568	void Post(const parser::OutputItem &x) {
7569	if (const auto *expr{std::get_if<parser::Expr>(&x.u)}) {
7570	if (const auto *designator{
7571	std::get_if<common::Indirection<parser::Designator>>(&expr->u)}) {
7572	NoteAsyncIODesignator(designator: designator->value());
7573	}
7574	}
7575	}
7576
7577	private:
7578	void NoteAsyncIODesignator(const parser::Designator &designator) {
7579	if (inAsyncIO_ && !InNestedBlockConstruct()) {
7580	const parser::Name &name{parser::GetFirstName(designator)};
7581	if (!IsHidden(name: name.source)) {
7582	asyncIONames_.insert(name.source);
7583	}
7584	}
7585	}
7586
7587	SemanticsContext &context_;
7588	bool inAsyncIO_{false};
7589	std::set<SourceName> asyncIONames_;
7590	};
7591
7592	// Any data list item or SIZE= specifier of an I/O data transfer statement
7593	// with ASYNCHRONOUS="YES" implicitly has the ASYNCHRONOUS attribute in the
7594	// local scope.
7595	void ConstructVisitor::HandleImpliedAsynchronousInScope(
7596	const parser::Block &block) {
7597	ExecutionPartAsyncIOSkimmer skimmer{context()};
7598	skimmer.Walk(block);
7599	for (auto name : skimmer.asyncIONames()) {
7600	if (Symbol * symbol{currScope().FindSymbol(name)}) {
7601	if (!symbol->attrs().test(Attr::ASYNCHRONOUS)) {
7602	if (&symbol->owner() != &currScope()) {
7603	symbol = &*currScope()
7604	.try_emplace(name, HostAssocDetails{*symbol})
7605	.first->second;
7606	}
7607	if (symbol->has<AssocEntityDetails>()) {
7608	symbol = const_cast<Symbol *>(&GetAssociationRoot(*symbol));
7609	}
7610	SetImplicitAttr(*symbol, Attr::ASYNCHRONOUS);
7611	}
7612	}
7613	}
7614	}
7615
7616	// ResolveNamesVisitor implementation
7617
7618	bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
7619	HandleCall(Symbol::Flag::Function, x.v);
7620	return false;
7621	}
7622	bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
7623	HandleCall(Symbol::Flag::Subroutine, x.call);
7624	Walk(x.chevrons);
7625	return false;
7626	}
7627
7628	bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
7629	auto &scope{currScope()};
7630	// Check C896 and C899: where IMPORT statements are allowed
7631	switch (scope.kind()) {
7632	case Scope::Kind::Module:
7633	if (scope.IsModule()) {
7634	Say("IMPORT is not allowed in a module scoping unit"_err_en_US);
7635	return false;
7636	} else if (x.kind == common::ImportKind::None) {
7637	Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US);
7638	return false;
7639	}
7640	break;
7641	case Scope::Kind::MainProgram:
7642	Say("IMPORT is not allowed in a main program scoping unit"_err_en_US);
7643	return false;
7644	case Scope::Kind::Subprogram:
7645	if (scope.parent().IsGlobal()) {
7646	Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US);
7647	return false;
7648	}
7649	break;
7650	case Scope::Kind::BlockData: // C1415 (in part)
7651	Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);
7652	return false;
7653	default:;
7654	}
7655	if (auto error{scope.SetImportKind(x.kind)}) {
7656	Say(std::move(*error));
7657	}
7658	for (auto &name : x.names) {
7659	if (Symbol * outer{FindSymbol(scope.parent(), name)}) {
7660	scope.add_importName(name.source);
7661	if (Symbol * symbol{FindInScope(name)}) {
7662	if (outer->GetUltimate() == symbol->GetUltimate()) {
7663	if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {
7664	Say(name,
7665	"The same '%s' is already present in this scope"_port_en_US);
7666	}
7667	} else {
7668	Say(name,
7669	"A distinct '%s' is already present in this scope"_err_en_US)
7670	.Attach(symbol->name(), "Previous declaration of '%s'"_en_US)
7671	.Attach(outer->name(), "Declaration of '%s' in host scope"_en_US);
7672	}
7673	}
7674	} else {
7675	Say(name, "'%s' not found in host scope"_err_en_US);
7676	}
7677	}
7678	prevImportStmt_ = currStmtSource();
7679	return false;
7680	}
7681
7682	const parser::Name *DeclarationVisitor::ResolveStructureComponent(
7683	const parser::StructureComponent &x) {
7684	return FindComponent(ResolveDataRef(x.base), x.component);
7685	}
7686
7687	const parser::Name *DeclarationVisitor::ResolveDesignator(
7688	const parser::Designator &x) {
7689	return common::visit(
7690	common::visitors{
7691	[&](const parser::DataRef &x) { return ResolveDataRef(x); },
7692	[&](const parser::Substring &x) {
7693	Walk(std::get<parser::SubstringRange>(x.t).t);
7694	return ResolveDataRef(std::get<parser::DataRef>(x.t));
7695	},
7696	},
7697	x.u);
7698	}
7699
7700	const parser::Name *DeclarationVisitor::ResolveDataRef(
7701	const parser::DataRef &x) {
7702	return common::visit(
7703	common::visitors{
7704	[=](const parser::Name &y) { return ResolveName(y); },
7705	[=](const Indirection<parser::StructureComponent> &y) {
7706	return ResolveStructureComponent(y.value());
7707	},
7708	[&](const Indirection<parser::ArrayElement> &y) {
7709	Walk(y.value().subscripts);
7710	const parser::Name *name{ResolveDataRef(y.value().base)};
7711	if (name && name->symbol) {
7712	if (!IsProcedure(*name->symbol)) {
7713	ConvertToObjectEntity(*name->symbol);
7714	} else if (!context().HasError(*name->symbol)) {
7715	SayWithDecl(*name, *name->symbol,
7716	"Cannot reference function '%s' as data"_err_en_US);
7717	context().SetError(*name->symbol);
7718	}
7719	}
7720	return name;
7721	},
7722	[&](const Indirection<parser::CoindexedNamedObject> &y) {
7723	Walk(y.value().imageSelector);
7724	return ResolveDataRef(y.value().base);
7725	},
7726	},
7727	x.u);
7728	}
7729
7730	// If implicit types are allowed, ensure name is in the symbol table.
7731	// Otherwise, report an error if it hasn't been declared.
7732	const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
7733	FindSymbol(name);
7734	if (CheckForHostAssociatedImplicit(name)) {
7735	NotePossibleBadForwardRef(name);
7736	return &name;
7737	}
7738	if (Symbol * symbol{name.symbol}) {
7739	if (CheckUseError(name)) {
7740	return nullptr; // reported an error
7741	}
7742	NotePossibleBadForwardRef(name);
7743	symbol->set(Symbol::Flag::ImplicitOrError, false);
7744	if (IsUplevelReference(*symbol)) {
7745	MakeHostAssocSymbol(name, *symbol);
7746	} else if (IsDummy(*symbol) ||
7747	(!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
7748	CheckEntryDummyUse(source: name.source, symbol);
7749	ConvertToObjectEntity(*symbol);
7750	ApplyImplicitRules(*symbol);
7751	}
7752	if (checkIndexUseInOwnBounds_ &&
7753	*checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) {
7754	if (context().ShouldWarn(common::LanguageFeature::ImpliedDoIndexScope)) {
7755	Say(name,
7756	"Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
7757	name.source);
7758	}
7759	}
7760	return &name;
7761	}
7762	if (isImplicitNoneType() && !deferImplicitTyping_) {
7763	Say(name, "No explicit type declared for '%s'"_err_en_US);
7764	return nullptr;
7765	}
7766	// Create the symbol, then ensure that it is accessible
7767	if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
7768	Say(name,
7769	"Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,
7770	name.source);
7771	}
7772	MakeSymbol(InclusiveScope(), name.source, Attrs{});
7773	auto *symbol{FindSymbol(name)};
7774	if (!symbol) {
7775	Say(name,
7776	"'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
7777	return nullptr;
7778	}
7779	ConvertToObjectEntity(symbol&: *symbol);
7780	ApplyImplicitRules(symbol&: *symbol);
7781	NotePossibleBadForwardRef(name);
7782	return &name;
7783	}
7784
7785	// A specification expression may refer to a symbol in the host procedure that
7786	// is implicitly typed. Because specification parts are processed before
7787	// execution parts, this may be the first time we see the symbol. It can't be a
7788	// local in the current scope (because it's in a specification expression) so
7789	// either it is implicitly declared in the host procedure or it is an error.
7790	// We create a symbol in the host assuming it is the former; if that proves to
7791	// be wrong we report an error later in CheckDeclarations().
7792	bool DeclarationVisitor::CheckForHostAssociatedImplicit(
7793	const parser::Name &name) {
7794	if (!inSpecificationPart_ || inEquivalenceStmt_) {
7795	return false;
7796	}
7797	if (name.symbol) {
7798	ApplyImplicitRules(symbol&: *name.symbol, allowForwardReference: true);
7799	}
7800	Symbol *hostSymbol;
7801	Scope *host{GetHostProcedure()};
7802	if (!host || isImplicitNoneType(*host)) {
7803	return false;
7804	}
7805	if (!name.symbol) {
7806	hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
7807	ConvertToObjectEntity(*hostSymbol);
7808	ApplyImplicitRules(*hostSymbol);
7809	hostSymbol->set(Symbol::Flag::ImplicitOrError);
7810	} else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {
7811	hostSymbol = name.symbol;
7812	} else {
7813	return false;
7814	}
7815	Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)};
7816	if (isImplicitNoneType()) {
7817	symbol.get<HostAssocDetails>().implicitOrExplicitTypeError = true;
7818	} else {
7819	symbol.get<HostAssocDetails>().implicitOrSpecExprError = true;
7820	}
7821	return true;
7822	}
7823
7824	bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {
7825	const Scope &symbolUnit{GetProgramUnitContaining(symbol)};
7826	if (symbolUnit == GetProgramUnitContaining(currScope())) {
7827	return false;
7828	} else {
7829	Scope::Kind kind{symbolUnit.kind()};
7830	return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;
7831	}
7832	}
7833
7834	// base is a part-ref of a derived type; find the named component in its type.
7835	// Also handles intrinsic type parameter inquiries (%kind, %len) and
7836	// COMPLEX component references (%re, %im).
7837	const parser::Name *DeclarationVisitor::FindComponent(
7838	const parser::Name *base, const parser::Name &component) {
7839	if (!base || !base->symbol) {
7840	return nullptr;
7841	}
7842	if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) {
7843	if (component.source == "kind") {
7844	if (misc->kind() == MiscDetails::Kind::ComplexPartRe ||
7845	misc->kind() == MiscDetails::Kind::ComplexPartIm ||
7846	misc->kind() == MiscDetails::Kind::KindParamInquiry ||
7847	misc->kind() == MiscDetails::Kind::LenParamInquiry) {
7848	// x%{re,im,kind,len}%kind
7849	MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry);
7850	return &component;
7851	}
7852	}
7853	}
7854	CheckEntryDummyUse(source: base->source, symbol: base->symbol);
7855	auto &symbol{base->symbol->GetUltimate()};
7856	if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) {
7857	SayWithDecl(*base, symbol,
7858	"'%s' is not an object and may not be used as the base of a component reference or type parameter inquiry"_err_en_US);
7859	return nullptr;
7860	}
7861	auto *type{symbol.GetType()};
7862	if (!type) {
7863	return nullptr; // should have already reported error
7864	}
7865	if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
7866	auto category{intrinsic->category()};
7867	MiscDetails::Kind miscKind{MiscDetails::Kind::None};
7868	if (component.source == "kind") {
7869	miscKind = MiscDetails::Kind::KindParamInquiry;
7870	} else if (category == TypeCategory::Character) {
7871	if (component.source == "len") {
7872	miscKind = MiscDetails::Kind::LenParamInquiry;
7873	}
7874	} else if (category == TypeCategory::Complex) {
7875	if (component.source == "re") {
7876	miscKind = MiscDetails::Kind::ComplexPartRe;
7877	} else if (component.source == "im") {
7878	miscKind = MiscDetails::Kind::ComplexPartIm;
7879	}
7880	}
7881	if (miscKind != MiscDetails::Kind::None) {
7882	MakePlaceholder(component, miscKind);
7883	return &component;
7884	}
7885	} else if (DerivedTypeSpec * derived{type->AsDerived()}) {
7886	derived->Instantiate(currScope()); // in case of forward referenced type
7887	if (const Scope * scope{derived->scope()}) {
7888	if (Resolve(component, scope->FindComponent(component.source))) {
7889	if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {
7890	context().Say(component.source, *msg);
7891	}
7892	return &component;
7893	} else {
7894	SayDerivedType(component.source,
7895	"Component '%s' not found in derived type '%s'"_err_en_US, *scope);
7896	}
7897	}
7898	return nullptr;
7899	}
7900	if (symbol.test(Symbol::Flag::Implicit)) {
7901	Say(*base,
7902	"'%s' is not an object of derived type; it is implicitly typed"_err_en_US);
7903	} else {
7904	SayWithDecl(
7905	*base, symbol, "'%s' is not an object of derived type"_err_en_US);
7906	}
7907	return nullptr;
7908	}
7909
7910	void DeclarationVisitor::Initialization(const parser::Name &name,
7911	const parser::Initialization &init, bool inComponentDecl) {
7912	// Traversal of the initializer was deferred to here so that the
7913	// symbol being declared can be available for use in the expression, e.g.:
7914	// real, parameter :: x = tiny(x)
7915	if (!name.symbol) {
7916	return;
7917	}
7918	Symbol &ultimate{name.symbol->GetUltimate()};
7919	// TODO: check C762 - all bounds and type parameters of component
7920	// are colons or constant expressions if component is initialized
7921	common::visit(
7922	common::visitors{
7923	[&](const parser::ConstantExpr &expr) {
7924	Walk(expr);
7925	if (IsNamedConstant(ultimate) || inComponentDecl) {
7926	NonPointerInitialization(name, expr);
7927	} else {
7928	// Defer analysis so forward references to nested subprograms
7929	// can be properly resolved when they appear in structure
7930	// constructors.
7931	ultimate.set(Symbol::Flag::InDataStmt);
7932	}
7933	},
7934	[&](const parser::NullInit &null) { // => NULL()
7935	Walk(null);
7936	if (auto nullInit{EvaluateExpr(null)}) {
7937	if (!evaluate::IsNullPointer(*nullInit)) { // C813
7938	Say(null.v.value().source,
7939	"Pointer initializer must be intrinsic NULL()"_err_en_US);
7940	} else if (IsPointer(ultimate)) {
7941	if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
7942	CHECK(!object->init());
7943	object->set_init(std::move(*nullInit));
7944	} else if (auto *procPtr{
7945	ultimate.detailsIf<ProcEntityDetails>()}) {
7946	CHECK(!procPtr->init());
7947	procPtr->set_init(nullptr);
7948	}
7949	} else {
7950	Say(name,
7951	"Non-pointer component '%s' initialized with null pointer"_err_en_US);
7952	}
7953	}
7954	},
7955	[&](const parser::InitialDataTarget &target) {
7956	// Defer analysis to the end of the specification part
7957	// so that forward references and attribute checks like SAVE
7958	// work better.
7959	auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
7960	Walk(target);
7961	ultimate.set(Symbol::Flag::InDataStmt);
7962	},
7963	[&](const std::list<Indirection<parser::DataStmtValue>> &values) {
7964	// Handled later in data-to-inits conversion
7965	ultimate.set(Symbol::Flag::InDataStmt);
7966	Walk(values);
7967	},
7968	},
7969	init.u);
7970	}
7971
7972	void DeclarationVisitor::PointerInitialization(
7973	const parser::Name &name, const parser::InitialDataTarget &target) {
7974	if (name.symbol) {
7975	Symbol &ultimate{name.symbol->GetUltimate()};
7976	if (!context().HasError(ultimate)) {
7977	if (IsPointer(ultimate)) {
7978	Walk(target);
7979	if (MaybeExpr expr{EvaluateExpr(target)}) {
7980	// Validation is done in declaration checking.
7981	if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
7982	CHECK(!details->init());
7983	details->set_init(std::move(*expr));
7984	ultimate.set(Symbol::Flag::InDataStmt, false);
7985	} else if (auto *details{ultimate.detailsIf<ProcEntityDetails>()}) {
7986	// something like "REAL, EXTERNAL, POINTER :: p => t"
7987	if (evaluate::IsNullProcedurePointer(*expr)) {
7988	CHECK(!details->init());
7989	details->set_init(nullptr);
7990	} else if (const Symbol *
7991	targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
7992	CHECK(!details->init());
7993	details->set_init(*targetSymbol);
7994	} else {
7995	Say(name,
7996	"Procedure pointer '%s' must be initialized with a procedure name or NULL()"_err_en_US);
7997	context().SetError(ultimate);
7998	}
7999	}
8000	}
8001	} else {
8002	Say(name,
8003	"'%s' is not a pointer but is initialized like one"_err_en_US);
8004	context().SetError(ultimate);
8005	}
8006	}
8007	}
8008	}
8009	void DeclarationVisitor::PointerInitialization(
8010	const parser::Name &name, const parser::ProcPointerInit &target) {
8011	if (name.symbol) {
8012	Symbol &ultimate{name.symbol->GetUltimate()};
8013	if (!context().HasError(ultimate)) {
8014	if (IsProcedurePointer(ultimate)) {
8015	auto &details{ultimate.get<ProcEntityDetails>()};
8016	CHECK(!details.init());
8017	if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
8018	Walk(target);
8019	if (!CheckUseError(name: *targetName) && targetName->symbol) {
8020	// Validation is done in declaration checking.
8021	details.set_init(*targetName->symbol);
8022	}
8023	} else { // explicit NULL
8024	details.set_init(nullptr);
8025	}
8026	} else {
8027	Say(name,
8028	"'%s' is not a procedure pointer but is initialized "
8029	"like one"_err_en_US);
8030	context().SetError(ultimate);
8031	}
8032	}
8033	}
8034	}
8035
8036	void DeclarationVisitor::NonPointerInitialization(
8037	const parser::Name &name, const parser::ConstantExpr &expr) {
8038	if (!context().HasError(name.symbol)) {
8039	Symbol &ultimate{name.symbol->GetUltimate()};
8040	if (!context().HasError(ultimate)) {
8041	if (IsPointer(ultimate)) {
8042	Say(name,
8043	"'%s' is a pointer but is not initialized like one"_err_en_US);
8044	} else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
8045	if (details->init()) {
8046	SayWithDecl(name, *name.symbol,
8047	"'%s' has already been initialized"_err_en_US);
8048	} else if (IsAllocatable(ultimate)) {
8049	Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
8050	} else if (ultimate.owner().IsParameterizedDerivedType()) {
8051	// Save the expression for per-instantiation analysis.
8052	details->set_unanalyzedPDTComponentInit(&expr.thing.value());
8053	} else if (MaybeExpr folded{EvaluateNonPointerInitializer(
8054	ultimate, expr, expr.thing.value().source)}) {
8055	details->set_init(std::move(*folded));
8056	ultimate.set(Symbol::Flag::InDataStmt, false);
8057	}
8058	} else {
8059	Say(name, "'%s' is not an object that can be initialized"_err_en_US);
8060	}
8061	}
8062	}
8063	}
8064
8065	void ResolveNamesVisitor::HandleCall(
8066	Symbol::Flag procFlag, const parser::Call &call) {
8067	common::visit(
8068	common::visitors{
8069	[&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
8070	[&](const parser::ProcComponentRef &x) {
8071	Walk(x);
8072	const parser::Name &name{x.v.thing.component};
8073	if (Symbol * symbol{name.symbol}) {
8074	if (IsProcedure(*symbol)) {
8075	SetProcFlag(name, *symbol, procFlag);
8076	}
8077	}
8078	},
8079	},
8080	std::get<parser::ProcedureDesignator>(call.t).u);
8081	const auto &arguments{std::get<std::list<parser::ActualArgSpec>>(call.t)};
8082	Walk(arguments);
8083	// Once an object has appeared in a specification function reference as
8084	// a whole scalar actual argument, it cannot be (re)dimensioned later.
8085	// The fact that it appeared to be a scalar may determine the resolution
8086	// or the result of an inquiry intrinsic function or generic procedure.
8087	if (inSpecificationPart_) {
8088	for (const auto &argSpec : arguments) {
8089	const auto &actual{std::get<parser::ActualArg>(argSpec.t)};
8090	if (const auto *expr{
8091	std::get_if<common::Indirection<parser::Expr>>(&actual.u)}) {
8092	if (const auto *designator{
8093	std::get_if<common::Indirection<parser::Designator>>(
8094	&expr->value().u)}) {
8095	if (const auto *dataRef{
8096	std::get_if<parser::DataRef>(&designator->value().u)}) {
8097	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)};
8098	name && name->symbol) {
8099	const Symbol &symbol{*name->symbol};
8100	const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
8101	if (symbol.has<EntityDetails>() ||
8102	(object && !object->IsArray())) {
8103	NoteScalarSpecificationArgument(symbol);
8104	}
8105	}
8106	}
8107	}
8108	}
8109	}
8110	}
8111	}
8112
8113	void ResolveNamesVisitor::HandleProcedureName(
8114	Symbol::Flag flag, const parser::Name &name) {
8115	CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
8116	auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
8117	if (!symbol) {
8118	if (IsIntrinsic(name.source, flag)) {
8119	symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
8120	SetImplicitAttr(*symbol, Attr::INTRINSIC);
8121	} else if (const auto ppcBuiltinScope =
8122	currScope().context().GetPPCBuiltinsScope()) {
8123	// Check if it is a builtin from the predefined module
8124	symbol = FindSymbol(*ppcBuiltinScope, name);
8125	if (!symbol) {
8126	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
8127	}
8128	} else {
8129	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
8130	}
8131	Resolve(name, *symbol);
8132	ConvertToProcEntity(symbol&: *symbol, usedHere: name.source);
8133	if (!symbol->attrs().test(Attr::INTRINSIC)) {
8134	if (CheckImplicitNoneExternal(name.source, *symbol)) {
8135	MakeExternal(symbol&: *symbol);
8136	// Create a place-holder HostAssocDetails symbol to preclude later
8137	// use of this name as a local symbol; but don't actually use this new
8138	// HostAssocDetails symbol in expressions.
8139	MakeHostAssocSymbol(name, hostSymbol: *symbol);
8140	name.symbol = symbol;
8141	}
8142	}
8143	CheckEntryDummyUse(source: name.source, symbol: symbol);
8144	SetProcFlag(name, *symbol, flag);
8145	} else if (CheckUseError(name)) {
8146	// error was reported
8147	} else {
8148	symbol = &symbol->GetUltimate();
8149	if (!name.symbol ||
8150	(name.symbol->has<HostAssocDetails>() && symbol->owner().IsGlobal() &&
8151	(symbol->has<ProcEntityDetails>() ||
8152	(symbol->has<SubprogramDetails>() &&
8153	symbol->scope() /*not ENTRY*/)))) {
8154	name.symbol = symbol;
8155	}
8156	CheckEntryDummyUse(source: name.source, symbol: symbol);
8157	bool convertedToProcEntity{ConvertToProcEntity(symbol&: *symbol, usedHere: name.source)};
8158	if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
8159	IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
8160	AcquireIntrinsicProcedureFlags(symbol&: *symbol);
8161	}
8162	if (!SetProcFlag(name, *symbol, flag)) {
8163	return; // reported error
8164	}
8165	CheckImplicitNoneExternal(name.source, *symbol);
8166	if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
8167	symbol->has<AssocEntityDetails>()) {
8168	// Symbols with DerivedTypeDetails and AssocEntityDetails are accepted
8169	// here as procedure-designators because this means the related
8170	// FunctionReference are mis-parsed structure constructors or array
8171	// references that will be fixed later when analyzing expressions.
8172	} else if (symbol->has<ObjectEntityDetails>()) {
8173	// Symbols with ObjectEntityDetails are also accepted because this can be
8174	// a mis-parsed array reference that will be fixed later. Ensure that if
8175	// this is a symbol from a host procedure, a symbol with HostAssocDetails
8176	// is created for the current scope.
8177	// Operate on non ultimate symbol so that HostAssocDetails are also
8178	// created for symbols used associated in the host procedure.
8179	ResolveName(name);
8180	} else if (symbol->test(Symbol::Flag::Implicit)) {
8181	Say(name,
8182	"Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);
8183	} else {
8184	SayWithDecl(name, *symbol,
8185	"Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
8186	}
8187	}
8188	}
8189
8190	bool ResolveNamesVisitor::CheckImplicitNoneExternal(
8191	const SourceName &name, const Symbol &symbol) {
8192	if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&
8193	!symbol.attrs().test(Attr::EXTERNAL) &&
8194	!symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) {
8195	Say(name,
8196	"'%s' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
8197	return false;
8198	}
8199	return true;
8200	}
8201
8202	// Variant of HandleProcedureName() for use while skimming the executable
8203	// part of a subprogram to catch calls to dummy procedures that are part
8204	// of the subprogram's interface, and to mark as procedures any symbols
8205	// that might otherwise have been miscategorized as objects.
8206	void ResolveNamesVisitor::NoteExecutablePartCall(
8207	Symbol::Flag flag, SourceName name, bool hasCUDAChevrons) {
8208	// Subtlety: The symbol pointers in the parse tree are not set, because
8209	// they might end up resolving elsewhere (e.g., construct entities in
8210	// SELECT TYPE).
8211	if (Symbol * symbol{currScope().FindSymbol(name)}) {
8212	Symbol::Flag other{flag == Symbol::Flag::Subroutine
8213	? Symbol::Flag::Function
8214	: Symbol::Flag::Subroutine};
8215	if (!symbol->test(other)) {
8216	ConvertToProcEntity(symbol&: *symbol, usedHere: name);
8217	if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
8218	symbol->set(flag);
8219	if (IsDummy(*symbol)) {
8220	SetImplicitAttr(*symbol, Attr::EXTERNAL);
8221	}
8222	ApplyImplicitRules(*symbol);
8223	if (hasCUDAChevrons) {
8224	details->set_isCUDAKernel();
8225	}
8226	}
8227	}
8228	}
8229	}
8230
8231	static bool IsLocallyImplicitGlobalSymbol(
8232	const Symbol &symbol, const parser::Name &localName) {
8233	if (symbol.owner().IsGlobal()) {
8234	const auto *subp{symbol.detailsIf<SubprogramDetails>()};
8235	const Scope *scope{
8236	subp && subp->entryScope() ? subp->entryScope() : symbol.scope()};
8237	return !(scope && scope->sourceRange().Contains(localName.source));
8238	}
8239	return false;
8240	}
8241
8242	static bool TypesMismatchIfNonNull(
8243	const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
8244	return type1 && type2 && *type1 != *type2;
8245	}
8246
8247	// Check and set the Function or Subroutine flag on symbol; false on error.
8248	bool ResolveNamesVisitor::SetProcFlag(
8249	const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
8250	if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
8251	SayWithDecl(
8252	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
8253	context().SetError(symbol);
8254	return false;
8255	} else if (symbol.test(Symbol::Flag::Subroutine) &&
8256	flag == Symbol::Flag::Function) {
8257	SayWithDecl(
8258	name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
8259	context().SetError(symbol);
8260	return false;
8261	} else if (flag == Symbol::Flag::Function &&
8262	IsLocallyImplicitGlobalSymbol(symbol, name) &&
8263	TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) {
8264	SayWithDecl(name, symbol,
8265	"Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);
8266	return false;
8267	} else if (symbol.has<ProcEntityDetails>()) {
8268	symbol.set(flag); // in case it hasn't been set yet
8269	if (flag == Symbol::Flag::Function) {
8270	ApplyImplicitRules(symbol);
8271	}
8272	if (symbol.attrs().test(Attr::INTRINSIC)) {
8273	AcquireIntrinsicProcedureFlags(symbol);
8274	}
8275	} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
8276	SayWithDecl(
8277	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
8278	context().SetError(symbol);
8279	} else if (symbol.attrs().test(Attr::INTRINSIC)) {
8280	AcquireIntrinsicProcedureFlags(symbol);
8281	}
8282	return true;
8283	}
8284
8285	bool ModuleVisitor::Pre(const parser::AccessStmt &x) {
8286	Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))};
8287	if (!currScope().IsModule()) { // C869
8288	Say(currStmtSource().value(),
8289	"%s statement may only appear in the specification part of a module"_err_en_US,
8290	EnumToString(accessAttr));
8291	return false;
8292	}
8293	const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)};
8294	if (accessIds.empty()) {
8295	if (prevAccessStmt_) { // C869
8296	Say("The default accessibility of this module has already been declared"_err_en_US)
8297	.Attach(*prevAccessStmt_, "Previous declaration"_en_US);
8298	}
8299	prevAccessStmt_ = currStmtSource();
8300	auto *moduleDetails{DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
8301	DEREF(moduleDetails).set_isDefaultPrivate(accessAttr == Attr::PRIVATE);
8302	} else {
8303	for (const auto &accessId : accessIds) {
8304	GenericSpecInfo info{accessId.v.value()};
8305	auto *symbol{FindInScope(info.symbolName())};
8306	if (!symbol && !info.kind().IsName()) {
8307	symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{});
8308	}
8309	info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol));
8310	}
8311	}
8312	return false;
8313	}
8314
8315	// Set the access specification for this symbol.
8316	Symbol &ModuleVisitor::SetAccess(
8317	const SourceName &name, Attr attr, Symbol *symbol) {
8318	if (!symbol) {
8319	symbol = &MakeSymbol(name);
8320	}
8321	Attrs &attrs{symbol->attrs()};
8322	if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
8323	// PUBLIC/PRIVATE already set: make it a fatal error if it changed
8324	Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE;
8325	Say(name,
8326	WithSeverity(
8327	"The accessibility of '%s' has already been specified as %s"_warn_en_US,
8328	attr != prev ? parser::Severity::Error : parser::Severity::Warning),
8329	MakeOpName(name), EnumToString(prev));
8330	} else {
8331	attrs.set(attr);
8332	}
8333	return *symbol;
8334	}
8335
8336	static bool NeedsExplicitType(const Symbol &symbol) {
8337	if (symbol.has<UnknownDetails>()) {
8338	return true;
8339	} else if (const auto *details{symbol.detailsIf<EntityDetails>()}) {
8340	return !details->type();
8341	} else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
8342	return !details->type();
8343	} else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
8344	return !details->procInterface() && !details->type();
8345	} else {
8346	return false;
8347	}
8348	}
8349
8350	void ResolveNamesVisitor::HandleDerivedTypesInImplicitStmts(
8351	const parser::ImplicitPart &implicitPart,
8352	const std::list<parser::DeclarationConstruct> &decls) {
8353	// Detect derived type definitions and create symbols for them now if
8354	// they appear in IMPLICIT statements so that these forward-looking
8355	// references will not be ambiguous with host associations.
8356	std::set<SourceName> implicitDerivedTypes;
8357	for (const auto &ipStmt : implicitPart.v) {
8358	if (const auto *impl{std::get_if<
8359	parser::Statement<common::Indirection<parser::ImplicitStmt>>>(
8360	&ipStmt.u)}) {
8361	if (const auto *specs{std::get_if<std::list<parser::ImplicitSpec>>(
8362	&impl->statement.value().u)}) {
8363	for (const auto &spec : *specs) {
8364	const auto &declTypeSpec{
8365	std::get<parser::DeclarationTypeSpec>(spec.t)};
8366	if (const auto *dtSpec{common::visit(
8367	common::visitors{
8368	[](const parser::DeclarationTypeSpec::Type &x) {
8369	return &x.derived;
8370	},
8371	[](const parser::DeclarationTypeSpec::Class &x) {
8372	return &x.derived;
8373	},
8374	[](const auto &) -> const parser::DerivedTypeSpec * {
8375	return nullptr;
8376	}},
8377	declTypeSpec.u)}) {
8378	implicitDerivedTypes.emplace(
8379	std::get<parser::Name>(dtSpec->t).source);
8380	}
8381	}
8382	}
8383	}
8384	}
8385	if (!implicitDerivedTypes.empty()) {
8386	for (const auto &decl : decls) {
8387	if (const auto *spec{
8388	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
8389	if (const auto *dtDef{
8390	std::get_if<common::Indirection<parser::DerivedTypeDef>>(
8391	&spec->u)}) {
8392	const parser::DerivedTypeStmt &dtStmt{
8393	std::get<parser::Statement<parser::DerivedTypeStmt>>(
8394	dtDef->value().t)
8395	.statement};
8396	const parser::Name &name{std::get<parser::Name>(dtStmt.t)};
8397	if (implicitDerivedTypes.find(name.source) !=
8398	implicitDerivedTypes.end() &&
8399	!FindInScope(name)) {
8400	DerivedTypeDetails details;
8401	details.set_isForwardReferenced(true);
8402	Resolve(name, MakeSymbol(name, std::move(details)));
8403	implicitDerivedTypes.erase(name.source);
8404	}
8405	}
8406	}
8407	}
8408	}
8409	}
8410
8411	bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
8412	const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
8413	implicitPart, decls] = x.t;
8414	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
8415	auto stateRestorer{
8416	common::ScopedSet(specPartState_, SpecificationPartState{})};
8417	Walk(accDecls);
8418	Walk(ompDecls);
8419	Walk(compilerDirectives);
8420	for (const auto &useStmt : useStmts) {
8421	CollectUseRenames(useStmt.statement.value());
8422	}
8423	Walk(useStmts);
8424	UseCUDABuiltinNames();
8425	ClearUseRenames();
8426	ClearUseOnly();
8427	ClearModuleUses();
8428	Walk(importStmts);
8429	HandleDerivedTypesInImplicitStmts(implicitPart, decls);
8430	Walk(implicitPart);
8431	for (const auto &decl : decls) {
8432	if (const auto *spec{
8433	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
8434	PreSpecificationConstruct(*spec);
8435	}
8436	}
8437	Walk(decls);
8438	FinishSpecificationPart(decls);
8439	return false;
8440	}
8441
8442	void ResolveNamesVisitor::UseCUDABuiltinNames() {
8443	if (FindCUDADeviceContext(&currScope())) {
8444	for (const auto &[name, symbol] : context().GetCUDABuiltinsScope()) {
8445	if (!FindInScope(name)) {
8446	auto &localSymbol{MakeSymbol(name)};
8447	localSymbol.set_details(UseDetails{name, *symbol});
8448	localSymbol.flags() = symbol->flags();
8449	}
8450	}
8451	}
8452	}
8453
8454	// Initial processing on specification constructs, before visiting them.
8455	void ResolveNamesVisitor::PreSpecificationConstruct(
8456	const parser::SpecificationConstruct &spec) {
8457	common::visit(
8458	common::visitors{
8459	[&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
8460	CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
8461	},
8462	[&](const Indirection<parser::InterfaceBlock> &y) {
8463	const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(
8464	y.value().t)};
8465	if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) {
8466	CreateGeneric(*spec);
8467	}
8468	},
8469	[&](const parser::Statement<parser::OtherSpecificationStmt> &y) {
8470	if (const auto *commonStmt{parser::Unwrap<parser::CommonStmt>(y)}) {
8471	CreateCommonBlockSymbols(*commonStmt);
8472	}
8473	},
8474	[&](const auto &) {},
8475	},
8476	spec.u);
8477	}
8478
8479	void ResolveNamesVisitor::CreateCommonBlockSymbols(
8480	const parser::CommonStmt &commonStmt) {
8481	for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
8482	const auto &[name, objects] = block.t;
8483	Symbol &commonBlock{MakeCommonBlockSymbol(name)};
8484	for (const auto &object : objects) {
8485	Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};
8486	if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {
8487	details->set_commonBlock(commonBlock);
8488	commonBlock.get<CommonBlockDetails>().add_object(obj);
8489	}
8490	}
8491	}
8492	}
8493
8494	void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
8495	auto info{GenericSpecInfo{x}};
8496	SourceName symbolName{info.symbolName()};
8497	if (IsLogicalConstant(context(), symbolName)) {
8498	Say(symbolName,
8499	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
8500	return;
8501	}
8502	GenericDetails genericDetails;
8503	Symbol *existing{nullptr};
8504	// Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
8505	for (const std::string &n : GetAllNames(context(), symbolName)) {
8506	existing = currScope().FindSymbol(SourceName{n});
8507	if (existing) {
8508	break;
8509	}
8510	}
8511	if (existing) {
8512	Symbol &ultimate{existing->GetUltimate()};
8513	if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
8514	if (&existing->owner() == &currScope()) {
8515	if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
8516	// Create a local copy of a use associated generic so that
8517	// it can be locally extended without corrupting the original.
8518	genericDetails.CopyFrom(*existingGeneric);
8519	if (existingGeneric->specific()) {
8520	genericDetails.set_specific(*existingGeneric->specific());
8521	}
8522	AddGenericUse(
8523	genericDetails, existing->name(), existingUse->symbol());
8524	} else if (existing == &ultimate) {
8525	// Extending an extant generic in the same scope
8526	info.Resolve(existing);
8527	return;
8528	} else {
8529	// Host association of a generic is handled elsewhere
8530	CHECK(existing->has<HostAssocDetails>());
8531	}
8532	} else {
8533	// Create a new generic for this scope.
8534	}
8535	} else if (ultimate.has<SubprogramDetails>() ||
8536	ultimate.has<SubprogramNameDetails>()) {
8537	genericDetails.set_specific(*existing);
8538	} else if (ultimate.has<ProcEntityDetails>()) {
8539	if (existing->name() != symbolName ||
8540	!ultimate.attrs().test(Attr::INTRINSIC)) {
8541	genericDetails.set_specific(*existing);
8542	}
8543	} else if (ultimate.has<DerivedTypeDetails>()) {
8544	genericDetails.set_derivedType(*existing);
8545	} else if (&existing->owner() == &currScope()) {
8546	SayAlreadyDeclared(symbolName, *existing);
8547	return;
8548	}
8549	if (&existing->owner() == &currScope()) {
8550	EraseSymbol(*existing);
8551	}
8552	}
8553	info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
8554	}
8555
8556	void ResolveNamesVisitor::FinishSpecificationPart(
8557	const std::list<parser::DeclarationConstruct> &decls) {
8558	misparsedStmtFuncFound_ = false;
8559	funcResultStack().CompleteFunctionResultType();
8560	CheckImports();
8561	for (auto &pair : currScope()) {
8562	auto &symbol{*pair.second};
8563	if (NeedsExplicitType(symbol)) {
8564	ApplyImplicitRules(symbol);
8565	}
8566	if (IsDummy(symbol) && isImplicitNoneType() &&
8567	symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
8568	Say(symbol.name(),
8569	"No explicit type declared for dummy argument '%s'"_err_en_US);
8570	context().SetError(symbol);
8571	}
8572	if (symbol.has<GenericDetails>()) {
8573	CheckGenericProcedures(symbol);
8574	}
8575	if (!symbol.has<HostAssocDetails>()) {
8576	CheckPossibleBadForwardRef(symbol);
8577	}
8578	}
8579	currScope().InstantiateDerivedTypes();
8580	for (const auto &decl : decls) {
8581	if (const auto *statement{std::get_if<
8582	parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(
8583	&decl.u)}) {
8584	messageHandler().set_currStmtSource(statement->source);
8585	AnalyzeStmtFunctionStmt(statement->statement.value());
8586	}
8587	}
8588	// TODO: what about instantiations in BLOCK?
8589	CheckSaveStmts();
8590	CheckCommonBlocks();
8591	if (!inInterfaceBlock()) {
8592	// TODO: warn for the case where the EQUIVALENCE statement is in a
8593	// procedure declaration in an interface block
8594	CheckEquivalenceSets();
8595	}
8596	}
8597
8598	// Analyze the bodies of statement functions now that the symbols in this
8599	// specification part have been fully declared and implicitly typed.
8600	// (Statement function references are not allowed in specification
8601	// expressions, so it's safe to defer processing their definitions.)
8602	void ResolveNamesVisitor::AnalyzeStmtFunctionStmt(
8603	const parser::StmtFunctionStmt &stmtFunc) {
8604	const auto &name{std::get<parser::Name>(stmtFunc.t)};
8605	Symbol *symbol{name.symbol};
8606	auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr};
8607	if (!details || !symbol->scope() ||
8608	&symbol->scope()->parent() != &currScope() || details->isInterface() ||
8609	details->isDummy() || details->entryScope() ||
8610	details->moduleInterface() || symbol->test(Symbol::Flag::Subroutine)) {
8611	return; // error recovery
8612	}
8613	// Resolve the symbols on the RHS of the statement function.
8614	PushScope(scope&: *symbol->scope());
8615	const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)};
8616	Walk(parsedExpr);
8617	PopScope();
8618	if (auto expr{AnalyzeExpr(context(), stmtFunc)}) {
8619	if (auto type{evaluate::DynamicType::From(*symbol)}) {
8620	if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) {
8621	details->set_stmtFunction(std::move(*converted));
8622	} else {
8623	Say(name.source,
8624	"Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US,
8625	name.source, type->AsFortran());
8626	}
8627	} else {
8628	details->set_stmtFunction(std::move(*expr));
8629	}
8630	}
8631	if (!details->stmtFunction()) {
8632	context().SetError(*symbol);
8633	}
8634	}
8635
8636	void ResolveNamesVisitor::CheckImports() {
8637	auto &scope{currScope()};
8638	switch (scope.GetImportKind()) {
8639	case common::ImportKind::None:
8640	break;
8641	case common::ImportKind::All:
8642	// C8102: all entities in host must not be hidden
8643	for (const auto &pair : scope.parent()) {
8644	auto &name{pair.first};
8645	std::optional<SourceName> scopeName{scope.GetName()};
8646	if (!scopeName || name != *scopeName) {
8647	CheckImport(prevImportStmt_.value(), name);
8648	}
8649	}
8650	break;
8651	case common::ImportKind::Default:
8652	case common::ImportKind::Only:
8653	// C8102: entities named in IMPORT must not be hidden
8654	for (auto &name : scope.importNames()) {
8655	CheckImport(name, name);
8656	}
8657	break;
8658	}
8659	}
8660
8661	void ResolveNamesVisitor::CheckImport(
8662	const SourceName &location, const SourceName &name) {
8663	if (auto *symbol{FindInScope(name)}) {
8664	const Symbol &ultimate{symbol->GetUltimate()};
8665	if (&ultimate.owner() == &currScope()) {
8666	Say(location, "'%s' from host is not accessible"_err_en_US, name)
8667	.Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US,
8668	symbol->name());
8669	}
8670	}
8671	}
8672
8673	bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {
8674	return CheckNotInBlock("IMPLICIT") && // C1107
8675	ImplicitRulesVisitor::Pre(x);
8676	}
8677
8678	void ResolveNamesVisitor::Post(const parser::PointerObject &x) {
8679	common::visit(common::visitors{
8680	[&](const parser::Name &x) { ResolveName(x); },
8681	[&](const parser::StructureComponent &x) {
8682	ResolveStructureComponent(x);
8683	},
8684	},
8685	x.u);
8686	}
8687	void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {
8688	common::visit(common::visitors{
8689	[&](const parser::Name &x) { ResolveName(x); },
8690	[&](const parser::StructureComponent &x) {
8691	ResolveStructureComponent(x);
8692	},
8693	},
8694	x.u);
8695	}
8696
8697	bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
8698	const auto &dataRef{std::get<parser::DataRef>(x.t)};
8699	const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
8700	const auto &expr{std::get<parser::Expr>(x.t)};
8701	ResolveDataRef(x: dataRef);
8702	Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
8703	Walk(bounds);
8704	// Resolve unrestricted specific intrinsic procedures as in "p => cos".
8705	if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
8706	if (NameIsKnownOrIntrinsic(*name)) {
8707	if (Symbol * symbol{name->symbol}) {
8708	if (IsProcedurePointer(ptrSymbol) &&
8709	!ptrSymbol->test(Symbol::Flag::Function) &&
8710	!ptrSymbol->test(Symbol::Flag::Subroutine)) {
8711	if (symbol->test(Symbol::Flag::Function)) {
8712	ApplyImplicitRules(*ptrSymbol);
8713	}
8714	}
8715	// If the name is known because it is an object entity from a host
8716	// procedure, create a host associated symbol.
8717	if (symbol->GetUltimate().has<ObjectEntityDetails>() &&
8718	IsUplevelReference(*symbol)) {
8719	MakeHostAssocSymbol(*name, *symbol);
8720	}
8721	}
8722	return false;
8723	}
8724	// Can also reference a global external procedure here
8725	if (auto it{context().globalScope().find(name->source)};
8726	it != context().globalScope().end()) {
8727	Symbol &global{*it->second};
8728	if (IsProcedure(global)) {
8729	Resolve(*name, global);
8730	return false;
8731	}
8732	}
8733	if (IsProcedurePointer(parser::GetLastName(dataRef).symbol) &&
8734	!FindSymbol(*name)) {
8735	// Unknown target of procedure pointer must be an external procedure
8736	Symbol &symbol{MakeSymbol(
8737	context().globalScope(), name->source, Attrs{Attr::EXTERNAL})};
8738	symbol.implicitAttrs().set(Attr::EXTERNAL);
8739	Resolve(*name, symbol);
8740	ConvertToProcEntity(symbol, usedHere: name->source);
8741	return false;
8742	}
8743	}
8744	Walk(expr);
8745	return false;
8746	}
8747	void ResolveNamesVisitor::Post(const parser::Designator &x) {
8748	ResolveDesignator(x);
8749	}
8750	void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) {
8751	Walk(std::get<parser::SubstringRange>(x.v.t).t);
8752	ResolveDataRef(x: std::get<parser::DataRef>(x.v.t));
8753	}
8754
8755	void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
8756	ResolveStructureComponent(x.v.thing);
8757	}
8758	void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {
8759	DeclTypeSpecVisitor::Post(x);
8760	ConstructVisitor::Post(x);
8761	}
8762	bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
8763	if (HandleStmtFunction(x)) {
8764	return false;
8765	} else {
8766	// This is an array element or pointer-valued function assignment:
8767	// resolve the names of indices/arguments
8768	const auto &names{std::get<std::list<parser::Name>>(x.t)};
8769	for (auto &name : names) {
8770	ResolveName(name);
8771	}
8772	return true;
8773	}
8774	}
8775
8776	bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {
8777	const parser::Name &name{x.v};
8778	if (FindSymbol(name)) {
8779	// OK
8780	} else if (IsLogicalConstant(context(), name.source)) {
8781	Say(name,
8782	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
8783	} else {
8784	// Resolved later in expression semantics
8785	MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);
8786	}
8787	return false;
8788	}
8789
8790	void ResolveNamesVisitor::Post(const parser::AssignStmt &x) {
8791	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
8792	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
8793	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
8794	}
8795	}
8796	void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {
8797	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
8798	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
8799	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
8800	}
8801	}
8802
8803	void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
8804	if (const auto *tkr{
8805	std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) {
8806	if (currScope().IsTopLevel() ||
8807	GetProgramUnitContaining(currScope()).kind() !=
8808	Scope::Kind::Subprogram) {
8809	Say(x.source,
8810	"!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US);
8811	return;
8812	}
8813	if (!inSpecificationPart_) {
8814	Say(x.source,
8815	"!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US);
8816	return;
8817	}
8818	if (tkr->empty()) {
8819	Symbol *symbol{currScope().symbol()};
8820	if (SubprogramDetails *
8821	subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) {
8822	subp->set_defaultIgnoreTKR(true);
8823	}
8824	} else {
8825	for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) {
8826	common::IgnoreTKRSet set;
8827	if (const auto &maybeList{
8828	std::get<std::optional<std::list<const char *>>>(item.t)}) {
8829	for (const char *p : *maybeList) {
8830	if (p) {
8831	switch (*p) {
8832	case 't':
8833	set.set(common::IgnoreTKR::Type);
8834	break;
8835	case 'k':
8836	set.set(common::IgnoreTKR::Kind);
8837	break;
8838	case 'r':
8839	set.set(common::IgnoreTKR::Rank);
8840	break;
8841	case 'd':
8842	set.set(common::IgnoreTKR::Device);
8843	break;
8844	case 'm':
8845	set.set(common::IgnoreTKR::Managed);
8846	break;
8847	case 'c':
8848	set.set(common::IgnoreTKR::Contiguous);
8849	break;
8850	case 'a':
8851	set = common::ignoreTKRAll;
8852	break;
8853	default:
8854	Say(x.source,
8855	"'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US,
8856	*p);
8857	set = common::ignoreTKRAll;
8858	break;
8859	}
8860	}
8861	}
8862	if (set.empty()) {
8863	Say(x.source,
8864	"!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US);
8865	}
8866	} else { // no (list)
8867	set = common::ignoreTKRAll;
8868	;
8869	}
8870	const auto &name{std::get<parser::Name>(item.t)};
8871	Symbol *symbol{FindSymbol(name)};
8872	if (!symbol) {
8873	symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{});
8874	}
8875	if (symbol->owner() != currScope()) {
8876	SayWithDecl(
8877	name, *symbol, "'%s' must be local to this subprogram"_err_en_US);
8878	} else {
8879	ConvertToObjectEntity(*symbol);
8880	if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) {
8881	object->set_ignoreTKR(set);
8882	} else {
8883	SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US);
8884	}
8885	}
8886	}
8887	}
8888	} else {
8889	Say(x.source, "Compiler directive was ignored"_warn_en_US);
8890	}
8891	}
8892
8893	bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
8894	if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
8895	x.u)) {
8896	// TODO: global directives
8897	return true;
8898	}
8899	if (std::holds_alternative<
8900	common::Indirection<parser::OpenACCRoutineConstruct>>(x.u)) {
8901	ResolveAccParts(context(), x, &topScope_);
8902	return false;
8903	}
8904	auto root{ProgramTree::Build(x)};
8905	SetScope(topScope_);
8906	ResolveSpecificationParts(root);
8907	FinishSpecificationParts(root);
8908	ResolveExecutionParts(root);
8909	FinishExecutionParts(root);
8910	ResolveAccParts(context(), x);
8911	ResolveOmpParts(context(), x);
8912	return false;
8913	}
8914
8915	template <typename A> std::set<SourceName> GetUses(const A &x) {
8916	std::set<SourceName> uses;
8917	if constexpr (!std::is_same_v<A, parser::CompilerDirective> &&
8918	!std::is_same_v<A, parser::OpenACCRoutineConstruct>) {
8919	const auto &spec{std::get<parser::SpecificationPart>(x.t)};
8920	const auto &unitUses{std::get<
8921	std::list<parser::Statement<common::Indirection<parser::UseStmt>>>>(
8922	spec.t)};
8923	for (const auto &u : unitUses) {
8924	uses.insert(u.statement.value().moduleName.source);
8925	}
8926	}
8927	return uses;
8928	}
8929
8930	bool ResolveNamesVisitor::Pre(const parser::Program &x) {
8931	std::map<SourceName, const parser::ProgramUnit *> modules;
8932	std::set<SourceName> uses;
8933	bool disordered{false};
8934	for (const auto &progUnit : x.v) {
8935	if (const auto *indMod{
8936	std::get_if<common::Indirection<parser::Module>>(&progUnit.u)}) {
8937	const parser::Module &mod{indMod->value()};
8938	const auto &moduleStmt{
8939	std::get<parser::Statement<parser::ModuleStmt>>(mod.t)};
8940	const SourceName &name{moduleStmt.statement.v.source};
8941	if (auto iter{modules.find(name)}; iter != modules.end()) {
8942	Say(name,
8943	"Module '%s' appears multiple times in a compilation unit"_err_en_US)
8944	.Attach(iter->first, "First definition of module"_en_US);
8945	return true;
8946	}
8947	modules.emplace(name, &progUnit);
8948	if (auto iter{uses.find(name)}; iter != uses.end()) {
8949	if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
8950	Say(name,
8951	"A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US)
8952	.Attach(*iter, "First USE of module"_en_US);
8953	}
8954	disordered = true;
8955	}
8956	}
8957	for (SourceName used : common::visit(
8958	[](const auto &indUnit) { return GetUses(indUnit.value()); },
8959	progUnit.u)) {
8960	uses.insert(used);
8961	}
8962	}
8963	if (!disordered) {
8964	return true;
8965	}
8966	// Process modules in topological order
8967	std::vector<const parser::ProgramUnit *> moduleOrder;
8968	while (!modules.empty()) {
8969	bool ok;
8970	for (const auto &pair : modules) {
8971	const SourceName &name{pair.first};
8972	const parser::ProgramUnit &progUnit{*pair.second};
8973	const parser::Module &m{
8974	std::get<common::Indirection<parser::Module>>(progUnit.u).value()};
8975	ok = true;
8976	for (const SourceName &use : GetUses(m)) {
8977	if (modules.find(use) != modules.end()) {
8978	ok = false;
8979	break;
8980	}
8981	}
8982	if (ok) {
8983	moduleOrder.push_back(x: &progUnit);
8984	modules.erase(x: name);
8985	break;
8986	}
8987	}
8988	if (!ok) {
8989	parser::Message *msg{nullptr};
8990	for (const auto &pair : modules) {
8991	if (msg) {
8992	msg->Attach(pair.first, "Module in a cycle"_en_US);
8993	} else {
8994	msg = &Say(pair.first,
8995	"Some modules in this compilation unit form one or more cycles of dependence"_err_en_US);
8996	}
8997	}
8998	return false;
8999	}
9000	}
9001	// Modules can be ordered. Process them first, and then all of the other
9002	// program units.
9003	for (const parser::ProgramUnit *progUnit : moduleOrder) {
9004	Walk(*progUnit);
9005	}
9006	for (const auto &progUnit : x.v) {
9007	if (!std::get_if<common::Indirection<parser::Module>>(&progUnit.u)) {
9008	Walk(progUnit);
9009	}
9010	}
9011	return false;
9012	}
9013
9014	// References to procedures need to record that their symbols are known
9015	// to be procedures, so that they don't get converted to objects by default.
9016	class ExecutionPartCallSkimmer : public ExecutionPartSkimmerBase {
9017	public:
9018	explicit ExecutionPartCallSkimmer(ResolveNamesVisitor &resolver)
9019	: resolver_{resolver} {}
9020
9021	void Walk(const parser::ExecutionPart &exec) {
9022	parser::Walk(exec, *this);
9023	EndWalk();
9024	}
9025
9026	using ExecutionPartSkimmerBase::Post;
9027	using ExecutionPartSkimmerBase::Pre;
9028
9029	void Post(const parser::FunctionReference &fr) {
9030	NoteCall(Symbol::Flag::Function, fr.v, false);
9031	}
9032	void Post(const parser::CallStmt &cs) {
9033	NoteCall(Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
9034	}
9035
9036	private:
9037	void NoteCall(
9038	Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
9039	auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
9040	if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
9041	if (!IsHidden(name: name->source)) {
9042	resolver_.NoteExecutablePartCall(flag, name->source, hasCUDAChevrons);
9043	}
9044	}
9045	}
9046
9047	ResolveNamesVisitor &resolver_;
9048	};
9049
9050	// Build the scope tree and resolve names in the specification parts of this
9051	// node and its children
9052	void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
9053	if (node.isSpecificationPartResolved()) {
9054	return; // been here already
9055	}
9056	node.set_isSpecificationPartResolved();
9057	if (!BeginScopeForNode(node)) {
9058	return; // an error prevented scope from being created
9059	}
9060	Scope &scope{currScope()};
9061	node.set_scope(scope);
9062	AddSubpNames(node);
9063	common::visit(
9064	[&](const auto *x) {
9065	if (x) {
9066	Walk(*x);
9067	}
9068	},
9069	node.stmt());
9070	Walk(node.spec());
9071	// If this is a function, convert result to an object. This is to prevent the
9072	// result from being converted later to a function symbol if it is called
9073	// inside the function.
9074	// If the result is function pointer, then ConvertToObjectEntity will not
9075	// convert the result to an object, and calling the symbol inside the function
9076	// will result in calls to the result pointer.
9077	// A function cannot be called recursively if RESULT was not used to define a
9078	// distinct result name (15.6.2.2 point 4.).
9079	if (Symbol * symbol{scope.symbol()}) {
9080	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
9081	if (details->isFunction()) {
9082	ConvertToObjectEntity(const_cast<Symbol &>(details->result()));
9083	}
9084	}
9085	}
9086	if (node.IsModule()) {
9087	ApplyDefaultAccess();
9088	}
9089	for (auto &child : node.children()) {
9090	ResolveSpecificationParts(node&: child);
9091	}
9092	if (node.exec()) {
9093	ExecutionPartCallSkimmer{*this}.Walk(*node.exec());
9094	HandleImpliedAsynchronousInScope(node.exec()->v);
9095	}
9096	EndScopeForNode(node);
9097	// Ensure that every object entity has a type.
9098	bool inModule{node.GetKind() == ProgramTree::Kind::Module ||
9099	node.GetKind() == ProgramTree::Kind::Submodule};
9100	for (auto &pair : *node.scope()) {
9101	Symbol &symbol{*pair.second};
9102	if (inModule && symbol.attrs().test(Attr::EXTERNAL) &&
9103	!symbol.test(Symbol::Flag::Function) &&
9104	!symbol.test(Symbol::Flag::Subroutine)) {
9105	// in a module, external proc without return type is subroutine
9106	symbol.set(
9107	symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
9108	}
9109	ApplyImplicitRules(symbol);
9110	}
9111	}
9112
9113	// Add SubprogramNameDetails symbols for module and internal subprograms and
9114	// their ENTRY statements.
9115	void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
9116	auto kind{
9117	node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
9118	for (auto &child : node.children()) {
9119	auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
9120	if (child.HasModulePrefix()) {
9121	SetExplicitAttr(symbol, Attr::MODULE);
9122	}
9123	auto childKind{child.GetKind()};
9124	if (childKind == ProgramTree::Kind::Function) {
9125	symbol.set(Symbol::Flag::Function);
9126	} else if (childKind == ProgramTree::Kind::Subroutine) {
9127	symbol.set(Symbol::Flag::Subroutine);
9128	} else {
9129	continue; // make ENTRY symbols only where valid
9130	}
9131	for (const auto &entryStmt : child.entryStmts()) {
9132	SubprogramNameDetails details{kind, child};
9133	auto &symbol{
9134	MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
9135	symbol.set(child.GetSubpFlag());
9136	if (child.HasModulePrefix()) {
9137	SetExplicitAttr(symbol, Attr::MODULE);
9138	}
9139	}
9140	}
9141	for (const auto &generic : node.genericSpecs()) {
9142	if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {
9143	if (currScope().find(name->source) != currScope().end()) {
9144	// If this scope has both a generic interface and a contained
9145	// subprogram with the same name, create the generic's symbol
9146	// now so that any other generics of the same name that are pulled
9147	// into scope later via USE association will properly merge instead
9148	// of raising a bogus error due a conflict with the subprogram.
9149	CreateGeneric(*generic);
9150	}
9151	}
9152	}
9153	}
9154
9155	// Push a new scope for this node or return false on error.
9156	bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
9157	switch (node.GetKind()) {
9158	SWITCH_COVERS_ALL_CASES
9159	case ProgramTree::Kind::Program:
9160	PushScope(Scope::Kind::MainProgram,
9161	&MakeSymbol(node.name(), MainProgramDetails{}));
9162	return true;
9163	case ProgramTree::Kind::Function:
9164	case ProgramTree::Kind::Subroutine:
9165	return BeginSubprogram(node.name(), node.GetSubpFlag(),
9166	node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts());
9167	case ProgramTree::Kind::MpSubprogram:
9168	return BeginMpSubprogram(name: node.name());
9169	case ProgramTree::Kind::Module:
9170	BeginModule(name: node.name(), isSubmodule: false);
9171	return true;
9172	case ProgramTree::Kind::Submodule:
9173	return BeginSubmodule(node.name(), node.GetParentId());
9174	case ProgramTree::Kind::BlockData:
9175	PushBlockDataScope(name: node.name());
9176	return true;
9177	}
9178	}
9179
9180	void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) {
9181	std::optional<parser::CharBlock> stmtSource;
9182	const std::optional<parser::LanguageBindingSpec> *binding{nullptr};
9183	common::visit(
9184	common::visitors{
9185	[&](const parser::Statement<parser::FunctionStmt> *stmt) {
9186	if (stmt) {
9187	stmtSource = stmt->source;
9188	if (const auto &maybeSuffix{
9189	std::get<std::optional<parser::Suffix>>(
9190	stmt->statement.t)}) {
9191	binding = &maybeSuffix->binding;
9192	}
9193	}
9194	},
9195	[&](const parser::Statement<parser::SubroutineStmt> *stmt) {
9196	if (stmt) {
9197	stmtSource = stmt->source;
9198	binding = &std::get<std::optional<parser::LanguageBindingSpec>>(
9199	stmt->statement.t);
9200	}
9201	},
9202	[](const auto *) {},
9203	},
9204	node.stmt());
9205	EndSubprogram(stmtSource, binding, &node.entryStmts());
9206	}
9207
9208	// Some analyses and checks, such as the processing of initializers of
9209	// pointers, are deferred until all of the pertinent specification parts
9210	// have been visited. This deferred processing enables the use of forward
9211	// references in these circumstances.
9212	// Data statement objects with implicit derived types are finally
9213	// resolved here.
9214	class DeferredCheckVisitor {
9215	public:
9216	explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)
9217	: resolver_{resolver} {}
9218
9219	template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
9220
9221	template <typename A> bool Pre(const A &) { return true; }
9222	template <typename A> void Post(const A &) {}
9223
9224	void Post(const parser::DerivedTypeStmt &x) {
9225	const auto &name{std::get<parser::Name>(x.t)};
9226	if (Symbol * symbol{name.symbol}) {
9227	if (Scope * scope{symbol->scope()}) {
9228	if (scope->IsDerivedType()) {
9229	CHECK(outerScope_ == nullptr);
9230	outerScope_ = &resolver_.currScope();
9231	resolver_.SetScope(*scope);
9232	}
9233	}
9234	}
9235	}
9236	void Post(const parser::EndTypeStmt &) {
9237	if (outerScope_) {
9238	resolver_.SetScope(*outerScope_);
9239	outerScope_ = nullptr;
9240	}
9241	}
9242
9243	void Post(const parser::ProcInterface &pi) {
9244	if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
9245	resolver_.CheckExplicitInterface(name: *name);
9246	}
9247	}
9248	bool Pre(const parser::EntityDecl &decl) {
9249	Init(std::get<parser::Name>(decl.t),
9250	std::get<std::optional<parser::Initialization>>(decl.t));
9251	return false;
9252	}
9253	bool Pre(const parser::ComponentDecl &decl) {
9254	Init(std::get<parser::Name>(decl.t),
9255	std::get<std::optional<parser::Initialization>>(decl.t));
9256	return false;
9257	}
9258	bool Pre(const parser::ProcDecl &decl) {
9259	if (const auto &init{
9260	std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {
9261	resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init);
9262	}
9263	return false;
9264	}
9265	void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) {
9266	resolver_.CheckExplicitInterface(name: tbps.interfaceName);
9267	}
9268	void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
9269	if (outerScope_) {
9270	resolver_.CheckBindings(tbps);
9271	}
9272	}
9273	bool Pre(const parser::DataStmtObject &) {
9274	++dataStmtObjectNesting_;
9275	return true;
9276	}
9277	void Post(const parser::DataStmtObject &) { --dataStmtObjectNesting_; }
9278	void Post(const parser::Designator &x) {
9279	if (dataStmtObjectNesting_ > 0) {
9280	resolver_.ResolveDesignator(x);
9281	}
9282	}
9283
9284	private:
9285	void Init(const parser::Name &name,
9286	const std::optional<parser::Initialization> &init) {
9287	if (init) {
9288	if (const auto *target{
9289	std::get_if<parser::InitialDataTarget>(&init->u)}) {
9290	resolver_.PointerInitialization(name, *target);
9291	} else if (const auto *expr{
9292	std::get_if<parser::ConstantExpr>(&init->u)}) {
9293	if (name.symbol) {
9294	if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};
9295	!object || !object->init()) {
9296	resolver_.NonPointerInitialization(name, *expr);
9297	}
9298	}
9299	}
9300	}
9301	}
9302
9303	ResolveNamesVisitor &resolver_;
9304	Scope *outerScope_{nullptr};
9305	int dataStmtObjectNesting_{0};
9306	};
9307
9308	// Perform checks and completions that need to happen after all of
9309	// the specification parts but before any of the execution parts.
9310	void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
9311	if (!node.scope()) {
9312	return; // error occurred creating scope
9313	}
9314	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
9315	SetScope(*node.scope());
9316	// The initializers of pointers and non-PARAMETER objects, the default
9317	// initializers of components, and non-deferred type-bound procedure
9318	// bindings have not yet been traversed.
9319	// We do that now, when any forward references that appeared
9320	// in those initializers will resolve to the right symbols without
9321	// incurring spurious errors with IMPLICIT NONE or forward references
9322	// to nested subprograms.
9323	DeferredCheckVisitor{*this}.Walk(node.spec());
9324	for (Scope &childScope : currScope().children()) {
9325	if (childScope.IsParameterizedDerivedTypeInstantiation()) {
9326	FinishDerivedTypeInstantiation(childScope);
9327	}
9328	}
9329	for (const auto &child : node.children()) {
9330	FinishSpecificationParts(node: child);
9331	}
9332	}
9333
9334	void ResolveNamesVisitor::FinishExecutionParts(const ProgramTree &node) {
9335	if (node.scope()) {
9336	SetScope(*node.scope());
9337	if (node.exec()) {
9338	DeferredCheckVisitor{*this}.Walk(*node.exec());
9339	}
9340	for (const auto &child : node.children()) {
9341	FinishExecutionParts(node: child);
9342	}
9343	}
9344	}
9345
9346	// Duplicate and fold component object pointer default initializer designators
9347	// using the actual type parameter values of each particular instantiation.
9348	// Validation is done later in declaration checking.
9349	void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
9350	CHECK(scope.IsDerivedType() && !scope.symbol());
9351	if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
9352	spec->Instantiate(currScope());
9353	const Symbol &origTypeSymbol{spec->typeSymbol()};
9354	if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
9355	CHECK(origTypeScope->IsDerivedType() &&
9356	origTypeScope->symbol() == &origTypeSymbol);
9357	auto &foldingContext{GetFoldingContext()};
9358	auto restorer{foldingContext.WithPDTInstance(*spec)};
9359	for (auto &pair : scope) {
9360	Symbol &comp{*pair.second};
9361	const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};
9362	if (IsPointer(comp)) {
9363	if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
9364	auto origDetails{origComp.get<ObjectEntityDetails>()};
9365	if (const MaybeExpr & init{origDetails.init()}) {
9366	SomeExpr newInit{*init};
9367	MaybeExpr folded{FoldExpr(std::move(newInit))};
9368	details->set_init(std::move(folded));
9369	}
9370	}
9371	}
9372	}
9373	}
9374	}
9375	}
9376
9377	// Resolve names in the execution part of this node and its children
9378	void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {
9379	if (!node.scope()) {
9380	return; // error occurred creating scope
9381	}
9382	SetScope(*node.scope());
9383	if (const auto *exec{node.exec()}) {
9384	Walk(*exec);
9385	}
9386	FinishNamelists();
9387	if (node.IsModule()) {
9388	// A second final pass to catch new symbols added from implicitly
9389	// typed names in NAMELIST groups or the specification parts of
9390	// module subprograms.
9391	ApplyDefaultAccess();
9392	}
9393	PopScope(); // converts unclassified entities into objects
9394	for (const auto &child : node.children()) {
9395	ResolveExecutionParts(node: child);
9396	}
9397	}
9398
9399	void ResolveNamesVisitor::Post(const parser::Program &x) {
9400	// ensure that all temps were deallocated
9401	CHECK(!attrs_);
9402	CHECK(!cudaDataAttr_);
9403	CHECK(!GetDeclTypeSpec());
9404	// Top-level resolution to propagate information across program units after
9405	// each of them has been resolved separately.
9406	ResolveOmpTopLevelParts(context(), x);
9407	}
9408
9409	// A singleton instance of the scope -> IMPLICIT rules mapping is
9410	// shared by all instances of ResolveNamesVisitor and accessed by this
9411	// pointer when the visitors (other than the top-level original) are
9412	// constructed.
9413	static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};
9414
9415	bool ResolveNames(
9416	SemanticsContext &context, const parser::Program &program, Scope &top) {
9417	ImplicitRulesMap implicitRulesMap;
9418	auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)};
9419	ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program);
9420	return !context.AnyFatalError();
9421	}
9422
9423	// Processes a module (but not internal) function when it is referenced
9424	// in a specification expression in a sibling procedure.
9425	void ResolveSpecificationParts(
9426	SemanticsContext &context, const Symbol &subprogram) {
9427	auto originalLocation{context.location()};
9428	ImplicitRulesMap implicitRulesMap;
9429	bool localImplicitRulesMap{false};
9430	if (!sharedImplicitRulesMap) {
9431	sharedImplicitRulesMap = &implicitRulesMap;
9432	localImplicitRulesMap = true;
9433	}
9434	ResolveNamesVisitor visitor{
9435	context, *sharedImplicitRulesMap, context.globalScope()};
9436	const auto &details{subprogram.get<SubprogramNameDetails>()};
9437	ProgramTree &node{details.node()};
9438	const Scope &moduleScope{subprogram.owner()};
9439	if (localImplicitRulesMap) {
9440	visitor.BeginScope(const_cast<Scope &>(moduleScope));
9441	} else {
9442	visitor.SetScope(const_cast<Scope &>(moduleScope));
9443	}
9444	visitor.ResolveSpecificationParts(node);
9445	context.set_location(std::move(originalLocation));
9446	if (localImplicitRulesMap) {
9447	sharedImplicitRulesMap = nullptr;
9448	}
9449	}
9450
9451	} // namespace Fortran::semantics
9452