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 "resolve-directives.h"
14	#include "resolve-names-utils.h"
15	#include "rewrite-parse-tree.h"
16	#include "flang/Common/indirection.h"
17	#include "flang/Common/restorer.h"
18	#include "flang/Common/visit.h"
19	#include "flang/Evaluate/characteristics.h"
20	#include "flang/Evaluate/check-expression.h"
21	#include "flang/Evaluate/common.h"
22	#include "flang/Evaluate/fold-designator.h"
23	#include "flang/Evaluate/fold.h"
24	#include "flang/Evaluate/intrinsics.h"
25	#include "flang/Evaluate/tools.h"
26	#include "flang/Evaluate/type.h"
27	#include "flang/Parser/parse-tree-visitor.h"
28	#include "flang/Parser/parse-tree.h"
29	#include "flang/Parser/tools.h"
30	#include "flang/Semantics/attr.h"
31	#include "flang/Semantics/expression.h"
32	#include "flang/Semantics/openmp-modifiers.h"
33	#include "flang/Semantics/program-tree.h"
34	#include "flang/Semantics/scope.h"
35	#include "flang/Semantics/semantics.h"
36	#include "flang/Semantics/symbol.h"
37	#include "flang/Semantics/tools.h"
38	#include "flang/Semantics/type.h"
39	#include "flang/Support/Fortran.h"
40	#include "flang/Support/default-kinds.h"
41	#include "llvm/ADT/StringSwitch.h"
42	#include "llvm/Support/raw_ostream.h"
43	#include <list>
44	#include <map>
45	#include <set>
46	#include <stack>
47
48	namespace Fortran::semantics {
49
50	using namespace parser::literals;
51
52	template <typename T> using Indirection = common::Indirection<T>;
53	using Message = parser::Message;
54	using Messages = parser::Messages;
55	using MessageFixedText = parser::MessageFixedText;
56	using MessageFormattedText = parser::MessageFormattedText;
57
58	class ResolveNamesVisitor;
59	class ScopeHandler;
60
61	// ImplicitRules maps initial character of identifier to the DeclTypeSpec
62	// representing the implicit type; std::nullopt if none.
63	// It also records the presence of IMPLICIT NONE statements.
64	// When inheritFromParent is set, defaults come from the parent rules.
65	class ImplicitRules {
66	public:
67	ImplicitRules(SemanticsContext &context, const ImplicitRules *parent)
68	: parent_{parent}, context_{context},
69	inheritFromParent_{parent != nullptr} {}
70	bool isImplicitNoneType() const;
71	bool isImplicitNoneExternal() const;
72	void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
73	void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
74	void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
75	// Get the implicit type for this name. May be null.
76	const DeclTypeSpec *GetType(
77	SourceName, bool respectImplicitNone = true) const;
78	// Record the implicit type for the range of characters [fromLetter,
79	// toLetter].
80	void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
81	parser::Location toLetter);
82
83	private:
84	static char Incr(char ch);
85
86	const ImplicitRules *parent_;
87	SemanticsContext &context_;
88	bool inheritFromParent_{false}; // look in parent if not specified here
89	bool isImplicitNoneType_{
90	context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)};
91	bool isImplicitNoneExternal_{
92	context_.IsEnabled(common::LanguageFeature::ImplicitNoneExternal)};
93	// map_ contains the mapping between letters and types that were defined
94	// by the IMPLICIT statements of the related scope. It does not contain
95	// the default Fortran mappings nor the mapping defined in parents.
96	std::map<char, common::Reference<const DeclTypeSpec>> map_;
97
98	friend llvm::raw_ostream &operator<<(
99	llvm::raw_ostream &, const ImplicitRules &);
100	friend void ShowImplicitRule(
101	llvm::raw_ostream &, const ImplicitRules &, char);
102	};
103
104	// scope -> implicit rules for that scope
105	using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>;
106
107	// Track statement source locations and save messages.
108	class MessageHandler {
109	public:
110	MessageHandler() { DIE("MessageHandler: default-constructed"); }
111	explicit MessageHandler(SemanticsContext &c) : context_{&c} {}
112	Messages &messages() { return context_->messages(); };
113	const std::optional<SourceName> &currStmtSource() {
114	return context_->location();
115	}
116	void set_currStmtSource(const std::optional<SourceName> &source) {
117	context_->set_location(source);
118	}
119
120	// Emit a message associated with the current statement source.
121	Message &Say(MessageFixedText &&);
122	Message &Say(MessageFormattedText &&);
123	// Emit a message about a SourceName
124	Message &Say(const SourceName &, MessageFixedText &&);
125	// Emit a formatted message associated with a source location.
126	template <typename... A>
127	Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) {
128	return context_->Say(source, std::move(msg), std::forward<A>(args)...);
129	}
130
131	private:
132	SemanticsContext *context_;
133	};
134
135	// Inheritance graph for the parse tree visitation classes that follow:
136	// BaseVisitor
137	// + AttrsVisitor
138	// | + DeclTypeSpecVisitor
139	// | + ImplicitRulesVisitor
140	// | + ScopeHandler ------------------+
141	// | + ModuleVisitor -------------+ |
142	// | + GenericHandler -------+ | |
143	// | | + InterfaceVisitor | | |
144	// | +-+ SubprogramVisitor ==|==+ | |
145	// + ArraySpecVisitor | | | |
146	// + DeclarationVisitor <--------+ | | |
147	// + ConstructVisitor | | |
148	// + ResolveNamesVisitor <------+-+-+
149
150	class BaseVisitor {
151	public:
152	BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
153	BaseVisitor(
154	SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)
155	: implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {
156	}
157	template <typename T> void Walk(const T &);
158
159	MessageHandler &messageHandler() { return messageHandler_; }
160	const std::optional<SourceName> &currStmtSource() {
161	return context_->location();
162	}
163	SemanticsContext &context() const { return *context_; }
164	evaluate::FoldingContext &GetFoldingContext() const {
165	return context_->foldingContext();
166	}
167	bool IsIntrinsic(
168	const SourceName &name, std::optional<Symbol::Flag> flag) const {
169	if (!flag) {
170	return context_->intrinsics().IsIntrinsic(name.ToString());
171	} else if (flag == Symbol::Flag::Function) {
172	return context_->intrinsics().IsIntrinsicFunction(name.ToString());
173	} else if (flag == Symbol::Flag::Subroutine) {
174	return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());
175	} else {
176	DIE("expected Subroutine or Function flag");
177	}
178	}
179
180	bool InModuleFile() const {
181	return GetFoldingContext().moduleFileName().has_value();
182	}
183
184	// Make a placeholder symbol for a Name that otherwise wouldn't have one.
185	// It is not in any scope and always has MiscDetails.
186	void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
187
188	template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
189	return evaluate::Fold(GetFoldingContext(), std::move(expr));
190	}
191
192	template <typename T> MaybeExpr EvaluateExpr(const T &expr) {
193	return FoldExpr(AnalyzeExpr(*context_, expr));
194	}
195
196	template <typename T>
197	MaybeExpr EvaluateNonPointerInitializer(
198	const Symbol &symbol, const T &expr, parser::CharBlock source) {
199	if (!context().HasError(symbol)) {
200	if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
201	auto restorer{GetFoldingContext().messages().SetLocation(source)};
202	return evaluate::NonPointerInitializationExpr(
203	symbol, std::move(*maybeExpr), GetFoldingContext());
204	}
205	}
206	return std::nullopt;
207	}
208
209	template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
210	return semantics::EvaluateIntExpr(*context_, expr);
211	}
212
213	template <typename T>
214	MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
215	if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
216	return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
217	std::move(*maybeIntExpr)));
218	} else {
219	return std::nullopt;
220	}
221	}
222
223	template <typename... A> Message &Say(A &&...args) {
224	return messageHandler_.Say(std::forward<A>(args)...);
225	}
226	template <typename... A>
227	Message &Say(
228	const parser::Name &name, MessageFixedText &&text, const A &...args) {
229	return messageHandler_.Say(name.source, std::move(text), args...);
230	}
231
232	protected:
233	ImplicitRulesMap *implicitRulesMap_{nullptr};
234
235	private:
236	ResolveNamesVisitor *this_;
237	SemanticsContext *context_;
238	MessageHandler messageHandler_;
239	};
240
241	// Provide Post methods to collect attributes into a member variable.
242	class AttrsVisitor : public virtual BaseVisitor {
243	public:
244	bool BeginAttrs(); // always returns true
245	Attrs GetAttrs();
246	std::optional<common::CUDADataAttr> cudaDataAttr() { return cudaDataAttr_; }
247	Attrs EndAttrs();
248	bool SetPassNameOn(Symbol &);
249	void SetBindNameOn(Symbol &);
250	void Post(const parser::LanguageBindingSpec &);
251	bool Pre(const parser::IntentSpec &);
252	bool Pre(const parser::Pass &);
253
254	bool CheckAndSet(Attr);
255
256	// Simple case: encountering CLASSNAME causes ATTRNAME to be set.
257	#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
258	bool Pre(const parser::CLASSNAME &) { \
259	CheckAndSet(Attr::ATTRNAME); \
260	return false; \
261	}
262	HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
263	HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
264	HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
265	HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
266	HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
267	HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
268	HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
269	HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
270	HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
271	HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
272	HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
273	HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
274	HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
275	HANDLE_ATTR_CLASS(External, EXTERNAL)
276	HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
277	HANDLE_ATTR_CLASS(NoPass, NOPASS)
278	HANDLE_ATTR_CLASS(Optional, OPTIONAL)
279	HANDLE_ATTR_CLASS(Parameter, PARAMETER)
280	HANDLE_ATTR_CLASS(Pointer, POINTER)
281	HANDLE_ATTR_CLASS(Protected, PROTECTED)
282	HANDLE_ATTR_CLASS(Save, SAVE)
283	HANDLE_ATTR_CLASS(Target, TARGET)
284	HANDLE_ATTR_CLASS(Value, VALUE)
285	HANDLE_ATTR_CLASS(Volatile, VOLATILE)
286	#undef HANDLE_ATTR_CLASS
287	bool Pre(const common::CUDADataAttr);
288
289	protected:
290	std::optional<Attrs> attrs_;
291	std::optional<common::CUDADataAttr> cudaDataAttr_;
292
293	Attr AccessSpecToAttr(const parser::AccessSpec &x) {
294	switch (x.v) {
295	case parser::AccessSpec::Kind::Public:
296	return Attr::PUBLIC;
297	case parser::AccessSpec::Kind::Private:
298	return Attr::PRIVATE;
299	}
300	llvm_unreachable("Switch covers all cases"); // suppress g++ warning
301	}
302	Attr IntentSpecToAttr(const parser::IntentSpec &x) {
303	switch (x.v) {
304	case parser::IntentSpec::Intent::In:
305	return Attr::INTENT_IN;
306	case parser::IntentSpec::Intent::Out:
307	return Attr::INTENT_OUT;
308	case parser::IntentSpec::Intent::InOut:
309	return Attr::INTENT_INOUT;
310	}
311	llvm_unreachable("Switch covers all cases"); // suppress g++ warning
312	}
313
314	private:
315	bool IsDuplicateAttr(Attr);
316	bool HaveAttrConflict(Attr, Attr, Attr);
317	bool IsConflictingAttr(Attr);
318
319	MaybeExpr bindName_; // from BIND(C, NAME="...")
320	bool isCDefined_{false}; // BIND(C, NAME="...", CDEFINED) extension
321	std::optional<SourceName> passName_; // from PASS(...)
322	};
323
324	// Find and create types from declaration-type-spec nodes.
325	class DeclTypeSpecVisitor : public AttrsVisitor {
326	public:
327	using AttrsVisitor::Post;
328	using AttrsVisitor::Pre;
329	void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
330	void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
331	void Post(const parser::DeclarationTypeSpec::ClassStar &);
332	void Post(const parser::DeclarationTypeSpec::TypeStar &);
333	bool Pre(const parser::TypeGuardStmt &);
334	void Post(const parser::TypeGuardStmt &);
335	void Post(const parser::TypeSpec &);
336
337	// Walk the parse tree of a type spec and return the DeclTypeSpec for it.
338	template <typename T>
339	const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
340	auto restorer{common::ScopedSet(state_, State{})};
341	set_allowForwardReferenceToDerivedType(allowForward);
342	BeginDeclTypeSpec();
343	Walk(x);
344	const auto *type{GetDeclTypeSpec()};
345	EndDeclTypeSpec();
346	return type;
347	}
348
349	protected:
350	struct State {
351	bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true
352	const DeclTypeSpec *declTypeSpec{nullptr};
353	struct {
354	DerivedTypeSpec *type{nullptr};
355	DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
356	} derived;
357	bool allowForwardReferenceToDerivedType{false};
358	};
359
360	bool allowForwardReferenceToDerivedType() const {
361	return state_.allowForwardReferenceToDerivedType;
362	}
363	void set_allowForwardReferenceToDerivedType(bool yes) {
364	state_.allowForwardReferenceToDerivedType = yes;
365	}
366
367	const DeclTypeSpec *GetDeclTypeSpec();
368	void BeginDeclTypeSpec();
369	void EndDeclTypeSpec();
370	void SetDeclTypeSpec(const DeclTypeSpec &);
371	void SetDeclTypeSpecCategory(DeclTypeSpec::Category);
372	DeclTypeSpec::Category GetDeclTypeSpecCategory() const {
373	return state_.derived.category;
374	}
375	KindExpr GetKindParamExpr(
376	TypeCategory, const std::optional<parser::KindSelector> &);
377	void CheckForAbstractType(const Symbol &typeSymbol);
378
379	private:
380	State state_;
381
382	void MakeNumericType(TypeCategory, int kind);
383	};
384
385	// Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
386	class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
387	public:
388	using DeclTypeSpecVisitor::Post;
389	using DeclTypeSpecVisitor::Pre;
390	using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
391
392	void Post(const parser::ParameterStmt &);
393	bool Pre(const parser::ImplicitStmt &);
394	bool Pre(const parser::LetterSpec &);
395	bool Pre(const parser::ImplicitSpec &);
396	void Post(const parser::ImplicitSpec &);
397
398	const DeclTypeSpec *GetType(
399	SourceName name, bool respectImplicitNoneType = true) {
400	return implicitRules_->GetType(name, respectImplicitNoneType);
401	}
402	bool isImplicitNoneType() const {
403	return implicitRules_->isImplicitNoneType();
404	}
405	bool isImplicitNoneType(const Scope &scope) const {
406	return implicitRulesMap_->at(k: &scope).isImplicitNoneType();
407	}
408	bool isImplicitNoneExternal() const {
409	return implicitRules_->isImplicitNoneExternal();
410	}
411	void set_inheritFromParent(bool x) {
412	implicitRules_->set_inheritFromParent(x);
413	}
414
415	protected:
416	void BeginScope(const Scope &);
417	void SetScope(const Scope &);
418
419	private:
420	// implicit rules in effect for current scope
421	ImplicitRules *implicitRules_{nullptr};
422	std::optional<SourceName> prevImplicit_;
423	std::optional<SourceName> prevImplicitNone_;
424	std::optional<SourceName> prevImplicitNoneType_;
425	std::optional<SourceName> prevParameterStmt_;
426
427	bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
428	};
429
430	// Track array specifications. They can occur in AttrSpec, EntityDecl,
431	// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointer, and
432	// ComponentDecl.
433	// 1. INTEGER, DIMENSION(10) :: x
434	// 2. INTEGER :: x(10)
435	// 3. ALLOCATABLE :: x(:)
436	// 4. DIMENSION :: x(10)
437	// 5. COMMON x(10)
438	// 6. POINTER(p,x(10))
439	class ArraySpecVisitor : public virtual BaseVisitor {
440	public:
441	void Post(const parser::ArraySpec &);
442	void Post(const parser::ComponentArraySpec &);
443	void Post(const parser::CoarraySpec &);
444	void Post(const parser::AttrSpec &) { PostAttrSpec(); }
445	void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
446
447	protected:
448	const ArraySpec &arraySpec();
449	void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }
450	const ArraySpec &coarraySpec();
451	void BeginArraySpec();
452	void EndArraySpec();
453	void ClearArraySpec() { arraySpec_.clear(); }
454	void ClearCoarraySpec() { coarraySpec_.clear(); }
455
456	private:
457	// arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
458	ArraySpec arraySpec_;
459	ArraySpec coarraySpec_;
460	// When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
461	// into attrArraySpec_
462	ArraySpec attrArraySpec_;
463	ArraySpec attrCoarraySpec_;
464
465	void PostAttrSpec();
466	};
467
468	// Manages a stack of function result information. We defer the processing
469	// of a type specification that appears in the prefix of a FUNCTION statement
470	// until the function result variable appears in the specification part
471	// or the end of the specification part. This allows for forward references
472	// in the type specification to resolve to local names.
473	class FuncResultStack {
474	public:
475	explicit FuncResultStack(ScopeHandler &scopeHandler)
476	: scopeHandler_{scopeHandler} {}
477	~FuncResultStack();
478
479	struct FuncInfo {
480	FuncInfo(const Scope &s, SourceName at) : scope{s}, source{at} {}
481	const Scope &scope;
482	SourceName source;
483	// Parse tree of the type specification in the FUNCTION prefix
484	const parser::DeclarationTypeSpec *parsedType{nullptr};
485	// Name of the function RESULT in the FUNCTION suffix, if any
486	const parser::Name *resultName{nullptr};
487	// Result symbol
488	Symbol *resultSymbol{nullptr};
489	bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt
490	};
491
492	// Completes the definition of the top function's result.
493	void CompleteFunctionResultType();
494	// Completes the definition of a symbol if it is the top function's result.
495	void CompleteTypeIfFunctionResult(Symbol &);
496
497	FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); }
498	FuncInfo &Push(const Scope &scope, SourceName at) {
499	return stack_.emplace_back(scope, at);
500	}
501	void Pop();
502
503	private:
504	ScopeHandler &scopeHandler_;
505	std::vector<FuncInfo> stack_;
506	};
507
508	// Manage a stack of Scopes
509	class ScopeHandler : public ImplicitRulesVisitor {
510	public:
511	using ImplicitRulesVisitor::Post;
512	using ImplicitRulesVisitor::Pre;
513
514	Scope &currScope() { return DEREF(currScope_); }
515	// The enclosing host procedure if current scope is in an internal procedure
516	Scope *GetHostProcedure();
517	// The innermost enclosing program unit scope, ignoring BLOCK and other
518	// construct scopes.
519	Scope &InclusiveScope();
520	// The enclosing scope, skipping derived types.
521	Scope &NonDerivedTypeScope();
522
523	// Create a new scope and push it on the scope stack.
524	void PushScope(Scope::Kind kind, Symbol *symbol);
525	void PushScope(Scope &scope);
526	void PopScope();
527	void SetScope(Scope &);
528
529	template <typename T> bool Pre(const parser::Statement<T> &x) {
530	messageHandler().set_currStmtSource(x.source);
531	currScope_->AddSourceRange(x.source);
532	return true;
533	}
534	template <typename T> void Post(const parser::Statement<T> &) {
535	messageHandler().set_currStmtSource(std::nullopt);
536	}
537
538	// Special messages: already declared; referencing symbol's declaration;
539	// about a type; two names & locations
540	void SayAlreadyDeclared(const parser::Name &, Symbol &);
541	void SayAlreadyDeclared(const SourceName &, Symbol &);
542	void SayAlreadyDeclared(const SourceName &, const SourceName &);
543	void SayWithReason(
544	const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
545	template <typename... A>
546	Message &SayWithDecl(
547	const parser::Name &, Symbol &, MessageFixedText &&, A &&...args);
548	void SayLocalMustBeVariable(const parser::Name &, Symbol &);
549	Message &SayDerivedType(
550	const SourceName &, MessageFixedText &&, const Scope &);
551	Message &Say2(const SourceName &, MessageFixedText &&, const SourceName &,
552	MessageFixedText &&);
553	Message &Say2(
554	const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
555	Message &Say2(
556	const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
557
558	// Search for symbol by name in current, parent derived type, and
559	// containing scopes
560	Symbol *FindSymbol(const parser::Name &);
561	Symbol *FindSymbol(const Scope &, const parser::Name &);
562	// Search for name only in scope, not in enclosing scopes.
563	Symbol *FindInScope(const Scope &, const parser::Name &);
564	Symbol *FindInScope(const Scope &, const SourceName &);
565	template <typename T> Symbol *FindInScope(const T &name) {
566	return FindInScope(currScope(), name);
567	}
568	// Search for name in a derived type scope and its parents.
569	Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
570	Symbol *FindInTypeOrParents(const parser::Name &);
571	Symbol *FindInScopeOrBlockConstructs(const Scope &, SourceName);
572	Symbol *FindSeparateModuleProcedureInterface(const parser::Name &);
573	void EraseSymbol(const parser::Name &);
574	void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
575	// Make a new symbol with the name and attrs of an existing one
576	Symbol &CopySymbol(const SourceName &, const Symbol &);
577
578	// Make symbols in the current or named scope
579	Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
580	Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
581	Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
582	Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);
583
584	template <typename D>
585	common::IfNoLvalue<Symbol &, D> MakeSymbol(
586	const parser::Name &name, D &&details) {
587	return MakeSymbol(name, Attrs{}, std::move(details));
588	}
589
590	template <typename D>
591	common::IfNoLvalue<Symbol &, D> MakeSymbol(
592	const parser::Name &name, const Attrs &attrs, D &&details) {
593	return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
594	}
595
596	template <typename D>
597	common::IfNoLvalue<Symbol &, D> MakeSymbol(
598	const SourceName &name, const Attrs &attrs, D &&details) {
599	// Note: don't use FindSymbol here. If this is a derived type scope,
600	// we want to detect whether the name is already declared as a component.
601	auto *symbol{FindInScope(name)};
602	if (!symbol) {
603	symbol = &MakeSymbol(name, attrs);
604	symbol->set_details(std::move(details));
605	return *symbol;
606	}
607	if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
608	if (auto *d{symbol->detailsIf<GenericDetails>()}) {
609	if (!d->specific()) {
610	// derived type with same name as a generic
611	auto *derivedType{d->derivedType()};
612	if (!derivedType) {
613	derivedType =
614	&currScope().MakeSymbol(name, attrs, std::move(details));
615	d->set_derivedType(*derivedType);
616	} else if (derivedType->CanReplaceDetails(details)) {
617	// was forward-referenced
618	CheckDuplicatedAttrs(name, *symbol, attrs);
619	SetExplicitAttrs(*derivedType, attrs);
620	derivedType->set_details(std::move(details));
621	} else {
622	SayAlreadyDeclared(name, *derivedType);
623	}
624	return *derivedType;
625	}
626	}
627	} else if constexpr (std::is_same_v<ProcEntityDetails, D>) {
628	if (auto *d{symbol->detailsIf<GenericDetails>()}) {
629	if (!d->derivedType()) {
630	// procedure pointer with same name as a generic
631	auto *specific{d->specific()};
632	if (!specific) {
633	specific = &currScope().MakeSymbol(name, attrs, std::move(details));
634	d->set_specific(*specific);
635	} else {
636	SayAlreadyDeclared(name, *specific);
637	}
638	return *specific;
639	}
640	}
641	}
642	if (symbol->CanReplaceDetails(details)) {
643	// update the existing symbol
644	CheckDuplicatedAttrs(name, *symbol, attrs);
645	SetExplicitAttrs(*symbol, attrs);
646	if constexpr (std::is_same_v<SubprogramDetails, D>) {
647	// Dummy argument defined by explicit interface?
648	details.set_isDummy(IsDummy(*symbol));
649	}
650	symbol->set_details(std::move(details));
651	return *symbol;
652	} else if constexpr (std::is_same_v<UnknownDetails, D>) {
653	CheckDuplicatedAttrs(name, *symbol, attrs);
654	SetExplicitAttrs(*symbol, attrs);
655	return *symbol;
656	} else {
657	if (!CheckPossibleBadForwardRef(*symbol)) {
658	if (name.empty() && symbol->name().empty()) {
659	// report the error elsewhere
660	return *symbol;
661	}
662	Symbol &errSym{*symbol};
663	if (auto *d{symbol->detailsIf<GenericDetails>()}) {
664	if (d->specific()) {
665	errSym = *d->specific();
666	} else if (d->derivedType()) {
667	errSym = *d->derivedType();
668	}
669	}
670	SayAlreadyDeclared(name, errSym);
671	}
672	// replace the old symbol with a new one with correct details
673	EraseSymbol(symbol: *symbol);
674	auto &result{MakeSymbol(name, attrs, std::move(details))};
675	context().SetError(result);
676	return result;
677	}
678	}
679
680	void MakeExternal(Symbol &);
681
682	// C815 duplicated attribute checking; returns false on error
683	bool CheckDuplicatedAttr(SourceName, Symbol &, Attr);
684	bool CheckDuplicatedAttrs(SourceName, Symbol &, Attrs);
685
686	void SetExplicitAttr(Symbol &symbol, Attr attr) const {
687	symbol.attrs().set(attr);
688	symbol.implicitAttrs().reset(attr);
689	}
690	void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const {
691	symbol.attrs() |= attrs;
692	symbol.implicitAttrs() &= ~attrs;
693	}
694	void SetImplicitAttr(Symbol &symbol, Attr attr) const {
695	symbol.attrs().set(attr);
696	symbol.implicitAttrs().set(attr);
697	}
698	void SetCUDADataAttr(
699	SourceName, Symbol &, std::optional<common::CUDADataAttr>);
700
701	protected:
702	FuncResultStack &funcResultStack() { return funcResultStack_; }
703
704	// Apply the implicit type rules to this symbol.
705	void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);
706	bool ImplicitlyTypeForwardRef(Symbol &);
707	void AcquireIntrinsicProcedureFlags(Symbol &);
708	const DeclTypeSpec *GetImplicitType(
709	Symbol &, bool respectImplicitNoneType = true);
710	void CheckEntryDummyUse(SourceName, Symbol *);
711	bool ConvertToObjectEntity(Symbol &);
712	bool ConvertToProcEntity(Symbol &, std::optional<SourceName> = std::nullopt);
713
714	const DeclTypeSpec &MakeNumericType(
715	TypeCategory, const std::optional<parser::KindSelector> &);
716	const DeclTypeSpec &MakeNumericType(TypeCategory, int);
717	const DeclTypeSpec &MakeLogicalType(
718	const std::optional<parser::KindSelector> &);
719	const DeclTypeSpec &MakeLogicalType(int);
720	void NotePossibleBadForwardRef(const parser::Name &);
721	std::optional<SourceName> HadForwardRef(const Symbol &) const;
722	bool CheckPossibleBadForwardRef(const Symbol &);
723	bool ConvertToUseError(Symbol &, const SourceName &, const Symbol &used);
724
725	bool inSpecificationPart_{false};
726	bool deferImplicitTyping_{false};
727	bool skipImplicitTyping_{false};
728	bool inEquivalenceStmt_{false};
729
730	// Some information is collected from a specification part for deferred
731	// processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts())
732	// that are called by ResolveNamesVisitor::FinishSpecificationPart(). Since
733	// specification parts can nest (e.g., INTERFACE bodies), the collected
734	// information that is not contained in the scope needs to be packaged
735	// and restorable.
736	struct SpecificationPartState {
737	std::set<SourceName> forwardRefs;
738	// Collect equivalence sets and process at end of specification part
739	std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets;
740	// Names of all common block objects in the scope
741	std::set<SourceName> commonBlockObjects;
742	// Names of all names that show in a declare target declaration
743	std::set<SourceName> declareTargetNames;
744	// Info about SAVE statements and attributes in current scope
745	struct {
746	std::optional<SourceName> saveAll; // "SAVE" without entity list
747	std::set<SourceName> entities; // names of entities with save attr
748	std::set<SourceName> commons; // names of common blocks with save attr
749	} saveInfo;
750	} specPartState_;
751
752	// Some declaration processing can and should be deferred to
753	// ResolveExecutionParts() to avoid prematurely creating implicitly-typed
754	// local symbols that should be host associations.
755	struct DeferredDeclarationState {
756	// The content of each namelist group
757	std::list<const parser::NamelistStmt::Group *> namelistGroups;
758	};
759	DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) {
760	if (!add && deferred_.find(x: &currScope()) == deferred_.end()) {
761	return nullptr;
762	} else {
763	return &deferred_.emplace(args: &currScope(), args: DeferredDeclarationState{})
764	.first->second;
765	}
766	}
767
768	void SkipImplicitTyping(bool skip) {
769	deferImplicitTyping_ = skipImplicitTyping_ = skip;
770	}
771
772	void NoteEarlyDeclaredDummyArgument(Symbol &symbol) {
773	earlyDeclaredDummyArguments_.insert(symbol);
774	}
775	bool IsEarlyDeclaredDummyArgument(Symbol &symbol) {
776	return earlyDeclaredDummyArguments_.find(symbol) !=
777	earlyDeclaredDummyArguments_.end();
778	}
779	void ForgetEarlyDeclaredDummyArgument(Symbol &symbol) {
780	earlyDeclaredDummyArguments_.erase(symbol);
781	}
782
783	private:
784	Scope *currScope_{nullptr};
785	FuncResultStack funcResultStack_{*this};
786	std::map<Scope *, DeferredDeclarationState> deferred_;
787	UnorderedSymbolSet earlyDeclaredDummyArguments_;
788	};
789
790	class ModuleVisitor : public virtual ScopeHandler {
791	public:
792	bool Pre(const parser::AccessStmt &);
793	bool Pre(const parser::Only &);
794	bool Pre(const parser::Rename::Names &);
795	bool Pre(const parser::Rename::Operators &);
796	bool Pre(const parser::UseStmt &);
797	void Post(const parser::UseStmt &);
798
799	void BeginModule(const parser::Name &, bool isSubmodule);
800	bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
801	void ApplyDefaultAccess();
802	Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
803	void AddAndCheckModuleUse(SourceName, bool isIntrinsic);
804	void CollectUseRenames(const parser::UseStmt &);
805	void ClearUseRenames() { useRenames_.clear(); }
806	void ClearUseOnly() { useOnly_.clear(); }
807	void ClearModuleUses() {
808	intrinsicUses_.clear();
809	nonIntrinsicUses_.clear();
810	}
811
812	private:
813	// The location of the last AccessStmt without access-ids, if any.
814	std::optional<SourceName> prevAccessStmt_;
815	// The scope of the module during a UseStmt
816	Scope *useModuleScope_{nullptr};
817	// Names that have appeared in a rename clause of USE statements
818	std::set<std::pair<SourceName, SourceName>> useRenames_;
819	// Names that have appeared in an ONLY clause of a USE statement
820	std::set<std::pair<SourceName, Scope *>> useOnly_;
821	// Intrinsic and non-intrinsic (explicit or not) module names that
822	// have appeared in USE statements; used for C1406 warnings.
823	std::set<SourceName> intrinsicUses_;
824	std::set<SourceName> nonIntrinsicUses_;
825
826	Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
827	// A rename in a USE statement: local => use
828	struct SymbolRename {
829	Symbol *local{nullptr};
830	Symbol *use{nullptr};
831	};
832	// Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
833	SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
834	SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
835	void DoAddUse(
836	SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol);
837	void AddUse(const GenericSpecInfo &);
838	// Record a name appearing as the target of a USE rename clause
839	void AddUseRename(SourceName name, SourceName moduleName) {
840	useRenames_.emplace(std::make_pair(name, moduleName));
841	}
842	bool IsUseRenamed(const SourceName &name) const {
843	return useModuleScope_ && useModuleScope_->symbol() &&
844	useRenames_.find({name, useModuleScope_->symbol()->name()}) !=
845	useRenames_.end();
846	}
847	// Record a name appearing in a USE ONLY clause
848	void AddUseOnly(const SourceName &name) {
849	useOnly_.emplace(args: std::make_pair(x: name, y&: useModuleScope_));
850	}
851	bool IsUseOnly(const SourceName &name) const {
852	return useOnly_.find({name, useModuleScope_}) != useOnly_.end();
853	}
854	Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic,
855	Scope *ancestor = nullptr);
856	};
857
858	class GenericHandler : public virtual ScopeHandler {
859	protected:
860	using ProcedureKind = parser::ProcedureStmt::Kind;
861	void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart);
862	void DeclaredPossibleSpecificProc(Symbol &);
863
864	// Mappings of generics to their as-yet specific proc names and kinds
865	using SpecificProcMapType =
866	std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>;
867	SpecificProcMapType specificsForGenericProcs_;
868	// inversion of SpecificProcMapType: maps pending proc names to generics
869	using GenericProcMapType = std::multimap<SourceName, Symbol *>;
870	GenericProcMapType genericsForSpecificProcs_;
871	};
872
873	class InterfaceVisitor : public virtual ScopeHandler,
874	public virtual GenericHandler {
875	public:
876	bool Pre(const parser::InterfaceStmt &);
877	void Post(const parser::InterfaceStmt &);
878	void Post(const parser::EndInterfaceStmt &);
879	bool Pre(const parser::GenericSpec &);
880	bool Pre(const parser::ProcedureStmt &);
881	bool Pre(const parser::GenericStmt &);
882	void Post(const parser::GenericStmt &);
883
884	bool inInterfaceBlock() const;
885	bool isGeneric() const;
886	bool isAbstract() const;
887
888	protected:
889	Symbol &GetGenericSymbol() { return DEREF(genericInfo_.top().symbol); }
890	// Add to generic the symbol for the subprogram with the same name
891	void CheckGenericProcedures(Symbol &);
892
893	private:
894	// A new GenericInfo is pushed for each interface block and generic stmt
895	struct GenericInfo {
896	GenericInfo(bool isInterface, bool isAbstract = false)
897	: isInterface{isInterface}, isAbstract{isAbstract} {}
898	bool isInterface; // in interface block
899	bool isAbstract; // in abstract interface block
900	Symbol *symbol{nullptr}; // the generic symbol being defined
901	};
902	std::stack<GenericInfo> genericInfo_;
903	const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }
904	void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }
905	void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
906	void ResolveNewSpecifics();
907	};
908
909	class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
910	public:
911	bool HandleStmtFunction(const parser::StmtFunctionStmt &);
912	bool Pre(const parser::SubroutineStmt &);
913	bool Pre(const parser::FunctionStmt &);
914	void Post(const parser::FunctionStmt &);
915	bool Pre(const parser::EntryStmt &);
916	void Post(const parser::EntryStmt &);
917	bool Pre(const parser::InterfaceBody::Subroutine &);
918	void Post(const parser::InterfaceBody::Subroutine &);
919	bool Pre(const parser::InterfaceBody::Function &);
920	void Post(const parser::InterfaceBody::Function &);
921	bool Pre(const parser::Suffix &);
922	bool Pre(const parser::PrefixSpec &);
923	bool Pre(const parser::PrefixSpec::Attributes &);
924	void Post(const parser::PrefixSpec::Launch_Bounds &);
925	void Post(const parser::PrefixSpec::Cluster_Dims &);
926
927	bool BeginSubprogram(const parser::Name &, Symbol::Flag,
928	bool hasModulePrefix = false,
929	const parser::LanguageBindingSpec * = nullptr,
930	const ProgramTree::EntryStmtList * = nullptr);
931	bool BeginMpSubprogram(const parser::Name &);
932	void PushBlockDataScope(const parser::Name &);
933	void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt,
934	const std::optional<parser::LanguageBindingSpec> * = nullptr,
935	const ProgramTree::EntryStmtList * = nullptr);
936
937	protected:
938	// Set when we see a stmt function that is really an array element assignment
939	bool misparsedStmtFuncFound_{false};
940
941	private:
942	// Edits an existing symbol created for earlier calls to a subprogram or ENTRY
943	// so that it can be replaced by a later definition.
944	bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
945	void CheckExtantProc(const parser::Name &, Symbol::Flag);
946	// Create a subprogram symbol in the current scope and push a new scope.
947	Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
948	const parser::LanguageBindingSpec * = nullptr,
949	bool hasModulePrefix = false);
950	Symbol *GetSpecificFromGeneric(const parser::Name &);
951	Symbol &PostSubprogramStmt();
952	void CreateDummyArgument(SubprogramDetails &, const parser::Name &);
953	void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);
954	void PostEntryStmt(const parser::EntryStmt &stmt);
955	void HandleLanguageBinding(Symbol *,
956	std::optional<parser::CharBlock> stmtSource,
957	const std::optional<parser::LanguageBindingSpec> *);
958	};
959
960	class DeclarationVisitor : public ArraySpecVisitor,
961	public virtual GenericHandler {
962	public:
963	using ArraySpecVisitor::Post;
964	using ScopeHandler::Post;
965	using ScopeHandler::Pre;
966
967	bool Pre(const parser::Initialization &);
968	void Post(const parser::EntityDecl &);
969	void Post(const parser::ObjectDecl &);
970	void Post(const parser::PointerDecl &);
971	bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
972	void Post(const parser::BindStmt &) { EndAttrs(); }
973	bool Pre(const parser::BindEntity &);
974	bool Pre(const parser::OldParameterStmt &);
975	bool Pre(const parser::NamedConstantDef &);
976	bool Pre(const parser::NamedConstant &);
977	void Post(const parser::EnumDef &);
978	bool Pre(const parser::Enumerator &);
979	bool Pre(const parser::AccessSpec &);
980	bool Pre(const parser::AsynchronousStmt &);
981	bool Pre(const parser::ContiguousStmt &);
982	bool Pre(const parser::ExternalStmt &);
983	bool Pre(const parser::IntentStmt &);
984	bool Pre(const parser::IntrinsicStmt &);
985	bool Pre(const parser::OptionalStmt &);
986	bool Pre(const parser::ProtectedStmt &);
987	bool Pre(const parser::ValueStmt &);
988	bool Pre(const parser::VolatileStmt &);
989	bool Pre(const parser::AllocatableStmt &) {
990	objectDeclAttr_ = Attr::ALLOCATABLE;
991	return true;
992	}
993	void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
994	bool Pre(const parser::TargetStmt &) {
995	objectDeclAttr_ = Attr::TARGET;
996	return true;
997	}
998	bool Pre(const parser::CUDAAttributesStmt &);
999	void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
1000	void Post(const parser::DimensionStmt::Declaration &);
1001	void Post(const parser::CodimensionDecl &);
1002	bool Pre(const parser::TypeDeclarationStmt &);
1003	void Post(const parser::TypeDeclarationStmt &);
1004	void Post(const parser::IntegerTypeSpec &);
1005	void Post(const parser::UnsignedTypeSpec &);
1006	void Post(const parser::IntrinsicTypeSpec::Real &);
1007	void Post(const parser::IntrinsicTypeSpec::Complex &);
1008	void Post(const parser::IntrinsicTypeSpec::Logical &);
1009	void Post(const parser::IntrinsicTypeSpec::Character &);
1010	void Post(const parser::CharSelector::LengthAndKind &);
1011	void Post(const parser::CharLength &);
1012	void Post(const parser::LengthSelector &);
1013	bool Pre(const parser::KindParam &);
1014	bool Pre(const parser::VectorTypeSpec &);
1015	void Post(const parser::VectorTypeSpec &);
1016	bool Pre(const parser::DeclarationTypeSpec::Type &);
1017	void Post(const parser::DeclarationTypeSpec::Type &);
1018	bool Pre(const parser::DeclarationTypeSpec::Class &);
1019	void Post(const parser::DeclarationTypeSpec::Class &);
1020	void Post(const parser::DeclarationTypeSpec::Record &);
1021	void Post(const parser::DerivedTypeSpec &);
1022	bool Pre(const parser::DerivedTypeDef &);
1023	bool Pre(const parser::DerivedTypeStmt &);
1024	void Post(const parser::DerivedTypeStmt &);
1025	bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
1026	void Post(const parser::TypeParamDefStmt &);
1027	bool Pre(const parser::TypeAttrSpec::Extends &);
1028	bool Pre(const parser::PrivateStmt &);
1029	bool Pre(const parser::SequenceStmt &);
1030	bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
1031	void Post(const parser::ComponentDefStmt &) { EndDecl(); }
1032	void Post(const parser::ComponentDecl &);
1033	void Post(const parser::FillDecl &);
1034	bool Pre(const parser::ProcedureDeclarationStmt &);
1035	void Post(const parser::ProcedureDeclarationStmt &);
1036	bool Pre(const parser::DataComponentDefStmt &); // returns false
1037	bool Pre(const parser::ProcComponentDefStmt &);
1038	void Post(const parser::ProcComponentDefStmt &);
1039	bool Pre(const parser::ProcPointerInit &);
1040	void Post(const parser::ProcInterface &);
1041	void Post(const parser::ProcDecl &);
1042	bool Pre(const parser::TypeBoundProcedurePart &);
1043	void Post(const parser::TypeBoundProcedurePart &);
1044	void Post(const parser::ContainsStmt &);
1045	bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
1046	void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
1047	void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
1048	void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
1049	bool Pre(const parser::FinalProcedureStmt &);
1050	bool Pre(const parser::TypeBoundGenericStmt &);
1051	bool Pre(const parser::StructureDef &); // returns false
1052	bool Pre(const parser::Union::UnionStmt &);
1053	bool Pre(const parser::StructureField &);
1054	void Post(const parser::StructureField &);
1055	bool Pre(const parser::AllocateStmt &);
1056	void Post(const parser::AllocateStmt &);
1057	bool Pre(const parser::StructureConstructor &);
1058	bool Pre(const parser::NamelistStmt::Group &);
1059	bool Pre(const parser::IoControlSpec &);
1060	bool Pre(const parser::CommonStmt::Block &);
1061	bool Pre(const parser::CommonBlockObject &);
1062	void Post(const parser::CommonBlockObject &);
1063	bool Pre(const parser::EquivalenceStmt &);
1064	bool Pre(const parser::SaveStmt &);
1065	bool Pre(const parser::BasedPointer &);
1066	void Post(const parser::BasedPointer &);
1067
1068	void PointerInitialization(
1069	const parser::Name &, const parser::InitialDataTarget &);
1070	void PointerInitialization(
1071	const parser::Name &, const parser::ProcPointerInit &);
1072	void NonPointerInitialization(
1073	const parser::Name &, const parser::ConstantExpr &);
1074	void CheckExplicitInterface(const parser::Name &);
1075	void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
1076
1077	const parser::Name *ResolveDesignator(const parser::Designator &);
1078	int GetVectorElementKind(
1079	TypeCategory category, const std::optional<parser::KindSelector> &kind);
1080
1081	protected:
1082	bool BeginDecl();
1083	void EndDecl();
1084	Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
1085	// Make sure that there's an entity in an enclosing scope called Name
1086	Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
1087	// Declare a LOCAL/LOCAL_INIT/REDUCE entity while setting a locality flag. If
1088	// there isn't a type specified it comes from the entity in the containing
1089	// scope, or implicit rules.
1090	void DeclareLocalEntity(const parser::Name &, Symbol::Flag);
1091	// Declare a statement entity (i.e., an implied DO loop index for
1092	// a DATA statement or an array constructor). If there isn't an explict
1093	// type specified, implicit rules apply. Return pointer to the new symbol,
1094	// or nullptr on error.
1095	Symbol *DeclareStatementEntity(const parser::DoVariable &,
1096	const std::optional<parser::IntegerTypeSpec> &);
1097	Symbol &MakeCommonBlockSymbol(const parser::Name &);
1098	Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
1099	bool CheckUseError(const parser::Name &);
1100	void CheckAccessibility(const SourceName &, bool, Symbol &);
1101	void CheckCommonBlocks();
1102	void CheckSaveStmts();
1103	void CheckEquivalenceSets();
1104	bool CheckNotInBlock(const char *);
1105	bool NameIsKnownOrIntrinsic(const parser::Name &);
1106	void FinishNamelists();
1107
1108	// Each of these returns a pointer to a resolved Name (i.e. with symbol)
1109	// or nullptr in case of error.
1110	const parser::Name *ResolveStructureComponent(
1111	const parser::StructureComponent &);
1112	const parser::Name *ResolveDataRef(const parser::DataRef &);
1113	const parser::Name *ResolveName(const parser::Name &);
1114	bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
1115	Symbol *NoteInterfaceName(const parser::Name &);
1116	bool IsUplevelReference(const Symbol &);
1117
1118	std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(
1119	const parser::DoVariable &name) {
1120	std::optional<SourceName> result{checkIndexUseInOwnBounds_};
1121	checkIndexUseInOwnBounds_ = name.thing.thing.source;
1122	return result;
1123	}
1124	void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {
1125	checkIndexUseInOwnBounds_ = restore;
1126	}
1127	void NoteScalarSpecificationArgument(const Symbol &symbol) {
1128	mustBeScalar_.emplace(symbol);
1129	}
1130	// Declare an object or procedure entity.
1131	// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
1132	template <typename T>
1133	Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
1134	Symbol &symbol{MakeSymbol(name, attrs)};
1135	if (context().HasError(symbol) || symbol.has<T>()) {
1136	return symbol; // OK or error already reported
1137	} else if (symbol.has<UnknownDetails>()) {
1138	symbol.set_details(T{});
1139	return symbol;
1140	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
1141	symbol.set_details(T{std::move(*details)});
1142	return symbol;
1143	} else if (std::is_same_v<EntityDetails, T> &&
1144	(symbol.has<ObjectEntityDetails>() ||
1145	symbol.has<ProcEntityDetails>())) {
1146	return symbol; // OK
1147	} else if (auto *details{symbol.detailsIf<UseDetails>()}) {
1148	Say(name.source,
1149	"'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
1150	name.source, GetUsedModule(*details).name());
1151	} else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
1152	if (details->kind() == SubprogramKind::Module) {
1153	Say2(name,
1154	"Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
1155	symbol, "Module procedure definition"_en_US);
1156	} else if (details->kind() == SubprogramKind::Internal) {
1157	Say2(name,
1158	"Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
1159	symbol, "Internal procedure definition"_en_US);
1160	} else {
1161	DIE("unexpected kind");
1162	}
1163	} else if (std::is_same_v<ObjectEntityDetails, T> &&
1164	symbol.has<ProcEntityDetails>()) {
1165	SayWithDecl(
1166	name, symbol, "'%s' is already declared as a procedure"_err_en_US);
1167	} else if (std::is_same_v<ProcEntityDetails, T> &&
1168	symbol.has<ObjectEntityDetails>()) {
1169	if (FindCommonBlockContaining(symbol)) {
1170	SayWithDecl(name, symbol,
1171	"'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
1172	} else {
1173	SayWithDecl(
1174	name, symbol, "'%s' is already declared as an object"_err_en_US);
1175	}
1176	} else if (!CheckPossibleBadForwardRef(symbol)) {
1177	SayAlreadyDeclared(name, symbol);
1178	}
1179	context().SetError(symbol);
1180	return symbol;
1181	}
1182
1183	private:
1184	// The attribute corresponding to the statement containing an ObjectDecl
1185	std::optional<Attr> objectDeclAttr_;
1186	// Info about current character type while walking DeclTypeSpec.
1187	// Also captures any "*length" specifier on an individual declaration.
1188	struct {
1189	std::optional<ParamValue> length;
1190	std::optional<KindExpr> kind;
1191	} charInfo_;
1192	// Info about current derived type or STRUCTURE while walking
1193	// DerivedTypeDef / StructureDef
1194	struct {
1195	const parser::Name *extends{nullptr}; // EXTENDS(name)
1196	bool privateComps{false}; // components are private by default
1197	bool privateBindings{false}; // bindings are private by default
1198	bool sawContains{false}; // currently processing bindings
1199	bool sequence{false}; // is a sequence type
1200	const Symbol *type{nullptr}; // derived type being defined
1201	bool isStructure{false}; // is a DEC STRUCTURE
1202	} derivedTypeInfo_;
1203	// In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
1204	// the interface name, if any.
1205	const parser::Name *interfaceName_{nullptr};
1206	// Map type-bound generic to binding names of its specific bindings
1207	std::multimap<Symbol *, const parser::Name *> genericBindings_;
1208	// Info about current ENUM
1209	struct EnumeratorState {
1210	// Enum value must hold inside a C_INT (7.6.2).
1211	std::optional<int> value{0};
1212	} enumerationState_;
1213	// Set for OldParameterStmt processing
1214	bool inOldStyleParameterStmt_{false};
1215	// Set when walking DATA & array constructor implied DO loop bounds
1216	// to warn about use of the implied DO intex therein.
1217	std::optional<SourceName> checkIndexUseInOwnBounds_;
1218	bool isVectorType_{false};
1219	UnorderedSymbolSet mustBeScalar_;
1220
1221	bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
1222	Symbol &HandleAttributeStmt(Attr, const parser::Name &);
1223	Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
1224	Symbol &DeclareProcEntity(
1225	const parser::Name &, Attrs, const Symbol *interface);
1226	void SetType(const parser::Name &, const DeclTypeSpec &);
1227	std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
1228	std::optional<DerivedTypeSpec> ResolveExtendsType(
1229	const parser::Name &, const parser::Name *);
1230	Symbol *MakeTypeSymbol(const SourceName &, Details &&);
1231	Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
1232	bool OkToAddComponent(const parser::Name &, const Symbol *extends = nullptr);
1233	ParamValue GetParamValue(
1234	const parser::TypeParamValue &, common::TypeParamAttr attr);
1235	void CheckCommonBlockDerivedType(
1236	const SourceName &, const Symbol &, UnorderedSymbolSet &);
1237	Attrs HandleSaveName(const SourceName &, Attrs);
1238	void AddSaveName(std::set<SourceName> &, const SourceName &);
1239	bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
1240	const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
1241	void Initialization(const parser::Name &, const parser::Initialization &,
1242	bool inComponentDecl);
1243	bool FindAndMarkDeclareTargetSymbol(const parser::Name &);
1244	bool PassesLocalityChecks(
1245	const parser::Name &name, Symbol &symbol, Symbol::Flag flag);
1246	bool CheckForHostAssociatedImplicit(const parser::Name &);
1247	bool HasCycle(const Symbol &, const Symbol *interface);
1248	bool MustBeScalar(const Symbol &symbol) const {
1249	return mustBeScalar_.find(symbol) != mustBeScalar_.end();
1250	}
1251	void DeclareIntrinsic(const parser::Name &);
1252	};
1253
1254	// Resolve construct entities and statement entities.
1255	// Check that construct names don't conflict with other names.
1256	class ConstructVisitor : public virtual DeclarationVisitor {
1257	public:
1258	bool Pre(const parser::ConcurrentHeader &);
1259	bool Pre(const parser::LocalitySpec::Local &);
1260	bool Pre(const parser::LocalitySpec::LocalInit &);
1261	bool Pre(const parser::LocalitySpec::Reduce &);
1262	bool Pre(const parser::LocalitySpec::Shared &);
1263	bool Pre(const parser::AcSpec &);
1264	bool Pre(const parser::AcImpliedDo &);
1265	bool Pre(const parser::DataImpliedDo &);
1266	bool Pre(const parser::DataIDoObject &);
1267	bool Pre(const parser::DataStmtObject &);
1268	bool Pre(const parser::DataStmtValue &);
1269	bool Pre(const parser::DoConstruct &);
1270	void Post(const parser::DoConstruct &);
1271	bool Pre(const parser::ForallConstruct &);
1272	void Post(const parser::ForallConstruct &);
1273	bool Pre(const parser::ForallStmt &);
1274	void Post(const parser::ForallStmt &);
1275	bool Pre(const parser::BlockConstruct &);
1276	void Post(const parser::Selector &);
1277	void Post(const parser::AssociateStmt &);
1278	void Post(const parser::EndAssociateStmt &);
1279	bool Pre(const parser::Association &);
1280	void Post(const parser::SelectTypeStmt &);
1281	void Post(const parser::SelectRankStmt &);
1282	bool Pre(const parser::SelectTypeConstruct &);
1283	void Post(const parser::SelectTypeConstruct &);
1284	bool Pre(const parser::SelectTypeConstruct::TypeCase &);
1285	void Post(const parser::SelectTypeConstruct::TypeCase &);
1286	// Creates Block scopes with neither symbol name nor symbol details.
1287	bool Pre(const parser::SelectRankConstruct::RankCase &);
1288	void Post(const parser::SelectRankConstruct::RankCase &);
1289	bool Pre(const parser::TypeGuardStmt::Guard &);
1290	void Post(const parser::TypeGuardStmt::Guard &);
1291	void Post(const parser::SelectRankCaseStmt::Rank &);
1292	bool Pre(const parser::ChangeTeamStmt &);
1293	void Post(const parser::EndChangeTeamStmt &);
1294	void Post(const parser::CoarrayAssociation &);
1295
1296	// Definitions of construct names
1297	bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
1298	bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
1299	bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
1300	bool Pre(const parser::LabelDoStmt &) {
1301	return false; // error recovery
1302	}
1303	bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
1304	bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
1305	bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
1306	bool Pre(const parser::SelectRankConstruct &);
1307	void Post(const parser::SelectRankConstruct &);
1308	bool Pre(const parser::SelectRankStmt &x) {
1309	return CheckDef(std::get<0>(x.t));
1310	}
1311	bool Pre(const parser::SelectTypeStmt &x) {
1312	return CheckDef(std::get<0>(x.t));
1313	}
1314
1315	// References to construct names
1316	void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }
1317	void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }
1318	void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
1319	void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
1320	void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
1321	void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
1322	void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }
1323	void Post(const parser::ElseStmt &x) { CheckRef(x.v); }
1324	void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }
1325	void Post(const parser::CaseStmt &x) { CheckRef(x.t); }
1326	void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }
1327	void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }
1328	void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }
1329	void Post(const parser::CycleStmt &x) { CheckRef(x.v); }
1330	void Post(const parser::ExitStmt &x) { CheckRef(x.v); }
1331
1332	void HandleImpliedAsynchronousInScope(const parser::Block &);
1333
1334	private:
1335	// R1105 selector -> expr | variable
1336	// expr is set in either case unless there were errors
1337	struct Selector {
1338	Selector() {}
1339	Selector(const SourceName &source, MaybeExpr &&expr)
1340	: source{source}, expr{std::move(expr)} {}
1341	operator bool() const { return expr.has_value(); }
1342	parser::CharBlock source;
1343	MaybeExpr expr;
1344	};
1345	// association -> [associate-name =>] selector
1346	struct Association {
1347	const parser::Name *name{nullptr};
1348	Selector selector;
1349	};
1350	std::vector<Association> associationStack_;
1351	Association *currentAssociation_{nullptr};
1352
1353	template <typename T> bool CheckDef(const T &t) {
1354	return CheckDef(std::get<std::optional<parser::Name>>(t));
1355	}
1356	template <typename T> void CheckRef(const T &t) {
1357	CheckRef(std::get<std::optional<parser::Name>>(t));
1358	}
1359	bool CheckDef(const std::optional<parser::Name> &);
1360	void CheckRef(const std::optional<parser::Name> &);
1361	const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
1362	const DeclTypeSpec &ToDeclTypeSpec(
1363	evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
1364	Symbol *MakeAssocEntity();
1365	void SetTypeFromAssociation(Symbol &);
1366	void SetAttrsFromAssociation(Symbol &);
1367	Selector ResolveSelector(const parser::Selector &);
1368	void ResolveIndexName(const parser::ConcurrentControl &control);
1369	void SetCurrentAssociation(std::size_t n);
1370	Association &GetCurrentAssociation();
1371	void PushAssociation();
1372	void PopAssociation(std::size_t count = 1);
1373	};
1374
1375	// Create scopes for OpenACC constructs
1376	class AccVisitor : public virtual DeclarationVisitor {
1377	public:
1378	void AddAccSourceRange(const parser::CharBlock &);
1379
1380	static bool NeedsScope(const parser::OpenACCBlockConstruct &);
1381
1382	bool Pre(const parser::OpenACCBlockConstruct &);
1383	void Post(const parser::OpenACCBlockConstruct &);
1384	bool Pre(const parser::OpenACCCombinedConstruct &);
1385	void Post(const parser::OpenACCCombinedConstruct &);
1386	bool Pre(const parser::AccBeginBlockDirective &x) {
1387	AddAccSourceRange(x.source);
1388	return true;
1389	}
1390	void Post(const parser::AccBeginBlockDirective &) {
1391	messageHandler().set_currStmtSource(std::nullopt);
1392	}
1393	bool Pre(const parser::AccEndBlockDirective &x) {
1394	AddAccSourceRange(x.source);
1395	return true;
1396	}
1397	void Post(const parser::AccEndBlockDirective &) {
1398	messageHandler().set_currStmtSource(std::nullopt);
1399	}
1400	bool Pre(const parser::AccBeginCombinedDirective &x) {
1401	AddAccSourceRange(x.source);
1402	return true;
1403	}
1404	void Post(const parser::AccBeginCombinedDirective &) {
1405	messageHandler().set_currStmtSource(std::nullopt);
1406	}
1407	bool Pre(const parser::AccEndCombinedDirective &x) {
1408	AddAccSourceRange(x.source);
1409	return true;
1410	}
1411	void Post(const parser::AccEndCombinedDirective &) {
1412	messageHandler().set_currStmtSource(std::nullopt);
1413	}
1414	bool Pre(const parser::AccBeginLoopDirective &x) {
1415	AddAccSourceRange(x.source);
1416	return true;
1417	}
1418	void Post(const parser::AccBeginLoopDirective &x) {
1419	messageHandler().set_currStmtSource(std::nullopt);
1420	}
1421	};
1422
1423	bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) {
1424	const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
1425	const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
1426	switch (beginDir.v) {
1427	case llvm::acc::Directive::ACCD_data:
1428	case llvm::acc::Directive::ACCD_host_data:
1429	case llvm::acc::Directive::ACCD_kernels:
1430	case llvm::acc::Directive::ACCD_parallel:
1431	case llvm::acc::Directive::ACCD_serial:
1432	return true;
1433	default:
1434	return false;
1435	}
1436	}
1437
1438	void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) {
1439	messageHandler().set_currStmtSource(source);
1440	currScope().AddSourceRange(source);
1441	}
1442
1443	bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
1444	if (NeedsScope(x)) {
1445	PushScope(Scope::Kind::OpenACCConstruct, nullptr);
1446	}
1447	return true;
1448	}
1449
1450	void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) {
1451	if (NeedsScope(x)) {
1452	PopScope();
1453	}
1454	}
1455
1456	bool AccVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
1457	PushScope(Scope::Kind::OpenACCConstruct, nullptr);
1458	return true;
1459	}
1460
1461	void AccVisitor::Post(const parser::OpenACCCombinedConstruct &x) { PopScope(); }
1462
1463	// Create scopes for OpenMP constructs
1464	class OmpVisitor : public virtual DeclarationVisitor {
1465	public:
1466	void AddOmpSourceRange(const parser::CharBlock &);
1467
1468	static bool NeedsScope(const parser::OpenMPBlockConstruct &);
1469	static bool NeedsScope(const parser::OmpClause &);
1470
1471	bool Pre(const parser::OmpMetadirectiveDirective &x) { //
1472	metaDirective_ = &x;
1473	++metaLevel_;
1474	return true;
1475	}
1476	void Post(const parser::OmpMetadirectiveDirective &) { //
1477	metaDirective_ = nullptr;
1478	--metaLevel_;
1479	}
1480
1481	bool Pre(const parser::OpenMPRequiresConstruct &x) {
1482	AddOmpSourceRange(x.source);
1483	return true;
1484	}
1485	bool Pre(const parser::OpenMPBlockConstruct &);
1486	void Post(const parser::OpenMPBlockConstruct &);
1487	bool Pre(const parser::OmpBeginBlockDirective &x) {
1488	AddOmpSourceRange(x.source);
1489	return true;
1490	}
1491	void Post(const parser::OmpBeginBlockDirective &) {
1492	messageHandler().set_currStmtSource(std::nullopt);
1493	}
1494	bool Pre(const parser::OmpEndBlockDirective &x) {
1495	AddOmpSourceRange(x.source);
1496	return true;
1497	}
1498	void Post(const parser::OmpEndBlockDirective &) {
1499	messageHandler().set_currStmtSource(std::nullopt);
1500	}
1501
1502	bool Pre(const parser::OpenMPLoopConstruct &) {
1503	PushScope(Scope::Kind::OtherConstruct, nullptr);
1504	return true;
1505	}
1506	void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
1507	bool Pre(const parser::OmpBeginLoopDirective &x) {
1508	AddOmpSourceRange(x.source);
1509	return true;
1510	}
1511
1512	bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {
1513	AddOmpSourceRange(x.source);
1514	ProcessMapperSpecifier(std::get<parser::OmpMapperSpecifier>(x.t),
1515	std::get<parser::OmpClauseList>(x.t));
1516	return false;
1517	}
1518
1519	bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
1520	AddOmpSourceRange(x.source);
1521	return true;
1522	}
1523
1524	bool Pre(const parser::OmpInitializerProc &x) {
1525	auto &procDes = std::get<parser::ProcedureDesignator>(x.t);
1526	auto &name = std::get<parser::Name>(procDes.u);
1527	auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
1528	if (!symbol) {
1529	context().Say(name.source,
1530	"Implicit subroutine declaration '%s' in DECLARE REDUCTION"_err_en_US,
1531	name.source);
1532	}
1533	return true;
1534	}
1535
1536	bool Pre(const parser::OmpDeclareVariantDirective &x) {
1537	AddOmpSourceRange(x.source);
1538	auto FindSymbolOrError = [&](const parser::Name &procName) {
1539	auto *symbol{FindSymbol(NonDerivedTypeScope(), procName)};
1540	if (!symbol) {
1541	context().Say(procName.source,
1542	"Implicit subroutine declaration '%s' in !$OMP DECLARE VARIANT"_err_en_US,
1543	procName.source);
1544	}
1545	};
1546	auto &baseProcName = std::get<std::optional<parser::Name>>(x.t);
1547	if (baseProcName) {
1548	FindSymbolOrError(*baseProcName);
1549	}
1550	auto &varProcName = std::get<parser::Name>(x.t);
1551	FindSymbolOrError(varProcName);
1552	return true;
1553	}
1554
1555	bool Pre(const parser::OpenMPDeclareReductionConstruct &x) {
1556	AddOmpSourceRange(x.source);
1557	ProcessReductionSpecifier(
1558	std::get<Indirection<parser::OmpReductionSpecifier>>(x.t).value(),
1559	std::get<std::optional<parser::OmpClauseList>>(x.t), x);
1560	return false;
1561	}
1562	bool Pre(const parser::OmpMapClause &);
1563
1564	void Post(const parser::OmpBeginLoopDirective &) {
1565	messageHandler().set_currStmtSource(std::nullopt);
1566	}
1567	bool Pre(const parser::OmpEndLoopDirective &x) {
1568	AddOmpSourceRange(x.source);
1569	return true;
1570	}
1571	void Post(const parser::OmpEndLoopDirective &) {
1572	messageHandler().set_currStmtSource(std::nullopt);
1573	}
1574
1575	bool Pre(const parser::OpenMPSectionsConstruct &) {
1576	PushScope(Scope::Kind::OtherConstruct, nullptr);
1577	return true;
1578	}
1579	void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
1580	bool Pre(const parser::OmpBeginSectionsDirective &x) {
1581	AddOmpSourceRange(x.source);
1582	return true;
1583	}
1584	void Post(const parser::OmpBeginSectionsDirective &) {
1585	messageHandler().set_currStmtSource(std::nullopt);
1586	}
1587	bool Pre(const parser::OmpEndSectionsDirective &x) {
1588	AddOmpSourceRange(x.source);
1589	return true;
1590	}
1591	void Post(const parser::OmpEndSectionsDirective &) {
1592	messageHandler().set_currStmtSource(std::nullopt);
1593	}
1594	bool Pre(const parser::OmpCriticalDirective &x) {
1595	AddOmpSourceRange(x.source);
1596	return true;
1597	}
1598	void Post(const parser::OmpCriticalDirective &) {
1599	messageHandler().set_currStmtSource(std::nullopt);
1600	}
1601	bool Pre(const parser::OmpEndCriticalDirective &x) {
1602	AddOmpSourceRange(x.source);
1603	return true;
1604	}
1605	void Post(const parser::OmpEndCriticalDirective &) {
1606	messageHandler().set_currStmtSource(std::nullopt);
1607	}
1608	bool Pre(const parser::OpenMPThreadprivate &) {
1609	SkipImplicitTyping(true);
1610	return true;
1611	}
1612	void Post(const parser::OpenMPThreadprivate &) { SkipImplicitTyping(false); }
1613	bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {
1614	const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1615	auto populateDeclareTargetNames{
1616	[this](const parser::OmpObjectList &objectList) {
1617	for (const auto &ompObject : objectList.v) {
1618	common::visit(
1619	common::visitors{
1620	[&](const parser::Designator &designator) {
1621	if (const auto *name{
1622	semantics::getDesignatorNameIfDataRef(
1623	designator)}) {
1624	specPartState_.declareTargetNames.insert(name->source);
1625	}
1626	},
1627	[&](const parser::Name &name) {
1628	specPartState_.declareTargetNames.insert(name.source);
1629	},
1630	},
1631	ompObject.u);
1632	}
1633	}};
1634
1635	if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1636	populateDeclareTargetNames(*objectList);
1637	} else if (const auto *clauseList{
1638	parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1639	for (const auto &clause : clauseList->v) {
1640	if (const auto *toClause{
1641	std::get_if<parser::OmpClause::To>(&clause.u)}) {
1642	populateDeclareTargetNames(
1643	std::get<parser::OmpObjectList>(toClause->v.t));
1644	} else if (const auto *linkClause{
1645	std::get_if<parser::OmpClause::Link>(&clause.u)}) {
1646	populateDeclareTargetNames(linkClause->v);
1647	} else if (const auto *enterClause{
1648	std::get_if<parser::OmpClause::Enter>(&clause.u)}) {
1649	populateDeclareTargetNames(enterClause->v);
1650	}
1651	}
1652	}
1653
1654	SkipImplicitTyping(true);
1655	return true;
1656	}
1657	void Post(const parser::OpenMPDeclareTargetConstruct &) {
1658	SkipImplicitTyping(false);
1659	}
1660	bool Pre(const parser::OpenMPDeclarativeAllocate &) {
1661	SkipImplicitTyping(true);
1662	return true;
1663	}
1664	void Post(const parser::OpenMPDeclarativeAllocate &) {
1665	SkipImplicitTyping(false);
1666	}
1667	bool Pre(const parser::OpenMPDeclarativeConstruct &x) {
1668	AddOmpSourceRange(x.source);
1669	// Without skipping implicit typing, declarative constructs
1670	// can implicitly declare variables instead of only using the
1671	// ones already declared in the Fortran sources.
1672	SkipImplicitTyping(true);
1673	return true;
1674	}
1675	void Post(const parser::OpenMPDeclarativeConstruct &) {
1676	SkipImplicitTyping(false);
1677	messageHandler().set_currStmtSource(std::nullopt);
1678	}
1679	bool Pre(const parser::OpenMPDepobjConstruct &x) {
1680	AddOmpSourceRange(x.source);
1681	return true;
1682	}
1683	void Post(const parser::OpenMPDepobjConstruct &x) {
1684	messageHandler().set_currStmtSource(std::nullopt);
1685	}
1686	bool Pre(const parser::OpenMPAtomicConstruct &x) {
1687	AddOmpSourceRange(x.source);
1688	return true;
1689	}
1690	void Post(const parser::OpenMPAtomicConstruct &) {
1691	messageHandler().set_currStmtSource(std::nullopt);
1692	}
1693	bool Pre(const parser::OmpClause &x) {
1694	if (NeedsScope(x)) {
1695	PushScope(Scope::Kind::OtherClause, nullptr);
1696	}
1697	return true;
1698	}
1699	void Post(const parser::OmpClause &x) {
1700	if (NeedsScope(x)) {
1701	PopScope();
1702	}
1703	}
1704	bool Pre(const parser::OmpDirectiveSpecification &x);
1705
1706	bool Pre(const parser::OmpTypeSpecifier &x) {
1707	BeginDeclTypeSpec();
1708	return true;
1709	}
1710	void Post(const parser::OmpTypeSpecifier &x) { //
1711	EndDeclTypeSpec();
1712	}
1713
1714	private:
1715	void ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
1716	const parser::OmpClauseList &clauses);
1717	template <typename T>
1718	void ProcessReductionSpecifier(const parser::OmpReductionSpecifier &spec,
1719	const std::optional<parser::OmpClauseList> &clauses,
1720	const T &wholeConstruct);
1721
1722	int metaLevel_{0};
1723	const parser::OmpMetadirectiveDirective *metaDirective_{nullptr};
1724	};
1725
1726	bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
1727	const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1728	const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1729	switch (beginDir.v) {
1730	case llvm::omp::Directive::OMPD_master:
1731	case llvm::omp::Directive::OMPD_ordered:
1732	case llvm::omp::Directive::OMPD_taskgroup:
1733	return false;
1734	default:
1735	return true;
1736	}
1737	}
1738
1739	bool OmpVisitor::NeedsScope(const parser::OmpClause &x) {
1740	// Iterators contain declarations, whose scope extends until the end
1741	// the clause.
1742	return llvm::omp::canHaveIterator(x.Id());
1743	}
1744
1745	void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
1746	messageHandler().set_currStmtSource(source);
1747	currScope().AddSourceRange(source);
1748	}
1749
1750	bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1751	if (NeedsScope(x)) {
1752	PushScope(Scope::Kind::OtherConstruct, nullptr);
1753	}
1754	return true;
1755	}
1756
1757	void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1758	if (NeedsScope(x)) {
1759	PopScope();
1760	}
1761	}
1762
1763	bool OmpVisitor::Pre(const parser::OmpMapClause &x) {
1764	auto &mods{OmpGetModifiers(x)};
1765	if (auto *mapper{OmpGetUniqueModifier<parser::OmpMapper>(mods)}) {
1766	if (auto *symbol{FindSymbol(currScope(), mapper->v)}) {
1767	// TODO: Do we need a specific flag or type here, to distinghuish against
1768	// other ConstructName things? Leaving this for the full implementation
1769	// of mapper lowering.
1770	auto *misc{symbol->detailsIf<MiscDetails>()};
1771	if (!misc || misc->kind() != MiscDetails::Kind::ConstructName)
1772	context().Say(mapper->v.source,
1773	"Name '%s' should be a mapper name"_err_en_US, mapper->v.source);
1774	else
1775	mapper->v.symbol = symbol;
1776	} else {
1777	mapper->v.symbol =
1778	&MakeSymbol(mapper->v, MiscDetails{MiscDetails::Kind::ConstructName});
1779	// TODO: When completing the implementation, we probably want to error if
1780	// the symbol is not declared, but right now, testing that the TODO for
1781	// OmpMapClause happens is obscured by the TODO for declare mapper, so
1782	// leaving this out. Remove the above line once the declare mapper is
1783	// implemented. context().Say(mapper->v.source, "'%s' not
1784	// declared"_err_en_US, mapper->v.source);
1785	}
1786	}
1787	return true;
1788	}
1789
1790	void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
1791	const parser::OmpClauseList &clauses) {
1792	// This "manually" walks the tree of the construct, because we need
1793	// to resolve the type before the map clauses are processed - when
1794	// just following the natural flow, the map clauses gets processed before
1795	// the type has been fully processed.
1796	BeginDeclTypeSpec();
1797	auto &mapperName{std::get<std::string>(spec.t)};
1798	MakeSymbol(parser::CharBlock(mapperName), Attrs{},
1799	MiscDetails{MiscDetails::Kind::ConstructName});
1800	PushScope(Scope::Kind::OtherConstruct, nullptr);
1801	Walk(std::get<parser::TypeSpec>(spec.t));
1802	auto &varName{std::get<parser::Name>(spec.t)};
1803	DeclareObjectEntity(varName);
1804
1805	Walk(clauses);
1806	EndDeclTypeSpec();
1807	PopScope();
1808	}
1809
1810	parser::CharBlock MakeNameFromOperator(
1811	const parser::DefinedOperator::IntrinsicOperator &op,
1812	SemanticsContext &context) {
1813	switch (op) {
1814	case parser::DefinedOperator::IntrinsicOperator::Multiply:
1815	return parser::CharBlock{"op.*", 4};
1816	case parser::DefinedOperator::IntrinsicOperator::Add:
1817	return parser::CharBlock{"op.+", 4};
1818	case parser::DefinedOperator::IntrinsicOperator::Subtract:
1819	return parser::CharBlock{"op.-", 4};
1820
1821	case parser::DefinedOperator::IntrinsicOperator::AND:
1822	return parser::CharBlock{"op.AND", 6};
1823	case parser::DefinedOperator::IntrinsicOperator::OR:
1824	return parser::CharBlock{"op.OR", 6};
1825	case parser::DefinedOperator::IntrinsicOperator::EQV:
1826	return parser::CharBlock{"op.EQV", 7};
1827	case parser::DefinedOperator::IntrinsicOperator::NEQV:
1828	return parser::CharBlock{"op.NEQV", 8};
1829
1830	default:
1831	context.Say("Unsupported operator in DECLARE REDUCTION"_err_en_US);
1832	return parser::CharBlock{"op.?", 4};
1833	}
1834	}
1835
1836	parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name) {
1837	return llvm::StringSwitch<parser::CharBlock>(name.ToString())
1838	.Case("max", {"op.max", 6})
1839	.Case("min", {"op.min", 6})
1840	.Case("iand", {"op.iand", 7})
1841	.Case("ior", {"op.ior", 6})
1842	.Case("ieor", {"op.ieor", 7})
1843	.Default(name);
1844	}
1845
1846	std::string MangleDefinedOperator(const parser::CharBlock &name) {
1847	CHECK(name[0] == '.' && name[name.size() - 1] == '.');
1848	return "op" + name.ToString();
1849	}
1850
1851	template <typename T>
1852	void OmpVisitor::ProcessReductionSpecifier(
1853	const parser::OmpReductionSpecifier &spec,
1854	const std::optional<parser::OmpClauseList> &clauses,
1855	const T &wholeOmpConstruct) {
1856	const parser::Name *name{nullptr};
1857	parser::CharBlock mangledName;
1858	UserReductionDetails reductionDetailsTemp;
1859	const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};
1860	if (auto *procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
1861	name = std::get_if<parser::Name>(&procDes->u);
1862	// This shouldn't be a procedure component: this is the name of the
1863	// reduction being declared.
1864	CHECK(name);
1865	// Prevent the symbol from conflicting with the builtin function name
1866	mangledName = MangleSpecialFunctions(name->source);
1867	// Note: the Name inside the parse tree is not updated because it is const.
1868	// All lookups must use MangleSpecialFunctions.
1869	} else {
1870	const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
1871	if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
1872	name = &definedOp->v;
1873	mangledName = context().SaveTempName(MangleDefinedOperator(name->source));
1874	} else {
1875	mangledName = MakeNameFromOperator(
1876	std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
1877	context());
1878	}
1879	}
1880
1881	// Use reductionDetailsTemp if we can't find the symbol (this is
1882	// the first, or only, instance with this name). The details then
1883	// gets stored in the symbol when it's created.
1884	UserReductionDetails *reductionDetails{&reductionDetailsTemp};
1885	Symbol *symbol{currScope().FindSymbol(mangledName)};
1886	if (symbol) {
1887	// If we found a symbol, we append the type info to the
1888	// existing reductionDetails.
1889	reductionDetails = symbol->detailsIf<UserReductionDetails>();
1890
1891	if (!reductionDetails) {
1892	context().Say(
1893	"Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,
1894	mangledName);
1895	return;
1896	}
1897	}
1898
1899	auto &typeList{std::get<parser::OmpTypeNameList>(spec.t)};
1900
1901	// Create a temporary variable declaration for the four variables
1902	// used in the reduction specifier and initializer (omp_out, omp_in,
1903	// omp_priv and omp_orig), with the type in the typeList.
1904	//
1905	// In theory it would be possible to create only variables that are
1906	// actually used, but that requires walking the entire parse-tree of the
1907	// expressions, and finding the relevant variables [there may well be other
1908	// variables involved too].
1909	//
1910	// This allows doing semantic analysis where the type is a derived type
1911	// e.g omp_out%x = omp_out%x + omp_in%x.
1912	//
1913	// These need to be temporary (in their own scope). If they are created
1914	// as variables in the outer scope, if there's more than one type in the
1915	// typelist, duplicate symbols will be reported.
1916	const parser::CharBlock ompVarNames[]{
1917	{"omp_in", 6}, {"omp_out", 7}, {"omp_priv", 8}, {"omp_orig", 8}};
1918
1919	for (auto &t : typeList.v) {
1920	PushScope(Scope::Kind::OtherConstruct, nullptr);
1921	BeginDeclTypeSpec();
1922	// We need to walk t.u because Walk(t) does it's own BeginDeclTypeSpec.
1923	Walk(t.u);
1924
1925	// Only process types we can find. There will be an error later on when
1926	// a type isn't found.
1927	if (const DeclTypeSpec *typeSpec{GetDeclTypeSpec()}) {
1928	reductionDetails->AddType(*typeSpec);
1929
1930	for (auto &nm : ompVarNames) {
1931	ObjectEntityDetails details{};
1932	details.set_type(*typeSpec);
1933	MakeSymbol(nm, Attrs{}, std::move(details));
1934	}
1935	}
1936	EndDeclTypeSpec();
1937	Walk(std::get<std::optional<parser::OmpReductionCombiner>>(spec.t));
1938	Walk(clauses);
1939	PopScope();
1940	}
1941
1942	reductionDetails->AddDecl(&wholeOmpConstruct);
1943
1944	if (!symbol) {
1945	symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
1946	}
1947	if (name) {
1948	name->symbol = symbol;
1949	}
1950	}
1951
1952	bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
1953	AddOmpSourceRange(source: x.source);
1954	if (metaLevel_ == 0) {
1955	// Not in METADIRECTIVE.
1956	return true;
1957	}
1958
1959	// If OmpDirectiveSpecification (which contains clauses) is a part of
1960	// METADIRECTIVE, some semantic checks may not be applicable.
1961	// Disable the semantic analysis for it in such cases to allow the compiler
1962	// to parse METADIRECTIVE without flagging errors.
1963	auto &maybeArgs{std::get<std::optional<parser::OmpArgumentList>>(x.t)};
1964	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.t)};
1965
1966	switch (x.DirId()) {
1967	case llvm::omp::Directive::OMPD_declare_mapper:
1968	if (maybeArgs && maybeClauses) {
1969	const parser::OmpArgument &first{maybeArgs->v.front()};
1970	if (auto *spec{std::get_if<parser::OmpMapperSpecifier>(&first.u)}) {
1971	ProcessMapperSpecifier(*spec, *maybeClauses);
1972	}
1973	}
1974	break;
1975	case llvm::omp::Directive::OMPD_declare_reduction:
1976	if (maybeArgs && maybeClauses) {
1977	const parser::OmpArgument &first{maybeArgs->v.front()};
1978	if (auto *spec{std::get_if<parser::OmpReductionSpecifier>(&first.u)}) {
1979	CHECK(metaDirective_);
1980	ProcessReductionSpecifier(*spec, maybeClauses, *metaDirective_);
1981	}
1982	}
1983	break;
1984	default:
1985	// Default processing.
1986	Walk(maybeArgs);
1987	Walk(maybeClauses);
1988	break;
1989	}
1990	return false;
1991	}
1992
1993	// Walk the parse tree and resolve names to symbols.
1994	class ResolveNamesVisitor : public virtual ScopeHandler,
1995	public ModuleVisitor,
1996	public SubprogramVisitor,
1997	public ConstructVisitor,
1998	public OmpVisitor,
1999	public AccVisitor {
2000	public:
2001	using AccVisitor::Post;
2002	using AccVisitor::Pre;
2003	using ArraySpecVisitor::Post;
2004	using ConstructVisitor::Post;
2005	using ConstructVisitor::Pre;
2006	using DeclarationVisitor::Post;
2007	using DeclarationVisitor::Pre;
2008	using ImplicitRulesVisitor::Post;
2009	using ImplicitRulesVisitor::Pre;
2010	using InterfaceVisitor::Post;
2011	using InterfaceVisitor::Pre;
2012	using ModuleVisitor::Post;
2013	using ModuleVisitor::Pre;
2014	using OmpVisitor::Post;
2015	using OmpVisitor::Pre;
2016	using ScopeHandler::Post;
2017	using ScopeHandler::Pre;
2018	using SubprogramVisitor::Post;
2019	using SubprogramVisitor::Pre;
2020
2021	ResolveNamesVisitor(
2022	SemanticsContext &context, ImplicitRulesMap &rules, Scope &top)
2023	: BaseVisitor{context, *this, rules}, topScope_{top} {
2024	PushScope(top);
2025	}
2026
2027	Scope &topScope() const { return topScope_; }
2028
2029	// Default action for a parse tree node is to visit children.
2030	template <typename T> bool Pre(const T &) { return true; }
2031	template <typename T> void Post(const T &) {}
2032
2033	bool Pre(const parser::SpecificationPart &);
2034	bool Pre(const parser::Program &);
2035	void Post(const parser::Program &);
2036	bool Pre(const parser::ImplicitStmt &);
2037	void Post(const parser::PointerObject &);
2038	void Post(const parser::AllocateObject &);
2039	bool Pre(const parser::PointerAssignmentStmt &);
2040	void Post(const parser::Designator &);
2041	void Post(const parser::SubstringInquiry &);
2042	template <typename A, typename B>
2043	void Post(const parser::LoopBounds<A, B> &x) {
2044	ResolveName(*parser::Unwrap<parser::Name>(x.name));
2045	}
2046	void Post(const parser::ProcComponentRef &);
2047	bool Pre(const parser::FunctionReference &);
2048	bool Pre(const parser::CallStmt &);
2049	bool Pre(const parser::ImportStmt &);
2050	void Post(const parser::TypeGuardStmt &);
2051	bool Pre(const parser::StmtFunctionStmt &);
2052	bool Pre(const parser::DefinedOpName &);
2053	bool Pre(const parser::ProgramUnit &);
2054	void Post(const parser::AssignStmt &);
2055	void Post(const parser::AssignedGotoStmt &);
2056	void Post(const parser::CompilerDirective &);
2057
2058	// These nodes should never be reached: they are handled in ProgramUnit
2059	bool Pre(const parser::MainProgram &) {
2060	llvm_unreachable("This node is handled in ProgramUnit");
2061	}
2062	bool Pre(const parser::FunctionSubprogram &) {
2063	llvm_unreachable("This node is handled in ProgramUnit");
2064	}
2065	bool Pre(const parser::SubroutineSubprogram &) {
2066	llvm_unreachable("This node is handled in ProgramUnit");
2067	}
2068	bool Pre(const parser::SeparateModuleSubprogram &) {
2069	llvm_unreachable("This node is handled in ProgramUnit");
2070	}
2071	bool Pre(const parser::Module &) {
2072	llvm_unreachable("This node is handled in ProgramUnit");
2073	}
2074	bool Pre(const parser::Submodule &) {
2075	llvm_unreachable("This node is handled in ProgramUnit");
2076	}
2077	bool Pre(const parser::BlockData &) {
2078	llvm_unreachable("This node is handled in ProgramUnit");
2079	}
2080
2081	void NoteExecutablePartCall(Symbol::Flag, SourceName, bool hasCUDAChevrons);
2082
2083	friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
2084
2085	private:
2086	// Kind of procedure we are expecting to see in a ProcedureDesignator
2087	std::optional<Symbol::Flag> expectedProcFlag_;
2088	std::optional<SourceName> prevImportStmt_;
2089	Scope &topScope_;
2090
2091	void PreSpecificationConstruct(const parser::SpecificationConstruct &);
2092	void EarlyDummyTypeDeclaration(
2093	const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
2094	&);
2095	void CreateCommonBlockSymbols(const parser::CommonStmt &);
2096	void CreateObjectSymbols(const std::list<parser::ObjectDecl> &, Attr);
2097	void CreateGeneric(const parser::GenericSpec &);
2098	void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
2099	void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
2100	void CheckImports();
2101	void CheckImport(const SourceName &, const SourceName &);
2102	void HandleCall(Symbol::Flag, const parser::Call &);
2103	void HandleProcedureName(Symbol::Flag, const parser::Name &);
2104	bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
2105	bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
2106	void ResolveSpecificationParts(ProgramTree &);
2107	void AddSubpNames(ProgramTree &);
2108	bool BeginScopeForNode(const ProgramTree &);
2109	void EndScopeForNode(const ProgramTree &);
2110	void FinishSpecificationParts(const ProgramTree &);
2111	void FinishExecutionParts(const ProgramTree &);
2112	void FinishDerivedTypeInstantiation(Scope &);
2113	void ResolveExecutionParts(const ProgramTree &);
2114	void UseCUDABuiltinNames();
2115	void HandleDerivedTypesInImplicitStmts(const parser::ImplicitPart &,
2116	const std::list<parser::DeclarationConstruct> &);
2117	};
2118
2119	// ImplicitRules implementation
2120
2121	bool ImplicitRules::isImplicitNoneType() const {
2122	if (isImplicitNoneType_) {
2123	return true;
2124	} else if (map_.empty() && inheritFromParent_) {
2125	return parent_->isImplicitNoneType();
2126	} else {
2127	return false; // default if not specified
2128	}
2129	}
2130
2131	bool ImplicitRules::isImplicitNoneExternal() const {
2132	if (isImplicitNoneExternal_) {
2133	return true;
2134	} else if (inheritFromParent_) {
2135	return parent_->isImplicitNoneExternal();
2136	} else {
2137	return false; // default if not specified
2138	}
2139	}
2140
2141	const DeclTypeSpec *ImplicitRules::GetType(
2142	SourceName name, bool respectImplicitNoneType) const {
2143	char ch{name.begin()[0]};
2144	if (isImplicitNoneType_ && respectImplicitNoneType) {
2145	return nullptr;
2146	} else if (auto it{map_.find(ch)}; it != map_.end()) {
2147	return &*it->second;
2148	} else if (inheritFromParent_) {
2149	return parent_->GetType(name, respectImplicitNoneType);
2150	} else if (ch >= 'i' && ch <= 'n') {
2151	return &context_.MakeNumericType(TypeCategory::Integer);
2152	} else if (ch >= 'a' && ch <= 'z') {
2153	return &context_.MakeNumericType(TypeCategory::Real);
2154	} else {
2155	return nullptr;
2156	}
2157	}
2158
2159	void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
2160	parser::Location fromLetter, parser::Location toLetter) {
2161	for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
2162	auto res{map_.emplace(ch, type)};
2163	if (!res.second) {
2164	context_.Say(parser::CharBlock{fromLetter},
2165	"More than one implicit type specified for '%c'"_err_en_US, ch);
2166	}
2167	if (ch == *toLetter) {
2168	break;
2169	}
2170	}
2171	}
2172
2173	// Return the next char after ch in a way that works for ASCII or EBCDIC.
2174	// Return '\0' for the char after 'z'.
2175	char ImplicitRules::Incr(char ch) {
2176	switch (ch) {
2177	case 'i':
2178	return 'j';
2179	case 'r':
2180	return 's';
2181	case 'z':
2182	return '\0';
2183	default:
2184	return ch + 1;
2185	}
2186	}
2187
2188	llvm::raw_ostream &operator<<(
2189	llvm::raw_ostream &o, const ImplicitRules &implicitRules) {
2190	o << "ImplicitRules:\n";
2191	for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
2192	ShowImplicitRule(o, implicitRules, ch);
2193	}
2194	ShowImplicitRule(o, implicitRules, '_');
2195	ShowImplicitRule(o, implicitRules, '$');
2196	ShowImplicitRule(o, implicitRules, '@');
2197	return o;
2198	}
2199	void ShowImplicitRule(
2200	llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {
2201	auto it{implicitRules.map_.find(ch)};
2202	if (it != implicitRules.map_.end()) {
2203	o << " " << ch << ": " << *it->second << '\n';
2204	}
2205	}
2206
2207	template <typename T> void BaseVisitor::Walk(const T &x) {
2208	parser::Walk(x, *this_);
2209	}
2210
2211	void BaseVisitor::MakePlaceholder(
2212	const parser::Name &name, MiscDetails::Kind kind) {
2213	if (!name.symbol) {
2214	name.symbol = &context_->globalScope().MakeSymbol(
2215	name.source, Attrs{}, MiscDetails{kind});
2216	}
2217	}
2218
2219	// AttrsVisitor implementation
2220
2221	bool AttrsVisitor::BeginAttrs() {
2222	CHECK(!attrs_ && !cudaDataAttr_);
2223	attrs_ = Attrs{};
2224	return true;
2225	}
2226	Attrs AttrsVisitor::GetAttrs() {
2227	CHECK(attrs_);
2228	return *attrs_;
2229	}
2230	Attrs AttrsVisitor::EndAttrs() {
2231	Attrs result{GetAttrs()};
2232	attrs_.reset();
2233	cudaDataAttr_.reset();
2234	passName_ = std::nullopt;
2235	bindName_.reset();
2236	isCDefined_ = false;
2237	return result;
2238	}
2239
2240	bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
2241	if (!passName_) {
2242	return false;
2243	}
2244	common::visit(common::visitors{
2245	[&](ProcEntityDetails &x) { x.set_passName(*passName_); },
2246	[&](ProcBindingDetails &x) { x.set_passName(*passName_); },
2247	[](auto &) { common::die("unexpected pass name"); },
2248	},
2249	symbol.details());
2250	return true;
2251	}
2252
2253	void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
2254	if ((!attrs_ || !attrs_->test(Attr::BIND_C)) &&
2255	!symbol.attrs().test(Attr::BIND_C)) {
2256	return;
2257	}
2258	symbol.SetIsCDefined(isCDefined_);
2259	std::optional<std::string> label{
2260	evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
2261	// 18.9.2(2): discard leading and trailing blanks
2262	if (label) {
2263	symbol.SetIsExplicitBindName(true);
2264	auto first{label->find_first_not_of(s: " ")};
2265	if (first == std::string::npos) {
2266	// Empty NAME= means no binding at all (18.10.2p2)
2267	return;
2268	}
2269	auto last{label->find_last_not_of(s: " ")};
2270	label = label->substr(pos: first, n: last - first + 1);
2271	} else if (symbol.GetIsExplicitBindName()) {
2272	// don't try to override explicit binding name with default
2273	return;
2274	} else if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) {
2275	// BIND(C) does not give an implicit binding label to internal procedures.
2276	return;
2277	} else {
2278	label = symbol.name().ToString();
2279	}
2280	// Checks whether a symbol has two Bind names.
2281	std::string oldBindName;
2282	if (const auto *bindName{symbol.GetBindName()}) {
2283	oldBindName = *bindName;
2284	}
2285	symbol.SetBindName(std::move(*label));
2286	if (!oldBindName.empty()) {
2287	if (const std::string * newBindName{symbol.GetBindName()}) {
2288	if (oldBindName != *newBindName) {
2289	Say(symbol.name(),
2290	"The entity '%s' has multiple BIND names ('%s' and '%s')"_err_en_US,
2291	symbol.name(), oldBindName, *newBindName);
2292	}
2293	}
2294	}
2295	}
2296
2297	void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
2298	if (CheckAndSet(Attr::BIND_C)) {
2299	if (const auto &name{
2300	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
2301	x.t)}) {
2302	bindName_ = EvaluateExpr(*name);
2303	}
2304	isCDefined_ = std::get<bool>(x.t);
2305	}
2306	}
2307	bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
2308	CheckAndSet(IntentSpecToAttr(x));
2309	return false;
2310	}
2311	bool AttrsVisitor::Pre(const parser::Pass &x) {
2312	if (CheckAndSet(Attr::PASS)) {
2313	if (x.v) {
2314	passName_ = x.v->source;
2315	MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
2316	}
2317	}
2318	return false;
2319	}
2320
2321	// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
2322	bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
2323	CHECK(attrs_);
2324	if (attrs_->test(attrName)) {
2325	context().Warn(common::LanguageFeature::RedundantAttribute,
2326	currStmtSource().value(),
2327	"Attribute '%s' cannot be used more than once"_warn_en_US,
2328	AttrToString(attrName));
2329	return true;
2330	}
2331	return false;
2332	}
2333
2334	// See if attrName violates a constraint cause by a conflict. attr1 and attr2
2335	// name attributes that cannot be used on the same declaration
2336	bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
2337	CHECK(attrs_);
2338	if ((attrName == attr1 && attrs_->test(attr2)) ||
2339	(attrName == attr2 && attrs_->test(attr1))) {
2340	Say(currStmtSource().value(),
2341	"Attributes '%s' and '%s' conflict with each other"_err_en_US,
2342	AttrToString(attr1), AttrToString(attr2));
2343	return true;
2344	}
2345	return false;
2346	}
2347	// C759, C1543
2348	bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
2349	return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
2350	HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
2351	HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
2352	HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
2353	HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
2354	HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
2355	HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
2356	}
2357	bool AttrsVisitor::CheckAndSet(Attr attrName) {
2358	if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
2359	return false;
2360	}
2361	attrs_->set(attrName);
2362	return true;
2363	}
2364	bool AttrsVisitor::Pre(const common::CUDADataAttr x) {
2365	if (cudaDataAttr_.value_or(x) != x) {
2366	Say(currStmtSource().value(),
2367	"CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,
2368	common::EnumToString(*cudaDataAttr_), common::EnumToString(x));
2369	}
2370	cudaDataAttr_ = x;
2371	return false;
2372	}
2373
2374	// DeclTypeSpecVisitor implementation
2375
2376	const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
2377	return state_.declTypeSpec;
2378	}
2379
2380	void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
2381	CHECK(!state_.expectDeclTypeSpec);
2382	CHECK(!state_.declTypeSpec);
2383	state_.expectDeclTypeSpec = true;
2384	}
2385	void DeclTypeSpecVisitor::EndDeclTypeSpec() {
2386	CHECK(state_.expectDeclTypeSpec);
2387	state_ = {};
2388	}
2389
2390	void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
2391	DeclTypeSpec::Category category) {
2392	CHECK(state_.expectDeclTypeSpec);
2393	state_.derived.category = category;
2394	}
2395
2396	bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
2397	BeginDeclTypeSpec();
2398	return true;
2399	}
2400	void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
2401	EndDeclTypeSpec();
2402	}
2403
2404	void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
2405	// Record the resolved DeclTypeSpec in the parse tree for use by
2406	// expression semantics if the DeclTypeSpec is a valid TypeSpec.
2407	// The grammar ensures that it's an intrinsic or derived type spec,
2408	// not TYPE(*) or CLASS(*) or CLASS(T).
2409	if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
2410	switch (spec->category()) {
2411	case DeclTypeSpec::Numeric:
2412	case DeclTypeSpec::Logical:
2413	case DeclTypeSpec::Character:
2414	typeSpec.declTypeSpec = spec;
2415	break;
2416	case DeclTypeSpec::TypeDerived:
2417	if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
2418	CheckForAbstractType(typeSymbol: derived->typeSymbol()); // C703
2419	typeSpec.declTypeSpec = spec;
2420	}
2421	break;
2422	default:
2423	CRASH_NO_CASE;
2424	}
2425	}
2426	}
2427
2428	void DeclTypeSpecVisitor::Post(
2429	const parser::IntrinsicTypeSpec::DoublePrecision &) {
2430	MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
2431	}
2432	void DeclTypeSpecVisitor::Post(
2433	const parser::IntrinsicTypeSpec::DoubleComplex &) {
2434	MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
2435	}
2436	void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
2437	SetDeclTypeSpec(context().MakeNumericType(category, kind));
2438	}
2439
2440	void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {
2441	if (typeSymbol.attrs().test(Attr::ABSTRACT)) {
2442	Say("ABSTRACT derived type may not be used here"_err_en_US);
2443	}
2444	}
2445
2446	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
2447	SetDeclTypeSpec(context().globalScope().MakeClassStarType());
2448	}
2449	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
2450	SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
2451	}
2452
2453	// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
2454	// and save it in state_.declTypeSpec.
2455	void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
2456	CHECK(state_.expectDeclTypeSpec);
2457	CHECK(!state_.declTypeSpec);
2458	state_.declTypeSpec = &declTypeSpec;
2459	}
2460
2461	KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
2462	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
2463	return AnalyzeKindSelector(context(), category, kind);
2464	}
2465
2466	// MessageHandler implementation
2467
2468	Message &MessageHandler::Say(MessageFixedText &&msg) {
2469	return context_->Say(currStmtSource().value(), std::move(msg));
2470	}
2471	Message &MessageHandler::Say(MessageFormattedText &&msg) {
2472	return context_->Say(currStmtSource().value(), std::move(msg));
2473	}
2474	Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
2475	return Say(source: name, msg: std::move(msg), args: name);
2476	}
2477
2478	// ImplicitRulesVisitor implementation
2479
2480	void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
2481	prevParameterStmt_ = currStmtSource();
2482	}
2483
2484	bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
2485	bool result{
2486	common::visit(common::visitors{
2487	[&](const std::list<ImplicitNoneNameSpec> &y) {
2488	return HandleImplicitNone(y);
2489	},
2490	[&](const std::list<parser::ImplicitSpec> &) {
2491	if (prevImplicitNoneType_) {
2492	Say("IMPLICIT statement after IMPLICIT NONE or "
2493	"IMPLICIT NONE(TYPE) statement"_err_en_US);
2494	return false;
2495	}
2496	implicitRules_->set_isImplicitNoneType(false);
2497	return true;
2498	},
2499	},
2500	x.u)};
2501	prevImplicit_ = currStmtSource();
2502	return result;
2503	}
2504
2505	bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
2506	auto loLoc{std::get<parser::Location>(x.t)};
2507	auto hiLoc{loLoc};
2508	if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
2509	hiLoc = *hiLocOpt;
2510	if (*hiLoc < *loLoc) {
2511	Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
2512	std::string(hiLoc, 1), std::string(loLoc, 1));
2513	return false;
2514	}
2515	}
2516	implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
2517	return false;
2518	}
2519
2520	bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
2521	BeginDeclTypeSpec();
2522	set_allowForwardReferenceToDerivedType(true);
2523	return true;
2524	}
2525
2526	void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
2527	set_allowForwardReferenceToDerivedType(false);
2528	EndDeclTypeSpec();
2529	}
2530
2531	void ImplicitRulesVisitor::SetScope(const Scope &scope) {
2532	implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);
2533	prevImplicit_ = std::nullopt;
2534	prevImplicitNone_ = std::nullopt;
2535	prevImplicitNoneType_ = std::nullopt;
2536	prevParameterStmt_ = std::nullopt;
2537	}
2538	void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
2539	// find or create implicit rules for this scope
2540	DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);
2541	SetScope(scope);
2542	}
2543
2544	// TODO: for all of these errors, reference previous statement too
2545	bool ImplicitRulesVisitor::HandleImplicitNone(
2546	const std::list<ImplicitNoneNameSpec> &nameSpecs) {
2547	if (prevImplicitNone_) {
2548	Say("More than one IMPLICIT NONE statement"_err_en_US);
2549	Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
2550	return false;
2551	}
2552	if (prevParameterStmt_) {
2553	Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
2554	return false;
2555	}
2556	prevImplicitNone_ = currStmtSource();
2557	bool implicitNoneTypeNever{
2558	context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
2559	if (nameSpecs.empty()) {
2560	if (!implicitNoneTypeNever) {
2561	prevImplicitNoneType_ = currStmtSource();
2562	implicitRules_->set_isImplicitNoneType(true);
2563	if (prevImplicit_) {
2564	Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
2565	return false;
2566	}
2567	}
2568	} else {
2569	int sawType{0};
2570	int sawExternal{0};
2571	for (const auto noneSpec : nameSpecs) {
2572	switch (noneSpec) {
2573	case ImplicitNoneNameSpec::External:
2574	implicitRules_->set_isImplicitNoneExternal(true);
2575	++sawExternal;
2576	break;
2577	case ImplicitNoneNameSpec::Type:
2578	if (!implicitNoneTypeNever) {
2579	prevImplicitNoneType_ = currStmtSource();
2580	implicitRules_->set_isImplicitNoneType(true);
2581	if (prevImplicit_) {
2582	Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
2583	return false;
2584	}
2585	++sawType;
2586	}
2587	break;
2588	}
2589	}
2590	if (sawType > 1) {
2591	Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
2592	return false;
2593	}
2594	if (sawExternal > 1) {
2595	Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
2596	return false;
2597	}
2598	}
2599	return true;
2600	}
2601
2602	// ArraySpecVisitor implementation
2603
2604	void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
2605	CHECK(arraySpec_.empty());
2606	arraySpec_ = AnalyzeArraySpec(context(), x);
2607	}
2608	void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
2609	CHECK(arraySpec_.empty());
2610	arraySpec_ = AnalyzeArraySpec(context(), x);
2611	}
2612	void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
2613	CHECK(coarraySpec_.empty());
2614	coarraySpec_ = AnalyzeCoarraySpec(context(), x);
2615	}
2616
2617	const ArraySpec &ArraySpecVisitor::arraySpec() {
2618	return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
2619	}
2620	const ArraySpec &ArraySpecVisitor::coarraySpec() {
2621	return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
2622	}
2623	void ArraySpecVisitor::BeginArraySpec() {
2624	CHECK(arraySpec_.empty());
2625	CHECK(coarraySpec_.empty());
2626	CHECK(attrArraySpec_.empty());
2627	CHECK(attrCoarraySpec_.empty());
2628	}
2629	void ArraySpecVisitor::EndArraySpec() {
2630	CHECK(arraySpec_.empty());
2631	CHECK(coarraySpec_.empty());
2632	attrArraySpec_.clear();
2633	attrCoarraySpec_.clear();
2634	}
2635	void ArraySpecVisitor::PostAttrSpec() {
2636	// Save dimension/codimension from attrs so we can process array/coarray-spec
2637	// on the entity-decl
2638	if (!arraySpec_.empty()) {
2639	if (attrArraySpec_.empty()) {
2640	attrArraySpec_ = arraySpec_;
2641	arraySpec_.clear();
2642	} else {
2643	Say(currStmtSource().value(),
2644	"Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
2645	}
2646	}
2647	if (!coarraySpec_.empty()) {
2648	if (attrCoarraySpec_.empty()) {
2649	attrCoarraySpec_ = coarraySpec_;
2650	coarraySpec_.clear();
2651	} else {
2652	Say(currStmtSource().value(),
2653	"Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
2654	}
2655	}
2656	}
2657
2658	// FuncResultStack implementation
2659
2660	FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
2661
2662	void FuncResultStack::CompleteFunctionResultType() {
2663	// If the function has a type in the prefix, process it now.
2664	FuncInfo *info{Top()};
2665	if (info && &info->scope == &scopeHandler_.currScope()) {
2666	if (info->parsedType && info->resultSymbol) {
2667	scopeHandler_.messageHandler().set_currStmtSource(info->source);
2668	if (const auto *type{
2669	scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
2670	Symbol &symbol{*info->resultSymbol};
2671	if (!scopeHandler_.context().HasError(symbol)) {
2672	if (symbol.GetType()) {
2673	scopeHandler_.Say(symbol.name(),
2674	"Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US);
2675	scopeHandler_.context().SetError(symbol);
2676	} else {
2677	symbol.SetType(*type);
2678	}
2679	}
2680	}
2681	info->parsedType = nullptr;
2682	}
2683	}
2684	}
2685
2686	// Called from ConvertTo{Object/Proc}Entity to cope with any appearance
2687	// of the function result in a specification expression.
2688	void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {
2689	if (FuncInfo * info{Top()}) {
2690	if (info->resultSymbol == &symbol) {
2691	CompleteFunctionResultType();
2692	}
2693	}
2694	}
2695
2696	void FuncResultStack::Pop() {
2697	if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {
2698	stack_.pop_back();
2699	}
2700	}
2701
2702	// ScopeHandler implementation
2703
2704	void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
2705	SayAlreadyDeclared(name.source, prev);
2706	}
2707	void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
2708	if (context().HasError(prev)) {
2709	// don't report another error about prev
2710	} else {
2711	if (const auto *details{prev.detailsIf<UseDetails>()}) {
2712	Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
2713	.Attach(details->location(),
2714	"It is use-associated with '%s' in module '%s'"_en_US,
2715	details->symbol().name(), GetUsedModule(*details).name());
2716	} else {
2717	SayAlreadyDeclared(name, prev.name());
2718	}
2719	context().SetError(prev);
2720	}
2721	}
2722	void ScopeHandler::SayAlreadyDeclared(
2723	const SourceName &name1, const SourceName &name2) {
2724	if (name1.begin() < name2.begin()) {
2725	SayAlreadyDeclared(name1: name2, name2: name1);
2726	} else {
2727	Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
2728	.Attach(name2, "Previous declaration of '%s'"_en_US, name2);
2729	}
2730	}
2731
2732	void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
2733	MessageFixedText &&msg1, Message &&msg2) {
2734	bool isFatal{msg1.IsFatal()};
2735	Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));
2736	context().SetError(symbol, isFatal);
2737	}
2738
2739	template <typename... A>
2740	Message &ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
2741	MessageFixedText &&msg, A &&...args) {
2742	auto &message{
2743	Say(name.source, std::move(msg), symbol.name(), std::forward<A>(args)...)
2744	.Attach(symbol.name(),
2745	symbol.test(Symbol::Flag::Implicit)
2746	? "Implicit declaration of '%s'"_en_US
2747	: "Declaration of '%s'"_en_US,
2748	name.source)};
2749	if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
2750	if (auto usedAsProc{proc->usedAsProcedureHere()}) {
2751	if (usedAsProc->begin() != symbol.name().begin()) {
2752	message.Attach(*usedAsProc, "Referenced as a procedure"_en_US);
2753	}
2754	}
2755	}
2756	return message;
2757	}
2758
2759	void ScopeHandler::SayLocalMustBeVariable(
2760	const parser::Name &name, Symbol &symbol) {
2761	SayWithDecl(name, symbol,
2762	"The name '%s' must be a variable to appear"
2763	" in a locality-spec"_err_en_US);
2764	}
2765
2766	Message &ScopeHandler::SayDerivedType(
2767	const SourceName &name, MessageFixedText &&msg, const Scope &type) {
2768	const Symbol &typeSymbol{DEREF(type.GetSymbol())};
2769	return Say(name, std::move(msg), name, typeSymbol.name())
2770	.Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
2771	typeSymbol.name());
2772	}
2773	Message &ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
2774	const SourceName &name2, MessageFixedText &&msg2) {
2775	return Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
2776	}
2777	Message &ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
2778	Symbol &symbol, MessageFixedText &&msg2) {
2779	bool isFatal{msg1.IsFatal()};
2780	Message &result{Say2(name, std::move(msg1), symbol.name(), std::move(msg2))};
2781	context().SetError(symbol, isFatal);
2782	return result;
2783	}
2784	Message &ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
2785	Symbol &symbol, MessageFixedText &&msg2) {
2786	bool isFatal{msg1.IsFatal()};
2787	Message &result{
2788	Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2))};
2789	context().SetError(symbol, isFatal);
2790	return result;
2791	}
2792
2793	// This is essentially GetProgramUnitContaining(), but it can return
2794	// a mutable Scope &, it ignores statement functions, and it fails
2795	// gracefully for error recovery (returning the original Scope).
2796	template <typename T> static T &GetInclusiveScope(T &scope) {
2797	for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
2798	switch (s->kind()) {
2799	case Scope::Kind::Module:
2800	case Scope::Kind::MainProgram:
2801	case Scope::Kind::Subprogram:
2802	case Scope::Kind::BlockData:
2803	if (!s->IsStmtFunction()) {
2804	return *s;
2805	}
2806	break;
2807	default:;
2808	}
2809	}
2810	return scope;
2811	}
2812
2813	Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(scope&: currScope()); }
2814
2815	Scope *ScopeHandler::GetHostProcedure() {
2816	Scope &parent{InclusiveScope().parent()};
2817	switch (parent.kind()) {
2818	case Scope::Kind::Subprogram:
2819	return &parent;
2820	case Scope::Kind::MainProgram:
2821	return &parent;
2822	default:
2823	return nullptr;
2824	}
2825	}
2826
2827	Scope &ScopeHandler::NonDerivedTypeScope() {
2828	return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
2829	}
2830
2831	void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
2832	PushScope(scope&: currScope().MakeScope(kind, symbol));
2833	}
2834	void ScopeHandler::PushScope(Scope &scope) {
2835	currScope_ = &scope;
2836	auto kind{currScope_->kind()};
2837	if (kind != Scope::Kind::BlockConstruct &&
2838	kind != Scope::Kind::OtherConstruct && kind != Scope::Kind::OtherClause) {
2839	BeginScope(scope);
2840	}
2841	// The name of a module or submodule cannot be "used" in its scope,
2842	// as we read 19.3.1(2), so we allow the name to be used as a local
2843	// identifier in the module or submodule too. Same with programs
2844	// (14.1(3)) and BLOCK DATA.
2845	if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
2846	kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
2847	if (auto *symbol{scope.symbol()}) {
2848	// Create a dummy symbol so we can't create another one with the same
2849	// name. It might already be there if we previously pushed the scope.
2850	SourceName name{symbol->name()};
2851	if (!FindInScope(scope, name)) {
2852	auto &newSymbol{MakeSymbol(name)};
2853	if (kind == Scope::Kind::Subprogram) {
2854	// Allow for recursive references. If this symbol is a function
2855	// without an explicit RESULT(), this new symbol will be discarded
2856	// and replaced with an object of the same name.
2857	newSymbol.set_details(HostAssocDetails{*symbol});
2858	} else {
2859	newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
2860	}
2861	}
2862	}
2863	}
2864	}
2865	void ScopeHandler::PopScope() {
2866	CHECK(currScope_ && !currScope_->IsGlobal());
2867	// Entities that are not yet classified as objects or procedures are now
2868	// assumed to be objects.
2869	// TODO: Statement functions
2870	for (auto &pair : currScope()) {
2871	ConvertToObjectEntity(*pair.second);
2872	}
2873	funcResultStack_.Pop();
2874	// If popping back into a global scope, pop back to the top scope.
2875	Scope *hermetic{context().currentHermeticModuleFileScope()};
2876	SetScope(currScope_->parent().IsGlobal()
2877	? (hermetic ? *hermetic : context().globalScope())
2878	: currScope_->parent());
2879	}
2880	void ScopeHandler::SetScope(Scope &scope) {
2881	currScope_ = &scope;
2882	ImplicitRulesVisitor::SetScope(InclusiveScope());
2883	}
2884
2885	Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
2886	return FindSymbol(currScope(), name);
2887	}
2888	Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
2889	if (scope.IsDerivedType()) {
2890	if (Symbol * symbol{scope.FindComponent(name.source)}) {
2891	if (symbol->has<TypeParamDetails>()) {
2892	return Resolve(name, symbol);
2893	}
2894	}
2895	return FindSymbol(scope.parent(), name);
2896	} else {
2897	// In EQUIVALENCE statements only resolve names in the local scope, see
2898	// 19.5.1.4, paragraph 2, item (10)
2899	return Resolve(name,
2900	inEquivalenceStmt_ ? FindInScope(scope, name)
2901	: scope.FindSymbol(name.source));
2902	}
2903	}
2904
2905	Symbol &ScopeHandler::MakeSymbol(
2906	Scope &scope, const SourceName &name, Attrs attrs) {
2907	if (Symbol * symbol{FindInScope(scope, name)}) {
2908	CheckDuplicatedAttrs(name, *symbol, attrs);
2909	SetExplicitAttrs(*symbol, attrs);
2910	return *symbol;
2911	} else {
2912	const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
2913	CHECK(pair.second); // name was not found, so must be able to add
2914	return *pair.first->second;
2915	}
2916	}
2917	Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
2918	return MakeSymbol(currScope(), name, attrs);
2919	}
2920	Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
2921	return Resolve(name, MakeSymbol(name.source, attrs));
2922	}
2923	Symbol &ScopeHandler::MakeHostAssocSymbol(
2924	const parser::Name &name, const Symbol &hostSymbol) {
2925	Symbol &symbol{*NonDerivedTypeScope()
2926	.try_emplace(name.source, HostAssocDetails{hostSymbol})
2927	.first->second};
2928	name.symbol = &symbol;
2929	symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
2930	// These attributes can be redundantly reapplied without error
2931	// on the host-associated name, at most once (C815).
2932	symbol.implicitAttrs() =
2933	symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
2934	// SAVE statement in the inner scope will create a new symbol.
2935	// If the host variable is used via host association,
2936	// we have to propagate whether SAVE is implicit in the host scope.
2937	// Otherwise, verifications that do not allow explicit SAVE
2938	// attribute would fail.
2939	symbol.implicitAttrs() |= hostSymbol.implicitAttrs() & Attrs{Attr::SAVE};
2940	symbol.flags() = hostSymbol.flags();
2941	return symbol;
2942	}
2943	Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
2944	CHECK(!FindInScope(name));
2945	return MakeSymbol(currScope(), name, symbol.attrs());
2946	}
2947
2948	// Look for name only in scope, not in enclosing scopes.
2949
2950	Symbol *ScopeHandler::FindInScope(
2951	const Scope &scope, const parser::Name &name) {
2952	return Resolve(name, FindInScope(scope, name.source));
2953	}
2954	Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
2955	// all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
2956	for (const std::string &n : GetAllNames(context(), name)) {
2957	auto it{scope.find(SourceName{n})};
2958	if (it != scope.end()) {
2959	return &*it->second;
2960	}
2961	}
2962	return nullptr;
2963	}
2964
2965	// Find a component or type parameter by name in a derived type or its parents.
2966	Symbol *ScopeHandler::FindInTypeOrParents(
2967	const Scope &scope, const parser::Name &name) {
2968	return Resolve(name, scope.FindComponent(name.source));
2969	}
2970	Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
2971	return FindInTypeOrParents(scope: currScope(), name);
2972	}
2973	Symbol *ScopeHandler::FindInScopeOrBlockConstructs(
2974	const Scope &scope, SourceName name) {
2975	if (Symbol * symbol{FindInScope(scope, name)}) {
2976	return symbol;
2977	}
2978	for (const Scope &child : scope.children()) {
2979	if (child.kind() == Scope::Kind::BlockConstruct) {
2980	if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) {
2981	return symbol;
2982	}
2983	}
2984	}
2985	return nullptr;
2986	}
2987
2988	void ScopeHandler::EraseSymbol(const parser::Name &name) {
2989	currScope().erase(name.source);
2990	name.symbol = nullptr;
2991	}
2992
2993	static bool NeedsType(const Symbol &symbol) {
2994	return !symbol.GetType() &&
2995	common::visit(common::visitors{
2996	[](const EntityDetails &) { return true; },
2997	[](const ObjectEntityDetails &) { return true; },
2998	[](const AssocEntityDetails &) { return true; },
2999	[&](const ProcEntityDetails &p) {
3000	return symbol.test(Symbol::Flag::Function) &&
3001	!symbol.attrs().test(Attr::INTRINSIC) &&
3002	!p.type() && !p.procInterface();
3003	},
3004	[](const auto &) { return false; },
3005	},
3006	symbol.details());
3007	}
3008
3009	void ScopeHandler::ApplyImplicitRules(
3010	Symbol &symbol, bool allowForwardReference) {
3011	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3012	if (context().HasError(symbol) || !NeedsType(symbol)) {
3013	return;
3014	}
3015	if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
3016	if (!skipImplicitTyping_) {
3017	symbol.set(Symbol::Flag::Implicit);
3018	symbol.SetType(*type);
3019	}
3020	return;
3021	}
3022	if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
3023	std::optional<Symbol::Flag> functionOrSubroutineFlag;
3024	if (symbol.test(Symbol::Flag::Function)) {
3025	functionOrSubroutineFlag = Symbol::Flag::Function;
3026	} else if (symbol.test(Symbol::Flag::Subroutine)) {
3027	functionOrSubroutineFlag = Symbol::Flag::Subroutine;
3028	}
3029	if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
3030	// type will be determined in expression semantics
3031	AcquireIntrinsicProcedureFlags(symbol);
3032	return;
3033	}
3034	}
3035	if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
3036	return;
3037	}
3038	if (const auto *entity{symbol.detailsIf<EntityDetails>()};
3039	entity && entity->isDummy()) {
3040	// Dummy argument, no declaration or reference; if it turns
3041	// out to be a subroutine, it's fine, and if it is a function
3042	// or object, it'll be caught later.
3043	return;
3044	}
3045	if (deferImplicitTyping_) {
3046	return;
3047	}
3048	if (!context().HasError(symbol)) {
3049	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
3050	context().SetError(symbol);
3051	}
3052	}
3053
3054	// Extension: Allow forward references to scalar integer dummy arguments
3055	// or variables in COMMON to appear in specification expressions under
3056	// IMPLICIT NONE(TYPE) when what would otherwise have been their implicit
3057	// type is default INTEGER.
3058	bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
3059	if (!inSpecificationPart_ || context().HasError(symbol) ||
3060	!(IsDummy(symbol) || FindCommonBlockContaining(symbol)) ||
3061	symbol.Rank() != 0 ||
3062	!context().languageFeatures().IsEnabled(
3063	common::LanguageFeature::ForwardRefImplicitNone)) {
3064	return false;
3065	}
3066	const DeclTypeSpec *type{
3067	GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
3068	if (!type || !type->IsNumeric(TypeCategory::Integer)) {
3069	return false;
3070	}
3071	auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
3072	if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
3073	return false;
3074	}
3075	if (!ConvertToObjectEntity(symbol)) {
3076	return false;
3077	}
3078	// TODO: check no INTENT(OUT) if dummy?
3079	context().Warn(common::LanguageFeature::ForwardRefImplicitNone, symbol.name(),
3080	"'%s' was used without (or before) being explicitly typed"_warn_en_US,
3081	symbol.name());
3082	symbol.set(Symbol::Flag::Implicit);
3083	symbol.SetType(*type);
3084	return true;
3085	}
3086
3087	// Ensure that the symbol for an intrinsic procedure is marked with
3088	// the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as
3089	// appropriate.
3090	void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
3091	SetImplicitAttr(symbol, Attr::INTRINSIC);
3092	switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {
3093	case evaluate::IntrinsicClass::elementalFunction:
3094	case evaluate::IntrinsicClass::elementalSubroutine:
3095	SetExplicitAttr(symbol, Attr::ELEMENTAL);
3096	SetExplicitAttr(symbol, Attr::PURE);
3097	break;
3098	case evaluate::IntrinsicClass::impureSubroutine:
3099	break;
3100	default:
3101	SetExplicitAttr(symbol, Attr::PURE);
3102	}
3103	}
3104
3105	const DeclTypeSpec *ScopeHandler::GetImplicitType(
3106	Symbol &symbol, bool respectImplicitNoneType) {
3107	const Scope *scope{&symbol.owner()};
3108	if (scope->IsGlobal()) {
3109	scope = &currScope();
3110	}
3111	scope = &GetInclusiveScope(scope: *scope);
3112	const auto *type{implicitRulesMap_->at(k: scope).GetType(
3113	symbol.name(), respectImplicitNoneType)};
3114	if (type) {
3115	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
3116	// Resolve any forward-referenced derived type; a quick no-op else.
3117	auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
3118	instantiatable.Instantiate(currScope());
3119	}
3120	}
3121	return type;
3122	}
3123
3124	void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) {
3125	if (!inSpecificationPart_ && symbol &&
3126	symbol->test(Symbol::Flag::EntryDummyArgument)) {
3127	Say(source,
3128	"Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US,
3129	symbol->name());
3130	symbol->set(Symbol::Flag::EntryDummyArgument, false);
3131	}
3132	}
3133
3134	// Convert symbol to be a ObjectEntity or return false if it can't be.
3135	bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
3136	if (symbol.has<ObjectEntityDetails>()) {
3137	// nothing to do
3138	} else if (symbol.has<UnknownDetails>()) {
3139	// These are attributes that a name could have picked up from
3140	// an attribute statement or type declaration statement.
3141	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
3142	return false;
3143	}
3144	symbol.set_details(ObjectEntityDetails{});
3145	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
3146	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
3147	return false;
3148	}
3149	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3150	symbol.set_details(ObjectEntityDetails{std::move(*details)});
3151	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
3152	return useDetails->symbol().has<ObjectEntityDetails>();
3153	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
3154	return hostDetails->symbol().has<ObjectEntityDetails>();
3155	} else {
3156	return false;
3157	}
3158	return true;
3159	}
3160	// Convert symbol to be a ProcEntity or return false if it can't be.
3161	bool ScopeHandler::ConvertToProcEntity(
3162	Symbol &symbol, std::optional<SourceName> usedHere) {
3163	if (symbol.has<ProcEntityDetails>()) {
3164	} else if (symbol.has<UnknownDetails>()) {
3165	symbol.set_details(ProcEntityDetails{});
3166	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
3167	if (IsFunctionResult(symbol) &&
3168	!(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
3169	// Don't turn function result into a procedure pointer unless both
3170	// POINTER and EXTERNAL
3171	return false;
3172	}
3173	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3174	symbol.set_details(ProcEntityDetails{std::move(*details)});
3175	if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
3176	CHECK(!symbol.test(Symbol::Flag::Subroutine));
3177	symbol.set(Symbol::Flag::Function);
3178	}
3179	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
3180	return useDetails->symbol().has<ProcEntityDetails>();
3181	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
3182	return hostDetails->symbol().has<ProcEntityDetails>();
3183	} else {
3184	return false;
3185	}
3186	auto &proc{symbol.get<ProcEntityDetails>()};
3187	if (usedHere && !proc.usedAsProcedureHere()) {
3188	proc.set_usedAsProcedureHere(*usedHere);
3189	}
3190	return true;
3191	}
3192
3193	const DeclTypeSpec &ScopeHandler::MakeNumericType(
3194	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
3195	KindExpr value{GetKindParamExpr(category, kind)};
3196	if (auto known{evaluate::ToInt64(value)}) {
3197	return MakeNumericType(category, static_cast<int>(*known));
3198	} else {
3199	return currScope_->MakeNumericType(category, std::move(value));
3200	}
3201	}
3202
3203	const DeclTypeSpec &ScopeHandler::MakeNumericType(
3204	TypeCategory category, int kind) {
3205	return context().MakeNumericType(category, kind);
3206	}
3207
3208	const DeclTypeSpec &ScopeHandler::MakeLogicalType(
3209	const std::optional<parser::KindSelector> &kind) {
3210	KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
3211	if (auto known{evaluate::ToInt64(value)}) {
3212	return MakeLogicalType(static_cast<int>(*known));
3213	} else {
3214	return currScope_->MakeLogicalType(std::move(value));
3215	}
3216	}
3217
3218	const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
3219	return context().MakeLogicalType(kind);
3220	}
3221
3222	void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
3223	if (inSpecificationPart_ && !deferImplicitTyping_ && name.symbol) {
3224	auto kind{currScope().kind()};
3225	if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
3226	kind == Scope::Kind::BlockConstruct) {
3227	bool isHostAssociated{&name.symbol->owner() == &currScope()
3228	? name.symbol->has<HostAssocDetails>()
3229	: name.symbol->owner().Contains(currScope())};
3230	if (isHostAssociated) {
3231	specPartState_.forwardRefs.insert(name.source);
3232	}
3233	}
3234	}
3235	}
3236
3237	std::optional<SourceName> ScopeHandler::HadForwardRef(
3238	const Symbol &symbol) const {
3239	auto iter{specPartState_.forwardRefs.find(symbol.name())};
3240	if (iter != specPartState_.forwardRefs.end()) {
3241	return *iter;
3242	}
3243	return std::nullopt;
3244	}
3245
3246	bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
3247	if (!context().HasError(symbol)) {
3248	if (auto fwdRef{HadForwardRef(symbol)}) {
3249	const Symbol *outer{symbol.owner().FindSymbol(symbol.name())};
3250	if (outer && symbol.has<UseDetails>() &&
3251	&symbol.GetUltimate() == &outer->GetUltimate()) {
3252	// e.g. IMPORT of host's USE association
3253	return false;
3254	}
3255	Say(*fwdRef,
3256	"Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
3257	*fwdRef)
3258	.Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
3259	context().SetError(symbol);
3260	return true;
3261	}
3262	if ((IsDummy(symbol) || FindCommonBlockContaining(symbol)) &&
3263	isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) &&
3264	!context().HasError(symbol)) {
3265	// Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in
3266	// ApplyImplicitRules() due to use in a specification expression,
3267	// and no explicit type declaration appeared later.
3268	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
3269	context().SetError(symbol);
3270	return true;
3271	}
3272	}
3273	return false;
3274	}
3275
3276	void ScopeHandler::MakeExternal(Symbol &symbol) {
3277	if (!symbol.attrs().test(Attr::EXTERNAL)) {
3278	SetImplicitAttr(symbol, Attr::EXTERNAL);
3279	if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
3280	Say(symbol.name(),
3281	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
3282	symbol.name());
3283	}
3284	}
3285	}
3286
3287	bool ScopeHandler::CheckDuplicatedAttr(
3288	SourceName name, Symbol &symbol, Attr attr) {
3289	if (attr == Attr::SAVE) {
3290	// checked elsewhere
3291	} else if (symbol.attrs().test(attr)) { // C815
3292	if (symbol.implicitAttrs().test(attr)) {
3293	// Implied attribute is now confirmed explicitly
3294	symbol.implicitAttrs().reset(attr);
3295	} else {
3296	Say(name, "%s attribute was already specified on '%s'"_err_en_US,
3297	EnumToString(attr), name);
3298	return false;
3299	}
3300	}
3301	return true;
3302	}
3303
3304	bool ScopeHandler::CheckDuplicatedAttrs(
3305	SourceName name, Symbol &symbol, Attrs attrs) {
3306	bool ok{true};
3307	attrs.IterateOverMembers(
3308	[&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });
3309	return ok;
3310	}
3311
3312	void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,
3313	std::optional<common::CUDADataAttr> attr) {
3314	if (attr) {
3315	ConvertToObjectEntity(symbol);
3316	if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
3317	if (*attr != object->cudaDataAttr().value_or(*attr)) {
3318	Say(source,
3319	"'%s' already has another CUDA data attribute ('%s')"_err_en_US,
3320	symbol.name(),
3321	std::string{common::EnumToString(*object->cudaDataAttr())}.c_str());
3322	} else {
3323	object->set_cudaDataAttr(attr);
3324	}
3325	} else {
3326	Say(source,
3327	"'%s' is not an object and may not have a CUDA data attribute"_err_en_US,
3328	symbol.name());
3329	}
3330	}
3331	}
3332
3333	// ModuleVisitor implementation
3334
3335	bool ModuleVisitor::Pre(const parser::Only &x) {
3336	common::visit(common::visitors{
3337	[&](const Indirection<parser::GenericSpec> &generic) {
3338	GenericSpecInfo genericSpecInfo{generic.value()};
3339	AddUseOnly(genericSpecInfo.symbolName());
3340	AddUse(genericSpecInfo);
3341	},
3342	[&](const parser::Name &name) {
3343	AddUseOnly(name.source);
3344	Resolve(name, AddUse(name.source, name.source).use);
3345	},
3346	[&](const parser::Rename &rename) { Walk(rename); },
3347	},
3348	x.u);
3349	return false;
3350	}
3351
3352	void ModuleVisitor::CollectUseRenames(const parser::UseStmt &useStmt) {
3353	auto doRename{[&](const parser::Rename &rename) {
3354	if (const auto *names{std::get_if<parser::Rename::Names>(&rename.u)}) {
3355	AddUseRename(name: std::get<1>(names->t).source, moduleName: useStmt.moduleName.source);
3356	}
3357	}};
3358	common::visit(
3359	common::visitors{
3360	[&](const std::list<parser::Rename> &renames) {
3361	for (const auto &rename : renames) {
3362	doRename(rename);
3363	}
3364	},
3365	[&](const std::list<parser::Only> &onlys) {
3366	for (const auto &only : onlys) {
3367	if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
3368	doRename(*rename);
3369	}
3370	}
3371	},
3372	},
3373	useStmt.u);
3374	}
3375
3376	bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
3377	const auto &localName{std::get<0>(x.t)};
3378	const auto &useName{std::get<1>(x.t)};
3379	SymbolRename rename{AddUse(localName.source, useName.source)};
3380	Resolve(useName, rename.use);
3381	Resolve(localName, rename.local);
3382	return false;
3383	}
3384	bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
3385	const parser::DefinedOpName &local{std::get<0>(x.t)};
3386	const parser::DefinedOpName &use{std::get<1>(x.t)};
3387	GenericSpecInfo localInfo{local};
3388	GenericSpecInfo useInfo{use};
3389	if (IsIntrinsicOperator(context(), local.v.source)) {
3390	Say(local.v,
3391	"Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
3392	} else if (IsLogicalConstant(context(), local.v.source)) {
3393	Say(local.v,
3394	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
3395	} else {
3396	SymbolRename rename{AddUse(localName: localInfo.symbolName(), useName: useInfo.symbolName())};
3397	useInfo.Resolve(rename.use);
3398	localInfo.Resolve(rename.local);
3399	}
3400	return false;
3401	}
3402
3403	// Set useModuleScope_ to the Scope of the module being used.
3404	bool ModuleVisitor::Pre(const parser::UseStmt &x) {
3405	std::optional<bool> isIntrinsic;
3406	if (x.nature) {
3407	isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic;
3408	} else if (currScope().IsModule() && currScope().symbol() &&
3409	currScope().symbol()->attrs().test(Attr::INTRINSIC)) {
3410	// Intrinsic modules USE only other intrinsic modules
3411	isIntrinsic = true;
3412	}
3413	useModuleScope_ = FindModule(x.moduleName, isIntrinsic);
3414	if (!useModuleScope_) {
3415	return false;
3416	}
3417	AddAndCheckModuleUse(x.moduleName.source,
3418	useModuleScope_->parent().kind() == Scope::Kind::IntrinsicModules);
3419	// use the name from this source file
3420	useModuleScope_->symbol()->ReplaceName(x.moduleName.source);
3421	return true;
3422	}
3423
3424	void ModuleVisitor::Post(const parser::UseStmt &x) {
3425	if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
3426	// Not a use-only: collect the names that were used in renames,
3427	// then add a use for each public name that was not renamed.
3428	std::set<SourceName> useNames;
3429	for (const auto &rename : *list) {
3430	common::visit(common::visitors{
3431	[&](const parser::Rename::Names &names) {
3432	useNames.insert(std::get<1>(names.t).source);
3433	},
3434	[&](const parser::Rename::Operators &ops) {
3435	useNames.insert(std::get<1>(ops.t).v.source);
3436	},
3437	},
3438	rename.u);
3439	}
3440	for (const auto &[name, symbol] : *useModuleScope_) {
3441	if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&
3442	(!symbol->implicitAttrs().test(Attr::INTRINSIC) ||
3443	symbol->has<UseDetails>()) &&
3444	!symbol->has<MiscDetails>() && useNames.count(name) == 0) {
3445	SourceName location{x.moduleName.source};
3446	if (auto *localSymbol{FindInScope(name)}) {
3447	DoAddUse(location, localSymbol->name(), *localSymbol, *symbol);
3448	} else {
3449	DoAddUse(location, location, CopySymbol(name, *symbol), *symbol);
3450	}
3451	}
3452	}
3453	}
3454	useModuleScope_ = nullptr;
3455	}
3456
3457	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
3458	const SourceName &localName, const SourceName &useName) {
3459	return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));
3460	}
3461
3462	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
3463	const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {
3464	if (!useModuleScope_) {
3465	return {}; // error occurred finding module
3466	}
3467	if (!useSymbol) {
3468	Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName),
3469	useModuleScope_->GetName().value());
3470	return {};
3471	}
3472	if (useSymbol->attrs().test(Attr::PRIVATE) &&
3473	!FindModuleFileContaining(currScope())) {
3474	// Privacy is not enforced in module files so that generic interfaces
3475	// can be resolved to private specific procedures in specification
3476	// expressions.
3477	// Local names that contain currency symbols ('$') are created by the
3478	// module file writer when a private name in another module is needed to
3479	// process a local declaration. These can show up in the output of
3480	// -fdebug-unparse-with-modules, too, so go easy on them.
3481	if (currScope().IsModule() &&
3482	localName.ToString().find("$") != std::string::npos) {
3483	Say(useName, "'%s' is PRIVATE in '%s'"_warn_en_US, MakeOpName(useName),
3484	useModuleScope_->GetName().value());
3485	} else {
3486	Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),
3487	useModuleScope_->GetName().value());
3488	return {};
3489	}
3490	}
3491	auto &localSymbol{MakeSymbol(localName)};
3492	DoAddUse(useName, localName, localSymbol&: localSymbol, useSymbol: *useSymbol);
3493	return {&localSymbol, useSymbol};
3494	}
3495
3496	// symbol must be either a Use or a Generic formed by merging two uses.
3497	// Convert it to a UseError with this additional location.
3498	bool ScopeHandler::ConvertToUseError(
3499	Symbol &symbol, const SourceName &location, const Symbol &used) {
3500	if (auto *ued{symbol.detailsIf<UseErrorDetails>()}) {
3501	ued->add_occurrence(location, used);
3502	return true;
3503	}
3504	const auto *useDetails{symbol.detailsIf<UseDetails>()};
3505	if (!useDetails) {
3506	if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {
3507	if (!genericDetails->uses().empty()) {
3508	useDetails = &genericDetails->uses().at(0)->get<UseDetails>();
3509	}
3510	}
3511	}
3512	if (useDetails) {
3513	symbol.set_details(
3514	UseErrorDetails{*useDetails}.add_occurrence(location, used));
3515	return true;
3516	}
3517	if (const auto *hostAssocDetails{symbol.detailsIf<HostAssocDetails>()};
3518	hostAssocDetails && hostAssocDetails->symbol().has<SubprogramDetails>() &&
3519	&symbol.owner() == &currScope() &&
3520	&hostAssocDetails->symbol() == currScope().symbol()) {
3521	// Handle USE-association of procedure FOO into function/subroutine FOO,
3522	// replacing its place-holding HostAssocDetails symbol.
3523	context().Warn(common::UsageWarning::UseAssociationIntoSameNameSubprogram,
3524	location,
3525	"'%s' is use-associated into a subprogram of the same name"_port_en_US,
3526	used.name());
3527	SourceName created{context().GetTempName(currScope())};
3528	Symbol &tmpUse{MakeSymbol(created, Attrs(), UseDetails{location, used})};
3529	UseErrorDetails useError{tmpUse.get<UseDetails>()};
3530	useError.add_occurrence(location, hostAssocDetails->symbol());
3531	symbol.set_details(std::move(useError));
3532	return true;
3533	}
3534	return false;
3535	}
3536
3537	// Two ultimate symbols are distinct, but they have the same name and come
3538	// from modules with the same name. At link time, their mangled names
3539	// would conflict, so they had better resolve to the same definition.
3540	// Check whether the two ultimate symbols have compatible definitions.
3541	// Returns true if no further processing is required in DoAddUse().
3542	static bool CheckCompatibleDistinctUltimates(SemanticsContext &context,
3543	SourceName location, SourceName localName, const Symbol &localSymbol,
3544	const Symbol &localUltimate, const Symbol &useUltimate, bool &isError) {
3545	isError = false;
3546	if (localUltimate.has<GenericDetails>()) {
3547	if (useUltimate.has<GenericDetails>() ||
3548	useUltimate.has<SubprogramDetails>() ||
3549	useUltimate.has<DerivedTypeDetails>()) {
3550	return false; // can try to merge them
3551	} else {
3552	isError = true;
3553	}
3554	} else if (useUltimate.has<GenericDetails>()) {
3555	if (localUltimate.has<SubprogramDetails>() ||
3556	localUltimate.has<DerivedTypeDetails>()) {
3557	return false; // can try to merge them
3558	} else {
3559	isError = true;
3560	}
3561	} else if (localUltimate.has<SubprogramDetails>()) {
3562	if (useUltimate.has<SubprogramDetails>()) {
3563	auto localCharacteristics{
3564	evaluate::characteristics::Procedure::Characterize(
3565	localUltimate, context.foldingContext())};
3566	auto useCharacteristics{
3567	evaluate::characteristics::Procedure::Characterize(
3568	useUltimate, context.foldingContext())};
3569	if ((localCharacteristics &&
3570	(!useCharacteristics ||
3571	*localCharacteristics != *useCharacteristics)) ||
3572	(!localCharacteristics && useCharacteristics)) {
3573	isError = true;
3574	}
3575	} else {
3576	isError = true;
3577	}
3578	} else if (useUltimate.has<SubprogramDetails>()) {
3579	isError = true;
3580	} else if (const auto *localObject{
3581	localUltimate.detailsIf<ObjectEntityDetails>()}) {
3582	if (const auto *useObject{useUltimate.detailsIf<ObjectEntityDetails>()}) {
3583	auto localType{evaluate::DynamicType::From(localUltimate)};
3584	auto useType{evaluate::DynamicType::From(useUltimate)};
3585	if (localUltimate.size() != useUltimate.size() ||
3586	(localType &&
3587	(!useType || !localType->IsTkLenCompatibleWith(*useType) ||
3588	!useType->IsTkLenCompatibleWith(*localType))) ||
3589	(!localType && useType)) {
3590	isError = true;
3591	} else if (IsNamedConstant(localUltimate)) {
3592	isError = !IsNamedConstant(useUltimate) ||
3593	!(*localObject->init() == *useObject->init());
3594	} else {
3595	isError = IsNamedConstant(useUltimate);
3596	}
3597	} else {
3598	isError = true;
3599	}
3600	} else if (useUltimate.has<ObjectEntityDetails>()) {
3601	isError = true;
3602	} else if (IsProcedurePointer(localUltimate)) {
3603	isError = !IsProcedurePointer(useUltimate);
3604	} else if (IsProcedurePointer(useUltimate)) {
3605	isError = true;
3606	} else if (localUltimate.has<DerivedTypeDetails>()) {
3607	isError = !(useUltimate.has<DerivedTypeDetails>() &&
3608	evaluate::AreSameDerivedTypeIgnoringSequence(
3609	DerivedTypeSpec{localUltimate.name(), localUltimate},
3610	DerivedTypeSpec{useUltimate.name(), useUltimate}));
3611	} else if (useUltimate.has<DerivedTypeDetails>()) {
3612	isError = true;
3613	} else if (localUltimate.has<NamelistDetails>() &&
3614	useUltimate.has<NamelistDetails>()) {
3615	} else if (localUltimate.has<CommonBlockDetails>() &&
3616	useUltimate.has<CommonBlockDetails>()) {
3617	} else {
3618	isError = true;
3619	}
3620	return true; // don't try to merge generics (or whatever)
3621	}
3622
3623	void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
3624	Symbol &originalLocal, const Symbol &useSymbol) {
3625	Symbol *localSymbol{&originalLocal};
3626	if (auto *details{localSymbol->detailsIf<UseErrorDetails>()}) {
3627	details->add_occurrence(location, useSymbol);
3628	return;
3629	}
3630	const Symbol &useUltimate{useSymbol.GetUltimate()};
3631	const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
3632	if (localSymbol->has<UnknownDetails>()) {
3633	if (useGeneric &&
3634	((useGeneric->specific() &&
3635	IsProcedurePointer(*useGeneric->specific())) ||
3636	(useGeneric->derivedType() &&
3637	useUltimate.name() != localSymbol->name()))) {
3638	// We are use-associating a generic that either shadows a procedure
3639	// pointer or shadows a derived type with a distinct name.
3640	// Local references that might be made to the procedure pointer should
3641	// use a UseDetails symbol for proper data addressing, and a derived
3642	// type needs to be in scope with its local name. So create an
3643	// empty local generic now into which the use-associated generic may
3644	// be copied.
3645	localSymbol->set_details(GenericDetails{});
3646	localSymbol->get<GenericDetails>().set_kind(useGeneric->kind());
3647	} else { // just create UseDetails
3648	localSymbol->set_details(UseDetails{localName, useSymbol});
3649	localSymbol->attrs() =
3650	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};
3651	localSymbol->implicitAttrs() =
3652	localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
3653	localSymbol->flags() = useSymbol.flags();
3654	return;
3655	}
3656	}
3657
3658	Symbol &localUltimate{localSymbol->GetUltimate()};
3659	if (&localUltimate == &useUltimate) {
3660	// use-associating the same symbol again -- ok
3661	return;
3662	}
3663	if (useUltimate.owner().IsModule() && localUltimate.owner().IsSubmodule() &&
3664	DoesScopeContain(&useUltimate.owner(), localUltimate)) {
3665	// Within a submodule, USE'ing a symbol that comes indirectly
3666	// from the ancestor module, e.g. foo in:
3667	// MODULE m1; INTERFACE; MODULE SUBROUTINE foo; END INTERFACE; END
3668	// MODULE m2; USE m1; END
3669	// SUBMODULE m1(sm); USE m2; CONTAINS; MODULE PROCEDURE foo; END; END
3670	return; // ok, ignore it
3671	}
3672
3673	if (localUltimate.name() == useUltimate.name() &&
3674	localUltimate.owner().IsModule() && useUltimate.owner().IsModule() &&
3675	localUltimate.owner().GetName() &&
3676	localUltimate.owner().GetName() == useUltimate.owner().GetName()) {
3677	bool isError{false};
3678	if (CheckCompatibleDistinctUltimates(context(), location, localName,
3679	*localSymbol, localUltimate, useUltimate, isError)) {
3680	if (isError) {
3681	// Convert the local symbol to a UseErrorDetails, if possible;
3682	// otherwise emit a fatal error.
3683	if (!ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol)) {
3684	context()
3685	.Say(location,
3686	"'%s' use-associated from '%s' in module '%s' is incompatible with '%s' from another module"_err_en_US,
3687	localName, useUltimate.name(),
3688	useUltimate.owner().GetName().value(), localUltimate.name())
3689	.Attach(useUltimate.name(), "First declaration"_en_US)
3690	.Attach(localUltimate.name(), "Other declaration"_en_US);
3691	return;
3692	}
3693	}
3694	if (auto *msg{context().Warn(
3695	common::UsageWarning::CompatibleDeclarationsFromDistinctModules,
3696	location,
3697	"'%s' is use-associated from '%s' in two distinct instances of module '%s'"_warn_en_US,
3698	localName, localUltimate.name(),
3699	localUltimate.owner().GetName().value())}) {
3700	msg->Attach(localUltimate.name(), "Previous declaration"_en_US)
3701	.Attach(useUltimate.name(), "Later declaration"_en_US);
3702	}
3703	return;
3704	}
3705	}
3706
3707	// There are many possible combinations of symbol types that could arrive
3708	// with the same (local) name vie USE association from distinct modules.
3709	// Fortran allows a generic interface to share its name with a derived type,
3710	// or with the name of a non-generic procedure (which should be one of the
3711	// generic's specific procedures). Implementing all these possibilities is
3712	// complicated.
3713	// Error cases are converted into UseErrorDetails symbols to trigger error
3714	// messages when/if bad combinations are actually used later in the program.
3715	// The error cases are:
3716	// - two distinct derived types
3717	// - two distinct non-generic procedures
3718	// - a generic and a non-generic that is not already one of its specifics
3719	// - anything other than a derived type, non-generic procedure, or
3720	// generic procedure being combined with something other than an
3721	// prior USE association of itself
3722	auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
3723	Symbol *localDerivedType{nullptr};
3724	if (localUltimate.has<DerivedTypeDetails>()) {
3725	localDerivedType = &localUltimate;
3726	} else if (localGeneric) {
3727	if (auto *dt{localGeneric->derivedType()};
3728	dt && !dt->attrs().test(Attr::PRIVATE)) {
3729	localDerivedType = dt;
3730	}
3731	}
3732	const Symbol *useDerivedType{nullptr};
3733	if (useUltimate.has<DerivedTypeDetails>()) {
3734	useDerivedType = &useUltimate;
3735	} else if (useGeneric) {
3736	if (const auto *dt{useGeneric->derivedType()};
3737	dt && !dt->attrs().test(Attr::PRIVATE)) {
3738	useDerivedType = dt;
3739	}
3740	}
3741
3742	Symbol *localProcedure{nullptr};
3743	if (localGeneric) {
3744	if (localGeneric->specific() &&
3745	!localGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3746	localProcedure = localGeneric->specific();
3747	}
3748	} else if (IsProcedure(localUltimate)) {
3749	localProcedure = &localUltimate;
3750	}
3751	const Symbol *useProcedure{nullptr};
3752	if (useGeneric) {
3753	if (useGeneric->specific() &&
3754	!useGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3755	useProcedure = useGeneric->specific();
3756	}
3757	} else if (IsProcedure(useUltimate)) {
3758	useProcedure = &useUltimate;
3759	}
3760
3761	// Creates a UseErrorDetails symbol in the current scope for a
3762	// current UseDetails symbol, but leaves the UseDetails in the
3763	// scope's name map.
3764	auto CreateLocalUseError{[&]() {
3765	EraseSymbol(*localSymbol);
3766	CHECK(localSymbol->has<UseDetails>());
3767	UseErrorDetails details{localSymbol->get<UseDetails>()};
3768	details.add_occurrence(location, useSymbol);
3769	Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))};
3770	// Restore *localSymbol in currScope
3771	auto iter{currScope().find(localName)};
3772	CHECK(iter != currScope().end() && &*iter->second == newSymbol);
3773	iter->second = MutableSymbolRef{*localSymbol};
3774	return newSymbol;
3775	}};
3776
3777	// When two derived types arrived, try to combine them.
3778	const Symbol *combinedDerivedType{nullptr};
3779	if (!useDerivedType) {
3780	combinedDerivedType = localDerivedType;
3781	} else if (!localDerivedType) {
3782	if (useDerivedType->name() == localName) {
3783	combinedDerivedType = useDerivedType;
3784	} else {
3785	combinedDerivedType =
3786	&currScope().MakeSymbol(localSymbol->name(), useDerivedType->attrs(),
3787	UseDetails{localSymbol->name(), *useDerivedType});
3788	}
3789	} else if (&localDerivedType->GetUltimate() ==
3790	&useDerivedType->GetUltimate()) {
3791	combinedDerivedType = localDerivedType;
3792	} else {
3793	const Scope *localScope{localDerivedType->GetUltimate().scope()};
3794	const Scope *useScope{useDerivedType->GetUltimate().scope()};
3795	if (localScope && useScope && localScope->derivedTypeSpec() &&
3796	useScope->derivedTypeSpec() &&
3797	evaluate::AreSameDerivedType(
3798	*localScope->derivedTypeSpec(), *useScope->derivedTypeSpec())) {
3799	combinedDerivedType = localDerivedType;
3800	} else {
3801	// Create a local UseErrorDetails for the ambiguous derived type
3802	if (localGeneric) {
3803	combinedDerivedType = CreateLocalUseError();
3804	} else {
3805	ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol);
3806	localDerivedType = nullptr;
3807	localGeneric = nullptr;
3808	combinedDerivedType = localSymbol;
3809	}
3810	}
3811	if (!localGeneric && !useGeneric) {
3812	return; // both symbols are derived types; done
3813	}
3814	}
3815
3816	auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) {
3817	if (&p1 == &p2) {
3818	return true;
3819	} else if (p1.name() != p2.name()) {
3820	return false;
3821	} else if (p1.attrs().test(Attr::INTRINSIC) ||
3822	p2.attrs().test(Attr::INTRINSIC)) {
3823	return p1.attrs().test(Attr::INTRINSIC) &&
3824	p2.attrs().test(Attr::INTRINSIC);
3825	} else if (!IsProcedure(p1) || !IsProcedure(p2)) {
3826	return false;
3827	} else if (IsPointer(p1) || IsPointer(p2)) {
3828	return false;
3829	} else if (const auto *subp{p1.detailsIf<SubprogramDetails>()};
3830	subp && !subp->isInterface()) {
3831	return false; // defined in module, not an external
3832	} else if (const auto *subp{p2.detailsIf<SubprogramDetails>()};
3833	subp && !subp->isInterface()) {
3834	return false; // defined in module, not an external
3835	} else {
3836	// Both are external interfaces, perhaps to the same procedure
3837	auto class1{ClassifyProcedure(p1)};
3838	auto class2{ClassifyProcedure(p2)};
3839	if (class1 == ProcedureDefinitionClass::External &&
3840	class2 == ProcedureDefinitionClass::External) {
3841	auto chars1{evaluate::characteristics::Procedure::Characterize(
3842	p1, GetFoldingContext())};
3843	auto chars2{evaluate::characteristics::Procedure::Characterize(
3844	p2, GetFoldingContext())};
3845	// same procedure interface defined identically in two modules?
3846	return chars1 && chars2 && *chars1 == *chars2;
3847	} else {
3848	return false;
3849	}
3850	}
3851	}};
3852
3853	// When two non-generic procedures arrived, try to combine them.
3854	const Symbol *combinedProcedure{nullptr};
3855	if (!localProcedure) {
3856	combinedProcedure = useProcedure;
3857	} else if (!useProcedure) {
3858	combinedProcedure = localProcedure;
3859	} else {
3860	if (AreSameProcedure(
3861	localProcedure->GetUltimate(), useProcedure->GetUltimate())) {
3862	if (!localGeneric && !useGeneric) {
3863	return; // both symbols are non-generic procedures
3864	}
3865	combinedProcedure = localProcedure;
3866	}
3867	}
3868
3869	// Prepare to merge generics
3870	bool cantCombine{false};
3871	if (localGeneric) {
3872	if (useGeneric || useDerivedType) {
3873	} else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
3874	return; // nothing to do; used subprogram is local's specific
3875	} else if (useUltimate.attrs().test(Attr::INTRINSIC) &&
3876	useUltimate.name() == localSymbol->name()) {
3877	return; // local generic can extend intrinsic
3878	} else {
3879	for (const auto &ref : localGeneric->specificProcs()) {
3880	if (&ref->GetUltimate() == &useUltimate) {
3881	return; // used non-generic is already a specific of local generic
3882	}
3883	}
3884	cantCombine = true;
3885	}
3886	} else if (useGeneric) {
3887	if (localDerivedType) {
3888	} else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate() ||
3889	(localSymbol->attrs().test(Attr::INTRINSIC) &&
3890	localUltimate.name() == useUltimate.name())) {
3891	// Local is the specific of the used generic or an intrinsic with the
3892	// same name; replace it.
3893	EraseSymbol(*localSymbol);
3894	Symbol &newSymbol{MakeSymbol(localName,
3895	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
3896	UseDetails{localName, useUltimate})};
3897	newSymbol.flags() = useSymbol.flags();
3898	return;
3899	} else {
3900	for (const auto &ref : useGeneric->specificProcs()) {
3901	if (&ref->GetUltimate() == &localUltimate) {
3902	return; // local non-generic is already a specific of used generic
3903	}
3904	}
3905	cantCombine = true;
3906	}
3907	} else {
3908	cantCombine = true;
3909	}
3910
3911	// If symbols are not combinable, create a use error.
3912	if (cantCombine) {
3913	if (!ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol)) {
3914	Say(location,
3915	"Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
3916	localName)
3917	.Attach(localSymbol->name(), "Previous declaration of '%s'"_en_US,
3918	localName);
3919	}
3920	return;
3921	}
3922
3923	// At this point, there must be at least one generic interface.
3924	CHECK(localGeneric || (useGeneric && (localDerivedType || localProcedure)));
3925
3926	// Ensure that a use-associated specific procedure that is a procedure
3927	// pointer is properly represented as a USE association of an entity.
3928	if (IsProcedurePointer(useProcedure)) {
3929	Symbol &combined{currScope().MakeSymbol(localSymbol->name(),
3930	useProcedure->attrs(), UseDetails{localName, *useProcedure})};
3931	combined.flags() |= useProcedure->flags();
3932	combinedProcedure = &combined;
3933	}
3934
3935	if (localGeneric) {
3936	// Create a local copy of a previously use-associated generic so that
3937	// it can be locally extended without corrupting the original.
3938	if (localSymbol->has<UseDetails>()) {
3939	GenericDetails generic;
3940	generic.CopyFrom(DEREF(localGeneric));
3941	EraseSymbol(*localSymbol);
3942	Symbol &newSymbol{MakeSymbol(
3943	localSymbol->name(), localSymbol->attrs(), std::move(generic))};
3944	newSymbol.flags() = localSymbol->flags();
3945	localGeneric = &newSymbol.get<GenericDetails>();
3946	localGeneric->AddUse(*localSymbol);
3947	localSymbol = &newSymbol;
3948	}
3949	if (useGeneric) {
3950	// Combine two use-associated generics
3951	localSymbol->attrs() =
3952	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
3953	localSymbol->flags() = useSymbol.flags();
3954	AddGenericUse(*localGeneric, localName, useUltimate);
3955	localGeneric->clear_derivedType();
3956	localGeneric->CopyFrom(*useGeneric);
3957	}
3958	localGeneric->clear_derivedType();
3959	if (combinedDerivedType) {
3960	localGeneric->set_derivedType(*const_cast<Symbol *>(combinedDerivedType));
3961	}
3962	localGeneric->clear_specific();
3963	if (combinedProcedure) {
3964	localGeneric->set_specific(*const_cast<Symbol *>(combinedProcedure));
3965	}
3966	} else {
3967	CHECK(localSymbol->has<UseDetails>());
3968	// Create a local copy of the use-associated generic, then extend it
3969	// with the combined derived type &/or non-generic procedure.
3970	GenericDetails generic;
3971	generic.CopyFrom(*useGeneric);
3972	EraseSymbol(*localSymbol);
3973	Symbol &newSymbol{MakeSymbol(localName,
3974	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
3975	std::move(generic))};
3976	newSymbol.flags() = useUltimate.flags();
3977	auto &newUseGeneric{newSymbol.get<GenericDetails>()};
3978	AddGenericUse(newUseGeneric, localName, useUltimate);
3979	newUseGeneric.AddUse(*localSymbol);
3980	if (combinedDerivedType) {
3981	if (const auto *oldDT{newUseGeneric.derivedType()}) {
3982	CHECK(&oldDT->GetUltimate() == &combinedDerivedType->GetUltimate());
3983	} else {
3984	newUseGeneric.set_derivedType(
3985	*const_cast<Symbol *>(combinedDerivedType));
3986	}
3987	}
3988	if (combinedProcedure) {
3989	newUseGeneric.set_specific(*const_cast<Symbol *>(combinedProcedure));
3990	}
3991	}
3992	}
3993
3994	void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
3995	if (useModuleScope_) {
3996	const auto &name{info.symbolName()};
3997	auto rename{AddUse(localName: name, useName: name, useSymbol: FindInScope(*useModuleScope_, name))};
3998	info.Resolve(rename.use);
3999	}
4000	}
4001
4002	// Create a UseDetails symbol for this USE and add it to generic
4003	Symbol &ModuleVisitor::AddGenericUse(
4004	GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {
4005	Symbol &newSymbol{
4006	currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})};
4007	generic.AddUse(newSymbol);
4008	return newSymbol;
4009	}
4010
4011	// Enforce F'2023 C1406 as a warning
4012	void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) {
4013	if (isIntrinsic) {
4014	if (auto iter{nonIntrinsicUses_.find(name)};
4015	iter != nonIntrinsicUses_.end()) {
4016	if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
4017	name,
4018	"Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,
4019	name)}) {
4020	msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
4021	}
4022	}
4023	intrinsicUses_.insert(name);
4024	} else {
4025	if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) {
4026	if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
4027	name,
4028	"Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,
4029	name)}) {
4030	msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
4031	}
4032	}
4033	nonIntrinsicUses_.insert(name);
4034	}
4035	}
4036
4037	bool ModuleVisitor::BeginSubmodule(
4038	const parser::Name &name, const parser::ParentIdentifier &parentId) {
4039	const auto &ancestorName{std::get<parser::Name>(parentId.t)};
4040	Scope *parentScope{nullptr};
4041	Scope *ancestor{FindModule(ancestorName, isIntrinsic: false /*not intrinsic*/)};
4042	if (ancestor) {
4043	if (const auto &parentName{
4044	std::get<std::optional<parser::Name>>(parentId.t)}) {
4045	parentScope = FindModule(*parentName, isIntrinsic: false /*not intrinsic*/, ancestor);
4046	} else {
4047	parentScope = ancestor;
4048	}
4049	}
4050	if (parentScope) {
4051	PushScope(*parentScope);
4052	} else {
4053	// Error recovery: there's no ancestor scope, so create a dummy one to
4054	// hold the submodule's scope.
4055	SourceName dummyName{context().GetTempName(currScope())};
4056	Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})};
4057	PushScope(Scope::Kind::Module, &dummySymbol);
4058	parentScope = &currScope();
4059	}
4060	BeginModule(name, isSubmodule: true);
4061	set_inheritFromParent(false); // submodules don't inherit parents' implicits
4062	if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) {
4063	Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
4064	ancestorName.source, name.source);
4065	}
4066	return true;
4067	}
4068
4069	void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
4070	// Submodule symbols are not visible in their parents' scopes.
4071	Symbol &symbol{isSubmodule ? Resolve(name,
4072	currScope().MakeSymbol(name.source, Attrs{},
4073	ModuleDetails{true}))
4074	: MakeSymbol(name, ModuleDetails{false})};
4075	auto &details{symbol.get<ModuleDetails>()};
4076	PushScope(Scope::Kind::Module, &symbol);
4077	details.set_scope(&currScope());
4078	prevAccessStmt_ = std::nullopt;
4079	}
4080
4081	// Find a module or submodule by name and return its scope.
4082	// If ancestor is present, look for a submodule of that ancestor module.
4083	// May have to read a .mod file to find it.
4084	// If an error occurs, report it and return nullptr.
4085	Scope *ModuleVisitor::FindModule(const parser::Name &name,
4086	std::optional<bool> isIntrinsic, Scope *ancestor) {
4087	ModFileReader reader{context()};
4088	Scope *scope{
4089	reader.Read(name.source, isIntrinsic, ancestor, /*silent=*/false)};
4090	if (scope) {
4091	if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
4092	std::optional<SourceName> submoduleName;
4093	if (const Scope * container{FindModuleOrSubmoduleContaining(currScope())};
4094	container && container->IsSubmodule()) {
4095	submoduleName = container->GetName();
4096	}
4097	if (submoduleName) {
4098	Say(name.source,
4099	"Module '%s' cannot USE itself from its own submodule '%s'"_err_en_US,
4100	name.source, *submoduleName);
4101	} else {
4102	Say(name, "Module '%s' cannot USE itself"_err_en_US);
4103	}
4104	}
4105	Resolve(name, scope->symbol());
4106	}
4107	return scope;
4108	}
4109
4110	void ModuleVisitor::ApplyDefaultAccess() {
4111	const auto *moduleDetails{
4112	DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
4113	CHECK(moduleDetails);
4114	Attr defaultAttr{
4115	DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE : Attr::PUBLIC};
4116	for (auto &pair : currScope()) {
4117	Symbol &symbol{*pair.second};
4118	if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
4119	Attr attr{defaultAttr};
4120	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
4121	if (generic->derivedType()) {
4122	// If a generic interface has a derived type of the same
4123	// name that has an explicit accessibility attribute, then
4124	// the generic must have the same accessibility.
4125	if (generic->derivedType()->attrs().test(Attr::PUBLIC)) {
4126	attr = Attr::PUBLIC;
4127	} else if (generic->derivedType()->attrs().test(Attr::PRIVATE)) {
4128	attr = Attr::PRIVATE;
4129	}
4130	}
4131	}
4132	SetImplicitAttr(symbol, attr);
4133	}
4134	}
4135	}
4136
4137	// InterfaceVistor implementation
4138
4139	bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
4140	bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
4141	genericInfo_.emplace(/*isInterface*/ args: true, args&: isAbstract);
4142	return BeginAttrs();
4143	}
4144
4145	void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
4146
4147	void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
4148	ResolveNewSpecifics();
4149	genericInfo_.pop();
4150	}
4151
4152	// Create a symbol in genericSymbol_ for this GenericSpec.
4153	bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
4154	if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) {
4155	SetGenericSymbol(*symbol);
4156	}
4157	return false;
4158	}
4159
4160	bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
4161	if (!isGeneric()) {
4162	Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
4163	} else {
4164	auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
4165	const auto &names{std::get<std::list<parser::Name>>(x.t)};
4166	AddSpecificProcs(names, kind);
4167	}
4168	return false;
4169	}
4170
4171	bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
4172	genericInfo_.emplace(/*isInterface*/ args: false);
4173	return BeginAttrs();
4174	}
4175	void InterfaceVisitor::Post(const parser::GenericStmt &x) {
4176	auto attrs{EndAttrs()};
4177	if (Symbol * symbol{GetGenericInfo().symbol}) {
4178	SetExplicitAttrs(*symbol, attrs);
4179	}
4180	const auto &names{std::get<std::list<parser::Name>>(x.t)};
4181	AddSpecificProcs(names, ProcedureKind::Procedure);
4182	ResolveNewSpecifics();
4183	genericInfo_.pop();
4184	}
4185
4186	bool InterfaceVisitor::inInterfaceBlock() const {
4187	return !genericInfo_.empty() && GetGenericInfo().isInterface;
4188	}
4189	bool InterfaceVisitor::isGeneric() const {
4190	return !genericInfo_.empty() && GetGenericInfo().symbol;
4191	}
4192	bool InterfaceVisitor::isAbstract() const {
4193	return !genericInfo_.empty() && GetGenericInfo().isAbstract;
4194	}
4195
4196	void InterfaceVisitor::AddSpecificProcs(
4197	const std::list<parser::Name> &names, ProcedureKind kind) {
4198	if (Symbol * symbol{GetGenericInfo().symbol};
4199	symbol && symbol->has<GenericDetails>()) {
4200	for (const auto &name : names) {
4201	specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));
4202	genericsForSpecificProcs_.emplace(name.source, symbol);
4203	}
4204	}
4205	}
4206
4207	// By now we should have seen all specific procedures referenced by name in
4208	// this generic interface. Resolve those names to symbols.
4209	void GenericHandler::ResolveSpecificsInGeneric(
4210	Symbol &generic, bool isEndOfSpecificationPart) {
4211	auto &details{generic.get<GenericDetails>()};
4212	UnorderedSymbolSet symbolsSeen;
4213	for (const Symbol &symbol : details.specificProcs()) {
4214	symbolsSeen.insert(symbol.GetUltimate());
4215	}
4216	auto range{specificsForGenericProcs_.equal_range(&generic)};
4217	SpecificProcMapType retain;
4218	for (auto it{range.first}; it != range.second; ++it) {
4219	const parser::Name *name{it->second.first};
4220	auto kind{it->second.second};
4221	const Symbol *symbol{isEndOfSpecificationPart
4222	? FindSymbol(*name)
4223	: FindInScope(generic.owner(), *name)};
4224	ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None};
4225	const Symbol *specific{symbol};
4226	const Symbol *ultimate{nullptr};
4227	if (symbol) {
4228	// Subtlety: when *symbol is a use- or host-association, the specific
4229	// procedure that is recorded in the GenericDetails below must be *symbol,
4230	// not the specific procedure shadowed by a generic, because that specific
4231	// procedure may be a symbol from another module and its name unavailable
4232	// to emit to a module file.
4233	const Symbol &bypassed{BypassGeneric(*symbol)};
4234	if (symbol == &symbol->GetUltimate()) {
4235	specific = &bypassed;
4236	}
4237	ultimate = &bypassed.GetUltimate();
4238	defClass = ClassifyProcedure(*ultimate);
4239	}
4240	std::optional<MessageFixedText> error;
4241	if (defClass == ProcedureDefinitionClass::Module) {
4242	// ok
4243	} else if (kind == ProcedureKind::ModuleProcedure) {
4244	error = "'%s' is not a module procedure"_err_en_US;
4245	} else {
4246	switch (defClass) {
4247	case ProcedureDefinitionClass::Intrinsic:
4248	case ProcedureDefinitionClass::External:
4249	case ProcedureDefinitionClass::Internal:
4250	case ProcedureDefinitionClass::Dummy:
4251	case ProcedureDefinitionClass::Pointer:
4252	break;
4253	case ProcedureDefinitionClass::None:
4254	error = "'%s' is not a procedure"_err_en_US;
4255	break;
4256	default:
4257	error =
4258	"'%s' is not a procedure that can appear in a generic interface"_err_en_US;
4259	break;
4260	}
4261	}
4262	if (error) {
4263	if (isEndOfSpecificationPart) {
4264	Say(*name, std::move(*error));
4265	} else {
4266	// possible forward reference, catch it later
4267	retain.emplace(&generic, std::make_pair(name, kind));
4268	}
4269	} else if (!ultimate) {
4270	} else if (symbolsSeen.insert(*ultimate).second /*true if added*/) {
4271	// When a specific procedure is a USE association, that association
4272	// is saved in the generic's specifics, not its ultimate symbol,
4273	// so that module file output of interfaces can distinguish them.
4274	details.AddSpecificProc(*specific, name->source);
4275	} else if (specific == ultimate) {
4276	Say(name->source,
4277	"Procedure '%s' is already specified in generic '%s'"_err_en_US,
4278	name->source, MakeOpName(generic.name()));
4279	} else {
4280	Say(name->source,
4281	"Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
4282	ultimate->name(), ultimate->owner().GetName().value(),
4283	MakeOpName(generic.name()));
4284	}
4285	}
4286	specificsForGenericProcs_.erase(range.first, range.second);
4287	specificsForGenericProcs_.merge(std::move(retain));
4288	}
4289
4290	void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {
4291	auto range{genericsForSpecificProcs_.equal_range(proc.name())};
4292	for (auto iter{range.first}; iter != range.second; ++iter) {
4293	ResolveSpecificsInGeneric(generic&: *iter->second, isEndOfSpecificationPart: false);
4294	}
4295	}
4296
4297	void InterfaceVisitor::ResolveNewSpecifics() {
4298	if (Symbol * generic{genericInfo_.top().symbol};
4299	generic && generic->has<GenericDetails>()) {
4300	ResolveSpecificsInGeneric(*generic, false);
4301	}
4302	}
4303
4304	// Mixed interfaces are allowed by the standard.
4305	// If there is a derived type with the same name, they must all be functions.
4306	void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
4307	ResolveSpecificsInGeneric(generic, true);
4308	auto &details{generic.get<GenericDetails>()};
4309	if (auto *proc{details.CheckSpecific()}) {
4310	context().Warn(common::UsageWarning::HomonymousSpecific,
4311	proc->name().begin() > generic.name().begin() ? proc->name()
4312	: generic.name(),
4313	"'%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,
4314	generic.name());
4315	}
4316	auto &specifics{details.specificProcs()};
4317	if (specifics.empty()) {
4318	if (details.derivedType()) {
4319	generic.set(Symbol::Flag::Function);
4320	}
4321	return;
4322	}
4323	const Symbol *function{nullptr};
4324	const Symbol *subroutine{nullptr};
4325	for (const Symbol &specific : specifics) {
4326	if (!function && specific.test(Symbol::Flag::Function)) {
4327	function = &specific;
4328	} else if (!subroutine && specific.test(Symbol::Flag::Subroutine)) {
4329	subroutine = &specific;
4330	if (details.derivedType() &&
4331	context().ShouldWarn(
4332	common::LanguageFeature::SubroutineAndFunctionSpecifics) &&
4333	!InModuleFile()) {
4334	SayDerivedType(generic.name(),
4335	"Generic interface '%s' should only contain functions due to derived type with same name"_warn_en_US,
4336	*details.derivedType()->GetUltimate().scope())
4337	.set_languageFeature(
4338	common::LanguageFeature::SubroutineAndFunctionSpecifics);
4339	}
4340	}
4341	if (function && subroutine) { // F'2023 C1514
4342	if (auto *msg{context().Warn(
4343	common::LanguageFeature::SubroutineAndFunctionSpecifics,
4344	generic.name(),
4345	"Generic interface '%s' has both a function and a subroutine"_warn_en_US,
4346	generic.name())}) {
4347	msg->Attach(function->name(), "Function declaration"_en_US)
4348	.Attach(subroutine->name(), "Subroutine declaration"_en_US);
4349	}
4350	break;
4351	}
4352	}
4353	if (function && !subroutine) {
4354	generic.set(Symbol::Flag::Function);
4355	} else if (subroutine && !function) {
4356	generic.set(Symbol::Flag::Subroutine);
4357	}
4358	}
4359
4360	// SubprogramVisitor implementation
4361
4362	// Return false if it is actually an assignment statement.
4363	bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
4364	const auto &name{std::get<parser::Name>(x.t)};
4365	const DeclTypeSpec *resultType{nullptr};
4366	// Look up name: provides return type or tells us if it's an array
4367	if (auto *symbol{FindSymbol(name)}) {
4368	Symbol &ultimate{symbol->GetUltimate()};
4369	if (ultimate.has<ObjectEntityDetails>() ||
4370	ultimate.has<AssocEntityDetails>() ||
4371	CouldBeDataPointerValuedFunction(&ultimate) ||
4372	(&symbol->owner() == &currScope() && IsFunctionResult(*symbol))) {
4373	misparsedStmtFuncFound_ = true;
4374	return false;
4375	}
4376	if (IsHostAssociated(*symbol, currScope())) {
4377	context().Warn(common::LanguageFeature::StatementFunctionExtensions,
4378	name.source,
4379	"Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US,
4380	name.source);
4381	MakeSymbol(name, Attrs{}, UnknownDetails{});
4382	} else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
4383	entity && !ultimate.has<ProcEntityDetails>()) {
4384	resultType = entity->type();
4385	ultimate.details() = UnknownDetails{}; // will be replaced below
4386	} else {
4387	misparsedStmtFuncFound_ = true;
4388	}
4389	}
4390	if (misparsedStmtFuncFound_) {
4391	Say(name,
4392	"'%s' has not been declared as an array or pointer-valued function"_err_en_US);
4393	return false;
4394	}
4395	auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
4396	symbol.set(Symbol::Flag::StmtFunction);
4397	EraseSymbol(symbol); // removes symbol added by PushSubprogramScope
4398	auto &details{symbol.get<SubprogramDetails>()};
4399	for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {
4400	ObjectEntityDetails dummyDetails{true};
4401	if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {
4402	if (auto *d{dummySymbol->GetType()}) {
4403	dummyDetails.set_type(*d);
4404	}
4405	}
4406	Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};
4407	ApplyImplicitRules(dummy);
4408	details.add_dummyArg(dummy);
4409	}
4410	ObjectEntityDetails resultDetails;
4411	if (resultType) {
4412	resultDetails.set_type(*resultType);
4413	}
4414	resultDetails.set_funcResult(true);
4415	Symbol &result{MakeSymbol(name, std::move(resultDetails))};
4416	result.flags().set(Symbol::Flag::StmtFunction);
4417	ApplyImplicitRules(result);
4418	details.set_result(result);
4419	// The analysis of the expression that constitutes the body of the
4420	// statement function is deferred to FinishSpecificationPart() so that
4421	// all declarations and implicit typing are complete.
4422	PopScope();
4423	return true;
4424	}
4425
4426	bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
4427	if (suffix.resultName) {
4428	if (IsFunction(currScope())) {
4429	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
4430	if (info->inFunctionStmt) {
4431	info->resultName = &suffix.resultName.value();
4432	} else {
4433	// will check the result name in Post(EntryStmt)
4434	}
4435	}
4436	} else {
4437	Message &msg{Say(*suffix.resultName,
4438	"RESULT(%s) may appear only in a function"_err_en_US)};
4439	if (const Symbol * subprogram{InclusiveScope().symbol()}) {
4440	msg.Attach(subprogram->name(), "Containing subprogram"_en_US);
4441	}
4442	}
4443	}
4444	// LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt,
4445	// all the way to EndSubprogram().
4446	return false;
4447	}
4448
4449	bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
4450	// Save this to process after UseStmt and ImplicitPart
4451	if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
4452	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
4453	if (info->parsedType) { // C1543
4454	Say(currStmtSource().value_or(info->source),
4455	"FUNCTION prefix cannot specify the type more than once"_err_en_US);
4456	} else {
4457	info->parsedType = parsedType;
4458	if (auto at{currStmtSource()}) {
4459	info->source = *at;
4460	}
4461	}
4462	} else {
4463	Say(currStmtSource().value(),
4464	"SUBROUTINE prefix cannot specify a type"_err_en_US);
4465	}
4466	return false;
4467	} else {
4468	return true;
4469	}
4470	}
4471
4472	bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
4473	if (auto *subp{currScope().symbol()
4474	? currScope().symbol()->detailsIf<SubprogramDetails>()
4475	: nullptr}) {
4476	for (auto attr : attrs.v) {
4477	if (auto current{subp->cudaSubprogramAttrs()}) {
4478	if (attr == *current ||
4479	(*current == common::CUDASubprogramAttrs::HostDevice &&
4480	(attr == common::CUDASubprogramAttrs::Host ||
4481	attr == common::CUDASubprogramAttrs::Device))) {
4482	context().Warn(common::LanguageFeature::RedundantAttribute,
4483	currStmtSource().value(),
4484	"ATTRIBUTES(%s) appears more than once"_warn_en_US,
4485	common::EnumToString(attr));
4486	} else if ((attr == common::CUDASubprogramAttrs::Host ||
4487	attr == common::CUDASubprogramAttrs::Device) &&
4488	(*current == common::CUDASubprogramAttrs::Host ||
4489	*current == common::CUDASubprogramAttrs::Device ||
4490	*current == common::CUDASubprogramAttrs::HostDevice)) {
4491	// HOST,DEVICE or DEVICE,HOST -> HostDevice
4492	subp->set_cudaSubprogramAttrs(
4493	common::CUDASubprogramAttrs::HostDevice);
4494	} else {
4495	Say(currStmtSource().value(),
4496	"ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,
4497	common::EnumToString(attr), common::EnumToString(*current));
4498	}
4499	} else {
4500	subp->set_cudaSubprogramAttrs(attr);
4501	}
4502	}
4503	if (auto attrs{subp->cudaSubprogramAttrs()}) {
4504	if (*attrs == common::CUDASubprogramAttrs::Global ||
4505	*attrs == common::CUDASubprogramAttrs::Grid_Global ||
4506	*attrs == common::CUDASubprogramAttrs::Device ||
4507	*attrs == common::CUDASubprogramAttrs::HostDevice) {
4508	const Scope &scope{currScope()};
4509	const Scope *mod{FindModuleContaining(scope)};
4510	if (mod &&
4511	(mod->GetName().value() == "cudadevice" ||
4512	mod->GetName().value() == "__cuda_device")) {
4513	return false;
4514	}
4515	// Implicitly USE the cudadevice module by copying its symbols in the
4516	// current scope.
4517	const Scope &cudaDeviceScope{context().GetCUDADeviceScope()};
4518	for (auto sym : cudaDeviceScope.GetSymbols()) {
4519	if (!currScope().FindSymbol(sym->name())) {
4520	auto &localSymbol{MakeSymbol(
4521	sym->name(), Attrs{}, UseDetails{sym->name(), *sym})};
4522	localSymbol.flags() = sym->flags();
4523	}
4524	}
4525	}
4526	}
4527	}
4528	return false;
4529	}
4530
4531	void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {
4532	std::vector<std::int64_t> bounds;
4533	bool ok{true};
4534	for (const auto &sicx : x.v) {
4535	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
4536	bounds.push_back(*value);
4537	} else {
4538	ok = false;
4539	}
4540	}
4541	if (!ok || bounds.size() < 2 || bounds.size() > 3) {
4542	Say(currStmtSource().value(),
4543	"Operands of LAUNCH_BOUNDS() must be 2 or 3 integer constants"_err_en_US);
4544	} else if (auto *subp{currScope().symbol()
4545	? currScope().symbol()->detailsIf<SubprogramDetails>()
4546	: nullptr}) {
4547	if (subp->cudaLaunchBounds().empty()) {
4548	subp->set_cudaLaunchBounds(std::move(bounds));
4549	} else {
4550	Say(currStmtSource().value(),
4551	"LAUNCH_BOUNDS() may only appear once"_err_en_US);
4552	}
4553	}
4554	}
4555
4556	void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
4557	std::vector<std::int64_t> dims;
4558	bool ok{true};
4559	for (const auto &sicx : x.v) {
4560	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
4561	dims.push_back(*value);
4562	} else {
4563	ok = false;
4564	}
4565	}
4566	if (!ok || dims.size() != 3) {
4567	Say(currStmtSource().value(),
4568	"Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);
4569	} else if (auto *subp{currScope().symbol()
4570	? currScope().symbol()->detailsIf<SubprogramDetails>()
4571	: nullptr}) {
4572	if (subp->cudaClusterDims().empty()) {
4573	subp->set_cudaClusterDims(std::move(dims));
4574	} else {
4575	Say(currStmtSource().value(),
4576	"CLUSTER_DIMS() may only appear once"_err_en_US);
4577	}
4578	}
4579	}
4580
4581	static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {
4582	for (const auto &prefix : prefixes) {
4583	if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
4584	return true;
4585	}
4586	}
4587	return false;
4588	}
4589
4590	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
4591	const auto &stmtTuple{
4592	std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};
4593	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
4594	Symbol::Flag::Subroutine,
4595	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
4596	}
4597	void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
4598	const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
4599	EndSubprogram(stmt.source,
4600	&std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t));
4601	}
4602	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
4603	const auto &stmtTuple{
4604	std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};
4605	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
4606	Symbol::Flag::Function,
4607	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
4608	}
4609	void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
4610	const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
4611	const auto &maybeSuffix{
4612	std::get<std::optional<parser::Suffix>>(stmt.statement.t)};
4613	EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr);
4614	}
4615
4616	bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
4617	BeginAttrs();
4618	Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t));
4619	Walk(std::get<parser::Name>(stmt.t));
4620	Walk(std::get<std::list<parser::DummyArg>>(stmt.t));
4621	// Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram.
4622	Symbol &symbol{PostSubprogramStmt()};
4623	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
4624	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4625	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4626	CreateDummyArgument(details, *dummyName);
4627	} else {
4628	details.add_alternateReturn();
4629	}
4630	}
4631	return false;
4632	}
4633	bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
4634	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
4635	CHECK(!info.inFunctionStmt);
4636	info.inFunctionStmt = true;
4637	if (auto at{currStmtSource()}) {
4638	info.source = *at;
4639	}
4640	return BeginAttrs();
4641	}
4642	bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
4643
4644	void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
4645	const auto &name{std::get<parser::Name>(stmt.t)};
4646	Symbol &symbol{PostSubprogramStmt()};
4647	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
4648	for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
4649	CreateDummyArgument(details, dummyName);
4650	}
4651	const parser::Name *funcResultName;
4652	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
4653	CHECK(info.inFunctionStmt);
4654	info.inFunctionStmt = false;
4655	bool distinctResultName{
4656	info.resultName && info.resultName->source != name.source};
4657	if (distinctResultName) {
4658	// Note that RESULT is ignored if it has the same name as the function.
4659	// The symbol created by PushScope() is retained as a place-holder
4660	// for error detection.
4661	funcResultName = info.resultName;
4662	} else {
4663	EraseSymbol(name); // was added by PushScope()
4664	funcResultName = &name;
4665	}
4666	if (details.isFunction()) {
4667	CHECK(context().HasError(currScope().symbol()));
4668	} else {
4669	// RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY
4670	// statement.
4671	Symbol *result{nullptr};
4672	if (distinctResultName) {
4673	if (auto iter{currScope().find(funcResultName->source)};
4674	iter != currScope().end()) {
4675	Symbol &entryResult{*iter->second};
4676	if (IsFunctionResult(entryResult)) {
4677	result = &entryResult;
4678	}
4679	}
4680	}
4681	if (result) {
4682	Resolve(*funcResultName, *result);
4683	} else {
4684	// add function result to function scope
4685	EntityDetails funcResultDetails;
4686	funcResultDetails.set_funcResult(true);
4687	result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
4688	}
4689	info.resultSymbol = result;
4690	details.set_result(*result);
4691	}
4692	// C1560.
4693	if (info.resultName && !distinctResultName) {
4694	context().Warn(common::UsageWarning::HomonymousResult,
4695	info.resultName->source,
4696	"The function name should not appear in RESULT; references to '%s' "
4697	"inside the function will be considered as references to the "
4698	"result only"_warn_en_US,
4699	name.source);
4700	// RESULT name was ignored above, the only side effect from doing so will be
4701	// the inability to make recursive calls. The related parser::Name is still
4702	// resolved to the created function result symbol because every parser::Name
4703	// should be resolved to avoid internal errors.
4704	Resolve(*info.resultName, info.resultSymbol);
4705	}
4706	name.symbol = &symbol; // must not be function result symbol
4707	// Clear the RESULT() name now in case an ENTRY statement in the implicit-part
4708	// has a RESULT() suffix.
4709	info.resultName = nullptr;
4710	}
4711
4712	Symbol &SubprogramVisitor::PostSubprogramStmt() {
4713	Symbol &symbol{*currScope().symbol()};
4714	SetExplicitAttrs(symbol, EndAttrs());
4715	if (symbol.attrs().test(Attr::MODULE)) {
4716	symbol.attrs().set(Attr::EXTERNAL, false);
4717	symbol.implicitAttrs().set(Attr::EXTERNAL, false);
4718	}
4719	return symbol;
4720	}
4721
4722	void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
4723	if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) {
4724	Walk(suffix->binding);
4725	}
4726	PostEntryStmt(stmt);
4727	EndAttrs();
4728	}
4729
4730	void SubprogramVisitor::CreateDummyArgument(
4731	SubprogramDetails &details, const parser::Name &name) {
4732	Symbol *dummy{FindInScope(name)};
4733	if (dummy) {
4734	if (IsDummy(*dummy)) {
4735	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
4736	dummy->set(Symbol::Flag::EntryDummyArgument, false);
4737	} else {
4738	Say(name,
4739	"'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US,
4740	name.source);
4741	return;
4742	}
4743	} else {
4744	SayWithDecl(name, *dummy,
4745	"'%s' may not appear as a dummy argument name in this subprogram"_err_en_US);
4746	return;
4747	}
4748	} else {
4749	dummy = &MakeSymbol(name, EntityDetails{true});
4750	}
4751	details.add_dummyArg(DEREF(dummy));
4752	}
4753
4754	void SubprogramVisitor::CreateEntry(
4755	const parser::EntryStmt &stmt, Symbol &subprogram) {
4756	const auto &entryName{std::get<parser::Name>(stmt.t)};
4757	Scope &outer{currScope().parent()};
4758	Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)
4759	? Symbol::Flag::Function
4760	: Symbol::Flag::Subroutine};
4761	Attrs attrs;
4762	const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
4763	bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding &&
4764	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
4765	suffix->binding->t)
4766	.has_value()};
4767	if (!hasGlobalBindingName) {
4768	if (Symbol * extant{FindSymbol(outer, entryName)}) {
4769	if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
4770	if (outer.IsTopLevel()) {
4771	Say2(entryName,
4772	"'%s' is already defined as a global identifier"_err_en_US,
4773	*extant, "Previous definition of '%s'"_en_US);
4774	} else {
4775	SayAlreadyDeclared(entryName, *extant);
4776	}
4777	return;
4778	}
4779	attrs = extant->attrs();
4780	}
4781	}
4782	std::optional<SourceName> distinctResultName;
4783	if (suffix && suffix->resultName &&
4784	suffix->resultName->source != entryName.source) {
4785	distinctResultName = suffix->resultName->source;
4786	}
4787	if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
4788	attrs.set(Attr::PUBLIC);
4789	}
4790	Symbol *entrySymbol{nullptr};
4791	if (hasGlobalBindingName) {
4792	// Hide the entry's symbol in a new anonymous global scope so
4793	// that its name doesn't clash with anything.
4794	Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})};
4795	symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
4796	Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)};
4797	entrySymbol = &MakeSymbol(hidden, entryName.source, attrs);
4798	} else {
4799	entrySymbol = FindInScope(outer, entryName.source);
4800	if (entrySymbol) {
4801	if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {
4802	if (auto *specific{generic->specific()}) {
4803	// Forward reference to ENTRY from a generic interface
4804	entrySymbol = specific;
4805	CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs);
4806	SetExplicitAttrs(*entrySymbol, attrs);
4807	}
4808	}
4809	} else {
4810	entrySymbol = &MakeSymbol(outer, entryName.source, attrs);
4811	}
4812	}
4813	SubprogramDetails entryDetails;
4814	entryDetails.set_entryScope(currScope());
4815	entrySymbol->set(subpFlag);
4816	if (subpFlag == Symbol::Flag::Function) {
4817	Symbol *result{nullptr};
4818	EntityDetails resultDetails;
4819	resultDetails.set_funcResult(true);
4820	if (distinctResultName) {
4821	// An explicit RESULT() can also be an explicit RESULT()
4822	// of the function or another ENTRY.
4823	if (auto iter{currScope().find(suffix->resultName->source)};
4824	iter != currScope().end()) {
4825	result = &*iter->second;
4826	}
4827	if (!result) {
4828	result =
4829	&MakeSymbol(*distinctResultName, Attrs{}, std::move(resultDetails));
4830	} else if (!result->has<EntityDetails>()) {
4831	Say(*distinctResultName,
4832	"ENTRY cannot have RESULT(%s) that is not a variable"_err_en_US,
4833	*distinctResultName)
4834	.Attach(result->name(), "Existing declaration of '%s'"_en_US,
4835	result->name());
4836	result = nullptr;
4837	}
4838	if (result) {
4839	Resolve(*suffix->resultName, *result);
4840	}
4841	} else {
4842	result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));
4843	}
4844	if (result) {
4845	entryDetails.set_result(*result);
4846	}
4847	}
4848	if (subpFlag == Symbol::Flag::Subroutine || distinctResultName) {
4849	Symbol &assoc{MakeSymbol(entryName.source)};
4850	assoc.set_details(HostAssocDetails{*entrySymbol});
4851	assoc.set(Symbol::Flag::Subroutine);
4852	}
4853	Resolve(entryName, *entrySymbol);
4854	std::set<SourceName> dummies;
4855	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4856	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4857	auto pair{dummies.insert(dummyName->source)};
4858	if (!pair.second) {
4859	Say(*dummyName,
4860	"'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US,
4861	dummyName->source);
4862	continue;
4863	}
4864	Symbol *dummy{FindInScope(*dummyName)};
4865	if (dummy) {
4866	if (!IsDummy(*dummy)) {
4867	evaluate::AttachDeclaration(
4868	Say(*dummyName,
4869	"'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US,
4870	dummyName->source),
4871	*dummy);
4872	continue;
4873	}
4874	} else {
4875	dummy = &MakeSymbol(*dummyName, EntityDetails{true});
4876	dummy->set(Symbol::Flag::EntryDummyArgument);
4877	}
4878	entryDetails.add_dummyArg(DEREF(dummy));
4879	} else if (subpFlag == Symbol::Flag::Function) { // C1573
4880	Say(entryName,
4881	"ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
4882	break;
4883	} else {
4884	entryDetails.add_alternateReturn();
4885	}
4886	}
4887	entrySymbol->set_details(std::move(entryDetails));
4888	}
4889
4890	void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
4891	// The entry symbol should have already been created and resolved
4892	// in CreateEntry(), called by BeginSubprogram(), with one exception (below).
4893	const auto &name{std::get<parser::Name>(stmt.t)};
4894	Scope &inclusiveScope{InclusiveScope()};
4895	if (!name.symbol) {
4896	if (inclusiveScope.kind() != Scope::Kind::Subprogram) {
4897	Say(name.source,
4898	"ENTRY '%s' may appear only in a subroutine or function"_err_en_US,
4899	name.source);
4900	} else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {
4901	Say(name.source,
4902	"ENTRY '%s' may not appear in a separate module procedure"_err_en_US,
4903	name.source);
4904	} else {
4905	// C1571 - entry is nested, so was not put into the program tree; error
4906	// is emitted from MiscChecker in semantics.cpp.
4907	}
4908	return;
4909	}
4910	Symbol &entrySymbol{*name.symbol};
4911	if (context().HasError(entrySymbol)) {
4912	return;
4913	}
4914	if (!entrySymbol.has<SubprogramDetails>()) {
4915	SayAlreadyDeclared(name, entrySymbol);
4916	return;
4917	}
4918	SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
4919	CHECK(entryDetails.entryScope() == &inclusiveScope);
4920	SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());
4921	entrySymbol.attrs() |= GetAttrs();
4922	SetBindNameOn(entrySymbol);
4923	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4924	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4925	if (Symbol * dummy{FindInScope(*dummyName)}) {
4926	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
4927	const auto *subp{dummy->detailsIf<SubprogramDetails>()};
4928	if (subp && subp->isInterface()) { // ok
4929	} else if (!dummy->has<EntityDetails>() &&
4930	!dummy->has<ObjectEntityDetails>() &&
4931	!dummy->has<ProcEntityDetails>()) {
4932	SayWithDecl(*dummyName, *dummy,
4933	"ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US);
4934	}
4935	dummy->set(Symbol::Flag::EntryDummyArgument, false);
4936	}
4937	}
4938	}
4939	}
4940	}
4941
4942	Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
4943	const parser::Name &name) {
4944	auto *symbol{FindSymbol(name)};
4945	if (symbol && symbol->has<SubprogramNameDetails>()) {
4946	const Scope *parent{nullptr};
4947	if (currScope().IsSubmodule()) {
4948	parent = currScope().symbol()->get<ModuleDetails>().parent();
4949	}
4950	symbol = parent ? FindSymbol(scope: *parent, name) : nullptr;
4951	}
4952	if (symbol) {
4953	if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
4954	symbol = generic->specific();
4955	}
4956	}
4957	if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
4958	// Error recovery in case of multiple definitions
4959	symbol = const_cast<Symbol *>(defnIface);
4960	}
4961	if (!IsSeparateModuleProcedureInterface(symbol)) {
4962	Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
4963	symbol = nullptr;
4964	}
4965	return symbol;
4966	}
4967
4968	// A subprogram declared with MODULE PROCEDURE
4969	bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
4970	Symbol *symbol{FindSeparateModuleProcedureInterface(name)};
4971	if (!symbol) {
4972	return false;
4973	}
4974	if (symbol->owner() == currScope() && symbol->scope()) {
4975	// This is a MODULE PROCEDURE whose interface appears in its host.
4976	// Convert the module procedure's interface into a subprogram.
4977	SetScope(DEREF(symbol->scope()));
4978	symbol->get<SubprogramDetails>().set_isInterface(false);
4979	name.symbol = symbol;
4980	} else {
4981	// Copy the interface into a new subprogram scope.
4982	EraseSymbol(name);
4983	Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
4984	PushScope(Scope::Kind::Subprogram, &newSymbol);
4985	auto &newSubprogram{newSymbol.get<SubprogramDetails>()};
4986	newSubprogram.set_moduleInterface(*symbol);
4987	auto &subprogram{symbol->get<SubprogramDetails>()};
4988	if (const auto *name{subprogram.bindName()}) {
4989	newSubprogram.set_bindName(std::string{*name});
4990	}
4991	newSymbol.attrs() |= symbol->attrs();
4992	newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
4993	? Symbol::Flag::Subroutine
4994	: Symbol::Flag::Function);
4995	MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());
4996	}
4997	return true;
4998	}
4999
5000	// A subprogram or interface declared with SUBROUTINE or FUNCTION
5001	bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
5002	Symbol::Flag subpFlag, bool hasModulePrefix,
5003	const parser::LanguageBindingSpec *bindingSpec,
5004	const ProgramTree::EntryStmtList *entryStmts) {
5005	bool isValid{true};
5006	if (hasModulePrefix && !currScope().IsModule() &&
5007	!currScope().IsSubmodule()) { // C1547
5008	Say(name,
5009	"'%s' is a MODULE procedure which must be declared within a "
5010	"MODULE or SUBMODULE"_err_en_US);
5011	// Don't return here because it can be useful to have the scope set for
5012	// other semantic checks run before we print the errors
5013	isValid = false;
5014	}
5015	Symbol *moduleInterface{nullptr};
5016	if (isValid && hasModulePrefix && !inInterfaceBlock()) {
5017	moduleInterface = FindSeparateModuleProcedureInterface(name);
5018	if (moduleInterface && &moduleInterface->owner() == &currScope()) {
5019	// Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
5020	// previously defined in the same scope.
5021	if (GenericDetails *
5022	generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {
5023	generic->clear_specific();
5024	name.symbol = nullptr;
5025	} else {
5026	EraseSymbol(name);
5027	}
5028	}
5029	}
5030	Symbol &newSymbol{
5031	PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};
5032	if (moduleInterface) {
5033	newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
5034	if (moduleInterface->attrs().test(Attr::PRIVATE)) {
5035	SetImplicitAttr(newSymbol, Attr::PRIVATE);
5036	} else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
5037	SetImplicitAttr(newSymbol, Attr::PUBLIC);
5038	}
5039	}
5040	if (entryStmts) {
5041	for (const auto &ref : *entryStmts) {
5042	CreateEntry(*ref, newSymbol);
5043	}
5044	}
5045	return true;
5046	}
5047
5048	void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol,
5049	std::optional<parser::CharBlock> stmtSource,
5050	const std::optional<parser::LanguageBindingSpec> *binding) {
5051	if (binding && *binding && symbol) {
5052	// Finally process the BIND(C,NAME=name) now that symbols in the name
5053	// expression will resolve to local names if needed.
5054	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
5055	auto originalStmtSource{messageHandler().currStmtSource()};
5056	messageHandler().set_currStmtSource(stmtSource);
5057	BeginAttrs();
5058	Walk(**binding);
5059	SetBindNameOn(*symbol);
5060	symbol->attrs() |= EndAttrs();
5061	messageHandler().set_currStmtSource(originalStmtSource);
5062	}
5063	}
5064
5065	void SubprogramVisitor::EndSubprogram(
5066	std::optional<parser::CharBlock> stmtSource,
5067	const std::optional<parser::LanguageBindingSpec> *binding,
5068	const ProgramTree::EntryStmtList *entryStmts) {
5069	HandleLanguageBinding(currScope().symbol(), stmtSource, binding);
5070	if (entryStmts) {
5071	for (const auto &ref : *entryStmts) {
5072	const parser::EntryStmt &entryStmt{*ref};
5073	if (const auto &suffix{
5074	std::get<std::optional<parser::Suffix>>(entryStmt.t)}) {
5075	const auto &name{std::get<parser::Name>(entryStmt.t)};
5076	HandleLanguageBinding(name.symbol, name.source, &suffix->binding);
5077	}
5078	}
5079	}
5080	if (inInterfaceBlock() && currScope().symbol()) {
5081	DeclaredPossibleSpecificProc(proc&: *currScope().symbol());
5082	}
5083	PopScope();
5084	}
5085
5086	bool SubprogramVisitor::HandlePreviousCalls(
5087	const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
5088	// If the extant symbol is a generic, check its homonymous specific
5089	// procedure instead if it has one.
5090	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
5091	return generic->specific() &&
5092	HandlePreviousCalls(name, *generic->specific(), subpFlag);
5093	} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
5094	!proc->isDummy() &&
5095	!symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
5096	// There's a symbol created for previous calls to this subprogram or
5097	// ENTRY's name. We have to replace that symbol in situ to avoid the
5098	// obligation to rewrite symbol pointers in the parse tree.
5099	if (!symbol.test(subpFlag)) {
5100	auto other{subpFlag == Symbol::Flag::Subroutine
5101	? Symbol::Flag::Function
5102	: Symbol::Flag::Subroutine};
5103	// External statements issue an explicit EXTERNAL attribute.
5104	if (symbol.attrs().test(Attr::EXTERNAL) &&
5105	!symbol.implicitAttrs().test(Attr::EXTERNAL)) {
5106	// Warn if external statement previously declared.
5107	context().Warn(common::LanguageFeature::RedundantAttribute, name.source,
5108	"EXTERNAL attribute was already specified on '%s'"_warn_en_US,
5109	name.source);
5110	} else if (symbol.test(other)) {
5111	Say2(name,
5112	subpFlag == Symbol::Flag::Function
5113	? "'%s' was previously called as a subroutine"_err_en_US
5114	: "'%s' was previously called as a function"_err_en_US,
5115	symbol, "Previous call of '%s'"_en_US);
5116	} else {
5117	symbol.set(subpFlag);
5118	}
5119	}
5120	EntityDetails entity;
5121	if (proc->type()) {
5122	entity.set_type(*proc->type());
5123	}
5124	symbol.details() = std::move(entity);
5125	return true;
5126	} else {
5127	return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();
5128	}
5129	}
5130
5131	void SubprogramVisitor::CheckExtantProc(
5132	const parser::Name &name, Symbol::Flag subpFlag) {
5133	if (auto *prev{FindSymbol(name)}) {
5134	if (IsDummy(*prev)) {
5135	} else if (auto *entity{prev->detailsIf<EntityDetails>()};
5136	IsPointer(*prev) && entity && !entity->type()) {
5137	// POINTER attribute set before interface
5138	} else if (inInterfaceBlock() && currScope() != prev->owner()) {
5139	// Procedures in an INTERFACE block do not resolve to symbols
5140	// in scopes between the global scope and the current scope.
5141	} else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
5142	SayAlreadyDeclared(name, *prev);
5143	}
5144	}
5145	}
5146
5147	Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
5148	Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
5149	bool hasModulePrefix) {
5150	Symbol *symbol{GetSpecificFromGeneric(name)};
5151	if (!symbol) {
5152	if (bindingSpec && currScope().IsGlobal() &&
5153	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
5154	bindingSpec->t)
5155	.has_value()) {
5156	// Create this new top-level subprogram with a binding label
5157	// in a new global scope, so that its symbol's name won't clash
5158	// with another symbol that has a distinct binding label.
5159	PushScope(Scope::Kind::Global,
5160	&MakeSymbol(context().GetTempName(currScope()), Attrs{},
5161	MiscDetails{MiscDetails::Kind::ScopeName}));
5162	}
5163	CheckExtantProc(name, subpFlag);
5164	symbol = &MakeSymbol(name, SubprogramDetails{});
5165	}
5166	symbol->ReplaceName(name.source);
5167	symbol->set(subpFlag);
5168	PushScope(Scope::Kind::Subprogram, symbol);
5169	if (subpFlag == Symbol::Flag::Function) {
5170	funcResultStack().Push(currScope(), name.source);
5171	}
5172	if (inInterfaceBlock()) {
5173	auto &details{symbol->get<SubprogramDetails>()};
5174	details.set_isInterface();
5175	if (isAbstract()) {
5176	SetExplicitAttr(*symbol, Attr::ABSTRACT);
5177	} else if (hasModulePrefix) {
5178	SetExplicitAttr(*symbol, Attr::MODULE);
5179	} else {
5180	MakeExternal(*symbol);
5181	}
5182	if (isGeneric()) {
5183	Symbol &genericSymbol{GetGenericSymbol()};
5184	if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {
5185	details->AddSpecificProc(*symbol, name.source);
5186	} else {
5187	CHECK(context().HasError(genericSymbol));
5188	}
5189	}
5190	set_inheritFromParent(false); // interfaces don't inherit, even if MODULE
5191	}
5192	if (Symbol * found{FindSymbol(name)};
5193	found && found->has<HostAssocDetails>()) {
5194	found->set(subpFlag); // PushScope() created symbol
5195	}
5196	return *symbol;
5197	}
5198
5199	void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
5200	if (auto *prev{FindSymbol(name)}) {
5201	if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
5202	if (prev->test(Symbol::Flag::Subroutine) ||
5203	prev->test(Symbol::Flag::Function)) {
5204	Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,
5205	"Previous call of '%s'"_en_US);
5206	}
5207	EraseSymbol(name);
5208	}
5209	}
5210	if (name.source.empty()) {
5211	// Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM
5212	PushScope(Scope::Kind::BlockData, nullptr);
5213	} else {
5214	PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
5215	}
5216	}
5217
5218	// If name is a generic, return specific subprogram with the same name.
5219	Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
5220	// Search for the name but don't resolve it
5221	if (auto *symbol{currScope().FindSymbol(name.source)}) {
5222	if (symbol->has<SubprogramNameDetails>()) {
5223	if (inInterfaceBlock()) {
5224	// Subtle: clear any MODULE flag so that the new interface
5225	// symbol doesn't inherit it and ruin the ability to check it.
5226	symbol->attrs().reset(Attr::MODULE);
5227	}
5228	} else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
5229	// found generic, want specific procedure
5230	auto *specific{details->specific()};
5231	Attrs moduleAttr;
5232	if (inInterfaceBlock()) {
5233	if (specific) {
5234	// Defining an interface in a generic of the same name which is
5235	// already shadowing another procedure. In some cases, the shadowed
5236	// procedure is about to be replaced.
5237	if (specific->has<SubprogramNameDetails>() &&
5238	specific->attrs().test(Attr::MODULE)) {
5239	// The shadowed procedure is a separate module procedure that is
5240	// actually defined later in this (sub)module.
5241	// Define its interface now as a new symbol.
5242	moduleAttr.set(Attr::MODULE);
5243	specific = nullptr;
5244	} else if (&specific->owner() != &symbol->owner()) {
5245	// The shadowed procedure was from an enclosing scope and will be
5246	// overridden by this interface definition.
5247	specific = nullptr;
5248	}
5249	if (!specific) {
5250	details->clear_specific();
5251	}
5252	} else if (const auto *dType{details->derivedType()}) {
5253	if (&dType->owner() != &symbol->owner()) {
5254	// The shadowed derived type was from an enclosing scope and
5255	// will be overridden by this interface definition.
5256	details->clear_derivedType();
5257	}
5258	}
5259	}
5260	if (!specific) {
5261	specific = &currScope().MakeSymbol(
5262	name.source, std::move(moduleAttr), SubprogramDetails{});
5263	if (details->derivedType()) {
5264	// A specific procedure with the same name as a derived type
5265	SayAlreadyDeclared(name, *details->derivedType());
5266	} else {
5267	details->set_specific(Resolve(name, *specific));
5268	}
5269	} else if (isGeneric()) {
5270	SayAlreadyDeclared(name, *specific);
5271	}
5272	if (specific->has<SubprogramNameDetails>()) {
5273	specific->set_details(Details{SubprogramDetails{}});
5274	}
5275	return specific;
5276	}
5277	}
5278	return nullptr;
5279	}
5280
5281	// DeclarationVisitor implementation
5282
5283	bool DeclarationVisitor::BeginDecl() {
5284	BeginDeclTypeSpec();
5285	BeginArraySpec();
5286	return BeginAttrs();
5287	}
5288	void DeclarationVisitor::EndDecl() {
5289	EndDeclTypeSpec();
5290	EndArraySpec();
5291	EndAttrs();
5292	}
5293
5294	bool DeclarationVisitor::CheckUseError(const parser::Name &name) {
5295	return HadUseError(context(), name.source, name.symbol);
5296	}
5297
5298	// Report error if accessibility of symbol doesn't match isPrivate.
5299	void DeclarationVisitor::CheckAccessibility(
5300	const SourceName &name, bool isPrivate, Symbol &symbol) {
5301	if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
5302	Say2(name,
5303	"'%s' does not have the same accessibility as its previous declaration"_err_en_US,
5304	symbol, "Previous declaration of '%s'"_en_US);
5305	}
5306	}
5307
5308	bool DeclarationVisitor::Pre(const parser::TypeDeclarationStmt &x) {
5309	BeginDecl();
5310	// If INTRINSIC appears as an attr-spec, handle it now as if the
5311	// names had appeared on an INTRINSIC attribute statement beforehand.
5312	for (const auto &attr : std::get<std::list<parser::AttrSpec>>(x.t)) {
5313	if (std::holds_alternative<parser::Intrinsic>(attr.u)) {
5314	for (const auto &decl : std::get<std::list<parser::EntityDecl>>(x.t)) {
5315	DeclareIntrinsic(parser::GetFirstName(decl));
5316	}
5317	break;
5318	}
5319	}
5320	return true;
5321	}
5322	void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
5323	EndDecl();
5324	}
5325
5326	void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
5327	DeclareObjectEntity(std::get<parser::Name>(x.t));
5328	}
5329	void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
5330	DeclareObjectEntity(std::get<parser::Name>(x.t));
5331	}
5332
5333	bool DeclarationVisitor::Pre(const parser::Initialization &) {
5334	// Defer inspection of initializers to Initialization() so that the
5335	// symbol being initialized will be available within the initialization
5336	// expression.
5337	return false;
5338	}
5339
5340	void DeclarationVisitor::Post(const parser::EntityDecl &x) {
5341	const auto &name{std::get<parser::ObjectName>(x.t)};
5342	Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
5343	attrs.set(Attr::INTRINSIC, false); // dealt with in Pre(TypeDeclarationStmt)
5344	Symbol &symbol{DeclareUnknownEntity(name, attrs)};
5345	symbol.ReplaceName(name.source);
5346	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
5347	if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
5348	ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
5349	symbol.set(
5350	Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
5351	Initialization(name, *init, false);
5352	} else if (attrs.test(Attr::PARAMETER)) { // C882, C883
5353	Say(name, "Missing initialization for parameter '%s'"_err_en_US);
5354	}
5355	if (auto *scopeSymbol{currScope().symbol()}) {
5356	if (auto *details{scopeSymbol->detailsIf<DerivedTypeDetails>()}) {
5357	if (details->isDECStructure()) {
5358	details->add_component(symbol);
5359	}
5360	}
5361	}
5362	}
5363
5364	void DeclarationVisitor::Post(const parser::PointerDecl &x) {
5365	const auto &name{std::get<parser::Name>(x.t)};
5366	if (const auto &deferredShapeSpecs{
5367	std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
5368	CHECK(arraySpec().empty());
5369	BeginArraySpec();
5370	set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
5371	Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
5372	symbol.ReplaceName(name.source);
5373	EndArraySpec();
5374	} else {
5375	if (const auto *symbol{FindInScope(name)}) {
5376	const auto *subp{symbol->detailsIf<SubprogramDetails>()};
5377	if (!symbol->has<UseDetails>() && // error caught elsewhere
5378	!symbol->has<ObjectEntityDetails>() &&
5379	!symbol->has<ProcEntityDetails>() &&
5380	!symbol->CanReplaceDetails(ObjectEntityDetails{}) &&
5381	!symbol->CanReplaceDetails(ProcEntityDetails{}) &&
5382	!(subp && subp->isInterface())) {
5383	Say(name, "'%s' cannot have the POINTER attribute"_err_en_US);
5384	}
5385	}
5386	HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t));
5387	}
5388	}
5389
5390	bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
5391	auto kind{std::get<parser::BindEntity::Kind>(x.t)};
5392	auto &name{std::get<parser::Name>(x.t)};
5393	Symbol *symbol;
5394	if (kind == parser::BindEntity::Kind::Object) {
5395	symbol = &HandleAttributeStmt(Attr::BIND_C, name);
5396	} else {
5397	symbol = &MakeCommonBlockSymbol(name);
5398	SetExplicitAttr(*symbol, Attr::BIND_C);
5399	}
5400	// 8.6.4(1)
5401	// Some entities such as named constant or module name need to checked
5402	// elsewhere. This is to skip the ICE caused by setting Bind name for non-name
5403	// things such as data type and also checks for procedures.
5404	if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() ||
5405	symbol->has<EntityDetails>()) {
5406	SetBindNameOn(*symbol);
5407	} else {
5408	Say(name,
5409	"Only variable and named common block can be in BIND statement"_err_en_US);
5410	}
5411	return false;
5412	}
5413	bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) {
5414	inOldStyleParameterStmt_ = true;
5415	Walk(x.v);
5416	inOldStyleParameterStmt_ = false;
5417	return false;
5418	}
5419	bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
5420	auto &name{std::get<parser::NamedConstant>(x.t).v};
5421	auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
5422	ConvertToObjectEntity(symbol&: symbol);
5423	auto *details{symbol.detailsIf<ObjectEntityDetails>()};
5424	if (!details || symbol.test(Symbol::Flag::CrayPointer) ||
5425	symbol.test(Symbol::Flag::CrayPointee)) {
5426	SayWithDecl(
5427	name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);
5428	return false;
5429	}
5430	const auto &expr{std::get<parser::ConstantExpr>(x.t)};
5431	if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
5432	Say(name, "Named constant '%s' already has a value"_err_en_US);
5433	}
5434	if (inOldStyleParameterStmt_) {
5435	// non-standard extension PARAMETER statement (no parentheses)
5436	Walk(expr);
5437	auto folded{EvaluateExpr(expr)};
5438	if (details->type()) {
5439	SayWithDecl(name, symbol,
5440	"Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US);
5441	} else if (folded) {
5442	auto at{expr.thing.value().source};
5443	if (evaluate::IsActuallyConstant(*folded)) {
5444	if (const auto *type{currScope().GetType(*folded)}) {
5445	if (type->IsPolymorphic()) {
5446	Say(at, "The expression must not be polymorphic"_err_en_US);
5447	} else if (auto shape{ToArraySpec(
5448	GetFoldingContext(), evaluate::GetShape(*folded))}) {
5449	// The type of the named constant is assumed from the expression.
5450	details->set_type(*type);
5451	details->set_init(std::move(*folded));
5452	details->set_shape(std::move(*shape));
5453	} else {
5454	Say(at, "The expression must have constant shape"_err_en_US);
5455	}
5456	} else {
5457	Say(at, "The expression must have a known type"_err_en_US);
5458	}
5459	} else {
5460	Say(at, "The expression must be a constant of known type"_err_en_US);
5461	}
5462	}
5463	} else {
5464	// standard-conforming PARAMETER statement (with parentheses)
5465	ApplyImplicitRules(symbol&: symbol);
5466	Walk(expr);
5467	if (auto converted{EvaluateNonPointerInitializer(
5468	symbol, expr, expr.thing.value().source)}) {
5469	details->set_init(std::move(*converted));
5470	}
5471	}
5472	return false;
5473	}
5474	bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
5475	const parser::Name &name{x.v};
5476	if (!FindSymbol(name)) {
5477	Say(name, "Named constant '%s' not found"_err_en_US);
5478	} else {
5479	CheckUseError(name);
5480	}
5481	return false;
5482	}
5483
5484	bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
5485	const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
5486	Symbol *symbol{FindInScope(name)};
5487	if (symbol && !symbol->has<UnknownDetails>()) {
5488	// Contrary to named constants appearing in a PARAMETER statement,
5489	// enumerator names should not have their type, dimension or any other
5490	// attributes defined before they are declared in the enumerator statement,
5491	// with the exception of accessibility.
5492	// This is not explicitly forbidden by the standard, but they are scalars
5493	// which type is left for the compiler to chose, so do not let users try to
5494	// tamper with that.
5495	SayAlreadyDeclared(name, *symbol);
5496	symbol = nullptr;
5497	} else {
5498	// Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
5499	symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
5500	symbol->SetType(context().MakeNumericType(
5501	TypeCategory::Integer, evaluate::CInteger::kind));
5502	}
5503
5504	if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
5505	enumerator.t)}) {
5506	Walk(*init); // Resolve names in expression before evaluation.
5507	if (auto value{EvaluateInt64(context(), *init)}) {
5508	// Cast all init expressions to C_INT so that they can then be
5509	// safely incremented (see 7.6 Note 2).
5510	enumerationState_.value = static_cast<int>(*value);
5511	} else {
5512	Say(name,
5513	"Enumerator value could not be computed "
5514	"from the given expression"_err_en_US);
5515	// Prevent resolution of next enumerators value
5516	enumerationState_.value = std::nullopt;
5517	}
5518	}
5519
5520	if (symbol) {
5521	if (enumerationState_.value) {
5522	symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
5523	evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
5524	} else {
5525	context().SetError(*symbol);
5526	}
5527	}
5528
5529	if (enumerationState_.value) {
5530	(*enumerationState_.value)++;
5531	}
5532	return false;
5533	}
5534
5535	void DeclarationVisitor::Post(const parser::EnumDef &) {
5536	enumerationState_ = EnumeratorState{};
5537	}
5538
5539	bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {
5540	Attr attr{AccessSpecToAttr(x)};
5541	if (!NonDerivedTypeScope().IsModule()) { // C817
5542	Say(currStmtSource().value(),
5543	"%s attribute may only appear in the specification part of a module"_err_en_US,
5544	EnumToString(attr));
5545	}
5546	CheckAndSet(attr);
5547	return false;
5548	}
5549
5550	bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
5551	return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
5552	}
5553	bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {
5554	return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);
5555	}
5556	bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
5557	HandleAttributeStmt(Attr::EXTERNAL, x.v);
5558	for (const auto &name : x.v) {
5559	auto *symbol{FindSymbol(name)};
5560	if (!ConvertToProcEntity(DEREF(symbol), name.source)) {
5561	// Check if previous symbol is an interface.
5562	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
5563	if (details->isInterface()) {
5564	// Warn if interface previously declared.
5565	context().Warn(common::LanguageFeature::RedundantAttribute,
5566	name.source,
5567	"EXTERNAL attribute was already specified on '%s'"_warn_en_US,
5568	name.source);
5569	}
5570	} else {
5571	SayWithDecl(
5572	name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
5573	}
5574	} else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840
5575	Say(symbol->name(),
5576	"Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,
5577	symbol->name());
5578	}
5579	}
5580	return false;
5581	}
5582	bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
5583	auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
5584	auto &names{std::get<std::list<parser::Name>>(x.t)};
5585	return CheckNotInBlock("INTENT") && // C1107
5586	HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
5587	}
5588	bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
5589	for (const auto &name : x.v) {
5590	DeclareIntrinsic(name);
5591	}
5592	return false;
5593	}
5594	void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
5595	HandleAttributeStmt(Attr::INTRINSIC, name);
5596	if (!IsIntrinsic(name.source, std::nullopt)) {
5597	Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
5598	}
5599	auto &symbol{DEREF(FindSymbol(name))};
5600	if (symbol.has<GenericDetails>()) {
5601	// Generic interface is extending intrinsic; ok
5602	} else if (!ConvertToProcEntity(symbol&: symbol, usedHere: name.source)) {
5603	SayWithDecl(
5604	name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
5605	} else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
5606	Say(symbol.name(),
5607	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
5608	symbol.name());
5609	} else {
5610	if (symbol.GetType()) {
5611	// These warnings are worded so that they should make sense in either
5612	// order.
5613	if (auto *msg{context().Warn(
5614	common::UsageWarning::IgnoredIntrinsicFunctionType, symbol.name(),
5615	"Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
5616	symbol.name())}) {
5617	msg->Attach(name.source,
5618	"INTRINSIC statement for explicitly-typed '%s'"_en_US, name.source);
5619	}
5620	}
5621	if (!symbol.test(Symbol::Flag::Function) &&
5622	!symbol.test(Symbol::Flag::Subroutine)) {
5623	if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) {
5624	symbol.set(Symbol::Flag::Function);
5625	} else if (context().intrinsics().IsIntrinsicSubroutine(
5626	name.source.ToString())) {
5627	symbol.set(Symbol::Flag::Subroutine);
5628	}
5629	}
5630	}
5631	}
5632	bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
5633	return CheckNotInBlock("OPTIONAL") && // C1107
5634	HandleAttributeStmt(Attr::OPTIONAL, x.v);
5635	}
5636	bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {
5637	return HandleAttributeStmt(Attr::PROTECTED, x.v);
5638	}
5639	bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
5640	return CheckNotInBlock("VALUE") && // C1107
5641	HandleAttributeStmt(Attr::VALUE, x.v);
5642	}
5643	bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
5644	return HandleAttributeStmt(Attr::VOLATILE, x.v);
5645	}
5646	bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {
5647	auto attr{std::get<common::CUDADataAttr>(x.t)};
5648	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
5649	auto *symbol{FindInScope(name)};
5650	if (symbol && symbol->has<UseDetails>()) {
5651	Say(currStmtSource().value(),
5652	"Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,
5653	name.source);
5654	} else {
5655	if (!symbol) {
5656	symbol = &MakeSymbol(name, ObjectEntityDetails{});
5657	}
5658	SetCUDADataAttr(name.source, *symbol, attr);
5659	}
5660	}
5661	return false;
5662	}
5663	// Handle a statement that sets an attribute on a list of names.
5664	bool DeclarationVisitor::HandleAttributeStmt(
5665	Attr attr, const std::list<parser::Name> &names) {
5666	for (const auto &name : names) {
5667	HandleAttributeStmt(attr, name);
5668	}
5669	return false;
5670	}
5671	Symbol &DeclarationVisitor::HandleAttributeStmt(
5672	Attr attr, const parser::Name &name) {
5673	auto *symbol{FindInScope(name)};
5674	if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
5675	// these can be set on a symbol that is host-assoc or use-assoc
5676	if (!symbol &&
5677	(currScope().kind() == Scope::Kind::Subprogram ||
5678	currScope().kind() == Scope::Kind::BlockConstruct)) {
5679	if (auto *hostSymbol{FindSymbol(name)}) {
5680	symbol = &MakeHostAssocSymbol(name, hostSymbol: *hostSymbol);
5681	}
5682	}
5683	} else if (symbol && symbol->has<UseDetails>()) {
5684	if (symbol->GetUltimate().attrs().test(attr)) {
5685	context().Warn(common::LanguageFeature::RedundantAttribute,
5686	currStmtSource().value(),
5687	"Use-associated '%s' already has '%s' attribute"_warn_en_US,
5688	name.source, EnumToString(attr));
5689	} else {
5690	Say(currStmtSource().value(),
5691	"Cannot change %s attribute on use-associated '%s'"_err_en_US,
5692	EnumToString(attr), name.source);
5693	}
5694	return *symbol;
5695	}
5696	if (!symbol) {
5697	symbol = &MakeSymbol(name, EntityDetails{});
5698	}
5699	if (CheckDuplicatedAttr(name.source, *symbol, attr)) {
5700	HandleSaveName(name.source, Attrs{attr});
5701	SetExplicitAttr(*symbol, attr);
5702	}
5703	return *symbol;
5704	}
5705	// C1107
5706	bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {
5707	if (currScope().kind() == Scope::Kind::BlockConstruct) {
5708	Say(MessageFormattedText{
5709	"%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});
5710	return false;
5711	} else {
5712	return true;
5713	}
5714	}
5715
5716	void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
5717	CHECK(objectDeclAttr_);
5718	const auto &name{std::get<parser::ObjectName>(x.t)};
5719	DeclareObjectEntity(name, Attrs{*objectDeclAttr_});
5720	}
5721
5722	// Declare an entity not yet known to be an object or proc.
5723	Symbol &DeclarationVisitor::DeclareUnknownEntity(
5724	const parser::Name &name, Attrs attrs) {
5725	if (!arraySpec().empty() || !coarraySpec().empty()) {
5726	return DeclareObjectEntity(name, attrs);
5727	} else {
5728	Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
5729	if (auto *type{GetDeclTypeSpec()}) {
5730	ForgetEarlyDeclaredDummyArgument(symbol);
5731	SetType(name, *type);
5732	}
5733	charInfo_.length.reset();
5734	if (symbol.attrs().test(Attr::EXTERNAL)) {
5735	ConvertToProcEntity(symbol);
5736	} else if (symbol.attrs().HasAny(Attrs{Attr::ALLOCATABLE,
5737	Attr::ASYNCHRONOUS, Attr::CONTIGUOUS, Attr::PARAMETER,
5738	Attr::SAVE, Attr::TARGET, Attr::VALUE, Attr::VOLATILE})) {
5739	ConvertToObjectEntity(symbol);
5740	}
5741	if (attrs.test(Attr::BIND_C)) {
5742	SetBindNameOn(symbol);
5743	}
5744	return symbol;
5745	}
5746	}
5747
5748	bool DeclarationVisitor::HasCycle(
5749	const Symbol &procSymbol, const Symbol *interface) {
5750	SourceOrderedSymbolSet procsInCycle;
5751	procsInCycle.insert(procSymbol);
5752	while (interface) {
5753	if (procsInCycle.count(*interface) > 0) {
5754	for (const auto &procInCycle : procsInCycle) {
5755	Say(procInCycle->name(),
5756	"The interface for procedure '%s' is recursively defined"_err_en_US,
5757	procInCycle->name());
5758	context().SetError(*procInCycle);
5759	}
5760	return true;
5761	} else if (const auto *procDetails{
5762	interface->detailsIf<ProcEntityDetails>()}) {
5763	procsInCycle.insert(*interface);
5764	interface = procDetails->procInterface();
5765	} else {
5766	break;
5767	}
5768	}
5769	return false;
5770	}
5771
5772	Symbol &DeclarationVisitor::DeclareProcEntity(
5773	const parser::Name &name, Attrs attrs, const Symbol *interface) {
5774	Symbol *proc{nullptr};
5775	if (auto *extant{FindInScope(name)}) {
5776	if (auto *d{extant->detailsIf<GenericDetails>()}; d && !d->derivedType()) {
5777	// procedure pointer with same name as a generic
5778	if (auto *specific{d->specific()}) {
5779	SayAlreadyDeclared(name, *specific);
5780	} else {
5781	// Create the ProcEntityDetails symbol in the scope as the "specific()"
5782	// symbol behind an existing GenericDetails symbol of the same name.
5783	proc = &Resolve(name,
5784	currScope().MakeSymbol(name.source, attrs, ProcEntityDetails{}));
5785	d->set_specific(*proc);
5786	}
5787	}
5788	}
5789	Symbol &symbol{proc ? *proc : DeclareEntity<ProcEntityDetails>(name, attrs)};
5790	if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
5791	if (context().HasError(symbol)) {
5792	} else if (HasCycle(procSymbol: symbol, interface)) {
5793	return symbol;
5794	} else if (interface && (details->procInterface() || details->type())) {
5795	SayWithDecl(name, symbol,
5796	"The interface for procedure '%s' has already been declared"_err_en_US);
5797	context().SetError(symbol);
5798	} else if (interface) {
5799	details->set_procInterfaces(
5800	*interface, BypassGeneric(interface->GetUltimate()));
5801	if (interface->test(Symbol::Flag::Function)) {
5802	symbol.set(Symbol::Flag::Function);
5803	} else if (interface->test(Symbol::Flag::Subroutine)) {
5804	symbol.set(Symbol::Flag::Subroutine);
5805	}
5806	} else if (auto *type{GetDeclTypeSpec()}) {
5807	ForgetEarlyDeclaredDummyArgument(symbol);
5808	SetType(name, *type);
5809	symbol.set(Symbol::Flag::Function);
5810	}
5811	SetBindNameOn(symbol);
5812	SetPassNameOn(symbol);
5813	}
5814	return symbol;
5815	}
5816
5817	Symbol &DeclarationVisitor::DeclareObjectEntity(
5818	const parser::Name &name, Attrs attrs) {
5819	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
5820	if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
5821	if (auto *type{GetDeclTypeSpec()}) {
5822	ForgetEarlyDeclaredDummyArgument(symbol);
5823	SetType(name, *type);
5824	}
5825	if (!arraySpec().empty()) {
5826	if (details->IsArray()) {
5827	if (!context().HasError(symbol)) {
5828	Say(name,
5829	"The dimensions of '%s' have already been declared"_err_en_US);
5830	context().SetError(symbol);
5831	}
5832	} else if (MustBeScalar(symbol)) {
5833	if (!context().HasError(symbol)) {
5834	context().Warn(common::UsageWarning::PreviousScalarUse, name.source,
5835	"'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US,
5836	name.source);
5837	}
5838	} else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
5839	Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);
5840	} else {
5841	details->set_shape(arraySpec());
5842	}
5843	}
5844	if (!coarraySpec().empty()) {
5845	if (details->IsCoarray()) {
5846	if (!context().HasError(symbol)) {
5847	Say(name,
5848	"The codimensions of '%s' have already been declared"_err_en_US);
5849	context().SetError(symbol);
5850	}
5851	} else {
5852	details->set_coshape(coarraySpec());
5853	}
5854	}
5855	SetBindNameOn(symbol);
5856	}
5857	ClearArraySpec();
5858	ClearCoarraySpec();
5859	charInfo_.length.reset();
5860	return symbol;
5861	}
5862
5863	void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
5864	if (!isVectorType_) {
5865	SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
5866	}
5867	}
5868	void DeclarationVisitor::Post(const parser::UnsignedTypeSpec &x) {
5869	if (!isVectorType_) {
5870	if (!context().IsEnabled(common::LanguageFeature::Unsigned) &&
5871	!context().AnyFatalError()) {
5872	context().Say("-funsigned is required to enable UNSIGNED type"_err_en_US);
5873	}
5874	SetDeclTypeSpec(MakeNumericType(TypeCategory::Unsigned, x.v));
5875	}
5876	}
5877	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
5878	if (!isVectorType_) {
5879	SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
5880	}
5881	}
5882	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
5883	SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
5884	}
5885	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
5886	SetDeclTypeSpec(MakeLogicalType(x.kind));
5887	}
5888	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
5889	if (!charInfo_.length) {
5890	charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};
5891	}
5892	if (!charInfo_.kind) {
5893	charInfo_.kind =
5894	KindExpr{context().GetDefaultKind(TypeCategory::Character)};
5895	}
5896	SetDeclTypeSpec(currScope().MakeCharacterType(
5897	std::move(*charInfo_.length), std::move(*charInfo_.kind)));
5898	charInfo_ = {};
5899	}
5900	void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
5901	charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
5902	std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};
5903	if (intKind &&
5904	!context().targetCharacteristics().IsTypeEnabled(
5905	TypeCategory::Character, *intKind)) { // C715, C719
5906	Say(currStmtSource().value(),
5907	"KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);
5908	charInfo_.kind = std::nullopt; // prevent further errors
5909	}
5910	if (x.length) {
5911	charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
5912	}
5913	}
5914	void DeclarationVisitor::Post(const parser::CharLength &x) {
5915	if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {
5916	charInfo_.length = ParamValue{
5917	static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};
5918	} else {
5919	charInfo_.length = GetParamValue(
5920	std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);
5921	}
5922	}
5923	void DeclarationVisitor::Post(const parser::LengthSelector &x) {
5924	if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {
5925	charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);
5926	}
5927	}
5928
5929	bool DeclarationVisitor::Pre(const parser::KindParam &x) {
5930	if (const auto *kind{std::get_if<
5931	parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
5932	&x.u)}) {
5933	const parser::Name &name{kind->thing.thing.thing};
5934	if (!FindSymbol(name)) {
5935	Say(name, "Parameter '%s' not found"_err_en_US);
5936	}
5937	}
5938	return false;
5939	}
5940
5941	int DeclarationVisitor::GetVectorElementKind(
5942	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
5943	KindExpr value{GetKindParamExpr(category, kind)};
5944	if (auto known{evaluate::ToInt64(value)}) {
5945	return static_cast<int>(*known);
5946	}
5947	common::die("Vector element kind must be known at compile-time");
5948	}
5949
5950	bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) {
5951	// PowerPC vector types are allowed only on Power architectures.
5952	if (!currScope().context().targetCharacteristics().isPPC()) {
5953	Say(currStmtSource().value(),
5954	"Vector type is only supported for PowerPC"_err_en_US);
5955	isVectorType_ = false;
5956	return false;
5957	}
5958	isVectorType_ = true;
5959	return true;
5960	}
5961	// Create semantic::DerivedTypeSpec for Vector types here.
5962	void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {
5963	llvm::StringRef typeName;
5964	llvm::SmallVector<ParamValue> typeParams;
5965	DerivedTypeSpec::Category vectorCategory;
5966
5967	isVectorType_ = false;
5968	common::visit(
5969	common::visitors{
5970	[&](const parser::IntrinsicVectorTypeSpec &y) {
5971	vectorCategory = DerivedTypeSpec::Category::IntrinsicVector;
5972	int vecElemKind = 0;
5973	typeName = "__builtin_ppc_intrinsic_vector";
5974	common::visit(
5975	common::visitors{
5976	[&](const parser::IntegerTypeSpec &z) {
5977	vecElemKind = GetVectorElementKind(
5978	TypeCategory::Integer, std::move(z.v));
5979	typeParams.push_back(ParamValue(
5980	static_cast<common::ConstantSubscript>(
5981	common::VectorElementCategory::Integer),
5982	common::TypeParamAttr::Kind));
5983	},
5984	[&](const parser::IntrinsicTypeSpec::Real &z) {
5985	vecElemKind = GetVectorElementKind(
5986	TypeCategory::Real, std::move(z.kind));
5987	typeParams.push_back(
5988	ParamValue(static_cast<common::ConstantSubscript>(
5989	common::VectorElementCategory::Real),
5990	common::TypeParamAttr::Kind));
5991	},
5992	[&](const parser::UnsignedTypeSpec &z) {
5993	vecElemKind = GetVectorElementKind(
5994	TypeCategory::Integer, std::move(z.v));
5995	typeParams.push_back(ParamValue(
5996	static_cast<common::ConstantSubscript>(
5997	common::VectorElementCategory::Unsigned),
5998	common::TypeParamAttr::Kind));
5999	},
6000	},
6001	y.v.u);
6002	typeParams.push_back(
6003	ParamValue(static_cast<common::ConstantSubscript>(vecElemKind),
6004	common::TypeParamAttr::Kind));
6005	},
6006	[&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) {
6007	vectorCategory = DerivedTypeSpec::Category::PairVector;
6008	typeName = "__builtin_ppc_pair_vector";
6009	},
6010	[&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) {
6011	vectorCategory = DerivedTypeSpec::Category::QuadVector;
6012	typeName = "__builtin_ppc_quad_vector";
6013	},
6014	},
6015	x.u);
6016
6017	auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope();
6018	if (!ppcBuiltinTypesScope) {
6019	common::die("INTERNAL: The __ppc_types module was not found ");
6020	}
6021
6022	auto iter{ppcBuiltinTypesScope->find(
6023	semantics::SourceName{typeName.data(), typeName.size()})};
6024	if (iter == ppcBuiltinTypesScope->cend()) {
6025	common::die("INTERNAL: The __ppc_types module does not define "
6026	"the type '%s'",
6027	typeName.data());
6028	}
6029
6030	const semantics::Symbol &typeSymbol{*iter->second};
6031	DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol};
6032	vectorDerivedType.set_category(vectorCategory);
6033	if (typeParams.size()) {
6034	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0]));
6035	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1]));
6036	vectorDerivedType.CookParameters(GetFoldingContext());
6037	}
6038
6039	if (const DeclTypeSpec *
6040	extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(
6041	vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
6042	// This derived type and parameter expressions (if any) are already present
6043	// in the __ppc_intrinsics scope.
6044	SetDeclTypeSpec(*extant);
6045	} else {
6046	DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType(
6047	DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))};
6048	DerivedTypeSpec &derived{type.derivedTypeSpec()};
6049	auto restorer{
6050	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
6051	derived.Instantiate(*ppcBuiltinTypesScope);
6052	SetDeclTypeSpec(type);
6053	}
6054	}
6055
6056	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
6057	CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
6058	return true;
6059	}
6060
6061	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
6062	const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)};
6063	if (const Symbol * derivedSymbol{derivedName.symbol}) {
6064	CheckForAbstractType(*derivedSymbol); // C706
6065	}
6066	}
6067
6068	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) {
6069	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
6070	return true;
6071	}
6072
6073	void DeclarationVisitor::Post(
6074	const parser::DeclarationTypeSpec::Class &parsedClass) {
6075	const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)};
6076	if (auto spec{ResolveDerivedType(typeName)};
6077	spec && !IsExtensibleType(&*spec)) { // C705
6078	SayWithDecl(typeName, *typeName.symbol,
6079	"Non-extensible derived type '%s' may not be used with CLASS"
6080	" keyword"_err_en_US);
6081	}
6082	}
6083
6084	void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
6085	const auto &typeName{std::get<parser::Name>(x.t)};
6086	auto spec{ResolveDerivedType(typeName)};
6087	if (!spec) {
6088	return;
6089	}
6090	bool seenAnyName{false};
6091	for (const auto &typeParamSpec :
6092	std::get<std::list<parser::TypeParamSpec>>(x.t)) {
6093	const auto &optKeyword{
6094	std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};
6095	std::optional<SourceName> name;
6096	if (optKeyword) {
6097	seenAnyName = true;
6098	name = optKeyword->v.source;
6099	} else if (seenAnyName) {
6100	Say(typeName.source, "Type parameter value must have a name"_err_en_US);
6101	continue;
6102	}
6103	const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
6104	// The expressions in a derived type specifier whose values define
6105	// non-defaulted type parameters are evaluated (folded) in the enclosing
6106	// scope. The KIND/LEN distinction is resolved later in
6107	// DerivedTypeSpec::CookParameters().
6108	ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
6109	if (!param.isExplicit() || param.GetExplicit()) {
6110	spec->AddRawParamValue(
6111	common::GetPtrFromOptional(optKeyword), std::move(param));
6112	}
6113	}
6114	// The DerivedTypeSpec *spec is used initially as a search key.
6115	// If it turns out to have the same name and actual parameter
6116	// value expressions as another DerivedTypeSpec in the current
6117	// scope does, then we'll use that extant spec; otherwise, when this
6118	// spec is distinct from all derived types previously instantiated
6119	// in the current scope, this spec will be moved into that collection.
6120	const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};
6121	auto category{GetDeclTypeSpecCategory()};
6122	if (dtDetails.isForwardReferenced()) {
6123	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
6124	SetDeclTypeSpec(type);
6125	return;
6126	}
6127	// Normalize parameters to produce a better search key.
6128	spec->CookParameters(GetFoldingContext());
6129	if (!spec->MightBeParameterized()) {
6130	spec->EvaluateParameters(context());
6131	}
6132	if (const DeclTypeSpec *
6133	extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
6134	// This derived type and parameter expressions (if any) are already present
6135	// in this scope.
6136	SetDeclTypeSpec(*extant);
6137	} else {
6138	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
6139	DerivedTypeSpec &derived{type.derivedTypeSpec()};
6140	if (derived.MightBeParameterized() &&
6141	currScope().IsParameterizedDerivedType()) {
6142	// Defer instantiation; use the derived type's definition's scope.
6143	derived.set_scope(DEREF(spec->typeSymbol().scope()));
6144	} else if (&currScope() == spec->typeSymbol().scope()) {
6145	// Direct recursive use of a type in the definition of one of its
6146	// components: defer instantiation
6147	} else {
6148	auto restorer{
6149	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
6150	derived.Instantiate(currScope());
6151	}
6152	SetDeclTypeSpec(type);
6153	}
6154	// Capture the DerivedTypeSpec in the parse tree for use in building
6155	// structure constructor expressions.
6156	x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
6157	}
6158
6159	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
6160	const auto &typeName{rec.v};
6161	if (auto spec{ResolveDerivedType(typeName)}) {
6162	spec->CookParameters(GetFoldingContext());
6163	spec->EvaluateParameters(context());
6164	if (const DeclTypeSpec *
6165	extant{currScope().FindInstantiatedDerivedType(
6166	*spec, DeclTypeSpec::TypeDerived)}) {
6167	SetDeclTypeSpec(*extant);
6168	} else {
6169	Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,
6170	typeName.source);
6171	}
6172	}
6173	}
6174
6175	// The descendents of DerivedTypeDef in the parse tree are visited directly
6176	// in this Pre() routine so that recursive use of the derived type can be
6177	// supported in the components.
6178	bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
6179	auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
6180	Walk(stmt);
6181	Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));
6182	auto &scope{currScope()};
6183	CHECK(scope.symbol());
6184	CHECK(scope.symbol()->scope() == &scope);
6185	auto &details{scope.symbol()->get<DerivedTypeDetails>()};
6186	for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
6187	if (auto *symbol{FindInScope(scope, paramName)}) {
6188	if (auto *details{symbol->detailsIf<TypeParamDetails>()}) {
6189	if (!details->attr()) {
6190	Say(paramName,
6191	"No definition found for type parameter '%s'"_err_en_US); // C742
6192	}
6193	}
6194	}
6195	}
6196	Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t));
6197	const auto &componentDefs{
6198	std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)};
6199	Walk(componentDefs);
6200	if (derivedTypeInfo_.sequence) {
6201	details.set_sequence(true);
6202	if (componentDefs.empty()) {
6203	// F'2023 C745 - not enforced by any compiler
6204	context().Warn(common::LanguageFeature::EmptySequenceType, stmt.source,
6205	"A sequence type should have at least one component"_warn_en_US);
6206	}
6207	if (!details.paramDeclOrder().empty()) { // C740
6208	Say(stmt.source,
6209	"A sequence type may not have type parameters"_err_en_US);
6210	}
6211	if (derivedTypeInfo_.extends) { // C735
6212	Say(stmt.source,
6213	"A sequence type may not have the EXTENDS attribute"_err_en_US);
6214	}
6215	}
6216	Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
6217	Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));
6218	details.set_isForwardReferenced(false);
6219	derivedTypeInfo_ = {};
6220	PopScope();
6221	return false;
6222	}
6223
6224	bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
6225	return BeginAttrs();
6226	}
6227	void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
6228	auto &name{std::get<parser::Name>(x.t)};
6229	// Resolve the EXTENDS() clause before creating the derived
6230	// type's symbol to foil attempts to recursively extend a type.
6231	auto *extendsName{derivedTypeInfo_.extends};
6232	std::optional<DerivedTypeSpec> extendsType{
6233	ResolveExtendsType(name, extendsName)};
6234	DerivedTypeDetails derivedTypeDetails;
6235	// Catch any premature structure constructors within the definition
6236	derivedTypeDetails.set_isForwardReferenced(true);
6237	auto &symbol{MakeSymbol(name, GetAttrs(), std::move(derivedTypeDetails))};
6238	symbol.ReplaceName(name.source);
6239	derivedTypeInfo_.type = &symbol;
6240	PushScope(Scope::Kind::DerivedType, &symbol);
6241	if (extendsType) {
6242	// Declare the "parent component"; private if the type is.
6243	// Any symbol stored in the EXTENDS() clause is temporarily
6244	// hidden so that a new symbol can be created for the parent
6245	// component without producing spurious errors about already
6246	// existing.
6247	const Symbol &extendsSymbol{extendsType->typeSymbol()};
6248	auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
6249	if (OkToAddComponent(*extendsName, extends: &extendsSymbol)) {
6250	auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
6251	comp.attrs().set(
6252	Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE));
6253	comp.implicitAttrs().set(
6254	Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE));
6255	comp.set(Symbol::Flag::ParentComp);
6256	DeclTypeSpec &type{currScope().MakeDerivedType(
6257	DeclTypeSpec::TypeDerived, std::move(*extendsType))};
6258	type.derivedTypeSpec().set_scope(DEREF(extendsSymbol.scope()));
6259	comp.SetType(type);
6260	DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
6261	details.add_component(comp);
6262	}
6263	}
6264	// Create symbols now for type parameters so that they shadow names
6265	// from the enclosing specification part.
6266	if (auto *details{symbol.detailsIf<DerivedTypeDetails>()}) {
6267	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
6268	if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{})}) {
6269	details->add_paramNameOrder(*symbol);
6270	}
6271	}
6272	}
6273	EndAttrs();
6274	}
6275
6276	void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
6277	auto *type{GetDeclTypeSpec()};
6278	DerivedTypeDetails *derivedDetails{nullptr};
6279	if (Symbol * dtSym{currScope().symbol()}) {
6280	derivedDetails = dtSym->detailsIf<DerivedTypeDetails>();
6281	}
6282	auto attr{std::get<common::TypeParamAttr>(x.t)};
6283	for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
6284	auto &name{std::get<parser::Name>(decl.t)};
6285	if (Symbol * symbol{FindInScope(currScope(), name)}) {
6286	if (auto *paramDetails{symbol->detailsIf<TypeParamDetails>()}) {
6287	if (!paramDetails->attr()) {
6288	paramDetails->set_attr(attr);
6289	SetType(name, *type);
6290	if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
6291	decl.t)}) {
6292	if (auto maybeExpr{AnalyzeExpr(context(), *init)}) {
6293	if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) {
6294	paramDetails->set_init(std::move(*intExpr));
6295	}
6296	}
6297	}
6298	if (derivedDetails) {
6299	derivedDetails->add_paramDeclOrder(*symbol);
6300	}
6301	} else {
6302	Say(name,
6303	"Type parameter '%s' was already declared in this derived type"_err_en_US);
6304	}
6305	}
6306	} else {
6307	Say(name, "'%s' is not a parameter of this derived type"_err_en_US);
6308	}
6309	}
6310	EndDecl();
6311	}
6312	bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
6313	if (derivedTypeInfo_.extends) {
6314	Say(currStmtSource().value(),
6315	"Attribute 'EXTENDS' cannot be used more than once"_err_en_US);
6316	} else {
6317	derivedTypeInfo_.extends = &x.v;
6318	}
6319	return false;
6320	}
6321
6322	bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
6323	if (!currScope().parent().IsModule()) {
6324	Say("PRIVATE is only allowed in a derived type that is"
6325	" in a module"_err_en_US); // C766
6326	} else if (derivedTypeInfo_.sawContains) {
6327	derivedTypeInfo_.privateBindings = true;
6328	} else if (!derivedTypeInfo_.privateComps) {
6329	derivedTypeInfo_.privateComps = true;
6330	} else { // C738
6331	context().Warn(common::LanguageFeature::RedundantAttribute,
6332	"PRIVATE should not appear more than once in derived type components"_warn_en_US);
6333	}
6334	return false;
6335	}
6336	bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {
6337	if (derivedTypeInfo_.sequence) { // C738
6338	context().Warn(common::LanguageFeature::RedundantAttribute,
6339	"SEQUENCE should not appear more than once in derived type components"_warn_en_US);
6340	}
6341	derivedTypeInfo_.sequence = true;
6342	return false;
6343	}
6344	void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
6345	const auto &name{std::get<parser::Name>(x.t)};
6346	auto attrs{GetAttrs()};
6347	if (derivedTypeInfo_.privateComps &&
6348	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
6349	attrs.set(Attr::PRIVATE);
6350	}
6351	if (const auto *declType{GetDeclTypeSpec()}) {
6352	if (const auto *derived{declType->AsDerived()}) {
6353	if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
6354	if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744
6355	Say("Recursive use of the derived type requires "
6356	"POINTER or ALLOCATABLE"_err_en_US);
6357	}
6358	}
6359	}
6360	}
6361	if (OkToAddComponent(name)) {
6362	auto &symbol{DeclareObjectEntity(name, attrs)};
6363	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
6364	if (symbol.has<ObjectEntityDetails>()) {
6365	if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
6366	Initialization(name, *init, true);
6367	}
6368	}
6369	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
6370	}
6371	ClearArraySpec();
6372	ClearCoarraySpec();
6373	}
6374	void DeclarationVisitor::Post(const parser::FillDecl &x) {
6375	// Replace "%FILL" with a distinct generated name
6376	const auto &name{std::get<parser::Name>(x.t)};
6377	const_cast<SourceName &>(name.source) = context().GetTempName(currScope());
6378	if (OkToAddComponent(name)) {
6379	auto &symbol{DeclareObjectEntity(name, GetAttrs())};
6380	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
6381	}
6382	ClearArraySpec();
6383	}
6384	bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
6385	CHECK(!interfaceName_);
6386	const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};
6387	for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
6388	if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
6389	if (std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
6390	bindC->t)
6391	.has_value()) {
6392	if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {
6393	Say(context().location().value(),
6394	"A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);
6395	}
6396	break;
6397	}
6398	}
6399	}
6400	return BeginDecl();
6401	}
6402	void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
6403	interfaceName_ = nullptr;
6404	EndDecl();
6405	}
6406	bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
6407	// Overrides parse tree traversal so as to handle attributes first,
6408	// so POINTER & ALLOCATABLE enable forward references to derived types.
6409	Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
6410	set_allowForwardReferenceToDerivedType(
6411	GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
6412	Walk(std::get<parser::DeclarationTypeSpec>(x.t));
6413	set_allowForwardReferenceToDerivedType(false);
6414	if (derivedTypeInfo_.sequence) { // C740
6415	if (const auto *declType{GetDeclTypeSpec()}) {
6416	if (!declType->AsIntrinsic() && !declType->IsSequenceType() &&
6417	!InModuleFile()) {
6418	if (GetAttrs().test(Attr::POINTER) &&
6419	context().IsEnabled(common::LanguageFeature::PointerInSeqType)) {
6420	context().Warn(common::LanguageFeature::PointerInSeqType,
6421	"A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);
6422	} else {
6423	Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US);
6424	}
6425	}
6426	}
6427	}
6428	Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));
6429	return false;
6430	}
6431	bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
6432	CHECK(!interfaceName_);
6433	return true;
6434	}
6435	void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
6436	interfaceName_ = nullptr;
6437	}
6438	bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
6439	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
6440	return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(name: *name);
6441	} else {
6442	const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))};
6443	Walk(null);
6444	if (auto nullInit{EvaluateExpr(null)}) {
6445	if (!evaluate::IsNullProcedurePointer(&*nullInit) &&
6446	!evaluate::IsBareNullPointer(&*nullInit)) {
6447	Say(null.v.value().source,
6448	"Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US);
6449	}
6450	}
6451	return false;
6452	}
6453	}
6454	void DeclarationVisitor::Post(const parser::ProcInterface &x) {
6455	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
6456	interfaceName_ = name;
6457	NoteInterfaceName(*name);
6458	}
6459	}
6460	void DeclarationVisitor::Post(const parser::ProcDecl &x) {
6461	const auto &name{std::get<parser::Name>(x.t)};
6462	// Don't use BypassGeneric or GetUltimate on this symbol, they can
6463	// lead to unusable names in module files.
6464	const Symbol *procInterface{
6465	interfaceName_ ? interfaceName_->symbol : nullptr};
6466	auto attrs{HandleSaveName(name.source, GetAttrs())};
6467	DerivedTypeDetails *dtDetails{nullptr};
6468	if (Symbol * symbol{currScope().symbol()}) {
6469	dtDetails = symbol->detailsIf<DerivedTypeDetails>();
6470	}
6471	if (!dtDetails) {
6472	attrs.set(Attr::EXTERNAL);
6473	}
6474	if (derivedTypeInfo_.privateComps &&
6475	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
6476	attrs.set(Attr::PRIVATE);
6477	}
6478	Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
6479	SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
6480	symbol.ReplaceName(name.source);
6481	if (dtDetails) {
6482	dtDetails->add_component(symbol);
6483	}
6484	DeclaredPossibleSpecificProc(symbol);
6485	}
6486
6487	bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {
6488	derivedTypeInfo_.sawContains = true;
6489	return true;
6490	}
6491
6492	// Resolve binding names from type-bound generics, saved in genericBindings_.
6493	void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) {
6494	// track specifics seen for the current generic to detect duplicates:
6495	const Symbol *currGeneric{nullptr};
6496	std::set<SourceName> specifics;
6497	for (const auto &[generic, bindingName] : genericBindings_) {
6498	if (generic != currGeneric) {
6499	currGeneric = generic;
6500	specifics.clear();
6501	}
6502	auto [it, inserted]{specifics.insert(bindingName->source)};
6503	if (!inserted) {
6504	Say(*bindingName, // C773
6505	"Binding name '%s' was already specified for generic '%s'"_err_en_US,
6506	bindingName->source, generic->name())
6507	.Attach(*it, "Previous specification of '%s'"_en_US, *it);
6508	continue;
6509	}
6510	auto *symbol{FindInTypeOrParents(*bindingName)};
6511	if (!symbol) {
6512	Say(*bindingName, // C772
6513	"Binding name '%s' not found in this derived type"_err_en_US);
6514	} else if (!symbol->has<ProcBindingDetails>()) {
6515	SayWithDecl(*bindingName, *symbol, // C772
6516	"'%s' is not the name of a specific binding of this type"_err_en_US);
6517	} else {
6518	generic->get<GenericDetails>().AddSpecificProc(
6519	*symbol, bindingName->source);
6520	}
6521	}
6522	genericBindings_.clear();
6523	}
6524
6525	void DeclarationVisitor::Post(const parser::ContainsStmt &) {
6526	if (derivedTypeInfo_.sequence) {
6527	Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740
6528	}
6529	}
6530
6531	void DeclarationVisitor::Post(
6532	const parser::TypeBoundProcedureStmt::WithoutInterface &x) {
6533	if (GetAttrs().test(Attr::DEFERRED)) { // C783
6534	Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US);
6535	}
6536	for (auto &declaration : x.declarations) {
6537	auto &bindingName{std::get<parser::Name>(declaration.t)};
6538	auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};
6539	const parser::Name &procedureName{optName ? *optName : bindingName};
6540	Symbol *procedure{FindSymbol(procedureName)};
6541	if (!procedure) {
6542	procedure = NoteInterfaceName(procedureName);
6543	}
6544	if (procedure) {
6545	const Symbol &bindTo{BypassGeneric(*procedure)};
6546	if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) {
6547	SetPassNameOn(*s);
6548	if (GetAttrs().test(Attr::DEFERRED)) {
6549	context().SetError(*s);
6550	}
6551	}
6552	}
6553	}
6554	}
6555
6556	void DeclarationVisitor::CheckBindings(
6557	const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
6558	CHECK(currScope().IsDerivedType());
6559	for (auto &declaration : tbps.declarations) {
6560	auto &bindingName{std::get<parser::Name>(declaration.t)};
6561	if (Symbol * binding{FindInScope(bindingName)}) {
6562	if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {
6563	const Symbol &ultimate{details->symbol().GetUltimate()};
6564	const Symbol &procedure{BypassGeneric(ultimate)};
6565	if (&procedure != &ultimate) {
6566	details->ReplaceSymbol(procedure);
6567	}
6568	if (!CanBeTypeBoundProc(procedure)) {
6569	if (details->symbol().name() != binding->name()) {
6570	Say(binding->name(),
6571	"The binding of '%s' ('%s') must be either an accessible "
6572	"module procedure or an external procedure with "
6573	"an explicit interface"_err_en_US,
6574	binding->name(), details->symbol().name());
6575	} else {
6576	Say(binding->name(),
6577	"'%s' must be either an accessible module procedure "
6578	"or an external procedure with an explicit interface"_err_en_US,
6579	binding->name());
6580	}
6581	context().SetError(*binding);
6582	}
6583	}
6584	}
6585	}
6586	}
6587
6588	void DeclarationVisitor::Post(
6589	const parser::TypeBoundProcedureStmt::WithInterface &x) {
6590	if (!GetAttrs().test(Attr::DEFERRED)) { // C783
6591	Say("DEFERRED is required when an interface-name is provided"_err_en_US);
6592	}
6593	if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) {
6594	for (auto &bindingName : x.bindingNames) {
6595	if (auto *s{
6596	MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) {
6597	SetPassNameOn(*s);
6598	if (!GetAttrs().test(Attr::DEFERRED)) {
6599	context().SetError(*s);
6600	}
6601	}
6602	}
6603	}
6604	}
6605
6606	bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) {
6607	if (currScope().IsDerivedType() && currScope().symbol()) {
6608	if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) {
6609	for (const auto &subrName : x.v) {
6610	Symbol *symbol{FindSymbol(subrName)};
6611	if (!symbol) {
6612	// FINAL procedures must be module subroutines
6613	symbol = &MakeSymbol(
6614	currScope().parent(), subrName.source, Attrs{Attr::MODULE});
6615	Resolve(subrName, symbol);
6616	symbol->set_details(ProcEntityDetails{});
6617	symbol->set(Symbol::Flag::Subroutine);
6618	}
6619	if (auto pair{details->finals().emplace(subrName.source, *symbol)};
6620	!pair.second) { // C787
6621	Say(subrName.source,
6622	"FINAL subroutine '%s' already appeared in this derived type"_err_en_US,
6623	subrName.source)
6624	.Attach(pair.first->first,
6625	"earlier appearance of this FINAL subroutine"_en_US);
6626	}
6627	}
6628	}
6629	}
6630	return false;
6631	}
6632
6633	bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
6634	const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)};
6635	const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};
6636	const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)};
6637	GenericSpecInfo info{genericSpec.value()};
6638	SourceName symbolName{info.symbolName()};
6639	bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private
6640	: derivedTypeInfo_.privateBindings};
6641	auto *genericSymbol{FindInScope(symbolName)};
6642	if (genericSymbol) {
6643	if (!genericSymbol->has<GenericDetails>()) {
6644	genericSymbol = nullptr; // MakeTypeSymbol will report the error below
6645	}
6646	} else {
6647	// look in ancestor types for a generic of the same name
6648	for (const auto &name : GetAllNames(context(), symbolName)) {
6649	if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) {
6650	if (inherited->has<GenericDetails>()) {
6651	CheckAccessibility(symbolName, isPrivate, *inherited); // C771
6652	} else {
6653	Say(symbolName,
6654	"Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US)
6655	.Attach(inherited->name(), "Inherited symbol"_en_US);
6656	}
6657	break;
6658	}
6659	}
6660	}
6661	if (genericSymbol) {
6662	CheckAccessibility(name: symbolName, isPrivate, symbol&: *genericSymbol); // C771
6663	} else {
6664	genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{});
6665	if (!genericSymbol) {
6666	return false;
6667	}
6668	if (isPrivate) {
6669	SetExplicitAttr(*genericSymbol, Attr::PRIVATE);
6670	}
6671	}
6672	for (const parser::Name &bindingName : bindingNames) {
6673	genericBindings_.emplace(genericSymbol, &bindingName);
6674	}
6675	info.Resolve(genericSymbol);
6676	return false;
6677	}
6678
6679	// DEC STRUCTUREs are handled thus to allow for nested definitions.
6680	bool DeclarationVisitor::Pre(const parser::StructureDef &def) {
6681	const auto &structureStatement{
6682	std::get<parser::Statement<parser::StructureStmt>>(def.t)};
6683	auto saveDerivedTypeInfo{derivedTypeInfo_};
6684	derivedTypeInfo_ = {};
6685	derivedTypeInfo_.isStructure = true;
6686	derivedTypeInfo_.sequence = true;
6687	Scope *previousStructure{nullptr};
6688	if (saveDerivedTypeInfo.isStructure) {
6689	previousStructure = &currScope();
6690	PopScope();
6691	}
6692	const parser::StructureStmt &structStmt{structureStatement.statement};
6693	const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};
6694	if (!name) {
6695	// Construct a distinct generated name for an anonymous structure
6696	auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};
6697	mutableName.emplace(
6698	parser::Name{context().GetTempName(currScope()), nullptr});
6699	}
6700	auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};
6701	symbol.ReplaceName(name->source);
6702	symbol.get<DerivedTypeDetails>().set_sequence(true);
6703	symbol.get<DerivedTypeDetails>().set_isDECStructure(true);
6704	derivedTypeInfo_.type = &symbol;
6705	PushScope(Scope::Kind::DerivedType, &symbol);
6706	const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};
6707	Walk(fields);
6708	PopScope();
6709	// Complete the definition
6710	DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};
6711	derivedTypeSpec.set_scope(DEREF(symbol.scope()));
6712	derivedTypeSpec.CookParameters(GetFoldingContext());
6713	derivedTypeSpec.EvaluateParameters(context());
6714	DeclTypeSpec &type{currScope().MakeDerivedType(
6715	DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};
6716	type.derivedTypeSpec().Instantiate(currScope());
6717	// Restore previous structure definition context, if any
6718	derivedTypeInfo_ = saveDerivedTypeInfo;
6719	if (previousStructure) {
6720	PushScope(*previousStructure);
6721	}
6722	// Handle any entity declarations on the STRUCTURE statement
6723	const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};
6724	if (!decls.empty()) {
6725	BeginDecl();
6726	SetDeclTypeSpec(type);
6727	Walk(decls);
6728	EndDecl();
6729	}
6730	return false;
6731	}
6732
6733	bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {
6734	Say("support for UNION"_todo_en_US); // TODO
6735	return true;
6736	}
6737
6738	bool DeclarationVisitor::Pre(const parser::StructureField &x) {
6739	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
6740	x.u)) {
6741	BeginDecl();
6742	}
6743	return true;
6744	}
6745
6746	void DeclarationVisitor::Post(const parser::StructureField &x) {
6747	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
6748	x.u)) {
6749	EndDecl();
6750	}
6751	}
6752
6753	bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
6754	BeginDeclTypeSpec();
6755	return true;
6756	}
6757	void DeclarationVisitor::Post(const parser::AllocateStmt &) {
6758	EndDeclTypeSpec();
6759	}
6760
6761	bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
6762	auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};
6763	const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};
6764	if (!type) {
6765	return false;
6766	}
6767	const DerivedTypeSpec *spec{type->AsDerived()};
6768	const Scope *typeScope{spec ? spec->scope() : nullptr};
6769	if (!typeScope) {
6770	return false;
6771	}
6772
6773	// N.B C7102 is implicitly enforced by having inaccessible types not
6774	// being found in resolution.
6775	// More constraints are enforced in expression.cpp so that they
6776	// can apply to structure constructors that have been converted
6777	// from misparsed function references.
6778	for (const auto &component :
6779	std::get<std::list<parser::ComponentSpec>>(x.t)) {
6780	// Visit the component spec expression, but not the keyword, since
6781	// we need to resolve its symbol in the scope of the derived type.
6782	Walk(std::get<parser::ComponentDataSource>(component.t));
6783	if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
6784	FindInTypeOrParents(*typeScope, kw->v);
6785	}
6786	}
6787	return false;
6788	}
6789
6790	bool DeclarationVisitor::Pre(const parser::BasedPointer &) {
6791	BeginArraySpec();
6792	return true;
6793	}
6794
6795	void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
6796	const parser::ObjectName &pointerName{std::get<0>(bp.t)};
6797	auto *pointer{FindInScope(pointerName)};
6798	if (!pointer) {
6799	pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
6800	} else if (!ConvertToObjectEntity(symbol&: *pointer)) {
6801	SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
6802	} else if (IsNamedConstant(*pointer)) {
6803	SayWithDecl(pointerName, *pointer,
6804	"'%s' is a named constant and may not be a Cray pointer"_err_en_US);
6805	} else if (pointer->Rank() > 0) {
6806	SayWithDecl(
6807	pointerName, *pointer, "Cray pointer '%s' must be a scalar"_err_en_US);
6808	} else if (pointer->test(Symbol::Flag::CrayPointee)) {
6809	Say(pointerName,
6810	"'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
6811	}
6812	pointer->set(Symbol::Flag::CrayPointer);
6813	const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer,
6814	context().targetCharacteristics().integerKindForPointer())};
6815	const auto *type{pointer->GetType()};
6816	if (!type) {
6817	pointer->SetType(pointerType);
6818	} else if (*type != pointerType) {
6819	Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
6820	pointerName.source, pointerType.AsFortran());
6821	}
6822	const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
6823	DeclareObjectEntity(pointeeName);
6824	if (Symbol * pointee{pointeeName.symbol}) {
6825	if (!ConvertToObjectEntity(*pointee)) {
6826	return;
6827	}
6828	if (IsNamedConstant(*pointee)) {
6829	Say(pointeeName,
6830	"'%s' is a named constant and may not be a Cray pointee"_err_en_US);
6831	return;
6832	}
6833	if (pointee->test(Symbol::Flag::CrayPointer)) {
6834	Say(pointeeName,
6835	"'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
6836	} else if (pointee->test(Symbol::Flag::CrayPointee)) {
6837	Say(pointeeName, "'%s' was already declared as a Cray pointee"_err_en_US);
6838	} else {
6839	pointee->set(Symbol::Flag::CrayPointee);
6840	}
6841	if (const auto *pointeeType{pointee->GetType()}) {
6842	if (const auto *derived{pointeeType->AsDerived()}) {
6843	if (!IsSequenceOrBindCType(derived)) {
6844	context().Warn(common::LanguageFeature::NonSequenceCrayPointee,
6845	pointeeName.source,
6846	"Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US,
6847	pointeeName.source);
6848	}
6849	}
6850	}
6851	currScope().add_crayPointer(pointeeName.source, *pointer);
6852	}
6853	}
6854
6855	bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
6856	if (!CheckNotInBlock(stmt: "NAMELIST")) { // C1107
6857	return false;
6858	}
6859	const auto &groupName{std::get<parser::Name>(x.t)};
6860	auto *groupSymbol{FindInScope(groupName)};
6861	if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) {
6862	groupSymbol = &MakeSymbol(groupName, NamelistDetails{});
6863	groupSymbol->ReplaceName(groupName.source);
6864	}
6865	// Name resolution of group items is deferred to FinishNamelists()
6866	// so that host association is handled correctly.
6867	GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x);
6868	return false;
6869	}
6870
6871	void DeclarationVisitor::FinishNamelists() {
6872	if (auto *deferred{GetDeferredDeclarationState()}) {
6873	for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) {
6874	if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) {
6875	if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) {
6876	for (const auto &name : std::get<std::list<parser::Name>>(group->t)) {
6877	auto *symbol{FindSymbol(name)};
6878	if (!symbol) {
6879	symbol = &MakeSymbol(name, ObjectEntityDetails{});
6880	ApplyImplicitRules(*symbol);
6881	} else if (!ConvertToObjectEntity(symbol->GetUltimate())) {
6882	SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
6883	context().SetError(*groupSymbol);
6884	}
6885	symbol->GetUltimate().set(Symbol::Flag::InNamelist);
6886	details->add_object(*symbol);
6887	}
6888	}
6889	}
6890	}
6891	deferred->namelistGroups.clear();
6892	}
6893	}
6894
6895	bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {
6896	if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
6897	auto *symbol{FindSymbol(*name)};
6898	if (!symbol) {
6899	Say(*name, "Namelist group '%s' not found"_err_en_US);
6900	} else if (!symbol->GetUltimate().has<NamelistDetails>()) {
6901	SayWithDecl(
6902	*name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
6903	}
6904	}
6905	return true;
6906	}
6907
6908	bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {
6909	CheckNotInBlock(stmt: "COMMON"); // C1107
6910	return true;
6911	}
6912
6913	bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {
6914	BeginArraySpec();
6915	return true;
6916	}
6917
6918	void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {
6919	const auto &name{std::get<parser::Name>(x.t)};
6920	if (auto *symbol{FindSymbol(name)}) {
6921	symbol->set(Symbol::Flag::InCommonBlock);
6922	}
6923	DeclareObjectEntity(name);
6924	auto pair{specPartState_.commonBlockObjects.insert(name.source)};
6925	if (!pair.second) {
6926	const SourceName &prev{*pair.first};
6927	Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,
6928	"Previous occurrence of '%s' in a COMMON block"_en_US);
6929	}
6930	}
6931
6932	bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {
6933	// save equivalence sets to be processed after specification part
6934	if (CheckNotInBlock(stmt: "EQUIVALENCE")) { // C1107
6935	for (const std::list<parser::EquivalenceObject> &set : x.v) {
6936	specPartState_.equivalenceSets.push_back(&set);
6937	}
6938	}
6939	return false; // don't implicitly declare names yet
6940	}
6941
6942	void DeclarationVisitor::CheckEquivalenceSets() {
6943	EquivalenceSets equivSets{context()};
6944	inEquivalenceStmt_ = true;
6945	for (const auto *set : specPartState_.equivalenceSets) {
6946	const auto &source{set->front().v.value().source};
6947	if (set->size() <= 1) { // R871
6948	Say(source, "Equivalence set must have more than one object"_err_en_US);
6949	}
6950	for (const parser::EquivalenceObject &object : *set) {
6951	const auto &designator{object.v.value()};
6952	// The designator was not resolved when it was encountered, so do it now.
6953	// AnalyzeExpr causes array sections to be changed to substrings as needed
6954	Walk(designator);
6955	if (AnalyzeExpr(context(), designator)) {
6956	equivSets.AddToSet(designator);
6957	}
6958	}
6959	equivSets.FinishSet(source);
6960	}
6961	inEquivalenceStmt_ = false;
6962	for (auto &set : equivSets.sets()) {
6963	if (!set.empty()) {
6964	currScope().add_equivalenceSet(std::move(set));
6965	}
6966	}
6967	specPartState_.equivalenceSets.clear();
6968	}
6969
6970	bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {
6971	if (x.v.empty()) {
6972	specPartState_.saveInfo.saveAll = currStmtSource();
6973	currScope().set_hasSAVE();
6974	} else {
6975	for (const parser::SavedEntity &y : x.v) {
6976	auto kind{std::get<parser::SavedEntity::Kind>(y.t)};
6977	const auto &name{std::get<parser::Name>(y.t)};
6978	if (kind == parser::SavedEntity::Kind::Common) {
6979	MakeCommonBlockSymbol(name);
6980	AddSaveName(specPartState_.saveInfo.commons, name.source);
6981	} else {
6982	HandleAttributeStmt(Attr::SAVE, name);
6983	}
6984	}
6985	}
6986	return false;
6987	}
6988
6989	void DeclarationVisitor::CheckSaveStmts() {
6990	for (const SourceName &name : specPartState_.saveInfo.entities) {
6991	auto *symbol{FindInScope(name)};
6992	if (!symbol) {
6993	// error was reported
6994	} else if (specPartState_.saveInfo.saveAll) {
6995	// C889 - note that pgi, ifort, xlf do not enforce this constraint
6996	if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
6997	Say2(name,
6998	"Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US,
6999	*specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US)
7000	.set_languageFeature(common::LanguageFeature::RedundantAttribute);
7001	}
7002	} else if (!IsSaved(*symbol)) {
7003	SetExplicitAttr(*symbol, Attr::SAVE);
7004	}
7005	}
7006	for (const SourceName &name : specPartState_.saveInfo.commons) {
7007	if (auto *symbol{currScope().FindCommonBlock(name)}) {
7008	auto &objects{symbol->get<CommonBlockDetails>().objects()};
7009	if (objects.empty()) {
7010	if (currScope().kind() != Scope::Kind::BlockConstruct) {
7011	Say(name,
7012	"'%s' appears as a COMMON block in a SAVE statement but not in"
7013	" a COMMON statement"_err_en_US);
7014	} else { // C1108
7015	Say(name,
7016	"SAVE statement in BLOCK construct may not contain a"
7017	" common block name '%s'"_err_en_US);
7018	}
7019	} else {
7020	for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
7021	if (!IsSaved(*object)) {
7022	SetImplicitAttr(*object, Attr::SAVE);
7023	}
7024	}
7025	}
7026	}
7027	}
7028	specPartState_.saveInfo = {};
7029	}
7030
7031	// Record SAVEd names in specPartState_.saveInfo.entities.
7032	Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) {
7033	if (attrs.test(Attr::SAVE)) {
7034	AddSaveName(specPartState_.saveInfo.entities, name);
7035	}
7036	return attrs;
7037	}
7038
7039	// Record a name in a set of those to be saved.
7040	void DeclarationVisitor::AddSaveName(
7041	std::set<SourceName> &set, const SourceName &name) {
7042	auto pair{set.insert(x: name)};
7043	if (!pair.second &&
7044	context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
7045	Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US,
7046	*pair.first, "Previous specification of SAVE attribute"_en_US)
7047	.set_languageFeature(common::LanguageFeature::RedundantAttribute);
7048	}
7049	}
7050
7051	// Check types of common block objects, now that they are known.
7052	void DeclarationVisitor::CheckCommonBlocks() {
7053	// check for empty common blocks
7054	for (const auto &pair : currScope().commonBlocks()) {
7055	const auto &symbol{*pair.second};
7056	if (symbol.get<CommonBlockDetails>().objects().empty() &&
7057	symbol.attrs().test(Attr::BIND_C)) {
7058	Say(symbol.name(),
7059	"'%s' appears as a COMMON block in a BIND statement but not in"
7060	" a COMMON statement"_err_en_US);
7061	}
7062	}
7063	// check objects in common blocks
7064	for (const auto &name : specPartState_.commonBlockObjects) {
7065	const auto *symbol{currScope().FindSymbol(name)};
7066	if (!symbol) {
7067	continue;
7068	}
7069	const auto &attrs{symbol->attrs()};
7070	if (attrs.test(Attr::ALLOCATABLE)) {
7071	Say(name,
7072	"ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
7073	} else if (attrs.test(Attr::BIND_C)) {
7074	Say(name,
7075	"Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
7076	} else if (IsNamedConstant(*symbol)) {
7077	Say(name,
7078	"A named constant '%s' may not appear in a COMMON block"_err_en_US);
7079	} else if (IsDummy(*symbol)) {
7080	Say(name,
7081	"Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
7082	} else if (symbol->IsFuncResult()) {
7083	Say(name,
7084	"Function result '%s' may not appear in a COMMON block"_err_en_US);
7085	} else if (const DeclTypeSpec * type{symbol->GetType()}) {
7086	if (type->category() == DeclTypeSpec::ClassStar) {
7087	Say(name,
7088	"Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US);
7089	} else if (const auto *derived{type->AsDerived()}) {
7090	if (!IsSequenceOrBindCType(derived)) {
7091	Say(name,
7092	"Derived type '%s' in COMMON block must have the BIND or"
7093	" SEQUENCE attribute"_err_en_US);
7094	}
7095	UnorderedSymbolSet typeSet;
7096	CheckCommonBlockDerivedType(name, derived->typeSymbol(), typeSet);
7097	}
7098	}
7099	}
7100	specPartState_.commonBlockObjects = {};
7101	}
7102
7103	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
7104	return Resolve(name, currScope().MakeCommonBlock(name.source));
7105	}
7106	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
7107	const std::optional<parser::Name> &name) {
7108	if (name) {
7109	return MakeCommonBlockSymbol(name: *name);
7110	} else {
7111	return MakeCommonBlockSymbol(name: parser::Name{});
7112	}
7113	}
7114
7115	bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
7116	return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
7117	}
7118
7119	// Check if this derived type can be in a COMMON block.
7120	void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name,
7121	const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) {
7122	if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) {
7123	return;
7124	}
7125	typeSet.emplace(typeSymbol);
7126	if (const auto *scope{typeSymbol.scope()}) {
7127	for (const auto &pair : *scope) {
7128	const Symbol &component{*pair.second};
7129	if (component.attrs().test(Attr::ALLOCATABLE)) {
7130	Say2(name,
7131	"Derived type variable '%s' may not appear in a COMMON block"
7132	" due to ALLOCATABLE component"_err_en_US,
7133	component.name(), "Component with ALLOCATABLE attribute"_en_US);
7134	return;
7135	}
7136	const auto *details{component.detailsIf<ObjectEntityDetails>()};
7137	if (component.test(Symbol::Flag::InDataStmt) ||
7138	(details && details->init())) {
7139	Say2(name,
7140	"Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
7141	component.name(), "Component with default initialization"_en_US);
7142	return;
7143	}
7144	if (details) {
7145	if (const auto *type{details->type()}) {
7146	if (const auto *derived{type->AsDerived()}) {
7147	const Symbol &derivedTypeSymbol{derived->typeSymbol()};
7148	CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet);
7149	}
7150	}
7151	}
7152	}
7153	}
7154	}
7155
7156	bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
7157	const parser::Name &name) {
7158	if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
7159	name.source.ToString())}) {
7160	// Unrestricted specific intrinsic function names (e.g., "cos")
7161	// are acceptable as procedure interfaces. The presence of the
7162	// INTRINSIC flag will cause this symbol to have a complete interface
7163	// recreated for it later on demand, but capturing its result type here
7164	// will make GetType() return a correct result without having to
7165	// probe the intrinsics table again.
7166	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
7167	SetImplicitAttr(symbol, Attr::INTRINSIC);
7168	CHECK(interface->functionResult.has_value());
7169	evaluate::DynamicType dyType{
7170	DEREF(interface->functionResult->GetTypeAndShape()).type()};
7171	CHECK(common::IsNumericTypeCategory(dyType.category()));
7172	const DeclTypeSpec &typeSpec{
7173	MakeNumericType(dyType.category(), dyType.kind())};
7174	ProcEntityDetails details;
7175	details.set_type(typeSpec);
7176	symbol.set_details(std::move(details));
7177	symbol.set(Symbol::Flag::Function);
7178	if (interface->IsElemental()) {
7179	SetExplicitAttr(symbol, Attr::ELEMENTAL);
7180	}
7181	if (interface->IsPure()) {
7182	SetExplicitAttr(symbol, Attr::PURE);
7183	}
7184	Resolve(name, symbol);
7185	return true;
7186	} else {
7187	return false;
7188	}
7189	}
7190
7191	// Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED
7192	bool DeclarationVisitor::PassesSharedLocalityChecks(
7193	const parser::Name &name, Symbol &symbol) {
7194	if (!IsVariableName(symbol)) {
7195	SayLocalMustBeVariable(name, symbol); // C1124
7196	return false;
7197	}
7198	if (symbol.owner() == currScope()) { // C1125 and C1126
7199	SayAlreadyDeclared(name, symbol);
7200	return false;
7201	}
7202	return true;
7203	}
7204
7205	// Checks for locality-specs LOCAL, LOCAL_INIT, and REDUCE
7206	bool DeclarationVisitor::PassesLocalityChecks(
7207	const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
7208	bool isReduce{flag == Symbol::Flag::LocalityReduce};
7209	const char *specName{
7210	flag == Symbol::Flag::LocalityLocalInit ? "LOCAL_INIT" : "LOCAL"};
7211	if (IsAllocatable(symbol) && !isReduce) { // F'2023 C1130
7212	SayWithDecl(name, symbol,
7213	"ALLOCATABLE variable '%s' not allowed in a %s locality-spec"_err_en_US,
7214	specName);
7215	return false;
7216	}
7217	if (IsOptional(symbol)) { // F'2023 C1130-C1131
7218	SayWithDecl(name, symbol,
7219	"OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
7220	return false;
7221	}
7222	if (IsIntentIn(symbol)) { // F'2023 C1130-C1131
7223	SayWithDecl(name, symbol,
7224	"INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
7225	return false;
7226	}
7227	if (IsFinalizable(symbol) && !isReduce) { // F'2023 C1130
7228	SayWithDecl(name, symbol,
7229	"Finalizable variable '%s' not allowed in a %s locality-spec"_err_en_US,
7230	specName);
7231	return false;
7232	}
7233	if (evaluate::IsCoarray(symbol) && !isReduce) { // F'2023 C1130
7234	SayWithDecl(name, symbol,
7235	"Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);
7236	return false;
7237	}
7238	if (const DeclTypeSpec * type{symbol.GetType()}) {
7239	if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
7240	!isReduce) { // F'2023 C1130
7241	SayWithDecl(name, symbol,
7242	"Nonpointer polymorphic argument '%s' not allowed in a %s locality-spec"_err_en_US,
7243	specName);
7244	return false;
7245	}
7246	}
7247	if (symbol.attrs().test(Attr::ASYNCHRONOUS) && isReduce) { // F'2023 C1131
7248	SayWithDecl(name, symbol,
7249	"ASYNCHRONOUS variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);
7250	return false;
7251	}
7252	if (symbol.attrs().test(Attr::VOLATILE) && isReduce) { // F'2023 C1131
7253	SayWithDecl(name, symbol,
7254	"VOLATILE variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);
7255	return false;
7256	}
7257	if (IsAssumedSizeArray(symbol)) { // F'2023 C1130-C1131
7258	SayWithDecl(name, symbol,
7259	"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
7260	return false;
7261	}
7262	if (std::optional<Message> whyNot{WhyNotDefinable(
7263	name.source, currScope(), DefinabilityFlags{}, symbol)}) {
7264	SayWithReason(name, symbol,
7265	"'%s' may not appear in a locality-spec because it is not definable"_err_en_US,
7266	std::move(whyNot->set_severity(parser::Severity::Because)));
7267	return false;
7268	}
7269	return PassesSharedLocalityChecks(name, symbol);
7270	}
7271
7272	Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
7273	const parser::Name &name) {
7274	Symbol *prev{FindSymbol(name)};
7275	if (!prev) {
7276	// Declare the name as an object in the enclosing scope so that
7277	// the name can't be repurposed there later as something else.
7278	prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
7279	ConvertToObjectEntity(*prev);
7280	ApplyImplicitRules(*prev);
7281	}
7282	return *prev;
7283	}
7284
7285	void DeclarationVisitor::DeclareLocalEntity(
7286	const parser::Name &name, Symbol::Flag flag) {
7287	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
7288	if (PassesLocalityChecks(name, prev, flag)) {
7289	if (auto *symbol{&MakeHostAssocSymbol(name, prev)}) {
7290	symbol->set(flag);
7291	}
7292	}
7293	}
7294
7295	Symbol *DeclarationVisitor::DeclareStatementEntity(
7296	const parser::DoVariable &doVar,
7297	const std::optional<parser::IntegerTypeSpec> &type) {
7298	const parser::Name &name{doVar.thing.thing};
7299	const DeclTypeSpec *declTypeSpec{nullptr};
7300	if (auto *prev{FindSymbol(name)}) {
7301	if (prev->owner() == currScope()) {
7302	SayAlreadyDeclared(name, *prev);
7303	return nullptr;
7304	}
7305	name.symbol = nullptr;
7306	// F'2023 19.4 p5 ambiguous rule about outer declarations
7307	declTypeSpec = prev->GetType();
7308	}
7309	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
7310	if (!symbol.has<ObjectEntityDetails>()) {
7311	return nullptr; // error was reported in DeclareEntity
7312	}
7313	if (type) {
7314	declTypeSpec = ProcessTypeSpec(*type);
7315	}
7316	if (declTypeSpec) {
7317	// Subtlety: Don't let a "*length" specifier (if any is pending) affect the
7318	// declaration of this implied DO loop control variable.
7319	auto restorer{
7320	common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};
7321	SetType(name, *declTypeSpec);
7322	} else {
7323	ApplyImplicitRules(symbol);
7324	}
7325	return Resolve(name, &symbol);
7326	}
7327
7328	// Set the type of an entity or report an error.
7329	void DeclarationVisitor::SetType(
7330	const parser::Name &name, const DeclTypeSpec &type) {
7331	CHECK(name.symbol);
7332	auto &symbol{*name.symbol};
7333	if (charInfo_.length) { // Declaration has "*length" (R723)
7334	auto length{std::move(*charInfo_.length)};
7335	charInfo_.length.reset();
7336	if (type.category() == DeclTypeSpec::Character) {
7337	auto kind{type.characterTypeSpec().kind()};
7338	// Recurse with correct type.
7339	SetType(name,
7340	currScope().MakeCharacterType(std::move(length), std::move(kind)));
7341	return;
7342	} else { // C753
7343	Say(name,
7344	"A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
7345	}
7346	}
7347	if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
7348	if (proc->procInterface()) {
7349	Say(name,
7350	"'%s' has an explicit interface and may not also have a type"_err_en_US);
7351	context().SetError(symbol);
7352	return;
7353	}
7354	}
7355	auto *prevType{symbol.GetType()};
7356	if (!prevType) {
7357	if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType()) {
7358	context().Warn(common::LanguageFeature::ForwardRefImplicitNoneData,
7359	name.source,
7360	"'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US,
7361	name.source);
7362	}
7363	symbol.SetType(type);
7364	} else if (symbol.has<UseDetails>()) {
7365	// error recovery case, redeclaration of use-associated name
7366	} else if (HadForwardRef(symbol: symbol)) {
7367	// error recovery after use of host-associated name
7368	} else if (!symbol.test(Symbol::Flag::Implicit)) {
7369	SayWithDecl(
7370	name, symbol, "The type of '%s' has already been declared"_err_en_US);
7371	context().SetError(symbol);
7372	} else if (type != *prevType) {
7373	SayWithDecl(name, symbol,
7374	"The type of '%s' has already been implicitly declared"_err_en_US);
7375	context().SetError(symbol);
7376	} else {
7377	symbol.set(Symbol::Flag::Implicit, false);
7378	}
7379	}
7380
7381	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
7382	const parser::Name &name) {
7383	Scope &outer{NonDerivedTypeScope()};
7384	Symbol *symbol{FindSymbol(outer, name)};
7385	Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
7386	auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
7387	if (generic) {
7388	if (Symbol * genDT{generic->derivedType()}) {
7389	symbol = genDT;
7390	generic = nullptr;
7391	}
7392	}
7393	if (!symbol || symbol->has<UnknownDetails>() ||
7394	(generic && &ultimate->owner() == &outer)) {
7395	if (allowForwardReferenceToDerivedType()) {
7396	if (!symbol) {
7397	symbol = &MakeSymbol(outer, name.source, Attrs{});
7398	Resolve(name, *symbol);
7399	} else if (generic) {
7400	// forward ref to type with later homonymous generic
7401	symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
7402	generic->set_derivedType(*symbol);
7403	name.symbol = symbol;
7404	}
7405	DerivedTypeDetails details;
7406	details.set_isForwardReferenced(true);
7407	symbol->set_details(std::move(details));
7408	} else { // C732
7409	Say(name, "Derived type '%s' not found"_err_en_US);
7410	return std::nullopt;
7411	}
7412	} else if (&DEREF(symbol).owner() != &outer &&
7413	!ultimate->has<GenericDetails>()) {
7414	// Prevent a later declaration in this scope of a host-associated
7415	// type name.
7416	outer.add_importName(name.source);
7417	}
7418	if (CheckUseError(name)) {
7419	return std::nullopt;
7420	} else if (symbol->GetUltimate().has<DerivedTypeDetails>()) {
7421	return DerivedTypeSpec{name.source, *symbol};
7422	} else {
7423	Say(name, "'%s' is not a derived type"_err_en_US);
7424	return std::nullopt;
7425	}
7426	}
7427
7428	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
7429	const parser::Name &typeName, const parser::Name *extendsName) {
7430	if (extendsName) {
7431	if (typeName.source == extendsName->source) {
7432	Say(extendsName->source,
7433	"Derived type '%s' cannot extend itself"_err_en_US);
7434	} else if (auto dtSpec{ResolveDerivedType(*extendsName)}) {
7435	if (!dtSpec->IsForwardReferenced()) {
7436	return dtSpec;
7437	}
7438	Say(typeName.source,
7439	"Derived type '%s' cannot extend type '%s' that has not yet been defined"_err_en_US,
7440	typeName.source, extendsName->source);
7441	}
7442	}
7443	return std::nullopt;
7444	}
7445
7446	Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
7447	// The symbol is checked later by CheckExplicitInterface() and
7448	// CheckBindings(). It can be a forward reference.
7449	if (!NameIsKnownOrIntrinsic(name)) {
7450	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
7451	Resolve(name, symbol);
7452	}
7453	return name.symbol;
7454	}
7455
7456	void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
7457	if (const Symbol * symbol{name.symbol}) {
7458	const Symbol &ultimate{symbol->GetUltimate()};
7459	if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
7460	!BypassGeneric(ultimate).HasExplicitInterface()) {
7461	Say(name,
7462	"'%s' must be an abstract interface or a procedure with an explicit interface"_err_en_US,
7463	symbol->name());
7464	}
7465	}
7466	}
7467
7468	// Create a symbol for a type parameter, component, or procedure binding in
7469	// the current derived type scope. Return false on error.
7470	Symbol *DeclarationVisitor::MakeTypeSymbol(
7471	const parser::Name &name, Details &&details) {
7472	return Resolve(name, MakeTypeSymbol(name.source, std::move(details)));
7473	}
7474	Symbol *DeclarationVisitor::MakeTypeSymbol(
7475	const SourceName &name, Details &&details) {
7476	Scope &derivedType{currScope()};
7477	CHECK(derivedType.IsDerivedType());
7478	if (auto *symbol{FindInScope(derivedType, name)}) { // C742
7479	Say2(name,
7480	"Type parameter, component, or procedure binding '%s'"
7481	" already defined in this type"_err_en_US,
7482	*symbol, "Previous definition of '%s'"_en_US);
7483	return nullptr;
7484	} else {
7485	auto attrs{GetAttrs()};
7486	// Apply binding-private-stmt if present and this is a procedure binding
7487	if (derivedTypeInfo_.privateBindings &&
7488	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
7489	std::holds_alternative<ProcBindingDetails>(details)) {
7490	attrs.set(Attr::PRIVATE);
7491	}
7492	Symbol &result{MakeSymbol(name, attrs, std::move(details))};
7493	SetCUDADataAttr(name, result, cudaDataAttr());
7494	return &result;
7495	}
7496	}
7497
7498	// Return true if it is ok to declare this component in the current scope.
7499	// Otherwise, emit an error and return false.
7500	bool DeclarationVisitor::OkToAddComponent(
7501	const parser::Name &name, const Symbol *extends) {
7502	for (const Scope *scope{&currScope()}; scope;) {
7503	CHECK(scope->IsDerivedType());
7504	if (auto *prev{FindInScope(*scope, name.source)}) {
7505	std::optional<parser::MessageFixedText> msg;
7506	std::optional<common::UsageWarning> warning;
7507	if (context().HasError(*prev)) { // don't pile on
7508	} else if (CheckAccessibleSymbol(currScope(), *prev)) {
7509	// inaccessible component -- redeclaration is ok
7510	if (extends) {
7511	// The parent type has a component of same name, but it remains
7512	// extensible outside its module since that component is PRIVATE.
7513	} else if (context().ShouldWarn(
7514	common::UsageWarning::RedeclaredInaccessibleComponent)) {
7515	msg =
7516	"Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US;
7517	warning = common::UsageWarning::RedeclaredInaccessibleComponent;
7518	}
7519	} else if (extends) {
7520	msg =
7521	"Type cannot be extended as it has a component named '%s'"_err_en_US;
7522	} else if (prev->test(Symbol::Flag::ParentComp)) {
7523	msg =
7524	"'%s' is a parent type of this type and so cannot be a component"_err_en_US;
7525	} else if (scope == &currScope()) {
7526	msg =
7527	"Component '%s' is already declared in this derived type"_err_en_US;
7528	} else {
7529	msg =
7530	"Component '%s' is already declared in a parent of this derived type"_err_en_US;
7531	}
7532	if (msg) {
7533	auto &said{Say2(name, std::move(*msg), *prev,
7534	"Previous declaration of '%s'"_en_US)};
7535	if (msg->severity() == parser::Severity::Error) {
7536	Resolve(name, *prev);
7537	return false;
7538	}
7539	if (warning) {
7540	said.set_usageWarning(*warning);
7541	}
7542	}
7543	}
7544	if (scope == &currScope() && extends) {
7545	// The parent component has not yet been added to the scope.
7546	scope = extends->scope();
7547	} else {
7548	scope = scope->GetDerivedTypeParent();
7549	}
7550	}
7551	return true;
7552	}
7553
7554	ParamValue DeclarationVisitor::GetParamValue(
7555	const parser::TypeParamValue &x, common::TypeParamAttr attr) {
7556	return common::visit(
7557	common::visitors{
7558	[=](const parser::ScalarIntExpr &x) { // C704
7559	return ParamValue{EvaluateIntExpr(x), attr};
7560	},
7561	[=](const parser::Star &) { return ParamValue::Assumed(attr); },
7562	[=](const parser::TypeParamValue::Deferred &) {
7563	return ParamValue::Deferred(attr);
7564	},
7565	},
7566	x.u);
7567	}
7568
7569	// ConstructVisitor implementation
7570
7571	void ConstructVisitor::ResolveIndexName(
7572	const parser::ConcurrentControl &control) {
7573	const parser::Name &name{std::get<parser::Name>(control.t)};
7574	auto *prev{FindSymbol(name)};
7575	if (prev) {
7576	if (prev->owner() == currScope()) {
7577	SayAlreadyDeclared(name, *prev);
7578	return;
7579	} else if (prev->owner().kind() == Scope::Kind::Forall &&
7580	context().ShouldWarn(
7581	common::LanguageFeature::OddIndexVariableRestrictions)) {
7582	SayWithDecl(name, *prev,
7583	"Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US)
7584	.set_languageFeature(
7585	common::LanguageFeature::OddIndexVariableRestrictions);
7586	}
7587	name.symbol = nullptr;
7588	}
7589	auto &symbol{DeclareObjectEntity(name)};
7590	if (symbol.GetType()) {
7591	// type came from explicit type-spec
7592	} else if (!prev) {
7593	ApplyImplicitRules(symbol&: symbol);
7594	} else {
7595	// Odd rules in F'2023 19.4 paras 6 & 8.
7596	Symbol &prevRoot{prev->GetUltimate()};
7597	if (const auto *type{prevRoot.GetType()}) {
7598	symbol.SetType(*type);
7599	} else {
7600	ApplyImplicitRules(symbol&: symbol);
7601	}
7602	if (prevRoot.has<ObjectEntityDetails>() ||
7603	ConvertToObjectEntity(prevRoot)) {
7604	if (prevRoot.IsObjectArray() &&
7605	context().ShouldWarn(
7606	common::LanguageFeature::OddIndexVariableRestrictions)) {
7607	SayWithDecl(name, *prev,
7608	"Index variable '%s' should be scalar in the enclosing scope"_port_en_US)
7609	.set_languageFeature(
7610	common::LanguageFeature::OddIndexVariableRestrictions);
7611	}
7612	} else if (!prevRoot.has<CommonBlockDetails>() &&
7613	context().ShouldWarn(
7614	common::LanguageFeature::OddIndexVariableRestrictions)) {
7615	SayWithDecl(name, *prev,
7616	"Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US)
7617	.set_languageFeature(
7618	common::LanguageFeature::OddIndexVariableRestrictions);
7619	}
7620	}
7621	EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
7622	}
7623
7624	// We need to make sure that all of the index-names get declared before the
7625	// expressions in the loop control are evaluated so that references to the
7626	// index-names in the expressions are correctly detected.
7627	bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
7628	BeginDeclTypeSpec();
7629	Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t));
7630	const auto &controls{
7631	std::get<std::list<parser::ConcurrentControl>>(header.t)};
7632	for (const auto &control : controls) {
7633	ResolveIndexName(control);
7634	}
7635	Walk(controls);
7636	Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t));
7637	EndDeclTypeSpec();
7638	return false;
7639	}
7640
7641	bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
7642	for (auto &name : x.v) {
7643	DeclareLocalEntity(name, Symbol::Flag::LocalityLocal);
7644	}
7645	return false;
7646	}
7647
7648	bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
7649	for (auto &name : x.v) {
7650	DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit);
7651	}
7652	return false;
7653	}
7654
7655	bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
7656	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
7657	DeclareLocalEntity(name, Symbol::Flag::LocalityReduce);
7658	}
7659	return false;
7660	}
7661
7662	bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
7663	for (const auto &name : x.v) {
7664	if (!FindSymbol(name)) {
7665	context().Warn(common::UsageWarning::ImplicitShared, name.source,
7666	"Variable '%s' with SHARED locality implicitly declared"_warn_en_US,
7667	name.source);
7668	}
7669	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
7670	if (PassesSharedLocalityChecks(name, prev)) {
7671	MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);
7672	}
7673	}
7674	return false;
7675	}
7676
7677	bool ConstructVisitor::Pre(const parser::AcSpec &x) {
7678	ProcessTypeSpec(x.type);
7679	Walk(x.values);
7680	return false;
7681	}
7682
7683	// Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the
7684	// enclosing ac-implied-do
7685	bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
7686	auto &values{std::get<std::list<parser::AcValue>>(x.t)};
7687	auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
7688	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
7689	auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
7690	// F'2018 has the scope of the implied DO variable covering the entire
7691	// implied DO production (19.4(5)), which seems wrong in cases where the name
7692	// of the implied DO variable appears in one of the bound expressions. Thus
7693	// this extension, which shrinks the scope of the variable to exclude the
7694	// expressions in the bounds.
7695	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
7696	Walk(bounds.lower);
7697	Walk(bounds.upper);
7698	Walk(bounds.step);
7699	EndCheckOnIndexUseInOwnBounds(restore: restore);
7700	PushScope(Scope::Kind::ImpliedDos, nullptr);
7701	DeclareStatementEntity(bounds.name, type);
7702	Walk(values);
7703	PopScope();
7704	return false;
7705	}
7706
7707	bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
7708	auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
7709	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
7710	auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
7711	// See comment in Pre(AcImpliedDo) above.
7712	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
7713	Walk(bounds.lower);
7714	Walk(bounds.upper);
7715	Walk(bounds.step);
7716	EndCheckOnIndexUseInOwnBounds(restore: restore);
7717	PushScope(Scope::Kind::ImpliedDos, nullptr);
7718	DeclareStatementEntity(bounds.name, type);
7719	Walk(objects);
7720	PopScope();
7721	return false;
7722	}
7723
7724	// Sets InDataStmt flag on a variable (or misidentified function) in a DATA
7725	// statement so that the predicate IsInitialized() will be true
7726	// during semantic analysis before the symbol's initializer is constructed.
7727	bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {
7728	common::visit(
7729	common::visitors{
7730	[&](const parser::Scalar<Indirection<parser::Designator>> &y) {
7731	Walk(y.thing.value());
7732	const parser::Name &first{parser::GetFirstName(y.thing.value())};
7733	if (first.symbol) {
7734	first.symbol->set(Symbol::Flag::InDataStmt);
7735	}
7736	},
7737	[&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); },
7738	},
7739	x.u);
7740	return false;
7741	}
7742
7743	bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
7744	// Subtle: DATA statements may appear in both the specification and
7745	// execution parts, but should be treated as if in the execution part
7746	// for purposes of implicit variable declaration vs. host association.
7747	// When a name first appears as an object in a DATA statement, it should
7748	// be implicitly declared locally as if it had been assigned.
7749	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
7750	common::visit(
7751	common::visitors{
7752	[&](const Indirection<parser::Variable> &y) {
7753	auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
7754	Walk(y.value());
7755	const parser::Name &first{parser::GetFirstName(y.value())};
7756	if (first.symbol) {
7757	first.symbol->set(Symbol::Flag::InDataStmt);
7758	}
7759	},
7760	[&](const parser::DataImpliedDo &y) {
7761	// Don't push scope here, since it's done when visiting
7762	// DataImpliedDo.
7763	Walk(y);
7764	},
7765	},
7766	x.u);
7767	return false;
7768	}
7769
7770	bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
7771	const auto &data{std::get<parser::DataStmtConstant>(x.t)};
7772	auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
7773	if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
7774	if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {
7775	if (const Symbol * symbol{FindSymbol(*name)};
7776	symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {
7777	mutableData.u = elem->ConvertToStructureConstructor(
7778	DerivedTypeSpec{name->source, *symbol});
7779	}
7780	}
7781	}
7782	return true;
7783	}
7784
7785	bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
7786	if (x.IsDoConcurrent()) {
7787	// The new scope has Kind::Forall for index variable name conflict
7788	// detection with nested FORALL/DO CONCURRENT constructs in
7789	// ResolveIndexName().
7790	PushScope(Scope::Kind::Forall, nullptr);
7791	}
7792	return true;
7793	}
7794	void ConstructVisitor::Post(const parser::DoConstruct &x) {
7795	if (x.IsDoConcurrent()) {
7796	PopScope();
7797	}
7798	}
7799
7800	bool ConstructVisitor::Pre(const parser::ForallConstruct &) {
7801	PushScope(Scope::Kind::Forall, nullptr);
7802	return true;
7803	}
7804	void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }
7805	bool ConstructVisitor::Pre(const parser::ForallStmt &) {
7806	PushScope(Scope::Kind::Forall, nullptr);
7807	return true;
7808	}
7809	void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }
7810
7811	bool ConstructVisitor::Pre(const parser::BlockConstruct &x) {
7812	const auto &[blockStmt, specPart, execPart, endBlockStmt] = x.t;
7813	Walk(blockStmt);
7814	CheckDef(blockStmt.statement.v);
7815	PushScope(Scope::Kind::BlockConstruct, nullptr);
7816	Walk(specPart);
7817	HandleImpliedAsynchronousInScope(execPart);
7818	Walk(execPart);
7819	Walk(endBlockStmt);
7820	PopScope();
7821	CheckRef(endBlockStmt.statement.v);
7822	return false;
7823	}
7824
7825	void ConstructVisitor::Post(const parser::Selector &x) {
7826	GetCurrentAssociation().selector = ResolveSelector(x);
7827	}
7828
7829	void ConstructVisitor::Post(const parser::AssociateStmt &x) {
7830	CheckDef(x.t);
7831	PushScope(Scope::Kind::OtherConstruct, nullptr);
7832	const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()};
7833	for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) {
7834	SetCurrentAssociation(nthLastAssoc);
7835	if (auto *symbol{MakeAssocEntity()}) {
7836	const MaybeExpr &expr{GetCurrentAssociation().selector.expr};
7837	if (ExtractCoarrayRef(expr)) { // C1103
7838	Say("Selector must not be a coindexed object"_err_en_US);
7839	}
7840	if (evaluate::IsAssumedRank(expr)) {
7841	Say("Selector must not be assumed-rank"_err_en_US);
7842	}
7843	SetTypeFromAssociation(*symbol);
7844	SetAttrsFromAssociation(*symbol);
7845	}
7846	}
7847	PopAssociation(count: assocCount);
7848	}
7849
7850	void ConstructVisitor::Post(const parser::EndAssociateStmt &x) {
7851	PopScope();
7852	CheckRef(x.v);
7853	}
7854
7855	bool ConstructVisitor::Pre(const parser::Association &x) {
7856	PushAssociation();
7857	const auto &name{std::get<parser::Name>(x.t)};
7858	GetCurrentAssociation().name = &name;
7859	return true;
7860	}
7861
7862	bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) {
7863	CheckDef(x.t);
7864	PushScope(Scope::Kind::OtherConstruct, nullptr);
7865	PushAssociation();
7866	return true;
7867	}
7868
7869	void ConstructVisitor::Post(const parser::CoarrayAssociation &x) {
7870	const auto &decl{std::get<parser::CodimensionDecl>(x.t)};
7871	const auto &name{std::get<parser::Name>(decl.t)};
7872	if (auto *symbol{FindInScope(name)}) {
7873	const auto &selector{std::get<parser::Selector>(x.t)};
7874	if (auto sel{ResolveSelector(selector)}) {
7875	const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)};
7876	if (!whole || whole->Corank() == 0) {
7877	Say(sel.source, // C1116
7878	"Selector in coarray association must name a coarray"_err_en_US);
7879	} else if (auto dynType{sel.expr->GetType()}) {
7880	if (!symbol->GetType()) {
7881	symbol->SetType(ToDeclTypeSpec(std::move(*dynType)));
7882	}
7883	}
7884	}
7885	}
7886	}
7887
7888	void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) {
7889	PopAssociation();
7890	PopScope();
7891	CheckRef(x.t);
7892	}
7893
7894	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) {
7895	PushAssociation();
7896	return true;
7897	}
7898
7899	void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {
7900	PopAssociation();
7901	}
7902
7903	void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
7904	auto &association{GetCurrentAssociation()};
7905	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7906	// This isn't a name in the current scope, it is in each TypeGuardStmt
7907	MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);
7908	association.name = &*name;
7909	if (ExtractCoarrayRef(association.selector.expr)) { // C1103
7910	Say("Selector must not be a coindexed object"_err_en_US);
7911	}
7912	if (association.selector.expr) {
7913	auto exprType{association.selector.expr->GetType()};
7914	if (exprType && !exprType->IsPolymorphic()) { // C1159
7915	Say(association.selector.source,
7916	"Selector '%s' in SELECT TYPE statement must be "
7917	"polymorphic"_err_en_US);
7918	}
7919	}
7920	} else {
7921	if (const Symbol *
7922	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
7923	ConvertToObjectEntity(const_cast<Symbol &>(*whole));
7924	if (!IsVariableName(*whole)) {
7925	Say(association.selector.source, // C901
7926	"Selector is not a variable"_err_en_US);
7927	association = {};
7928	}
7929	if (const DeclTypeSpec * type{whole->GetType()}) {
7930	if (!type->IsPolymorphic()) { // C1159
7931	Say(association.selector.source,
7932	"Selector '%s' in SELECT TYPE statement must be "
7933	"polymorphic"_err_en_US);
7934	}
7935	}
7936	} else {
7937	Say(association.selector.source, // C1157
7938	"Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
7939	association = {};
7940	}
7941	}
7942	}
7943
7944	void ConstructVisitor::Post(const parser::SelectRankStmt &x) {
7945	auto &association{GetCurrentAssociation()};
7946	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7947	// This isn't a name in the current scope, it is in each SelectRankCaseStmt
7948	MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName);
7949	association.name = &*name;
7950	}
7951	}
7952
7953	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {
7954	PushScope(Scope::Kind::OtherConstruct, nullptr);
7955	return true;
7956	}
7957	void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {
7958	PopScope();
7959	}
7960
7961	bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) {
7962	PushScope(Scope::Kind::OtherConstruct, nullptr);
7963	return true;
7964	}
7965	void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) {
7966	PopScope();
7967	}
7968
7969	bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) {
7970	if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) {
7971	// CLASS IS (t)
7972	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
7973	}
7974	return true;
7975	}
7976
7977	void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
7978	if (auto *symbol{MakeAssocEntity()}) {
7979	if (std::holds_alternative<parser::Default>(x.u)) {
7980	SetTypeFromAssociation(*symbol);
7981	} else if (const auto *type{GetDeclTypeSpec()}) {
7982	symbol->SetType(*type);
7983	symbol->get<AssocEntityDetails>().set_isTypeGuard();
7984	}
7985	SetAttrsFromAssociation(*symbol);
7986	}
7987	}
7988
7989	void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
7990	if (auto *symbol{MakeAssocEntity()}) {
7991	SetTypeFromAssociation(*symbol);
7992	auto &details{symbol->get<AssocEntityDetails>()};
7993	// Don't call SetAttrsFromAssociation() for SELECT RANK.
7994	Attrs selectorAttrs{
7995	evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
7996	Attrs attrsToKeep{Attr::ASYNCHRONOUS, Attr::TARGET, Attr::VOLATILE};
7997	if (const auto *rankValue{
7998	std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
7999	// RANK(n)
8000	if (auto expr{EvaluateIntExpr(*rankValue)}) {
8001	if (auto val{evaluate::ToInt64(*expr)}) {
8002	details.set_rank(*val);
8003	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
8004	} else {
8005	Say("RANK() expression must be constant"_err_en_US);
8006	}
8007	}
8008	} else if (std::holds_alternative<parser::Star>(x.u)) {
8009	// RANK(*): assumed-size
8010	details.set_IsAssumedSize();
8011	} else {
8012	CHECK(std::holds_alternative<parser::Default>(x.u));
8013	// RANK DEFAULT: assumed-rank
8014	details.set_IsAssumedRank();
8015	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
8016	}
8017	symbol->attrs() |= selectorAttrs & attrsToKeep;
8018	}
8019	}
8020
8021	bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
8022	PushAssociation();
8023	return true;
8024	}
8025
8026	void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
8027	PopAssociation();
8028	}
8029
8030	bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
8031	if (x && !x->symbol) {
8032	// Construct names are not scoped by BLOCK in the standard, but many,
8033	// but not all, compilers do treat them as if they were so scoped.
8034	if (Symbol * inner{FindInScope(currScope(), *x)}) {
8035	SayAlreadyDeclared(*x, *inner);
8036	} else {
8037	if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {
8038	if (Symbol *
8039	other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) {
8040	SayWithDecl(*x, *other,
8041	"The construct name '%s' should be distinct at the subprogram level"_port_en_US)
8042	.set_languageFeature(common::LanguageFeature::BenignNameClash);
8043	}
8044	}
8045	MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
8046	}
8047	}
8048	return true;
8049	}
8050
8051	void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
8052	if (x) {
8053	// Just add an occurrence of this name; checking is done in ValidateLabels
8054	FindSymbol(*x);
8055	}
8056	}
8057
8058	// Make a symbol for the associating entity of the current association.
8059	Symbol *ConstructVisitor::MakeAssocEntity() {
8060	Symbol *symbol{nullptr};
8061	auto &association{GetCurrentAssociation()};
8062	if (association.name) {
8063	symbol = &MakeSymbol(*association.name, UnknownDetails{});
8064	if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) {
8065	Say(*association.name, // C1102
8066	"The associate name '%s' is already used in this associate statement"_err_en_US);
8067	return nullptr;
8068	}
8069	} else if (const Symbol *
8070	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
8071	symbol = &MakeSymbol(whole->name());
8072	} else {
8073	return nullptr;
8074	}
8075	if (auto &expr{association.selector.expr}) {
8076	symbol->set_details(AssocEntityDetails{common::Clone(*expr)});
8077	} else {
8078	symbol->set_details(AssocEntityDetails{});
8079	}
8080	return symbol;
8081	}
8082
8083	// Set the type of symbol based on the current association selector.
8084	void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {
8085	auto &details{symbol.get<AssocEntityDetails>()};
8086	const MaybeExpr *pexpr{&details.expr()};
8087	if (!*pexpr) {
8088	pexpr = &GetCurrentAssociation().selector.expr;
8089	}
8090	if (*pexpr) {
8091	const SomeExpr &expr{**pexpr};
8092	if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {
8093	if (const auto *charExpr{
8094	evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>(
8095	expr)}) {
8096	symbol.SetType(ToDeclTypeSpec(std::move(*type),
8097	FoldExpr(common::visit(
8098	[](const auto &kindChar) { return kindChar.LEN(); },
8099	charExpr->u))));
8100	} else {
8101	symbol.SetType(ToDeclTypeSpec(std::move(*type)));
8102	}
8103	} else {
8104	// BOZ literals, procedure designators, &c. are not acceptable
8105	Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);
8106	}
8107	}
8108	}
8109
8110	// If current selector is a variable, set some of its attributes on symbol.
8111	// For ASSOCIATE, CHANGE TEAM, and SELECT TYPE only; not SELECT RANK.
8112	void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
8113	Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
8114	symbol.attrs() |=
8115	attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE};
8116	if (attrs.test(Attr::POINTER)) {
8117	SetImplicitAttr(symbol, Attr::TARGET);
8118	}
8119	}
8120
8121	ConstructVisitor::Selector ConstructVisitor::ResolveSelector(
8122	const parser::Selector &x) {
8123	return common::visit(common::visitors{
8124	[&](const parser::Expr &expr) {
8125	return Selector{expr.source, EvaluateExpr(x)};
8126	},
8127	[&](const parser::Variable &var) {
8128	return Selector{var.GetSource(), EvaluateExpr(x)};
8129	},
8130	},
8131	x.u);
8132	}
8133
8134	// Set the current association to the nth to the last association on the
8135	// association stack. The top of the stack is at n = 1. This allows access
8136	// to the interior of a list of associations at the top of the stack.
8137	void ConstructVisitor::SetCurrentAssociation(std::size_t n) {
8138	CHECK(n > 0 && n <= associationStack_.size());
8139	currentAssociation_ = &associationStack_[associationStack_.size() - n];
8140	}
8141
8142	ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() {
8143	CHECK(currentAssociation_);
8144	return *currentAssociation_;
8145	}
8146
8147	void ConstructVisitor::PushAssociation() {
8148	associationStack_.emplace_back(args: Association{});
8149	currentAssociation_ = &associationStack_.back();
8150	}
8151
8152	void ConstructVisitor::PopAssociation(std::size_t count) {
8153	CHECK(count > 0 && count <= associationStack_.size());
8154	associationStack_.resize(new_size: associationStack_.size() - count);
8155	currentAssociation_ =
8156	associationStack_.empty() ? nullptr : &associationStack_.back();
8157	}
8158
8159	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
8160	evaluate::DynamicType &&type) {
8161	switch (type.category()) {
8162	SWITCH_COVERS_ALL_CASES
8163	case common::TypeCategory::Integer:
8164	case common::TypeCategory::Unsigned:
8165	case common::TypeCategory::Real:
8166	case common::TypeCategory::Complex:
8167	return context().MakeNumericType(type.category(), type.kind());
8168	case common::TypeCategory::Logical:
8169	return context().MakeLogicalType(type.kind());
8170	case common::TypeCategory::Derived:
8171	if (type.IsAssumedType()) {
8172	return currScope().MakeTypeStarType();
8173	} else if (type.IsUnlimitedPolymorphic()) {
8174	return currScope().MakeClassStarType();
8175	} else {
8176	return currScope().MakeDerivedType(
8177	type.IsPolymorphic() ? DeclTypeSpec::ClassDerived
8178	: DeclTypeSpec::TypeDerived,
8179	common::Clone(type.GetDerivedTypeSpec())
8180
8181	);
8182	}
8183	case common::TypeCategory::Character:
8184	CRASH_NO_CASE;
8185	}
8186	}
8187
8188	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
8189	evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
8190	CHECK(type.category() == common::TypeCategory::Character);
8191	if (length) {
8192	return currScope().MakeCharacterType(
8193	ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},
8194	KindExpr{type.kind()});
8195	} else {
8196	return currScope().MakeCharacterType(
8197	ParamValue::Deferred(common::TypeParamAttr::Len),
8198	KindExpr{type.kind()});
8199	}
8200	}
8201
8202	class ExecutionPartSkimmerBase {
8203	public:
8204	template <typename A> bool Pre(const A &) { return true; }
8205	template <typename A> void Post(const A &) {}
8206
8207	bool InNestedBlockConstruct() const { return blockDepth_ > 0; }
8208
8209	bool Pre(const parser::AssociateConstruct &) {
8210	PushScope();
8211	return true;
8212	}
8213	void Post(const parser::AssociateConstruct &) { PopScope(); }
8214	bool Pre(const parser::Association &x) {
8215	Hide(name: std::get<parser::Name>(x.t));
8216	return true;
8217	}
8218	bool Pre(const parser::BlockConstruct &) {
8219	PushScope();
8220	++blockDepth_;
8221	return true;
8222	}
8223	void Post(const parser::BlockConstruct &) {
8224	--blockDepth_;
8225	PopScope();
8226	}
8227	// Note declarations of local names in BLOCK constructs.
8228	// Don't have to worry about INTENT(), VALUE, or OPTIONAL
8229	// (pertinent only to dummy arguments), ASYNCHRONOUS/VOLATILE,
8230	// or accessibility attributes,
8231	bool Pre(const parser::EntityDecl &x) {
8232	Hide(std::get<parser::ObjectName>(x.t));
8233	return true;
8234	}
8235	bool Pre(const parser::ObjectDecl &x) {
8236	Hide(std::get<parser::ObjectName>(x.t));
8237	return true;
8238	}
8239	bool Pre(const parser::PointerDecl &x) {
8240	Hide(name: std::get<parser::Name>(x.t));
8241	return true;
8242	}
8243	bool Pre(const parser::BindEntity &x) {
8244	Hide(name: std::get<parser::Name>(x.t));
8245	return true;
8246	}
8247	bool Pre(const parser::ContiguousStmt &x) {
8248	for (const parser::Name &name : x.v) {
8249	Hide(name);
8250	}
8251	return true;
8252	}
8253	bool Pre(const parser::DimensionStmt::Declaration &x) {
8254	Hide(name: std::get<parser::Name>(x.t));
8255	return true;
8256	}
8257	bool Pre(const parser::ExternalStmt &x) {
8258	for (const parser::Name &name : x.v) {
8259	Hide(name);
8260	}
8261	return true;
8262	}
8263	bool Pre(const parser::IntrinsicStmt &x) {
8264	for (const parser::Name &name : x.v) {
8265	Hide(name);
8266	}
8267	return true;
8268	}
8269	bool Pre(const parser::CodimensionStmt &x) {
8270	for (const parser::CodimensionDecl &decl : x.v) {
8271	Hide(std::get<parser::Name>(decl.t));
8272	}
8273	return true;
8274	}
8275	void Post(const parser::ImportStmt &x) {
8276	if (x.kind == common::ImportKind::None ||
8277	x.kind == common::ImportKind::Only) {
8278	if (!nestedScopes_.front().importOnly.has_value()) {
8279	nestedScopes_.front().importOnly.emplace();
8280	}
8281	for (const auto &name : x.names) {
8282	nestedScopes_.front().importOnly->emplace(name.source);
8283	}
8284	} else {
8285	// no special handling needed for explicit names or IMPORT, ALL
8286	}
8287	}
8288	void Post(const parser::UseStmt &x) {
8289	if (const auto *onlyList{std::get_if<std::list<parser::Only>>(&x.u)}) {
8290	for (const auto &only : *onlyList) {
8291	if (const auto *name{std::get_if<parser::Name>(&only.u)}) {
8292	Hide(*name);
8293	} else if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
8294	if (const auto *names{
8295	std::get_if<parser::Rename::Names>(&rename->u)}) {
8296	Hide(std::get<0>(names->t));
8297	}
8298	}
8299	}
8300	} else {
8301	// USE may or may not shadow symbols in host scopes
8302	nestedScopes_.front().hasUseWithoutOnly = true;
8303	}
8304	}
8305	bool Pre(const parser::DerivedTypeStmt &x) {
8306	Hide(name: std::get<parser::Name>(x.t));
8307	PushScope();
8308	return true;
8309	}
8310	void Post(const parser::DerivedTypeDef &) { PopScope(); }
8311	bool Pre(const parser::SelectTypeConstruct &) {
8312	PushScope();
8313	return true;
8314	}
8315	void Post(const parser::SelectTypeConstruct &) { PopScope(); }
8316	bool Pre(const parser::SelectTypeStmt &x) {
8317	if (const auto &maybeName{std::get<1>(x.t)}) {
8318	Hide(name: *maybeName);
8319	}
8320	return true;
8321	}
8322	bool Pre(const parser::SelectRankConstruct &) {
8323	PushScope();
8324	return true;
8325	}
8326	void Post(const parser::SelectRankConstruct &) { PopScope(); }
8327	bool Pre(const parser::SelectRankStmt &x) {
8328	if (const auto &maybeName{std::get<1>(x.t)}) {
8329	Hide(name: *maybeName);
8330	}
8331	return true;
8332	}
8333
8334	// Iterator-modifiers contain variable declarations, and do introduce
8335	// a new scope. These variables can only have integer types, and their
8336	// scope only extends until the end of the clause. A potential alternative
8337	// to the code below may be to ignore OpenMP clauses, but it's not clear
8338	// if OMP-specific checks can be avoided altogether.
8339	bool Pre(const parser::OmpClause &x) {
8340	if (OmpVisitor::NeedsScope(x)) {
8341	PushScope();
8342	}
8343	return true;
8344	}
8345	void Post(const parser::OmpClause &x) {
8346	if (OmpVisitor::NeedsScope(x)) {
8347	PopScope();
8348	}
8349	}
8350
8351	protected:
8352	bool IsHidden(SourceName name) {
8353	for (const auto &scope : nestedScopes_) {
8354	if (scope.locals.find(name) != scope.locals.end()) {
8355	return true; // shadowed by nested declaration
8356	}
8357	if (scope.hasUseWithoutOnly) {
8358	break;
8359	}
8360	if (scope.importOnly &&
8361	scope.importOnly->find(name) == scope.importOnly->end()) {
8362	return true; // not imported
8363	}
8364	}
8365	return false;
8366	}
8367
8368	void EndWalk() { CHECK(nestedScopes_.empty()); }
8369
8370	private:
8371	void PushScope() { nestedScopes_.emplace_front(); }
8372	void PopScope() { nestedScopes_.pop_front(); }
8373	void Hide(const parser::Name &name) {
8374	nestedScopes_.front().locals.emplace(name.source);
8375	}
8376
8377	int blockDepth_{0};
8378	struct NestedScopeInfo {
8379	bool hasUseWithoutOnly{false};
8380	std::set<SourceName> locals;
8381	std::optional<std::set<SourceName>> importOnly;
8382	};
8383	std::list<NestedScopeInfo> nestedScopes_;
8384	};
8385
8386	class ExecutionPartAsyncIOSkimmer : public ExecutionPartSkimmerBase {
8387	public:
8388	explicit ExecutionPartAsyncIOSkimmer(SemanticsContext &context)
8389	: context_{context} {}
8390
8391	void Walk(const parser::Block &block) {
8392	parser::Walk(block, *this);
8393	EndWalk();
8394	}
8395
8396	const std::set<SourceName> asyncIONames() const { return asyncIONames_; }
8397
8398	using ExecutionPartSkimmerBase::Post;
8399	using ExecutionPartSkimmerBase::Pre;
8400
8401	bool Pre(const parser::IoControlSpec::Asynchronous &async) {
8402	if (auto folded{evaluate::Fold(
8403	context_.foldingContext(), AnalyzeExpr(context_, async.v))}) {
8404	if (auto str{
8405	evaluate::GetScalarConstantValue<evaluate::Ascii>(*folded)}) {
8406	for (char ch : *str) {
8407	if (ch != ' ') {
8408	inAsyncIO_ = ch == 'y' || ch == 'Y';
8409	break;
8410	}
8411	}
8412	}
8413	}
8414	return true;
8415	}
8416	void Post(const parser::ReadStmt &) { inAsyncIO_ = false; }
8417	void Post(const parser::WriteStmt &) { inAsyncIO_ = false; }
8418	void Post(const parser::IoControlSpec::Size &size) {
8419	if (const auto *designator{
8420	std::get_if<common::Indirection<parser::Designator>>(
8421	&size.v.thing.thing.u)}) {
8422	NoteAsyncIODesignator(designator: designator->value());
8423	}
8424	}
8425	void Post(const parser::InputItem &x) {
8426	if (const auto *var{std::get_if<parser::Variable>(&x.u)}) {
8427	if (const auto *designator{
8428	std::get_if<common::Indirection<parser::Designator>>(&var->u)}) {
8429	NoteAsyncIODesignator(designator: designator->value());
8430	}
8431	}
8432	}
8433	void Post(const parser::OutputItem &x) {
8434	if (const auto *expr{std::get_if<parser::Expr>(&x.u)}) {
8435	if (const auto *designator{
8436	std::get_if<common::Indirection<parser::Designator>>(&expr->u)}) {
8437	NoteAsyncIODesignator(designator: designator->value());
8438	}
8439	}
8440	}
8441
8442	private:
8443	void NoteAsyncIODesignator(const parser::Designator &designator) {
8444	if (inAsyncIO_ && !InNestedBlockConstruct()) {
8445	const parser::Name &name{parser::GetFirstName(designator)};
8446	if (!IsHidden(name: name.source)) {
8447	asyncIONames_.insert(name.source);
8448	}
8449	}
8450	}
8451
8452	SemanticsContext &context_;
8453	bool inAsyncIO_{false};
8454	std::set<SourceName> asyncIONames_;
8455	};
8456
8457	// Any data list item or SIZE= specifier of an I/O data transfer statement
8458	// with ASYNCHRONOUS="YES" implicitly has the ASYNCHRONOUS attribute in the
8459	// local scope.
8460	void ConstructVisitor::HandleImpliedAsynchronousInScope(
8461	const parser::Block &block) {
8462	ExecutionPartAsyncIOSkimmer skimmer{context()};
8463	skimmer.Walk(block);
8464	for (auto name : skimmer.asyncIONames()) {
8465	if (Symbol * symbol{currScope().FindSymbol(name)}) {
8466	if (!symbol->attrs().test(Attr::ASYNCHRONOUS)) {
8467	if (&symbol->owner() != &currScope()) {
8468	symbol = &*currScope()
8469	.try_emplace(name, HostAssocDetails{*symbol})
8470	.first->second;
8471	}
8472	if (symbol->has<AssocEntityDetails>()) {
8473	symbol = const_cast<Symbol *>(&GetAssociationRoot(*symbol));
8474	}
8475	SetImplicitAttr(*symbol, Attr::ASYNCHRONOUS);
8476	}
8477	}
8478	}
8479	}
8480
8481	// ResolveNamesVisitor implementation
8482
8483	bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
8484	HandleCall(Symbol::Flag::Function, x.v);
8485	return false;
8486	}
8487	bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
8488	HandleCall(Symbol::Flag::Subroutine, x.call);
8489	Walk(x.chevrons);
8490	return false;
8491	}
8492
8493	bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
8494	auto &scope{currScope()};
8495	// Check C896 and C899: where IMPORT statements are allowed
8496	switch (scope.kind()) {
8497	case Scope::Kind::Module:
8498	if (scope.IsModule()) {
8499	Say("IMPORT is not allowed in a module scoping unit"_err_en_US);
8500	return false;
8501	} else if (x.kind == common::ImportKind::None) {
8502	Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US);
8503	return false;
8504	}
8505	break;
8506	case Scope::Kind::MainProgram:
8507	Say("IMPORT is not allowed in a main program scoping unit"_err_en_US);
8508	return false;
8509	case Scope::Kind::Subprogram:
8510	if (scope.parent().IsGlobal()) {
8511	Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US);
8512	return false;
8513	}
8514	break;
8515	case Scope::Kind::BlockData: // C1415 (in part)
8516	Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);
8517	return false;
8518	default:;
8519	}
8520	if (auto error{scope.SetImportKind(x.kind)}) {
8521	Say(std::move(*error));
8522	}
8523	for (auto &name : x.names) {
8524	if (Symbol * outer{FindSymbol(scope.parent(), name)}) {
8525	scope.add_importName(name.source);
8526	if (Symbol * symbol{FindInScope(name)}) {
8527	if (outer->GetUltimate() == symbol->GetUltimate()) {
8528	context().Warn(common::LanguageFeature::BenignNameClash, name.source,
8529	"The same '%s' is already present in this scope"_port_en_US,
8530	name.source);
8531	} else {
8532	Say(name,
8533	"A distinct '%s' is already present in this scope"_err_en_US)
8534	.Attach(symbol->name(), "Previous declaration of '%s'"_en_US)
8535	.Attach(outer->name(), "Declaration of '%s' in host scope"_en_US);
8536	}
8537	}
8538	} else {
8539	Say(name, "'%s' not found in host scope"_err_en_US);
8540	}
8541	}
8542	prevImportStmt_ = currStmtSource();
8543	return false;
8544	}
8545
8546	const parser::Name *DeclarationVisitor::ResolveStructureComponent(
8547	const parser::StructureComponent &x) {
8548	return FindComponent(ResolveDataRef(x.base), x.component);
8549	}
8550
8551	const parser::Name *DeclarationVisitor::ResolveDesignator(
8552	const parser::Designator &x) {
8553	return common::visit(
8554	common::visitors{
8555	[&](const parser::DataRef &x) { return ResolveDataRef(x); },
8556	[&](const parser::Substring &x) {
8557	Walk(std::get<parser::SubstringRange>(x.t).t);
8558	return ResolveDataRef(std::get<parser::DataRef>(x.t));
8559	},
8560	},
8561	x.u);
8562	}
8563
8564	const parser::Name *DeclarationVisitor::ResolveDataRef(
8565	const parser::DataRef &x) {
8566	return common::visit(
8567	common::visitors{
8568	[=](const parser::Name &y) { return ResolveName(y); },
8569	[=](const Indirection<parser::StructureComponent> &y) {
8570	return ResolveStructureComponent(y.value());
8571	},
8572	[&](const Indirection<parser::ArrayElement> &y) {
8573	Walk(y.value().subscripts);
8574	const parser::Name *name{ResolveDataRef(y.value().base)};
8575	if (name && name->symbol) {
8576	if (!IsProcedure(*name->symbol)) {
8577	ConvertToObjectEntity(*name->symbol);
8578	} else if (!context().HasError(*name->symbol)) {
8579	SayWithDecl(*name, *name->symbol,
8580	"Cannot reference function '%s' as data"_err_en_US);
8581	context().SetError(*name->symbol);
8582	}
8583	}
8584	return name;
8585	},
8586	[&](const Indirection<parser::CoindexedNamedObject> &y) {
8587	Walk(y.value().imageSelector);
8588	return ResolveDataRef(y.value().base);
8589	},
8590	},
8591	x.u);
8592	}
8593
8594	static bool TypesMismatchIfNonNull(
8595	const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
8596	return type1 && type2 && *type1 != *type2;
8597	}
8598
8599	// If implicit types are allowed, ensure name is in the symbol table.
8600	// Otherwise, report an error if it hasn't been declared.
8601	const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
8602	if (!FindSymbol(name)) {
8603	if (FindAndMarkDeclareTargetSymbol(name)) {
8604	return &name;
8605	}
8606	}
8607
8608	if (CheckForHostAssociatedImplicit(name)) {
8609	NotePossibleBadForwardRef(name);
8610	return &name;
8611	}
8612	if (Symbol * symbol{name.symbol}) {
8613	if (CheckUseError(name)) {
8614	return nullptr; // reported an error
8615	}
8616	NotePossibleBadForwardRef(name);
8617	symbol->set(Symbol::Flag::ImplicitOrError, false);
8618	if (IsUplevelReference(*symbol)) {
8619	MakeHostAssocSymbol(name, *symbol);
8620	} else if (IsDummy(*symbol)) {
8621	CheckEntryDummyUse(source: name.source, symbol);
8622	ConvertToObjectEntity(*symbol);
8623	if (IsEarlyDeclaredDummyArgument(*symbol)) {
8624	ForgetEarlyDeclaredDummyArgument(*symbol);
8625	if (isImplicitNoneType()) {
8626	context().Warn(common::LanguageFeature::ForwardRefImplicitNone,
8627	name.source,
8628	"'%s' was used under IMPLICIT NONE(TYPE) before being explicitly typed"_warn_en_US,
8629	name.source);
8630	} else if (TypesMismatchIfNonNull(
8631	symbol->GetType(), GetImplicitType(*symbol))) {
8632	context().Warn(common::LanguageFeature::ForwardRefExplicitTypeDummy,
8633	name.source,
8634	"'%s' was used before being explicitly typed (and its implicit type would differ)"_warn_en_US,
8635	name.source);
8636	}
8637	}
8638	ApplyImplicitRules(*symbol);
8639	} else if (!symbol->GetType() && FindCommonBlockContaining(*symbol)) {
8640	ConvertToObjectEntity(*symbol);
8641	ApplyImplicitRules(*symbol);
8642	} else if (const auto *tpd{symbol->detailsIf<TypeParamDetails>()};
8643	tpd && !tpd->attr()) {
8644	Say(name,
8645	"Type parameter '%s' was referenced before being declared"_err_en_US,
8646	name.source);
8647	context().SetError(*symbol);
8648	}
8649	if (checkIndexUseInOwnBounds_ &&
8650	*checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) {
8651	context().Warn(common::LanguageFeature::ImpliedDoIndexScope, name.source,
8652	"Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
8653	name.source);
8654	}
8655	return &name;
8656	}
8657	if (isImplicitNoneType() && !deferImplicitTyping_) {
8658	Say(name, "No explicit type declared for '%s'"_err_en_US);
8659	return nullptr;
8660	}
8661	// Create the symbol, then ensure that it is accessible
8662	if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
8663	Say(name,
8664	"Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,
8665	name.source);
8666	}
8667	MakeSymbol(InclusiveScope(), name.source, Attrs{});
8668	auto *symbol{FindSymbol(name)};
8669	if (!symbol) {
8670	Say(name,
8671	"'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
8672	return nullptr;
8673	}
8674	ConvertToObjectEntity(symbol&: *symbol);
8675	ApplyImplicitRules(symbol&: *symbol);
8676	NotePossibleBadForwardRef(name);
8677	return &name;
8678	}
8679
8680	// A specification expression may refer to a symbol in the host procedure that
8681	// is implicitly typed. Because specification parts are processed before
8682	// execution parts, this may be the first time we see the symbol. It can't be a
8683	// local in the current scope (because it's in a specification expression) so
8684	// either it is implicitly declared in the host procedure or it is an error.
8685	// We create a symbol in the host assuming it is the former; if that proves to
8686	// be wrong we report an error later in CheckDeclarations().
8687	bool DeclarationVisitor::CheckForHostAssociatedImplicit(
8688	const parser::Name &name) {
8689	if (!inSpecificationPart_ || inEquivalenceStmt_) {
8690	return false;
8691	}
8692	if (name.symbol) {
8693	ApplyImplicitRules(symbol&: *name.symbol, allowForwardReference: true);
8694	}
8695	if (Scope * host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
8696	Symbol *hostSymbol{nullptr};
8697	if (!name.symbol) {
8698	if (currScope().CanImport(name.source)) {
8699	hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
8700	ConvertToObjectEntity(*hostSymbol);
8701	ApplyImplicitRules(*hostSymbol);
8702	hostSymbol->set(Symbol::Flag::ImplicitOrError);
8703	}
8704	} else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {
8705	hostSymbol = name.symbol;
8706	}
8707	if (hostSymbol) {
8708	Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)};
8709	if (auto *assoc{symbol.detailsIf<HostAssocDetails>()}) {
8710	if (isImplicitNoneType()) {
8711	assoc->implicitOrExplicitTypeError = true;
8712	} else {
8713	assoc->implicitOrSpecExprError = true;
8714	}
8715	return true;
8716	}
8717	}
8718	}
8719	return false;
8720	}
8721
8722	bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {
8723	if (symbol.owner().IsTopLevel()) {
8724	return false;
8725	}
8726	const Scope &symbolUnit{GetProgramUnitContaining(symbol)};
8727	if (symbolUnit == GetProgramUnitContaining(currScope())) {
8728	return false;
8729	} else {
8730	Scope::Kind kind{symbolUnit.kind()};
8731	return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;
8732	}
8733	}
8734
8735	// base is a part-ref of a derived type; find the named component in its type.
8736	// Also handles intrinsic type parameter inquiries (%kind, %len) and
8737	// COMPLEX component references (%re, %im).
8738	const parser::Name *DeclarationVisitor::FindComponent(
8739	const parser::Name *base, const parser::Name &component) {
8740	if (!base || !base->symbol) {
8741	return nullptr;
8742	}
8743	if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) {
8744	if (component.source == "kind") {
8745	if (misc->kind() == MiscDetails::Kind::ComplexPartRe ||
8746	misc->kind() == MiscDetails::Kind::ComplexPartIm ||
8747	misc->kind() == MiscDetails::Kind::KindParamInquiry ||
8748	misc->kind() == MiscDetails::Kind::LenParamInquiry) {
8749	// x%{re,im,kind,len}%kind
8750	MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry);
8751	return &component;
8752	}
8753	}
8754	}
8755	CheckEntryDummyUse(source: base->source, symbol: base->symbol);
8756	auto &symbol{base->symbol->GetUltimate()};
8757	if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) {
8758	SayWithDecl(*base, symbol,
8759	"'%s' is not an object and may not be used as the base of a component reference or type parameter inquiry"_err_en_US);
8760	return nullptr;
8761	}
8762	auto *type{symbol.GetType()};
8763	if (!type) {
8764	return nullptr; // should have already reported error
8765	}
8766	if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
8767	auto category{intrinsic->category()};
8768	MiscDetails::Kind miscKind{MiscDetails::Kind::None};
8769	if (component.source == "kind") {
8770	miscKind = MiscDetails::Kind::KindParamInquiry;
8771	} else if (category == TypeCategory::Character) {
8772	if (component.source == "len") {
8773	miscKind = MiscDetails::Kind::LenParamInquiry;
8774	}
8775	} else if (category == TypeCategory::Complex) {
8776	if (component.source == "re") {
8777	miscKind = MiscDetails::Kind::ComplexPartRe;
8778	} else if (component.source == "im") {
8779	miscKind = MiscDetails::Kind::ComplexPartIm;
8780	}
8781	}
8782	if (miscKind != MiscDetails::Kind::None) {
8783	MakePlaceholder(component, miscKind);
8784	return &component;
8785	}
8786	} else if (DerivedTypeSpec * derived{type->AsDerived()}) {
8787	derived->Instantiate(currScope()); // in case of forward referenced type
8788	if (const Scope * scope{derived->scope()}) {
8789	if (Resolve(component, scope->FindComponent(component.source))) {
8790	if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {
8791	context().Say(component.source, *msg);
8792	}
8793	return &component;
8794	} else {
8795	SayDerivedType(component.source,
8796	"Component '%s' not found in derived type '%s'"_err_en_US, *scope);
8797	}
8798	}
8799	return nullptr;
8800	}
8801	if (symbol.test(Symbol::Flag::Implicit)) {
8802	Say(*base,
8803	"'%s' is not an object of derived type; it is implicitly typed"_err_en_US);
8804	} else {
8805	SayWithDecl(
8806	*base, symbol, "'%s' is not an object of derived type"_err_en_US);
8807	}
8808	return nullptr;
8809	}
8810
8811	bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
8812	const parser::Name &name) {
8813	if (!specPartState_.declareTargetNames.empty()) {
8814	if (specPartState_.declareTargetNames.count(name.source)) {
8815	if (!currScope().IsTopLevel()) {
8816	// Search preceding scopes until we find a matching symbol or run out
8817	// of scopes to search, we skip the current scope as it's already been
8818	// designated as implicit here.
8819	for (auto *scope = &currScope().parent();; scope = &scope->parent()) {
8820	if (Symbol * symbol{scope->FindSymbol(name.source)}) {
8821	if (symbol->test(Symbol::Flag::Subroutine) ||
8822	symbol->test(Symbol::Flag::Function)) {
8823	const auto [sym, success]{currScope().try_emplace(
8824	symbol->name(), Attrs{}, HostAssocDetails{*symbol})};
8825	assert(success &&
8826	"FindAndMarkDeclareTargetSymbol could not emplace new "
8827	"subroutine/function symbol");
8828	name.symbol = &*sym->second;
8829	symbol->test(Symbol::Flag::Subroutine)
8830	? name.symbol->set(Symbol::Flag::Subroutine)
8831	: name.symbol->set(Symbol::Flag::Function);
8832	return true;
8833	}
8834	// if we find a symbol that is not a function or subroutine, we
8835	// currently escape without doing anything.
8836	break;
8837	}
8838
8839	// This is our loop exit condition, as parent() has an inbuilt assert
8840	// if you call it on a top level scope, rather than returning a null
8841	// value.
8842	if (scope->IsTopLevel()) {
8843	return false;
8844	}
8845	}
8846	}
8847	}
8848	}
8849	return false;
8850	}
8851
8852	void DeclarationVisitor::Initialization(const parser::Name &name,
8853	const parser::Initialization &init, bool inComponentDecl) {
8854	// Traversal of the initializer was deferred to here so that the
8855	// symbol being declared can be available for use in the expression, e.g.:
8856	// real, parameter :: x = tiny(x)
8857	if (!name.symbol) {
8858	return;
8859	}
8860	Symbol &ultimate{name.symbol->GetUltimate()};
8861	// TODO: check C762 - all bounds and type parameters of component
8862	// are colons or constant expressions if component is initialized
8863	common::visit(
8864	common::visitors{
8865	[&](const parser::ConstantExpr &expr) {
8866	Walk(expr);
8867	if (IsNamedConstant(ultimate) || inComponentDecl) {
8868	NonPointerInitialization(name, expr);
8869	} else {
8870	// Defer analysis so forward references to nested subprograms
8871	// can be properly resolved when they appear in structure
8872	// constructors.
8873	ultimate.set(Symbol::Flag::InDataStmt);
8874	}
8875	},
8876	[&](const parser::NullInit &null) { // => NULL()
8877	Walk(null);
8878	if (auto nullInit{EvaluateExpr(null)}) {
8879	if (!evaluate::IsNullPointer(&*nullInit)) { // C813
8880	Say(null.v.value().source,
8881	"Pointer initializer must be intrinsic NULL()"_err_en_US);
8882	} else if (IsPointer(ultimate)) {
8883	if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
8884	CHECK(!object->init());
8885	object->set_init(std::move(*nullInit));
8886	} else if (auto *procPtr{
8887	ultimate.detailsIf<ProcEntityDetails>()}) {
8888	CHECK(!procPtr->init());
8889	procPtr->set_init(nullptr);
8890	}
8891	} else {
8892	Say(name,
8893	"Non-pointer component '%s' initialized with null pointer"_err_en_US);
8894	}
8895	}
8896	},
8897	[&](const parser::InitialDataTarget &target) {
8898	// Defer analysis to the end of the specification part
8899	// so that forward references and attribute checks like SAVE
8900	// work better.
8901	auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
8902	Walk(target);
8903	ultimate.set(Symbol::Flag::InDataStmt);
8904	},
8905	[&](const std::list<Indirection<parser::DataStmtValue>> &values) {
8906	// Handled later in data-to-inits conversion
8907	ultimate.set(Symbol::Flag::InDataStmt);
8908	Walk(values);
8909	},
8910	},
8911	init.u);
8912	}
8913
8914	void DeclarationVisitor::PointerInitialization(
8915	const parser::Name &name, const parser::InitialDataTarget &target) {
8916	if (name.symbol) {
8917	Symbol &ultimate{name.symbol->GetUltimate()};
8918	if (!context().HasError(ultimate)) {
8919	if (IsPointer(ultimate)) {
8920	Walk(target);
8921	if (MaybeExpr expr{EvaluateExpr(target)}) {
8922	// Validation is done in declaration checking.
8923	if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
8924	CHECK(!details->init());
8925	details->set_init(std::move(*expr));
8926	ultimate.set(Symbol::Flag::InDataStmt, false);
8927	} else if (auto *details{ultimate.detailsIf<ProcEntityDetails>()}) {
8928	// something like "REAL, EXTERNAL, POINTER :: p => t"
8929	if (evaluate::IsNullProcedurePointer(&*expr)) {
8930	CHECK(!details->init());
8931	details->set_init(nullptr);
8932	} else if (const Symbol *
8933	targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
8934	CHECK(!details->init());
8935	details->set_init(*targetSymbol);
8936	} else {
8937	Say(name,
8938	"Procedure pointer '%s' must be initialized with a procedure name or NULL()"_err_en_US);
8939	context().SetError(ultimate);
8940	}
8941	}
8942	}
8943	} else {
8944	Say(name,
8945	"'%s' is not a pointer but is initialized like one"_err_en_US);
8946	context().SetError(ultimate);
8947	}
8948	}
8949	}
8950	}
8951	void DeclarationVisitor::PointerInitialization(
8952	const parser::Name &name, const parser::ProcPointerInit &target) {
8953	if (name.symbol) {
8954	Symbol &ultimate{name.symbol->GetUltimate()};
8955	if (!context().HasError(ultimate)) {
8956	if (IsProcedurePointer(ultimate)) {
8957	auto &details{ultimate.get<ProcEntityDetails>()};
8958	if (details.init()) {
8959	Say(name, "'%s' was previously initialized"_err_en_US);
8960	context().SetError(ultimate);
8961	} else if (const auto *targetName{
8962	std::get_if<parser::Name>(&target.u)}) {
8963	Walk(target);
8964	if (!CheckUseError(name: *targetName) && targetName->symbol) {
8965	// Validation is done in declaration checking.
8966	details.set_init(*targetName->symbol);
8967	}
8968	} else { // explicit NULL
8969	details.set_init(nullptr);
8970	}
8971	} else {
8972	Say(name,
8973	"'%s' is not a procedure pointer but is initialized like one"_err_en_US);
8974	context().SetError(ultimate);
8975	}
8976	}
8977	}
8978	}
8979
8980	void DeclarationVisitor::NonPointerInitialization(
8981	const parser::Name &name, const parser::ConstantExpr &expr) {
8982	if (!context().HasError(name.symbol)) {
8983	Symbol &ultimate{name.symbol->GetUltimate()};
8984	if (!context().HasError(ultimate)) {
8985	if (IsPointer(ultimate)) {
8986	Say(name,
8987	"'%s' is a pointer but is not initialized like one"_err_en_US);
8988	} else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
8989	if (details->init()) {
8990	SayWithDecl(name, *name.symbol,
8991	"'%s' has already been initialized"_err_en_US);
8992	} else if (IsAllocatable(ultimate)) {
8993	Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
8994	} else if (ultimate.owner().IsParameterizedDerivedType()) {
8995	// Save the expression for per-instantiation analysis.
8996	details->set_unanalyzedPDTComponentInit(&expr.thing.value());
8997	} else if (MaybeExpr folded{EvaluateNonPointerInitializer(
8998	ultimate, expr, expr.thing.value().source)}) {
8999	details->set_init(std::move(*folded));
9000	ultimate.set(Symbol::Flag::InDataStmt, false);
9001	}
9002	} else {
9003	Say(name, "'%s' is not an object that can be initialized"_err_en_US);
9004	}
9005	}
9006	}
9007	}
9008
9009	void ResolveNamesVisitor::HandleCall(
9010	Symbol::Flag procFlag, const parser::Call &call) {
9011	common::visit(
9012	common::visitors{
9013	[&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
9014	[&](const parser::ProcComponentRef &x) {
9015	Walk(x);
9016	const parser::Name &name{x.v.thing.component};
9017	if (Symbol * symbol{name.symbol}) {
9018	if (IsProcedure(*symbol)) {
9019	SetProcFlag(name, *symbol, procFlag);
9020	}
9021	}
9022	},
9023	},
9024	std::get<parser::ProcedureDesignator>(call.t).u);
9025	const auto &arguments{std::get<std::list<parser::ActualArgSpec>>(call.t)};
9026	Walk(arguments);
9027	// Once an object has appeared in a specification function reference as
9028	// a whole scalar actual argument, it cannot be (re)dimensioned later.
9029	// The fact that it appeared to be a scalar may determine the resolution
9030	// or the result of an inquiry intrinsic function or generic procedure.
9031	if (inSpecificationPart_) {
9032	for (const auto &argSpec : arguments) {
9033	const auto &actual{std::get<parser::ActualArg>(argSpec.t)};
9034	if (const auto *expr{
9035	std::get_if<common::Indirection<parser::Expr>>(&actual.u)}) {
9036	if (const auto *designator{
9037	std::get_if<common::Indirection<parser::Designator>>(
9038	&expr->value().u)}) {
9039	if (const auto *dataRef{
9040	std::get_if<parser::DataRef>(&designator->value().u)}) {
9041	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)};
9042	name && name->symbol) {
9043	const Symbol &symbol{*name->symbol};
9044	const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
9045	if (symbol.has<EntityDetails>() ||
9046	(object && !object->IsArray())) {
9047	NoteScalarSpecificationArgument(symbol);
9048	}
9049	}
9050	}
9051	}
9052	}
9053	}
9054	}
9055	}
9056
9057	void ResolveNamesVisitor::HandleProcedureName(
9058	Symbol::Flag flag, const parser::Name &name) {
9059	CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
9060	auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
9061	if (!symbol) {
9062	if (IsIntrinsic(name.source, flag)) {
9063	symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
9064	SetImplicitAttr(*symbol, Attr::INTRINSIC);
9065	} else if (const auto ppcBuiltinScope =
9066	currScope().context().GetPPCBuiltinsScope()) {
9067	// Check if it is a builtin from the predefined module
9068	symbol = FindSymbol(*ppcBuiltinScope, name);
9069	if (!symbol) {
9070	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
9071	}
9072	} else {
9073	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
9074	}
9075	Resolve(name, *symbol);
9076	ConvertToProcEntity(symbol&: *symbol, usedHere: name.source);
9077	if (!symbol->attrs().test(Attr::INTRINSIC)) {
9078	if (CheckImplicitNoneExternal(name.source, *symbol)) {
9079	MakeExternal(symbol&: *symbol);
9080	// Create a place-holder HostAssocDetails symbol to preclude later
9081	// use of this name as a local symbol; but don't actually use this new
9082	// HostAssocDetails symbol in expressions.
9083	MakeHostAssocSymbol(name, hostSymbol: *symbol);
9084	name.symbol = symbol;
9085	}
9086	}
9087	CheckEntryDummyUse(source: name.source, symbol: symbol);
9088	SetProcFlag(name, *symbol, flag);
9089	} else if (CheckUseError(name)) {
9090	// error was reported
9091	} else {
9092	symbol = &symbol->GetUltimate();
9093	if (!name.symbol ||
9094	(name.symbol->has<HostAssocDetails>() && symbol->owner().IsGlobal() &&
9095	(symbol->has<ProcEntityDetails>() ||
9096	(symbol->has<SubprogramDetails>() &&
9097	symbol->scope() /*not ENTRY*/)))) {
9098	name.symbol = symbol;
9099	}
9100	CheckEntryDummyUse(source: name.source, symbol: symbol);
9101	bool convertedToProcEntity{ConvertToProcEntity(symbol&: *symbol, usedHere: name.source)};
9102	if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
9103	IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
9104	AcquireIntrinsicProcedureFlags(symbol&: *symbol);
9105	}
9106	if (!SetProcFlag(name, *symbol, flag)) {
9107	return; // reported error
9108	}
9109	CheckImplicitNoneExternal(name.source, *symbol);
9110	if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
9111	symbol->has<AssocEntityDetails>()) {
9112	// Symbols with DerivedTypeDetails and AssocEntityDetails are accepted
9113	// here as procedure-designators because this means the related
9114	// FunctionReference are mis-parsed structure constructors or array
9115	// references that will be fixed later when analyzing expressions.
9116	} else if (symbol->has<ObjectEntityDetails>()) {
9117	// Symbols with ObjectEntityDetails are also accepted because this can be
9118	// a mis-parsed array reference that will be fixed later. Ensure that if
9119	// this is a symbol from a host procedure, a symbol with HostAssocDetails
9120	// is created for the current scope.
9121	// Operate on non ultimate symbol so that HostAssocDetails are also
9122	// created for symbols used associated in the host procedure.
9123	ResolveName(name);
9124	} else if (symbol->test(Symbol::Flag::Implicit)) {
9125	Say(name,
9126	"Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);
9127	} else {
9128	SayWithDecl(name, *symbol,
9129	"Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
9130	}
9131	}
9132	}
9133
9134	bool ResolveNamesVisitor::CheckImplicitNoneExternal(
9135	const SourceName &name, const Symbol &symbol) {
9136	if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&
9137	!symbol.attrs().test(Attr::EXTERNAL) &&
9138	!symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) {
9139	Say(name,
9140	"'%s' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
9141	return false;
9142	}
9143	return true;
9144	}
9145
9146	// Variant of HandleProcedureName() for use while skimming the executable
9147	// part of a subprogram to catch calls to dummy procedures that are part
9148	// of the subprogram's interface, and to mark as procedures any symbols
9149	// that might otherwise have been miscategorized as objects.
9150	void ResolveNamesVisitor::NoteExecutablePartCall(
9151	Symbol::Flag flag, SourceName name, bool hasCUDAChevrons) {
9152	// Subtlety: The symbol pointers in the parse tree are not set, because
9153	// they might end up resolving elsewhere (e.g., construct entities in
9154	// SELECT TYPE).
9155	if (Symbol * symbol{currScope().FindSymbol(name)}) {
9156	Symbol::Flag other{flag == Symbol::Flag::Subroutine
9157	? Symbol::Flag::Function
9158	: Symbol::Flag::Subroutine};
9159	if (!symbol->test(other)) {
9160	ConvertToProcEntity(symbol&: *symbol, usedHere: name);
9161	if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
9162	symbol->set(flag);
9163	if (IsDummy(*symbol)) {
9164	SetImplicitAttr(*symbol, Attr::EXTERNAL);
9165	}
9166	ApplyImplicitRules(*symbol);
9167	if (hasCUDAChevrons) {
9168	details->set_isCUDAKernel();
9169	}
9170	}
9171	}
9172	}
9173	}
9174
9175	static bool IsLocallyImplicitGlobalSymbol(
9176	const Symbol &symbol, const parser::Name &localName) {
9177	if (symbol.owner().IsGlobal()) {
9178	const auto *subp{symbol.detailsIf<SubprogramDetails>()};
9179	const Scope *scope{
9180	subp && subp->entryScope() ? subp->entryScope() : symbol.scope()};
9181	return !(scope && scope->sourceRange().Contains(localName.source));
9182	}
9183	return false;
9184	}
9185
9186	// Check and set the Function or Subroutine flag on symbol; false on error.
9187	bool ResolveNamesVisitor::SetProcFlag(
9188	const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
9189	if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
9190	SayWithDecl(
9191	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
9192	context().SetError(symbol);
9193	return false;
9194	} else if (symbol.test(Symbol::Flag::Subroutine) &&
9195	flag == Symbol::Flag::Function) {
9196	SayWithDecl(
9197	name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
9198	context().SetError(symbol);
9199	return false;
9200	} else if (flag == Symbol::Flag::Function &&
9201	IsLocallyImplicitGlobalSymbol(symbol, name) &&
9202	TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) {
9203	SayWithDecl(name, symbol,
9204	"Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);
9205	return false;
9206	} else if (symbol.has<ProcEntityDetails>()) {
9207	symbol.set(flag); // in case it hasn't been set yet
9208	if (flag == Symbol::Flag::Function) {
9209	ApplyImplicitRules(symbol);
9210	}
9211	if (symbol.attrs().test(Attr::INTRINSIC)) {
9212	AcquireIntrinsicProcedureFlags(symbol);
9213	}
9214	} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
9215	SayWithDecl(
9216	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
9217	context().SetError(symbol);
9218	} else if (symbol.attrs().test(Attr::INTRINSIC)) {
9219	AcquireIntrinsicProcedureFlags(symbol);
9220	}
9221	return true;
9222	}
9223
9224	bool ModuleVisitor::Pre(const parser::AccessStmt &x) {
9225	Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))};
9226	if (!currScope().IsModule()) { // C869
9227	Say(currStmtSource().value(),
9228	"%s statement may only appear in the specification part of a module"_err_en_US,
9229	EnumToString(accessAttr));
9230	return false;
9231	}
9232	const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)};
9233	if (accessIds.empty()) {
9234	if (prevAccessStmt_) { // C869
9235	Say("The default accessibility of this module has already been declared"_err_en_US)
9236	.Attach(*prevAccessStmt_, "Previous declaration"_en_US);
9237	}
9238	prevAccessStmt_ = currStmtSource();
9239	auto *moduleDetails{DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
9240	DEREF(moduleDetails).set_isDefaultPrivate(accessAttr == Attr::PRIVATE);
9241	} else {
9242	for (const auto &accessId : accessIds) {
9243	GenericSpecInfo info{accessId.v.value()};
9244	auto *symbol{FindInScope(info.symbolName())};
9245	if (!symbol && !info.kind().IsName()) {
9246	symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{});
9247	}
9248	info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol));
9249	}
9250	}
9251	return false;
9252	}
9253
9254	// Set the access specification for this symbol.
9255	Symbol &ModuleVisitor::SetAccess(
9256	const SourceName &name, Attr attr, Symbol *symbol) {
9257	if (!symbol) {
9258	symbol = &MakeSymbol(name);
9259	}
9260	Attrs &attrs{symbol->attrs()};
9261	if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
9262	// PUBLIC/PRIVATE already set: make it a fatal error if it changed
9263	Attr prev{attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE};
9264	if (attr != prev) {
9265	Say(name,
9266	"The accessibility of '%s' has already been specified as %s"_err_en_US,
9267	MakeOpName(name), EnumToString(prev));
9268	} else {
9269	context().Warn(common::LanguageFeature::RedundantAttribute, name,
9270	"The accessibility of '%s' has already been specified as %s"_warn_en_US,
9271	MakeOpName(name), EnumToString(prev));
9272	}
9273	} else {
9274	attrs.set(attr);
9275	}
9276	return *symbol;
9277	}
9278
9279	static bool NeedsExplicitType(const Symbol &symbol) {
9280	if (symbol.has<UnknownDetails>()) {
9281	return true;
9282	} else if (const auto *details{symbol.detailsIf<EntityDetails>()}) {
9283	return !details->type();
9284	} else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
9285	return !details->type();
9286	} else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
9287	return !details->procInterface() && !details->type();
9288	} else {
9289	return false;
9290	}
9291	}
9292
9293	void ResolveNamesVisitor::HandleDerivedTypesInImplicitStmts(
9294	const parser::ImplicitPart &implicitPart,
9295	const std::list<parser::DeclarationConstruct> &decls) {
9296	// Detect derived type definitions and create symbols for them now if
9297	// they appear in IMPLICIT statements so that these forward-looking
9298	// references will not be ambiguous with host associations.
9299	std::set<SourceName> implicitDerivedTypes;
9300	for (const auto &ipStmt : implicitPart.v) {
9301	if (const auto *impl{std::get_if<
9302	parser::Statement<common::Indirection<parser::ImplicitStmt>>>(
9303	&ipStmt.u)}) {
9304	if (const auto *specs{std::get_if<std::list<parser::ImplicitSpec>>(
9305	&impl->statement.value().u)}) {
9306	for (const auto &spec : *specs) {
9307	const auto &declTypeSpec{
9308	std::get<parser::DeclarationTypeSpec>(spec.t)};
9309	if (const auto *dtSpec{common::visit(
9310	common::visitors{
9311	[](const parser::DeclarationTypeSpec::Type &x) {
9312	return &x.derived;
9313	},
9314	[](const parser::DeclarationTypeSpec::Class &x) {
9315	return &x.derived;
9316	},
9317	[](const auto &) -> const parser::DerivedTypeSpec * {
9318	return nullptr;
9319	}},
9320	declTypeSpec.u)}) {
9321	implicitDerivedTypes.emplace(
9322	std::get<parser::Name>(dtSpec->t).source);
9323	}
9324	}
9325	}
9326	}
9327	}
9328	if (!implicitDerivedTypes.empty()) {
9329	for (const auto &decl : decls) {
9330	if (const auto *spec{
9331	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
9332	if (const auto *dtDef{
9333	std::get_if<common::Indirection<parser::DerivedTypeDef>>(
9334	&spec->u)}) {
9335	const parser::DerivedTypeStmt &dtStmt{
9336	std::get<parser::Statement<parser::DerivedTypeStmt>>(
9337	dtDef->value().t)
9338	.statement};
9339	const parser::Name &name{std::get<parser::Name>(dtStmt.t)};
9340	if (implicitDerivedTypes.find(name.source) !=
9341	implicitDerivedTypes.end() &&
9342	!FindInScope(name)) {
9343	DerivedTypeDetails details;
9344	details.set_isForwardReferenced(true);
9345	Resolve(name, MakeSymbol(name, std::move(details)));
9346	implicitDerivedTypes.erase(name.source);
9347	}
9348	}
9349	}
9350	}
9351	}
9352	}
9353
9354	bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
9355	const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
9356	implicitPart, decls] = x.t;
9357	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
9358	auto stateRestorer{
9359	common::ScopedSet(specPartState_, SpecificationPartState{})};
9360	Walk(accDecls);
9361	Walk(ompDecls);
9362	Walk(compilerDirectives);
9363	for (const auto &useStmt : useStmts) {
9364	CollectUseRenames(useStmt.statement.value());
9365	}
9366	Walk(useStmts);
9367	UseCUDABuiltinNames();
9368	ClearUseRenames();
9369	ClearUseOnly();
9370	ClearModuleUses();
9371	Walk(importStmts);
9372	HandleDerivedTypesInImplicitStmts(implicitPart, decls);
9373	Walk(implicitPart);
9374	for (const auto &decl : decls) {
9375	if (const auto *spec{
9376	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
9377	PreSpecificationConstruct(*spec);
9378	}
9379	}
9380	Walk(decls);
9381	FinishSpecificationPart(decls);
9382	return false;
9383	}
9384
9385	void ResolveNamesVisitor::UseCUDABuiltinNames() {
9386	if (FindCUDADeviceContext(&currScope())) {
9387	for (const auto &[name, symbol] : context().GetCUDABuiltinsScope()) {
9388	if (!FindInScope(name)) {
9389	auto &localSymbol{MakeSymbol(name)};
9390	localSymbol.set_details(UseDetails{name, *symbol});
9391	localSymbol.flags() = symbol->flags();
9392	}
9393	}
9394	}
9395	}
9396
9397	// Initial processing on specification constructs, before visiting them.
9398	void ResolveNamesVisitor::PreSpecificationConstruct(
9399	const parser::SpecificationConstruct &spec) {
9400	common::visit(
9401	common::visitors{
9402	[&](const parser::Statement<
9403	common::Indirection<parser::TypeDeclarationStmt>> &y) {
9404	EarlyDummyTypeDeclaration(y);
9405	},
9406	[&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
9407	CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
9408	},
9409	[&](const Indirection<parser::InterfaceBlock> &y) {
9410	const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(
9411	y.value().t)};
9412	if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) {
9413	CreateGeneric(*spec);
9414	}
9415	},
9416	[&](const parser::Statement<parser::OtherSpecificationStmt> &y) {
9417	common::visit(
9418	common::visitors{
9419	[&](const common::Indirection<parser::CommonStmt> &z) {
9420	CreateCommonBlockSymbols(z.value());
9421	},
9422	[&](const common::Indirection<parser::TargetStmt> &z) {
9423	CreateObjectSymbols(z.value().v, Attr::TARGET);
9424	},
9425	[](const auto &) {},
9426	},
9427	y.statement.u);
9428	},
9429	[](const auto &) {},
9430	},
9431	spec.u);
9432	}
9433
9434	void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
9435	const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
9436	&stmt) {
9437	context().set_location(stmt.source);
9438	const auto &[declTypeSpec, attrs, entities] = stmt.statement.value().t;
9439	if (const auto *intrin{
9440	std::get_if<parser::IntrinsicTypeSpec>(&declTypeSpec.u)}) {
9441	if (const auto *intType{std::get_if<parser::IntegerTypeSpec>(&intrin->u)}) {
9442	if (const auto &kind{intType->v}) {
9443	if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&
9444	!parser::Unwrap<parser::IntLiteralConstant>(*kind)) {
9445	return;
9446	}
9447	}
9448	const DeclTypeSpec *type{nullptr};
9449	for (const auto &ent : entities) {
9450	const auto &objName{std::get<parser::ObjectName>(ent.t)};
9451	Resolve(objName, FindInScope(currScope(), objName));
9452	if (Symbol * symbol{objName.symbol};
9453	symbol && IsDummy(*symbol) && NeedsType(*symbol)) {
9454	if (!type) {
9455	type = ProcessTypeSpec(declTypeSpec);
9456	if (!type || !type->IsNumeric(TypeCategory::Integer)) {
9457	break;
9458	}
9459	}
9460	symbol->SetType(*type);
9461	NoteEarlyDeclaredDummyArgument(*symbol);
9462	// Set the Implicit flag to disable bogus errors from
9463	// being emitted later when this declaration is processed
9464	// again normally.
9465	symbol->set(Symbol::Flag::Implicit);
9466	}
9467	}
9468	}
9469	}
9470	}
9471
9472	void ResolveNamesVisitor::CreateCommonBlockSymbols(
9473	const parser::CommonStmt &commonStmt) {
9474	for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
9475	const auto &[name, objects] = block.t;
9476	Symbol &commonBlock{MakeCommonBlockSymbol(name)};
9477	for (const auto &object : objects) {
9478	Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};
9479	if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {
9480	details->set_commonBlock(commonBlock);
9481	commonBlock.get<CommonBlockDetails>().add_object(obj);
9482	}
9483	}
9484	}
9485	}
9486
9487	void ResolveNamesVisitor::CreateObjectSymbols(
9488	const std::list<parser::ObjectDecl> &decls, Attr attr) {
9489	for (const parser::ObjectDecl &decl : decls) {
9490	SetImplicitAttr(DeclareEntity<ObjectEntityDetails>(
9491	std::get<parser::ObjectName>(decl.t), Attrs{}),
9492	attr);
9493	}
9494	}
9495
9496	void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
9497	auto info{GenericSpecInfo{x}};
9498	SourceName symbolName{info.symbolName()};
9499	if (IsLogicalConstant(context(), symbolName)) {
9500	Say(symbolName,
9501	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
9502	return;
9503	}
9504	GenericDetails genericDetails;
9505	Symbol *existing{nullptr};
9506	// Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
9507	for (const std::string &n : GetAllNames(context(), symbolName)) {
9508	existing = currScope().FindSymbol(SourceName{n});
9509	if (existing) {
9510	break;
9511	}
9512	}
9513	if (existing) {
9514	Symbol &ultimate{existing->GetUltimate()};
9515	if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
9516	if (&existing->owner() == &currScope()) {
9517	if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
9518	// Create a local copy of a use associated generic so that
9519	// it can be locally extended without corrupting the original.
9520	genericDetails.CopyFrom(*existingGeneric);
9521	if (existingGeneric->specific()) {
9522	genericDetails.set_specific(*existingGeneric->specific());
9523	}
9524	AddGenericUse(
9525	genericDetails, existing->name(), existingUse->symbol());
9526	} else if (existing == &ultimate) {
9527	// Extending an extant generic in the same scope
9528	info.Resolve(existing);
9529	return;
9530	} else {
9531	// Host association of a generic is handled elsewhere
9532	CHECK(existing->has<HostAssocDetails>());
9533	}
9534	} else {
9535	// Create a new generic for this scope.
9536	}
9537	} else if (ultimate.has<SubprogramDetails>() ||
9538	ultimate.has<SubprogramNameDetails>()) {
9539	genericDetails.set_specific(*existing);
9540	} else if (ultimate.has<ProcEntityDetails>()) {
9541	if (existing->name() != symbolName ||
9542	!ultimate.attrs().test(Attr::INTRINSIC)) {
9543	genericDetails.set_specific(*existing);
9544	}
9545	} else if (ultimate.has<DerivedTypeDetails>()) {
9546	genericDetails.set_derivedType(*existing);
9547	} else if (&existing->owner() == &currScope()) {
9548	SayAlreadyDeclared(symbolName, *existing);
9549	return;
9550	}
9551	if (&existing->owner() == &currScope()) {
9552	EraseSymbol(*existing);
9553	}
9554	}
9555	info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
9556	}
9557
9558	static void SetImplicitCUDADevice(bool inDeviceSubprogram, Symbol &symbol) {
9559	if (inDeviceSubprogram && symbol.has<ObjectEntityDetails>()) {
9560	auto *object{symbol.detailsIf<ObjectEntityDetails>()};
9561	if (!object->cudaDataAttr() && !IsValue(symbol) &&
9562	!IsFunctionResult(symbol)) {
9563	// Implicitly set device attribute if none is set in device context.
9564	object->set_cudaDataAttr(common::CUDADataAttr::Device);
9565	}
9566	}
9567	}
9568
9569	void ResolveNamesVisitor::FinishSpecificationPart(
9570	const std::list<parser::DeclarationConstruct> &decls) {
9571	misparsedStmtFuncFound_ = false;
9572	funcResultStack().CompleteFunctionResultType();
9573	CheckImports();
9574	bool inDeviceSubprogram{false};
9575	Symbol *scopeSym{currScope().symbol()};
9576	if (currScope().kind() == Scope::Kind::BlockConstruct) {
9577	scopeSym = currScope().parent().symbol();
9578	}
9579	if (scopeSym) {
9580	if (auto *details{scopeSym->detailsIf<SubprogramDetails>()}) {
9581	// Check the current procedure is a device procedure to apply implicit
9582	// attribute at the end.
9583	if (auto attrs{details->cudaSubprogramAttrs()}) {
9584	if (*attrs == common::CUDASubprogramAttrs::Device ||
9585	*attrs == common::CUDASubprogramAttrs::Global ||
9586	*attrs == common::CUDASubprogramAttrs::Grid_Global) {
9587	inDeviceSubprogram = true;
9588	}
9589	}
9590	}
9591	}
9592	for (auto &pair : currScope()) {
9593	auto &symbol{*pair.second};
9594	if (inInterfaceBlock()) {
9595	ConvertToObjectEntity(symbol);
9596	}
9597	if (NeedsExplicitType(symbol)) {
9598	ApplyImplicitRules(symbol);
9599	}
9600	if (IsDummy(symbol) && isImplicitNoneType() &&
9601	symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
9602	Say(symbol.name(),
9603	"No explicit type declared for dummy argument '%s'"_err_en_US);
9604	context().SetError(symbol);
9605	}
9606	if (symbol.has<GenericDetails>()) {
9607	CheckGenericProcedures(symbol);
9608	}
9609	if (!symbol.has<HostAssocDetails>()) {
9610	CheckPossibleBadForwardRef(symbol);
9611	}
9612	// Propagate BIND(C) attribute to procedure entities from their interfaces,
9613	// but not the NAME=, even if it is empty (which would be a reasonable
9614	// and useful behavior, actually). This interpretation is not at all
9615	// clearly described in the standard, but matches the behavior of several
9616	// other compilers.
9617	if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
9618	!proc->isDummy() && !IsPointer(symbol) &&
9619	!symbol.attrs().test(Attr::BIND_C)) {
9620	if (const Symbol * iface{proc->procInterface()};
9621	iface && IsBindCProcedure(*iface)) {
9622	SetImplicitAttr(symbol, Attr::BIND_C);
9623	SetBindNameOn(symbol);
9624	}
9625	}
9626	if (currScope().kind() == Scope::Kind::BlockConstruct) {
9627	// Only look for specification in BlockConstruct. Other cases are done in
9628	// ResolveSpecificationParts.
9629	SetImplicitCUDADevice(inDeviceSubprogram, symbol);
9630	}
9631	}
9632	currScope().InstantiateDerivedTypes();
9633	for (const auto &decl : decls) {
9634	if (const auto *statement{std::get_if<
9635	parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(
9636	&decl.u)}) {
9637	messageHandler().set_currStmtSource(statement->source);
9638	AnalyzeStmtFunctionStmt(statement->statement.value());
9639	}
9640	}
9641	// TODO: what about instantiations in BLOCK?
9642	CheckSaveStmts();
9643	CheckCommonBlocks();
9644	if (!inInterfaceBlock()) {
9645	// TODO: warn for the case where the EQUIVALENCE statement is in a
9646	// procedure declaration in an interface block
9647	CheckEquivalenceSets();
9648	}
9649	}
9650
9651	// Analyze the bodies of statement functions now that the symbols in this
9652	// specification part have been fully declared and implicitly typed.
9653	// (Statement function references are not allowed in specification
9654	// expressions, so it's safe to defer processing their definitions.)
9655	void ResolveNamesVisitor::AnalyzeStmtFunctionStmt(
9656	const parser::StmtFunctionStmt &stmtFunc) {
9657	const auto &name{std::get<parser::Name>(stmtFunc.t)};
9658	Symbol *symbol{name.symbol};
9659	auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr};
9660	if (!details || !symbol->scope() ||
9661	&symbol->scope()->parent() != &currScope() || details->isInterface() ||
9662	details->isDummy() || details->entryScope() ||
9663	details->moduleInterface() || symbol->test(Symbol::Flag::Subroutine)) {
9664	return; // error recovery
9665	}
9666	// Resolve the symbols on the RHS of the statement function.
9667	PushScope(scope&: *symbol->scope());
9668	const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)};
9669	Walk(parsedExpr);
9670	PopScope();
9671	if (auto expr{AnalyzeExpr(context(), stmtFunc)}) {
9672	if (auto type{evaluate::DynamicType::From(*symbol)}) {
9673	if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) {
9674	details->set_stmtFunction(std::move(*converted));
9675	} else {
9676	Say(name.source,
9677	"Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US,
9678	name.source, type->AsFortran());
9679	}
9680	} else {
9681	details->set_stmtFunction(std::move(*expr));
9682	}
9683	}
9684	if (!details->stmtFunction()) {
9685	context().SetError(*symbol);
9686	}
9687	}
9688
9689	void ResolveNamesVisitor::CheckImports() {
9690	auto &scope{currScope()};
9691	switch (scope.GetImportKind()) {
9692	case common::ImportKind::None:
9693	break;
9694	case common::ImportKind::All:
9695	// C8102: all entities in host must not be hidden
9696	for (const auto &pair : scope.parent()) {
9697	auto &name{pair.first};
9698	std::optional<SourceName> scopeName{scope.GetName()};
9699	if (!scopeName || name != *scopeName) {
9700	CheckImport(prevImportStmt_.value(), name);
9701	}
9702	}
9703	break;
9704	case common::ImportKind::Default:
9705	case common::ImportKind::Only:
9706	// C8102: entities named in IMPORT must not be hidden
9707	for (auto &name : scope.importNames()) {
9708	CheckImport(name, name);
9709	}
9710	break;
9711	}
9712	}
9713
9714	void ResolveNamesVisitor::CheckImport(
9715	const SourceName &location, const SourceName &name) {
9716	if (auto *symbol{FindInScope(name)}) {
9717	const Symbol &ultimate{symbol->GetUltimate()};
9718	if (&ultimate.owner() == &currScope()) {
9719	Say(location, "'%s' from host is not accessible"_err_en_US, name)
9720	.Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US,
9721	symbol->name());
9722	}
9723	}
9724	}
9725
9726	bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {
9727	return CheckNotInBlock("IMPLICIT") && // C1107
9728	ImplicitRulesVisitor::Pre(x);
9729	}
9730
9731	void ResolveNamesVisitor::Post(const parser::PointerObject &x) {
9732	common::visit(common::visitors{
9733	[&](const parser::Name &x) { ResolveName(x); },
9734	[&](const parser::StructureComponent &x) {
9735	ResolveStructureComponent(x);
9736	},
9737	},
9738	x.u);
9739	}
9740	void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {
9741	common::visit(common::visitors{
9742	[&](const parser::Name &x) { ResolveName(x); },
9743	[&](const parser::StructureComponent &x) {
9744	ResolveStructureComponent(x);
9745	},
9746	},
9747	x.u);
9748	}
9749
9750	bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
9751	const auto &dataRef{std::get<parser::DataRef>(x.t)};
9752	const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
9753	const auto &expr{std::get<parser::Expr>(x.t)};
9754	ResolveDataRef(x: dataRef);
9755	Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
9756	Walk(bounds);
9757	// Resolve unrestricted specific intrinsic procedures as in "p => cos".
9758	if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
9759	if (NameIsKnownOrIntrinsic(*name)) {
9760	if (Symbol * symbol{name->symbol}) {
9761	if (IsProcedurePointer(ptrSymbol) &&
9762	!ptrSymbol->test(Symbol::Flag::Function) &&
9763	!ptrSymbol->test(Symbol::Flag::Subroutine)) {
9764	if (symbol->test(Symbol::Flag::Function)) {
9765	ApplyImplicitRules(*ptrSymbol);
9766	}
9767	}
9768	// If the name is known because it is an object entity from a host
9769	// procedure, create a host associated symbol.
9770	if (symbol->GetUltimate().has<ObjectEntityDetails>() &&
9771	IsUplevelReference(*symbol)) {
9772	MakeHostAssocSymbol(*name, *symbol);
9773	}
9774	}
9775	return false;
9776	}
9777	// Can also reference a global external procedure here
9778	if (auto it{context().globalScope().find(name->source)};
9779	it != context().globalScope().end()) {
9780	Symbol &global{*it->second};
9781	if (IsProcedure(global)) {
9782	Resolve(*name, global);
9783	return false;
9784	}
9785	}
9786	if (IsProcedurePointer(parser::GetLastName(dataRef).symbol) &&
9787	!FindSymbol(*name)) {
9788	// Unknown target of procedure pointer must be an external procedure
9789	Symbol &symbol{MakeSymbol(
9790	context().globalScope(), name->source, Attrs{Attr::EXTERNAL})};
9791	symbol.implicitAttrs().set(Attr::EXTERNAL);
9792	Resolve(*name, symbol);
9793	ConvertToProcEntity(symbol, usedHere: name->source);
9794	return false;
9795	}
9796	}
9797	Walk(expr);
9798	return false;
9799	}
9800	void ResolveNamesVisitor::Post(const parser::Designator &x) {
9801	ResolveDesignator(x);
9802	}
9803	void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) {
9804	Walk(std::get<parser::SubstringRange>(x.v.t).t);
9805	ResolveDataRef(x: std::get<parser::DataRef>(x.v.t));
9806	}
9807
9808	void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
9809	ResolveStructureComponent(x.v.thing);
9810	}
9811	void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {
9812	DeclTypeSpecVisitor::Post(x);
9813	ConstructVisitor::Post(x);
9814	}
9815	bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
9816	if (HandleStmtFunction(x)) {
9817	return false;
9818	} else {
9819	// This is an array element or pointer-valued function assignment:
9820	// resolve the names of indices/arguments
9821	const auto &names{std::get<std::list<parser::Name>>(x.t)};
9822	for (auto &name : names) {
9823	ResolveName(name);
9824	}
9825	return true;
9826	}
9827	}
9828
9829	bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {
9830	const parser::Name &name{x.v};
9831	if (FindSymbol(name)) {
9832	// OK
9833	} else if (IsLogicalConstant(context(), name.source)) {
9834	Say(name,
9835	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
9836	} else {
9837	// Resolved later in expression semantics
9838	MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);
9839	}
9840	return false;
9841	}
9842
9843	void ResolveNamesVisitor::Post(const parser::AssignStmt &x) {
9844	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
9845	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
9846	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
9847	}
9848	}
9849	void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {
9850	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
9851	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
9852	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
9853	}
9854	}
9855
9856	void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
9857	if (std::holds_alternative<parser::CompilerDirective::VectorAlways>(x.u) ||
9858	std::holds_alternative<parser::CompilerDirective::Unroll>(x.u) ||
9859	std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(x.u) ||
9860	std::holds_alternative<parser::CompilerDirective::NoVector>(x.u) ||
9861	std::holds_alternative<parser::CompilerDirective::NoUnroll>(x.u) ||
9862	std::holds_alternative<parser::CompilerDirective::NoUnrollAndJam>(x.u)) {
9863	return;
9864	}
9865	if (const auto *tkr{
9866	std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) {
9867	if (currScope().IsTopLevel() ||
9868	GetProgramUnitContaining(currScope()).kind() !=
9869	Scope::Kind::Subprogram) {
9870	Say(x.source,
9871	"!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US);
9872	return;
9873	}
9874	if (!inSpecificationPart_) {
9875	Say(x.source,
9876	"!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US);
9877	return;
9878	}
9879	if (tkr->empty()) {
9880	Symbol *symbol{currScope().symbol()};
9881	if (SubprogramDetails *
9882	subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) {
9883	subp->set_defaultIgnoreTKR(true);
9884	}
9885	} else {
9886	for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) {
9887	common::IgnoreTKRSet set;
9888	if (const auto &maybeList{
9889	std::get<std::optional<std::list<const char *>>>(item.t)}) {
9890	for (const char *p : *maybeList) {
9891	if (p) {
9892	switch (*p) {
9893	case 't':
9894	set.set(common::IgnoreTKR::Type);
9895	break;
9896	case 'k':
9897	set.set(common::IgnoreTKR::Kind);
9898	break;
9899	case 'r':
9900	set.set(common::IgnoreTKR::Rank);
9901	break;
9902	case 'd':
9903	set.set(common::IgnoreTKR::Device);
9904	break;
9905	case 'm':
9906	set.set(common::IgnoreTKR::Managed);
9907	break;
9908	case 'c':
9909	set.set(common::IgnoreTKR::Contiguous);
9910	break;
9911	case 'a':
9912	set = common::ignoreTKRAll;
9913	break;
9914	default:
9915	Say(x.source,
9916	"'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US,
9917	*p);
9918	set = common::ignoreTKRAll;
9919	break;
9920	}
9921	}
9922	}
9923	if (set.empty()) {
9924	Say(x.source,
9925	"!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US);
9926	}
9927	} else { // no (list)
9928	set = common::ignoreTKRAll;
9929	;
9930	}
9931	const auto &name{std::get<parser::Name>(item.t)};
9932	Symbol *symbol{FindSymbol(name)};
9933	if (!symbol) {
9934	symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{});
9935	}
9936	if (symbol->owner() != currScope()) {
9937	SayWithDecl(
9938	name, *symbol, "'%s' must be local to this subprogram"_err_en_US);
9939	} else {
9940	ConvertToObjectEntity(*symbol);
9941	if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) {
9942	object->set_ignoreTKR(set);
9943	} else {
9944	SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US);
9945	}
9946	}
9947	}
9948	}
9949	} else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) {
9950	Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US)
9951	.set_usageWarning(common::UsageWarning::IgnoredDirective);
9952	}
9953	}
9954
9955	bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
9956	if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
9957	x.u)) {
9958	// TODO: global directives
9959	return true;
9960	}
9961	if (std::holds_alternative<
9962	common::Indirection<parser::OpenACCRoutineConstruct>>(x.u)) {
9963	ResolveAccParts(context(), x, &topScope_);
9964	return false;
9965	}
9966	ProgramTree &root{ProgramTree::Build(x, context())};
9967	SetScope(topScope_);
9968	ResolveSpecificationParts(root);
9969	FinishSpecificationParts(root);
9970	ResolveExecutionParts(root);
9971	FinishExecutionParts(root);
9972	ResolveAccParts(context(), x, /*topScope=*/nullptr);
9973	ResolveOmpParts(context(), x);
9974	return false;
9975	}
9976
9977	template <typename A> std::set<SourceName> GetUses(const A &x) {
9978	std::set<SourceName> uses;
9979	if constexpr (!std::is_same_v<A, parser::CompilerDirective> &&
9980	!std::is_same_v<A, parser::OpenACCRoutineConstruct>) {
9981	const auto &spec{std::get<parser::SpecificationPart>(x.t)};
9982	const auto &unitUses{std::get<
9983	std::list<parser::Statement<common::Indirection<parser::UseStmt>>>>(
9984	spec.t)};
9985	for (const auto &u : unitUses) {
9986	uses.insert(u.statement.value().moduleName.source);
9987	}
9988	}
9989	return uses;
9990	}
9991
9992	bool ResolveNamesVisitor::Pre(const parser::Program &x) {
9993	if (Scope * hermetic{context().currentHermeticModuleFileScope()}) {
9994	// Processing either the dependent modules or first module of a
9995	// hermetic module file; ensure that the hermetic module scope has
9996	// its implicit rules map entry.
9997	ImplicitRulesVisitor::BeginScope(*hermetic);
9998	}
9999	std::map<SourceName, const parser::ProgramUnit *> modules;
10000	std::set<SourceName> uses;
10001	bool disordered{false};
10002	for (const auto &progUnit : x.v) {
10003	if (const auto *indMod{
10004	std::get_if<common::Indirection<parser::Module>>(&progUnit.u)}) {
10005	const parser::Module &mod{indMod->value()};
10006	const auto &moduleStmt{
10007	std::get<parser::Statement<parser::ModuleStmt>>(mod.t)};
10008	const SourceName &name{moduleStmt.statement.v.source};
10009	if (auto iter{modules.find(name)}; iter != modules.end()) {
10010	Say(name,
10011	"Module '%s' appears multiple times in a compilation unit"_err_en_US)
10012	.Attach(iter->first, "First definition of module"_en_US);
10013	return true;
10014	}
10015	modules.emplace(name, &progUnit);
10016	if (auto iter{uses.find(name)}; iter != uses.end()) {
10017	if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
10018	Say(name,
10019	"A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US,
10020	name)
10021	.Attach(*iter, "First USE of module"_en_US);
10022	}
10023	disordered = true;
10024	}
10025	}
10026	for (SourceName used : common::visit(
10027	[](const auto &indUnit) { return GetUses(indUnit.value()); },
10028	progUnit.u)) {
10029	uses.insert(used);
10030	}
10031	}
10032	if (!disordered) {
10033	return true;
10034	}
10035	// Process modules in topological order
10036	std::vector<const parser::ProgramUnit *> moduleOrder;
10037	while (!modules.empty()) {
10038	bool ok;
10039	for (const auto &pair : modules) {
10040	const SourceName &name{pair.first};
10041	const parser::ProgramUnit &progUnit{*pair.second};
10042	const parser::Module &m{
10043	std::get<common::Indirection<parser::Module>>(progUnit.u).value()};
10044	ok = true;
10045	for (const SourceName &use : GetUses(m)) {
10046	if (modules.find(use) != modules.end()) {
10047	ok = false;
10048	break;
10049	}
10050	}
10051	if (ok) {
10052	moduleOrder.push_back(x: &progUnit);
10053	modules.erase(x: name);
10054	break;
10055	}
10056	}
10057	if (!ok) {
10058	Message *msg{nullptr};
10059	for (const auto &pair : modules) {
10060	if (msg) {
10061	msg->Attach(pair.first, "Module in a cycle"_en_US);
10062	} else {
10063	msg = &Say(pair.first,
10064	"Some modules in this compilation unit form one or more cycles of dependence"_err_en_US);
10065	}
10066	}
10067	return false;
10068	}
10069	}
10070	// Modules can be ordered. Process them first, and then all of the other
10071	// program units.
10072	for (const parser::ProgramUnit *progUnit : moduleOrder) {
10073	Walk(*progUnit);
10074	}
10075	for (const auto &progUnit : x.v) {
10076	if (!std::get_if<common::Indirection<parser::Module>>(&progUnit.u)) {
10077	Walk(progUnit);
10078	}
10079	}
10080	return false;
10081	}
10082
10083	// References to procedures need to record that their symbols are known
10084	// to be procedures, so that they don't get converted to objects by default.
10085	class ExecutionPartCallSkimmer : public ExecutionPartSkimmerBase {
10086	public:
10087	explicit ExecutionPartCallSkimmer(ResolveNamesVisitor &resolver)
10088	: resolver_{resolver} {}
10089
10090	void Walk(const parser::ExecutionPart &exec) {
10091	parser::Walk(exec, *this);
10092	EndWalk();
10093	}
10094
10095	using ExecutionPartSkimmerBase::Post;
10096	using ExecutionPartSkimmerBase::Pre;
10097
10098	void Post(const parser::FunctionReference &fr) {
10099	NoteCall(Symbol::Flag::Function, fr.v, false);
10100	}
10101	void Post(const parser::CallStmt &cs) {
10102	NoteCall(Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
10103	}
10104
10105	private:
10106	void NoteCall(
10107	Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
10108	auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
10109	if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
10110	if (!IsHidden(name: name->source)) {
10111	resolver_.NoteExecutablePartCall(flag, name->source, hasCUDAChevrons);
10112	}
10113	}
10114	}
10115
10116	ResolveNamesVisitor &resolver_;
10117	};
10118
10119	// Build the scope tree and resolve names in the specification parts of this
10120	// node and its children
10121	void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
10122	if (node.isSpecificationPartResolved()) {
10123	return; // been here already
10124	}
10125	node.set_isSpecificationPartResolved();
10126	if (!BeginScopeForNode(node)) {
10127	return; // an error prevented scope from being created
10128	}
10129	Scope &scope{currScope()};
10130	node.set_scope(scope);
10131	AddSubpNames(node);
10132	common::visit(
10133	[&](const auto *x) {
10134	if (x) {
10135	Walk(*x);
10136	}
10137	},
10138	node.stmt());
10139	Walk(node.spec());
10140	bool inDeviceSubprogram{false};
10141	// If this is a function, convert result to an object. This is to prevent the
10142	// result from being converted later to a function symbol if it is called
10143	// inside the function.
10144	// If the result is function pointer, then ConvertToObjectEntity will not
10145	// convert the result to an object, and calling the symbol inside the function
10146	// will result in calls to the result pointer.
10147	// A function cannot be called recursively if RESULT was not used to define a
10148	// distinct result name (15.6.2.2 point 4.).
10149	if (Symbol * symbol{scope.symbol()}) {
10150	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
10151	if (details->isFunction()) {
10152	ConvertToObjectEntity(const_cast<Symbol &>(details->result()));
10153	}
10154	// Check the current procedure is a device procedure to apply implicit
10155	// attribute at the end.
10156	if (auto attrs{details->cudaSubprogramAttrs()}) {
10157	if (*attrs == common::CUDASubprogramAttrs::Device ||
10158	*attrs == common::CUDASubprogramAttrs::Global ||
10159	*attrs == common::CUDASubprogramAttrs::Grid_Global) {
10160	inDeviceSubprogram = true;
10161	}
10162	}
10163	}
10164	}
10165	if (node.IsModule()) {
10166	ApplyDefaultAccess();
10167	}
10168	for (auto &child : node.children()) {
10169	ResolveSpecificationParts(child);
10170	}
10171	if (node.exec()) {
10172	ExecutionPartCallSkimmer{*this}.Walk(*node.exec());
10173	HandleImpliedAsynchronousInScope(node.exec()->v);
10174	}
10175	EndScopeForNode(node);
10176	// Ensure that every object entity has a type.
10177	bool inModule{node.GetKind() == ProgramTree::Kind::Module ||
10178	node.GetKind() == ProgramTree::Kind::Submodule};
10179	for (auto &pair : *node.scope()) {
10180	Symbol &symbol{*pair.second};
10181	if (inModule && symbol.attrs().test(Attr::EXTERNAL) && !IsPointer(symbol) &&
10182	!symbol.test(Symbol::Flag::Function) &&
10183	!symbol.test(Symbol::Flag::Subroutine)) {
10184	// in a module, external proc without return type is subroutine
10185	symbol.set(
10186	symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
10187	}
10188	ApplyImplicitRules(symbol);
10189	// Apply CUDA implicit attributes if needed.
10190	SetImplicitCUDADevice(inDeviceSubprogram, symbol);
10191	// Main program local objects usually don't have an implied SAVE attribute,
10192	// as one might think, but in the exceptional case of a derived type
10193	// local object that contains a coarray, we have to mark it as an
10194	// implied SAVE so that evaluate::IsSaved() will return true.
10195	if (node.scope()->kind() == Scope::Kind::MainProgram) {
10196	if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
10197	if (const DeclTypeSpec * type{object->type()}) {
10198	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
10199	if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {
10200	SetImplicitAttr(symbol, Attr::SAVE);
10201	}
10202	}
10203	}
10204	}
10205	}
10206	}
10207	}
10208
10209	// Add SubprogramNameDetails symbols for module and internal subprograms and
10210	// their ENTRY statements.
10211	void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
10212	auto kind{
10213	node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
10214	for (auto &child : node.children()) {
10215	auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
10216	if (child.HasModulePrefix()) {
10217	SetExplicitAttr(symbol, Attr::MODULE);
10218	}
10219	if (child.bindingSpec()) {
10220	SetExplicitAttr(symbol, Attr::BIND_C);
10221	}
10222	auto childKind{child.GetKind()};
10223	if (childKind == ProgramTree::Kind::Function) {
10224	symbol.set(Symbol::Flag::Function);
10225	} else if (childKind == ProgramTree::Kind::Subroutine) {
10226	symbol.set(Symbol::Flag::Subroutine);
10227	} else {
10228	continue; // make ENTRY symbols only where valid
10229	}
10230	for (const auto &entryStmt : child.entryStmts()) {
10231	SubprogramNameDetails details{kind, child};
10232	auto &symbol{
10233	MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
10234	symbol.set(child.GetSubpFlag());
10235	if (child.HasModulePrefix()) {
10236	SetExplicitAttr(symbol, Attr::MODULE);
10237	}
10238	if (child.bindingSpec()) {
10239	SetExplicitAttr(symbol, Attr::BIND_C);
10240	}
10241	}
10242	}
10243	for (const auto &generic : node.genericSpecs()) {
10244	if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {
10245	if (currScope().find(name->source) != currScope().end()) {
10246	// If this scope has both a generic interface and a contained
10247	// subprogram with the same name, create the generic's symbol
10248	// now so that any other generics of the same name that are pulled
10249	// into scope later via USE association will properly merge instead
10250	// of raising a bogus error due a conflict with the subprogram.
10251	CreateGeneric(*generic);
10252	}
10253	}
10254	}
10255	}
10256
10257	// Push a new scope for this node or return false on error.
10258	bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
10259	switch (node.GetKind()) {
10260	SWITCH_COVERS_ALL_CASES
10261	case ProgramTree::Kind::Program:
10262	PushScope(Scope::Kind::MainProgram,
10263	&MakeSymbol(node.name(), MainProgramDetails{}));
10264	return true;
10265	case ProgramTree::Kind::Function:
10266	case ProgramTree::Kind::Subroutine:
10267	return BeginSubprogram(node.name(), node.GetSubpFlag(),
10268	node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts());
10269	case ProgramTree::Kind::MpSubprogram:
10270	return BeginMpSubprogram(name: node.name());
10271	case ProgramTree::Kind::Module:
10272	BeginModule(name: node.name(), isSubmodule: false);
10273	return true;
10274	case ProgramTree::Kind::Submodule:
10275	return BeginSubmodule(node.name(), node.GetParentId());
10276	case ProgramTree::Kind::BlockData:
10277	PushBlockDataScope(name: node.name());
10278	return true;
10279	}
10280	}
10281
10282	void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) {
10283	std::optional<parser::CharBlock> stmtSource;
10284	const std::optional<parser::LanguageBindingSpec> *binding{nullptr};
10285	common::visit(
10286	common::visitors{
10287	[&](const parser::Statement<parser::FunctionStmt> *stmt) {
10288	if (stmt) {
10289	stmtSource = stmt->source;
10290	if (const auto &maybeSuffix{
10291	std::get<std::optional<parser::Suffix>>(
10292	stmt->statement.t)}) {
10293	binding = &maybeSuffix->binding;
10294	}
10295	}
10296	},
10297	[&](const parser::Statement<parser::SubroutineStmt> *stmt) {
10298	if (stmt) {
10299	stmtSource = stmt->source;
10300	binding = &std::get<std::optional<parser::LanguageBindingSpec>>(
10301	stmt->statement.t);
10302	}
10303	},
10304	[](const auto *) {},
10305	},
10306	node.stmt());
10307	EndSubprogram(stmtSource, binding, &node.entryStmts());
10308	}
10309
10310	// Some analyses and checks, such as the processing of initializers of
10311	// pointers, are deferred until all of the pertinent specification parts
10312	// have been visited. This deferred processing enables the use of forward
10313	// references in these circumstances.
10314	// Data statement objects with implicit derived types are finally
10315	// resolved here.
10316	class DeferredCheckVisitor {
10317	public:
10318	explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)
10319	: resolver_{resolver} {}
10320
10321	template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
10322
10323	template <typename A> bool Pre(const A &) { return true; }
10324	template <typename A> void Post(const A &) {}
10325
10326	void Post(const parser::DerivedTypeStmt &x) {
10327	const auto &name{std::get<parser::Name>(x.t)};
10328	if (Symbol * symbol{name.symbol}) {
10329	if (Scope * scope{symbol->scope()}) {
10330	if (scope->IsDerivedType()) {
10331	CHECK(outerScope_ == nullptr);
10332	outerScope_ = &resolver_.currScope();
10333	resolver_.SetScope(*scope);
10334	}
10335	}
10336	}
10337	}
10338	void Post(const parser::EndTypeStmt &) {
10339	if (outerScope_) {
10340	resolver_.SetScope(*outerScope_);
10341	outerScope_ = nullptr;
10342	}
10343	}
10344
10345	void Post(const parser::ProcInterface &pi) {
10346	if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
10347	resolver_.CheckExplicitInterface(name: *name);
10348	}
10349	}
10350	bool Pre(const parser::EntityDecl &decl) {
10351	Init(std::get<parser::Name>(decl.t),
10352	std::get<std::optional<parser::Initialization>>(decl.t));
10353	return false;
10354	}
10355	bool Pre(const parser::ComponentDecl &decl) {
10356	Init(std::get<parser::Name>(decl.t),
10357	std::get<std::optional<parser::Initialization>>(decl.t));
10358	return false;
10359	}
10360	bool Pre(const parser::ProcDecl &decl) {
10361	if (const auto &init{
10362	std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {
10363	resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init);
10364	}
10365	return false;
10366	}
10367	void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) {
10368	resolver_.CheckExplicitInterface(name: tbps.interfaceName);
10369	}
10370	void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
10371	if (outerScope_) {
10372	resolver_.CheckBindings(tbps);
10373	}
10374	}
10375	bool Pre(const parser::DataStmtObject &) {
10376	++dataStmtObjectNesting_;
10377	return true;
10378	}
10379	void Post(const parser::DataStmtObject &) { --dataStmtObjectNesting_; }
10380	void Post(const parser::Designator &x) {
10381	if (dataStmtObjectNesting_ > 0) {
10382	resolver_.ResolveDesignator(x);
10383	}
10384	}
10385
10386	private:
10387	void Init(const parser::Name &name,
10388	const std::optional<parser::Initialization> &init) {
10389	if (init) {
10390	if (const auto *target{
10391	std::get_if<parser::InitialDataTarget>(&init->u)}) {
10392	resolver_.PointerInitialization(name, *target);
10393	} else if (const auto *expr{
10394	std::get_if<parser::ConstantExpr>(&init->u)}) {
10395	if (name.symbol) {
10396	if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};
10397	!object || !object->init()) {
10398	resolver_.NonPointerInitialization(name, *expr);
10399	}
10400	}
10401	}
10402	}
10403	}
10404
10405	ResolveNamesVisitor &resolver_;
10406	Scope *outerScope_{nullptr};
10407	int dataStmtObjectNesting_{0};
10408	};
10409
10410	// Perform checks and completions that need to happen after all of
10411	// the specification parts but before any of the execution parts.
10412	void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
10413	if (!node.scope()) {
10414	return; // error occurred creating scope
10415	}
10416	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
10417	SetScope(*node.scope());
10418	// The initializers of pointers and non-PARAMETER objects, the default
10419	// initializers of components, and non-deferred type-bound procedure
10420	// bindings have not yet been traversed.
10421	// We do that now, when any forward references that appeared
10422	// in those initializers will resolve to the right symbols without
10423	// incurring spurious errors with IMPLICIT NONE or forward references
10424	// to nested subprograms.
10425	DeferredCheckVisitor{*this}.Walk(node.spec());
10426	for (Scope &childScope : currScope().children()) {
10427	if (childScope.IsParameterizedDerivedTypeInstantiation()) {
10428	FinishDerivedTypeInstantiation(childScope);
10429	}
10430	}
10431	for (const auto &child : node.children()) {
10432	FinishSpecificationParts(child);
10433	}
10434	}
10435
10436	void ResolveNamesVisitor::FinishExecutionParts(const ProgramTree &node) {
10437	if (node.scope()) {
10438	SetScope(*node.scope());
10439	if (node.exec()) {
10440	DeferredCheckVisitor{*this}.Walk(*node.exec());
10441	}
10442	for (const auto &child : node.children()) {
10443	FinishExecutionParts(child);
10444	}
10445	}
10446	}
10447
10448	// Duplicate and fold component object pointer default initializer designators
10449	// using the actual type parameter values of each particular instantiation.
10450	// Validation is done later in declaration checking.
10451	void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
10452	CHECK(scope.IsDerivedType() && !scope.symbol());
10453	if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
10454	spec->Instantiate(currScope());
10455	const Symbol &origTypeSymbol{spec->typeSymbol()};
10456	if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
10457	CHECK(origTypeScope->IsDerivedType() &&
10458	origTypeScope->symbol() == &origTypeSymbol);
10459	auto &foldingContext{GetFoldingContext()};
10460	auto restorer{foldingContext.WithPDTInstance(*spec)};
10461	for (auto &pair : scope) {
10462	Symbol &comp{*pair.second};
10463	const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};
10464	if (IsPointer(comp)) {
10465	if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
10466	auto origDetails{origComp.get<ObjectEntityDetails>()};
10467	if (const MaybeExpr & init{origDetails.init()}) {
10468	SomeExpr newInit{*init};
10469	MaybeExpr folded{FoldExpr(std::move(newInit))};
10470	details->set_init(std::move(folded));
10471	}
10472	}
10473	}
10474	}
10475	}
10476	}
10477	}
10478
10479	// Resolve names in the execution part of this node and its children
10480	void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {
10481	if (!node.scope()) {
10482	return; // error occurred creating scope
10483	}
10484	SetScope(*node.scope());
10485	if (const auto *exec{node.exec()}) {
10486	Walk(*exec);
10487	}
10488	FinishNamelists();
10489	if (node.IsModule()) {
10490	// A second final pass to catch new symbols added from implicitly
10491	// typed names in NAMELIST groups or the specification parts of
10492	// module subprograms.
10493	ApplyDefaultAccess();
10494	}
10495	PopScope(); // converts unclassified entities into objects
10496	for (const auto &child : node.children()) {
10497	ResolveExecutionParts(child);
10498	}
10499	}
10500
10501	void ResolveNamesVisitor::Post(const parser::Program &x) {
10502	// ensure that all temps were deallocated
10503	CHECK(!attrs_);
10504	CHECK(!cudaDataAttr_);
10505	CHECK(!GetDeclTypeSpec());
10506	// Top-level resolution to propagate information across program units after
10507	// each of them has been resolved separately.
10508	ResolveOmpTopLevelParts(context(), x);
10509	}
10510
10511	// A singleton instance of the scope -> IMPLICIT rules mapping is
10512	// shared by all instances of ResolveNamesVisitor and accessed by this
10513	// pointer when the visitors (other than the top-level original) are
10514	// constructed.
10515	static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};
10516
10517	bool ResolveNames(
10518	SemanticsContext &context, const parser::Program &program, Scope &top) {
10519	ImplicitRulesMap implicitRulesMap;
10520	auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)};
10521	ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program);
10522	return !context.AnyFatalError();
10523	}
10524
10525	// Processes a module (but not internal) function when it is referenced
10526	// in a specification expression in a sibling procedure.
10527	void ResolveSpecificationParts(
10528	SemanticsContext &context, const Symbol &subprogram) {
10529	auto originalLocation{context.location()};
10530	ImplicitRulesMap implicitRulesMap;
10531	bool localImplicitRulesMap{false};
10532	if (!sharedImplicitRulesMap) {
10533	sharedImplicitRulesMap = &implicitRulesMap;
10534	localImplicitRulesMap = true;
10535	}
10536	ResolveNamesVisitor visitor{
10537	context, *sharedImplicitRulesMap, context.globalScope()};
10538	const auto &details{subprogram.get<SubprogramNameDetails>()};
10539	ProgramTree &node{details.node()};
10540	const Scope &moduleScope{subprogram.owner()};
10541	if (localImplicitRulesMap) {
10542	visitor.BeginScope(const_cast<Scope &>(moduleScope));
10543	} else {
10544	visitor.SetScope(const_cast<Scope &>(moduleScope));
10545	}
10546	visitor.ResolveSpecificationParts(node);
10547	context.set_location(std::move(originalLocation));
10548	if (localImplicitRulesMap) {
10549	sharedImplicitRulesMap = nullptr;
10550	}
10551	}
10552
10553	} // namespace Fortran::semantics
10554