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	return false;
1733	default:
1734	return true;
1735	}
1736	}
1737
1738	bool OmpVisitor::NeedsScope(const parser::OmpClause &x) {
1739	// Iterators contain declarations, whose scope extends until the end
1740	// the clause.
1741	return llvm::omp::canHaveIterator(x.Id());
1742	}
1743
1744	void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
1745	messageHandler().set_currStmtSource(source);
1746	currScope().AddSourceRange(source);
1747	}
1748
1749	bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
1750	if (NeedsScope(x)) {
1751	PushScope(Scope::Kind::OtherConstruct, nullptr);
1752	}
1753	return true;
1754	}
1755
1756	void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
1757	if (NeedsScope(x)) {
1758	PopScope();
1759	}
1760	}
1761
1762	bool OmpVisitor::Pre(const parser::OmpMapClause &x) {
1763	auto &mods{OmpGetModifiers(x)};
1764	if (auto *mapper{OmpGetUniqueModifier<parser::OmpMapper>(mods)}) {
1765	if (auto *symbol{FindSymbol(currScope(), mapper->v)}) {
1766	// TODO: Do we need a specific flag or type here, to distinghuish against
1767	// other ConstructName things? Leaving this for the full implementation
1768	// of mapper lowering.
1769	auto *misc{symbol->detailsIf<MiscDetails>()};
1770	if (!misc || misc->kind() != MiscDetails::Kind::ConstructName)
1771	context().Say(mapper->v.source,
1772	"Name '%s' should be a mapper name"_err_en_US, mapper->v.source);
1773	else
1774	mapper->v.symbol = symbol;
1775	} else {
1776	mapper->v.symbol =
1777	&MakeSymbol(mapper->v, MiscDetails{MiscDetails::Kind::ConstructName});
1778	// TODO: When completing the implementation, we probably want to error if
1779	// the symbol is not declared, but right now, testing that the TODO for
1780	// OmpMapClause happens is obscured by the TODO for declare mapper, so
1781	// leaving this out. Remove the above line once the declare mapper is
1782	// implemented. context().Say(mapper->v.source, "'%s' not
1783	// declared"_err_en_US, mapper->v.source);
1784	}
1785	}
1786	return true;
1787	}
1788
1789	void OmpVisitor::ProcessMapperSpecifier(const parser::OmpMapperSpecifier &spec,
1790	const parser::OmpClauseList &clauses) {
1791	// This "manually" walks the tree of the construct, because we need
1792	// to resolve the type before the map clauses are processed - when
1793	// just following the natural flow, the map clauses gets processed before
1794	// the type has been fully processed.
1795	BeginDeclTypeSpec();
1796	auto &mapperName{std::get<std::string>(spec.t)};
1797	MakeSymbol(parser::CharBlock(mapperName), Attrs{},
1798	MiscDetails{MiscDetails::Kind::ConstructName});
1799	PushScope(Scope::Kind::OtherConstruct, nullptr);
1800	Walk(std::get<parser::TypeSpec>(spec.t));
1801	auto &varName{std::get<parser::Name>(spec.t)};
1802	DeclareObjectEntity(varName);
1803	EndDeclTypeSpec();
1804
1805	Walk(clauses);
1806	PopScope();
1807	}
1808
1809	parser::CharBlock MakeNameFromOperator(
1810	const parser::DefinedOperator::IntrinsicOperator &op,
1811	SemanticsContext &context) {
1812	switch (op) {
1813	case parser::DefinedOperator::IntrinsicOperator::Multiply:
1814	return parser::CharBlock{"op.*", 4};
1815	case parser::DefinedOperator::IntrinsicOperator::Add:
1816	return parser::CharBlock{"op.+", 4};
1817	case parser::DefinedOperator::IntrinsicOperator::Subtract:
1818	return parser::CharBlock{"op.-", 4};
1819
1820	case parser::DefinedOperator::IntrinsicOperator::AND:
1821	return parser::CharBlock{"op.AND", 6};
1822	case parser::DefinedOperator::IntrinsicOperator::OR:
1823	return parser::CharBlock{"op.OR", 6};
1824	case parser::DefinedOperator::IntrinsicOperator::EQV:
1825	return parser::CharBlock{"op.EQV", 7};
1826	case parser::DefinedOperator::IntrinsicOperator::NEQV:
1827	return parser::CharBlock{"op.NEQV", 8};
1828
1829	default:
1830	context.Say("Unsupported operator in DECLARE REDUCTION"_err_en_US);
1831	return parser::CharBlock{"op.?", 4};
1832	}
1833	}
1834
1835	parser::CharBlock MangleSpecialFunctions(const parser::CharBlock &name) {
1836	return llvm::StringSwitch<parser::CharBlock>(name.ToString())
1837	.Case("max", {"op.max", 6})
1838	.Case("min", {"op.min", 6})
1839	.Case("iand", {"op.iand", 7})
1840	.Case("ior", {"op.ior", 6})
1841	.Case("ieor", {"op.ieor", 7})
1842	.Default(name);
1843	}
1844
1845	std::string MangleDefinedOperator(const parser::CharBlock &name) {
1846	CHECK(name[0] == '.' && name[name.size() - 1] == '.');
1847	return "op" + name.ToString();
1848	}
1849
1850	template <typename T>
1851	void OmpVisitor::ProcessReductionSpecifier(
1852	const parser::OmpReductionSpecifier &spec,
1853	const std::optional<parser::OmpClauseList> &clauses,
1854	const T &wholeOmpConstruct) {
1855	const parser::Name *name{nullptr};
1856	parser::CharBlock mangledName;
1857	UserReductionDetails reductionDetailsTemp;
1858	const auto &id{std::get<parser::OmpReductionIdentifier>(spec.t)};
1859	if (auto *procDes{std::get_if<parser::ProcedureDesignator>(&id.u)}) {
1860	name = std::get_if<parser::Name>(&procDes->u);
1861	// This shouldn't be a procedure component: this is the name of the
1862	// reduction being declared.
1863	CHECK(name);
1864	// Prevent the symbol from conflicting with the builtin function name
1865	mangledName = MangleSpecialFunctions(name->source);
1866	// Note: the Name inside the parse tree is not updated because it is const.
1867	// All lookups must use MangleSpecialFunctions.
1868	} else {
1869	const auto &defOp{std::get<parser::DefinedOperator>(id.u)};
1870	if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&defOp.u)}) {
1871	name = &definedOp->v;
1872	mangledName = context().SaveTempName(MangleDefinedOperator(name->source));
1873	} else {
1874	mangledName = MakeNameFromOperator(
1875	std::get<parser::DefinedOperator::IntrinsicOperator>(defOp.u),
1876	context());
1877	}
1878	}
1879
1880	// Use reductionDetailsTemp if we can't find the symbol (this is
1881	// the first, or only, instance with this name). The details then
1882	// gets stored in the symbol when it's created.
1883	UserReductionDetails *reductionDetails{&reductionDetailsTemp};
1884	Symbol *symbol{currScope().FindSymbol(mangledName)};
1885	if (symbol) {
1886	// If we found a symbol, we append the type info to the
1887	// existing reductionDetails.
1888	reductionDetails = symbol->detailsIf<UserReductionDetails>();
1889
1890	if (!reductionDetails) {
1891	context().Say(
1892	"Duplicate definition of '%s' in DECLARE REDUCTION"_err_en_US,
1893	mangledName);
1894	return;
1895	}
1896	}
1897
1898	auto &typeList{std::get<parser::OmpTypeNameList>(spec.t)};
1899
1900	// Create a temporary variable declaration for the four variables
1901	// used in the reduction specifier and initializer (omp_out, omp_in,
1902	// omp_priv and omp_orig), with the type in the typeList.
1903	//
1904	// In theory it would be possible to create only variables that are
1905	// actually used, but that requires walking the entire parse-tree of the
1906	// expressions, and finding the relevant variables [there may well be other
1907	// variables involved too].
1908	//
1909	// This allows doing semantic analysis where the type is a derived type
1910	// e.g omp_out%x = omp_out%x + omp_in%x.
1911	//
1912	// These need to be temporary (in their own scope). If they are created
1913	// as variables in the outer scope, if there's more than one type in the
1914	// typelist, duplicate symbols will be reported.
1915	const parser::CharBlock ompVarNames[]{
1916	{"omp_in", 6}, {"omp_out", 7}, {"omp_priv", 8}, {"omp_orig", 8}};
1917
1918	for (auto &t : typeList.v) {
1919	PushScope(Scope::Kind::OtherConstruct, nullptr);
1920	BeginDeclTypeSpec();
1921	// We need to walk t.u because Walk(t) does it's own BeginDeclTypeSpec.
1922	Walk(t.u);
1923
1924	// Only process types we can find. There will be an error later on when
1925	// a type isn't found.
1926	if (const DeclTypeSpec *typeSpec{GetDeclTypeSpec()}) {
1927	reductionDetails->AddType(*typeSpec);
1928
1929	for (auto &nm : ompVarNames) {
1930	ObjectEntityDetails details{};
1931	details.set_type(*typeSpec);
1932	MakeSymbol(nm, Attrs{}, std::move(details));
1933	}
1934	}
1935	EndDeclTypeSpec();
1936	Walk(std::get<std::optional<parser::OmpReductionCombiner>>(spec.t));
1937	Walk(clauses);
1938	PopScope();
1939	}
1940
1941	reductionDetails->AddDecl(&wholeOmpConstruct);
1942
1943	if (!symbol) {
1944	symbol = &MakeSymbol(mangledName, Attrs{}, std::move(*reductionDetails));
1945	}
1946	if (name) {
1947	name->symbol = symbol;
1948	}
1949	}
1950
1951	bool OmpVisitor::Pre(const parser::OmpDirectiveSpecification &x) {
1952	AddOmpSourceRange(source: x.source);
1953	if (metaLevel_ == 0) {
1954	// Not in METADIRECTIVE.
1955	return true;
1956	}
1957
1958	// If OmpDirectiveSpecification (which contains clauses) is a part of
1959	// METADIRECTIVE, some semantic checks may not be applicable.
1960	// Disable the semantic analysis for it in such cases to allow the compiler
1961	// to parse METADIRECTIVE without flagging errors.
1962	auto &maybeArgs{std::get<std::optional<parser::OmpArgumentList>>(x.t)};
1963	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.t)};
1964
1965	switch (x.DirId()) {
1966	case llvm::omp::Directive::OMPD_declare_mapper:
1967	if (maybeArgs && maybeClauses) {
1968	const parser::OmpArgument &first{maybeArgs->v.front()};
1969	if (auto *spec{std::get_if<parser::OmpMapperSpecifier>(&first.u)}) {
1970	ProcessMapperSpecifier(*spec, *maybeClauses);
1971	}
1972	}
1973	break;
1974	case llvm::omp::Directive::OMPD_declare_reduction:
1975	if (maybeArgs && maybeClauses) {
1976	const parser::OmpArgument &first{maybeArgs->v.front()};
1977	if (auto *spec{std::get_if<parser::OmpReductionSpecifier>(&first.u)}) {
1978	CHECK(metaDirective_);
1979	ProcessReductionSpecifier(*spec, maybeClauses, *metaDirective_);
1980	}
1981	}
1982	break;
1983	default:
1984	// Default processing.
1985	Walk(maybeArgs);
1986	Walk(maybeClauses);
1987	break;
1988	}
1989	return false;
1990	}
1991
1992	// Walk the parse tree and resolve names to symbols.
1993	class ResolveNamesVisitor : public virtual ScopeHandler,
1994	public ModuleVisitor,
1995	public SubprogramVisitor,
1996	public ConstructVisitor,
1997	public OmpVisitor,
1998	public AccVisitor {
1999	public:
2000	using AccVisitor::Post;
2001	using AccVisitor::Pre;
2002	using ArraySpecVisitor::Post;
2003	using ConstructVisitor::Post;
2004	using ConstructVisitor::Pre;
2005	using DeclarationVisitor::Post;
2006	using DeclarationVisitor::Pre;
2007	using ImplicitRulesVisitor::Post;
2008	using ImplicitRulesVisitor::Pre;
2009	using InterfaceVisitor::Post;
2010	using InterfaceVisitor::Pre;
2011	using ModuleVisitor::Post;
2012	using ModuleVisitor::Pre;
2013	using OmpVisitor::Post;
2014	using OmpVisitor::Pre;
2015	using ScopeHandler::Post;
2016	using ScopeHandler::Pre;
2017	using SubprogramVisitor::Post;
2018	using SubprogramVisitor::Pre;
2019
2020	ResolveNamesVisitor(
2021	SemanticsContext &context, ImplicitRulesMap &rules, Scope &top)
2022	: BaseVisitor{context, *this, rules}, topScope_{top} {
2023	PushScope(top);
2024	}
2025
2026	Scope &topScope() const { return topScope_; }
2027
2028	// Default action for a parse tree node is to visit children.
2029	template <typename T> bool Pre(const T &) { return true; }
2030	template <typename T> void Post(const T &) {}
2031
2032	bool Pre(const parser::SpecificationPart &);
2033	bool Pre(const parser::Program &);
2034	void Post(const parser::Program &);
2035	bool Pre(const parser::ImplicitStmt &);
2036	void Post(const parser::PointerObject &);
2037	void Post(const parser::AllocateObject &);
2038	bool Pre(const parser::PointerAssignmentStmt &);
2039	void Post(const parser::Designator &);
2040	void Post(const parser::SubstringInquiry &);
2041	template <typename A, typename B>
2042	void Post(const parser::LoopBounds<A, B> &x) {
2043	ResolveName(*parser::Unwrap<parser::Name>(x.name));
2044	}
2045	void Post(const parser::ProcComponentRef &);
2046	bool Pre(const parser::FunctionReference &);
2047	bool Pre(const parser::CallStmt &);
2048	bool Pre(const parser::ImportStmt &);
2049	void Post(const parser::TypeGuardStmt &);
2050	bool Pre(const parser::StmtFunctionStmt &);
2051	bool Pre(const parser::DefinedOpName &);
2052	bool Pre(const parser::ProgramUnit &);
2053	void Post(const parser::AssignStmt &);
2054	void Post(const parser::AssignedGotoStmt &);
2055	void Post(const parser::CompilerDirective &);
2056
2057	// These nodes should never be reached: they are handled in ProgramUnit
2058	bool Pre(const parser::MainProgram &) {
2059	llvm_unreachable("This node is handled in ProgramUnit");
2060	}
2061	bool Pre(const parser::FunctionSubprogram &) {
2062	llvm_unreachable("This node is handled in ProgramUnit");
2063	}
2064	bool Pre(const parser::SubroutineSubprogram &) {
2065	llvm_unreachable("This node is handled in ProgramUnit");
2066	}
2067	bool Pre(const parser::SeparateModuleSubprogram &) {
2068	llvm_unreachable("This node is handled in ProgramUnit");
2069	}
2070	bool Pre(const parser::Module &) {
2071	llvm_unreachable("This node is handled in ProgramUnit");
2072	}
2073	bool Pre(const parser::Submodule &) {
2074	llvm_unreachable("This node is handled in ProgramUnit");
2075	}
2076	bool Pre(const parser::BlockData &) {
2077	llvm_unreachable("This node is handled in ProgramUnit");
2078	}
2079
2080	void NoteExecutablePartCall(Symbol::Flag, SourceName, bool hasCUDAChevrons);
2081
2082	friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
2083
2084	private:
2085	// Kind of procedure we are expecting to see in a ProcedureDesignator
2086	std::optional<Symbol::Flag> expectedProcFlag_;
2087	std::optional<SourceName> prevImportStmt_;
2088	Scope &topScope_;
2089
2090	void PreSpecificationConstruct(const parser::SpecificationConstruct &);
2091	void EarlyDummyTypeDeclaration(
2092	const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
2093	&);
2094	void CreateCommonBlockSymbols(const parser::CommonStmt &);
2095	void CreateObjectSymbols(const std::list<parser::ObjectDecl> &, Attr);
2096	void CreateGeneric(const parser::GenericSpec &);
2097	void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
2098	void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
2099	void CheckImports();
2100	void CheckImport(const SourceName &, const SourceName &);
2101	void HandleCall(Symbol::Flag, const parser::Call &);
2102	void HandleProcedureName(Symbol::Flag, const parser::Name &);
2103	bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
2104	bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
2105	void ResolveSpecificationParts(ProgramTree &);
2106	void AddSubpNames(ProgramTree &);
2107	bool BeginScopeForNode(const ProgramTree &);
2108	void EndScopeForNode(const ProgramTree &);
2109	void FinishSpecificationParts(const ProgramTree &);
2110	void FinishExecutionParts(const ProgramTree &);
2111	void FinishDerivedTypeInstantiation(Scope &);
2112	void ResolveExecutionParts(const ProgramTree &);
2113	void UseCUDABuiltinNames();
2114	void HandleDerivedTypesInImplicitStmts(const parser::ImplicitPart &,
2115	const std::list<parser::DeclarationConstruct> &);
2116	};
2117
2118	// ImplicitRules implementation
2119
2120	bool ImplicitRules::isImplicitNoneType() const {
2121	if (isImplicitNoneType_) {
2122	return true;
2123	} else if (map_.empty() && inheritFromParent_) {
2124	return parent_->isImplicitNoneType();
2125	} else {
2126	return false; // default if not specified
2127	}
2128	}
2129
2130	bool ImplicitRules::isImplicitNoneExternal() const {
2131	if (isImplicitNoneExternal_) {
2132	return true;
2133	} else if (inheritFromParent_) {
2134	return parent_->isImplicitNoneExternal();
2135	} else {
2136	return false; // default if not specified
2137	}
2138	}
2139
2140	const DeclTypeSpec *ImplicitRules::GetType(
2141	SourceName name, bool respectImplicitNoneType) const {
2142	char ch{name.front()};
2143	if (isImplicitNoneType_ && respectImplicitNoneType) {
2144	return nullptr;
2145	} else if (auto it{map_.find(ch)}; it != map_.end()) {
2146	return &*it->second;
2147	} else if (inheritFromParent_) {
2148	return parent_->GetType(name, respectImplicitNoneType);
2149	} else if (ch >= 'i' && ch <= 'n') {
2150	return &context_.MakeNumericType(TypeCategory::Integer);
2151	} else if (ch >= 'a' && ch <= 'z') {
2152	return &context_.MakeNumericType(TypeCategory::Real);
2153	} else {
2154	return nullptr;
2155	}
2156	}
2157
2158	void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
2159	parser::Location fromLetter, parser::Location toLetter) {
2160	for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
2161	auto res{map_.emplace(ch, type)};
2162	if (!res.second) {
2163	context_.Say(parser::CharBlock{fromLetter},
2164	"More than one implicit type specified for '%c'"_err_en_US, ch);
2165	}
2166	if (ch == *toLetter) {
2167	break;
2168	}
2169	}
2170	}
2171
2172	// Return the next char after ch in a way that works for ASCII or EBCDIC.
2173	// Return '\0' for the char after 'z'.
2174	char ImplicitRules::Incr(char ch) {
2175	switch (ch) {
2176	case 'i':
2177	return 'j';
2178	case 'r':
2179	return 's';
2180	case 'z':
2181	return '\0';
2182	default:
2183	return ch + 1;
2184	}
2185	}
2186
2187	llvm::raw_ostream &operator<<(
2188	llvm::raw_ostream &o, const ImplicitRules &implicitRules) {
2189	o << "ImplicitRules:\n";
2190	for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
2191	ShowImplicitRule(o, implicitRules, ch);
2192	}
2193	ShowImplicitRule(o, implicitRules, '_');
2194	ShowImplicitRule(o, implicitRules, '$');
2195	ShowImplicitRule(o, implicitRules, '@');
2196	return o;
2197	}
2198	void ShowImplicitRule(
2199	llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {
2200	auto it{implicitRules.map_.find(ch)};
2201	if (it != implicitRules.map_.end()) {
2202	o << " " << ch << ": " << *it->second << '\n';
2203	}
2204	}
2205
2206	template <typename T> void BaseVisitor::Walk(const T &x) {
2207	parser::Walk(x, *this_);
2208	}
2209
2210	void BaseVisitor::MakePlaceholder(
2211	const parser::Name &name, MiscDetails::Kind kind) {
2212	if (!name.symbol) {
2213	name.symbol = &context_->globalScope().MakeSymbol(
2214	name.source, Attrs{}, MiscDetails{kind});
2215	}
2216	}
2217
2218	// AttrsVisitor implementation
2219
2220	bool AttrsVisitor::BeginAttrs() {
2221	CHECK(!attrs_ && !cudaDataAttr_);
2222	attrs_ = Attrs{};
2223	return true;
2224	}
2225	Attrs AttrsVisitor::GetAttrs() {
2226	CHECK(attrs_);
2227	return *attrs_;
2228	}
2229	Attrs AttrsVisitor::EndAttrs() {
2230	Attrs result{GetAttrs()};
2231	attrs_.reset();
2232	cudaDataAttr_.reset();
2233	passName_ = std::nullopt;
2234	bindName_.reset();
2235	isCDefined_ = false;
2236	return result;
2237	}
2238
2239	bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
2240	if (!passName_) {
2241	return false;
2242	}
2243	common::visit(common::visitors{
2244	[&](ProcEntityDetails &x) { x.set_passName(*passName_); },
2245	[&](ProcBindingDetails &x) { x.set_passName(*passName_); },
2246	[](auto &) { common::die("unexpected pass name"); },
2247	},
2248	symbol.details());
2249	return true;
2250	}
2251
2252	void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
2253	if ((!attrs_ || !attrs_->test(Attr::BIND_C)) &&
2254	!symbol.attrs().test(Attr::BIND_C)) {
2255	return;
2256	}
2257	symbol.SetIsCDefined(isCDefined_);
2258	std::optional<std::string> label{
2259	evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
2260	// 18.9.2(2): discard leading and trailing blanks
2261	if (label) {
2262	symbol.SetIsExplicitBindName(true);
2263	auto first{label->find_first_not_of(s: " ")};
2264	if (first == std::string::npos) {
2265	// Empty NAME= means no binding at all (18.10.2p2)
2266	return;
2267	}
2268	auto last{label->find_last_not_of(s: " ")};
2269	label = label->substr(pos: first, n: last - first + 1);
2270	} else if (symbol.GetIsExplicitBindName()) {
2271	// don't try to override explicit binding name with default
2272	return;
2273	} else if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) {
2274	// BIND(C) does not give an implicit binding label to internal procedures.
2275	return;
2276	} else {
2277	label = symbol.name().ToString();
2278	}
2279	// Checks whether a symbol has two Bind names.
2280	std::string oldBindName;
2281	if (const auto *bindName{symbol.GetBindName()}) {
2282	oldBindName = *bindName;
2283	}
2284	symbol.SetBindName(std::move(*label));
2285	if (!oldBindName.empty()) {
2286	if (const std::string * newBindName{symbol.GetBindName()}) {
2287	if (oldBindName != *newBindName) {
2288	Say(symbol.name(),
2289	"The entity '%s' has multiple BIND names ('%s' and '%s')"_err_en_US,
2290	symbol.name(), oldBindName, *newBindName);
2291	}
2292	}
2293	}
2294	}
2295
2296	void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
2297	if (CheckAndSet(Attr::BIND_C)) {
2298	if (const auto &name{
2299	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
2300	x.t)}) {
2301	bindName_ = EvaluateExpr(*name);
2302	}
2303	isCDefined_ = std::get<bool>(x.t);
2304	}
2305	}
2306	bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
2307	CheckAndSet(IntentSpecToAttr(x));
2308	return false;
2309	}
2310	bool AttrsVisitor::Pre(const parser::Pass &x) {
2311	if (CheckAndSet(Attr::PASS)) {
2312	if (x.v) {
2313	passName_ = x.v->source;
2314	MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
2315	}
2316	}
2317	return false;
2318	}
2319
2320	// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
2321	bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
2322	CHECK(attrs_);
2323	if (attrs_->test(attrName)) {
2324	context().Warn(common::LanguageFeature::RedundantAttribute,
2325	currStmtSource().value(),
2326	"Attribute '%s' cannot be used more than once"_warn_en_US,
2327	AttrToString(attrName));
2328	return true;
2329	}
2330	return false;
2331	}
2332
2333	// See if attrName violates a constraint cause by a conflict. attr1 and attr2
2334	// name attributes that cannot be used on the same declaration
2335	bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
2336	CHECK(attrs_);
2337	if ((attrName == attr1 && attrs_->test(attr2)) ||
2338	(attrName == attr2 && attrs_->test(attr1))) {
2339	Say(currStmtSource().value(),
2340	"Attributes '%s' and '%s' conflict with each other"_err_en_US,
2341	AttrToString(attr1), AttrToString(attr2));
2342	return true;
2343	}
2344	return false;
2345	}
2346	// C759, C1543
2347	bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
2348	return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
2349	HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
2350	HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
2351	HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
2352	HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
2353	HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
2354	HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
2355	}
2356	bool AttrsVisitor::CheckAndSet(Attr attrName) {
2357	if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
2358	return false;
2359	}
2360	attrs_->set(attrName);
2361	return true;
2362	}
2363	bool AttrsVisitor::Pre(const common::CUDADataAttr x) {
2364	if (cudaDataAttr_.value_or(x) != x) {
2365	Say(currStmtSource().value(),
2366	"CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,
2367	common::EnumToString(*cudaDataAttr_), common::EnumToString(x));
2368	}
2369	cudaDataAttr_ = x;
2370	return false;
2371	}
2372
2373	// DeclTypeSpecVisitor implementation
2374
2375	const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
2376	return state_.declTypeSpec;
2377	}
2378
2379	void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
2380	CHECK(!state_.expectDeclTypeSpec);
2381	CHECK(!state_.declTypeSpec);
2382	state_.expectDeclTypeSpec = true;
2383	}
2384	void DeclTypeSpecVisitor::EndDeclTypeSpec() {
2385	CHECK(state_.expectDeclTypeSpec);
2386	state_ = {};
2387	}
2388
2389	void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
2390	DeclTypeSpec::Category category) {
2391	CHECK(state_.expectDeclTypeSpec);
2392	state_.derived.category = category;
2393	}
2394
2395	bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
2396	BeginDeclTypeSpec();
2397	return true;
2398	}
2399	void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
2400	EndDeclTypeSpec();
2401	}
2402
2403	void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
2404	// Record the resolved DeclTypeSpec in the parse tree for use by
2405	// expression semantics if the DeclTypeSpec is a valid TypeSpec.
2406	// The grammar ensures that it's an intrinsic or derived type spec,
2407	// not TYPE(*) or CLASS(*) or CLASS(T).
2408	if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
2409	switch (spec->category()) {
2410	case DeclTypeSpec::Numeric:
2411	case DeclTypeSpec::Logical:
2412	case DeclTypeSpec::Character:
2413	typeSpec.declTypeSpec = spec;
2414	break;
2415	case DeclTypeSpec::TypeDerived:
2416	if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
2417	CheckForAbstractType(typeSymbol: derived->typeSymbol()); // C703
2418	typeSpec.declTypeSpec = spec;
2419	}
2420	break;
2421	default:
2422	CRASH_NO_CASE;
2423	}
2424	}
2425	}
2426
2427	void DeclTypeSpecVisitor::Post(
2428	const parser::IntrinsicTypeSpec::DoublePrecision &) {
2429	MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
2430	}
2431	void DeclTypeSpecVisitor::Post(
2432	const parser::IntrinsicTypeSpec::DoubleComplex &) {
2433	MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
2434	}
2435	void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
2436	SetDeclTypeSpec(context().MakeNumericType(category, kind));
2437	}
2438
2439	void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {
2440	if (typeSymbol.attrs().test(Attr::ABSTRACT)) {
2441	Say("ABSTRACT derived type may not be used here"_err_en_US);
2442	}
2443	}
2444
2445	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
2446	SetDeclTypeSpec(context().globalScope().MakeClassStarType());
2447	}
2448	void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
2449	SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
2450	}
2451
2452	// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
2453	// and save it in state_.declTypeSpec.
2454	void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
2455	CHECK(state_.expectDeclTypeSpec);
2456	CHECK(!state_.declTypeSpec);
2457	state_.declTypeSpec = &declTypeSpec;
2458	}
2459
2460	KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
2461	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
2462	return AnalyzeKindSelector(context(), category, kind);
2463	}
2464
2465	// MessageHandler implementation
2466
2467	Message &MessageHandler::Say(MessageFixedText &&msg) {
2468	return context_->Say(currStmtSource().value(), std::move(msg));
2469	}
2470	Message &MessageHandler::Say(MessageFormattedText &&msg) {
2471	return context_->Say(currStmtSource().value(), std::move(msg));
2472	}
2473	Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
2474	return Say(source: name, msg: std::move(msg), args: name);
2475	}
2476
2477	// ImplicitRulesVisitor implementation
2478
2479	void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
2480	prevParameterStmt_ = currStmtSource();
2481	}
2482
2483	bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
2484	bool result{
2485	common::visit(common::visitors{
2486	[&](const std::list<ImplicitNoneNameSpec> &y) {
2487	return HandleImplicitNone(y);
2488	},
2489	[&](const std::list<parser::ImplicitSpec> &) {
2490	if (prevImplicitNoneType_) {
2491	Say("IMPLICIT statement after IMPLICIT NONE or "
2492	"IMPLICIT NONE(TYPE) statement"_err_en_US);
2493	return false;
2494	}
2495	implicitRules_->set_isImplicitNoneType(false);
2496	return true;
2497	},
2498	},
2499	x.u)};
2500	prevImplicit_ = currStmtSource();
2501	return result;
2502	}
2503
2504	bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
2505	auto loLoc{std::get<parser::Location>(x.t)};
2506	auto hiLoc{loLoc};
2507	if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
2508	hiLoc = *hiLocOpt;
2509	if (*hiLoc < *loLoc) {
2510	Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
2511	std::string(hiLoc, 1), std::string(loLoc, 1));
2512	return false;
2513	}
2514	}
2515	implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
2516	return false;
2517	}
2518
2519	bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
2520	BeginDeclTypeSpec();
2521	set_allowForwardReferenceToDerivedType(true);
2522	return true;
2523	}
2524
2525	void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
2526	set_allowForwardReferenceToDerivedType(false);
2527	EndDeclTypeSpec();
2528	}
2529
2530	void ImplicitRulesVisitor::SetScope(const Scope &scope) {
2531	implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);
2532	prevImplicit_ = std::nullopt;
2533	prevImplicitNone_ = std::nullopt;
2534	prevImplicitNoneType_ = std::nullopt;
2535	prevParameterStmt_ = std::nullopt;
2536	}
2537	void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
2538	// find or create implicit rules for this scope
2539	DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);
2540	SetScope(scope);
2541	}
2542
2543	// TODO: for all of these errors, reference previous statement too
2544	bool ImplicitRulesVisitor::HandleImplicitNone(
2545	const std::list<ImplicitNoneNameSpec> &nameSpecs) {
2546	if (prevImplicitNone_) {
2547	Say("More than one IMPLICIT NONE statement"_err_en_US);
2548	Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
2549	return false;
2550	}
2551	if (prevParameterStmt_) {
2552	Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
2553	return false;
2554	}
2555	prevImplicitNone_ = currStmtSource();
2556	bool implicitNoneTypeNever{
2557	context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
2558	if (nameSpecs.empty()) {
2559	if (!implicitNoneTypeNever) {
2560	prevImplicitNoneType_ = currStmtSource();
2561	implicitRules_->set_isImplicitNoneType(true);
2562	if (prevImplicit_) {
2563	Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
2564	return false;
2565	}
2566	}
2567	} else {
2568	int sawType{0};
2569	int sawExternal{0};
2570	for (const auto noneSpec : nameSpecs) {
2571	switch (noneSpec) {
2572	case ImplicitNoneNameSpec::External:
2573	implicitRules_->set_isImplicitNoneExternal(true);
2574	++sawExternal;
2575	break;
2576	case ImplicitNoneNameSpec::Type:
2577	if (!implicitNoneTypeNever) {
2578	prevImplicitNoneType_ = currStmtSource();
2579	implicitRules_->set_isImplicitNoneType(true);
2580	if (prevImplicit_) {
2581	Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
2582	return false;
2583	}
2584	++sawType;
2585	}
2586	break;
2587	}
2588	}
2589	if (sawType > 1) {
2590	Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
2591	return false;
2592	}
2593	if (sawExternal > 1) {
2594	Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
2595	return false;
2596	}
2597	}
2598	return true;
2599	}
2600
2601	// ArraySpecVisitor implementation
2602
2603	void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
2604	CHECK(arraySpec_.empty());
2605	arraySpec_ = AnalyzeArraySpec(context(), x);
2606	}
2607	void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
2608	CHECK(arraySpec_.empty());
2609	arraySpec_ = AnalyzeArraySpec(context(), x);
2610	}
2611	void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
2612	CHECK(coarraySpec_.empty());
2613	coarraySpec_ = AnalyzeCoarraySpec(context(), x);
2614	}
2615
2616	const ArraySpec &ArraySpecVisitor::arraySpec() {
2617	return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
2618	}
2619	const ArraySpec &ArraySpecVisitor::coarraySpec() {
2620	return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
2621	}
2622	void ArraySpecVisitor::BeginArraySpec() {
2623	CHECK(arraySpec_.empty());
2624	CHECK(coarraySpec_.empty());
2625	CHECK(attrArraySpec_.empty());
2626	CHECK(attrCoarraySpec_.empty());
2627	}
2628	void ArraySpecVisitor::EndArraySpec() {
2629	CHECK(arraySpec_.empty());
2630	CHECK(coarraySpec_.empty());
2631	attrArraySpec_.clear();
2632	attrCoarraySpec_.clear();
2633	}
2634	void ArraySpecVisitor::PostAttrSpec() {
2635	// Save dimension/codimension from attrs so we can process array/coarray-spec
2636	// on the entity-decl
2637	if (!arraySpec_.empty()) {
2638	if (attrArraySpec_.empty()) {
2639	attrArraySpec_ = arraySpec_;
2640	arraySpec_.clear();
2641	} else {
2642	Say(currStmtSource().value(),
2643	"Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
2644	}
2645	}
2646	if (!coarraySpec_.empty()) {
2647	if (attrCoarraySpec_.empty()) {
2648	attrCoarraySpec_ = coarraySpec_;
2649	coarraySpec_.clear();
2650	} else {
2651	Say(currStmtSource().value(),
2652	"Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
2653	}
2654	}
2655	}
2656
2657	// FuncResultStack implementation
2658
2659	FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
2660
2661	void FuncResultStack::CompleteFunctionResultType() {
2662	// If the function has a type in the prefix, process it now.
2663	FuncInfo *info{Top()};
2664	if (info && &info->scope == &scopeHandler_.currScope()) {
2665	if (info->parsedType && info->resultSymbol) {
2666	scopeHandler_.messageHandler().set_currStmtSource(info->source);
2667	if (const auto *type{
2668	scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
2669	Symbol &symbol{*info->resultSymbol};
2670	if (!scopeHandler_.context().HasError(symbol)) {
2671	if (symbol.GetType()) {
2672	scopeHandler_.Say(symbol.name(),
2673	"Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US);
2674	scopeHandler_.context().SetError(symbol);
2675	} else {
2676	symbol.SetType(*type);
2677	}
2678	}
2679	}
2680	info->parsedType = nullptr;
2681	}
2682	}
2683	}
2684
2685	// Called from ConvertTo{Object/Proc}Entity to cope with any appearance
2686	// of the function result in a specification expression.
2687	void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {
2688	if (FuncInfo * info{Top()}) {
2689	if (info->resultSymbol == &symbol) {
2690	CompleteFunctionResultType();
2691	}
2692	}
2693	}
2694
2695	void FuncResultStack::Pop() {
2696	if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {
2697	stack_.pop_back();
2698	}
2699	}
2700
2701	// ScopeHandler implementation
2702
2703	void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
2704	SayAlreadyDeclared(name.source, prev);
2705	}
2706	void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
2707	if (context().HasError(prev)) {
2708	// don't report another error about prev
2709	} else {
2710	if (const auto *details{prev.detailsIf<UseDetails>()}) {
2711	Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
2712	.Attach(details->location(),
2713	"It is use-associated with '%s' in module '%s'"_en_US,
2714	details->symbol().name(), GetUsedModule(*details).name());
2715	} else {
2716	SayAlreadyDeclared(name, prev.name());
2717	}
2718	context().SetError(prev);
2719	}
2720	}
2721	void ScopeHandler::SayAlreadyDeclared(
2722	const SourceName &name1, const SourceName &name2) {
2723	if (name1.begin() < name2.begin()) {
2724	SayAlreadyDeclared(name1: name2, name2: name1);
2725	} else {
2726	Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
2727	.Attach(name2, "Previous declaration of '%s'"_en_US, name2);
2728	}
2729	}
2730
2731	void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
2732	MessageFixedText &&msg1, Message &&msg2) {
2733	bool isFatal{msg1.IsFatal()};
2734	Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));
2735	context().SetError(symbol, isFatal);
2736	}
2737
2738	template <typename... A>
2739	Message &ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
2740	MessageFixedText &&msg, A &&...args) {
2741	auto &message{
2742	Say(name.source, std::move(msg), symbol.name(), std::forward<A>(args)...)
2743	.Attach(symbol.name(),
2744	symbol.test(Symbol::Flag::Implicit)
2745	? "Implicit declaration of '%s'"_en_US
2746	: "Declaration of '%s'"_en_US,
2747	name.source)};
2748	if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
2749	if (auto usedAsProc{proc->usedAsProcedureHere()}) {
2750	if (usedAsProc->begin() != symbol.name().begin()) {
2751	message.Attach(*usedAsProc, "Referenced as a procedure"_en_US);
2752	}
2753	}
2754	}
2755	return message;
2756	}
2757
2758	void ScopeHandler::SayLocalMustBeVariable(
2759	const parser::Name &name, Symbol &symbol) {
2760	SayWithDecl(name, symbol,
2761	"The name '%s' must be a variable to appear"
2762	" in a locality-spec"_err_en_US);
2763	}
2764
2765	Message &ScopeHandler::SayDerivedType(
2766	const SourceName &name, MessageFixedText &&msg, const Scope &type) {
2767	const Symbol &typeSymbol{DEREF(type.GetSymbol())};
2768	return Say(name, std::move(msg), name, typeSymbol.name())
2769	.Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
2770	typeSymbol.name());
2771	}
2772	Message &ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
2773	const SourceName &name2, MessageFixedText &&msg2) {
2774	return Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
2775	}
2776	Message &ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
2777	Symbol &symbol, MessageFixedText &&msg2) {
2778	bool isFatal{msg1.IsFatal()};
2779	Message &result{Say2(name, std::move(msg1), symbol.name(), std::move(msg2))};
2780	context().SetError(symbol, isFatal);
2781	return result;
2782	}
2783	Message &ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
2784	Symbol &symbol, MessageFixedText &&msg2) {
2785	bool isFatal{msg1.IsFatal()};
2786	Message &result{
2787	Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2))};
2788	context().SetError(symbol, isFatal);
2789	return result;
2790	}
2791
2792	// This is essentially GetProgramUnitContaining(), but it can return
2793	// a mutable Scope &, it ignores statement functions, and it fails
2794	// gracefully for error recovery (returning the original Scope).
2795	template <typename T> static T &GetInclusiveScope(T &scope) {
2796	for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
2797	switch (s->kind()) {
2798	case Scope::Kind::Module:
2799	case Scope::Kind::MainProgram:
2800	case Scope::Kind::Subprogram:
2801	case Scope::Kind::BlockData:
2802	if (!s->IsStmtFunction()) {
2803	return *s;
2804	}
2805	break;
2806	default:;
2807	}
2808	}
2809	return scope;
2810	}
2811
2812	Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(scope&: currScope()); }
2813
2814	Scope *ScopeHandler::GetHostProcedure() {
2815	Scope &parent{InclusiveScope().parent()};
2816	switch (parent.kind()) {
2817	case Scope::Kind::Subprogram:
2818	return &parent;
2819	case Scope::Kind::MainProgram:
2820	return &parent;
2821	default:
2822	return nullptr;
2823	}
2824	}
2825
2826	Scope &ScopeHandler::NonDerivedTypeScope() {
2827	return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
2828	}
2829
2830	static void SetImplicitCUDADevice(Symbol &symbol) {
2831	if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
2832	if (!object->cudaDataAttr() && !IsValue(symbol) &&
2833	!IsFunctionResult(symbol)) {
2834	// Implicitly set device attribute if none is set in device context.
2835	object->set_cudaDataAttr(common::CUDADataAttr::Device);
2836	}
2837	}
2838	}
2839
2840	void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
2841	PushScope(scope&: currScope().MakeScope(kind, symbol));
2842	}
2843	void ScopeHandler::PushScope(Scope &scope) {
2844	currScope_ = &scope;
2845	auto kind{currScope_->kind()};
2846	if (kind != Scope::Kind::BlockConstruct &&
2847	kind != Scope::Kind::OtherConstruct && kind != Scope::Kind::OtherClause) {
2848	BeginScope(scope);
2849	}
2850	// The name of a module or submodule cannot be "used" in its scope,
2851	// as we read 19.3.1(2), so we allow the name to be used as a local
2852	// identifier in the module or submodule too. Same with programs
2853	// (14.1(3)) and BLOCK DATA.
2854	if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
2855	kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
2856	if (auto *symbol{scope.symbol()}) {
2857	// Create a dummy symbol so we can't create another one with the same
2858	// name. It might already be there if we previously pushed the scope.
2859	SourceName name{symbol->name()};
2860	if (!FindInScope(scope, name)) {
2861	auto &newSymbol{MakeSymbol(name)};
2862	if (kind == Scope::Kind::Subprogram) {
2863	// Allow for recursive references. If this symbol is a function
2864	// without an explicit RESULT(), this new symbol will be discarded
2865	// and replaced with an object of the same name.
2866	newSymbol.set_details(HostAssocDetails{*symbol});
2867	} else {
2868	newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
2869	}
2870	}
2871	}
2872	}
2873	}
2874	void ScopeHandler::PopScope() {
2875	CHECK(currScope_ && !currScope_->IsGlobal());
2876	// Entities that are not yet classified as objects or procedures are now
2877	// assumed to be objects.
2878	// TODO: Statement functions
2879	bool inDeviceSubprogram{false};
2880	const Symbol *scopeSym{currScope().GetSymbol()};
2881	if (currScope().kind() == Scope::Kind::BlockConstruct) {
2882	scopeSym = GetProgramUnitContaining(currScope()).GetSymbol();
2883	}
2884	if (scopeSym) {
2885	if (auto *details{scopeSym->detailsIf<SubprogramDetails>()}) {
2886	// Check the current procedure is a device procedure to apply implicit
2887	// attribute at the end.
2888	if (auto attrs{details->cudaSubprogramAttrs()}) {
2889	if (*attrs == common::CUDASubprogramAttrs::Device ||
2890	*attrs == common::CUDASubprogramAttrs::Global ||
2891	*attrs == common::CUDASubprogramAttrs::Grid_Global) {
2892	inDeviceSubprogram = true;
2893	}
2894	}
2895	}
2896	}
2897	for (auto &pair : currScope()) {
2898	ConvertToObjectEntity(*pair.second);
2899	}
2900
2901	// Apply CUDA device attributes if in a device subprogram
2902	if (inDeviceSubprogram && currScope().kind() == Scope::Kind::BlockConstruct) {
2903	for (auto &pair : currScope()) {
2904	SetImplicitCUDADevice(*pair.second);
2905	}
2906	}
2907
2908	funcResultStack_.Pop();
2909	// If popping back into a global scope, pop back to the top scope.
2910	Scope *hermetic{context().currentHermeticModuleFileScope()};
2911	SetScope(currScope_->parent().IsGlobal()
2912	? (hermetic ? *hermetic : context().globalScope())
2913	: currScope_->parent());
2914	}
2915	void ScopeHandler::SetScope(Scope &scope) {
2916	currScope_ = &scope;
2917	ImplicitRulesVisitor::SetScope(InclusiveScope());
2918	}
2919
2920	Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
2921	return FindSymbol(currScope(), name);
2922	}
2923	Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
2924	if (scope.IsDerivedType()) {
2925	if (Symbol * symbol{scope.FindComponent(name.source)}) {
2926	if (symbol->has<TypeParamDetails>()) {
2927	return Resolve(name, symbol);
2928	}
2929	}
2930	return FindSymbol(scope.parent(), name);
2931	} else {
2932	// In EQUIVALENCE statements only resolve names in the local scope, see
2933	// 19.5.1.4, paragraph 2, item (10)
2934	return Resolve(name,
2935	inEquivalenceStmt_ ? FindInScope(scope, name)
2936	: scope.FindSymbol(name.source));
2937	}
2938	}
2939
2940	Symbol &ScopeHandler::MakeSymbol(
2941	Scope &scope, const SourceName &name, Attrs attrs) {
2942	if (Symbol * symbol{FindInScope(scope, name)}) {
2943	CheckDuplicatedAttrs(name, *symbol, attrs);
2944	SetExplicitAttrs(*symbol, attrs);
2945	return *symbol;
2946	} else {
2947	const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
2948	CHECK(pair.second); // name was not found, so must be able to add
2949	return *pair.first->second;
2950	}
2951	}
2952	Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
2953	return MakeSymbol(currScope(), name, attrs);
2954	}
2955	Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
2956	return Resolve(name, MakeSymbol(name.source, attrs));
2957	}
2958	Symbol &ScopeHandler::MakeHostAssocSymbol(
2959	const parser::Name &name, const Symbol &hostSymbol) {
2960	Symbol &symbol{*NonDerivedTypeScope()
2961	.try_emplace(name.source, HostAssocDetails{hostSymbol})
2962	.first->second};
2963	name.symbol = &symbol;
2964	symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
2965	// These attributes can be redundantly reapplied without error
2966	// on the host-associated name, at most once (C815).
2967	symbol.implicitAttrs() =
2968	symbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
2969	// SAVE statement in the inner scope will create a new symbol.
2970	// If the host variable is used via host association,
2971	// we have to propagate whether SAVE is implicit in the host scope.
2972	// Otherwise, verifications that do not allow explicit SAVE
2973	// attribute would fail.
2974	symbol.implicitAttrs() |= hostSymbol.implicitAttrs() & Attrs{Attr::SAVE};
2975	symbol.flags() = hostSymbol.flags();
2976	return symbol;
2977	}
2978	Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
2979	CHECK(!FindInScope(name));
2980	return MakeSymbol(currScope(), name, symbol.attrs());
2981	}
2982
2983	// Look for name only in scope, not in enclosing scopes.
2984
2985	Symbol *ScopeHandler::FindInScope(
2986	const Scope &scope, const parser::Name &name) {
2987	return Resolve(name, FindInScope(scope, name.source));
2988	}
2989	Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
2990	// all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
2991	for (const std::string &n : GetAllNames(context(), name)) {
2992	auto it{scope.find(SourceName{n})};
2993	if (it != scope.end()) {
2994	return &*it->second;
2995	}
2996	}
2997	return nullptr;
2998	}
2999
3000	// Find a component or type parameter by name in a derived type or its parents.
3001	Symbol *ScopeHandler::FindInTypeOrParents(
3002	const Scope &scope, const parser::Name &name) {
3003	return Resolve(name, scope.FindComponent(name.source));
3004	}
3005	Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
3006	return FindInTypeOrParents(scope: currScope(), name);
3007	}
3008	Symbol *ScopeHandler::FindInScopeOrBlockConstructs(
3009	const Scope &scope, SourceName name) {
3010	if (Symbol * symbol{FindInScope(scope, name)}) {
3011	return symbol;
3012	}
3013	for (const Scope &child : scope.children()) {
3014	if (child.kind() == Scope::Kind::BlockConstruct) {
3015	if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) {
3016	return symbol;
3017	}
3018	}
3019	}
3020	return nullptr;
3021	}
3022
3023	void ScopeHandler::EraseSymbol(const parser::Name &name) {
3024	currScope().erase(name.source);
3025	name.symbol = nullptr;
3026	}
3027
3028	static bool NeedsType(const Symbol &symbol) {
3029	return !symbol.GetType() &&
3030	common::visit(common::visitors{
3031	[](const EntityDetails &) { return true; },
3032	[](const ObjectEntityDetails &) { return true; },
3033	[](const AssocEntityDetails &) { return true; },
3034	[&](const ProcEntityDetails &p) {
3035	return symbol.test(Symbol::Flag::Function) &&
3036	!symbol.attrs().test(Attr::INTRINSIC) &&
3037	!p.type() && !p.procInterface();
3038	},
3039	[](const auto &) { return false; },
3040	},
3041	symbol.details());
3042	}
3043
3044	void ScopeHandler::ApplyImplicitRules(
3045	Symbol &symbol, bool allowForwardReference) {
3046	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3047	if (context().HasError(symbol) || !NeedsType(symbol)) {
3048	return;
3049	}
3050	if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
3051	if (!skipImplicitTyping_) {
3052	symbol.set(Symbol::Flag::Implicit);
3053	symbol.SetType(*type);
3054	}
3055	return;
3056	}
3057	if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
3058	std::optional<Symbol::Flag> functionOrSubroutineFlag;
3059	if (symbol.test(Symbol::Flag::Function)) {
3060	functionOrSubroutineFlag = Symbol::Flag::Function;
3061	} else if (symbol.test(Symbol::Flag::Subroutine)) {
3062	functionOrSubroutineFlag = Symbol::Flag::Subroutine;
3063	}
3064	if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
3065	// type will be determined in expression semantics
3066	AcquireIntrinsicProcedureFlags(symbol);
3067	return;
3068	}
3069	}
3070	if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
3071	return;
3072	}
3073	if (const auto *entity{symbol.detailsIf<EntityDetails>()};
3074	entity && entity->isDummy()) {
3075	// Dummy argument, no declaration or reference; if it turns
3076	// out to be a subroutine, it's fine, and if it is a function
3077	// or object, it'll be caught later.
3078	return;
3079	}
3080	if (deferImplicitTyping_) {
3081	return;
3082	}
3083	if (!context().HasError(symbol)) {
3084	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
3085	context().SetError(symbol);
3086	}
3087	}
3088
3089	// Extension: Allow forward references to scalar integer dummy arguments
3090	// or variables in COMMON to appear in specification expressions under
3091	// IMPLICIT NONE(TYPE) when what would otherwise have been their implicit
3092	// type is default INTEGER.
3093	bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
3094	if (!inSpecificationPart_ || context().HasError(symbol) ||
3095	!(IsDummy(symbol) || FindCommonBlockContaining(symbol)) ||
3096	symbol.Rank() != 0 ||
3097	!context().languageFeatures().IsEnabled(
3098	common::LanguageFeature::ForwardRefImplicitNone)) {
3099	return false;
3100	}
3101	const DeclTypeSpec *type{
3102	GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
3103	if (!type || !type->IsNumeric(TypeCategory::Integer)) {
3104	return false;
3105	}
3106	auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
3107	if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
3108	return false;
3109	}
3110	if (!ConvertToObjectEntity(symbol)) {
3111	return false;
3112	}
3113	// TODO: check no INTENT(OUT) if dummy?
3114	context().Warn(common::LanguageFeature::ForwardRefImplicitNone, symbol.name(),
3115	"'%s' was used without (or before) being explicitly typed"_warn_en_US,
3116	symbol.name());
3117	symbol.set(Symbol::Flag::Implicit);
3118	symbol.SetType(*type);
3119	return true;
3120	}
3121
3122	// Ensure that the symbol for an intrinsic procedure is marked with
3123	// the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as
3124	// appropriate.
3125	void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
3126	SetImplicitAttr(symbol, Attr::INTRINSIC);
3127	switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {
3128	case evaluate::IntrinsicClass::elementalFunction:
3129	case evaluate::IntrinsicClass::elementalSubroutine:
3130	SetExplicitAttr(symbol, Attr::ELEMENTAL);
3131	SetExplicitAttr(symbol, Attr::PURE);
3132	break;
3133	case evaluate::IntrinsicClass::impureSubroutine:
3134	break;
3135	default:
3136	SetExplicitAttr(symbol, Attr::PURE);
3137	}
3138	}
3139
3140	const DeclTypeSpec *ScopeHandler::GetImplicitType(
3141	Symbol &symbol, bool respectImplicitNoneType) {
3142	const Scope *scope{&symbol.owner()};
3143	if (scope->IsGlobal()) {
3144	scope = &currScope();
3145	}
3146	scope = &GetInclusiveScope(scope: *scope);
3147	const auto *type{implicitRulesMap_->at(k: scope).GetType(
3148	symbol.name(), respectImplicitNoneType)};
3149	if (type) {
3150	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
3151	// Resolve any forward-referenced derived type; a quick no-op else.
3152	auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
3153	instantiatable.Instantiate(currScope());
3154	}
3155	}
3156	return type;
3157	}
3158
3159	void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) {
3160	if (!inSpecificationPart_ && symbol &&
3161	symbol->test(Symbol::Flag::EntryDummyArgument)) {
3162	Say(source,
3163	"Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US,
3164	symbol->name());
3165	symbol->set(Symbol::Flag::EntryDummyArgument, false);
3166	}
3167	}
3168
3169	// Convert symbol to be a ObjectEntity or return false if it can't be.
3170	bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
3171	if (symbol.has<ObjectEntityDetails>()) {
3172	// nothing to do
3173	} else if (symbol.has<UnknownDetails>()) {
3174	// These are attributes that a name could have picked up from
3175	// an attribute statement or type declaration statement.
3176	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
3177	return false;
3178	}
3179	symbol.set_details(ObjectEntityDetails{});
3180	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
3181	if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) {
3182	return false;
3183	}
3184	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3185	symbol.set_details(ObjectEntityDetails{std::move(*details)});
3186	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
3187	return useDetails->symbol().has<ObjectEntityDetails>();
3188	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
3189	return hostDetails->symbol().has<ObjectEntityDetails>();
3190	} else {
3191	return false;
3192	}
3193	return true;
3194	}
3195	// Convert symbol to be a ProcEntity or return false if it can't be.
3196	bool ScopeHandler::ConvertToProcEntity(
3197	Symbol &symbol, std::optional<SourceName> usedHere) {
3198	if (symbol.has<ProcEntityDetails>()) {
3199	} else if (symbol.has<UnknownDetails>()) {
3200	symbol.set_details(ProcEntityDetails{});
3201	} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
3202	if (IsFunctionResult(symbol) &&
3203	!(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
3204	// Don't turn function result into a procedure pointer unless both
3205	// POINTER and EXTERNAL
3206	return false;
3207	}
3208	funcResultStack_.CompleteTypeIfFunctionResult(symbol);
3209	symbol.set_details(ProcEntityDetails{std::move(*details)});
3210	if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
3211	CHECK(!symbol.test(Symbol::Flag::Subroutine));
3212	symbol.set(Symbol::Flag::Function);
3213	}
3214	} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
3215	return useDetails->symbol().has<ProcEntityDetails>();
3216	} else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) {
3217	return hostDetails->symbol().has<ProcEntityDetails>();
3218	} else {
3219	return false;
3220	}
3221	auto &proc{symbol.get<ProcEntityDetails>()};
3222	if (usedHere && !proc.usedAsProcedureHere()) {
3223	proc.set_usedAsProcedureHere(*usedHere);
3224	}
3225	return true;
3226	}
3227
3228	const DeclTypeSpec &ScopeHandler::MakeNumericType(
3229	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
3230	KindExpr value{GetKindParamExpr(category, kind)};
3231	if (auto known{evaluate::ToInt64(value)}) {
3232	return MakeNumericType(category, static_cast<int>(*known));
3233	} else {
3234	return currScope_->MakeNumericType(category, std::move(value));
3235	}
3236	}
3237
3238	const DeclTypeSpec &ScopeHandler::MakeNumericType(
3239	TypeCategory category, int kind) {
3240	return context().MakeNumericType(category, kind);
3241	}
3242
3243	const DeclTypeSpec &ScopeHandler::MakeLogicalType(
3244	const std::optional<parser::KindSelector> &kind) {
3245	KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
3246	if (auto known{evaluate::ToInt64(value)}) {
3247	return MakeLogicalType(static_cast<int>(*known));
3248	} else {
3249	return currScope_->MakeLogicalType(std::move(value));
3250	}
3251	}
3252
3253	const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
3254	return context().MakeLogicalType(kind);
3255	}
3256
3257	void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
3258	if (inSpecificationPart_ && !deferImplicitTyping_ && name.symbol) {
3259	auto kind{currScope().kind()};
3260	if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
3261	kind == Scope::Kind::BlockConstruct) {
3262	bool isHostAssociated{&name.symbol->owner() == &currScope()
3263	? name.symbol->has<HostAssocDetails>()
3264	: name.symbol->owner().Contains(currScope())};
3265	if (isHostAssociated) {
3266	specPartState_.forwardRefs.insert(name.source);
3267	}
3268	}
3269	}
3270	}
3271
3272	std::optional<SourceName> ScopeHandler::HadForwardRef(
3273	const Symbol &symbol) const {
3274	auto iter{specPartState_.forwardRefs.find(symbol.name())};
3275	if (iter != specPartState_.forwardRefs.end()) {
3276	return *iter;
3277	}
3278	return std::nullopt;
3279	}
3280
3281	bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
3282	if (!context().HasError(symbol)) {
3283	if (auto fwdRef{HadForwardRef(symbol)}) {
3284	const Symbol *outer{symbol.owner().FindSymbol(symbol.name())};
3285	if (outer && symbol.has<UseDetails>() &&
3286	&symbol.GetUltimate() == &outer->GetUltimate()) {
3287	// e.g. IMPORT of host's USE association
3288	return false;
3289	}
3290	Say(*fwdRef,
3291	"Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
3292	*fwdRef)
3293	.Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
3294	context().SetError(symbol);
3295	return true;
3296	}
3297	if ((IsDummy(symbol) || FindCommonBlockContaining(symbol)) &&
3298	isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) &&
3299	!context().HasError(symbol)) {
3300	// Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in
3301	// ApplyImplicitRules() due to use in a specification expression,
3302	// and no explicit type declaration appeared later.
3303	Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
3304	context().SetError(symbol);
3305	return true;
3306	}
3307	}
3308	return false;
3309	}
3310
3311	void ScopeHandler::MakeExternal(Symbol &symbol) {
3312	if (!symbol.attrs().test(Attr::EXTERNAL)) {
3313	SetImplicitAttr(symbol, Attr::EXTERNAL);
3314	if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
3315	Say(symbol.name(),
3316	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
3317	symbol.name());
3318	}
3319	}
3320	}
3321
3322	bool ScopeHandler::CheckDuplicatedAttr(
3323	SourceName name, Symbol &symbol, Attr attr) {
3324	if (attr == Attr::SAVE) {
3325	// checked elsewhere
3326	} else if (symbol.attrs().test(attr)) { // C815
3327	if (symbol.implicitAttrs().test(attr)) {
3328	// Implied attribute is now confirmed explicitly
3329	symbol.implicitAttrs().reset(attr);
3330	} else {
3331	Say(name, "%s attribute was already specified on '%s'"_err_en_US,
3332	EnumToString(attr), name);
3333	return false;
3334	}
3335	}
3336	return true;
3337	}
3338
3339	bool ScopeHandler::CheckDuplicatedAttrs(
3340	SourceName name, Symbol &symbol, Attrs attrs) {
3341	bool ok{true};
3342	attrs.IterateOverMembers(
3343	[&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });
3344	return ok;
3345	}
3346
3347	void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,
3348	std::optional<common::CUDADataAttr> attr) {
3349	if (attr) {
3350	ConvertToObjectEntity(symbol);
3351	if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
3352	if (*attr != object->cudaDataAttr().value_or(*attr)) {
3353	Say(source,
3354	"'%s' already has another CUDA data attribute ('%s')"_err_en_US,
3355	symbol.name(),
3356	std::string{common::EnumToString(*object->cudaDataAttr())}.c_str());
3357	} else {
3358	object->set_cudaDataAttr(attr);
3359	}
3360	} else {
3361	Say(source,
3362	"'%s' is not an object and may not have a CUDA data attribute"_err_en_US,
3363	symbol.name());
3364	}
3365	}
3366	}
3367
3368	// ModuleVisitor implementation
3369
3370	bool ModuleVisitor::Pre(const parser::Only &x) {
3371	common::visit(common::visitors{
3372	[&](const Indirection<parser::GenericSpec> &generic) {
3373	GenericSpecInfo genericSpecInfo{generic.value()};
3374	AddUseOnly(genericSpecInfo.symbolName());
3375	AddUse(genericSpecInfo);
3376	},
3377	[&](const parser::Name &name) {
3378	AddUseOnly(name.source);
3379	Resolve(name, AddUse(name.source, name.source).use);
3380	},
3381	[&](const parser::Rename &rename) { Walk(rename); },
3382	},
3383	x.u);
3384	return false;
3385	}
3386
3387	void ModuleVisitor::CollectUseRenames(const parser::UseStmt &useStmt) {
3388	auto doRename{[&](const parser::Rename &rename) {
3389	if (const auto *names{std::get_if<parser::Rename::Names>(&rename.u)}) {
3390	AddUseRename(name: std::get<1>(names->t).source, moduleName: useStmt.moduleName.source);
3391	}
3392	}};
3393	common::visit(
3394	common::visitors{
3395	[&](const std::list<parser::Rename> &renames) {
3396	for (const auto &rename : renames) {
3397	doRename(rename);
3398	}
3399	},
3400	[&](const std::list<parser::Only> &onlys) {
3401	for (const auto &only : onlys) {
3402	if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
3403	doRename(*rename);
3404	}
3405	}
3406	},
3407	},
3408	useStmt.u);
3409	}
3410
3411	bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
3412	const auto &localName{std::get<0>(x.t)};
3413	const auto &useName{std::get<1>(x.t)};
3414	SymbolRename rename{AddUse(localName.source, useName.source)};
3415	Resolve(useName, rename.use);
3416	Resolve(localName, rename.local);
3417	return false;
3418	}
3419	bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
3420	const parser::DefinedOpName &local{std::get<0>(x.t)};
3421	const parser::DefinedOpName &use{std::get<1>(x.t)};
3422	GenericSpecInfo localInfo{local};
3423	GenericSpecInfo useInfo{use};
3424	if (IsIntrinsicOperator(context(), local.v.source)) {
3425	Say(local.v,
3426	"Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
3427	} else if (IsLogicalConstant(context(), local.v.source)) {
3428	Say(local.v,
3429	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
3430	} else {
3431	SymbolRename rename{AddUse(localName: localInfo.symbolName(), useName: useInfo.symbolName())};
3432	useInfo.Resolve(rename.use);
3433	localInfo.Resolve(rename.local);
3434	}
3435	return false;
3436	}
3437
3438	// Set useModuleScope_ to the Scope of the module being used.
3439	bool ModuleVisitor::Pre(const parser::UseStmt &x) {
3440	std::optional<bool> isIntrinsic;
3441	if (x.nature) {
3442	isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic;
3443	} else if (currScope().IsModule() && currScope().symbol() &&
3444	currScope().symbol()->attrs().test(Attr::INTRINSIC)) {
3445	// Intrinsic modules USE only other intrinsic modules
3446	isIntrinsic = true;
3447	}
3448	useModuleScope_ = FindModule(x.moduleName, isIntrinsic);
3449	if (!useModuleScope_) {
3450	return false;
3451	}
3452	AddAndCheckModuleUse(x.moduleName.source,
3453	useModuleScope_->parent().kind() == Scope::Kind::IntrinsicModules);
3454	// use the name from this source file
3455	useModuleScope_->symbol()->ReplaceName(x.moduleName.source);
3456	return true;
3457	}
3458
3459	void ModuleVisitor::Post(const parser::UseStmt &x) {
3460	if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
3461	// Not a use-only: collect the names that were used in renames,
3462	// then add a use for each public name that was not renamed.
3463	std::set<SourceName> useNames;
3464	for (const auto &rename : *list) {
3465	common::visit(common::visitors{
3466	[&](const parser::Rename::Names &names) {
3467	useNames.insert(std::get<1>(names.t).source);
3468	},
3469	[&](const parser::Rename::Operators &ops) {
3470	useNames.insert(std::get<1>(ops.t).v.source);
3471	},
3472	},
3473	rename.u);
3474	}
3475	for (const auto &[name, symbol] : *useModuleScope_) {
3476	if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&
3477	(!symbol->implicitAttrs().test(Attr::INTRINSIC) ||
3478	symbol->has<UseDetails>()) &&
3479	!symbol->has<MiscDetails>() && useNames.count(name) == 0) {
3480	SourceName location{x.moduleName.source};
3481	if (auto *localSymbol{FindInScope(name)}) {
3482	DoAddUse(location, localSymbol->name(), *localSymbol, *symbol);
3483	} else {
3484	DoAddUse(location, location, CopySymbol(name, *symbol), *symbol);
3485	}
3486	}
3487	}
3488	}
3489	useModuleScope_ = nullptr;
3490	}
3491
3492	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
3493	const SourceName &localName, const SourceName &useName) {
3494	return AddUse(localName, useName, FindInScope(*useModuleScope_, useName));
3495	}
3496
3497	ModuleVisitor::SymbolRename ModuleVisitor::AddUse(
3498	const SourceName &localName, const SourceName &useName, Symbol *useSymbol) {
3499	if (!useModuleScope_) {
3500	return {}; // error occurred finding module
3501	}
3502	if (!useSymbol) {
3503	Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName),
3504	useModuleScope_->GetName().value());
3505	return {};
3506	}
3507	if (useSymbol->attrs().test(Attr::PRIVATE) &&
3508	!FindModuleFileContaining(currScope())) {
3509	// Privacy is not enforced in module files so that generic interfaces
3510	// can be resolved to private specific procedures in specification
3511	// expressions.
3512	// Local names that contain currency symbols ('$') are created by the
3513	// module file writer when a private name in another module is needed to
3514	// process a local declaration. These can show up in the output of
3515	// -fdebug-unparse-with-modules, too, so go easy on them.
3516	if (currScope().IsModule() &&
3517	localName.ToString().find("$") != std::string::npos) {
3518	Say(useName, "'%s' is PRIVATE in '%s'"_warn_en_US, MakeOpName(useName),
3519	useModuleScope_->GetName().value());
3520	} else {
3521	Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName),
3522	useModuleScope_->GetName().value());
3523	return {};
3524	}
3525	}
3526	auto &localSymbol{MakeSymbol(localName)};
3527	DoAddUse(useName, localName, localSymbol&: localSymbol, useSymbol: *useSymbol);
3528	return {&localSymbol, useSymbol};
3529	}
3530
3531	// symbol must be either a Use or a Generic formed by merging two uses.
3532	// Convert it to a UseError with this additional location.
3533	bool ScopeHandler::ConvertToUseError(
3534	Symbol &symbol, const SourceName &location, const Symbol &used) {
3535	if (auto *ued{symbol.detailsIf<UseErrorDetails>()}) {
3536	ued->add_occurrence(location, used);
3537	return true;
3538	}
3539	const auto *useDetails{symbol.detailsIf<UseDetails>()};
3540	if (!useDetails) {
3541	if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {
3542	if (!genericDetails->uses().empty()) {
3543	useDetails = &genericDetails->uses().at(0)->get<UseDetails>();
3544	}
3545	}
3546	}
3547	if (useDetails) {
3548	symbol.set_details(
3549	UseErrorDetails{*useDetails}.add_occurrence(location, used));
3550	return true;
3551	}
3552	if (const auto *hostAssocDetails{symbol.detailsIf<HostAssocDetails>()};
3553	hostAssocDetails && hostAssocDetails->symbol().has<SubprogramDetails>() &&
3554	&symbol.owner() == &currScope() &&
3555	&hostAssocDetails->symbol() == currScope().symbol()) {
3556	// Handle USE-association of procedure FOO into function/subroutine FOO,
3557	// replacing its place-holding HostAssocDetails symbol.
3558	context().Warn(common::UsageWarning::UseAssociationIntoSameNameSubprogram,
3559	location,
3560	"'%s' is use-associated into a subprogram of the same name"_port_en_US,
3561	used.name());
3562	SourceName created{context().GetTempName(currScope())};
3563	Symbol &tmpUse{MakeSymbol(created, Attrs(), UseDetails{location, used})};
3564	UseErrorDetails useError{tmpUse.get<UseDetails>()};
3565	useError.add_occurrence(location, hostAssocDetails->symbol());
3566	symbol.set_details(std::move(useError));
3567	return true;
3568	}
3569	return false;
3570	}
3571
3572	// Two ultimate symbols are distinct, but they have the same name and come
3573	// from modules with the same name. At link time, their mangled names
3574	// would conflict, so they had better resolve to the same definition.
3575	// Check whether the two ultimate symbols have compatible definitions.
3576	// Returns true if no further processing is required in DoAddUse().
3577	static bool CheckCompatibleDistinctUltimates(SemanticsContext &context,
3578	SourceName location, SourceName localName, const Symbol &localSymbol,
3579	const Symbol &localUltimate, const Symbol &useUltimate, bool &isError) {
3580	isError = false;
3581	if (localUltimate.has<GenericDetails>()) {
3582	if (useUltimate.has<GenericDetails>() ||
3583	useUltimate.has<SubprogramDetails>() ||
3584	useUltimate.has<DerivedTypeDetails>()) {
3585	return false; // can try to merge them
3586	} else {
3587	isError = true;
3588	}
3589	} else if (useUltimate.has<GenericDetails>()) {
3590	if (localUltimate.has<SubprogramDetails>() ||
3591	localUltimate.has<DerivedTypeDetails>()) {
3592	return false; // can try to merge them
3593	} else {
3594	isError = true;
3595	}
3596	} else if (localUltimate.has<SubprogramDetails>()) {
3597	if (useUltimate.has<SubprogramDetails>()) {
3598	auto localCharacteristics{
3599	evaluate::characteristics::Procedure::Characterize(
3600	localUltimate, context.foldingContext())};
3601	auto useCharacteristics{
3602	evaluate::characteristics::Procedure::Characterize(
3603	useUltimate, context.foldingContext())};
3604	if ((localCharacteristics &&
3605	(!useCharacteristics ||
3606	*localCharacteristics != *useCharacteristics)) ||
3607	(!localCharacteristics && useCharacteristics)) {
3608	isError = true;
3609	}
3610	} else {
3611	isError = true;
3612	}
3613	} else if (useUltimate.has<SubprogramDetails>()) {
3614	isError = true;
3615	} else if (const auto *localObject{
3616	localUltimate.detailsIf<ObjectEntityDetails>()}) {
3617	if (const auto *useObject{useUltimate.detailsIf<ObjectEntityDetails>()}) {
3618	auto localType{evaluate::DynamicType::From(localUltimate)};
3619	auto useType{evaluate::DynamicType::From(useUltimate)};
3620	if (localUltimate.size() != useUltimate.size() ||
3621	(localType &&
3622	(!useType || !localType->IsTkLenCompatibleWith(*useType) ||
3623	!useType->IsTkLenCompatibleWith(*localType))) ||
3624	(!localType && useType)) {
3625	isError = true;
3626	} else if (IsNamedConstant(localUltimate)) {
3627	isError = !IsNamedConstant(useUltimate) ||
3628	!(*localObject->init() == *useObject->init());
3629	} else {
3630	isError = IsNamedConstant(useUltimate);
3631	}
3632	} else {
3633	isError = true;
3634	}
3635	} else if (useUltimate.has<ObjectEntityDetails>()) {
3636	isError = true;
3637	} else if (IsProcedurePointer(localUltimate)) {
3638	isError = !IsProcedurePointer(useUltimate);
3639	} else if (IsProcedurePointer(useUltimate)) {
3640	isError = true;
3641	} else if (localUltimate.has<DerivedTypeDetails>()) {
3642	isError = !(useUltimate.has<DerivedTypeDetails>() &&
3643	evaluate::AreSameDerivedTypeIgnoringSequence(
3644	DerivedTypeSpec{localUltimate.name(), localUltimate},
3645	DerivedTypeSpec{useUltimate.name(), useUltimate}));
3646	} else if (useUltimate.has<DerivedTypeDetails>()) {
3647	isError = true;
3648	} else if (localUltimate.has<NamelistDetails>() &&
3649	useUltimate.has<NamelistDetails>()) {
3650	} else if (localUltimate.has<CommonBlockDetails>() &&
3651	useUltimate.has<CommonBlockDetails>()) {
3652	} else {
3653	isError = true;
3654	}
3655	return true; // don't try to merge generics (or whatever)
3656	}
3657
3658	void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
3659	Symbol &originalLocal, const Symbol &useSymbol) {
3660	Symbol *localSymbol{&originalLocal};
3661	if (auto *details{localSymbol->detailsIf<UseErrorDetails>()}) {
3662	details->add_occurrence(location, useSymbol);
3663	return;
3664	}
3665	const Symbol &useUltimate{useSymbol.GetUltimate()};
3666	const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
3667	if (localSymbol->has<UnknownDetails>()) {
3668	if (useGeneric &&
3669	((useGeneric->specific() &&
3670	IsProcedurePointer(*useGeneric->specific())) ||
3671	(useGeneric->derivedType() &&
3672	useUltimate.name() != localSymbol->name()))) {
3673	// We are use-associating a generic that either shadows a procedure
3674	// pointer or shadows a derived type with a distinct name.
3675	// Local references that might be made to the procedure pointer should
3676	// use a UseDetails symbol for proper data addressing, and a derived
3677	// type needs to be in scope with its local name. So create an
3678	// empty local generic now into which the use-associated generic may
3679	// be copied.
3680	localSymbol->set_details(GenericDetails{});
3681	localSymbol->get<GenericDetails>().set_kind(useGeneric->kind());
3682	} else { // just create UseDetails
3683	localSymbol->set_details(UseDetails{localName, useSymbol});
3684	localSymbol->attrs() =
3685	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE};
3686	localSymbol->implicitAttrs() =
3687	localSymbol->attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE};
3688	localSymbol->flags() = useSymbol.flags();
3689	return;
3690	}
3691	}
3692
3693	Symbol &localUltimate{localSymbol->GetUltimate()};
3694	if (&localUltimate == &useUltimate) {
3695	// use-associating the same symbol again -- ok
3696	return;
3697	}
3698	if (useUltimate.owner().IsModule() && localUltimate.owner().IsSubmodule() &&
3699	DoesScopeContain(&useUltimate.owner(), localUltimate)) {
3700	// Within a submodule, USE'ing a symbol that comes indirectly
3701	// from the ancestor module, e.g. foo in:
3702	// MODULE m1; INTERFACE; MODULE SUBROUTINE foo; END INTERFACE; END
3703	// MODULE m2; USE m1; END
3704	// SUBMODULE m1(sm); USE m2; CONTAINS; MODULE PROCEDURE foo; END; END
3705	return; // ok, ignore it
3706	}
3707
3708	if (localUltimate.name() == useUltimate.name() &&
3709	localUltimate.owner().IsModule() && useUltimate.owner().IsModule() &&
3710	localUltimate.owner().GetName() &&
3711	localUltimate.owner().GetName() == useUltimate.owner().GetName()) {
3712	bool isError{false};
3713	if (CheckCompatibleDistinctUltimates(context(), location, localName,
3714	*localSymbol, localUltimate, useUltimate, isError)) {
3715	if (isError) {
3716	// Convert the local symbol to a UseErrorDetails, if possible;
3717	// otherwise emit a fatal error.
3718	if (!ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol)) {
3719	context()
3720	.Say(location,
3721	"'%s' use-associated from '%s' in module '%s' is incompatible with '%s' from another module"_err_en_US,
3722	localName, useUltimate.name(),
3723	useUltimate.owner().GetName().value(), localUltimate.name())
3724	.Attach(useUltimate.name(), "First declaration"_en_US)
3725	.Attach(localUltimate.name(), "Other declaration"_en_US);
3726	return;
3727	}
3728	}
3729	if (auto *msg{context().Warn(
3730	common::UsageWarning::CompatibleDeclarationsFromDistinctModules,
3731	location,
3732	"'%s' is use-associated from '%s' in two distinct instances of module '%s'"_warn_en_US,
3733	localName, localUltimate.name(),
3734	localUltimate.owner().GetName().value())}) {
3735	msg->Attach(localUltimate.name(), "Previous declaration"_en_US)
3736	.Attach(useUltimate.name(), "Later declaration"_en_US);
3737	}
3738	return;
3739	}
3740	}
3741
3742	// There are many possible combinations of symbol types that could arrive
3743	// with the same (local) name vie USE association from distinct modules.
3744	// Fortran allows a generic interface to share its name with a derived type,
3745	// or with the name of a non-generic procedure (which should be one of the
3746	// generic's specific procedures). Implementing all these possibilities is
3747	// complicated.
3748	// Error cases are converted into UseErrorDetails symbols to trigger error
3749	// messages when/if bad combinations are actually used later in the program.
3750	// The error cases are:
3751	// - two distinct derived types
3752	// - two distinct non-generic procedures
3753	// - a generic and a non-generic that is not already one of its specifics
3754	// - anything other than a derived type, non-generic procedure, or
3755	// generic procedure being combined with something other than an
3756	// prior USE association of itself
3757	auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
3758	Symbol *localDerivedType{nullptr};
3759	if (localUltimate.has<DerivedTypeDetails>()) {
3760	localDerivedType = &localUltimate;
3761	} else if (localGeneric) {
3762	if (auto *dt{localGeneric->derivedType()};
3763	dt && !dt->attrs().test(Attr::PRIVATE)) {
3764	localDerivedType = dt;
3765	}
3766	}
3767	const Symbol *useDerivedType{nullptr};
3768	if (useUltimate.has<DerivedTypeDetails>()) {
3769	useDerivedType = &useUltimate;
3770	} else if (useGeneric) {
3771	if (const auto *dt{useGeneric->derivedType()};
3772	dt && !dt->attrs().test(Attr::PRIVATE)) {
3773	useDerivedType = dt;
3774	}
3775	}
3776
3777	Symbol *localProcedure{nullptr};
3778	if (localGeneric) {
3779	if (localGeneric->specific() &&
3780	!localGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3781	localProcedure = localGeneric->specific();
3782	}
3783	} else if (IsProcedure(localUltimate)) {
3784	localProcedure = &localUltimate;
3785	}
3786	const Symbol *useProcedure{nullptr};
3787	if (useGeneric) {
3788	if (useGeneric->specific() &&
3789	!useGeneric->specific()->attrs().test(Attr::PRIVATE)) {
3790	useProcedure = useGeneric->specific();
3791	}
3792	} else if (IsProcedure(useUltimate)) {
3793	useProcedure = &useUltimate;
3794	}
3795
3796	// Creates a UseErrorDetails symbol in the current scope for a
3797	// current UseDetails symbol, but leaves the UseDetails in the
3798	// scope's name map.
3799	auto CreateLocalUseError{[&]() {
3800	EraseSymbol(*localSymbol);
3801	CHECK(localSymbol->has<UseDetails>());
3802	UseErrorDetails details{localSymbol->get<UseDetails>()};
3803	details.add_occurrence(location, useSymbol);
3804	Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))};
3805	// Restore *localSymbol in currScope
3806	auto iter{currScope().find(localName)};
3807	CHECK(iter != currScope().end() && &*iter->second == newSymbol);
3808	iter->second = MutableSymbolRef{*localSymbol};
3809	return newSymbol;
3810	}};
3811
3812	// When two derived types arrived, try to combine them.
3813	const Symbol *combinedDerivedType{nullptr};
3814	if (!useDerivedType) {
3815	combinedDerivedType = localDerivedType;
3816	} else if (!localDerivedType) {
3817	if (useDerivedType->name() == localName) {
3818	combinedDerivedType = useDerivedType;
3819	} else {
3820	combinedDerivedType =
3821	&currScope().MakeSymbol(localSymbol->name(), useDerivedType->attrs(),
3822	UseDetails{localSymbol->name(), *useDerivedType});
3823	}
3824	} else if (&localDerivedType->GetUltimate() ==
3825	&useDerivedType->GetUltimate()) {
3826	combinedDerivedType = localDerivedType;
3827	} else {
3828	const Scope *localScope{localDerivedType->GetUltimate().scope()};
3829	const Scope *useScope{useDerivedType->GetUltimate().scope()};
3830	if (localScope && useScope && localScope->derivedTypeSpec() &&
3831	useScope->derivedTypeSpec() &&
3832	evaluate::AreSameDerivedType(
3833	*localScope->derivedTypeSpec(), *useScope->derivedTypeSpec())) {
3834	combinedDerivedType = localDerivedType;
3835	} else {
3836	// Create a local UseErrorDetails for the ambiguous derived type
3837	if (localGeneric) {
3838	combinedDerivedType = CreateLocalUseError();
3839	} else {
3840	ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol);
3841	localDerivedType = nullptr;
3842	localGeneric = nullptr;
3843	combinedDerivedType = localSymbol;
3844	}
3845	}
3846	if (!localGeneric && !useGeneric) {
3847	return; // both symbols are derived types; done
3848	}
3849	}
3850
3851	auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) {
3852	if (&p1 == &p2) {
3853	return true;
3854	} else if (p1.name() != p2.name()) {
3855	return false;
3856	} else if (p1.attrs().test(Attr::INTRINSIC) ||
3857	p2.attrs().test(Attr::INTRINSIC)) {
3858	return p1.attrs().test(Attr::INTRINSIC) &&
3859	p2.attrs().test(Attr::INTRINSIC);
3860	} else if (!IsProcedure(p1) || !IsProcedure(p2)) {
3861	return false;
3862	} else if (IsPointer(p1) || IsPointer(p2)) {
3863	return false;
3864	} else if (const auto *subp{p1.detailsIf<SubprogramDetails>()};
3865	subp && !subp->isInterface()) {
3866	return false; // defined in module, not an external
3867	} else if (const auto *subp{p2.detailsIf<SubprogramDetails>()};
3868	subp && !subp->isInterface()) {
3869	return false; // defined in module, not an external
3870	} else {
3871	// Both are external interfaces, perhaps to the same procedure
3872	auto class1{ClassifyProcedure(p1)};
3873	auto class2{ClassifyProcedure(p2)};
3874	if (class1 == ProcedureDefinitionClass::External &&
3875	class2 == ProcedureDefinitionClass::External) {
3876	auto chars1{evaluate::characteristics::Procedure::Characterize(
3877	p1, GetFoldingContext())};
3878	auto chars2{evaluate::characteristics::Procedure::Characterize(
3879	p2, GetFoldingContext())};
3880	// same procedure interface defined identically in two modules?
3881	return chars1 && chars2 && *chars1 == *chars2;
3882	} else {
3883	return false;
3884	}
3885	}
3886	}};
3887
3888	// When two non-generic procedures arrived, try to combine them.
3889	const Symbol *combinedProcedure{nullptr};
3890	if (!localProcedure) {
3891	combinedProcedure = useProcedure;
3892	} else if (!useProcedure) {
3893	combinedProcedure = localProcedure;
3894	} else {
3895	if (AreSameProcedure(
3896	localProcedure->GetUltimate(), useProcedure->GetUltimate())) {
3897	if (!localGeneric && !useGeneric) {
3898	return; // both symbols are non-generic procedures
3899	}
3900	combinedProcedure = localProcedure;
3901	}
3902	}
3903
3904	// Prepare to merge generics
3905	bool cantCombine{false};
3906	if (localGeneric) {
3907	if (useGeneric || useDerivedType) {
3908	} else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
3909	return; // nothing to do; used subprogram is local's specific
3910	} else if (useUltimate.attrs().test(Attr::INTRINSIC) &&
3911	useUltimate.name() == localSymbol->name()) {
3912	return; // local generic can extend intrinsic
3913	} else {
3914	for (const auto &ref : localGeneric->specificProcs()) {
3915	if (&ref->GetUltimate() == &useUltimate) {
3916	return; // used non-generic is already a specific of local generic
3917	}
3918	}
3919	cantCombine = true;
3920	}
3921	} else if (useGeneric) {
3922	if (localDerivedType) {
3923	} else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate() ||
3924	(localSymbol->attrs().test(Attr::INTRINSIC) &&
3925	localUltimate.name() == useUltimate.name())) {
3926	// Local is the specific of the used generic or an intrinsic with the
3927	// same name; replace it.
3928	EraseSymbol(*localSymbol);
3929	Symbol &newSymbol{MakeSymbol(localName,
3930	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
3931	UseDetails{localName, useUltimate})};
3932	newSymbol.flags() = useSymbol.flags();
3933	return;
3934	} else {
3935	for (const auto &ref : useGeneric->specificProcs()) {
3936	if (&ref->GetUltimate() == &localUltimate) {
3937	return; // local non-generic is already a specific of used generic
3938	}
3939	}
3940	cantCombine = true;
3941	}
3942	} else {
3943	cantCombine = true;
3944	}
3945
3946	// If symbols are not combinable, create a use error.
3947	if (cantCombine) {
3948	if (!ConvertToUseError(symbol&: *localSymbol, location: location, used: useSymbol)) {
3949	Say(location,
3950	"Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
3951	localName)
3952	.Attach(localSymbol->name(), "Previous declaration of '%s'"_en_US,
3953	localName);
3954	}
3955	return;
3956	}
3957
3958	// At this point, there must be at least one generic interface.
3959	CHECK(localGeneric || (useGeneric && (localDerivedType || localProcedure)));
3960
3961	// Ensure that a use-associated specific procedure that is a procedure
3962	// pointer is properly represented as a USE association of an entity.
3963	if (IsProcedurePointer(useProcedure)) {
3964	Symbol &combined{currScope().MakeSymbol(localSymbol->name(),
3965	useProcedure->attrs(), UseDetails{localName, *useProcedure})};
3966	combined.flags() |= useProcedure->flags();
3967	combinedProcedure = &combined;
3968	}
3969
3970	if (localGeneric) {
3971	// Create a local copy of a previously use-associated generic so that
3972	// it can be locally extended without corrupting the original.
3973	if (localSymbol->has<UseDetails>()) {
3974	GenericDetails generic;
3975	generic.CopyFrom(DEREF(localGeneric));
3976	EraseSymbol(*localSymbol);
3977	Symbol &newSymbol{MakeSymbol(
3978	localSymbol->name(), localSymbol->attrs(), std::move(generic))};
3979	newSymbol.flags() = localSymbol->flags();
3980	localGeneric = &newSymbol.get<GenericDetails>();
3981	localGeneric->AddUse(*localSymbol);
3982	localSymbol = &newSymbol;
3983	}
3984	if (useGeneric) {
3985	// Combine two use-associated generics
3986	localSymbol->attrs() =
3987	useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
3988	localSymbol->flags() = useSymbol.flags();
3989	AddGenericUse(*localGeneric, localName, useUltimate);
3990	localGeneric->clear_derivedType();
3991	localGeneric->CopyFrom(*useGeneric);
3992	}
3993	localGeneric->clear_derivedType();
3994	if (combinedDerivedType) {
3995	localGeneric->set_derivedType(*const_cast<Symbol *>(combinedDerivedType));
3996	}
3997	localGeneric->clear_specific();
3998	if (combinedProcedure) {
3999	localGeneric->set_specific(*const_cast<Symbol *>(combinedProcedure));
4000	}
4001	} else {
4002	CHECK(localSymbol->has<UseDetails>());
4003	// Create a local copy of the use-associated generic, then extend it
4004	// with the combined derived type &/or non-generic procedure.
4005	GenericDetails generic;
4006	generic.CopyFrom(*useGeneric);
4007	EraseSymbol(*localSymbol);
4008	Symbol &newSymbol{MakeSymbol(localName,
4009	useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
4010	std::move(generic))};
4011	newSymbol.flags() = useUltimate.flags();
4012	auto &newUseGeneric{newSymbol.get<GenericDetails>()};
4013	AddGenericUse(newUseGeneric, localName, useUltimate);
4014	newUseGeneric.AddUse(*localSymbol);
4015	if (combinedDerivedType) {
4016	if (const auto *oldDT{newUseGeneric.derivedType()}) {
4017	CHECK(&oldDT->GetUltimate() == &combinedDerivedType->GetUltimate());
4018	} else {
4019	newUseGeneric.set_derivedType(
4020	*const_cast<Symbol *>(combinedDerivedType));
4021	}
4022	}
4023	if (combinedProcedure) {
4024	newUseGeneric.set_specific(*const_cast<Symbol *>(combinedProcedure));
4025	}
4026	}
4027	}
4028
4029	void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
4030	if (useModuleScope_) {
4031	const auto &name{info.symbolName()};
4032	auto rename{AddUse(localName: name, useName: name, useSymbol: FindInScope(*useModuleScope_, name))};
4033	info.Resolve(rename.use);
4034	}
4035	}
4036
4037	// Create a UseDetails symbol for this USE and add it to generic
4038	Symbol &ModuleVisitor::AddGenericUse(
4039	GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {
4040	Symbol &newSymbol{
4041	currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})};
4042	generic.AddUse(newSymbol);
4043	return newSymbol;
4044	}
4045
4046	// Enforce F'2023 C1406 as a warning
4047	void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) {
4048	if (isIntrinsic) {
4049	if (auto iter{nonIntrinsicUses_.find(name)};
4050	iter != nonIntrinsicUses_.end()) {
4051	if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
4052	name,
4053	"Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,
4054	name)}) {
4055	msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
4056	}
4057	}
4058	intrinsicUses_.insert(name);
4059	} else {
4060	if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) {
4061	if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
4062	name,
4063	"Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,
4064	name)}) {
4065	msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
4066	}
4067	}
4068	nonIntrinsicUses_.insert(name);
4069	}
4070	}
4071
4072	bool ModuleVisitor::BeginSubmodule(
4073	const parser::Name &name, const parser::ParentIdentifier &parentId) {
4074	const auto &ancestorName{std::get<parser::Name>(parentId.t)};
4075	Scope *parentScope{nullptr};
4076	Scope *ancestor{FindModule(ancestorName, isIntrinsic: false /*not intrinsic*/)};
4077	if (ancestor) {
4078	if (const auto &parentName{
4079	std::get<std::optional<parser::Name>>(parentId.t)}) {
4080	parentScope = FindModule(*parentName, isIntrinsic: false /*not intrinsic*/, ancestor);
4081	} else {
4082	parentScope = ancestor;
4083	}
4084	}
4085	if (parentScope) {
4086	PushScope(*parentScope);
4087	} else {
4088	// Error recovery: there's no ancestor scope, so create a dummy one to
4089	// hold the submodule's scope.
4090	SourceName dummyName{context().GetTempName(currScope())};
4091	Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})};
4092	PushScope(Scope::Kind::Module, &dummySymbol);
4093	parentScope = &currScope();
4094	}
4095	BeginModule(name, isSubmodule: true);
4096	set_inheritFromParent(false); // submodules don't inherit parents' implicits
4097	if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) {
4098	Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
4099	ancestorName.source, name.source);
4100	}
4101	return true;
4102	}
4103
4104	void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) {
4105	// Submodule symbols are not visible in their parents' scopes.
4106	Symbol &symbol{isSubmodule ? Resolve(name,
4107	currScope().MakeSymbol(name.source, Attrs{},
4108	ModuleDetails{true}))
4109	: MakeSymbol(name, ModuleDetails{false})};
4110	auto &details{symbol.get<ModuleDetails>()};
4111	PushScope(Scope::Kind::Module, &symbol);
4112	details.set_scope(&currScope());
4113	prevAccessStmt_ = std::nullopt;
4114	}
4115
4116	// Find a module or submodule by name and return its scope.
4117	// If ancestor is present, look for a submodule of that ancestor module.
4118	// May have to read a .mod file to find it.
4119	// If an error occurs, report it and return nullptr.
4120	Scope *ModuleVisitor::FindModule(const parser::Name &name,
4121	std::optional<bool> isIntrinsic, Scope *ancestor) {
4122	ModFileReader reader{context()};
4123	Scope *scope{
4124	reader.Read(name.source, isIntrinsic, ancestor, /*silent=*/false)};
4125	if (scope) {
4126	if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
4127	std::optional<SourceName> submoduleName;
4128	if (const Scope * container{FindModuleOrSubmoduleContaining(currScope())};
4129	container && container->IsSubmodule()) {
4130	submoduleName = container->GetName();
4131	}
4132	if (submoduleName) {
4133	Say(name.source,
4134	"Module '%s' cannot USE itself from its own submodule '%s'"_err_en_US,
4135	name.source, *submoduleName);
4136	} else {
4137	Say(name, "Module '%s' cannot USE itself"_err_en_US);
4138	}
4139	}
4140	Resolve(name, scope->symbol());
4141	}
4142	return scope;
4143	}
4144
4145	void ModuleVisitor::ApplyDefaultAccess() {
4146	const auto *moduleDetails{
4147	DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
4148	CHECK(moduleDetails);
4149	Attr defaultAttr{
4150	DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE : Attr::PUBLIC};
4151	for (auto &pair : currScope()) {
4152	Symbol &symbol{*pair.second};
4153	if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
4154	Attr attr{defaultAttr};
4155	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
4156	if (generic->derivedType()) {
4157	// If a generic interface has a derived type of the same
4158	// name that has an explicit accessibility attribute, then
4159	// the generic must have the same accessibility.
4160	if (generic->derivedType()->attrs().test(Attr::PUBLIC)) {
4161	attr = Attr::PUBLIC;
4162	} else if (generic->derivedType()->attrs().test(Attr::PRIVATE)) {
4163	attr = Attr::PRIVATE;
4164	}
4165	}
4166	}
4167	SetImplicitAttr(symbol, attr);
4168	}
4169	}
4170	}
4171
4172	// InterfaceVistor implementation
4173
4174	bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
4175	bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)};
4176	genericInfo_.emplace(/*isInterface*/ args: true, args&: isAbstract);
4177	return BeginAttrs();
4178	}
4179
4180	void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
4181
4182	void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
4183	ResolveNewSpecifics();
4184	genericInfo_.pop();
4185	}
4186
4187	// Create a symbol in genericSymbol_ for this GenericSpec.
4188	bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
4189	if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) {
4190	SetGenericSymbol(*symbol);
4191	}
4192	return false;
4193	}
4194
4195	bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
4196	if (!isGeneric()) {
4197	Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
4198	} else {
4199	auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
4200	const auto &names{std::get<std::list<parser::Name>>(x.t)};
4201	AddSpecificProcs(names, kind);
4202	}
4203	return false;
4204	}
4205
4206	bool InterfaceVisitor::Pre(const parser::GenericStmt &) {
4207	genericInfo_.emplace(/*isInterface*/ args: false);
4208	return BeginAttrs();
4209	}
4210	void InterfaceVisitor::Post(const parser::GenericStmt &x) {
4211	auto attrs{EndAttrs()};
4212	if (Symbol * symbol{GetGenericInfo().symbol}) {
4213	SetExplicitAttrs(*symbol, attrs);
4214	}
4215	const auto &names{std::get<std::list<parser::Name>>(x.t)};
4216	AddSpecificProcs(names, ProcedureKind::Procedure);
4217	ResolveNewSpecifics();
4218	genericInfo_.pop();
4219	}
4220
4221	bool InterfaceVisitor::inInterfaceBlock() const {
4222	return !genericInfo_.empty() && GetGenericInfo().isInterface;
4223	}
4224	bool InterfaceVisitor::isGeneric() const {
4225	return !genericInfo_.empty() && GetGenericInfo().symbol;
4226	}
4227	bool InterfaceVisitor::isAbstract() const {
4228	return !genericInfo_.empty() && GetGenericInfo().isAbstract;
4229	}
4230
4231	void InterfaceVisitor::AddSpecificProcs(
4232	const std::list<parser::Name> &names, ProcedureKind kind) {
4233	if (Symbol * symbol{GetGenericInfo().symbol};
4234	symbol && symbol->has<GenericDetails>()) {
4235	for (const auto &name : names) {
4236	specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));
4237	genericsForSpecificProcs_.emplace(name.source, symbol);
4238	}
4239	}
4240	}
4241
4242	// By now we should have seen all specific procedures referenced by name in
4243	// this generic interface. Resolve those names to symbols.
4244	void GenericHandler::ResolveSpecificsInGeneric(
4245	Symbol &generic, bool isEndOfSpecificationPart) {
4246	auto &details{generic.get<GenericDetails>()};
4247	UnorderedSymbolSet symbolsSeen;
4248	for (const Symbol &symbol : details.specificProcs()) {
4249	symbolsSeen.insert(symbol.GetUltimate());
4250	}
4251	auto range{specificsForGenericProcs_.equal_range(&generic)};
4252	SpecificProcMapType retain;
4253	for (auto it{range.first}; it != range.second; ++it) {
4254	const parser::Name *name{it->second.first};
4255	auto kind{it->second.second};
4256	const Symbol *symbol{isEndOfSpecificationPart
4257	? FindSymbol(*name)
4258	: FindInScope(generic.owner(), *name)};
4259	ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None};
4260	const Symbol *specific{symbol};
4261	const Symbol *ultimate{nullptr};
4262	if (symbol) {
4263	// Subtlety: when *symbol is a use- or host-association, the specific
4264	// procedure that is recorded in the GenericDetails below must be *symbol,
4265	// not the specific procedure shadowed by a generic, because that specific
4266	// procedure may be a symbol from another module and its name unavailable
4267	// to emit to a module file.
4268	const Symbol &bypassed{BypassGeneric(*symbol)};
4269	if (symbol == &symbol->GetUltimate()) {
4270	specific = &bypassed;
4271	}
4272	ultimate = &bypassed.GetUltimate();
4273	defClass = ClassifyProcedure(*ultimate);
4274	}
4275	std::optional<MessageFixedText> error;
4276	if (defClass == ProcedureDefinitionClass::Module) {
4277	// ok
4278	} else if (kind == ProcedureKind::ModuleProcedure) {
4279	error = "'%s' is not a module procedure"_err_en_US;
4280	} else {
4281	switch (defClass) {
4282	case ProcedureDefinitionClass::Intrinsic:
4283	case ProcedureDefinitionClass::External:
4284	case ProcedureDefinitionClass::Internal:
4285	case ProcedureDefinitionClass::Dummy:
4286	case ProcedureDefinitionClass::Pointer:
4287	break;
4288	case ProcedureDefinitionClass::None:
4289	error = "'%s' is not a procedure"_err_en_US;
4290	break;
4291	default:
4292	error =
4293	"'%s' is not a procedure that can appear in a generic interface"_err_en_US;
4294	break;
4295	}
4296	}
4297	if (error) {
4298	if (isEndOfSpecificationPart) {
4299	Say(*name, std::move(*error));
4300	} else {
4301	// possible forward reference, catch it later
4302	retain.emplace(&generic, std::make_pair(name, kind));
4303	}
4304	} else if (!ultimate) {
4305	} else if (symbolsSeen.insert(*ultimate).second /*true if added*/) {
4306	// When a specific procedure is a USE association, that association
4307	// is saved in the generic's specifics, not its ultimate symbol,
4308	// so that module file output of interfaces can distinguish them.
4309	details.AddSpecificProc(*specific, name->source);
4310	} else if (specific == ultimate) {
4311	Say(name->source,
4312	"Procedure '%s' is already specified in generic '%s'"_err_en_US,
4313	name->source, MakeOpName(generic.name()));
4314	} else {
4315	Say(name->source,
4316	"Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
4317	ultimate->name(), ultimate->owner().GetName().value(),
4318	MakeOpName(generic.name()));
4319	}
4320	}
4321	specificsForGenericProcs_.erase(range.first, range.second);
4322	specificsForGenericProcs_.merge(std::move(retain));
4323	}
4324
4325	void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {
4326	auto range{genericsForSpecificProcs_.equal_range(proc.name())};
4327	for (auto iter{range.first}; iter != range.second; ++iter) {
4328	ResolveSpecificsInGeneric(generic&: *iter->second, isEndOfSpecificationPart: false);
4329	}
4330	}
4331
4332	void InterfaceVisitor::ResolveNewSpecifics() {
4333	if (Symbol * generic{genericInfo_.top().symbol};
4334	generic && generic->has<GenericDetails>()) {
4335	ResolveSpecificsInGeneric(*generic, false);
4336	}
4337	}
4338
4339	// Mixed interfaces are allowed by the standard.
4340	// If there is a derived type with the same name, they must all be functions.
4341	void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
4342	ResolveSpecificsInGeneric(generic, true);
4343	auto &details{generic.get<GenericDetails>()};
4344	if (auto *proc{details.CheckSpecific()}) {
4345	context().Warn(common::UsageWarning::HomonymousSpecific,
4346	proc->name().begin() > generic.name().begin() ? proc->name()
4347	: generic.name(),
4348	"'%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,
4349	generic.name());
4350	}
4351	auto &specifics{details.specificProcs()};
4352	if (specifics.empty()) {
4353	if (details.derivedType()) {
4354	generic.set(Symbol::Flag::Function);
4355	}
4356	return;
4357	}
4358	const Symbol *function{nullptr};
4359	const Symbol *subroutine{nullptr};
4360	for (const Symbol &specific : specifics) {
4361	if (!function && specific.test(Symbol::Flag::Function)) {
4362	function = &specific;
4363	} else if (!subroutine && specific.test(Symbol::Flag::Subroutine)) {
4364	subroutine = &specific;
4365	if (details.derivedType() &&
4366	context().ShouldWarn(
4367	common::LanguageFeature::SubroutineAndFunctionSpecifics) &&
4368	!InModuleFile()) {
4369	SayDerivedType(generic.name(),
4370	"Generic interface '%s' should only contain functions due to derived type with same name"_warn_en_US,
4371	*details.derivedType()->GetUltimate().scope())
4372	.set_languageFeature(
4373	common::LanguageFeature::SubroutineAndFunctionSpecifics);
4374	}
4375	}
4376	if (function && subroutine) { // F'2023 C1514
4377	if (auto *msg{context().Warn(
4378	common::LanguageFeature::SubroutineAndFunctionSpecifics,
4379	generic.name(),
4380	"Generic interface '%s' has both a function and a subroutine"_warn_en_US,
4381	generic.name())}) {
4382	msg->Attach(function->name(), "Function declaration"_en_US)
4383	.Attach(subroutine->name(), "Subroutine declaration"_en_US);
4384	}
4385	break;
4386	}
4387	}
4388	if (function && !subroutine) {
4389	generic.set(Symbol::Flag::Function);
4390	} else if (subroutine && !function) {
4391	generic.set(Symbol::Flag::Subroutine);
4392	}
4393	}
4394
4395	// SubprogramVisitor implementation
4396
4397	// Return false if it is actually an assignment statement.
4398	bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
4399	const auto &name{std::get<parser::Name>(x.t)};
4400	const DeclTypeSpec *resultType{nullptr};
4401	// Look up name: provides return type or tells us if it's an array
4402	if (auto *symbol{FindSymbol(name)}) {
4403	Symbol &ultimate{symbol->GetUltimate()};
4404	if (ultimate.has<ObjectEntityDetails>() ||
4405	ultimate.has<AssocEntityDetails>() ||
4406	CouldBeDataPointerValuedFunction(&ultimate) ||
4407	(&symbol->owner() == &currScope() && IsFunctionResult(*symbol))) {
4408	misparsedStmtFuncFound_ = true;
4409	return false;
4410	}
4411	if (IsHostAssociated(*symbol, currScope())) {
4412	context().Warn(common::LanguageFeature::StatementFunctionExtensions,
4413	name.source,
4414	"Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US,
4415	name.source);
4416	MakeSymbol(name, Attrs{}, UnknownDetails{});
4417	} else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
4418	entity && !ultimate.has<ProcEntityDetails>()) {
4419	resultType = entity->type();
4420	ultimate.details() = UnknownDetails{}; // will be replaced below
4421	} else {
4422	misparsedStmtFuncFound_ = true;
4423	}
4424	}
4425	if (misparsedStmtFuncFound_) {
4426	Say(name,
4427	"'%s' has not been declared as an array or pointer-valued function"_err_en_US);
4428	return false;
4429	}
4430	auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
4431	symbol.set(Symbol::Flag::StmtFunction);
4432	EraseSymbol(symbol); // removes symbol added by PushSubprogramScope
4433	auto &details{symbol.get<SubprogramDetails>()};
4434	for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) {
4435	ObjectEntityDetails dummyDetails{true};
4436	if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) {
4437	if (auto *d{dummySymbol->GetType()}) {
4438	dummyDetails.set_type(*d);
4439	}
4440	}
4441	Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))};
4442	ApplyImplicitRules(dummy);
4443	details.add_dummyArg(dummy);
4444	}
4445	ObjectEntityDetails resultDetails;
4446	if (resultType) {
4447	resultDetails.set_type(*resultType);
4448	}
4449	resultDetails.set_funcResult(true);
4450	Symbol &result{MakeSymbol(name, std::move(resultDetails))};
4451	result.flags().set(Symbol::Flag::StmtFunction);
4452	ApplyImplicitRules(result);
4453	details.set_result(result);
4454	// The analysis of the expression that constitutes the body of the
4455	// statement function is deferred to FinishSpecificationPart() so that
4456	// all declarations and implicit typing are complete.
4457	PopScope();
4458	return true;
4459	}
4460
4461	bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
4462	if (suffix.resultName) {
4463	if (IsFunction(currScope())) {
4464	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
4465	if (info->inFunctionStmt) {
4466	info->resultName = &suffix.resultName.value();
4467	} else {
4468	// will check the result name in Post(EntryStmt)
4469	}
4470	}
4471	} else {
4472	Message &msg{Say(*suffix.resultName,
4473	"RESULT(%s) may appear only in a function"_err_en_US)};
4474	if (const Symbol * subprogram{InclusiveScope().symbol()}) {
4475	msg.Attach(subprogram->name(), "Containing subprogram"_en_US);
4476	}
4477	}
4478	}
4479	// LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt,
4480	// all the way to EndSubprogram().
4481	return false;
4482	}
4483
4484	bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
4485	// Save this to process after UseStmt and ImplicitPart
4486	if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
4487	if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
4488	if (info->parsedType) { // C1543
4489	Say(currStmtSource().value_or(info->source),
4490	"FUNCTION prefix cannot specify the type more than once"_err_en_US);
4491	} else {
4492	info->parsedType = parsedType;
4493	if (auto at{currStmtSource()}) {
4494	info->source = *at;
4495	}
4496	}
4497	} else {
4498	Say(currStmtSource().value(),
4499	"SUBROUTINE prefix cannot specify a type"_err_en_US);
4500	}
4501	return false;
4502	} else {
4503	return true;
4504	}
4505	}
4506
4507	bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
4508	if (auto *subp{currScope().symbol()
4509	? currScope().symbol()->detailsIf<SubprogramDetails>()
4510	: nullptr}) {
4511	for (auto attr : attrs.v) {
4512	if (auto current{subp->cudaSubprogramAttrs()}) {
4513	if (attr == *current ||
4514	(*current == common::CUDASubprogramAttrs::HostDevice &&
4515	(attr == common::CUDASubprogramAttrs::Host ||
4516	attr == common::CUDASubprogramAttrs::Device))) {
4517	context().Warn(common::LanguageFeature::RedundantAttribute,
4518	currStmtSource().value(),
4519	"ATTRIBUTES(%s) appears more than once"_warn_en_US,
4520	common::EnumToString(attr));
4521	} else if ((attr == common::CUDASubprogramAttrs::Host ||
4522	attr == common::CUDASubprogramAttrs::Device) &&
4523	(*current == common::CUDASubprogramAttrs::Host ||
4524	*current == common::CUDASubprogramAttrs::Device ||
4525	*current == common::CUDASubprogramAttrs::HostDevice)) {
4526	// HOST,DEVICE or DEVICE,HOST -> HostDevice
4527	subp->set_cudaSubprogramAttrs(
4528	common::CUDASubprogramAttrs::HostDevice);
4529	} else {
4530	Say(currStmtSource().value(),
4531	"ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,
4532	common::EnumToString(attr), common::EnumToString(*current));
4533	}
4534	} else {
4535	subp->set_cudaSubprogramAttrs(attr);
4536	}
4537	}
4538	if (auto attrs{subp->cudaSubprogramAttrs()}) {
4539	if (*attrs == common::CUDASubprogramAttrs::Global ||
4540	*attrs == common::CUDASubprogramAttrs::Grid_Global ||
4541	*attrs == common::CUDASubprogramAttrs::Device ||
4542	*attrs == common::CUDASubprogramAttrs::HostDevice) {
4543	const Scope &scope{currScope()};
4544	const Scope *mod{FindModuleContaining(scope)};
4545	if (mod &&
4546	(mod->GetName().value() == "cudadevice" ||
4547	mod->GetName().value() == "__cuda_device")) {
4548	return false;
4549	}
4550	// Implicitly USE the cudadevice module by copying its symbols in the
4551	// current scope.
4552	const Scope &cudaDeviceScope{context().GetCUDADeviceScope()};
4553	for (auto sym : cudaDeviceScope.GetSymbols()) {
4554	if (!currScope().FindSymbol(sym->name())) {
4555	auto &localSymbol{MakeSymbol(
4556	sym->name(), Attrs{}, UseDetails{sym->name(), *sym})};
4557	localSymbol.flags() = sym->flags();
4558	}
4559	}
4560	}
4561	}
4562	}
4563	return false;
4564	}
4565
4566	void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {
4567	std::vector<std::int64_t> bounds;
4568	bool ok{true};
4569	for (const auto &sicx : x.v) {
4570	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
4571	bounds.push_back(*value);
4572	} else {
4573	ok = false;
4574	}
4575	}
4576	if (!ok || bounds.size() < 2 || bounds.size() > 3) {
4577	Say(currStmtSource().value(),
4578	"Operands of LAUNCH_BOUNDS() must be 2 or 3 integer constants"_err_en_US);
4579	} else if (auto *subp{currScope().symbol()
4580	? currScope().symbol()->detailsIf<SubprogramDetails>()
4581	: nullptr}) {
4582	if (subp->cudaLaunchBounds().empty()) {
4583	subp->set_cudaLaunchBounds(std::move(bounds));
4584	} else {
4585	Say(currStmtSource().value(),
4586	"LAUNCH_BOUNDS() may only appear once"_err_en_US);
4587	}
4588	}
4589	}
4590
4591	void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
4592	std::vector<std::int64_t> dims;
4593	bool ok{true};
4594	for (const auto &sicx : x.v) {
4595	if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
4596	dims.push_back(*value);
4597	} else {
4598	ok = false;
4599	}
4600	}
4601	if (!ok || dims.size() != 3) {
4602	Say(currStmtSource().value(),
4603	"Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);
4604	} else if (auto *subp{currScope().symbol()
4605	? currScope().symbol()->detailsIf<SubprogramDetails>()
4606	: nullptr}) {
4607	if (subp->cudaClusterDims().empty()) {
4608	subp->set_cudaClusterDims(std::move(dims));
4609	} else {
4610	Say(currStmtSource().value(),
4611	"CLUSTER_DIMS() may only appear once"_err_en_US);
4612	}
4613	}
4614	}
4615
4616	static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {
4617	for (const auto &prefix : prefixes) {
4618	if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
4619	return true;
4620	}
4621	}
4622	return false;
4623	}
4624
4625	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
4626	const auto &stmtTuple{
4627	std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};
4628	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
4629	Symbol::Flag::Subroutine,
4630	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
4631	}
4632	void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
4633	const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
4634	EndSubprogram(stmt.source,
4635	&std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t));
4636	}
4637	bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
4638	const auto &stmtTuple{
4639	std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};
4640	return BeginSubprogram(std::get<parser::Name>(stmtTuple),
4641	Symbol::Flag::Function,
4642	HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
4643	}
4644	void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
4645	const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
4646	const auto &maybeSuffix{
4647	std::get<std::optional<parser::Suffix>>(stmt.statement.t)};
4648	EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr);
4649	}
4650
4651	bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
4652	BeginAttrs();
4653	Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t));
4654	Walk(std::get<parser::Name>(stmt.t));
4655	Walk(std::get<std::list<parser::DummyArg>>(stmt.t));
4656	// Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram.
4657	Symbol &symbol{PostSubprogramStmt()};
4658	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
4659	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4660	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4661	CreateDummyArgument(details, *dummyName);
4662	} else {
4663	details.add_alternateReturn();
4664	}
4665	}
4666	return false;
4667	}
4668	bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
4669	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
4670	CHECK(!info.inFunctionStmt);
4671	info.inFunctionStmt = true;
4672	if (auto at{currStmtSource()}) {
4673	info.source = *at;
4674	}
4675	return BeginAttrs();
4676	}
4677	bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
4678
4679	void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
4680	const auto &name{std::get<parser::Name>(stmt.t)};
4681	Symbol &symbol{PostSubprogramStmt()};
4682	SubprogramDetails &details{symbol.get<SubprogramDetails>()};
4683	for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
4684	CreateDummyArgument(details, dummyName);
4685	}
4686	const parser::Name *funcResultName;
4687	FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
4688	CHECK(info.inFunctionStmt);
4689	info.inFunctionStmt = false;
4690	bool distinctResultName{
4691	info.resultName && info.resultName->source != name.source};
4692	if (distinctResultName) {
4693	// Note that RESULT is ignored if it has the same name as the function.
4694	// The symbol created by PushScope() is retained as a place-holder
4695	// for error detection.
4696	funcResultName = info.resultName;
4697	} else {
4698	EraseSymbol(name); // was added by PushScope()
4699	funcResultName = &name;
4700	}
4701	if (details.isFunction()) {
4702	CHECK(context().HasError(currScope().symbol()));
4703	} else {
4704	// RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY
4705	// statement.
4706	Symbol *result{nullptr};
4707	if (distinctResultName) {
4708	if (auto iter{currScope().find(funcResultName->source)};
4709	iter != currScope().end()) {
4710	Symbol &entryResult{*iter->second};
4711	if (IsFunctionResult(entryResult)) {
4712	result = &entryResult;
4713	}
4714	}
4715	}
4716	if (result) {
4717	Resolve(*funcResultName, *result);
4718	} else {
4719	// add function result to function scope
4720	EntityDetails funcResultDetails;
4721	funcResultDetails.set_funcResult(true);
4722	result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
4723	}
4724	info.resultSymbol = result;
4725	details.set_result(*result);
4726	}
4727	// C1560.
4728	if (info.resultName && !distinctResultName) {
4729	context().Warn(common::UsageWarning::HomonymousResult,
4730	info.resultName->source,
4731	"The function name should not appear in RESULT; references to '%s' "
4732	"inside the function will be considered as references to the "
4733	"result only"_warn_en_US,
4734	name.source);
4735	// RESULT name was ignored above, the only side effect from doing so will be
4736	// the inability to make recursive calls. The related parser::Name is still
4737	// resolved to the created function result symbol because every parser::Name
4738	// should be resolved to avoid internal errors.
4739	Resolve(*info.resultName, info.resultSymbol);
4740	}
4741	name.symbol = &symbol; // must not be function result symbol
4742	// Clear the RESULT() name now in case an ENTRY statement in the implicit-part
4743	// has a RESULT() suffix.
4744	info.resultName = nullptr;
4745	}
4746
4747	Symbol &SubprogramVisitor::PostSubprogramStmt() {
4748	Symbol &symbol{*currScope().symbol()};
4749	SetExplicitAttrs(symbol, EndAttrs());
4750	if (symbol.attrs().test(Attr::MODULE)) {
4751	symbol.attrs().set(Attr::EXTERNAL, false);
4752	symbol.implicitAttrs().set(Attr::EXTERNAL, false);
4753	}
4754	return symbol;
4755	}
4756
4757	void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
4758	if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) {
4759	Walk(suffix->binding);
4760	}
4761	PostEntryStmt(stmt);
4762	EndAttrs();
4763	}
4764
4765	void SubprogramVisitor::CreateDummyArgument(
4766	SubprogramDetails &details, const parser::Name &name) {
4767	Symbol *dummy{FindInScope(name)};
4768	if (dummy) {
4769	if (IsDummy(*dummy)) {
4770	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
4771	dummy->set(Symbol::Flag::EntryDummyArgument, false);
4772	} else {
4773	Say(name,
4774	"'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US,
4775	name.source);
4776	return;
4777	}
4778	} else {
4779	SayWithDecl(name, *dummy,
4780	"'%s' may not appear as a dummy argument name in this subprogram"_err_en_US);
4781	return;
4782	}
4783	} else {
4784	dummy = &MakeSymbol(name, EntityDetails{true});
4785	}
4786	details.add_dummyArg(DEREF(dummy));
4787	}
4788
4789	void SubprogramVisitor::CreateEntry(
4790	const parser::EntryStmt &stmt, Symbol &subprogram) {
4791	const auto &entryName{std::get<parser::Name>(stmt.t)};
4792	Scope &outer{currScope().parent()};
4793	Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)
4794	? Symbol::Flag::Function
4795	: Symbol::Flag::Subroutine};
4796	Attrs attrs;
4797	const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
4798	bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding &&
4799	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
4800	suffix->binding->t)
4801	.has_value()};
4802	if (!hasGlobalBindingName) {
4803	if (Symbol * extant{FindSymbol(outer, entryName)}) {
4804	if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
4805	if (outer.IsTopLevel()) {
4806	Say2(entryName,
4807	"'%s' is already defined as a global identifier"_err_en_US,
4808	*extant, "Previous definition of '%s'"_en_US);
4809	} else {
4810	SayAlreadyDeclared(entryName, *extant);
4811	}
4812	return;
4813	}
4814	attrs = extant->attrs();
4815	}
4816	}
4817	std::optional<SourceName> distinctResultName;
4818	if (suffix && suffix->resultName &&
4819	suffix->resultName->source != entryName.source) {
4820	distinctResultName = suffix->resultName->source;
4821	}
4822	if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
4823	attrs.set(Attr::PUBLIC);
4824	}
4825	Symbol *entrySymbol{nullptr};
4826	if (hasGlobalBindingName) {
4827	// Hide the entry's symbol in a new anonymous global scope so
4828	// that its name doesn't clash with anything.
4829	Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})};
4830	symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
4831	Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)};
4832	entrySymbol = &MakeSymbol(hidden, entryName.source, attrs);
4833	} else {
4834	entrySymbol = FindInScope(outer, entryName.source);
4835	if (entrySymbol) {
4836	if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {
4837	if (auto *specific{generic->specific()}) {
4838	// Forward reference to ENTRY from a generic interface
4839	entrySymbol = specific;
4840	CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs);
4841	SetExplicitAttrs(*entrySymbol, attrs);
4842	}
4843	}
4844	} else {
4845	entrySymbol = &MakeSymbol(outer, entryName.source, attrs);
4846	}
4847	}
4848	SubprogramDetails entryDetails;
4849	entryDetails.set_entryScope(currScope());
4850	entrySymbol->set(subpFlag);
4851	if (subpFlag == Symbol::Flag::Function) {
4852	Symbol *result{nullptr};
4853	EntityDetails resultDetails;
4854	resultDetails.set_funcResult(true);
4855	if (distinctResultName) {
4856	// An explicit RESULT() can also be an explicit RESULT()
4857	// of the function or another ENTRY.
4858	if (auto iter{currScope().find(suffix->resultName->source)};
4859	iter != currScope().end()) {
4860	result = &*iter->second;
4861	}
4862	if (!result) {
4863	result =
4864	&MakeSymbol(*distinctResultName, Attrs{}, std::move(resultDetails));
4865	} else if (!result->has<EntityDetails>()) {
4866	Say(*distinctResultName,
4867	"ENTRY cannot have RESULT(%s) that is not a variable"_err_en_US,
4868	*distinctResultName)
4869	.Attach(result->name(), "Existing declaration of '%s'"_en_US,
4870	result->name());
4871	result = nullptr;
4872	}
4873	if (result) {
4874	Resolve(*suffix->resultName, *result);
4875	}
4876	} else {
4877	result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));
4878	}
4879	if (result) {
4880	entryDetails.set_result(*result);
4881	}
4882	}
4883	if (subpFlag == Symbol::Flag::Subroutine || distinctResultName) {
4884	Symbol &assoc{MakeSymbol(entryName.source)};
4885	assoc.set_details(HostAssocDetails{*entrySymbol});
4886	assoc.set(Symbol::Flag::Subroutine);
4887	}
4888	Resolve(entryName, *entrySymbol);
4889	std::set<SourceName> dummies;
4890	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4891	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4892	auto pair{dummies.insert(dummyName->source)};
4893	if (!pair.second) {
4894	Say(*dummyName,
4895	"'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US,
4896	dummyName->source);
4897	continue;
4898	}
4899	Symbol *dummy{FindInScope(*dummyName)};
4900	if (dummy) {
4901	if (!IsDummy(*dummy)) {
4902	evaluate::AttachDeclaration(
4903	Say(*dummyName,
4904	"'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US,
4905	dummyName->source),
4906	*dummy);
4907	continue;
4908	}
4909	} else {
4910	dummy = &MakeSymbol(*dummyName, EntityDetails{true});
4911	dummy->set(Symbol::Flag::EntryDummyArgument);
4912	}
4913	entryDetails.add_dummyArg(DEREF(dummy));
4914	} else if (subpFlag == Symbol::Flag::Function) { // C1573
4915	Say(entryName,
4916	"ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
4917	break;
4918	} else {
4919	entryDetails.add_alternateReturn();
4920	}
4921	}
4922	entrySymbol->set_details(std::move(entryDetails));
4923	}
4924
4925	void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
4926	// The entry symbol should have already been created and resolved
4927	// in CreateEntry(), called by BeginSubprogram(), with one exception (below).
4928	const auto &name{std::get<parser::Name>(stmt.t)};
4929	Scope &inclusiveScope{InclusiveScope()};
4930	if (!name.symbol) {
4931	if (inclusiveScope.kind() != Scope::Kind::Subprogram) {
4932	Say(name.source,
4933	"ENTRY '%s' may appear only in a subroutine or function"_err_en_US,
4934	name.source);
4935	} else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {
4936	Say(name.source,
4937	"ENTRY '%s' may not appear in a separate module procedure"_err_en_US,
4938	name.source);
4939	} else {
4940	// C1571 - entry is nested, so was not put into the program tree; error
4941	// is emitted from MiscChecker in semantics.cpp.
4942	}
4943	return;
4944	}
4945	Symbol &entrySymbol{*name.symbol};
4946	if (context().HasError(entrySymbol)) {
4947	return;
4948	}
4949	if (!entrySymbol.has<SubprogramDetails>()) {
4950	SayAlreadyDeclared(name, entrySymbol);
4951	return;
4952	}
4953	SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
4954	CHECK(entryDetails.entryScope() == &inclusiveScope);
4955	SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());
4956	entrySymbol.attrs() |= GetAttrs();
4957	SetBindNameOn(entrySymbol);
4958	for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
4959	if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
4960	if (Symbol * dummy{FindInScope(*dummyName)}) {
4961	if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
4962	const auto *subp{dummy->detailsIf<SubprogramDetails>()};
4963	if (subp && subp->isInterface()) { // ok
4964	} else if (!dummy->has<EntityDetails>() &&
4965	!dummy->has<ObjectEntityDetails>() &&
4966	!dummy->has<ProcEntityDetails>()) {
4967	SayWithDecl(*dummyName, *dummy,
4968	"ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US);
4969	}
4970	dummy->set(Symbol::Flag::EntryDummyArgument, false);
4971	}
4972	}
4973	}
4974	}
4975	}
4976
4977	Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
4978	const parser::Name &name) {
4979	auto *symbol{FindSymbol(name)};
4980	if (symbol && symbol->has<SubprogramNameDetails>()) {
4981	const Scope *parent{nullptr};
4982	if (currScope().IsSubmodule()) {
4983	parent = currScope().symbol()->get<ModuleDetails>().parent();
4984	}
4985	symbol = parent ? FindSymbol(scope: *parent, name) : nullptr;
4986	}
4987	if (symbol) {
4988	if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
4989	symbol = generic->specific();
4990	}
4991	}
4992	if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
4993	// Error recovery in case of multiple definitions
4994	symbol = const_cast<Symbol *>(defnIface);
4995	}
4996	if (!IsSeparateModuleProcedureInterface(symbol)) {
4997	Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
4998	symbol = nullptr;
4999	}
5000	return symbol;
5001	}
5002
5003	// A subprogram declared with MODULE PROCEDURE
5004	bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
5005	Symbol *symbol{FindSeparateModuleProcedureInterface(name)};
5006	if (!symbol) {
5007	return false;
5008	}
5009	if (symbol->owner() == currScope() && symbol->scope()) {
5010	// This is a MODULE PROCEDURE whose interface appears in its host.
5011	// Convert the module procedure's interface into a subprogram.
5012	SetScope(DEREF(symbol->scope()));
5013	symbol->get<SubprogramDetails>().set_isInterface(false);
5014	name.symbol = symbol;
5015	} else {
5016	// Copy the interface into a new subprogram scope.
5017	EraseSymbol(name);
5018	Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
5019	PushScope(Scope::Kind::Subprogram, &newSymbol);
5020	auto &newSubprogram{newSymbol.get<SubprogramDetails>()};
5021	newSubprogram.set_moduleInterface(*symbol);
5022	auto &subprogram{symbol->get<SubprogramDetails>()};
5023	if (const auto *name{subprogram.bindName()}) {
5024	newSubprogram.set_bindName(std::string{*name});
5025	}
5026	newSymbol.attrs() |= symbol->attrs();
5027	newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
5028	? Symbol::Flag::Subroutine
5029	: Symbol::Flag::Function);
5030	MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());
5031	}
5032	return true;
5033	}
5034
5035	// A subprogram or interface declared with SUBROUTINE or FUNCTION
5036	bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
5037	Symbol::Flag subpFlag, bool hasModulePrefix,
5038	const parser::LanguageBindingSpec *bindingSpec,
5039	const ProgramTree::EntryStmtList *entryStmts) {
5040	bool isValid{true};
5041	if (hasModulePrefix && !currScope().IsModule() &&
5042	!currScope().IsSubmodule()) { // C1547
5043	Say(name,
5044	"'%s' is a MODULE procedure which must be declared within a "
5045	"MODULE or SUBMODULE"_err_en_US);
5046	// Don't return here because it can be useful to have the scope set for
5047	// other semantic checks run before we print the errors
5048	isValid = false;
5049	}
5050	Symbol *moduleInterface{nullptr};
5051	if (isValid && hasModulePrefix && !inInterfaceBlock()) {
5052	moduleInterface = FindSeparateModuleProcedureInterface(name);
5053	if (moduleInterface && &moduleInterface->owner() == &currScope()) {
5054	// Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
5055	// previously defined in the same scope.
5056	if (GenericDetails *
5057	generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {
5058	generic->clear_specific();
5059	name.symbol = nullptr;
5060	} else {
5061	EraseSymbol(name);
5062	}
5063	}
5064	}
5065	Symbol &newSymbol{
5066	PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};
5067	if (moduleInterface) {
5068	newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
5069	if (moduleInterface->attrs().test(Attr::PRIVATE)) {
5070	SetImplicitAttr(newSymbol, Attr::PRIVATE);
5071	} else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
5072	SetImplicitAttr(newSymbol, Attr::PUBLIC);
5073	}
5074	}
5075	if (entryStmts) {
5076	for (const auto &ref : *entryStmts) {
5077	CreateEntry(*ref, newSymbol);
5078	}
5079	}
5080	return true;
5081	}
5082
5083	void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol,
5084	std::optional<parser::CharBlock> stmtSource,
5085	const std::optional<parser::LanguageBindingSpec> *binding) {
5086	if (binding && *binding && symbol) {
5087	// Finally process the BIND(C,NAME=name) now that symbols in the name
5088	// expression will resolve to local names if needed.
5089	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
5090	auto originalStmtSource{messageHandler().currStmtSource()};
5091	messageHandler().set_currStmtSource(stmtSource);
5092	BeginAttrs();
5093	Walk(**binding);
5094	SetBindNameOn(*symbol);
5095	symbol->attrs() |= EndAttrs();
5096	messageHandler().set_currStmtSource(originalStmtSource);
5097	}
5098	}
5099
5100	void SubprogramVisitor::EndSubprogram(
5101	std::optional<parser::CharBlock> stmtSource,
5102	const std::optional<parser::LanguageBindingSpec> *binding,
5103	const ProgramTree::EntryStmtList *entryStmts) {
5104	HandleLanguageBinding(currScope().symbol(), stmtSource, binding);
5105	if (entryStmts) {
5106	for (const auto &ref : *entryStmts) {
5107	const parser::EntryStmt &entryStmt{*ref};
5108	if (const auto &suffix{
5109	std::get<std::optional<parser::Suffix>>(entryStmt.t)}) {
5110	const auto &name{std::get<parser::Name>(entryStmt.t)};
5111	HandleLanguageBinding(name.symbol, name.source, &suffix->binding);
5112	}
5113	}
5114	}
5115	if (inInterfaceBlock() && currScope().symbol()) {
5116	DeclaredPossibleSpecificProc(proc&: *currScope().symbol());
5117	}
5118	PopScope();
5119	}
5120
5121	bool SubprogramVisitor::HandlePreviousCalls(
5122	const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
5123	// If the extant symbol is a generic, check its homonymous specific
5124	// procedure instead if it has one.
5125	if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
5126	return generic->specific() &&
5127	HandlePreviousCalls(name, *generic->specific(), subpFlag);
5128	} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
5129	!proc->isDummy() &&
5130	!symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
5131	// There's a symbol created for previous calls to this subprogram or
5132	// ENTRY's name. We have to replace that symbol in situ to avoid the
5133	// obligation to rewrite symbol pointers in the parse tree.
5134	if (!symbol.test(subpFlag)) {
5135	auto other{subpFlag == Symbol::Flag::Subroutine
5136	? Symbol::Flag::Function
5137	: Symbol::Flag::Subroutine};
5138	// External statements issue an explicit EXTERNAL attribute.
5139	if (symbol.attrs().test(Attr::EXTERNAL) &&
5140	!symbol.implicitAttrs().test(Attr::EXTERNAL)) {
5141	// Warn if external statement previously declared.
5142	context().Warn(common::LanguageFeature::RedundantAttribute, name.source,
5143	"EXTERNAL attribute was already specified on '%s'"_warn_en_US,
5144	name.source);
5145	} else if (symbol.test(other)) {
5146	Say2(name,
5147	subpFlag == Symbol::Flag::Function
5148	? "'%s' was previously called as a subroutine"_err_en_US
5149	: "'%s' was previously called as a function"_err_en_US,
5150	symbol, "Previous call of '%s'"_en_US);
5151	} else {
5152	symbol.set(subpFlag);
5153	}
5154	}
5155	EntityDetails entity;
5156	if (proc->type()) {
5157	entity.set_type(*proc->type());
5158	}
5159	symbol.details() = std::move(entity);
5160	return true;
5161	} else {
5162	return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();
5163	}
5164	}
5165
5166	void SubprogramVisitor::CheckExtantProc(
5167	const parser::Name &name, Symbol::Flag subpFlag) {
5168	if (auto *prev{FindSymbol(name)}) {
5169	if (IsDummy(*prev)) {
5170	} else if (auto *entity{prev->detailsIf<EntityDetails>()};
5171	IsPointer(*prev) && entity && !entity->type()) {
5172	// POINTER attribute set before interface
5173	} else if (inInterfaceBlock() && currScope() != prev->owner()) {
5174	// Procedures in an INTERFACE block do not resolve to symbols
5175	// in scopes between the global scope and the current scope.
5176	} else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
5177	SayAlreadyDeclared(name, *prev);
5178	}
5179	}
5180	}
5181
5182	Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
5183	Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
5184	bool hasModulePrefix) {
5185	Symbol *symbol{GetSpecificFromGeneric(name)};
5186	if (!symbol) {
5187	if (bindingSpec && currScope().IsGlobal() &&
5188	std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
5189	bindingSpec->t)
5190	.has_value()) {
5191	// Create this new top-level subprogram with a binding label
5192	// in a new global scope, so that its symbol's name won't clash
5193	// with another symbol that has a distinct binding label.
5194	PushScope(Scope::Kind::Global,
5195	&MakeSymbol(context().GetTempName(currScope()), Attrs{},
5196	MiscDetails{MiscDetails::Kind::ScopeName}));
5197	}
5198	CheckExtantProc(name, subpFlag);
5199	symbol = &MakeSymbol(name, SubprogramDetails{});
5200	}
5201	symbol->ReplaceName(name.source);
5202	symbol->set(subpFlag);
5203	PushScope(Scope::Kind::Subprogram, symbol);
5204	if (subpFlag == Symbol::Flag::Function) {
5205	funcResultStack().Push(currScope(), name.source);
5206	}
5207	if (inInterfaceBlock()) {
5208	auto &details{symbol->get<SubprogramDetails>()};
5209	details.set_isInterface();
5210	if (isAbstract()) {
5211	SetExplicitAttr(*symbol, Attr::ABSTRACT);
5212	} else if (hasModulePrefix) {
5213	SetExplicitAttr(*symbol, Attr::MODULE);
5214	} else {
5215	MakeExternal(*symbol);
5216	}
5217	if (isGeneric()) {
5218	Symbol &genericSymbol{GetGenericSymbol()};
5219	if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {
5220	details->AddSpecificProc(*symbol, name.source);
5221	} else {
5222	CHECK(context().HasError(genericSymbol));
5223	}
5224	}
5225	set_inheritFromParent(false); // interfaces don't inherit, even if MODULE
5226	}
5227	if (Symbol * found{FindSymbol(name)};
5228	found && found->has<HostAssocDetails>()) {
5229	found->set(subpFlag); // PushScope() created symbol
5230	}
5231	return *symbol;
5232	}
5233
5234	void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
5235	if (auto *prev{FindSymbol(name)}) {
5236	if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
5237	if (prev->test(Symbol::Flag::Subroutine) ||
5238	prev->test(Symbol::Flag::Function)) {
5239	Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev,
5240	"Previous call of '%s'"_en_US);
5241	}
5242	EraseSymbol(name);
5243	}
5244	}
5245	if (name.source.empty()) {
5246	// Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM
5247	PushScope(Scope::Kind::BlockData, nullptr);
5248	} else {
5249	PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
5250	}
5251	}
5252
5253	// If name is a generic, return specific subprogram with the same name.
5254	Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
5255	// Search for the name but don't resolve it
5256	if (auto *symbol{currScope().FindSymbol(name.source)}) {
5257	if (symbol->has<SubprogramNameDetails>()) {
5258	if (inInterfaceBlock()) {
5259	// Subtle: clear any MODULE flag so that the new interface
5260	// symbol doesn't inherit it and ruin the ability to check it.
5261	symbol->attrs().reset(Attr::MODULE);
5262	}
5263	} else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
5264	// found generic, want specific procedure
5265	auto *specific{details->specific()};
5266	Attrs moduleAttr;
5267	if (inInterfaceBlock()) {
5268	if (specific) {
5269	// Defining an interface in a generic of the same name which is
5270	// already shadowing another procedure. In some cases, the shadowed
5271	// procedure is about to be replaced.
5272	if (specific->has<SubprogramNameDetails>() &&
5273	specific->attrs().test(Attr::MODULE)) {
5274	// The shadowed procedure is a separate module procedure that is
5275	// actually defined later in this (sub)module.
5276	// Define its interface now as a new symbol.
5277	moduleAttr.set(Attr::MODULE);
5278	specific = nullptr;
5279	} else if (&specific->owner() != &symbol->owner()) {
5280	// The shadowed procedure was from an enclosing scope and will be
5281	// overridden by this interface definition.
5282	specific = nullptr;
5283	}
5284	if (!specific) {
5285	details->clear_specific();
5286	}
5287	} else if (const auto *dType{details->derivedType()}) {
5288	if (&dType->owner() != &symbol->owner()) {
5289	// The shadowed derived type was from an enclosing scope and
5290	// will be overridden by this interface definition.
5291	details->clear_derivedType();
5292	}
5293	}
5294	}
5295	if (!specific) {
5296	specific = &currScope().MakeSymbol(
5297	name.source, std::move(moduleAttr), SubprogramDetails{});
5298	if (details->derivedType()) {
5299	// A specific procedure with the same name as a derived type
5300	SayAlreadyDeclared(name, *details->derivedType());
5301	} else {
5302	details->set_specific(Resolve(name, *specific));
5303	}
5304	} else if (isGeneric()) {
5305	SayAlreadyDeclared(name, *specific);
5306	}
5307	if (specific->has<SubprogramNameDetails>()) {
5308	specific->set_details(Details{SubprogramDetails{}});
5309	}
5310	return specific;
5311	}
5312	}
5313	return nullptr;
5314	}
5315
5316	// DeclarationVisitor implementation
5317
5318	bool DeclarationVisitor::BeginDecl() {
5319	BeginDeclTypeSpec();
5320	BeginArraySpec();
5321	return BeginAttrs();
5322	}
5323	void DeclarationVisitor::EndDecl() {
5324	EndDeclTypeSpec();
5325	EndArraySpec();
5326	EndAttrs();
5327	}
5328
5329	bool DeclarationVisitor::CheckUseError(const parser::Name &name) {
5330	return HadUseError(context(), name.source, name.symbol);
5331	}
5332
5333	// Report error if accessibility of symbol doesn't match isPrivate.
5334	void DeclarationVisitor::CheckAccessibility(
5335	const SourceName &name, bool isPrivate, Symbol &symbol) {
5336	if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
5337	Say2(name,
5338	"'%s' does not have the same accessibility as its previous declaration"_err_en_US,
5339	symbol, "Previous declaration of '%s'"_en_US);
5340	}
5341	}
5342
5343	bool DeclarationVisitor::Pre(const parser::TypeDeclarationStmt &x) {
5344	BeginDecl();
5345	// If INTRINSIC appears as an attr-spec, handle it now as if the
5346	// names had appeared on an INTRINSIC attribute statement beforehand.
5347	for (const auto &attr : std::get<std::list<parser::AttrSpec>>(x.t)) {
5348	if (std::holds_alternative<parser::Intrinsic>(attr.u)) {
5349	for (const auto &decl : std::get<std::list<parser::EntityDecl>>(x.t)) {
5350	DeclareIntrinsic(parser::GetFirstName(decl));
5351	}
5352	break;
5353	}
5354	}
5355	return true;
5356	}
5357	void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
5358	EndDecl();
5359	}
5360
5361	void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
5362	DeclareObjectEntity(std::get<parser::Name>(x.t));
5363	}
5364	void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
5365	DeclareObjectEntity(std::get<parser::Name>(x.t));
5366	}
5367
5368	bool DeclarationVisitor::Pre(const parser::Initialization &) {
5369	// Defer inspection of initializers to Initialization() so that the
5370	// symbol being initialized will be available within the initialization
5371	// expression.
5372	return false;
5373	}
5374
5375	void DeclarationVisitor::Post(const parser::EntityDecl &x) {
5376	const auto &name{std::get<parser::ObjectName>(x.t)};
5377	Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
5378	attrs.set(Attr::INTRINSIC, false); // dealt with in Pre(TypeDeclarationStmt)
5379	Symbol &symbol{DeclareUnknownEntity(name, attrs)};
5380	symbol.ReplaceName(name.source);
5381	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
5382	if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
5383	ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
5384	symbol.set(
5385	Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
5386	Initialization(name, *init, /*inComponentDecl=*/false);
5387	} else if (attrs.test(Attr::PARAMETER)) { // C882, C883
5388	Say(name, "Missing initialization for parameter '%s'"_err_en_US);
5389	}
5390	if (auto *scopeSymbol{currScope().symbol()}) {
5391	if (auto *details{scopeSymbol->detailsIf<DerivedTypeDetails>()}) {
5392	if (details->isDECStructure()) {
5393	details->add_component(symbol);
5394	}
5395	}
5396	}
5397	}
5398
5399	void DeclarationVisitor::Post(const parser::PointerDecl &x) {
5400	const auto &name{std::get<parser::Name>(x.t)};
5401	if (const auto &deferredShapeSpecs{
5402	std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) {
5403	CHECK(arraySpec().empty());
5404	BeginArraySpec();
5405	set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs));
5406	Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})};
5407	symbol.ReplaceName(name.source);
5408	EndArraySpec();
5409	} else {
5410	if (const auto *symbol{FindInScope(name)}) {
5411	const auto *subp{symbol->detailsIf<SubprogramDetails>()};
5412	if (!symbol->has<UseDetails>() && // error caught elsewhere
5413	!symbol->has<ObjectEntityDetails>() &&
5414	!symbol->has<ProcEntityDetails>() &&
5415	!symbol->CanReplaceDetails(ObjectEntityDetails{}) &&
5416	!symbol->CanReplaceDetails(ProcEntityDetails{}) &&
5417	!(subp && subp->isInterface())) {
5418	Say(name, "'%s' cannot have the POINTER attribute"_err_en_US);
5419	}
5420	}
5421	HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t));
5422	}
5423	}
5424
5425	bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
5426	auto kind{std::get<parser::BindEntity::Kind>(x.t)};
5427	auto &name{std::get<parser::Name>(x.t)};
5428	Symbol *symbol;
5429	if (kind == parser::BindEntity::Kind::Object) {
5430	symbol = &HandleAttributeStmt(Attr::BIND_C, name);
5431	} else {
5432	symbol = &MakeCommonBlockSymbol(name);
5433	SetExplicitAttr(*symbol, Attr::BIND_C);
5434	}
5435	// 8.6.4(1)
5436	// Some entities such as named constant or module name need to checked
5437	// elsewhere. This is to skip the ICE caused by setting Bind name for non-name
5438	// things such as data type and also checks for procedures.
5439	if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() ||
5440	symbol->has<EntityDetails>()) {
5441	SetBindNameOn(*symbol);
5442	} else {
5443	Say(name,
5444	"Only variable and named common block can be in BIND statement"_err_en_US);
5445	}
5446	return false;
5447	}
5448	bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) {
5449	inOldStyleParameterStmt_ = true;
5450	Walk(x.v);
5451	inOldStyleParameterStmt_ = false;
5452	return false;
5453	}
5454	bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
5455	auto &name{std::get<parser::NamedConstant>(x.t).v};
5456	auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
5457	ConvertToObjectEntity(symbol&: symbol);
5458	auto *details{symbol.detailsIf<ObjectEntityDetails>()};
5459	if (!details || symbol.test(Symbol::Flag::CrayPointer) ||
5460	symbol.test(Symbol::Flag::CrayPointee)) {
5461	SayWithDecl(
5462	name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US);
5463	return false;
5464	}
5465	const auto &expr{std::get<parser::ConstantExpr>(x.t)};
5466	if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
5467	Say(name, "Named constant '%s' already has a value"_err_en_US);
5468	}
5469	if (inOldStyleParameterStmt_) {
5470	// non-standard extension PARAMETER statement (no parentheses)
5471	Walk(expr);
5472	auto folded{EvaluateExpr(expr)};
5473	if (details->type()) {
5474	SayWithDecl(name, symbol,
5475	"Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US);
5476	} else if (folded) {
5477	auto at{expr.thing.value().source};
5478	if (evaluate::IsActuallyConstant(*folded)) {
5479	if (const auto *type{currScope().GetType(*folded)}) {
5480	if (type->IsPolymorphic()) {
5481	Say(at, "The expression must not be polymorphic"_err_en_US);
5482	} else if (auto shape{ToArraySpec(
5483	GetFoldingContext(), evaluate::GetShape(*folded))}) {
5484	// The type of the named constant is assumed from the expression.
5485	details->set_type(*type);
5486	details->set_init(std::move(*folded));
5487	details->set_shape(std::move(*shape));
5488	} else {
5489	Say(at, "The expression must have constant shape"_err_en_US);
5490	}
5491	} else {
5492	Say(at, "The expression must have a known type"_err_en_US);
5493	}
5494	} else {
5495	Say(at, "The expression must be a constant of known type"_err_en_US);
5496	}
5497	}
5498	} else {
5499	// standard-conforming PARAMETER statement (with parentheses)
5500	ApplyImplicitRules(symbol&: symbol);
5501	Walk(expr);
5502	if (auto converted{EvaluateNonPointerInitializer(
5503	symbol, expr, expr.thing.value().source)}) {
5504	details->set_init(std::move(*converted));
5505	}
5506	}
5507	return false;
5508	}
5509	bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
5510	const parser::Name &name{x.v};
5511	if (!FindSymbol(name)) {
5512	Say(name, "Named constant '%s' not found"_err_en_US);
5513	} else {
5514	CheckUseError(name);
5515	}
5516	return false;
5517	}
5518
5519	bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
5520	const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
5521	Symbol *symbol{FindInScope(name)};
5522	if (symbol && !symbol->has<UnknownDetails>()) {
5523	// Contrary to named constants appearing in a PARAMETER statement,
5524	// enumerator names should not have their type, dimension or any other
5525	// attributes defined before they are declared in the enumerator statement,
5526	// with the exception of accessibility.
5527	// This is not explicitly forbidden by the standard, but they are scalars
5528	// which type is left for the compiler to chose, so do not let users try to
5529	// tamper with that.
5530	SayAlreadyDeclared(name, *symbol);
5531	symbol = nullptr;
5532	} else {
5533	// Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
5534	symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
5535	symbol->SetType(context().MakeNumericType(
5536	TypeCategory::Integer, evaluate::CInteger::kind));
5537	}
5538
5539	if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
5540	enumerator.t)}) {
5541	Walk(*init); // Resolve names in expression before evaluation.
5542	if (auto value{EvaluateInt64(context(), *init)}) {
5543	// Cast all init expressions to C_INT so that they can then be
5544	// safely incremented (see 7.6 Note 2).
5545	enumerationState_.value = static_cast<int>(*value);
5546	} else {
5547	Say(name,
5548	"Enumerator value could not be computed "
5549	"from the given expression"_err_en_US);
5550	// Prevent resolution of next enumerators value
5551	enumerationState_.value = std::nullopt;
5552	}
5553	}
5554
5555	if (symbol) {
5556	if (enumerationState_.value) {
5557	symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
5558	evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
5559	} else {
5560	context().SetError(*symbol);
5561	}
5562	}
5563
5564	if (enumerationState_.value) {
5565	(*enumerationState_.value)++;
5566	}
5567	return false;
5568	}
5569
5570	void DeclarationVisitor::Post(const parser::EnumDef &) {
5571	enumerationState_ = EnumeratorState{};
5572	}
5573
5574	bool DeclarationVisitor::Pre(const parser::AccessSpec &x) {
5575	Attr attr{AccessSpecToAttr(x)};
5576	if (!NonDerivedTypeScope().IsModule()) { // C817
5577	Say(currStmtSource().value(),
5578	"%s attribute may only appear in the specification part of a module"_err_en_US,
5579	EnumToString(attr));
5580	}
5581	CheckAndSet(attr);
5582	return false;
5583	}
5584
5585	bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
5586	return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
5587	}
5588	bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) {
5589	return HandleAttributeStmt(Attr::CONTIGUOUS, x.v);
5590	}
5591	bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
5592	HandleAttributeStmt(Attr::EXTERNAL, x.v);
5593	for (const auto &name : x.v) {
5594	auto *symbol{FindSymbol(name)};
5595	if (!ConvertToProcEntity(DEREF(symbol), name.source)) {
5596	// Check if previous symbol is an interface.
5597	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
5598	if (details->isInterface()) {
5599	// Warn if interface previously declared.
5600	context().Warn(common::LanguageFeature::RedundantAttribute,
5601	name.source,
5602	"EXTERNAL attribute was already specified on '%s'"_warn_en_US,
5603	name.source);
5604	}
5605	} else {
5606	SayWithDecl(
5607	name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
5608	}
5609	} else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840
5610	Say(symbol->name(),
5611	"Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,
5612	symbol->name());
5613	}
5614	}
5615	return false;
5616	}
5617	bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
5618	auto &intentSpec{std::get<parser::IntentSpec>(x.t)};
5619	auto &names{std::get<std::list<parser::Name>>(x.t)};
5620	return CheckNotInBlock("INTENT") && // C1107
5621	HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
5622	}
5623	bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
5624	for (const auto &name : x.v) {
5625	DeclareIntrinsic(name);
5626	}
5627	return false;
5628	}
5629	void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
5630	HandleAttributeStmt(Attr::INTRINSIC, name);
5631	if (!IsIntrinsic(name.source, std::nullopt)) {
5632	Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
5633	}
5634	auto &symbol{DEREF(FindSymbol(name))};
5635	if (symbol.has<GenericDetails>()) {
5636	// Generic interface is extending intrinsic; ok
5637	} else if (!ConvertToProcEntity(symbol&: symbol, usedHere: name.source)) {
5638	SayWithDecl(
5639	name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
5640	} else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
5641	Say(symbol.name(),
5642	"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
5643	symbol.name());
5644	} else {
5645	if (symbol.GetType()) {
5646	// These warnings are worded so that they should make sense in either
5647	// order.
5648	if (auto *msg{context().Warn(
5649	common::UsageWarning::IgnoredIntrinsicFunctionType, symbol.name(),
5650	"Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
5651	symbol.name())}) {
5652	msg->Attach(name.source,
5653	"INTRINSIC statement for explicitly-typed '%s'"_en_US, name.source);
5654	}
5655	}
5656	if (!symbol.test(Symbol::Flag::Function) &&
5657	!symbol.test(Symbol::Flag::Subroutine)) {
5658	if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) {
5659	symbol.set(Symbol::Flag::Function);
5660	} else if (context().intrinsics().IsIntrinsicSubroutine(
5661	name.source.ToString())) {
5662	symbol.set(Symbol::Flag::Subroutine);
5663	}
5664	}
5665	}
5666	}
5667	bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
5668	return CheckNotInBlock("OPTIONAL") && // C1107
5669	HandleAttributeStmt(Attr::OPTIONAL, x.v);
5670	}
5671	bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) {
5672	return HandleAttributeStmt(Attr::PROTECTED, x.v);
5673	}
5674	bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
5675	return CheckNotInBlock("VALUE") && // C1107
5676	HandleAttributeStmt(Attr::VALUE, x.v);
5677	}
5678	bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
5679	return HandleAttributeStmt(Attr::VOLATILE, x.v);
5680	}
5681	bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {
5682	auto attr{std::get<common::CUDADataAttr>(x.t)};
5683	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
5684	auto *symbol{FindInScope(name)};
5685	if (symbol && symbol->has<UseDetails>()) {
5686	Say(currStmtSource().value(),
5687	"Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,
5688	name.source);
5689	} else {
5690	if (!symbol) {
5691	symbol = &MakeSymbol(name, ObjectEntityDetails{});
5692	}
5693	SetCUDADataAttr(name.source, *symbol, attr);
5694	}
5695	}
5696	return false;
5697	}
5698	// Handle a statement that sets an attribute on a list of names.
5699	bool DeclarationVisitor::HandleAttributeStmt(
5700	Attr attr, const std::list<parser::Name> &names) {
5701	for (const auto &name : names) {
5702	HandleAttributeStmt(attr, name);
5703	}
5704	return false;
5705	}
5706	Symbol &DeclarationVisitor::HandleAttributeStmt(
5707	Attr attr, const parser::Name &name) {
5708	auto *symbol{FindInScope(name)};
5709	if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
5710	// these can be set on a symbol that is host-assoc or use-assoc
5711	if (!symbol &&
5712	(currScope().kind() == Scope::Kind::Subprogram ||
5713	currScope().kind() == Scope::Kind::BlockConstruct)) {
5714	if (auto *hostSymbol{FindSymbol(name)}) {
5715	symbol = &MakeHostAssocSymbol(name, hostSymbol: *hostSymbol);
5716	}
5717	}
5718	} else if (symbol && symbol->has<UseDetails>()) {
5719	if (symbol->GetUltimate().attrs().test(attr)) {
5720	context().Warn(common::LanguageFeature::RedundantAttribute,
5721	currStmtSource().value(),
5722	"Use-associated '%s' already has '%s' attribute"_warn_en_US,
5723	name.source, EnumToString(attr));
5724	} else {
5725	Say(currStmtSource().value(),
5726	"Cannot change %s attribute on use-associated '%s'"_err_en_US,
5727	EnumToString(attr), name.source);
5728	}
5729	return *symbol;
5730	}
5731	if (!symbol) {
5732	symbol = &MakeSymbol(name, EntityDetails{});
5733	}
5734	if (CheckDuplicatedAttr(name.source, *symbol, attr)) {
5735	HandleSaveName(name.source, Attrs{attr});
5736	SetExplicitAttr(*symbol, attr);
5737	}
5738	return *symbol;
5739	}
5740	// C1107
5741	bool DeclarationVisitor::CheckNotInBlock(const char *stmt) {
5742	if (currScope().kind() == Scope::Kind::BlockConstruct) {
5743	Say(MessageFormattedText{
5744	"%s statement is not allowed in a BLOCK construct"_err_en_US, stmt});
5745	return false;
5746	} else {
5747	return true;
5748	}
5749	}
5750
5751	void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
5752	CHECK(objectDeclAttr_);
5753	const auto &name{std::get<parser::ObjectName>(x.t)};
5754	DeclareObjectEntity(name, Attrs{*objectDeclAttr_});
5755	}
5756
5757	// Declare an entity not yet known to be an object or proc.
5758	Symbol &DeclarationVisitor::DeclareUnknownEntity(
5759	const parser::Name &name, Attrs attrs) {
5760	if (!arraySpec().empty() || !coarraySpec().empty()) {
5761	return DeclareObjectEntity(name, attrs);
5762	} else {
5763	Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
5764	if (auto *type{GetDeclTypeSpec()}) {
5765	ForgetEarlyDeclaredDummyArgument(symbol);
5766	SetType(name, *type);
5767	}
5768	charInfo_.length.reset();
5769	if (symbol.attrs().test(Attr::EXTERNAL)) {
5770	ConvertToProcEntity(symbol);
5771	} else if (symbol.attrs().HasAny(Attrs{Attr::ALLOCATABLE,
5772	Attr::ASYNCHRONOUS, Attr::CONTIGUOUS, Attr::PARAMETER,
5773	Attr::SAVE, Attr::TARGET, Attr::VALUE, Attr::VOLATILE})) {
5774	ConvertToObjectEntity(symbol);
5775	}
5776	if (attrs.test(Attr::BIND_C)) {
5777	SetBindNameOn(symbol);
5778	}
5779	return symbol;
5780	}
5781	}
5782
5783	bool DeclarationVisitor::HasCycle(
5784	const Symbol &procSymbol, const Symbol *interface) {
5785	SourceOrderedSymbolSet procsInCycle;
5786	procsInCycle.insert(procSymbol);
5787	while (interface) {
5788	if (procsInCycle.count(*interface) > 0) {
5789	for (const auto &procInCycle : procsInCycle) {
5790	Say(procInCycle->name(),
5791	"The interface for procedure '%s' is recursively defined"_err_en_US,
5792	procInCycle->name());
5793	context().SetError(*procInCycle);
5794	}
5795	return true;
5796	} else if (const auto *procDetails{
5797	interface->detailsIf<ProcEntityDetails>()}) {
5798	procsInCycle.insert(*interface);
5799	interface = procDetails->procInterface();
5800	} else {
5801	break;
5802	}
5803	}
5804	return false;
5805	}
5806
5807	Symbol &DeclarationVisitor::DeclareProcEntity(
5808	const parser::Name &name, Attrs attrs, const Symbol *interface) {
5809	Symbol *proc{nullptr};
5810	if (auto *extant{FindInScope(name)}) {
5811	if (auto *d{extant->detailsIf<GenericDetails>()}; d && !d->derivedType()) {
5812	// procedure pointer with same name as a generic
5813	if (auto *specific{d->specific()}) {
5814	SayAlreadyDeclared(name, *specific);
5815	} else {
5816	// Create the ProcEntityDetails symbol in the scope as the "specific()"
5817	// symbol behind an existing GenericDetails symbol of the same name.
5818	proc = &Resolve(name,
5819	currScope().MakeSymbol(name.source, attrs, ProcEntityDetails{}));
5820	d->set_specific(*proc);
5821	}
5822	}
5823	}
5824	Symbol &symbol{proc ? *proc : DeclareEntity<ProcEntityDetails>(name, attrs)};
5825	if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
5826	if (context().HasError(symbol)) {
5827	} else if (HasCycle(procSymbol: symbol, interface)) {
5828	return symbol;
5829	} else if (interface && (details->procInterface() || details->type())) {
5830	SayWithDecl(name, symbol,
5831	"The interface for procedure '%s' has already been declared"_err_en_US);
5832	context().SetError(symbol);
5833	} else if (interface) {
5834	details->set_procInterfaces(
5835	*interface, BypassGeneric(interface->GetUltimate()));
5836	if (interface->test(Symbol::Flag::Function)) {
5837	symbol.set(Symbol::Flag::Function);
5838	} else if (interface->test(Symbol::Flag::Subroutine)) {
5839	symbol.set(Symbol::Flag::Subroutine);
5840	}
5841	} else if (auto *type{GetDeclTypeSpec()}) {
5842	ForgetEarlyDeclaredDummyArgument(symbol);
5843	SetType(name, *type);
5844	symbol.set(Symbol::Flag::Function);
5845	}
5846	SetBindNameOn(symbol);
5847	SetPassNameOn(symbol);
5848	}
5849	return symbol;
5850	}
5851
5852	Symbol &DeclarationVisitor::DeclareObjectEntity(
5853	const parser::Name &name, Attrs attrs) {
5854	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
5855	if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
5856	if (auto *type{GetDeclTypeSpec()}) {
5857	ForgetEarlyDeclaredDummyArgument(symbol);
5858	SetType(name, *type);
5859	}
5860	if (!arraySpec().empty()) {
5861	if (details->IsArray()) {
5862	if (!context().HasError(symbol)) {
5863	Say(name,
5864	"The dimensions of '%s' have already been declared"_err_en_US);
5865	context().SetError(symbol);
5866	}
5867	} else if (MustBeScalar(symbol)) {
5868	if (!context().HasError(symbol)) {
5869	context().Warn(common::UsageWarning::PreviousScalarUse, name.source,
5870	"'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US,
5871	name.source);
5872	}
5873	} else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
5874	Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);
5875	} else {
5876	details->set_shape(arraySpec());
5877	}
5878	}
5879	if (!coarraySpec().empty()) {
5880	if (details->IsCoarray()) {
5881	if (!context().HasError(symbol)) {
5882	Say(name,
5883	"The codimensions of '%s' have already been declared"_err_en_US);
5884	context().SetError(symbol);
5885	}
5886	} else {
5887	details->set_coshape(coarraySpec());
5888	}
5889	}
5890	SetBindNameOn(symbol);
5891	}
5892	ClearArraySpec();
5893	ClearCoarraySpec();
5894	charInfo_.length.reset();
5895	return symbol;
5896	}
5897
5898	void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
5899	if (!isVectorType_) {
5900	SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
5901	}
5902	}
5903	void DeclarationVisitor::Post(const parser::UnsignedTypeSpec &x) {
5904	if (!isVectorType_) {
5905	if (!context().IsEnabled(common::LanguageFeature::Unsigned) &&
5906	!context().AnyFatalError()) {
5907	context().Say("-funsigned is required to enable UNSIGNED type"_err_en_US);
5908	}
5909	SetDeclTypeSpec(MakeNumericType(TypeCategory::Unsigned, x.v));
5910	}
5911	}
5912	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
5913	if (!isVectorType_) {
5914	SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
5915	}
5916	}
5917	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
5918	SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind));
5919	}
5920	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
5921	SetDeclTypeSpec(MakeLogicalType(x.kind));
5922	}
5923	void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
5924	if (!charInfo_.length) {
5925	charInfo_.length = ParamValue{1, common::TypeParamAttr::Len};
5926	}
5927	if (!charInfo_.kind) {
5928	charInfo_.kind =
5929	KindExpr{context().GetDefaultKind(TypeCategory::Character)};
5930	}
5931	SetDeclTypeSpec(currScope().MakeCharacterType(
5932	std::move(*charInfo_.length), std::move(*charInfo_.kind)));
5933	charInfo_ = {};
5934	}
5935	void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
5936	charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
5937	std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};
5938	if (intKind &&
5939	!context().targetCharacteristics().IsTypeEnabled(
5940	TypeCategory::Character, *intKind)) { // C715, C719
5941	Say(currStmtSource().value(),
5942	"KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);
5943	charInfo_.kind = std::nullopt; // prevent further errors
5944	}
5945	if (x.length) {
5946	charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
5947	}
5948	}
5949	void DeclarationVisitor::Post(const parser::CharLength &x) {
5950	if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) {
5951	charInfo_.length = ParamValue{
5952	static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len};
5953	} else {
5954	charInfo_.length = GetParamValue(
5955	std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len);
5956	}
5957	}
5958	void DeclarationVisitor::Post(const parser::LengthSelector &x) {
5959	if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) {
5960	charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len);
5961	}
5962	}
5963
5964	bool DeclarationVisitor::Pre(const parser::KindParam &x) {
5965	if (const auto *kind{std::get_if<
5966	parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>(
5967	&x.u)}) {
5968	const parser::Name &name{kind->thing.thing.thing};
5969	if (!FindSymbol(name)) {
5970	Say(name, "Parameter '%s' not found"_err_en_US);
5971	}
5972	}
5973	return false;
5974	}
5975
5976	int DeclarationVisitor::GetVectorElementKind(
5977	TypeCategory category, const std::optional<parser::KindSelector> &kind) {
5978	KindExpr value{GetKindParamExpr(category, kind)};
5979	if (auto known{evaluate::ToInt64(value)}) {
5980	return static_cast<int>(*known);
5981	}
5982	common::die("Vector element kind must be known at compile-time");
5983	}
5984
5985	bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) {
5986	// PowerPC vector types are allowed only on Power architectures.
5987	if (!currScope().context().targetCharacteristics().isPPC()) {
5988	Say(currStmtSource().value(),
5989	"Vector type is only supported for PowerPC"_err_en_US);
5990	isVectorType_ = false;
5991	return false;
5992	}
5993	isVectorType_ = true;
5994	return true;
5995	}
5996	// Create semantic::DerivedTypeSpec for Vector types here.
5997	void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {
5998	llvm::StringRef typeName;
5999	llvm::SmallVector<ParamValue> typeParams;
6000	DerivedTypeSpec::Category vectorCategory;
6001
6002	isVectorType_ = false;
6003	common::visit(
6004	common::visitors{
6005	[&](const parser::IntrinsicVectorTypeSpec &y) {
6006	vectorCategory = DerivedTypeSpec::Category::IntrinsicVector;
6007	int vecElemKind = 0;
6008	typeName = "__builtin_ppc_intrinsic_vector";
6009	common::visit(
6010	common::visitors{
6011	[&](const parser::IntegerTypeSpec &z) {
6012	vecElemKind = GetVectorElementKind(
6013	TypeCategory::Integer, std::move(z.v));
6014	typeParams.push_back(ParamValue(
6015	static_cast<common::ConstantSubscript>(
6016	common::VectorElementCategory::Integer),
6017	common::TypeParamAttr::Kind));
6018	},
6019	[&](const parser::IntrinsicTypeSpec::Real &z) {
6020	vecElemKind = GetVectorElementKind(
6021	TypeCategory::Real, std::move(z.kind));
6022	typeParams.push_back(
6023	ParamValue(static_cast<common::ConstantSubscript>(
6024	common::VectorElementCategory::Real),
6025	common::TypeParamAttr::Kind));
6026	},
6027	[&](const parser::UnsignedTypeSpec &z) {
6028	vecElemKind = GetVectorElementKind(
6029	TypeCategory::Integer, std::move(z.v));
6030	typeParams.push_back(ParamValue(
6031	static_cast<common::ConstantSubscript>(
6032	common::VectorElementCategory::Unsigned),
6033	common::TypeParamAttr::Kind));
6034	},
6035	},
6036	y.v.u);
6037	typeParams.push_back(
6038	ParamValue(static_cast<common::ConstantSubscript>(vecElemKind),
6039	common::TypeParamAttr::Kind));
6040	},
6041	[&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) {
6042	vectorCategory = DerivedTypeSpec::Category::PairVector;
6043	typeName = "__builtin_ppc_pair_vector";
6044	},
6045	[&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) {
6046	vectorCategory = DerivedTypeSpec::Category::QuadVector;
6047	typeName = "__builtin_ppc_quad_vector";
6048	},
6049	},
6050	x.u);
6051
6052	auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope();
6053	if (!ppcBuiltinTypesScope) {
6054	common::die("INTERNAL: The __ppc_types module was not found ");
6055	}
6056
6057	auto iter{ppcBuiltinTypesScope->find(
6058	semantics::SourceName{typeName.data(), typeName.size()})};
6059	if (iter == ppcBuiltinTypesScope->cend()) {
6060	common::die("INTERNAL: The __ppc_types module does not define "
6061	"the type '%s'",
6062	typeName.data());
6063	}
6064
6065	const semantics::Symbol &typeSymbol{*iter->second};
6066	DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol};
6067	vectorDerivedType.set_category(vectorCategory);
6068	if (typeParams.size()) {
6069	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0]));
6070	vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1]));
6071	vectorDerivedType.CookParameters(GetFoldingContext());
6072	}
6073
6074	if (const DeclTypeSpec *
6075	extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(
6076	vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
6077	// This derived type and parameter expressions (if any) are already present
6078	// in the __ppc_intrinsics scope.
6079	SetDeclTypeSpec(*extant);
6080	} else {
6081	DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType(
6082	DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))};
6083	DerivedTypeSpec &derived{type.derivedTypeSpec()};
6084	auto restorer{
6085	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
6086	derived.Instantiate(*ppcBuiltinTypesScope);
6087	SetDeclTypeSpec(type);
6088	}
6089	}
6090
6091	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
6092	CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived);
6093	return true;
6094	}
6095
6096	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
6097	const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)};
6098	if (const Symbol * derivedSymbol{derivedName.symbol}) {
6099	CheckForAbstractType(*derivedSymbol); // C706
6100	}
6101	}
6102
6103	bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) {
6104	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
6105	return true;
6106	}
6107
6108	void DeclarationVisitor::Post(
6109	const parser::DeclarationTypeSpec::Class &parsedClass) {
6110	const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)};
6111	if (auto spec{ResolveDerivedType(typeName)};
6112	spec && !IsExtensibleType(&*spec)) { // C705
6113	SayWithDecl(typeName, *typeName.symbol,
6114	"Non-extensible derived type '%s' may not be used with CLASS"
6115	" keyword"_err_en_US);
6116	}
6117	}
6118
6119	void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
6120	const auto &typeName{std::get<parser::Name>(x.t)};
6121	auto spec{ResolveDerivedType(typeName)};
6122	if (!spec) {
6123	return;
6124	}
6125	bool seenAnyName{false};
6126	for (const auto &typeParamSpec :
6127	std::get<std::list<parser::TypeParamSpec>>(x.t)) {
6128	const auto &optKeyword{
6129	std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};
6130	std::optional<SourceName> name;
6131	if (optKeyword) {
6132	seenAnyName = true;
6133	name = optKeyword->v.source;
6134	} else if (seenAnyName) {
6135	Say(typeName.source, "Type parameter value must have a name"_err_en_US);
6136	continue;
6137	}
6138	const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
6139	// The expressions in a derived type specifier whose values define
6140	// non-defaulted type parameters are evaluated (folded) in the enclosing
6141	// scope. The KIND/LEN distinction is resolved later in
6142	// DerivedTypeSpec::CookParameters().
6143	ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
6144	if (!param.isExplicit() || param.GetExplicit()) {
6145	spec->AddRawParamValue(
6146	common::GetPtrFromOptional(optKeyword), std::move(param));
6147	}
6148	}
6149	// The DerivedTypeSpec *spec is used initially as a search key.
6150	// If it turns out to have the same name and actual parameter
6151	// value expressions as another DerivedTypeSpec in the current
6152	// scope does, then we'll use that extant spec; otherwise, when this
6153	// spec is distinct from all derived types previously instantiated
6154	// in the current scope, this spec will be moved into that collection.
6155	const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};
6156	auto category{GetDeclTypeSpecCategory()};
6157	if (dtDetails.isForwardReferenced()) {
6158	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
6159	SetDeclTypeSpec(type);
6160	return;
6161	}
6162	// Normalize parameters to produce a better search key.
6163	spec->CookParameters(GetFoldingContext());
6164	if (!spec->MightBeParameterized()) {
6165	spec->EvaluateParameters(context());
6166	}
6167	if (const DeclTypeSpec *
6168	extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
6169	// This derived type and parameter expressions (if any) are already present
6170	// in this scope.
6171	SetDeclTypeSpec(*extant);
6172	} else {
6173	DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
6174	DerivedTypeSpec &derived{type.derivedTypeSpec()};
6175	if (derived.MightBeParameterized() &&
6176	currScope().IsParameterizedDerivedType()) {
6177	// Defer instantiation; use the derived type's definition's scope.
6178	derived.set_scope(DEREF(spec->typeSymbol().scope()));
6179	} else if (&currScope() == spec->typeSymbol().scope()) {
6180	// Direct recursive use of a type in the definition of one of its
6181	// components: defer instantiation
6182	} else {
6183	auto restorer{
6184	GetFoldingContext().messages().SetLocation(currStmtSource().value())};
6185	derived.Instantiate(currScope());
6186	}
6187	SetDeclTypeSpec(type);
6188	}
6189	// Capture the DerivedTypeSpec in the parse tree for use in building
6190	// structure constructor expressions.
6191	x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
6192	}
6193
6194	void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
6195	const auto &typeName{rec.v};
6196	if (auto spec{ResolveDerivedType(typeName)}) {
6197	spec->CookParameters(GetFoldingContext());
6198	spec->EvaluateParameters(context());
6199	if (const DeclTypeSpec *
6200	extant{currScope().FindInstantiatedDerivedType(
6201	*spec, DeclTypeSpec::TypeDerived)}) {
6202	SetDeclTypeSpec(*extant);
6203	} else {
6204	Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US,
6205	typeName.source);
6206	}
6207	}
6208	}
6209
6210	// The descendents of DerivedTypeDef in the parse tree are visited directly
6211	// in this Pre() routine so that recursive use of the derived type can be
6212	// supported in the components.
6213	bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
6214	auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
6215	Walk(stmt);
6216	Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t));
6217	auto &scope{currScope()};
6218	CHECK(scope.symbol());
6219	CHECK(scope.symbol()->scope() == &scope);
6220	auto &details{scope.symbol()->get<DerivedTypeDetails>()};
6221	for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
6222	if (auto *symbol{FindInScope(scope, paramName)}) {
6223	if (auto *details{symbol->detailsIf<TypeParamDetails>()}) {
6224	if (!details->attr()) {
6225	Say(paramName,
6226	"No definition found for type parameter '%s'"_err_en_US); // C742
6227	}
6228	}
6229	}
6230	}
6231	Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t));
6232	const auto &componentDefs{
6233	std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)};
6234	Walk(componentDefs);
6235	if (derivedTypeInfo_.sequence) {
6236	details.set_sequence(true);
6237	if (componentDefs.empty()) {
6238	// F'2023 C745 - not enforced by any compiler
6239	context().Warn(common::LanguageFeature::EmptySequenceType, stmt.source,
6240	"A sequence type should have at least one component"_warn_en_US);
6241	}
6242	if (!details.paramDeclOrder().empty()) { // C740
6243	Say(stmt.source,
6244	"A sequence type may not have type parameters"_err_en_US);
6245	}
6246	if (derivedTypeInfo_.extends) { // C735
6247	Say(stmt.source,
6248	"A sequence type may not have the EXTENDS attribute"_err_en_US);
6249	}
6250	}
6251	Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t));
6252	Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t));
6253	details.set_isForwardReferenced(false);
6254	derivedTypeInfo_ = {};
6255	PopScope();
6256	return false;
6257	}
6258
6259	bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) {
6260	return BeginAttrs();
6261	}
6262	void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
6263	auto &name{std::get<parser::Name>(x.t)};
6264	// Resolve the EXTENDS() clause before creating the derived
6265	// type's symbol to foil attempts to recursively extend a type.
6266	auto *extendsName{derivedTypeInfo_.extends};
6267	std::optional<DerivedTypeSpec> extendsType{
6268	ResolveExtendsType(name, extendsName)};
6269	DerivedTypeDetails derivedTypeDetails;
6270	// Catch any premature structure constructors within the definition
6271	derivedTypeDetails.set_isForwardReferenced(true);
6272	auto &symbol{MakeSymbol(name, GetAttrs(), std::move(derivedTypeDetails))};
6273	symbol.ReplaceName(name.source);
6274	derivedTypeInfo_.type = &symbol;
6275	PushScope(Scope::Kind::DerivedType, &symbol);
6276	if (extendsType) {
6277	// Declare the "parent component"; private if the type is.
6278	// Any symbol stored in the EXTENDS() clause is temporarily
6279	// hidden so that a new symbol can be created for the parent
6280	// component without producing spurious errors about already
6281	// existing.
6282	const Symbol &extendsSymbol{extendsType->typeSymbol()};
6283	auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
6284	if (OkToAddComponent(*extendsName, extends: &extendsSymbol)) {
6285	auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
6286	comp.attrs().set(
6287	Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE));
6288	comp.implicitAttrs().set(
6289	Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE));
6290	comp.set(Symbol::Flag::ParentComp);
6291	DeclTypeSpec &type{currScope().MakeDerivedType(
6292	DeclTypeSpec::TypeDerived, std::move(*extendsType))};
6293	type.derivedTypeSpec().set_scope(DEREF(extendsSymbol.scope()));
6294	comp.SetType(type);
6295	DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
6296	details.add_component(comp);
6297	}
6298	}
6299	// Create symbols now for type parameters so that they shadow names
6300	// from the enclosing specification part.
6301	if (auto *details{symbol.detailsIf<DerivedTypeDetails>()}) {
6302	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
6303	if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{})}) {
6304	details->add_paramNameOrder(*symbol);
6305	}
6306	}
6307	}
6308	EndAttrs();
6309	}
6310
6311	void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
6312	auto *type{GetDeclTypeSpec()};
6313	DerivedTypeDetails *derivedDetails{nullptr};
6314	if (Symbol * dtSym{currScope().symbol()}) {
6315	derivedDetails = dtSym->detailsIf<DerivedTypeDetails>();
6316	}
6317	auto attr{std::get<common::TypeParamAttr>(x.t)};
6318	for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
6319	auto &name{std::get<parser::Name>(decl.t)};
6320	if (Symbol * symbol{FindInScope(currScope(), name)}) {
6321	if (auto *paramDetails{symbol->detailsIf<TypeParamDetails>()}) {
6322	if (!paramDetails->attr()) {
6323	paramDetails->set_attr(attr);
6324	SetType(name, *type);
6325	if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
6326	decl.t)}) {
6327	if (auto maybeExpr{AnalyzeExpr(context(), *init)}) {
6328	if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) {
6329	paramDetails->set_init(std::move(*intExpr));
6330	}
6331	}
6332	}
6333	if (derivedDetails) {
6334	derivedDetails->add_paramDeclOrder(*symbol);
6335	}
6336	} else {
6337	Say(name,
6338	"Type parameter '%s' was already declared in this derived type"_err_en_US);
6339	}
6340	}
6341	} else {
6342	Say(name, "'%s' is not a parameter of this derived type"_err_en_US);
6343	}
6344	}
6345	EndDecl();
6346	}
6347	bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
6348	if (derivedTypeInfo_.extends) {
6349	Say(currStmtSource().value(),
6350	"Attribute 'EXTENDS' cannot be used more than once"_err_en_US);
6351	} else {
6352	derivedTypeInfo_.extends = &x.v;
6353	}
6354	return false;
6355	}
6356
6357	bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
6358	if (!currScope().parent().IsModule()) {
6359	Say("PRIVATE is only allowed in a derived type that is"
6360	" in a module"_err_en_US); // C766
6361	} else if (derivedTypeInfo_.sawContains) {
6362	derivedTypeInfo_.privateBindings = true;
6363	} else if (!derivedTypeInfo_.privateComps) {
6364	derivedTypeInfo_.privateComps = true;
6365	} else { // C738
6366	context().Warn(common::LanguageFeature::RedundantAttribute,
6367	"PRIVATE should not appear more than once in derived type components"_warn_en_US);
6368	}
6369	return false;
6370	}
6371	bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {
6372	if (derivedTypeInfo_.sequence) { // C738
6373	context().Warn(common::LanguageFeature::RedundantAttribute,
6374	"SEQUENCE should not appear more than once in derived type components"_warn_en_US);
6375	}
6376	derivedTypeInfo_.sequence = true;
6377	return false;
6378	}
6379	void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
6380	const auto &name{std::get<parser::Name>(x.t)};
6381	auto attrs{GetAttrs()};
6382	if (derivedTypeInfo_.privateComps &&
6383	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
6384	attrs.set(Attr::PRIVATE);
6385	}
6386	if (const auto *declType{GetDeclTypeSpec()}) {
6387	if (const auto *derived{declType->AsDerived()}) {
6388	if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
6389	if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744
6390	Say("Recursive use of the derived type requires "
6391	"POINTER or ALLOCATABLE"_err_en_US);
6392	}
6393	}
6394	}
6395	}
6396	if (OkToAddComponent(name)) {
6397	auto &symbol{DeclareObjectEntity(name, attrs)};
6398	SetCUDADataAttr(name.source, symbol, cudaDataAttr());
6399	if (symbol.has<ObjectEntityDetails>()) {
6400	if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
6401	Initialization(name, *init, /*inComponentDecl=*/true);
6402	}
6403	}
6404	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
6405	}
6406	ClearArraySpec();
6407	ClearCoarraySpec();
6408	}
6409	void DeclarationVisitor::Post(const parser::FillDecl &x) {
6410	// Replace "%FILL" with a distinct generated name
6411	const auto &name{std::get<parser::Name>(x.t)};
6412	const_cast<SourceName &>(name.source) = context().GetTempName(currScope());
6413	if (OkToAddComponent(name)) {
6414	auto &symbol{DeclareObjectEntity(name, GetAttrs())};
6415	currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
6416	}
6417	ClearArraySpec();
6418	}
6419	bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
6420	CHECK(!interfaceName_);
6421	const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};
6422	for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
6423	if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
6424	if (std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
6425	bindC->t)
6426	.has_value()) {
6427	if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {
6428	Say(context().location().value(),
6429	"A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);
6430	}
6431	break;
6432	}
6433	}
6434	}
6435	return BeginDecl();
6436	}
6437	void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
6438	interfaceName_ = nullptr;
6439	EndDecl();
6440	}
6441	bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
6442	// Overrides parse tree traversal so as to handle attributes first,
6443	// so POINTER & ALLOCATABLE enable forward references to derived types.
6444	Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
6445	set_allowForwardReferenceToDerivedType(
6446	GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
6447	Walk(std::get<parser::DeclarationTypeSpec>(x.t));
6448	set_allowForwardReferenceToDerivedType(false);
6449	if (derivedTypeInfo_.sequence) { // C740
6450	if (const auto *declType{GetDeclTypeSpec()}) {
6451	if (!declType->AsIntrinsic() && !declType->IsSequenceType() &&
6452	!InModuleFile()) {
6453	if (GetAttrs().test(Attr::POINTER) &&
6454	context().IsEnabled(common::LanguageFeature::PointerInSeqType)) {
6455	context().Warn(common::LanguageFeature::PointerInSeqType,
6456	"A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);
6457	} else {
6458	Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US);
6459	}
6460	}
6461	}
6462	}
6463	Walk(std::get<std::list<parser::ComponentOrFill>>(x.t));
6464	return false;
6465	}
6466	bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
6467	CHECK(!interfaceName_);
6468	return true;
6469	}
6470	void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
6471	interfaceName_ = nullptr;
6472	}
6473	bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
6474	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
6475	return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(name: *name);
6476	} else {
6477	const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))};
6478	Walk(null);
6479	if (auto nullInit{EvaluateExpr(null)}) {
6480	if (!evaluate::IsNullProcedurePointer(&*nullInit) &&
6481	!evaluate::IsBareNullPointer(&*nullInit)) {
6482	Say(null.v.value().source,
6483	"Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US);
6484	}
6485	}
6486	return false;
6487	}
6488	}
6489	void DeclarationVisitor::Post(const parser::ProcInterface &x) {
6490	if (auto *name{std::get_if<parser::Name>(&x.u)}) {
6491	interfaceName_ = name;
6492	NoteInterfaceName(*name);
6493	}
6494	}
6495	void DeclarationVisitor::Post(const parser::ProcDecl &x) {
6496	const auto &name{std::get<parser::Name>(x.t)};
6497	// Don't use BypassGeneric or GetUltimate on this symbol, they can
6498	// lead to unusable names in module files.
6499	const Symbol *procInterface{
6500	interfaceName_ ? interfaceName_->symbol : nullptr};
6501	auto attrs{HandleSaveName(name.source, GetAttrs())};
6502	DerivedTypeDetails *dtDetails{nullptr};
6503	if (Symbol * symbol{currScope().symbol()}) {
6504	dtDetails = symbol->detailsIf<DerivedTypeDetails>();
6505	}
6506	if (!dtDetails) {
6507	attrs.set(Attr::EXTERNAL);
6508	}
6509	if (derivedTypeInfo_.privateComps &&
6510	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
6511	attrs.set(Attr::PRIVATE);
6512	}
6513	Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
6514	SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
6515	symbol.ReplaceName(name.source);
6516	if (dtDetails) {
6517	dtDetails->add_component(symbol);
6518	}
6519	DeclaredPossibleSpecificProc(symbol);
6520	}
6521
6522	bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {
6523	derivedTypeInfo_.sawContains = true;
6524	return true;
6525	}
6526
6527	// Resolve binding names from type-bound generics, saved in genericBindings_.
6528	void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) {
6529	// track specifics seen for the current generic to detect duplicates:
6530	const Symbol *currGeneric{nullptr};
6531	std::set<SourceName> specifics;
6532	for (const auto &[generic, bindingName] : genericBindings_) {
6533	if (generic != currGeneric) {
6534	currGeneric = generic;
6535	specifics.clear();
6536	}
6537	auto [it, inserted]{specifics.insert(bindingName->source)};
6538	if (!inserted) {
6539	Say(*bindingName, // C773
6540	"Binding name '%s' was already specified for generic '%s'"_err_en_US,
6541	bindingName->source, generic->name())
6542	.Attach(*it, "Previous specification of '%s'"_en_US, *it);
6543	continue;
6544	}
6545	auto *symbol{FindInTypeOrParents(*bindingName)};
6546	if (!symbol) {
6547	Say(*bindingName, // C772
6548	"Binding name '%s' not found in this derived type"_err_en_US);
6549	} else if (!symbol->has<ProcBindingDetails>()) {
6550	SayWithDecl(*bindingName, *symbol, // C772
6551	"'%s' is not the name of a specific binding of this type"_err_en_US);
6552	} else {
6553	generic->get<GenericDetails>().AddSpecificProc(
6554	*symbol, bindingName->source);
6555	}
6556	}
6557	genericBindings_.clear();
6558	}
6559
6560	void DeclarationVisitor::Post(const parser::ContainsStmt &) {
6561	if (derivedTypeInfo_.sequence) {
6562	Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740
6563	}
6564	}
6565
6566	void DeclarationVisitor::Post(
6567	const parser::TypeBoundProcedureStmt::WithoutInterface &x) {
6568	if (GetAttrs().test(Attr::DEFERRED)) { // C783
6569	Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US);
6570	}
6571	for (auto &declaration : x.declarations) {
6572	auto &bindingName{std::get<parser::Name>(declaration.t)};
6573	auto &optName{std::get<std::optional<parser::Name>>(declaration.t)};
6574	const parser::Name &procedureName{optName ? *optName : bindingName};
6575	Symbol *procedure{FindSymbol(procedureName)};
6576	if (!procedure) {
6577	procedure = NoteInterfaceName(procedureName);
6578	}
6579	if (procedure) {
6580	const Symbol &bindTo{BypassGeneric(*procedure)};
6581	if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) {
6582	SetPassNameOn(*s);
6583	if (GetAttrs().test(Attr::DEFERRED)) {
6584	context().SetError(*s);
6585	}
6586	}
6587	}
6588	}
6589	}
6590
6591	void DeclarationVisitor::CheckBindings(
6592	const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
6593	CHECK(currScope().IsDerivedType());
6594	for (auto &declaration : tbps.declarations) {
6595	auto &bindingName{std::get<parser::Name>(declaration.t)};
6596	if (Symbol * binding{FindInScope(bindingName)}) {
6597	if (auto *details{binding->detailsIf<ProcBindingDetails>()}) {
6598	const Symbol &ultimate{details->symbol().GetUltimate()};
6599	const Symbol &procedure{BypassGeneric(ultimate)};
6600	if (&procedure != &ultimate) {
6601	details->ReplaceSymbol(procedure);
6602	}
6603	if (!CanBeTypeBoundProc(procedure)) {
6604	if (details->symbol().name() != binding->name()) {
6605	Say(binding->name(),
6606	"The binding of '%s' ('%s') must be either an accessible "
6607	"module procedure or an external procedure with "
6608	"an explicit interface"_err_en_US,
6609	binding->name(), details->symbol().name());
6610	} else {
6611	Say(binding->name(),
6612	"'%s' must be either an accessible module procedure "
6613	"or an external procedure with an explicit interface"_err_en_US,
6614	binding->name());
6615	}
6616	context().SetError(*binding);
6617	}
6618	}
6619	}
6620	}
6621	}
6622
6623	void DeclarationVisitor::Post(
6624	const parser::TypeBoundProcedureStmt::WithInterface &x) {
6625	if (!GetAttrs().test(Attr::DEFERRED)) { // C783
6626	Say("DEFERRED is required when an interface-name is provided"_err_en_US);
6627	}
6628	if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) {
6629	for (auto &bindingName : x.bindingNames) {
6630	if (auto *s{
6631	MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) {
6632	SetPassNameOn(*s);
6633	if (!GetAttrs().test(Attr::DEFERRED)) {
6634	context().SetError(*s);
6635	}
6636	}
6637	}
6638	}
6639	}
6640
6641	bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) {
6642	if (currScope().IsDerivedType() && currScope().symbol()) {
6643	if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) {
6644	for (const auto &subrName : x.v) {
6645	Symbol *symbol{FindSymbol(subrName)};
6646	if (!symbol) {
6647	// FINAL procedures must be module subroutines
6648	symbol = &MakeSymbol(
6649	currScope().parent(), subrName.source, Attrs{Attr::MODULE});
6650	Resolve(subrName, symbol);
6651	symbol->set_details(ProcEntityDetails{});
6652	symbol->set(Symbol::Flag::Subroutine);
6653	}
6654	if (auto pair{details->finals().emplace(subrName.source, *symbol)};
6655	!pair.second) { // C787
6656	Say(subrName.source,
6657	"FINAL subroutine '%s' already appeared in this derived type"_err_en_US,
6658	subrName.source)
6659	.Attach(pair.first->first,
6660	"earlier appearance of this FINAL subroutine"_en_US);
6661	}
6662	}
6663	}
6664	}
6665	return false;
6666	}
6667
6668	bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
6669	const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)};
6670	const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};
6671	const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)};
6672	GenericSpecInfo info{genericSpec.value()};
6673	SourceName symbolName{info.symbolName()};
6674	bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private
6675	: derivedTypeInfo_.privateBindings};
6676	auto *genericSymbol{FindInScope(symbolName)};
6677	if (genericSymbol) {
6678	if (!genericSymbol->has<GenericDetails>()) {
6679	genericSymbol = nullptr; // MakeTypeSymbol will report the error below
6680	}
6681	} else {
6682	// look in ancestor types for a generic of the same name
6683	for (const auto &name : GetAllNames(context(), symbolName)) {
6684	if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) {
6685	if (inherited->has<GenericDetails>()) {
6686	CheckAccessibility(symbolName, isPrivate, *inherited); // C771
6687	} else {
6688	Say(symbolName,
6689	"Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US)
6690	.Attach(inherited->name(), "Inherited symbol"_en_US);
6691	}
6692	break;
6693	}
6694	}
6695	}
6696	if (genericSymbol) {
6697	CheckAccessibility(name: symbolName, isPrivate, symbol&: *genericSymbol); // C771
6698	} else {
6699	genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{});
6700	if (!genericSymbol) {
6701	return false;
6702	}
6703	if (isPrivate) {
6704	SetExplicitAttr(*genericSymbol, Attr::PRIVATE);
6705	}
6706	}
6707	for (const parser::Name &bindingName : bindingNames) {
6708	genericBindings_.emplace(genericSymbol, &bindingName);
6709	}
6710	info.Resolve(genericSymbol);
6711	return false;
6712	}
6713
6714	// DEC STRUCTUREs are handled thus to allow for nested definitions.
6715	bool DeclarationVisitor::Pre(const parser::StructureDef &def) {
6716	const auto &structureStatement{
6717	std::get<parser::Statement<parser::StructureStmt>>(def.t)};
6718	auto saveDerivedTypeInfo{derivedTypeInfo_};
6719	derivedTypeInfo_ = {};
6720	derivedTypeInfo_.isStructure = true;
6721	derivedTypeInfo_.sequence = true;
6722	Scope *previousStructure{nullptr};
6723	if (saveDerivedTypeInfo.isStructure) {
6724	previousStructure = &currScope();
6725	PopScope();
6726	}
6727	const parser::StructureStmt &structStmt{structureStatement.statement};
6728	const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)};
6729	if (!name) {
6730	// Construct a distinct generated name for an anonymous structure
6731	auto &mutableName{const_cast<std::optional<parser::Name> &>(name)};
6732	mutableName.emplace(
6733	parser::Name{context().GetTempName(currScope()), nullptr});
6734	}
6735	auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})};
6736	symbol.ReplaceName(name->source);
6737	symbol.get<DerivedTypeDetails>().set_sequence(true);
6738	symbol.get<DerivedTypeDetails>().set_isDECStructure(true);
6739	derivedTypeInfo_.type = &symbol;
6740	PushScope(Scope::Kind::DerivedType, &symbol);
6741	const auto &fields{std::get<std::list<parser::StructureField>>(def.t)};
6742	Walk(fields);
6743	PopScope();
6744	// Complete the definition
6745	DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol};
6746	derivedTypeSpec.set_scope(DEREF(symbol.scope()));
6747	derivedTypeSpec.CookParameters(GetFoldingContext());
6748	derivedTypeSpec.EvaluateParameters(context());
6749	DeclTypeSpec &type{currScope().MakeDerivedType(
6750	DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))};
6751	type.derivedTypeSpec().Instantiate(currScope());
6752	// Restore previous structure definition context, if any
6753	derivedTypeInfo_ = saveDerivedTypeInfo;
6754	if (previousStructure) {
6755	PushScope(*previousStructure);
6756	}
6757	// Handle any entity declarations on the STRUCTURE statement
6758	const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)};
6759	if (!decls.empty()) {
6760	BeginDecl();
6761	SetDeclTypeSpec(type);
6762	Walk(decls);
6763	EndDecl();
6764	}
6765	return false;
6766	}
6767
6768	bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) {
6769	Say("support for UNION"_todo_en_US); // TODO
6770	return true;
6771	}
6772
6773	bool DeclarationVisitor::Pre(const parser::StructureField &x) {
6774	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
6775	x.u)) {
6776	BeginDecl();
6777	}
6778	return true;
6779	}
6780
6781	void DeclarationVisitor::Post(const parser::StructureField &x) {
6782	if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>(
6783	x.u)) {
6784	EndDecl();
6785	}
6786	}
6787
6788	bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
6789	BeginDeclTypeSpec();
6790	return true;
6791	}
6792	void DeclarationVisitor::Post(const parser::AllocateStmt &) {
6793	EndDeclTypeSpec();
6794	}
6795
6796	bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
6797	auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};
6798	const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};
6799	if (!type) {
6800	return false;
6801	}
6802	const DerivedTypeSpec *spec{type->AsDerived()};
6803	const Scope *typeScope{spec ? spec->scope() : nullptr};
6804	if (!typeScope) {
6805	return false;
6806	}
6807
6808	// N.B C7102 is implicitly enforced by having inaccessible types not
6809	// being found in resolution.
6810	// More constraints are enforced in expression.cpp so that they
6811	// can apply to structure constructors that have been converted
6812	// from misparsed function references.
6813	for (const auto &component :
6814	std::get<std::list<parser::ComponentSpec>>(x.t)) {
6815	// Visit the component spec expression, but not the keyword, since
6816	// we need to resolve its symbol in the scope of the derived type.
6817	Walk(std::get<parser::ComponentDataSource>(component.t));
6818	if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
6819	FindInTypeOrParents(*typeScope, kw->v);
6820	}
6821	}
6822	return false;
6823	}
6824
6825	bool DeclarationVisitor::Pre(const parser::BasedPointer &) {
6826	BeginArraySpec();
6827	return true;
6828	}
6829
6830	void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
6831	const parser::ObjectName &pointerName{std::get<0>(bp.t)};
6832	auto *pointer{FindInScope(pointerName)};
6833	if (!pointer) {
6834	pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
6835	} else if (!ConvertToObjectEntity(symbol&: *pointer)) {
6836	SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
6837	} else if (IsNamedConstant(*pointer)) {
6838	SayWithDecl(pointerName, *pointer,
6839	"'%s' is a named constant and may not be a Cray pointer"_err_en_US);
6840	} else if (pointer->Rank() > 0) {
6841	SayWithDecl(
6842	pointerName, *pointer, "Cray pointer '%s' must be a scalar"_err_en_US);
6843	} else if (pointer->test(Symbol::Flag::CrayPointee)) {
6844	Say(pointerName,
6845	"'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
6846	}
6847	pointer->set(Symbol::Flag::CrayPointer);
6848	const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer,
6849	context().targetCharacteristics().integerKindForPointer())};
6850	const auto *type{pointer->GetType()};
6851	if (!type) {
6852	pointer->SetType(pointerType);
6853	} else if (*type != pointerType) {
6854	Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
6855	pointerName.source, pointerType.AsFortran());
6856	}
6857	const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
6858	DeclareObjectEntity(pointeeName);
6859	if (Symbol * pointee{pointeeName.symbol}) {
6860	if (!ConvertToObjectEntity(*pointee)) {
6861	return;
6862	}
6863	if (IsNamedConstant(*pointee)) {
6864	Say(pointeeName,
6865	"'%s' is a named constant and may not be a Cray pointee"_err_en_US);
6866	return;
6867	}
6868	if (pointee->test(Symbol::Flag::CrayPointer)) {
6869	Say(pointeeName,
6870	"'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
6871	} else if (pointee->test(Symbol::Flag::CrayPointee)) {
6872	Say(pointeeName, "'%s' was already declared as a Cray pointee"_err_en_US);
6873	} else {
6874	pointee->set(Symbol::Flag::CrayPointee);
6875	}
6876	if (const auto *pointeeType{pointee->GetType()}) {
6877	if (const auto *derived{pointeeType->AsDerived()}) {
6878	if (!IsSequenceOrBindCType(derived)) {
6879	context().Warn(common::LanguageFeature::NonSequenceCrayPointee,
6880	pointeeName.source,
6881	"Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US,
6882	pointeeName.source);
6883	}
6884	}
6885	}
6886	currScope().add_crayPointer(pointeeName.source, *pointer);
6887	}
6888	}
6889
6890	bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
6891	if (!CheckNotInBlock(stmt: "NAMELIST")) { // C1107
6892	return false;
6893	}
6894	const auto &groupName{std::get<parser::Name>(x.t)};
6895	auto *groupSymbol{FindInScope(groupName)};
6896	if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) {
6897	groupSymbol = &MakeSymbol(groupName, NamelistDetails{});
6898	groupSymbol->ReplaceName(groupName.source);
6899	}
6900	// Name resolution of group items is deferred to FinishNamelists()
6901	// so that host association is handled correctly.
6902	GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x);
6903	return false;
6904	}
6905
6906	void DeclarationVisitor::FinishNamelists() {
6907	if (auto *deferred{GetDeferredDeclarationState()}) {
6908	for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) {
6909	if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) {
6910	if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) {
6911	for (const auto &name : std::get<std::list<parser::Name>>(group->t)) {
6912	auto *symbol{FindSymbol(name)};
6913	if (!symbol) {
6914	symbol = &MakeSymbol(name, ObjectEntityDetails{});
6915	ApplyImplicitRules(*symbol);
6916	} else if (!ConvertToObjectEntity(symbol->GetUltimate())) {
6917	SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
6918	context().SetError(*groupSymbol);
6919	}
6920	symbol->GetUltimate().set(Symbol::Flag::InNamelist);
6921	details->add_object(*symbol);
6922	}
6923	}
6924	}
6925	}
6926	deferred->namelistGroups.clear();
6927	}
6928	}
6929
6930	bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {
6931	if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
6932	auto *symbol{FindSymbol(*name)};
6933	if (!symbol) {
6934	Say(*name, "Namelist group '%s' not found"_err_en_US);
6935	} else if (!symbol->GetUltimate().has<NamelistDetails>()) {
6936	SayWithDecl(
6937	*name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
6938	}
6939	}
6940	return true;
6941	}
6942
6943	bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {
6944	CheckNotInBlock(stmt: "COMMON"); // C1107
6945	return true;
6946	}
6947
6948	bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {
6949	BeginArraySpec();
6950	return true;
6951	}
6952
6953	void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {
6954	const auto &name{std::get<parser::Name>(x.t)};
6955	if (auto *symbol{FindSymbol(name)}) {
6956	symbol->set(Symbol::Flag::InCommonBlock);
6957	}
6958	DeclareObjectEntity(name);
6959	auto pair{specPartState_.commonBlockObjects.insert(name.source)};
6960	if (!pair.second) {
6961	const SourceName &prev{*pair.first};
6962	Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,
6963	"Previous occurrence of '%s' in a COMMON block"_en_US);
6964	}
6965	}
6966
6967	bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {
6968	// save equivalence sets to be processed after specification part
6969	if (CheckNotInBlock(stmt: "EQUIVALENCE")) { // C1107
6970	for (const std::list<parser::EquivalenceObject> &set : x.v) {
6971	specPartState_.equivalenceSets.push_back(&set);
6972	}
6973	}
6974	return false; // don't implicitly declare names yet
6975	}
6976
6977	void DeclarationVisitor::CheckEquivalenceSets() {
6978	EquivalenceSets equivSets{context()};
6979	inEquivalenceStmt_ = true;
6980	for (const auto *set : specPartState_.equivalenceSets) {
6981	const auto &source{set->front().v.value().source};
6982	if (set->size() <= 1) { // R871
6983	Say(source, "Equivalence set must have more than one object"_err_en_US);
6984	}
6985	for (const parser::EquivalenceObject &object : *set) {
6986	const auto &designator{object.v.value()};
6987	// The designator was not resolved when it was encountered, so do it now.
6988	// AnalyzeExpr causes array sections to be changed to substrings as needed
6989	Walk(designator);
6990	if (AnalyzeExpr(context(), designator)) {
6991	equivSets.AddToSet(designator);
6992	}
6993	}
6994	equivSets.FinishSet(source);
6995	}
6996	inEquivalenceStmt_ = false;
6997	for (auto &set : equivSets.sets()) {
6998	if (!set.empty()) {
6999	currScope().add_equivalenceSet(std::move(set));
7000	}
7001	}
7002	specPartState_.equivalenceSets.clear();
7003	}
7004
7005	bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {
7006	if (x.v.empty()) {
7007	specPartState_.saveInfo.saveAll = currStmtSource();
7008	currScope().set_hasSAVE();
7009	} else {
7010	for (const parser::SavedEntity &y : x.v) {
7011	auto kind{std::get<parser::SavedEntity::Kind>(y.t)};
7012	const auto &name{std::get<parser::Name>(y.t)};
7013	if (kind == parser::SavedEntity::Kind::Common) {
7014	MakeCommonBlockSymbol(name);
7015	AddSaveName(specPartState_.saveInfo.commons, name.source);
7016	} else {
7017	HandleAttributeStmt(Attr::SAVE, name);
7018	}
7019	}
7020	}
7021	return false;
7022	}
7023
7024	void DeclarationVisitor::CheckSaveStmts() {
7025	for (const SourceName &name : specPartState_.saveInfo.entities) {
7026	auto *symbol{FindInScope(name)};
7027	if (!symbol) {
7028	// error was reported
7029	} else if (specPartState_.saveInfo.saveAll) {
7030	// C889 - note that pgi, ifort, xlf do not enforce this constraint
7031	if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
7032	Say2(name,
7033	"Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US,
7034	*specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US)
7035	.set_languageFeature(common::LanguageFeature::RedundantAttribute);
7036	}
7037	} else if (!IsSaved(*symbol)) {
7038	SetExplicitAttr(*symbol, Attr::SAVE);
7039	}
7040	}
7041	for (const SourceName &name : specPartState_.saveInfo.commons) {
7042	if (auto *symbol{currScope().FindCommonBlock(name)}) {
7043	auto &objects{symbol->get<CommonBlockDetails>().objects()};
7044	if (objects.empty()) {
7045	if (currScope().kind() != Scope::Kind::BlockConstruct) {
7046	Say(name,
7047	"'%s' appears as a COMMON block in a SAVE statement but not in"
7048	" a COMMON statement"_err_en_US);
7049	} else { // C1108
7050	Say(name,
7051	"SAVE statement in BLOCK construct may not contain a"
7052	" common block name '%s'"_err_en_US);
7053	}
7054	} else {
7055	for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
7056	if (!IsSaved(*object)) {
7057	SetImplicitAttr(*object, Attr::SAVE);
7058	}
7059	}
7060	}
7061	}
7062	}
7063	specPartState_.saveInfo = {};
7064	}
7065
7066	// Record SAVEd names in specPartState_.saveInfo.entities.
7067	Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) {
7068	if (attrs.test(Attr::SAVE)) {
7069	AddSaveName(specPartState_.saveInfo.entities, name);
7070	}
7071	return attrs;
7072	}
7073
7074	// Record a name in a set of those to be saved.
7075	void DeclarationVisitor::AddSaveName(
7076	std::set<SourceName> &set, const SourceName &name) {
7077	auto pair{set.insert(x: name)};
7078	if (!pair.second &&
7079	context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
7080	Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US,
7081	*pair.first, "Previous specification of SAVE attribute"_en_US)
7082	.set_languageFeature(common::LanguageFeature::RedundantAttribute);
7083	}
7084	}
7085
7086	// Check types of common block objects, now that they are known.
7087	void DeclarationVisitor::CheckCommonBlocks() {
7088	// check for empty common blocks
7089	for (const auto &pair : currScope().commonBlocks()) {
7090	const auto &symbol{*pair.second};
7091	if (symbol.get<CommonBlockDetails>().objects().empty() &&
7092	symbol.attrs().test(Attr::BIND_C)) {
7093	Say(symbol.name(),
7094	"'%s' appears as a COMMON block in a BIND statement but not in"
7095	" a COMMON statement"_err_en_US);
7096	}
7097	}
7098	// check objects in common blocks
7099	for (const auto &name : specPartState_.commonBlockObjects) {
7100	const auto *symbol{currScope().FindSymbol(name)};
7101	if (!symbol) {
7102	continue;
7103	}
7104	const auto &attrs{symbol->attrs()};
7105	if (attrs.test(Attr::ALLOCATABLE)) {
7106	Say(name,
7107	"ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
7108	} else if (attrs.test(Attr::BIND_C)) {
7109	Say(name,
7110	"Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
7111	} else if (IsNamedConstant(*symbol)) {
7112	Say(name,
7113	"A named constant '%s' may not appear in a COMMON block"_err_en_US);
7114	} else if (IsDummy(*symbol)) {
7115	Say(name,
7116	"Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
7117	} else if (symbol->IsFuncResult()) {
7118	Say(name,
7119	"Function result '%s' may not appear in a COMMON block"_err_en_US);
7120	} else if (const DeclTypeSpec * type{symbol->GetType()}) {
7121	if (type->category() == DeclTypeSpec::ClassStar) {
7122	Say(name,
7123	"Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US);
7124	} else if (const auto *derived{type->AsDerived()}) {
7125	if (!IsSequenceOrBindCType(derived)) {
7126	Say(name,
7127	"Derived type '%s' in COMMON block must have the BIND or"
7128	" SEQUENCE attribute"_err_en_US);
7129	}
7130	UnorderedSymbolSet typeSet;
7131	CheckCommonBlockDerivedType(name, derived->typeSymbol(), typeSet);
7132	}
7133	}
7134	}
7135	specPartState_.commonBlockObjects = {};
7136	}
7137
7138	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
7139	return Resolve(name, currScope().MakeCommonBlock(name.source));
7140	}
7141	Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
7142	const std::optional<parser::Name> &name) {
7143	if (name) {
7144	return MakeCommonBlockSymbol(name: *name);
7145	} else {
7146	return MakeCommonBlockSymbol(name: parser::Name{});
7147	}
7148	}
7149
7150	bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
7151	return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
7152	}
7153
7154	// Check if this derived type can be in a COMMON block.
7155	void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name,
7156	const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) {
7157	if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) {
7158	return;
7159	}
7160	typeSet.emplace(typeSymbol);
7161	if (const auto *scope{typeSymbol.scope()}) {
7162	for (const auto &pair : *scope) {
7163	const Symbol &component{*pair.second};
7164	if (component.attrs().test(Attr::ALLOCATABLE)) {
7165	Say2(name,
7166	"Derived type variable '%s' may not appear in a COMMON block"
7167	" due to ALLOCATABLE component"_err_en_US,
7168	component.name(), "Component with ALLOCATABLE attribute"_en_US);
7169	return;
7170	}
7171	const auto *details{component.detailsIf<ObjectEntityDetails>()};
7172	if (component.test(Symbol::Flag::InDataStmt) ||
7173	(details && details->init())) {
7174	Say2(name,
7175	"Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
7176	component.name(), "Component with default initialization"_en_US);
7177	return;
7178	}
7179	if (details) {
7180	if (const auto *type{details->type()}) {
7181	if (const auto *derived{type->AsDerived()}) {
7182	const Symbol &derivedTypeSymbol{derived->typeSymbol()};
7183	CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet);
7184	}
7185	}
7186	}
7187	}
7188	}
7189	}
7190
7191	bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
7192	const parser::Name &name) {
7193	if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
7194	name.source.ToString())}) {
7195	// Unrestricted specific intrinsic function names (e.g., "cos")
7196	// are acceptable as procedure interfaces. The presence of the
7197	// INTRINSIC flag will cause this symbol to have a complete interface
7198	// recreated for it later on demand, but capturing its result type here
7199	// will make GetType() return a correct result without having to
7200	// probe the intrinsics table again.
7201	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
7202	SetImplicitAttr(symbol, Attr::INTRINSIC);
7203	CHECK(interface->functionResult.has_value());
7204	evaluate::DynamicType dyType{
7205	DEREF(interface->functionResult->GetTypeAndShape()).type()};
7206	CHECK(common::IsNumericTypeCategory(dyType.category()));
7207	const DeclTypeSpec &typeSpec{
7208	MakeNumericType(dyType.category(), dyType.kind())};
7209	ProcEntityDetails details;
7210	details.set_type(typeSpec);
7211	symbol.set_details(std::move(details));
7212	symbol.set(Symbol::Flag::Function);
7213	if (interface->IsElemental()) {
7214	SetExplicitAttr(symbol, Attr::ELEMENTAL);
7215	}
7216	if (interface->IsPure()) {
7217	SetExplicitAttr(symbol, Attr::PURE);
7218	}
7219	Resolve(name, symbol);
7220	return true;
7221	} else {
7222	return false;
7223	}
7224	}
7225
7226	// Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED
7227	bool DeclarationVisitor::PassesSharedLocalityChecks(
7228	const parser::Name &name, Symbol &symbol) {
7229	if (!IsVariableName(symbol)) {
7230	SayLocalMustBeVariable(name, symbol); // C1124
7231	return false;
7232	}
7233	if (symbol.owner() == currScope()) { // C1125 and C1126
7234	SayAlreadyDeclared(name, symbol);
7235	return false;
7236	}
7237	return true;
7238	}
7239
7240	// Checks for locality-specs LOCAL, LOCAL_INIT, and REDUCE
7241	bool DeclarationVisitor::PassesLocalityChecks(
7242	const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
7243	bool isReduce{flag == Symbol::Flag::LocalityReduce};
7244	const char *specName{
7245	flag == Symbol::Flag::LocalityLocalInit ? "LOCAL_INIT" : "LOCAL"};
7246	if (IsAllocatable(symbol) && !isReduce) { // F'2023 C1130
7247	SayWithDecl(name, symbol,
7248	"ALLOCATABLE variable '%s' not allowed in a %s locality-spec"_err_en_US,
7249	specName);
7250	return false;
7251	}
7252	if (IsOptional(symbol)) { // F'2023 C1130-C1131
7253	SayWithDecl(name, symbol,
7254	"OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
7255	return false;
7256	}
7257	if (IsIntentIn(symbol)) { // F'2023 C1130-C1131
7258	SayWithDecl(name, symbol,
7259	"INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
7260	return false;
7261	}
7262	if (IsFinalizable(symbol) && !isReduce) { // F'2023 C1130
7263	SayWithDecl(name, symbol,
7264	"Finalizable variable '%s' not allowed in a %s locality-spec"_err_en_US,
7265	specName);
7266	return false;
7267	}
7268	if (evaluate::IsCoarray(symbol) && !isReduce) { // F'2023 C1130
7269	SayWithDecl(name, symbol,
7270	"Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);
7271	return false;
7272	}
7273	if (const DeclTypeSpec * type{symbol.GetType()}) {
7274	if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
7275	!isReduce) { // F'2023 C1130
7276	SayWithDecl(name, symbol,
7277	"Nonpointer polymorphic argument '%s' not allowed in a %s locality-spec"_err_en_US,
7278	specName);
7279	return false;
7280	}
7281	if (const DerivedTypeSpec *derived{type->AsDerived()}) { // F'2023 C1130
7282	if (auto bad{FindAllocatableUltimateComponent(*derived)}) {
7283	SayWithDecl(name, symbol,
7284	"Derived type variable '%s' with ultimate ALLOCATABLE component '%s' not allowed in a %s locality-spec"_err_en_US,
7285	bad.BuildResultDesignatorName(), specName);
7286	return false;
7287	}
7288	}
7289	}
7290	if (symbol.attrs().test(Attr::ASYNCHRONOUS) && isReduce) { // F'2023 C1131
7291	SayWithDecl(name, symbol,
7292	"ASYNCHRONOUS variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);
7293	return false;
7294	}
7295	if (symbol.attrs().test(Attr::VOLATILE) && isReduce) { // F'2023 C1131
7296	SayWithDecl(name, symbol,
7297	"VOLATILE variable '%s' not allowed in a REDUCE locality-spec"_err_en_US);
7298	return false;
7299	}
7300	if (IsAssumedSizeArray(symbol)) { // F'2023 C1130-C1131
7301	SayWithDecl(name, symbol,
7302	"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
7303	return false;
7304	}
7305	if (std::optional<Message> whyNot{WhyNotDefinable(
7306	name.source, currScope(), DefinabilityFlags{}, symbol)}) {
7307	SayWithReason(name, symbol,
7308	"'%s' may not appear in a locality-spec because it is not definable"_err_en_US,
7309	std::move(whyNot->set_severity(parser::Severity::Because)));
7310	return false;
7311	}
7312	return PassesSharedLocalityChecks(name, symbol);
7313	}
7314
7315	Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
7316	const parser::Name &name) {
7317	Symbol *prev{FindSymbol(name)};
7318	if (!prev) {
7319	// Declare the name as an object in the enclosing scope so that
7320	// the name can't be repurposed there later as something else.
7321	prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
7322	ConvertToObjectEntity(*prev);
7323	ApplyImplicitRules(*prev);
7324	}
7325	return *prev;
7326	}
7327
7328	void DeclarationVisitor::DeclareLocalEntity(
7329	const parser::Name &name, Symbol::Flag flag) {
7330	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
7331	if (PassesLocalityChecks(name, prev, flag)) {
7332	if (auto *symbol{&MakeHostAssocSymbol(name, prev)}) {
7333	symbol->set(flag);
7334	}
7335	}
7336	}
7337
7338	Symbol *DeclarationVisitor::DeclareStatementEntity(
7339	const parser::DoVariable &doVar,
7340	const std::optional<parser::IntegerTypeSpec> &type) {
7341	const parser::Name &name{doVar.thing.thing};
7342	const DeclTypeSpec *declTypeSpec{nullptr};
7343	if (auto *prev{FindSymbol(name)}) {
7344	if (prev->owner() == currScope()) {
7345	SayAlreadyDeclared(name, *prev);
7346	return nullptr;
7347	}
7348	name.symbol = nullptr;
7349	// F'2023 19.4 p5 ambiguous rule about outer declarations
7350	declTypeSpec = prev->GetType();
7351	}
7352	Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
7353	if (!symbol.has<ObjectEntityDetails>()) {
7354	return nullptr; // error was reported in DeclareEntity
7355	}
7356	if (type) {
7357	declTypeSpec = ProcessTypeSpec(*type);
7358	}
7359	if (declTypeSpec) {
7360	// Subtlety: Don't let a "*length" specifier (if any is pending) affect the
7361	// declaration of this implied DO loop control variable.
7362	auto restorer{
7363	common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})};
7364	SetType(name, *declTypeSpec);
7365	} else {
7366	ApplyImplicitRules(symbol);
7367	}
7368	return Resolve(name, &symbol);
7369	}
7370
7371	// Set the type of an entity or report an error.
7372	void DeclarationVisitor::SetType(
7373	const parser::Name &name, const DeclTypeSpec &type) {
7374	CHECK(name.symbol);
7375	auto &symbol{*name.symbol};
7376	if (charInfo_.length) { // Declaration has "*length" (R723)
7377	auto length{std::move(*charInfo_.length)};
7378	charInfo_.length.reset();
7379	if (type.category() == DeclTypeSpec::Character) {
7380	auto kind{type.characterTypeSpec().kind()};
7381	// Recurse with correct type.
7382	SetType(name,
7383	currScope().MakeCharacterType(std::move(length), std::move(kind)));
7384	return;
7385	} else { // C753
7386	Say(name,
7387	"A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
7388	}
7389	}
7390	if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
7391	if (proc->procInterface()) {
7392	Say(name,
7393	"'%s' has an explicit interface and may not also have a type"_err_en_US);
7394	context().SetError(symbol);
7395	return;
7396	}
7397	}
7398	auto *prevType{symbol.GetType()};
7399	if (!prevType) {
7400	if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType()) {
7401	context().Warn(common::LanguageFeature::ForwardRefImplicitNoneData,
7402	name.source,
7403	"'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US,
7404	name.source);
7405	}
7406	symbol.SetType(type);
7407	} else if (symbol.has<UseDetails>()) {
7408	// error recovery case, redeclaration of use-associated name
7409	} else if (HadForwardRef(symbol: symbol)) {
7410	// error recovery after use of host-associated name
7411	} else if (!symbol.test(Symbol::Flag::Implicit)) {
7412	SayWithDecl(
7413	name, symbol, "The type of '%s' has already been declared"_err_en_US);
7414	context().SetError(symbol);
7415	} else if (type != *prevType) {
7416	SayWithDecl(name, symbol,
7417	"The type of '%s' has already been implicitly declared"_err_en_US);
7418	context().SetError(symbol);
7419	} else {
7420	symbol.set(Symbol::Flag::Implicit, false);
7421	}
7422	}
7423
7424	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
7425	const parser::Name &name) {
7426	Scope &outer{NonDerivedTypeScope()};
7427	Symbol *symbol{FindSymbol(outer, name)};
7428	Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
7429	auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
7430	if (generic) {
7431	if (Symbol * genDT{generic->derivedType()}) {
7432	symbol = genDT;
7433	generic = nullptr;
7434	}
7435	}
7436	if (!symbol || symbol->has<UnknownDetails>() ||
7437	(generic && &ultimate->owner() == &outer)) {
7438	if (allowForwardReferenceToDerivedType()) {
7439	if (!symbol) {
7440	symbol = &MakeSymbol(outer, name.source, Attrs{});
7441	Resolve(name, *symbol);
7442	} else if (generic) {
7443	// forward ref to type with later homonymous generic
7444	symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
7445	generic->set_derivedType(*symbol);
7446	name.symbol = symbol;
7447	}
7448	DerivedTypeDetails details;
7449	details.set_isForwardReferenced(true);
7450	symbol->set_details(std::move(details));
7451	} else { // C732
7452	Say(name, "Derived type '%s' not found"_err_en_US);
7453	return std::nullopt;
7454	}
7455	} else if (&DEREF(symbol).owner() != &outer &&
7456	!ultimate->has<GenericDetails>()) {
7457	// Prevent a later declaration in this scope of a host-associated
7458	// type name.
7459	outer.add_importName(name.source);
7460	}
7461	if (CheckUseError(name)) {
7462	return std::nullopt;
7463	} else if (symbol->GetUltimate().has<DerivedTypeDetails>()) {
7464	return DerivedTypeSpec{name.source, *symbol};
7465	} else {
7466	Say(name, "'%s' is not a derived type"_err_en_US);
7467	return std::nullopt;
7468	}
7469	}
7470
7471	std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
7472	const parser::Name &typeName, const parser::Name *extendsName) {
7473	if (extendsName) {
7474	if (typeName.source == extendsName->source) {
7475	Say(extendsName->source,
7476	"Derived type '%s' cannot extend itself"_err_en_US);
7477	} else if (auto dtSpec{ResolveDerivedType(*extendsName)}) {
7478	if (!dtSpec->IsForwardReferenced()) {
7479	return dtSpec;
7480	}
7481	Say(typeName.source,
7482	"Derived type '%s' cannot extend type '%s' that has not yet been defined"_err_en_US,
7483	typeName.source, extendsName->source);
7484	}
7485	}
7486	return std::nullopt;
7487	}
7488
7489	Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
7490	// The symbol is checked later by CheckExplicitInterface() and
7491	// CheckBindings(). It can be a forward reference.
7492	if (!NameIsKnownOrIntrinsic(name)) {
7493	Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
7494	Resolve(name, symbol);
7495	}
7496	return name.symbol;
7497	}
7498
7499	void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
7500	if (const Symbol * symbol{name.symbol}) {
7501	const Symbol &ultimate{symbol->GetUltimate()};
7502	if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
7503	!BypassGeneric(ultimate).HasExplicitInterface()) {
7504	Say(name,
7505	"'%s' must be an abstract interface or a procedure with an explicit interface"_err_en_US,
7506	symbol->name());
7507	}
7508	}
7509	}
7510
7511	// Create a symbol for a type parameter, component, or procedure binding in
7512	// the current derived type scope. Return false on error.
7513	Symbol *DeclarationVisitor::MakeTypeSymbol(
7514	const parser::Name &name, Details &&details) {
7515	return Resolve(name, MakeTypeSymbol(name.source, std::move(details)));
7516	}
7517	Symbol *DeclarationVisitor::MakeTypeSymbol(
7518	const SourceName &name, Details &&details) {
7519	Scope &derivedType{currScope()};
7520	CHECK(derivedType.IsDerivedType());
7521	if (auto *symbol{FindInScope(derivedType, name)}) { // C742
7522	Say2(name,
7523	"Type parameter, component, or procedure binding '%s'"
7524	" already defined in this type"_err_en_US,
7525	*symbol, "Previous definition of '%s'"_en_US);
7526	return nullptr;
7527	} else {
7528	auto attrs{GetAttrs()};
7529	// Apply binding-private-stmt if present and this is a procedure binding
7530	if (derivedTypeInfo_.privateBindings &&
7531	!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
7532	std::holds_alternative<ProcBindingDetails>(details)) {
7533	attrs.set(Attr::PRIVATE);
7534	}
7535	Symbol &result{MakeSymbol(name, attrs, std::move(details))};
7536	SetCUDADataAttr(name, result, cudaDataAttr());
7537	return &result;
7538	}
7539	}
7540
7541	// Return true if it is ok to declare this component in the current scope.
7542	// Otherwise, emit an error and return false.
7543	bool DeclarationVisitor::OkToAddComponent(
7544	const parser::Name &name, const Symbol *extends) {
7545	for (const Scope *scope{&currScope()}; scope;) {
7546	CHECK(scope->IsDerivedType());
7547	if (auto *prev{FindInScope(*scope, name.source)}) {
7548	std::optional<parser::MessageFixedText> msg;
7549	std::optional<common::UsageWarning> warning;
7550	if (context().HasError(*prev)) { // don't pile on
7551	} else if (CheckAccessibleSymbol(currScope(), *prev)) {
7552	// inaccessible component -- redeclaration is ok
7553	if (extends) {
7554	// The parent type has a component of same name, but it remains
7555	// extensible outside its module since that component is PRIVATE.
7556	} else if (context().ShouldWarn(
7557	common::UsageWarning::RedeclaredInaccessibleComponent)) {
7558	msg =
7559	"Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US;
7560	warning = common::UsageWarning::RedeclaredInaccessibleComponent;
7561	}
7562	} else if (extends) {
7563	msg =
7564	"Type cannot be extended as it has a component named '%s'"_err_en_US;
7565	} else if (prev->test(Symbol::Flag::ParentComp)) {
7566	msg =
7567	"'%s' is a parent type of this type and so cannot be a component"_err_en_US;
7568	} else if (scope == &currScope()) {
7569	msg =
7570	"Component '%s' is already declared in this derived type"_err_en_US;
7571	} else {
7572	msg =
7573	"Component '%s' is already declared in a parent of this derived type"_err_en_US;
7574	}
7575	if (msg) {
7576	auto &said{Say2(name, std::move(*msg), *prev,
7577	"Previous declaration of '%s'"_en_US)};
7578	if (msg->severity() == parser::Severity::Error) {
7579	Resolve(name, *prev);
7580	return false;
7581	}
7582	if (warning) {
7583	said.set_usageWarning(*warning);
7584	}
7585	}
7586	}
7587	if (scope == &currScope() && extends) {
7588	// The parent component has not yet been added to the scope.
7589	scope = extends->scope();
7590	} else {
7591	scope = scope->GetDerivedTypeParent();
7592	}
7593	}
7594	return true;
7595	}
7596
7597	ParamValue DeclarationVisitor::GetParamValue(
7598	const parser::TypeParamValue &x, common::TypeParamAttr attr) {
7599	return common::visit(
7600	common::visitors{
7601	[=](const parser::ScalarIntExpr &x) { // C704
7602	return ParamValue{EvaluateIntExpr(x), attr};
7603	},
7604	[=](const parser::Star &) { return ParamValue::Assumed(attr); },
7605	[=](const parser::TypeParamValue::Deferred &) {
7606	return ParamValue::Deferred(attr);
7607	},
7608	},
7609	x.u);
7610	}
7611
7612	// ConstructVisitor implementation
7613
7614	void ConstructVisitor::ResolveIndexName(
7615	const parser::ConcurrentControl &control) {
7616	const parser::Name &name{std::get<parser::Name>(control.t)};
7617	auto *prev{FindSymbol(name)};
7618	if (prev) {
7619	if (prev->owner() == currScope()) {
7620	SayAlreadyDeclared(name, *prev);
7621	return;
7622	} else if (prev->owner().kind() == Scope::Kind::Forall &&
7623	context().ShouldWarn(
7624	common::LanguageFeature::OddIndexVariableRestrictions)) {
7625	SayWithDecl(name, *prev,
7626	"Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US)
7627	.set_languageFeature(
7628	common::LanguageFeature::OddIndexVariableRestrictions);
7629	}
7630	name.symbol = nullptr;
7631	}
7632	auto &symbol{DeclareObjectEntity(name)};
7633	if (symbol.GetType()) {
7634	// type came from explicit type-spec
7635	} else if (!prev) {
7636	ApplyImplicitRules(symbol&: symbol);
7637	} else {
7638	// Odd rules in F'2023 19.4 paras 6 & 8.
7639	Symbol &prevRoot{prev->GetUltimate()};
7640	if (const auto *type{prevRoot.GetType()}) {
7641	symbol.SetType(*type);
7642	} else {
7643	ApplyImplicitRules(symbol&: symbol);
7644	}
7645	if (prevRoot.has<ObjectEntityDetails>() ||
7646	ConvertToObjectEntity(prevRoot)) {
7647	if (prevRoot.IsObjectArray() &&
7648	context().ShouldWarn(
7649	common::LanguageFeature::OddIndexVariableRestrictions)) {
7650	SayWithDecl(name, *prev,
7651	"Index variable '%s' should be scalar in the enclosing scope"_port_en_US)
7652	.set_languageFeature(
7653	common::LanguageFeature::OddIndexVariableRestrictions);
7654	}
7655	} else if (!prevRoot.has<CommonBlockDetails>() &&
7656	context().ShouldWarn(
7657	common::LanguageFeature::OddIndexVariableRestrictions)) {
7658	SayWithDecl(name, *prev,
7659	"Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US)
7660	.set_languageFeature(
7661	common::LanguageFeature::OddIndexVariableRestrictions);
7662	}
7663	}
7664	EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
7665	}
7666
7667	// We need to make sure that all of the index-names get declared before the
7668	// expressions in the loop control are evaluated so that references to the
7669	// index-names in the expressions are correctly detected.
7670	bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
7671	BeginDeclTypeSpec();
7672	Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t));
7673	const auto &controls{
7674	std::get<std::list<parser::ConcurrentControl>>(header.t)};
7675	for (const auto &control : controls) {
7676	ResolveIndexName(control);
7677	}
7678	Walk(controls);
7679	Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t));
7680	EndDeclTypeSpec();
7681	return false;
7682	}
7683
7684	bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
7685	for (auto &name : x.v) {
7686	DeclareLocalEntity(name, Symbol::Flag::LocalityLocal);
7687	}
7688	return false;
7689	}
7690
7691	bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
7692	for (auto &name : x.v) {
7693	DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit);
7694	}
7695	return false;
7696	}
7697
7698	bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
7699	for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
7700	DeclareLocalEntity(name, Symbol::Flag::LocalityReduce);
7701	}
7702	return false;
7703	}
7704
7705	bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
7706	for (const auto &name : x.v) {
7707	if (!FindSymbol(name)) {
7708	context().Warn(common::UsageWarning::ImplicitShared, name.source,
7709	"Variable '%s' with SHARED locality implicitly declared"_warn_en_US,
7710	name.source);
7711	}
7712	Symbol &prev{FindOrDeclareEnclosingEntity(name)};
7713	if (PassesSharedLocalityChecks(name, prev)) {
7714	MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared);
7715	}
7716	}
7717	return false;
7718	}
7719
7720	bool ConstructVisitor::Pre(const parser::AcSpec &x) {
7721	ProcessTypeSpec(x.type);
7722	Walk(x.values);
7723	return false;
7724	}
7725
7726	// Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the
7727	// enclosing ac-implied-do
7728	bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
7729	auto &values{std::get<std::list<parser::AcValue>>(x.t)};
7730	auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
7731	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
7732	auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
7733	// F'2018 has the scope of the implied DO variable covering the entire
7734	// implied DO production (19.4(5)), which seems wrong in cases where the name
7735	// of the implied DO variable appears in one of the bound expressions. Thus
7736	// this extension, which shrinks the scope of the variable to exclude the
7737	// expressions in the bounds.
7738	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
7739	Walk(bounds.lower);
7740	Walk(bounds.upper);
7741	Walk(bounds.step);
7742	EndCheckOnIndexUseInOwnBounds(restore: restore);
7743	PushScope(Scope::Kind::ImpliedDos, nullptr);
7744	DeclareStatementEntity(bounds.name, type);
7745	Walk(values);
7746	PopScope();
7747	return false;
7748	}
7749
7750	bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
7751	auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
7752	auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
7753	auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
7754	// See comment in Pre(AcImpliedDo) above.
7755	auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
7756	Walk(bounds.lower);
7757	Walk(bounds.upper);
7758	Walk(bounds.step);
7759	EndCheckOnIndexUseInOwnBounds(restore: restore);
7760	PushScope(Scope::Kind::ImpliedDos, nullptr);
7761	DeclareStatementEntity(bounds.name, type);
7762	Walk(objects);
7763	PopScope();
7764	return false;
7765	}
7766
7767	// Sets InDataStmt flag on a variable (or misidentified function) in a DATA
7768	// statement so that the predicate IsInitialized() will be true
7769	// during semantic analysis before the symbol's initializer is constructed.
7770	bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {
7771	common::visit(
7772	common::visitors{
7773	[&](const parser::Scalar<Indirection<parser::Designator>> &y) {
7774	Walk(y.thing.value());
7775	const parser::Name &first{parser::GetFirstName(y.thing.value())};
7776	if (first.symbol) {
7777	first.symbol->set(Symbol::Flag::InDataStmt);
7778	}
7779	},
7780	[&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); },
7781	},
7782	x.u);
7783	return false;
7784	}
7785
7786	bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
7787	// Subtle: DATA statements may appear in both the specification and
7788	// execution parts, but should be treated as if in the execution part
7789	// for purposes of implicit variable declaration vs. host association.
7790	// When a name first appears as an object in a DATA statement, it should
7791	// be implicitly declared locally as if it had been assigned.
7792	auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
7793	common::visit(
7794	common::visitors{
7795	[&](const Indirection<parser::Variable> &y) {
7796	auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
7797	Walk(y.value());
7798	const parser::Name &first{parser::GetFirstName(y.value())};
7799	if (first.symbol) {
7800	first.symbol->set(Symbol::Flag::InDataStmt);
7801	}
7802	},
7803	[&](const parser::DataImpliedDo &y) {
7804	// Don't push scope here, since it's done when visiting
7805	// DataImpliedDo.
7806	Walk(y);
7807	},
7808	},
7809	x.u);
7810	return false;
7811	}
7812
7813	bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
7814	const auto &data{std::get<parser::DataStmtConstant>(x.t)};
7815	auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
7816	if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
7817	if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {
7818	if (const Symbol * symbol{FindSymbol(*name)};
7819	symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {
7820	mutableData.u = elem->ConvertToStructureConstructor(
7821	DerivedTypeSpec{name->source, *symbol});
7822	}
7823	}
7824	}
7825	return true;
7826	}
7827
7828	bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
7829	if (x.IsDoConcurrent()) {
7830	// The new scope has Kind::Forall for index variable name conflict
7831	// detection with nested FORALL/DO CONCURRENT constructs in
7832	// ResolveIndexName().
7833	PushScope(Scope::Kind::Forall, nullptr);
7834	}
7835	return true;
7836	}
7837	void ConstructVisitor::Post(const parser::DoConstruct &x) {
7838	if (x.IsDoConcurrent()) {
7839	PopScope();
7840	}
7841	}
7842
7843	bool ConstructVisitor::Pre(const parser::ForallConstruct &) {
7844	PushScope(Scope::Kind::Forall, nullptr);
7845	return true;
7846	}
7847	void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }
7848	bool ConstructVisitor::Pre(const parser::ForallStmt &) {
7849	PushScope(Scope::Kind::Forall, nullptr);
7850	return true;
7851	}
7852	void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }
7853
7854	bool ConstructVisitor::Pre(const parser::BlockConstruct &x) {
7855	const auto &[blockStmt, specPart, execPart, endBlockStmt] = x.t;
7856	Walk(blockStmt);
7857	CheckDef(blockStmt.statement.v);
7858	PushScope(Scope::Kind::BlockConstruct, nullptr);
7859	Walk(specPart);
7860	HandleImpliedAsynchronousInScope(execPart);
7861	Walk(execPart);
7862	Walk(endBlockStmt);
7863	PopScope();
7864	CheckRef(endBlockStmt.statement.v);
7865	return false;
7866	}
7867
7868	void ConstructVisitor::Post(const parser::Selector &x) {
7869	GetCurrentAssociation().selector = ResolveSelector(x);
7870	}
7871
7872	void ConstructVisitor::Post(const parser::AssociateStmt &x) {
7873	CheckDef(x.t);
7874	PushScope(Scope::Kind::OtherConstruct, nullptr);
7875	const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()};
7876	for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) {
7877	SetCurrentAssociation(nthLastAssoc);
7878	if (auto *symbol{MakeAssocEntity()}) {
7879	const MaybeExpr &expr{GetCurrentAssociation().selector.expr};
7880	if (ExtractCoarrayRef(expr)) { // C1103
7881	Say("Selector must not be a coindexed object"_err_en_US);
7882	}
7883	if (evaluate::IsAssumedRank(expr)) {
7884	Say("Selector must not be assumed-rank"_err_en_US);
7885	}
7886	SetTypeFromAssociation(*symbol);
7887	SetAttrsFromAssociation(*symbol);
7888	}
7889	}
7890	PopAssociation(count: assocCount);
7891	}
7892
7893	void ConstructVisitor::Post(const parser::EndAssociateStmt &x) {
7894	PopScope();
7895	CheckRef(x.v);
7896	}
7897
7898	bool ConstructVisitor::Pre(const parser::Association &x) {
7899	PushAssociation();
7900	const auto &name{std::get<parser::Name>(x.t)};
7901	GetCurrentAssociation().name = &name;
7902	return true;
7903	}
7904
7905	bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) {
7906	CheckDef(x.t);
7907	PushScope(Scope::Kind::OtherConstruct, nullptr);
7908	PushAssociation();
7909	return true;
7910	}
7911
7912	void ConstructVisitor::Post(const parser::CoarrayAssociation &x) {
7913	const auto &decl{std::get<parser::CodimensionDecl>(x.t)};
7914	const auto &name{std::get<parser::Name>(decl.t)};
7915	if (auto *symbol{FindInScope(name)}) {
7916	const auto &selector{std::get<parser::Selector>(x.t)};
7917	if (auto sel{ResolveSelector(selector)}) {
7918	const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)};
7919	if (!whole || whole->Corank() == 0) {
7920	Say(sel.source, // C1116
7921	"Selector in coarray association must name a coarray"_err_en_US);
7922	} else if (auto dynType{sel.expr->GetType()}) {
7923	if (!symbol->GetType()) {
7924	symbol->SetType(ToDeclTypeSpec(std::move(*dynType)));
7925	}
7926	}
7927	}
7928	}
7929	}
7930
7931	void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) {
7932	PopAssociation();
7933	PopScope();
7934	CheckRef(x.t);
7935	}
7936
7937	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) {
7938	PushAssociation();
7939	return true;
7940	}
7941
7942	void ConstructVisitor::Post(const parser::SelectTypeConstruct &) {
7943	PopAssociation();
7944	}
7945
7946	void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
7947	auto &association{GetCurrentAssociation()};
7948	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7949	// This isn't a name in the current scope, it is in each TypeGuardStmt
7950	MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName);
7951	association.name = &*name;
7952	if (ExtractCoarrayRef(association.selector.expr)) { // C1103
7953	Say("Selector must not be a coindexed object"_err_en_US);
7954	}
7955	if (association.selector.expr) {
7956	auto exprType{association.selector.expr->GetType()};
7957	if (exprType && !exprType->IsPolymorphic()) { // C1159
7958	Say(association.selector.source,
7959	"Selector '%s' in SELECT TYPE statement must be "
7960	"polymorphic"_err_en_US);
7961	}
7962	}
7963	} else {
7964	if (const Symbol *
7965	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
7966	ConvertToObjectEntity(const_cast<Symbol &>(*whole));
7967	if (!IsVariableName(*whole)) {
7968	Say(association.selector.source, // C901
7969	"Selector is not a variable"_err_en_US);
7970	association = {};
7971	}
7972	if (const DeclTypeSpec * type{whole->GetType()}) {
7973	if (!type->IsPolymorphic()) { // C1159
7974	Say(association.selector.source,
7975	"Selector '%s' in SELECT TYPE statement must be "
7976	"polymorphic"_err_en_US);
7977	}
7978	}
7979	} else {
7980	Say(association.selector.source, // C1157
7981	"Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
7982	association = {};
7983	}
7984	}
7985	}
7986
7987	void ConstructVisitor::Post(const parser::SelectRankStmt &x) {
7988	auto &association{GetCurrentAssociation()};
7989	if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
7990	// This isn't a name in the current scope, it is in each SelectRankCaseStmt
7991	MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName);
7992	association.name = &*name;
7993	}
7994	}
7995
7996	bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {
7997	PushScope(Scope::Kind::OtherConstruct, nullptr);
7998	return true;
7999	}
8000	void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {
8001	PopScope();
8002	}
8003
8004	bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) {
8005	PushScope(Scope::Kind::OtherConstruct, nullptr);
8006	return true;
8007	}
8008	void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) {
8009	PopScope();
8010	}
8011
8012	bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) {
8013	if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) {
8014	// CLASS IS (t)
8015	SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived);
8016	}
8017	return true;
8018	}
8019
8020	void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
8021	if (auto *symbol{MakeAssocEntity()}) {
8022	if (std::holds_alternative<parser::Default>(x.u)) {
8023	SetTypeFromAssociation(*symbol);
8024	} else if (const auto *type{GetDeclTypeSpec()}) {
8025	symbol->SetType(*type);
8026	symbol->get<AssocEntityDetails>().set_isTypeGuard();
8027	}
8028	SetAttrsFromAssociation(*symbol);
8029	}
8030	}
8031
8032	void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
8033	if (auto *symbol{MakeAssocEntity()}) {
8034	SetTypeFromAssociation(*symbol);
8035	auto &details{symbol->get<AssocEntityDetails>()};
8036	// Don't call SetAttrsFromAssociation() for SELECT RANK.
8037	Attrs selectorAttrs{
8038	evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
8039	Attrs attrsToKeep{Attr::ASYNCHRONOUS, Attr::TARGET, Attr::VOLATILE};
8040	if (const auto *rankValue{
8041	std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
8042	// RANK(n)
8043	if (auto expr{EvaluateIntExpr(*rankValue)}) {
8044	if (auto val{evaluate::ToInt64(*expr)}) {
8045	details.set_rank(*val);
8046	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
8047	} else {
8048	Say("RANK() expression must be constant"_err_en_US);
8049	}
8050	}
8051	} else if (std::holds_alternative<parser::Star>(x.u)) {
8052	// RANK(*): assumed-size
8053	details.set_IsAssumedSize();
8054	} else {
8055	CHECK(std::holds_alternative<parser::Default>(x.u));
8056	// RANK DEFAULT: assumed-rank
8057	details.set_IsAssumedRank();
8058	attrsToKeep |= Attrs{Attr::ALLOCATABLE, Attr::POINTER};
8059	}
8060	symbol->attrs() |= selectorAttrs & attrsToKeep;
8061	}
8062	}
8063
8064	bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
8065	PushAssociation();
8066	return true;
8067	}
8068
8069	void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
8070	PopAssociation();
8071	}
8072
8073	bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
8074	if (x && !x->symbol) {
8075	// Construct names are not scoped by BLOCK in the standard, but many,
8076	// but not all, compilers do treat them as if they were so scoped.
8077	if (Symbol * inner{FindInScope(currScope(), *x)}) {
8078	SayAlreadyDeclared(*x, *inner);
8079	} else {
8080	if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {
8081	if (Symbol *
8082	other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) {
8083	SayWithDecl(*x, *other,
8084	"The construct name '%s' should be distinct at the subprogram level"_port_en_US)
8085	.set_languageFeature(common::LanguageFeature::BenignNameClash);
8086	}
8087	}
8088	MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
8089	}
8090	}
8091	return true;
8092	}
8093
8094	void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
8095	if (x) {
8096	// Just add an occurrence of this name; checking is done in ValidateLabels
8097	FindSymbol(*x);
8098	}
8099	}
8100
8101	// Make a symbol for the associating entity of the current association.
8102	Symbol *ConstructVisitor::MakeAssocEntity() {
8103	Symbol *symbol{nullptr};
8104	auto &association{GetCurrentAssociation()};
8105	if (association.name) {
8106	symbol = &MakeSymbol(*association.name, UnknownDetails{});
8107	if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) {
8108	Say(*association.name, // C1102
8109	"The associate name '%s' is already used in this associate statement"_err_en_US);
8110	return nullptr;
8111	}
8112	} else if (const Symbol *
8113	whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
8114	symbol = &MakeSymbol(whole->name());
8115	} else {
8116	return nullptr;
8117	}
8118	if (auto &expr{association.selector.expr}) {
8119	symbol->set_details(AssocEntityDetails{common::Clone(*expr)});
8120	} else {
8121	symbol->set_details(AssocEntityDetails{});
8122	}
8123	return symbol;
8124	}
8125
8126	// Set the type of symbol based on the current association selector.
8127	void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) {
8128	auto &details{symbol.get<AssocEntityDetails>()};
8129	const MaybeExpr *pexpr{&details.expr()};
8130	if (!*pexpr) {
8131	pexpr = &GetCurrentAssociation().selector.expr;
8132	}
8133	if (*pexpr) {
8134	const SomeExpr &expr{**pexpr};
8135	if (std::optional<evaluate::DynamicType> type{expr.GetType()}) {
8136	if (const auto *charExpr{
8137	evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>(
8138	expr)}) {
8139	symbol.SetType(ToDeclTypeSpec(std::move(*type),
8140	FoldExpr(common::visit(
8141	[](const auto &kindChar) { return kindChar.LEN(); },
8142	charExpr->u))));
8143	} else {
8144	symbol.SetType(ToDeclTypeSpec(std::move(*type)));
8145	}
8146	} else {
8147	// BOZ literals, procedure designators, &c. are not acceptable
8148	Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US);
8149	}
8150	}
8151	}
8152
8153	// If current selector is a variable, set some of its attributes on symbol.
8154	// For ASSOCIATE, CHANGE TEAM, and SELECT TYPE only; not SELECT RANK.
8155	void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) {
8156	Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)};
8157	symbol.attrs() |=
8158	attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE};
8159	if (attrs.test(Attr::POINTER)) {
8160	SetImplicitAttr(symbol, Attr::TARGET);
8161	}
8162	}
8163
8164	ConstructVisitor::Selector ConstructVisitor::ResolveSelector(
8165	const parser::Selector &x) {
8166	return common::visit(common::visitors{
8167	[&](const parser::Expr &expr) {
8168	return Selector{expr.source, EvaluateExpr(x)};
8169	},
8170	[&](const parser::Variable &var) {
8171	return Selector{var.GetSource(), EvaluateExpr(x)};
8172	},
8173	},
8174	x.u);
8175	}
8176
8177	// Set the current association to the nth to the last association on the
8178	// association stack. The top of the stack is at n = 1. This allows access
8179	// to the interior of a list of associations at the top of the stack.
8180	void ConstructVisitor::SetCurrentAssociation(std::size_t n) {
8181	CHECK(n > 0 && n <= associationStack_.size());
8182	currentAssociation_ = &associationStack_[associationStack_.size() - n];
8183	}
8184
8185	ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() {
8186	CHECK(currentAssociation_);
8187	return *currentAssociation_;
8188	}
8189
8190	void ConstructVisitor::PushAssociation() {
8191	associationStack_.emplace_back(args: Association{});
8192	currentAssociation_ = &associationStack_.back();
8193	}
8194
8195	void ConstructVisitor::PopAssociation(std::size_t count) {
8196	CHECK(count > 0 && count <= associationStack_.size());
8197	associationStack_.resize(new_size: associationStack_.size() - count);
8198	currentAssociation_ =
8199	associationStack_.empty() ? nullptr : &associationStack_.back();
8200	}
8201
8202	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
8203	evaluate::DynamicType &&type) {
8204	switch (type.category()) {
8205	SWITCH_COVERS_ALL_CASES
8206	case common::TypeCategory::Integer:
8207	case common::TypeCategory::Unsigned:
8208	case common::TypeCategory::Real:
8209	case common::TypeCategory::Complex:
8210	return context().MakeNumericType(type.category(), type.kind());
8211	case common::TypeCategory::Logical:
8212	return context().MakeLogicalType(type.kind());
8213	case common::TypeCategory::Derived:
8214	if (type.IsAssumedType()) {
8215	return currScope().MakeTypeStarType();
8216	} else if (type.IsUnlimitedPolymorphic()) {
8217	return currScope().MakeClassStarType();
8218	} else {
8219	return currScope().MakeDerivedType(
8220	type.IsPolymorphic() ? DeclTypeSpec::ClassDerived
8221	: DeclTypeSpec::TypeDerived,
8222	common::Clone(type.GetDerivedTypeSpec())
8223
8224	);
8225	}
8226	case common::TypeCategory::Character:
8227	CRASH_NO_CASE;
8228	}
8229	}
8230
8231	const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
8232	evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) {
8233	CHECK(type.category() == common::TypeCategory::Character);
8234	if (length) {
8235	return currScope().MakeCharacterType(
8236	ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},
8237	KindExpr{type.kind()});
8238	} else {
8239	return currScope().MakeCharacterType(
8240	ParamValue::Deferred(common::TypeParamAttr::Len),
8241	KindExpr{type.kind()});
8242	}
8243	}
8244
8245	class ExecutionPartSkimmerBase {
8246	public:
8247	template <typename A> bool Pre(const A &) { return true; }
8248	template <typename A> void Post(const A &) {}
8249
8250	bool InNestedBlockConstruct() const { return blockDepth_ > 0; }
8251
8252	bool Pre(const parser::AssociateConstruct &) {
8253	PushScope();
8254	return true;
8255	}
8256	void Post(const parser::AssociateConstruct &) { PopScope(); }
8257	bool Pre(const parser::Association &x) {
8258	Hide(name: std::get<parser::Name>(x.t));
8259	return true;
8260	}
8261	bool Pre(const parser::BlockConstruct &) {
8262	PushScope();
8263	++blockDepth_;
8264	return true;
8265	}
8266	void Post(const parser::BlockConstruct &) {
8267	--blockDepth_;
8268	PopScope();
8269	}
8270	// Note declarations of local names in BLOCK constructs.
8271	// Don't have to worry about INTENT(), VALUE, or OPTIONAL
8272	// (pertinent only to dummy arguments), ASYNCHRONOUS/VOLATILE,
8273	// or accessibility attributes,
8274	bool Pre(const parser::EntityDecl &x) {
8275	Hide(std::get<parser::ObjectName>(x.t));
8276	return true;
8277	}
8278	bool Pre(const parser::ObjectDecl &x) {
8279	Hide(std::get<parser::ObjectName>(x.t));
8280	return true;
8281	}
8282	bool Pre(const parser::PointerDecl &x) {
8283	Hide(name: std::get<parser::Name>(x.t));
8284	return true;
8285	}
8286	bool Pre(const parser::BindEntity &x) {
8287	Hide(name: std::get<parser::Name>(x.t));
8288	return true;
8289	}
8290	bool Pre(const parser::ContiguousStmt &x) {
8291	for (const parser::Name &name : x.v) {
8292	Hide(name);
8293	}
8294	return true;
8295	}
8296	bool Pre(const parser::DimensionStmt::Declaration &x) {
8297	Hide(name: std::get<parser::Name>(x.t));
8298	return true;
8299	}
8300	bool Pre(const parser::ExternalStmt &x) {
8301	for (const parser::Name &name : x.v) {
8302	Hide(name);
8303	}
8304	return true;
8305	}
8306	bool Pre(const parser::IntrinsicStmt &x) {
8307	for (const parser::Name &name : x.v) {
8308	Hide(name);
8309	}
8310	return true;
8311	}
8312	bool Pre(const parser::CodimensionStmt &x) {
8313	for (const parser::CodimensionDecl &decl : x.v) {
8314	Hide(std::get<parser::Name>(decl.t));
8315	}
8316	return true;
8317	}
8318	void Post(const parser::ImportStmt &x) {
8319	if (x.kind == common::ImportKind::None ||
8320	x.kind == common::ImportKind::Only) {
8321	if (!nestedScopes_.front().importOnly.has_value()) {
8322	nestedScopes_.front().importOnly.emplace();
8323	}
8324	for (const auto &name : x.names) {
8325	nestedScopes_.front().importOnly->emplace(name.source);
8326	}
8327	} else {
8328	// no special handling needed for explicit names or IMPORT, ALL
8329	}
8330	}
8331	void Post(const parser::UseStmt &x) {
8332	if (const auto *onlyList{std::get_if<std::list<parser::Only>>(&x.u)}) {
8333	for (const auto &only : *onlyList) {
8334	if (const auto *name{std::get_if<parser::Name>(&only.u)}) {
8335	Hide(*name);
8336	} else if (const auto *rename{std::get_if<parser::Rename>(&only.u)}) {
8337	if (const auto *names{
8338	std::get_if<parser::Rename::Names>(&rename->u)}) {
8339	Hide(std::get<0>(names->t));
8340	}
8341	}
8342	}
8343	} else {
8344	// USE may or may not shadow symbols in host scopes
8345	nestedScopes_.front().hasUseWithoutOnly = true;
8346	}
8347	}
8348	bool Pre(const parser::DerivedTypeStmt &x) {
8349	Hide(name: std::get<parser::Name>(x.t));
8350	PushScope();
8351	return true;
8352	}
8353	void Post(const parser::DerivedTypeDef &) { PopScope(); }
8354	bool Pre(const parser::SelectTypeConstruct &) {
8355	PushScope();
8356	return true;
8357	}
8358	void Post(const parser::SelectTypeConstruct &) { PopScope(); }
8359	bool Pre(const parser::SelectTypeStmt &x) {
8360	if (const auto &maybeName{std::get<1>(x.t)}) {
8361	Hide(name: *maybeName);
8362	}
8363	return true;
8364	}
8365	bool Pre(const parser::SelectRankConstruct &) {
8366	PushScope();
8367	return true;
8368	}
8369	void Post(const parser::SelectRankConstruct &) { PopScope(); }
8370	bool Pre(const parser::SelectRankStmt &x) {
8371	if (const auto &maybeName{std::get<1>(x.t)}) {
8372	Hide(name: *maybeName);
8373	}
8374	return true;
8375	}
8376
8377	// Iterator-modifiers contain variable declarations, and do introduce
8378	// a new scope. These variables can only have integer types, and their
8379	// scope only extends until the end of the clause. A potential alternative
8380	// to the code below may be to ignore OpenMP clauses, but it's not clear
8381	// if OMP-specific checks can be avoided altogether.
8382	bool Pre(const parser::OmpClause &x) {
8383	if (OmpVisitor::NeedsScope(x)) {
8384	PushScope();
8385	}
8386	return true;
8387	}
8388	void Post(const parser::OmpClause &x) {
8389	if (OmpVisitor::NeedsScope(x)) {
8390	PopScope();
8391	}
8392	}
8393
8394	protected:
8395	bool IsHidden(SourceName name) {
8396	for (const auto &scope : nestedScopes_) {
8397	if (scope.locals.find(name) != scope.locals.end()) {
8398	return true; // shadowed by nested declaration
8399	}
8400	if (scope.hasUseWithoutOnly) {
8401	break;
8402	}
8403	if (scope.importOnly &&
8404	scope.importOnly->find(name) == scope.importOnly->end()) {
8405	return true; // not imported
8406	}
8407	}
8408	return false;
8409	}
8410
8411	void EndWalk() { CHECK(nestedScopes_.empty()); }
8412
8413	private:
8414	void PushScope() { nestedScopes_.emplace_front(); }
8415	void PopScope() { nestedScopes_.pop_front(); }
8416	void Hide(const parser::Name &name) {
8417	nestedScopes_.front().locals.emplace(name.source);
8418	}
8419
8420	int blockDepth_{0};
8421	struct NestedScopeInfo {
8422	bool hasUseWithoutOnly{false};
8423	std::set<SourceName> locals;
8424	std::optional<std::set<SourceName>> importOnly;
8425	};
8426	std::list<NestedScopeInfo> nestedScopes_;
8427	};
8428
8429	class ExecutionPartAsyncIOSkimmer : public ExecutionPartSkimmerBase {
8430	public:
8431	explicit ExecutionPartAsyncIOSkimmer(SemanticsContext &context)
8432	: context_{context} {}
8433
8434	void Walk(const parser::Block &block) {
8435	parser::Walk(block, *this);
8436	EndWalk();
8437	}
8438
8439	const std::set<SourceName> asyncIONames() const { return asyncIONames_; }
8440
8441	using ExecutionPartSkimmerBase::Post;
8442	using ExecutionPartSkimmerBase::Pre;
8443
8444	bool Pre(const parser::IoControlSpec::Asynchronous &async) {
8445	if (auto folded{evaluate::Fold(
8446	context_.foldingContext(), AnalyzeExpr(context_, async.v))}) {
8447	if (auto str{
8448	evaluate::GetScalarConstantValue<evaluate::Ascii>(*folded)}) {
8449	for (char ch : *str) {
8450	if (ch != ' ') {
8451	inAsyncIO_ = ch == 'y' || ch == 'Y';
8452	break;
8453	}
8454	}
8455	}
8456	}
8457	return true;
8458	}
8459	void Post(const parser::ReadStmt &) { inAsyncIO_ = false; }
8460	void Post(const parser::WriteStmt &) { inAsyncIO_ = false; }
8461	void Post(const parser::IoControlSpec::Size &size) {
8462	if (const auto *designator{
8463	std::get_if<common::Indirection<parser::Designator>>(
8464	&size.v.thing.thing.u)}) {
8465	NoteAsyncIODesignator(designator: designator->value());
8466	}
8467	}
8468	void Post(const parser::InputItem &x) {
8469	if (const auto *var{std::get_if<parser::Variable>(&x.u)}) {
8470	if (const auto *designator{
8471	std::get_if<common::Indirection<parser::Designator>>(&var->u)}) {
8472	NoteAsyncIODesignator(designator: designator->value());
8473	}
8474	}
8475	}
8476	void Post(const parser::OutputItem &x) {
8477	if (const auto *expr{std::get_if<parser::Expr>(&x.u)}) {
8478	if (const auto *designator{
8479	std::get_if<common::Indirection<parser::Designator>>(&expr->u)}) {
8480	NoteAsyncIODesignator(designator: designator->value());
8481	}
8482	}
8483	}
8484
8485	private:
8486	void NoteAsyncIODesignator(const parser::Designator &designator) {
8487	if (inAsyncIO_ && !InNestedBlockConstruct()) {
8488	const parser::Name &name{parser::GetFirstName(designator)};
8489	if (!IsHidden(name: name.source)) {
8490	asyncIONames_.insert(name.source);
8491	}
8492	}
8493	}
8494
8495	SemanticsContext &context_;
8496	bool inAsyncIO_{false};
8497	std::set<SourceName> asyncIONames_;
8498	};
8499
8500	// Any data list item or SIZE= specifier of an I/O data transfer statement
8501	// with ASYNCHRONOUS="YES" implicitly has the ASYNCHRONOUS attribute in the
8502	// local scope.
8503	void ConstructVisitor::HandleImpliedAsynchronousInScope(
8504	const parser::Block &block) {
8505	ExecutionPartAsyncIOSkimmer skimmer{context()};
8506	skimmer.Walk(block);
8507	for (auto name : skimmer.asyncIONames()) {
8508	if (Symbol * symbol{currScope().FindSymbol(name)}) {
8509	if (!symbol->attrs().test(Attr::ASYNCHRONOUS)) {
8510	if (&symbol->owner() != &currScope()) {
8511	symbol = &*currScope()
8512	.try_emplace(name, HostAssocDetails{*symbol})
8513	.first->second;
8514	}
8515	if (symbol->has<AssocEntityDetails>()) {
8516	symbol = const_cast<Symbol *>(&GetAssociationRoot(*symbol));
8517	}
8518	SetImplicitAttr(*symbol, Attr::ASYNCHRONOUS);
8519	}
8520	}
8521	}
8522	}
8523
8524	// ResolveNamesVisitor implementation
8525
8526	bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
8527	HandleCall(Symbol::Flag::Function, x.v);
8528	return false;
8529	}
8530	bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
8531	HandleCall(Symbol::Flag::Subroutine, x.call);
8532	Walk(x.chevrons);
8533	return false;
8534	}
8535
8536	bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
8537	auto &scope{currScope()};
8538	// Check C896 and C899: where IMPORT statements are allowed
8539	switch (scope.kind()) {
8540	case Scope::Kind::Module:
8541	if (scope.IsModule()) {
8542	Say("IMPORT is not allowed in a module scoping unit"_err_en_US);
8543	return false;
8544	} else if (x.kind == common::ImportKind::None) {
8545	Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US);
8546	return false;
8547	}
8548	break;
8549	case Scope::Kind::MainProgram:
8550	Say("IMPORT is not allowed in a main program scoping unit"_err_en_US);
8551	return false;
8552	case Scope::Kind::Subprogram:
8553	if (scope.parent().IsGlobal()) {
8554	Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US);
8555	return false;
8556	}
8557	break;
8558	case Scope::Kind::BlockData: // C1415 (in part)
8559	Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);
8560	return false;
8561	default:;
8562	}
8563	if (auto error{scope.SetImportKind(x.kind)}) {
8564	Say(std::move(*error));
8565	}
8566	for (auto &name : x.names) {
8567	if (Symbol * outer{FindSymbol(scope.parent(), name)}) {
8568	scope.add_importName(name.source);
8569	if (Symbol * symbol{FindInScope(name)}) {
8570	if (outer->GetUltimate() == symbol->GetUltimate()) {
8571	context().Warn(common::LanguageFeature::BenignNameClash, name.source,
8572	"The same '%s' is already present in this scope"_port_en_US,
8573	name.source);
8574	} else {
8575	Say(name,
8576	"A distinct '%s' is already present in this scope"_err_en_US)
8577	.Attach(symbol->name(), "Previous declaration of '%s'"_en_US)
8578	.Attach(outer->name(), "Declaration of '%s' in host scope"_en_US);
8579	}
8580	}
8581	} else {
8582	Say(name, "'%s' not found in host scope"_err_en_US);
8583	}
8584	}
8585	prevImportStmt_ = currStmtSource();
8586	return false;
8587	}
8588
8589	const parser::Name *DeclarationVisitor::ResolveStructureComponent(
8590	const parser::StructureComponent &x) {
8591	return FindComponent(ResolveDataRef(x.base), x.component);
8592	}
8593
8594	const parser::Name *DeclarationVisitor::ResolveDesignator(
8595	const parser::Designator &x) {
8596	return common::visit(
8597	common::visitors{
8598	[&](const parser::DataRef &x) { return ResolveDataRef(x); },
8599	[&](const parser::Substring &x) {
8600	Walk(std::get<parser::SubstringRange>(x.t).t);
8601	return ResolveDataRef(std::get<parser::DataRef>(x.t));
8602	},
8603	},
8604	x.u);
8605	}
8606
8607	const parser::Name *DeclarationVisitor::ResolveDataRef(
8608	const parser::DataRef &x) {
8609	return common::visit(
8610	common::visitors{
8611	[=](const parser::Name &y) { return ResolveName(y); },
8612	[=](const Indirection<parser::StructureComponent> &y) {
8613	return ResolveStructureComponent(y.value());
8614	},
8615	[&](const Indirection<parser::ArrayElement> &y) {
8616	Walk(y.value().subscripts);
8617	const parser::Name *name{ResolveDataRef(y.value().base)};
8618	if (name && name->symbol) {
8619	if (!IsProcedure(*name->symbol)) {
8620	ConvertToObjectEntity(*name->symbol);
8621	} else if (!context().HasError(*name->symbol)) {
8622	SayWithDecl(*name, *name->symbol,
8623	"Cannot reference function '%s' as data"_err_en_US);
8624	context().SetError(*name->symbol);
8625	}
8626	}
8627	return name;
8628	},
8629	[&](const Indirection<parser::CoindexedNamedObject> &y) {
8630	Walk(y.value().imageSelector);
8631	return ResolveDataRef(y.value().base);
8632	},
8633	},
8634	x.u);
8635	}
8636
8637	static bool TypesMismatchIfNonNull(
8638	const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
8639	return type1 && type2 && *type1 != *type2;
8640	}
8641
8642	// If implicit types are allowed, ensure name is in the symbol table.
8643	// Otherwise, report an error if it hasn't been declared.
8644	const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
8645	if (!FindSymbol(name)) {
8646	if (FindAndMarkDeclareTargetSymbol(name)) {
8647	return &name;
8648	}
8649	}
8650
8651	if (CheckForHostAssociatedImplicit(name)) {
8652	NotePossibleBadForwardRef(name);
8653	return &name;
8654	}
8655	if (Symbol * symbol{name.symbol}) {
8656	if (CheckUseError(name)) {
8657	return nullptr; // reported an error
8658	}
8659	NotePossibleBadForwardRef(name);
8660	symbol->set(Symbol::Flag::ImplicitOrError, false);
8661	if (IsUplevelReference(*symbol)) {
8662	MakeHostAssocSymbol(name, *symbol);
8663	} else if (IsDummy(*symbol)) {
8664	CheckEntryDummyUse(source: name.source, symbol);
8665	ConvertToObjectEntity(*symbol);
8666	if (IsEarlyDeclaredDummyArgument(*symbol)) {
8667	ForgetEarlyDeclaredDummyArgument(*symbol);
8668	if (isImplicitNoneType()) {
8669	context().Warn(common::LanguageFeature::ForwardRefImplicitNone,
8670	name.source,
8671	"'%s' was used under IMPLICIT NONE(TYPE) before being explicitly typed"_warn_en_US,
8672	name.source);
8673	} else if (TypesMismatchIfNonNull(
8674	symbol->GetType(), GetImplicitType(*symbol))) {
8675	context().Warn(common::LanguageFeature::ForwardRefExplicitTypeDummy,
8676	name.source,
8677	"'%s' was used before being explicitly typed (and its implicit type would differ)"_warn_en_US,
8678	name.source);
8679	}
8680	}
8681	ApplyImplicitRules(*symbol);
8682	} else if (!symbol->GetType() && FindCommonBlockContaining(*symbol)) {
8683	ConvertToObjectEntity(*symbol);
8684	ApplyImplicitRules(*symbol);
8685	} else if (const auto *tpd{symbol->detailsIf<TypeParamDetails>()};
8686	tpd && !tpd->attr()) {
8687	Say(name,
8688	"Type parameter '%s' was referenced before being declared"_err_en_US,
8689	name.source);
8690	context().SetError(*symbol);
8691	}
8692	if (checkIndexUseInOwnBounds_ &&
8693	*checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) {
8694	context().Warn(common::LanguageFeature::ImpliedDoIndexScope, name.source,
8695	"Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
8696	name.source);
8697	}
8698	return &name;
8699	}
8700	if (isImplicitNoneType() && !deferImplicitTyping_) {
8701	Say(name, "No explicit type declared for '%s'"_err_en_US);
8702	return nullptr;
8703	}
8704	// Create the symbol, then ensure that it is accessible
8705	if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
8706	Say(name,
8707	"Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,
8708	name.source);
8709	}
8710	MakeSymbol(InclusiveScope(), name.source, Attrs{});
8711	auto *symbol{FindSymbol(name)};
8712	if (!symbol) {
8713	Say(name,
8714	"'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
8715	return nullptr;
8716	}
8717	ConvertToObjectEntity(symbol&: *symbol);
8718	ApplyImplicitRules(symbol&: *symbol);
8719	NotePossibleBadForwardRef(name);
8720	return &name;
8721	}
8722
8723	// A specification expression may refer to a symbol in the host procedure that
8724	// is implicitly typed. Because specification parts are processed before
8725	// execution parts, this may be the first time we see the symbol. It can't be a
8726	// local in the current scope (because it's in a specification expression) so
8727	// either it is implicitly declared in the host procedure or it is an error.
8728	// We create a symbol in the host assuming it is the former; if that proves to
8729	// be wrong we report an error later in CheckDeclarations().
8730	bool DeclarationVisitor::CheckForHostAssociatedImplicit(
8731	const parser::Name &name) {
8732	if (!inSpecificationPart_ || inEquivalenceStmt_) {
8733	return false;
8734	}
8735	if (name.symbol) {
8736	ApplyImplicitRules(symbol&: *name.symbol, allowForwardReference: true);
8737	}
8738	if (Scope * host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
8739	Symbol *hostSymbol{nullptr};
8740	if (!name.symbol) {
8741	if (currScope().CanImport(name.source)) {
8742	hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
8743	ConvertToObjectEntity(*hostSymbol);
8744	ApplyImplicitRules(*hostSymbol);
8745	hostSymbol->set(Symbol::Flag::ImplicitOrError);
8746	}
8747	} else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {
8748	hostSymbol = name.symbol;
8749	}
8750	if (hostSymbol) {
8751	Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)};
8752	if (auto *assoc{symbol.detailsIf<HostAssocDetails>()}) {
8753	if (isImplicitNoneType()) {
8754	assoc->implicitOrExplicitTypeError = true;
8755	} else {
8756	assoc->implicitOrSpecExprError = true;
8757	}
8758	return true;
8759	}
8760	}
8761	}
8762	return false;
8763	}
8764
8765	bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {
8766	if (symbol.owner().IsTopLevel()) {
8767	return false;
8768	}
8769	const Scope &symbolUnit{GetProgramUnitContaining(symbol)};
8770	if (symbolUnit == GetProgramUnitContaining(currScope())) {
8771	return false;
8772	} else {
8773	Scope::Kind kind{symbolUnit.kind()};
8774	return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;
8775	}
8776	}
8777
8778	// base is a part-ref of a derived type; find the named component in its type.
8779	// Also handles intrinsic type parameter inquiries (%kind, %len) and
8780	// COMPLEX component references (%re, %im).
8781	const parser::Name *DeclarationVisitor::FindComponent(
8782	const parser::Name *base, const parser::Name &component) {
8783	if (!base || !base->symbol) {
8784	return nullptr;
8785	}
8786	if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) {
8787	if (component.source == "kind") {
8788	if (misc->kind() == MiscDetails::Kind::ComplexPartRe ||
8789	misc->kind() == MiscDetails::Kind::ComplexPartIm ||
8790	misc->kind() == MiscDetails::Kind::KindParamInquiry ||
8791	misc->kind() == MiscDetails::Kind::LenParamInquiry) {
8792	// x%{re,im,kind,len}%kind
8793	MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry);
8794	return &component;
8795	}
8796	}
8797	}
8798	CheckEntryDummyUse(source: base->source, symbol: base->symbol);
8799	auto &symbol{base->symbol->GetUltimate()};
8800	if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) {
8801	SayWithDecl(*base, symbol,
8802	"'%s' is not an object and may not be used as the base of a component reference or type parameter inquiry"_err_en_US);
8803	return nullptr;
8804	}
8805	auto *type{symbol.GetType()};
8806	if (!type) {
8807	return nullptr; // should have already reported error
8808	}
8809	if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
8810	auto category{intrinsic->category()};
8811	MiscDetails::Kind miscKind{MiscDetails::Kind::None};
8812	if (component.source == "kind") {
8813	miscKind = MiscDetails::Kind::KindParamInquiry;
8814	} else if (category == TypeCategory::Character) {
8815	if (component.source == "len") {
8816	miscKind = MiscDetails::Kind::LenParamInquiry;
8817	}
8818	} else if (category == TypeCategory::Complex) {
8819	if (component.source == "re") {
8820	miscKind = MiscDetails::Kind::ComplexPartRe;
8821	} else if (component.source == "im") {
8822	miscKind = MiscDetails::Kind::ComplexPartIm;
8823	}
8824	}
8825	if (miscKind != MiscDetails::Kind::None) {
8826	MakePlaceholder(component, miscKind);
8827	return &component;
8828	}
8829	} else if (DerivedTypeSpec * derived{type->AsDerived()}) {
8830	derived->Instantiate(currScope()); // in case of forward referenced type
8831	if (const Scope * scope{derived->scope()}) {
8832	if (Resolve(component, scope->FindComponent(component.source))) {
8833	if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {
8834	context().Say(component.source, *msg);
8835	}
8836	return &component;
8837	} else {
8838	SayDerivedType(component.source,
8839	"Component '%s' not found in derived type '%s'"_err_en_US, *scope);
8840	}
8841	}
8842	return nullptr;
8843	}
8844	if (symbol.test(Symbol::Flag::Implicit)) {
8845	Say(*base,
8846	"'%s' is not an object of derived type; it is implicitly typed"_err_en_US);
8847	} else {
8848	SayWithDecl(
8849	*base, symbol, "'%s' is not an object of derived type"_err_en_US);
8850	}
8851	return nullptr;
8852	}
8853
8854	bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
8855	const parser::Name &name) {
8856	if (!specPartState_.declareTargetNames.empty()) {
8857	if (specPartState_.declareTargetNames.count(name.source)) {
8858	if (!currScope().IsTopLevel()) {
8859	// Search preceding scopes until we find a matching symbol or run out
8860	// of scopes to search, we skip the current scope as it's already been
8861	// designated as implicit here.
8862	for (auto *scope = &currScope().parent();; scope = &scope->parent()) {
8863	if (Symbol * symbol{scope->FindSymbol(name.source)}) {
8864	if (symbol->test(Symbol::Flag::Subroutine) ||
8865	symbol->test(Symbol::Flag::Function)) {
8866	const auto [sym, success]{currScope().try_emplace(
8867	symbol->name(), Attrs{}, HostAssocDetails{*symbol})};
8868	assert(success &&
8869	"FindAndMarkDeclareTargetSymbol could not emplace new "
8870	"subroutine/function symbol");
8871	name.symbol = &*sym->second;
8872	symbol->test(Symbol::Flag::Subroutine)
8873	? name.symbol->set(Symbol::Flag::Subroutine)
8874	: name.symbol->set(Symbol::Flag::Function);
8875	return true;
8876	}
8877	// if we find a symbol that is not a function or subroutine, we
8878	// currently escape without doing anything.
8879	break;
8880	}
8881
8882	// This is our loop exit condition, as parent() has an inbuilt assert
8883	// if you call it on a top level scope, rather than returning a null
8884	// value.
8885	if (scope->IsTopLevel()) {
8886	return false;
8887	}
8888	}
8889	}
8890	}
8891	}
8892	return false;
8893	}
8894
8895	void DeclarationVisitor::Initialization(const parser::Name &name,
8896	const parser::Initialization &init, bool inComponentDecl) {
8897	// Traversal of the initializer was deferred to here so that the
8898	// symbol being declared can be available for use in the expression, e.g.:
8899	// real, parameter :: x = tiny(x)
8900	if (!name.symbol) {
8901	return;
8902	}
8903	Symbol &ultimate{name.symbol->GetUltimate()};
8904	// TODO: check C762 - all bounds and type parameters of component
8905	// are colons or constant expressions if component is initialized
8906	common::visit(
8907	common::visitors{
8908	[&](const parser::ConstantExpr &expr) {
8909	Walk(expr);
8910	if (IsNamedConstant(ultimate) || inComponentDecl) {
8911	NonPointerInitialization(name, expr);
8912	} else {
8913	// Defer analysis so forward references to nested subprograms
8914	// can be properly resolved when they appear in structure
8915	// constructors.
8916	ultimate.set(Symbol::Flag::InDataStmt);
8917	}
8918	},
8919	[&](const parser::NullInit &null) { // => NULL()
8920	Walk(null);
8921	if (auto nullInit{EvaluateExpr(null)}) {
8922	if (!evaluate::IsNullPointer(&*nullInit)) { // C813
8923	Say(null.v.value().source,
8924	"Pointer initializer must be intrinsic NULL()"_err_en_US);
8925	} else if (IsPointer(ultimate)) {
8926	if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
8927	CHECK(!object->init());
8928	object->set_init(std::move(*nullInit));
8929	} else if (auto *procPtr{
8930	ultimate.detailsIf<ProcEntityDetails>()}) {
8931	CHECK(!procPtr->init());
8932	procPtr->set_init(nullptr);
8933	}
8934	} else {
8935	Say(name,
8936	"Non-pointer component '%s' initialized with null pointer"_err_en_US);
8937	}
8938	}
8939	},
8940	[&](const parser::InitialDataTarget &target) {
8941	// Defer analysis to the end of the specification part
8942	// so that forward references and attribute checks like SAVE
8943	// work better.
8944	if (inComponentDecl) {
8945	PointerInitialization(name, target);
8946	} else {
8947	auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
8948	Walk(target);
8949	ultimate.set(Symbol::Flag::InDataStmt);
8950	}
8951	},
8952	[&](const std::list<Indirection<parser::DataStmtValue>> &values) {
8953	// Handled later in data-to-inits conversion
8954	ultimate.set(Symbol::Flag::InDataStmt);
8955	Walk(values);
8956	},
8957	},
8958	init.u);
8959	}
8960
8961	void DeclarationVisitor::PointerInitialization(
8962	const parser::Name &name, const parser::InitialDataTarget &target) {
8963	if (name.symbol) {
8964	Symbol &ultimate{name.symbol->GetUltimate()};
8965	if (!context().HasError(ultimate)) {
8966	if (IsPointer(ultimate)) {
8967	Walk(target);
8968	if (MaybeExpr expr{EvaluateExpr(target)}) {
8969	// Validation is done in declaration checking.
8970	if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
8971	CHECK(!details->init());
8972	details->set_init(std::move(*expr));
8973	ultimate.set(Symbol::Flag::InDataStmt, false);
8974	} else if (auto *details{ultimate.detailsIf<ProcEntityDetails>()}) {
8975	// something like "REAL, EXTERNAL, POINTER :: p => t"
8976	if (evaluate::IsNullProcedurePointer(&*expr)) {
8977	CHECK(!details->init());
8978	details->set_init(nullptr);
8979	} else if (const Symbol *
8980	targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
8981	CHECK(!details->init());
8982	details->set_init(*targetSymbol);
8983	} else {
8984	Say(name,
8985	"Procedure pointer '%s' must be initialized with a procedure name or NULL()"_err_en_US);
8986	context().SetError(ultimate);
8987	}
8988	}
8989	}
8990	} else {
8991	Say(name,
8992	"'%s' is not a pointer but is initialized like one"_err_en_US);
8993	context().SetError(ultimate);
8994	}
8995	}
8996	}
8997	}
8998	void DeclarationVisitor::PointerInitialization(
8999	const parser::Name &name, const parser::ProcPointerInit &target) {
9000	if (name.symbol) {
9001	Symbol &ultimate{name.symbol->GetUltimate()};
9002	if (!context().HasError(ultimate)) {
9003	if (IsProcedurePointer(ultimate)) {
9004	auto &details{ultimate.get<ProcEntityDetails>()};
9005	if (details.init()) {
9006	Say(name, "'%s' was previously initialized"_err_en_US);
9007	context().SetError(ultimate);
9008	} else if (const auto *targetName{
9009	std::get_if<parser::Name>(&target.u)}) {
9010	Walk(target);
9011	if (!CheckUseError(name: *targetName) && targetName->symbol) {
9012	// Validation is done in declaration checking.
9013	details.set_init(*targetName->symbol);
9014	}
9015	} else { // explicit NULL
9016	details.set_init(nullptr);
9017	}
9018	} else {
9019	Say(name,
9020	"'%s' is not a procedure pointer but is initialized like one"_err_en_US);
9021	context().SetError(ultimate);
9022	}
9023	}
9024	}
9025	}
9026
9027	void DeclarationVisitor::NonPointerInitialization(
9028	const parser::Name &name, const parser::ConstantExpr &expr) {
9029	if (!context().HasError(name.symbol)) {
9030	Symbol &ultimate{name.symbol->GetUltimate()};
9031	if (!context().HasError(ultimate)) {
9032	if (IsPointer(ultimate)) {
9033	Say(name,
9034	"'%s' is a pointer but is not initialized like one"_err_en_US);
9035	} else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
9036	if (details->init()) {
9037	SayWithDecl(name, *name.symbol,
9038	"'%s' has already been initialized"_err_en_US);
9039	} else if (IsAllocatable(ultimate)) {
9040	Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
9041	} else if (ultimate.owner().IsParameterizedDerivedType()) {
9042	// Save the expression for per-instantiation analysis.
9043	details->set_unanalyzedPDTComponentInit(&expr.thing.value());
9044	} else if (MaybeExpr folded{EvaluateNonPointerInitializer(
9045	ultimate, expr, expr.thing.value().source)}) {
9046	details->set_init(std::move(*folded));
9047	ultimate.set(Symbol::Flag::InDataStmt, false);
9048	}
9049	} else {
9050	Say(name, "'%s' is not an object that can be initialized"_err_en_US);
9051	}
9052	}
9053	}
9054	}
9055
9056	void ResolveNamesVisitor::HandleCall(
9057	Symbol::Flag procFlag, const parser::Call &call) {
9058	common::visit(
9059	common::visitors{
9060	[&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
9061	[&](const parser::ProcComponentRef &x) {
9062	Walk(x);
9063	const parser::Name &name{x.v.thing.component};
9064	if (Symbol * symbol{name.symbol}) {
9065	if (IsProcedure(*symbol)) {
9066	SetProcFlag(name, *symbol, procFlag);
9067	}
9068	}
9069	},
9070	},
9071	std::get<parser::ProcedureDesignator>(call.t).u);
9072	const auto &arguments{std::get<std::list<parser::ActualArgSpec>>(call.t)};
9073	Walk(arguments);
9074	// Once an object has appeared in a specification function reference as
9075	// a whole scalar actual argument, it cannot be (re)dimensioned later.
9076	// The fact that it appeared to be a scalar may determine the resolution
9077	// or the result of an inquiry intrinsic function or generic procedure.
9078	if (inSpecificationPart_) {
9079	for (const auto &argSpec : arguments) {
9080	const auto &actual{std::get<parser::ActualArg>(argSpec.t)};
9081	if (const auto *expr{
9082	std::get_if<common::Indirection<parser::Expr>>(&actual.u)}) {
9083	if (const auto *designator{
9084	std::get_if<common::Indirection<parser::Designator>>(
9085	&expr->value().u)}) {
9086	if (const auto *dataRef{
9087	std::get_if<parser::DataRef>(&designator->value().u)}) {
9088	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)};
9089	name && name->symbol) {
9090	const Symbol &symbol{*name->symbol};
9091	const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
9092	if (symbol.has<EntityDetails>() ||
9093	(object && !object->IsArray())) {
9094	NoteScalarSpecificationArgument(symbol);
9095	}
9096	}
9097	}
9098	}
9099	}
9100	}
9101	}
9102	}
9103
9104	void ResolveNamesVisitor::HandleProcedureName(
9105	Symbol::Flag flag, const parser::Name &name) {
9106	CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
9107	auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
9108	if (!symbol) {
9109	if (IsIntrinsic(name.source, flag)) {
9110	symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
9111	SetImplicitAttr(*symbol, Attr::INTRINSIC);
9112	} else if (const auto ppcBuiltinScope =
9113	currScope().context().GetPPCBuiltinsScope()) {
9114	// Check if it is a builtin from the predefined module
9115	symbol = FindSymbol(*ppcBuiltinScope, name);
9116	if (!symbol) {
9117	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
9118	}
9119	} else {
9120	symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
9121	}
9122	Resolve(name, *symbol);
9123	ConvertToProcEntity(symbol&: *symbol, usedHere: name.source);
9124	if (!symbol->attrs().test(Attr::INTRINSIC)) {
9125	if (CheckImplicitNoneExternal(name.source, *symbol)) {
9126	MakeExternal(symbol&: *symbol);
9127	// Create a place-holder HostAssocDetails symbol to preclude later
9128	// use of this name as a local symbol; but don't actually use this new
9129	// HostAssocDetails symbol in expressions.
9130	MakeHostAssocSymbol(name, hostSymbol: *symbol);
9131	name.symbol = symbol;
9132	}
9133	}
9134	CheckEntryDummyUse(source: name.source, symbol: symbol);
9135	SetProcFlag(name, *symbol, flag);
9136	} else if (CheckUseError(name)) {
9137	// error was reported
9138	} else {
9139	symbol = &symbol->GetUltimate();
9140	if (!name.symbol ||
9141	(name.symbol->has<HostAssocDetails>() && symbol->owner().IsGlobal() &&
9142	(symbol->has<ProcEntityDetails>() ||
9143	(symbol->has<SubprogramDetails>() &&
9144	symbol->scope() /*not ENTRY*/)))) {
9145	name.symbol = symbol;
9146	}
9147	CheckEntryDummyUse(source: name.source, symbol: symbol);
9148	bool convertedToProcEntity{ConvertToProcEntity(symbol&: *symbol, usedHere: name.source)};
9149	if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
9150	IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
9151	AcquireIntrinsicProcedureFlags(symbol&: *symbol);
9152	}
9153	if (!SetProcFlag(name, *symbol, flag)) {
9154	return; // reported error
9155	}
9156	CheckImplicitNoneExternal(name.source, *symbol);
9157	if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
9158	symbol->has<AssocEntityDetails>()) {
9159	// Symbols with DerivedTypeDetails and AssocEntityDetails are accepted
9160	// here as procedure-designators because this means the related
9161	// FunctionReference are mis-parsed structure constructors or array
9162	// references that will be fixed later when analyzing expressions.
9163	} else if (symbol->has<ObjectEntityDetails>()) {
9164	// Symbols with ObjectEntityDetails are also accepted because this can be
9165	// a mis-parsed array reference that will be fixed later. Ensure that if
9166	// this is a symbol from a host procedure, a symbol with HostAssocDetails
9167	// is created for the current scope.
9168	// Operate on non ultimate symbol so that HostAssocDetails are also
9169	// created for symbols used associated in the host procedure.
9170	ResolveName(name);
9171	} else if (symbol->test(Symbol::Flag::Implicit)) {
9172	Say(name,
9173	"Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US);
9174	} else {
9175	SayWithDecl(name, *symbol,
9176	"Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
9177	}
9178	}
9179	}
9180
9181	bool ResolveNamesVisitor::CheckImplicitNoneExternal(
9182	const SourceName &name, const Symbol &symbol) {
9183	if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&
9184	!symbol.attrs().test(Attr::EXTERNAL) &&
9185	!symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) {
9186	Say(name,
9187	"'%s' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
9188	return false;
9189	}
9190	return true;
9191	}
9192
9193	// Variant of HandleProcedureName() for use while skimming the executable
9194	// part of a subprogram to catch calls to dummy procedures that are part
9195	// of the subprogram's interface, and to mark as procedures any symbols
9196	// that might otherwise have been miscategorized as objects.
9197	void ResolveNamesVisitor::NoteExecutablePartCall(
9198	Symbol::Flag flag, SourceName name, bool hasCUDAChevrons) {
9199	// Subtlety: The symbol pointers in the parse tree are not set, because
9200	// they might end up resolving elsewhere (e.g., construct entities in
9201	// SELECT TYPE).
9202	if (Symbol * symbol{currScope().FindSymbol(name)}) {
9203	Symbol::Flag other{flag == Symbol::Flag::Subroutine
9204	? Symbol::Flag::Function
9205	: Symbol::Flag::Subroutine};
9206	if (!symbol->test(other)) {
9207	ConvertToProcEntity(symbol&: *symbol, usedHere: name);
9208	if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
9209	symbol->set(flag);
9210	if (IsDummy(*symbol)) {
9211	SetImplicitAttr(*symbol, Attr::EXTERNAL);
9212	}
9213	ApplyImplicitRules(*symbol);
9214	if (hasCUDAChevrons) {
9215	details->set_isCUDAKernel();
9216	}
9217	}
9218	}
9219	}
9220	}
9221
9222	static bool IsLocallyImplicitGlobalSymbol(
9223	const Symbol &symbol, const parser::Name &localName) {
9224	if (symbol.owner().IsGlobal()) {
9225	const auto *subp{symbol.detailsIf<SubprogramDetails>()};
9226	const Scope *scope{
9227	subp && subp->entryScope() ? subp->entryScope() : symbol.scope()};
9228	return !(scope && scope->sourceRange().Contains(localName.source));
9229	}
9230	return false;
9231	}
9232
9233	// Check and set the Function or Subroutine flag on symbol; false on error.
9234	bool ResolveNamesVisitor::SetProcFlag(
9235	const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
9236	if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
9237	SayWithDecl(
9238	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
9239	context().SetError(symbol);
9240	return false;
9241	} else if (symbol.test(Symbol::Flag::Subroutine) &&
9242	flag == Symbol::Flag::Function) {
9243	SayWithDecl(
9244	name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
9245	context().SetError(symbol);
9246	return false;
9247	} else if (flag == Symbol::Flag::Function &&
9248	IsLocallyImplicitGlobalSymbol(symbol, name) &&
9249	TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) {
9250	SayWithDecl(name, symbol,
9251	"Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);
9252	return false;
9253	} else if (symbol.has<ProcEntityDetails>()) {
9254	symbol.set(flag); // in case it hasn't been set yet
9255	if (flag == Symbol::Flag::Function) {
9256	ApplyImplicitRules(symbol);
9257	}
9258	if (symbol.attrs().test(Attr::INTRINSIC)) {
9259	AcquireIntrinsicProcedureFlags(symbol);
9260	}
9261	} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
9262	SayWithDecl(
9263	name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
9264	context().SetError(symbol);
9265	} else if (symbol.attrs().test(Attr::INTRINSIC)) {
9266	AcquireIntrinsicProcedureFlags(symbol);
9267	}
9268	return true;
9269	}
9270
9271	bool ModuleVisitor::Pre(const parser::AccessStmt &x) {
9272	Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))};
9273	if (!currScope().IsModule()) { // C869
9274	Say(currStmtSource().value(),
9275	"%s statement may only appear in the specification part of a module"_err_en_US,
9276	EnumToString(accessAttr));
9277	return false;
9278	}
9279	const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)};
9280	if (accessIds.empty()) {
9281	if (prevAccessStmt_) { // C869
9282	Say("The default accessibility of this module has already been declared"_err_en_US)
9283	.Attach(*prevAccessStmt_, "Previous declaration"_en_US);
9284	}
9285	prevAccessStmt_ = currStmtSource();
9286	auto *moduleDetails{DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
9287	DEREF(moduleDetails).set_isDefaultPrivate(accessAttr == Attr::PRIVATE);
9288	} else {
9289	for (const auto &accessId : accessIds) {
9290	GenericSpecInfo info{accessId.v.value()};
9291	auto *symbol{FindInScope(info.symbolName())};
9292	if (!symbol && !info.kind().IsName()) {
9293	symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{});
9294	}
9295	info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol));
9296	}
9297	}
9298	return false;
9299	}
9300
9301	// Set the access specification for this symbol.
9302	Symbol &ModuleVisitor::SetAccess(
9303	const SourceName &name, Attr attr, Symbol *symbol) {
9304	if (!symbol) {
9305	symbol = &MakeSymbol(name);
9306	}
9307	Attrs &attrs{symbol->attrs()};
9308	if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
9309	// PUBLIC/PRIVATE already set: make it a fatal error if it changed
9310	Attr prev{attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE};
9311	if (attr != prev) {
9312	Say(name,
9313	"The accessibility of '%s' has already been specified as %s"_err_en_US,
9314	MakeOpName(name), EnumToString(prev));
9315	} else {
9316	context().Warn(common::LanguageFeature::RedundantAttribute, name,
9317	"The accessibility of '%s' has already been specified as %s"_warn_en_US,
9318	MakeOpName(name), EnumToString(prev));
9319	}
9320	} else {
9321	attrs.set(attr);
9322	}
9323	return *symbol;
9324	}
9325
9326	static bool NeedsExplicitType(const Symbol &symbol) {
9327	if (symbol.has<UnknownDetails>()) {
9328	return true;
9329	} else if (const auto *details{symbol.detailsIf<EntityDetails>()}) {
9330	return !details->type();
9331	} else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
9332	return !details->type();
9333	} else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
9334	return !details->procInterface() && !details->type();
9335	} else {
9336	return false;
9337	}
9338	}
9339
9340	void ResolveNamesVisitor::HandleDerivedTypesInImplicitStmts(
9341	const parser::ImplicitPart &implicitPart,
9342	const std::list<parser::DeclarationConstruct> &decls) {
9343	// Detect derived type definitions and create symbols for them now if
9344	// they appear in IMPLICIT statements so that these forward-looking
9345	// references will not be ambiguous with host associations.
9346	std::set<SourceName> implicitDerivedTypes;
9347	for (const auto &ipStmt : implicitPart.v) {
9348	if (const auto *impl{std::get_if<
9349	parser::Statement<common::Indirection<parser::ImplicitStmt>>>(
9350	&ipStmt.u)}) {
9351	if (const auto *specs{std::get_if<std::list<parser::ImplicitSpec>>(
9352	&impl->statement.value().u)}) {
9353	for (const auto &spec : *specs) {
9354	const auto &declTypeSpec{
9355	std::get<parser::DeclarationTypeSpec>(spec.t)};
9356	if (const auto *dtSpec{common::visit(
9357	common::visitors{
9358	[](const parser::DeclarationTypeSpec::Type &x) {
9359	return &x.derived;
9360	},
9361	[](const parser::DeclarationTypeSpec::Class &x) {
9362	return &x.derived;
9363	},
9364	[](const auto &) -> const parser::DerivedTypeSpec * {
9365	return nullptr;
9366	}},
9367	declTypeSpec.u)}) {
9368	implicitDerivedTypes.emplace(
9369	std::get<parser::Name>(dtSpec->t).source);
9370	}
9371	}
9372	}
9373	}
9374	}
9375	if (!implicitDerivedTypes.empty()) {
9376	for (const auto &decl : decls) {
9377	if (const auto *spec{
9378	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
9379	if (const auto *dtDef{
9380	std::get_if<common::Indirection<parser::DerivedTypeDef>>(
9381	&spec->u)}) {
9382	const parser::DerivedTypeStmt &dtStmt{
9383	std::get<parser::Statement<parser::DerivedTypeStmt>>(
9384	dtDef->value().t)
9385	.statement};
9386	const parser::Name &name{std::get<parser::Name>(dtStmt.t)};
9387	if (implicitDerivedTypes.find(name.source) !=
9388	implicitDerivedTypes.end() &&
9389	!FindInScope(name)) {
9390	DerivedTypeDetails details;
9391	details.set_isForwardReferenced(true);
9392	Resolve(name, MakeSymbol(name, std::move(details)));
9393	implicitDerivedTypes.erase(name.source);
9394	}
9395	}
9396	}
9397	}
9398	}
9399	}
9400
9401	bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
9402	const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
9403	implicitPart, decls] = x.t;
9404	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
9405	auto stateRestorer{
9406	common::ScopedSet(specPartState_, SpecificationPartState{})};
9407	Walk(accDecls);
9408	Walk(ompDecls);
9409	Walk(compilerDirectives);
9410	for (const auto &useStmt : useStmts) {
9411	CollectUseRenames(useStmt.statement.value());
9412	}
9413	Walk(useStmts);
9414	UseCUDABuiltinNames();
9415	ClearUseRenames();
9416	ClearUseOnly();
9417	ClearModuleUses();
9418	Walk(importStmts);
9419	HandleDerivedTypesInImplicitStmts(implicitPart, decls);
9420	Walk(implicitPart);
9421	for (const auto &decl : decls) {
9422	if (const auto *spec{
9423	std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
9424	PreSpecificationConstruct(*spec);
9425	}
9426	}
9427	Walk(decls);
9428	FinishSpecificationPart(decls);
9429	return false;
9430	}
9431
9432	void ResolveNamesVisitor::UseCUDABuiltinNames() {
9433	if (FindCUDADeviceContext(&currScope())) {
9434	for (const auto &[name, symbol] : context().GetCUDABuiltinsScope()) {
9435	if (!FindInScope(name)) {
9436	auto &localSymbol{MakeSymbol(name)};
9437	localSymbol.set_details(UseDetails{name, *symbol});
9438	localSymbol.flags() = symbol->flags();
9439	}
9440	}
9441	}
9442	}
9443
9444	// Initial processing on specification constructs, before visiting them.
9445	void ResolveNamesVisitor::PreSpecificationConstruct(
9446	const parser::SpecificationConstruct &spec) {
9447	common::visit(
9448	common::visitors{
9449	[&](const parser::Statement<
9450	common::Indirection<parser::TypeDeclarationStmt>> &y) {
9451	EarlyDummyTypeDeclaration(y);
9452	},
9453	[&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
9454	CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
9455	},
9456	[&](const Indirection<parser::InterfaceBlock> &y) {
9457	const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(
9458	y.value().t)};
9459	if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) {
9460	CreateGeneric(*spec);
9461	}
9462	},
9463	[&](const parser::Statement<parser::OtherSpecificationStmt> &y) {
9464	common::visit(
9465	common::visitors{
9466	[&](const common::Indirection<parser::CommonStmt> &z) {
9467	CreateCommonBlockSymbols(z.value());
9468	},
9469	[&](const common::Indirection<parser::TargetStmt> &z) {
9470	CreateObjectSymbols(z.value().v, Attr::TARGET);
9471	},
9472	[](const auto &) {},
9473	},
9474	y.statement.u);
9475	},
9476	[](const auto &) {},
9477	},
9478	spec.u);
9479	}
9480
9481	void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
9482	const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
9483	&stmt) {
9484	context().set_location(stmt.source);
9485	const auto &[declTypeSpec, attrs, entities] = stmt.statement.value().t;
9486	if (const auto *intrin{
9487	std::get_if<parser::IntrinsicTypeSpec>(&declTypeSpec.u)}) {
9488	if (const auto *intType{std::get_if<parser::IntegerTypeSpec>(&intrin->u)}) {
9489	if (const auto &kind{intType->v}) {
9490	if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&
9491	!parser::Unwrap<parser::IntLiteralConstant>(*kind)) {
9492	return;
9493	}
9494	}
9495	const DeclTypeSpec *type{nullptr};
9496	for (const auto &ent : entities) {
9497	const auto &objName{std::get<parser::ObjectName>(ent.t)};
9498	Resolve(objName, FindInScope(currScope(), objName));
9499	if (Symbol * symbol{objName.symbol};
9500	symbol && IsDummy(*symbol) && NeedsType(*symbol)) {
9501	if (!type) {
9502	type = ProcessTypeSpec(declTypeSpec);
9503	if (!type || !type->IsNumeric(TypeCategory::Integer)) {
9504	break;
9505	}
9506	}
9507	symbol->SetType(*type);
9508	NoteEarlyDeclaredDummyArgument(*symbol);
9509	// Set the Implicit flag to disable bogus errors from
9510	// being emitted later when this declaration is processed
9511	// again normally.
9512	symbol->set(Symbol::Flag::Implicit);
9513	}
9514	}
9515	}
9516	}
9517	}
9518
9519	void ResolveNamesVisitor::CreateCommonBlockSymbols(
9520	const parser::CommonStmt &commonStmt) {
9521	for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
9522	const auto &[name, objects] = block.t;
9523	Symbol &commonBlock{MakeCommonBlockSymbol(name)};
9524	for (const auto &object : objects) {
9525	Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};
9526	if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {
9527	details->set_commonBlock(commonBlock);
9528	commonBlock.get<CommonBlockDetails>().add_object(obj);
9529	}
9530	}
9531	}
9532	}
9533
9534	void ResolveNamesVisitor::CreateObjectSymbols(
9535	const std::list<parser::ObjectDecl> &decls, Attr attr) {
9536	for (const parser::ObjectDecl &decl : decls) {
9537	SetImplicitAttr(DeclareEntity<ObjectEntityDetails>(
9538	std::get<parser::ObjectName>(decl.t), Attrs{}),
9539	attr);
9540	}
9541	}
9542
9543	void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
9544	auto info{GenericSpecInfo{x}};
9545	SourceName symbolName{info.symbolName()};
9546	if (IsLogicalConstant(context(), symbolName)) {
9547	Say(symbolName,
9548	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
9549	return;
9550	}
9551	GenericDetails genericDetails;
9552	Symbol *existing{nullptr};
9553	// Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
9554	for (const std::string &n : GetAllNames(context(), symbolName)) {
9555	existing = currScope().FindSymbol(SourceName{n});
9556	if (existing) {
9557	break;
9558	}
9559	}
9560	if (existing) {
9561	Symbol &ultimate{existing->GetUltimate()};
9562	if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
9563	if (&existing->owner() == &currScope()) {
9564	if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
9565	// Create a local copy of a use associated generic so that
9566	// it can be locally extended without corrupting the original.
9567	genericDetails.CopyFrom(*existingGeneric);
9568	if (existingGeneric->specific()) {
9569	genericDetails.set_specific(*existingGeneric->specific());
9570	}
9571	AddGenericUse(
9572	genericDetails, existing->name(), existingUse->symbol());
9573	} else if (existing == &ultimate) {
9574	// Extending an extant generic in the same scope
9575	info.Resolve(existing);
9576	return;
9577	} else {
9578	// Host association of a generic is handled elsewhere
9579	CHECK(existing->has<HostAssocDetails>());
9580	}
9581	} else {
9582	// Create a new generic for this scope.
9583	}
9584	} else if (ultimate.has<SubprogramDetails>() ||
9585	ultimate.has<SubprogramNameDetails>()) {
9586	genericDetails.set_specific(*existing);
9587	} else if (ultimate.has<ProcEntityDetails>()) {
9588	if (existing->name() != symbolName ||
9589	!ultimate.attrs().test(Attr::INTRINSIC)) {
9590	genericDetails.set_specific(*existing);
9591	}
9592	} else if (ultimate.has<DerivedTypeDetails>()) {
9593	genericDetails.set_derivedType(*existing);
9594	} else if (&existing->owner() == &currScope()) {
9595	SayAlreadyDeclared(symbolName, *existing);
9596	return;
9597	}
9598	if (&existing->owner() == &currScope()) {
9599	EraseSymbol(*existing);
9600	}
9601	}
9602	info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
9603	}
9604
9605	void ResolveNamesVisitor::FinishSpecificationPart(
9606	const std::list<parser::DeclarationConstruct> &decls) {
9607	misparsedStmtFuncFound_ = false;
9608	funcResultStack().CompleteFunctionResultType();
9609	CheckImports();
9610	for (auto &pair : currScope()) {
9611	auto &symbol{*pair.second};
9612	if (inInterfaceBlock()) {
9613	ConvertToObjectEntity(symbol);
9614	}
9615	if (NeedsExplicitType(symbol)) {
9616	ApplyImplicitRules(symbol);
9617	}
9618	if (IsDummy(symbol) && isImplicitNoneType() &&
9619	symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
9620	Say(symbol.name(),
9621	"No explicit type declared for dummy argument '%s'"_err_en_US);
9622	context().SetError(symbol);
9623	}
9624	if (symbol.has<GenericDetails>()) {
9625	CheckGenericProcedures(symbol);
9626	}
9627	if (!symbol.has<HostAssocDetails>()) {
9628	CheckPossibleBadForwardRef(symbol);
9629	}
9630	// Propagate BIND(C) attribute to procedure entities from their interfaces,
9631	// but not the NAME=, even if it is empty (which would be a reasonable
9632	// and useful behavior, actually). This interpretation is not at all
9633	// clearly described in the standard, but matches the behavior of several
9634	// other compilers.
9635	if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
9636	!proc->isDummy() && !IsPointer(symbol) &&
9637	!symbol.attrs().test(Attr::BIND_C)) {
9638	if (const Symbol * iface{proc->procInterface()};
9639	iface && IsBindCProcedure(*iface)) {
9640	SetImplicitAttr(symbol, Attr::BIND_C);
9641	SetBindNameOn(symbol);
9642	}
9643	}
9644	}
9645	currScope().InstantiateDerivedTypes();
9646	for (const auto &decl : decls) {
9647	if (const auto *statement{std::get_if<
9648	parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(
9649	&decl.u)}) {
9650	messageHandler().set_currStmtSource(statement->source);
9651	AnalyzeStmtFunctionStmt(statement->statement.value());
9652	}
9653	}
9654	// TODO: what about instantiations in BLOCK?
9655	CheckSaveStmts();
9656	CheckCommonBlocks();
9657	if (!inInterfaceBlock()) {
9658	// TODO: warn for the case where the EQUIVALENCE statement is in a
9659	// procedure declaration in an interface block
9660	CheckEquivalenceSets();
9661	}
9662	}
9663
9664	// Analyze the bodies of statement functions now that the symbols in this
9665	// specification part have been fully declared and implicitly typed.
9666	// (Statement function references are not allowed in specification
9667	// expressions, so it's safe to defer processing their definitions.)
9668	void ResolveNamesVisitor::AnalyzeStmtFunctionStmt(
9669	const parser::StmtFunctionStmt &stmtFunc) {
9670	const auto &name{std::get<parser::Name>(stmtFunc.t)};
9671	Symbol *symbol{name.symbol};
9672	auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr};
9673	if (!details || !symbol->scope() ||
9674	&symbol->scope()->parent() != &currScope() || details->isInterface() ||
9675	details->isDummy() || details->entryScope() ||
9676	details->moduleInterface() || symbol->test(Symbol::Flag::Subroutine)) {
9677	return; // error recovery
9678	}
9679	// Resolve the symbols on the RHS of the statement function.
9680	PushScope(scope&: *symbol->scope());
9681	const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)};
9682	Walk(parsedExpr);
9683	PopScope();
9684	if (auto expr{AnalyzeExpr(context(), stmtFunc)}) {
9685	if (auto type{evaluate::DynamicType::From(*symbol)}) {
9686	if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) {
9687	details->set_stmtFunction(std::move(*converted));
9688	} else {
9689	Say(name.source,
9690	"Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US,
9691	name.source, type->AsFortran());
9692	}
9693	} else {
9694	details->set_stmtFunction(std::move(*expr));
9695	}
9696	}
9697	if (!details->stmtFunction()) {
9698	context().SetError(*symbol);
9699	}
9700	}
9701
9702	void ResolveNamesVisitor::CheckImports() {
9703	auto &scope{currScope()};
9704	switch (scope.GetImportKind()) {
9705	case common::ImportKind::None:
9706	break;
9707	case common::ImportKind::All:
9708	// C8102: all entities in host must not be hidden
9709	for (const auto &pair : scope.parent()) {
9710	auto &name{pair.first};
9711	std::optional<SourceName> scopeName{scope.GetName()};
9712	if (!scopeName || name != *scopeName) {
9713	CheckImport(prevImportStmt_.value(), name);
9714	}
9715	}
9716	break;
9717	case common::ImportKind::Default:
9718	case common::ImportKind::Only:
9719	// C8102: entities named in IMPORT must not be hidden
9720	for (auto &name : scope.importNames()) {
9721	CheckImport(name, name);
9722	}
9723	break;
9724	}
9725	}
9726
9727	void ResolveNamesVisitor::CheckImport(
9728	const SourceName &location, const SourceName &name) {
9729	if (auto *symbol{FindInScope(name)}) {
9730	const Symbol &ultimate{symbol->GetUltimate()};
9731	if (&ultimate.owner() == &currScope()) {
9732	Say(location, "'%s' from host is not accessible"_err_en_US, name)
9733	.Attach(symbol->name(), "'%s' is hidden by this entity"_because_en_US,
9734	symbol->name());
9735	}
9736	}
9737	}
9738
9739	bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {
9740	return CheckNotInBlock("IMPLICIT") && // C1107
9741	ImplicitRulesVisitor::Pre(x);
9742	}
9743
9744	void ResolveNamesVisitor::Post(const parser::PointerObject &x) {
9745	common::visit(common::visitors{
9746	[&](const parser::Name &x) { ResolveName(x); },
9747	[&](const parser::StructureComponent &x) {
9748	ResolveStructureComponent(x);
9749	},
9750	},
9751	x.u);
9752	}
9753	void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {
9754	common::visit(common::visitors{
9755	[&](const parser::Name &x) { ResolveName(x); },
9756	[&](const parser::StructureComponent &x) {
9757	ResolveStructureComponent(x);
9758	},
9759	},
9760	x.u);
9761	}
9762
9763	bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
9764	const auto &dataRef{std::get<parser::DataRef>(x.t)};
9765	const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
9766	const auto &expr{std::get<parser::Expr>(x.t)};
9767	ResolveDataRef(x: dataRef);
9768	Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
9769	Walk(bounds);
9770	// Resolve unrestricted specific intrinsic procedures as in "p => cos".
9771	if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
9772	if (NameIsKnownOrIntrinsic(*name)) {
9773	if (Symbol * symbol{name->symbol}) {
9774	if (IsProcedurePointer(ptrSymbol) &&
9775	!ptrSymbol->test(Symbol::Flag::Function) &&
9776	!ptrSymbol->test(Symbol::Flag::Subroutine)) {
9777	if (symbol->test(Symbol::Flag::Function)) {
9778	ApplyImplicitRules(*ptrSymbol);
9779	}
9780	}
9781	// If the name is known because it is an object entity from a host
9782	// procedure, create a host associated symbol.
9783	if (symbol->GetUltimate().has<ObjectEntityDetails>() &&
9784	IsUplevelReference(*symbol)) {
9785	MakeHostAssocSymbol(*name, *symbol);
9786	}
9787	}
9788	return false;
9789	}
9790	// Can also reference a global external procedure here
9791	if (auto it{context().globalScope().find(name->source)};
9792	it != context().globalScope().end()) {
9793	Symbol &global{*it->second};
9794	if (IsProcedure(global)) {
9795	Resolve(*name, global);
9796	return false;
9797	}
9798	}
9799	if (IsProcedurePointer(parser::GetLastName(dataRef).symbol) &&
9800	!FindSymbol(*name)) {
9801	// Unknown target of procedure pointer must be an external procedure
9802	Symbol &symbol{MakeSymbol(
9803	context().globalScope(), name->source, Attrs{Attr::EXTERNAL})};
9804	symbol.implicitAttrs().set(Attr::EXTERNAL);
9805	Resolve(*name, symbol);
9806	ConvertToProcEntity(symbol, usedHere: name->source);
9807	return false;
9808	}
9809	}
9810	Walk(expr);
9811	return false;
9812	}
9813	void ResolveNamesVisitor::Post(const parser::Designator &x) {
9814	ResolveDesignator(x);
9815	}
9816	void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) {
9817	Walk(std::get<parser::SubstringRange>(x.v.t).t);
9818	ResolveDataRef(x: std::get<parser::DataRef>(x.v.t));
9819	}
9820
9821	void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
9822	ResolveStructureComponent(x.v.thing);
9823	}
9824	void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {
9825	DeclTypeSpecVisitor::Post(x);
9826	ConstructVisitor::Post(x);
9827	}
9828	bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
9829	if (HandleStmtFunction(x)) {
9830	return false;
9831	} else {
9832	// This is an array element or pointer-valued function assignment:
9833	// resolve the names of indices/arguments
9834	const auto &names{std::get<std::list<parser::Name>>(x.t)};
9835	for (auto &name : names) {
9836	ResolveName(name);
9837	}
9838	return true;
9839	}
9840	}
9841
9842	bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) {
9843	const parser::Name &name{x.v};
9844	if (FindSymbol(name)) {
9845	// OK
9846	} else if (IsLogicalConstant(context(), name.source)) {
9847	Say(name,
9848	"Logical constant '%s' may not be used as a defined operator"_err_en_US);
9849	} else {
9850	// Resolved later in expression semantics
9851	MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);
9852	}
9853	return false;
9854	}
9855
9856	void ResolveNamesVisitor::Post(const parser::AssignStmt &x) {
9857	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
9858	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
9859	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
9860	}
9861	}
9862	void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) {
9863	if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) {
9864	CheckEntryDummyUse(source: name->source, symbol: name->symbol);
9865	ConvertToObjectEntity(symbol&: DEREF(name->symbol));
9866	}
9867	}
9868
9869	void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
9870	if (std::holds_alternative<parser::CompilerDirective::VectorAlways>(x.u) ||
9871	std::holds_alternative<parser::CompilerDirective::Unroll>(x.u) ||
9872	std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(x.u) ||
9873	std::holds_alternative<parser::CompilerDirective::NoVector>(x.u) ||
9874	std::holds_alternative<parser::CompilerDirective::NoUnroll>(x.u) ||
9875	std::holds_alternative<parser::CompilerDirective::NoUnrollAndJam>(x.u)) {
9876	return;
9877	}
9878	if (const auto *tkr{
9879	std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) {
9880	if (currScope().IsTopLevel() ||
9881	GetProgramUnitContaining(currScope()).kind() !=
9882	Scope::Kind::Subprogram) {
9883	Say(x.source,
9884	"!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US);
9885	return;
9886	}
9887	if (!inSpecificationPart_) {
9888	Say(x.source,
9889	"!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US);
9890	return;
9891	}
9892	if (tkr->empty()) {
9893	Symbol *symbol{currScope().symbol()};
9894	if (SubprogramDetails *
9895	subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) {
9896	subp->set_defaultIgnoreTKR(true);
9897	}
9898	} else {
9899	for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) {
9900	common::IgnoreTKRSet set;
9901	if (const auto &maybeList{
9902	std::get<std::optional<std::list<const char *>>>(item.t)}) {
9903	for (const char *p : *maybeList) {
9904	if (p) {
9905	switch (*p) {
9906	case 't':
9907	set.set(common::IgnoreTKR::Type);
9908	break;
9909	case 'k':
9910	set.set(common::IgnoreTKR::Kind);
9911	break;
9912	case 'r':
9913	set.set(common::IgnoreTKR::Rank);
9914	break;
9915	case 'd':
9916	set.set(common::IgnoreTKR::Device);
9917	break;
9918	case 'm':
9919	set.set(common::IgnoreTKR::Managed);
9920	break;
9921	case 'c':
9922	set.set(common::IgnoreTKR::Contiguous);
9923	break;
9924	case 'a':
9925	set = common::ignoreTKRAll;
9926	break;
9927	default:
9928	Say(x.source,
9929	"'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US,
9930	*p);
9931	set = common::ignoreTKRAll;
9932	break;
9933	}
9934	}
9935	}
9936	if (set.empty()) {
9937	Say(x.source,
9938	"!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US);
9939	}
9940	} else { // no (list)
9941	set = common::ignoreTKRAll;
9942	;
9943	}
9944	const auto &name{std::get<parser::Name>(item.t)};
9945	Symbol *symbol{FindSymbol(name)};
9946	if (!symbol) {
9947	symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{});
9948	}
9949	if (symbol->owner() != currScope()) {
9950	SayWithDecl(
9951	name, *symbol, "'%s' must be local to this subprogram"_err_en_US);
9952	} else {
9953	ConvertToObjectEntity(*symbol);
9954	if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) {
9955	object->set_ignoreTKR(set);
9956	} else {
9957	SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US);
9958	}
9959	}
9960	}
9961	}
9962	} else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) {
9963	Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US)
9964	.set_usageWarning(common::UsageWarning::IgnoredDirective);
9965	}
9966	}
9967
9968	bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
9969	if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>(
9970	x.u)) {
9971	// TODO: global directives
9972	return true;
9973	}
9974	if (std::holds_alternative<
9975	common::Indirection<parser::OpenACCRoutineConstruct>>(x.u)) {
9976	ResolveAccParts(context(), x, &topScope_);
9977	return false;
9978	}
9979	ProgramTree &root{ProgramTree::Build(x, context())};
9980	SetScope(topScope_);
9981	ResolveSpecificationParts(root);
9982	FinishSpecificationParts(root);
9983	ResolveExecutionParts(root);
9984	FinishExecutionParts(root);
9985	ResolveAccParts(context(), x, /*topScope=*/nullptr);
9986	ResolveOmpParts(context(), x);
9987	return false;
9988	}
9989
9990	template <typename A> std::set<SourceName> GetUses(const A &x) {
9991	std::set<SourceName> uses;
9992	if constexpr (!std::is_same_v<A, parser::CompilerDirective> &&
9993	!std::is_same_v<A, parser::OpenACCRoutineConstruct>) {
9994	const auto &spec{std::get<parser::SpecificationPart>(x.t)};
9995	const auto &unitUses{std::get<
9996	std::list<parser::Statement<common::Indirection<parser::UseStmt>>>>(
9997	spec.t)};
9998	for (const auto &u : unitUses) {
9999	uses.insert(u.statement.value().moduleName.source);
10000	}
10001	}
10002	return uses;
10003	}
10004
10005	bool ResolveNamesVisitor::Pre(const parser::Program &x) {
10006	if (Scope * hermetic{context().currentHermeticModuleFileScope()}) {
10007	// Processing either the dependent modules or first module of a
10008	// hermetic module file; ensure that the hermetic module scope has
10009	// its implicit rules map entry.
10010	ImplicitRulesVisitor::BeginScope(*hermetic);
10011	}
10012	std::map<SourceName, const parser::ProgramUnit *> modules;
10013	std::set<SourceName> uses;
10014	bool disordered{false};
10015	for (const auto &progUnit : x.v) {
10016	if (const auto *indMod{
10017	std::get_if<common::Indirection<parser::Module>>(&progUnit.u)}) {
10018	const parser::Module &mod{indMod->value()};
10019	const auto &moduleStmt{
10020	std::get<parser::Statement<parser::ModuleStmt>>(mod.t)};
10021	const SourceName &name{moduleStmt.statement.v.source};
10022	if (auto iter{modules.find(name)}; iter != modules.end()) {
10023	Say(name,
10024	"Module '%s' appears multiple times in a compilation unit"_err_en_US)
10025	.Attach(iter->first, "First definition of module"_en_US);
10026	return true;
10027	}
10028	modules.emplace(name, &progUnit);
10029	if (auto iter{uses.find(name)}; iter != uses.end()) {
10030	if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
10031	Say(name,
10032	"A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US,
10033	name)
10034	.Attach(*iter, "First USE of module"_en_US);
10035	}
10036	disordered = true;
10037	}
10038	}
10039	for (SourceName used : common::visit(
10040	[](const auto &indUnit) { return GetUses(indUnit.value()); },
10041	progUnit.u)) {
10042	uses.insert(used);
10043	}
10044	}
10045	if (!disordered) {
10046	return true;
10047	}
10048	// Process modules in topological order
10049	std::vector<const parser::ProgramUnit *> moduleOrder;
10050	while (!modules.empty()) {
10051	bool ok;
10052	for (const auto &pair : modules) {
10053	const SourceName &name{pair.first};
10054	const parser::ProgramUnit &progUnit{*pair.second};
10055	const parser::Module &m{
10056	std::get<common::Indirection<parser::Module>>(progUnit.u).value()};
10057	ok = true;
10058	for (const SourceName &use : GetUses(m)) {
10059	if (modules.find(use) != modules.end()) {
10060	ok = false;
10061	break;
10062	}
10063	}
10064	if (ok) {
10065	moduleOrder.push_back(x: &progUnit);
10066	modules.erase(x: name);
10067	break;
10068	}
10069	}
10070	if (!ok) {
10071	Message *msg{nullptr};
10072	for (const auto &pair : modules) {
10073	if (msg) {
10074	msg->Attach(pair.first, "Module in a cycle"_en_US);
10075	} else {
10076	msg = &Say(pair.first,
10077	"Some modules in this compilation unit form one or more cycles of dependence"_err_en_US);
10078	}
10079	}
10080	return false;
10081	}
10082	}
10083	// Modules can be ordered. Process them first, and then all of the other
10084	// program units.
10085	for (const parser::ProgramUnit *progUnit : moduleOrder) {
10086	Walk(*progUnit);
10087	}
10088	for (const auto &progUnit : x.v) {
10089	if (!std::get_if<common::Indirection<parser::Module>>(&progUnit.u)) {
10090	Walk(progUnit);
10091	}
10092	}
10093	return false;
10094	}
10095
10096	// References to procedures need to record that their symbols are known
10097	// to be procedures, so that they don't get converted to objects by default.
10098	class ExecutionPartCallSkimmer : public ExecutionPartSkimmerBase {
10099	public:
10100	explicit ExecutionPartCallSkimmer(ResolveNamesVisitor &resolver)
10101	: resolver_{resolver} {}
10102
10103	void Walk(const parser::ExecutionPart &exec) {
10104	parser::Walk(exec, *this);
10105	EndWalk();
10106	}
10107
10108	using ExecutionPartSkimmerBase::Post;
10109	using ExecutionPartSkimmerBase::Pre;
10110
10111	void Post(const parser::FunctionReference &fr) {
10112	NoteCall(Symbol::Flag::Function, fr.v, false);
10113	}
10114	void Post(const parser::CallStmt &cs) {
10115	NoteCall(Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
10116	}
10117
10118	private:
10119	void NoteCall(
10120	Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
10121	auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
10122	if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
10123	if (!IsHidden(name: name->source)) {
10124	resolver_.NoteExecutablePartCall(flag, name->source, hasCUDAChevrons);
10125	}
10126	}
10127	}
10128
10129	ResolveNamesVisitor &resolver_;
10130	};
10131
10132	// Build the scope tree and resolve names in the specification parts of this
10133	// node and its children
10134	void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
10135	if (node.isSpecificationPartResolved()) {
10136	return; // been here already
10137	}
10138	node.set_isSpecificationPartResolved();
10139	if (!BeginScopeForNode(node)) {
10140	return; // an error prevented scope from being created
10141	}
10142	Scope &scope{currScope()};
10143	node.set_scope(scope);
10144	AddSubpNames(node);
10145	common::visit(
10146	[&](const auto *x) {
10147	if (x) {
10148	Walk(*x);
10149	}
10150	},
10151	node.stmt());
10152	Walk(node.spec());
10153	bool inDeviceSubprogram{false};
10154	// If this is a function, convert result to an object. This is to prevent the
10155	// result from being converted later to a function symbol if it is called
10156	// inside the function.
10157	// If the result is function pointer, then ConvertToObjectEntity will not
10158	// convert the result to an object, and calling the symbol inside the function
10159	// will result in calls to the result pointer.
10160	// A function cannot be called recursively if RESULT was not used to define a
10161	// distinct result name (15.6.2.2 point 4.).
10162	if (Symbol * symbol{scope.symbol()}) {
10163	if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
10164	if (details->isFunction()) {
10165	ConvertToObjectEntity(const_cast<Symbol &>(details->result()));
10166	}
10167	// Check the current procedure is a device procedure to apply implicit
10168	// attribute at the end.
10169	if (auto attrs{details->cudaSubprogramAttrs()}) {
10170	if (*attrs == common::CUDASubprogramAttrs::Device ||
10171	*attrs == common::CUDASubprogramAttrs::Global ||
10172	*attrs == common::CUDASubprogramAttrs::Grid_Global) {
10173	inDeviceSubprogram = true;
10174	}
10175	}
10176	}
10177	}
10178	if (node.IsModule()) {
10179	ApplyDefaultAccess();
10180	}
10181	for (auto &child : node.children()) {
10182	ResolveSpecificationParts(child);
10183	}
10184	if (node.exec()) {
10185	ExecutionPartCallSkimmer{*this}.Walk(*node.exec());
10186	HandleImpliedAsynchronousInScope(node.exec()->v);
10187	}
10188	EndScopeForNode(node);
10189	// Ensure that every object entity has a type.
10190	bool inModule{node.GetKind() == ProgramTree::Kind::Module ||
10191	node.GetKind() == ProgramTree::Kind::Submodule};
10192	for (auto &pair : *node.scope()) {
10193	Symbol &symbol{*pair.second};
10194	if (inModule && symbol.attrs().test(Attr::EXTERNAL) && !IsPointer(symbol) &&
10195	!symbol.test(Symbol::Flag::Function) &&
10196	!symbol.test(Symbol::Flag::Subroutine)) {
10197	// in a module, external proc without return type is subroutine
10198	symbol.set(
10199	symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
10200	}
10201	ApplyImplicitRules(symbol);
10202	// Apply CUDA implicit attributes if needed.
10203	if (inDeviceSubprogram) {
10204	SetImplicitCUDADevice(symbol);
10205	}
10206	// Main program local objects usually don't have an implied SAVE attribute,
10207	// as one might think, but in the exceptional case of a derived type
10208	// local object that contains a coarray, we have to mark it as an
10209	// implied SAVE so that evaluate::IsSaved() will return true.
10210	if (node.scope()->kind() == Scope::Kind::MainProgram) {
10211	if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
10212	if (const DeclTypeSpec * type{object->type()}) {
10213	if (const DerivedTypeSpec * derived{type->AsDerived()}) {
10214	if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {
10215	SetImplicitAttr(symbol, Attr::SAVE);
10216	}
10217	}
10218	}
10219	}
10220	}
10221	}
10222	}
10223
10224	// Add SubprogramNameDetails symbols for module and internal subprograms and
10225	// their ENTRY statements.
10226	void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
10227	auto kind{
10228	node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
10229	for (auto &child : node.children()) {
10230	auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
10231	if (child.HasModulePrefix()) {
10232	SetExplicitAttr(symbol, Attr::MODULE);
10233	}
10234	if (child.bindingSpec()) {
10235	SetExplicitAttr(symbol, Attr::BIND_C);
10236	}
10237	auto childKind{child.GetKind()};
10238	if (childKind == ProgramTree::Kind::Function) {
10239	symbol.set(Symbol::Flag::Function);
10240	} else if (childKind == ProgramTree::Kind::Subroutine) {
10241	symbol.set(Symbol::Flag::Subroutine);
10242	} else {
10243	continue; // make ENTRY symbols only where valid
10244	}
10245	for (const auto &entryStmt : child.entryStmts()) {
10246	SubprogramNameDetails details{kind, child};
10247	auto &symbol{
10248	MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
10249	symbol.set(child.GetSubpFlag());
10250	if (child.HasModulePrefix()) {
10251	SetExplicitAttr(symbol, Attr::MODULE);
10252	}
10253	if (child.bindingSpec()) {
10254	SetExplicitAttr(symbol, Attr::BIND_C);
10255	}
10256	}
10257	}
10258	for (const auto &generic : node.genericSpecs()) {
10259	if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {
10260	if (currScope().find(name->source) != currScope().end()) {
10261	// If this scope has both a generic interface and a contained
10262	// subprogram with the same name, create the generic's symbol
10263	// now so that any other generics of the same name that are pulled
10264	// into scope later via USE association will properly merge instead
10265	// of raising a bogus error due a conflict with the subprogram.
10266	CreateGeneric(*generic);
10267	}
10268	}
10269	}
10270	}
10271
10272	// Push a new scope for this node or return false on error.
10273	bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
10274	switch (node.GetKind()) {
10275	SWITCH_COVERS_ALL_CASES
10276	case ProgramTree::Kind::Program:
10277	PushScope(Scope::Kind::MainProgram,
10278	&MakeSymbol(node.name(), MainProgramDetails{}));
10279	return true;
10280	case ProgramTree::Kind::Function:
10281	case ProgramTree::Kind::Subroutine:
10282	return BeginSubprogram(node.name(), node.GetSubpFlag(),
10283	node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts());
10284	case ProgramTree::Kind::MpSubprogram:
10285	return BeginMpSubprogram(name: node.name());
10286	case ProgramTree::Kind::Module:
10287	BeginModule(name: node.name(), isSubmodule: false);
10288	return true;
10289	case ProgramTree::Kind::Submodule:
10290	return BeginSubmodule(node.name(), node.GetParentId());
10291	case ProgramTree::Kind::BlockData:
10292	PushBlockDataScope(name: node.name());
10293	return true;
10294	}
10295	}
10296
10297	void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) {
10298	std::optional<parser::CharBlock> stmtSource;
10299	const std::optional<parser::LanguageBindingSpec> *binding{nullptr};
10300	common::visit(
10301	common::visitors{
10302	[&](const parser::Statement<parser::FunctionStmt> *stmt) {
10303	if (stmt) {
10304	stmtSource = stmt->source;
10305	if (const auto &maybeSuffix{
10306	std::get<std::optional<parser::Suffix>>(
10307	stmt->statement.t)}) {
10308	binding = &maybeSuffix->binding;
10309	}
10310	}
10311	},
10312	[&](const parser::Statement<parser::SubroutineStmt> *stmt) {
10313	if (stmt) {
10314	stmtSource = stmt->source;
10315	binding = &std::get<std::optional<parser::LanguageBindingSpec>>(
10316	stmt->statement.t);
10317	}
10318	},
10319	[](const auto *) {},
10320	},
10321	node.stmt());
10322	EndSubprogram(stmtSource, binding, &node.entryStmts());
10323	}
10324
10325	// Some analyses and checks, such as the processing of initializers of
10326	// pointers, are deferred until all of the pertinent specification parts
10327	// have been visited. This deferred processing enables the use of forward
10328	// references in these circumstances.
10329	// Data statement objects with implicit derived types are finally
10330	// resolved here.
10331	class DeferredCheckVisitor {
10332	public:
10333	explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)
10334	: resolver_{resolver} {}
10335
10336	template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
10337
10338	template <typename A> bool Pre(const A &) { return true; }
10339	template <typename A> void Post(const A &) {}
10340
10341	void Post(const parser::DerivedTypeStmt &x) {
10342	const auto &name{std::get<parser::Name>(x.t)};
10343	if (Symbol * symbol{name.symbol}) {
10344	if (Scope * scope{symbol->scope()}) {
10345	if (scope->IsDerivedType()) {
10346	CHECK(outerScope_ == nullptr);
10347	outerScope_ = &resolver_.currScope();
10348	resolver_.SetScope(*scope);
10349	}
10350	}
10351	}
10352	}
10353	void Post(const parser::EndTypeStmt &) {
10354	if (outerScope_) {
10355	resolver_.SetScope(*outerScope_);
10356	outerScope_ = nullptr;
10357	}
10358	}
10359
10360	void Post(const parser::ProcInterface &pi) {
10361	if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
10362	resolver_.CheckExplicitInterface(name: *name);
10363	}
10364	}
10365	bool Pre(const parser::EntityDecl &decl) {
10366	Init(std::get<parser::Name>(decl.t),
10367	std::get<std::optional<parser::Initialization>>(decl.t));
10368	return false;
10369	}
10370	bool Pre(const parser::ProcDecl &decl) {
10371	if (const auto &init{
10372	std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) {
10373	resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init);
10374	}
10375	return false;
10376	}
10377	void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) {
10378	resolver_.CheckExplicitInterface(name: tbps.interfaceName);
10379	}
10380	void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) {
10381	if (outerScope_) {
10382	resolver_.CheckBindings(tbps);
10383	}
10384	}
10385	bool Pre(const parser::DataStmtObject &) {
10386	++dataStmtObjectNesting_;
10387	return true;
10388	}
10389	void Post(const parser::DataStmtObject &) { --dataStmtObjectNesting_; }
10390	void Post(const parser::Designator &x) {
10391	if (dataStmtObjectNesting_ > 0) {
10392	resolver_.ResolveDesignator(x);
10393	}
10394	}
10395
10396	private:
10397	void Init(const parser::Name &name,
10398	const std::optional<parser::Initialization> &init) {
10399	if (init) {
10400	if (const auto *target{
10401	std::get_if<parser::InitialDataTarget>(&init->u)}) {
10402	resolver_.PointerInitialization(name, *target);
10403	} else if (const auto *expr{
10404	std::get_if<parser::ConstantExpr>(&init->u)}) {
10405	if (name.symbol) {
10406	if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};
10407	!object || !object->init()) {
10408	resolver_.NonPointerInitialization(name, *expr);
10409	}
10410	}
10411	}
10412	}
10413	}
10414
10415	ResolveNamesVisitor &resolver_;
10416	Scope *outerScope_{nullptr};
10417	int dataStmtObjectNesting_{0};
10418	};
10419
10420	// Perform checks and completions that need to happen after all of
10421	// the specification parts but before any of the execution parts.
10422	void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
10423	if (!node.scope()) {
10424	return; // error occurred creating scope
10425	}
10426	auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
10427	SetScope(*node.scope());
10428	// The initializers of pointers and non-PARAMETER objects, the default
10429	// initializers of components, and non-deferred type-bound procedure
10430	// bindings have not yet been traversed.
10431	// We do that now, when any forward references that appeared
10432	// in those initializers will resolve to the right symbols without
10433	// incurring spurious errors with IMPLICIT NONE or forward references
10434	// to nested subprograms.
10435	DeferredCheckVisitor{*this}.Walk(node.spec());
10436	for (Scope &childScope : currScope().children()) {
10437	if (childScope.IsParameterizedDerivedTypeInstantiation()) {
10438	FinishDerivedTypeInstantiation(childScope);
10439	}
10440	}
10441	for (const auto &child : node.children()) {
10442	FinishSpecificationParts(child);
10443	}
10444	}
10445
10446	void ResolveNamesVisitor::FinishExecutionParts(const ProgramTree &node) {
10447	if (node.scope()) {
10448	SetScope(*node.scope());
10449	if (node.exec()) {
10450	DeferredCheckVisitor{*this}.Walk(*node.exec());
10451	}
10452	for (const auto &child : node.children()) {
10453	FinishExecutionParts(child);
10454	}
10455	}
10456	}
10457
10458	// Duplicate and fold component object pointer default initializer designators
10459	// using the actual type parameter values of each particular instantiation.
10460	// Validation is done later in declaration checking.
10461	void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
10462	CHECK(scope.IsDerivedType() && !scope.symbol());
10463	if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
10464	spec->Instantiate(currScope());
10465	const Symbol &origTypeSymbol{spec->typeSymbol()};
10466	if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
10467	CHECK(origTypeScope->IsDerivedType() &&
10468	origTypeScope->symbol() == &origTypeSymbol);
10469	auto &foldingContext{GetFoldingContext()};
10470	auto restorer{foldingContext.WithPDTInstance(*spec)};
10471	for (auto &pair : scope) {
10472	Symbol &comp{*pair.second};
10473	const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};
10474	if (IsPointer(comp)) {
10475	if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
10476	auto origDetails{origComp.get<ObjectEntityDetails>()};
10477	if (const MaybeExpr & init{origDetails.init()}) {
10478	SomeExpr newInit{*init};
10479	MaybeExpr folded{FoldExpr(std::move(newInit))};
10480	details->set_init(std::move(folded));
10481	}
10482	}
10483	}
10484	}
10485	}
10486	}
10487	}
10488
10489	// Resolve names in the execution part of this node and its children
10490	void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {
10491	if (!node.scope()) {
10492	return; // error occurred creating scope
10493	}
10494	SetScope(*node.scope());
10495	if (const auto *exec{node.exec()}) {
10496	Walk(*exec);
10497	}
10498	FinishNamelists();
10499	if (node.IsModule()) {
10500	// A second final pass to catch new symbols added from implicitly
10501	// typed names in NAMELIST groups or the specification parts of
10502	// module subprograms.
10503	ApplyDefaultAccess();
10504	}
10505	PopScope(); // converts unclassified entities into objects
10506	for (const auto &child : node.children()) {
10507	ResolveExecutionParts(child);
10508	}
10509	}
10510
10511	void ResolveNamesVisitor::Post(const parser::Program &x) {
10512	// ensure that all temps were deallocated
10513	CHECK(!attrs_);
10514	CHECK(!cudaDataAttr_);
10515	CHECK(!GetDeclTypeSpec());
10516	// Top-level resolution to propagate information across program units after
10517	// each of them has been resolved separately.
10518	ResolveOmpTopLevelParts(context(), x);
10519	}
10520
10521	// A singleton instance of the scope -> IMPLICIT rules mapping is
10522	// shared by all instances of ResolveNamesVisitor and accessed by this
10523	// pointer when the visitors (other than the top-level original) are
10524	// constructed.
10525	static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};
10526
10527	bool ResolveNames(
10528	SemanticsContext &context, const parser::Program &program, Scope &top) {
10529	ImplicitRulesMap implicitRulesMap;
10530	auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)};
10531	ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program);
10532	return !context.AnyFatalError();
10533	}
10534
10535	// Processes a module (but not internal) function when it is referenced
10536	// in a specification expression in a sibling procedure.
10537	void ResolveSpecificationParts(
10538	SemanticsContext &context, const Symbol &subprogram) {
10539	auto originalLocation{context.location()};
10540	ImplicitRulesMap implicitRulesMap;
10541	bool localImplicitRulesMap{false};
10542	if (!sharedImplicitRulesMap) {
10543	sharedImplicitRulesMap = &implicitRulesMap;
10544	localImplicitRulesMap = true;
10545	}
10546	ResolveNamesVisitor visitor{
10547	context, *sharedImplicitRulesMap, context.globalScope()};
10548	const auto &details{subprogram.get<SubprogramNameDetails>()};
10549	ProgramTree &node{details.node()};
10550	const Scope &moduleScope{subprogram.owner()};
10551	if (localImplicitRulesMap) {
10552	visitor.BeginScope(const_cast<Scope &>(moduleScope));
10553	} else {
10554	visitor.SetScope(const_cast<Scope &>(moduleScope));
10555	}
10556	visitor.ResolveSpecificationParts(node);
10557	context.set_location(std::move(originalLocation));
10558	if (localImplicitRulesMap) {
10559	sharedImplicitRulesMap = nullptr;
10560	}
10561	}
10562
10563	} // namespace Fortran::semantics
10564