Bug Summary

File:build/source/flang/lib/Semantics/resolve-names.cpp
Warning:line 5093, column 7
Called C++ object pointer is null

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-pc-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name resolve-names.cpp -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model pic -pic-level 2 -mframe-pointer=none -relaxed-aliasing -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -ffunction-sections -fdata-sections -fcoverage-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -resource-dir /usr/lib/llvm-17/lib/clang/17 -isystem /build/source/llvm/../mlir/include -isystem tools/mlir/include -isystem tools/clang/include -isystem /build/source/llvm/../clang/include -I tools/flang/lib/Semantics -I /build/source/flang/lib/Semantics -I /build/source/flang/include -I tools/flang/include -I include -I /build/source/llvm/include -D FLANG_INCLUDE_TESTS=1 -D FLANG_LITTLE_ENDIAN=1 -D FLANG_VENDOR="Debian " -D _DEBUG -D _GNU_SOURCE -D __STDC_CONSTANT_MACROS -D __STDC_FORMAT_MACROS -D __STDC_LIMIT_MACROS -D _FORTIFY_SOURCE=2 -D NDEBUG -U NDEBUG -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/x86_64-linux-gnu/c++/10 -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../include/c++/10/backward -internal-isystem /usr/lib/llvm-17/lib/clang/17/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/10/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -fmacro-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fmacro-prefix-map=/build/source/= -fcoverage-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fcoverage-prefix-map=/build/source/= -source-date-epoch 1675289259 -O2 -Wno-unused-command-line-argument -Wno-unused-parameter -Wwrite-strings -Wno-missing-field-initializers -Wno-long-long -Wno-maybe-uninitialized -Wno-class-memaccess -Wno-redundant-move -Wno-pessimizing-move -Wno-noexcept-type -Wno-comment -Wno-misleading-indentation -Wno-deprecated-copy -Wno-ctad-maybe-unsupported -std=c++17 -fdeprecated-macro -fdebug-compilation-dir=/build/source/build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/build-llvm/tools/clang/stage2-bins=build-llvm/tools/clang/stage2-bins -fdebug-prefix-map=/build/source/= -ferror-limit 19 -fvisibility-inlines-hidden -stack-protector 2 -fgnuc-version=4.2.1 -fcolor-diagnostics -vectorize-loops -vectorize-slp -analyzer-output=html -analyzer-config stable-report-filename=true -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2023-02-02-055145-558594-1 -x c++ /build/source/flang/lib/Semantics/resolve-names.cpp

/build/source/flang/lib/Semantics/resolve-names.cpp

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

/build/source/flang/include/flang/Parser/parse-tree-visitor.h

1//===-- include/flang/Parser/parse-tree-visitor.h ---------------*- C++ -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#ifndef FORTRAN_PARSER_PARSE_TREE_VISITOR_H_
10#define FORTRAN_PARSER_PARSE_TREE_VISITOR_H_
11
12#include "parse-tree.h"
13#include "flang/Common/visit.h"
14#include <cstddef>
15#include <optional>
16#include <tuple>
17#include <utility>
18#include <variant>
19
20/// Parse tree visitor
21/// Call Walk(x, visitor) to visit x and, by default, each node under x.
22/// If x is non-const, the visitor member functions can modify the tree.
23///
24/// visitor.Pre(x) is called before visiting x and its children are not
25/// visited if it returns false.
26///
27/// visitor.Post(x) is called after visiting x.
28
29namespace Fortran::parser {
30
31// Default case for visitation of non-class data members, strings, and
32// any other non-decomposable values.
33template <typename A, typename V>
34std::enable_if_t<!std::is_class_v<A> || std::is_same_v<std::string, A> ||
35 std::is_same_v<CharBlock, A>>
36Walk(const A &x, V &visitor) {
37 if (visitor.Pre(x)) {
38 visitor.Post(x);
39 }
40}
41template <typename A, typename M>
42std::enable_if_t<!std::is_class_v<A> || std::is_same_v<std::string, A> ||
43 std::is_same_v<CharBlock, A>>
44Walk(A &x, M &mutator) {
45 if (mutator.Pre(x)) {
46 mutator.Post(x);
47 }
48}
49
50template <typename V> void Walk(const format::ControlEditDesc &, V &);
51template <typename M> void Walk(format::ControlEditDesc &, M &);
52template <typename V> void Walk(const format::DerivedTypeDataEditDesc &, V &);
53template <typename M> void Walk(format::DerivedTypeDataEditDesc &, M &);
54template <typename V> void Walk(const format::FormatItem &, V &);
55template <typename M> void Walk(format::FormatItem &, M &);
56template <typename V> void Walk(const format::FormatSpecification &, V &);
57template <typename M> void Walk(format::FormatSpecification &, M &);
58template <typename V> void Walk(const format::IntrinsicTypeDataEditDesc &, V &);
59template <typename M> void Walk(format::IntrinsicTypeDataEditDesc &, M &);
60
61// Traversal of needed STL template classes (optional, list, tuple, variant)
62template <typename T, typename V>
63void Walk(const std::optional<T> &x, V &visitor) {
64 if (x) {
2
Assuming the condition is true
3
Taking true branch
65 Walk(*x, visitor);
4
Calling 'Walk<Fortran::parser::TypeBoundProcedurePart, Fortran::semantics::ResolveNamesVisitor>'
66 }
67}
68template <typename T, typename M> void Walk(std::optional<T> &x, M &mutator) {
69 if (x) {
70 Walk(*x, mutator);
71 }
72}
73// For most lists, just traverse the elements; but when a list constitutes
74// a Block (i.e., std::list<ExecutionPartConstruct>), also invoke the
75// visitor/mutator on the list itself.
76template <typename T, typename V> void Walk(const std::list<T> &x, V &visitor) {
77 for (const auto &elem : x) {
78 Walk(elem, visitor);
79 }
80}
81template <typename T, typename M> void Walk(std::list<T> &x, M &mutator) {
82 for (auto &elem : x) {
83 Walk(elem, mutator);
84 }
85}
86template <typename V> void Walk(const Block &x, V &visitor) {
87 if (visitor.Pre(x)) {
88 for (const auto &elem : x) {
89 Walk(elem, visitor);
90 }
91 visitor.Post(x);
92 }
93}
94template <typename M> void Walk(Block &x, M &mutator) {
95 if (mutator.Pre(x)) {
96 for (auto &elem : x) {
97 Walk(elem, mutator);
98 }
99 mutator.Post(x);
100 }
101}
102template <std::size_t I = 0, typename Func, typename T>
103void ForEachInTuple(const T &tuple, Func func) {
104 func(std::get<I>(tuple));
105 if constexpr (I + 1 < std::tuple_size_v<T>) {
106 ForEachInTuple<I + 1>(tuple, func);
107 }
108}
109template <typename V, typename... A>
110void Walk(const std::tuple<A...> &x, V &visitor) {
111 if (sizeof...(A) > 0) {
112 if (visitor.Pre(x)) {
113 ForEachInTuple(x, [&](const auto &y) { Walk(y, visitor); });
114 visitor.Post(x);
115 }
116 }
117}
118template <std::size_t I = 0, typename Func, typename T>
119void ForEachInTuple(T &tuple, Func func) {
120 func(std::get<I>(tuple));
121 if constexpr (I + 1 < std::tuple_size_v<T>) {
122 ForEachInTuple<I + 1>(tuple, func);
123 }
124}
125template <typename M, typename... A>
126void Walk(std::tuple<A...> &x, M &mutator) {
127 if (sizeof...(A) > 0) {
128 if (mutator.Pre(x)) {
129 ForEachInTuple(x, [&](auto &y) { Walk(y, mutator); });
130 mutator.Post(x);
131 }
132 }
133}
134template <typename V, typename... A>
135void Walk(const std::variant<A...> &x, V &visitor) {
136 if (visitor.Pre(x)) {
137 common::visit([&](const auto &y) { Walk(y, visitor); }, x);
138 visitor.Post(x);
139 }
140}
141template <typename M, typename... A>
142void Walk(std::variant<A...> &x, M &mutator) {
143 if (mutator.Pre(x)) {
144 common::visit([&](auto &y) { Walk(y, mutator); }, x);
145 mutator.Post(x);
146 }
147}
148template <typename A, typename B, typename V>
149void Walk(const std::pair<A, B> &x, V &visitor) {
150 if (visitor.Pre(x)) {
151 Walk(x.first, visitor);
152 Walk(x.second, visitor);
153 }
154}
155template <typename A, typename B, typename M>
156void Walk(std::pair<A, B> &x, M &mutator) {
157 if (mutator.Pre(x)) {
158 Walk(x.first, mutator);
159 Walk(x.second, mutator);
160 }
161}
162
163// Trait-determined traversal of empty, tuple, union, wrapper,
164// and constraint-checking classes.
165template <typename A, typename V>
166std::enable_if_t<EmptyTrait<A>> Walk(const A &x, V &visitor) {
167 if (visitor.Pre(x)) {
168 visitor.Post(x);
169 }
170}
171template <typename A, typename M>
172std::enable_if_t<EmptyTrait<A>> Walk(A &x, M &mutator) {
173 if (mutator.Pre(x)) {
174 mutator.Post(x);
175 }
176}
177
178template <typename A, typename V>
179std::enable_if_t<TupleTrait<A>> Walk(const A &x, V &visitor) {
180 if (visitor.Pre(x)) {
5
Taking true branch
181 Walk(x.t, visitor);
182 visitor.Post(x);
6
Calling 'DeclarationVisitor::Post'
183 }
184}
185template <typename A, typename M>
186std::enable_if_t<TupleTrait<A>> Walk(A &x, M &mutator) {
187 if (mutator.Pre(x)) {
188 Walk(x.t, mutator);
189 mutator.Post(x);
190 }
191}
192
193template <typename A, typename V>
194std::enable_if_t<UnionTrait<A>> Walk(const A &x, V &visitor) {
195 if (visitor.Pre(x)) {
196 Walk(x.u, visitor);
197 visitor.Post(x);
198 }
199}
200template <typename A, typename M>
201std::enable_if_t<UnionTrait<A>> Walk(A &x, M &mutator) {
202 if (mutator.Pre(x)) {
203 Walk(x.u, mutator);
204 mutator.Post(x);
205 }
206}
207
208template <typename A, typename V>
209std::enable_if_t<WrapperTrait<A>> Walk(const A &x, V &visitor) {
210 if (visitor.Pre(x)) {
211 Walk(x.v, visitor);
212 visitor.Post(x);
213 }
214}
215template <typename A, typename M>
216std::enable_if_t<WrapperTrait<A>> Walk(A &x, M &mutator) {
217 if (mutator.Pre(x)) {
218 Walk(x.v, mutator);
219 mutator.Post(x);
220 }
221}
222
223template <typename A, typename V>
224std::enable_if_t<ConstraintTrait<A>> Walk(const A &x, V &visitor) {
225 if (visitor.Pre(x)) {
226 Walk(x.thing, visitor);
227 visitor.Post(x);
228 }
229}
230template <typename A, typename M>
231std::enable_if_t<ConstraintTrait<A>> Walk(A &x, M &mutator) {
232 if (mutator.Pre(x)) {
233 Walk(x.thing, mutator);
234 mutator.Post(x);
235 }
236}
237
238template <typename T, typename V>
239void Walk(const common::Indirection<T> &x, V &visitor) {
240 Walk(x.value(), visitor);
241}
242template <typename T, typename M>
243void Walk(common::Indirection<T> &x, M &mutator) {
244 Walk(x.value(), mutator);
245}
246
247template <typename T, typename V> void Walk(const Statement<T> &x, V &visitor) {
248 if (visitor.Pre(x)) {
249 // N.B. The label, if any, is not visited.
250 Walk(x.source, visitor);
251 Walk(x.statement, visitor);
252 visitor.Post(x);
253 }
254}
255template <typename T, typename M> void Walk(Statement<T> &x, M &mutator) {
256 if (mutator.Pre(x)) {
257 // N.B. The label, if any, is not visited.
258 Walk(x.source, mutator);
259 Walk(x.statement, mutator);
260 mutator.Post(x);
261 }
262}
263
264template <typename T, typename V>
265void Walk(const UnlabeledStatement<T> &x, V &visitor) {
266 if (visitor.Pre(x)) {
267 Walk(x.source, visitor);
268 Walk(x.statement, visitor);
269 visitor.Post(x);
270 }
271}
272template <typename T, typename M>
273void Walk(UnlabeledStatement<T> &x, M &mutator) {
274 if (mutator.Pre(x)) {
275 Walk(x.source, mutator);
276 Walk(x.statement, mutator);
277 mutator.Post(x);
278 }
279}
280
281template <typename V> void Walk(const Name &x, V &visitor) {
282 if (visitor.Pre(x)) {
283 Walk(x.source, visitor);
284 visitor.Post(x);
285 }
286}
287template <typename M> void Walk(Name &x, M &mutator) {
288 if (mutator.Pre(x)) {
289 Walk(x.source, mutator);
290 mutator.Post(x);
291 }
292}
293
294template <typename V> void Walk(const AcSpec &x, V &visitor) {
295 if (visitor.Pre(x)) {
296 Walk(x.type, visitor);
297 Walk(x.values, visitor);
298 visitor.Post(x);
299 }
300}
301template <typename M> void Walk(AcSpec &x, M &mutator) {
302 if (mutator.Pre(x)) {
303 Walk(x.type, mutator);
304 Walk(x.values, mutator);
305 mutator.Post(x);
306 }
307}
308template <typename V> void Walk(const ArrayElement &x, V &visitor) {
309 if (visitor.Pre(x)) {
310 Walk(x.base, visitor);
311 Walk(x.subscripts, visitor);
312 visitor.Post(x);
313 }
314}
315template <typename M> void Walk(ArrayElement &x, M &mutator) {
316 if (mutator.Pre(x)) {
317 Walk(x.base, mutator);
318 Walk(x.subscripts, mutator);
319 mutator.Post(x);
320 }
321}
322template <typename V>
323void Walk(const CharSelector::LengthAndKind &x, V &visitor) {
324 if (visitor.Pre(x)) {
325 Walk(x.length, visitor);
326 Walk(x.kind, visitor);
327 visitor.Post(x);
328 }
329}
330template <typename M> void Walk(CharSelector::LengthAndKind &x, M &mutator) {
331 if (mutator.Pre(x)) {
332 Walk(x.length, mutator);
333 Walk(x.kind, mutator);
334 mutator.Post(x);
335 }
336}
337template <typename V> void Walk(const CaseValueRange::Range &x, V &visitor) {
338 if (visitor.Pre(x)) {
339 Walk(x.lower, visitor);
340 Walk(x.upper, visitor);
341 visitor.Post(x);
342 }
343}
344template <typename M> void Walk(CaseValueRange::Range &x, M &mutator) {
345 if (mutator.Pre(x)) {
346 Walk(x.lower, mutator);
347 Walk(x.upper, mutator);
348 mutator.Post(x);
349 }
350}
351template <typename V> void Walk(const CoindexedNamedObject &x, V &visitor) {
352 if (visitor.Pre(x)) {
353 Walk(x.base, visitor);
354 Walk(x.imageSelector, visitor);
355 visitor.Post(x);
356 }
357}
358template <typename M> void Walk(CoindexedNamedObject &x, M &mutator) {
359 if (mutator.Pre(x)) {
360 Walk(x.base, mutator);
361 Walk(x.imageSelector, mutator);
362 mutator.Post(x);
363 }
364}
365template <typename V>
366void Walk(const DeclarationTypeSpec::Class &x, V &visitor) {
367 if (visitor.Pre(x)) {
368 Walk(x.derived, visitor);
369 visitor.Post(x);
370 }
371}
372template <typename M> void Walk(DeclarationTypeSpec::Class &x, M &mutator) {
373 if (mutator.Pre(x)) {
374 Walk(x.derived, mutator);
375 mutator.Post(x);
376 }
377}
378template <typename V>
379void Walk(const DeclarationTypeSpec::Type &x, V &visitor) {
380 if (visitor.Pre(x)) {
381 Walk(x.derived, visitor);
382 visitor.Post(x);
383 }
384}
385template <typename M> void Walk(DeclarationTypeSpec::Type &x, M &mutator) {
386 if (mutator.Pre(x)) {
387 Walk(x.derived, mutator);
388 mutator.Post(x);
389 }
390}
391template <typename V> void Walk(const ImportStmt &x, V &visitor) {
392 if (visitor.Pre(x)) {
393 Walk(x.names, visitor);
394 visitor.Post(x);
395 }
396}
397template <typename M> void Walk(ImportStmt &x, M &mutator) {
398 if (mutator.Pre(x)) {
399 Walk(x.names, mutator);
400 mutator.Post(x);
401 }
402}
403template <typename V>
404void Walk(const IntrinsicTypeSpec::Character &x, V &visitor) {
405 if (visitor.Pre(x)) {
406 Walk(x.selector, visitor);
407 visitor.Post(x);
408 }
409}
410template <typename M> void Walk(IntrinsicTypeSpec::Character &x, M &mutator) {
411 if (mutator.Pre(x)) {
412 Walk(x.selector, mutator);
413 mutator.Post(x);
414 }
415}
416template <typename V>
417void Walk(const IntrinsicTypeSpec::Complex &x, V &visitor) {
418 if (visitor.Pre(x)) {
419 Walk(x.kind, visitor);
420 visitor.Post(x);
421 }
422}
423template <typename M> void Walk(IntrinsicTypeSpec::Complex &x, M &mutator) {
424 if (mutator.Pre(x)) {
425 Walk(x.kind, mutator);
426 mutator.Post(x);
427 }
428}
429template <typename V>
430void Walk(const IntrinsicTypeSpec::Logical &x, V &visitor) {
431 if (visitor.Pre(x)) {
432 Walk(x.kind, visitor);
433 visitor.Post(x);
434 }
435}
436template <typename M> void Walk(IntrinsicTypeSpec::Logical &x, M &mutator) {
437 if (mutator.Pre(x)) {
438 Walk(x.kind, mutator);
439 mutator.Post(x);
440 }
441}
442template <typename V> void Walk(const IntrinsicTypeSpec::Real &x, V &visitor) {
443 if (visitor.Pre(x)) {
444 Walk(x.kind, visitor);
445 visitor.Post(x);
446 }
447}
448template <typename M> void Walk(IntrinsicTypeSpec::Real &x, M &mutator) {
449 if (mutator.Pre(x)) {
450 Walk(x.kind, mutator);
451 mutator.Post(x);
452 }
453}
454template <typename A, typename B, typename V>
455void Walk(const LoopBounds<A, B> &x, V &visitor) {
456 if (visitor.Pre(x)) {
457 Walk(x.name, visitor);
458 Walk(x.lower, visitor);
459 Walk(x.upper, visitor);
460 Walk(x.step, visitor);
461 visitor.Post(x);
462 }
463}
464template <typename A, typename B, typename M>
465void Walk(LoopBounds<A, B> &x, M &mutator) {
466 if (mutator.Pre(x)) {
467 Walk(x.name, mutator);
468 Walk(x.lower, mutator);
469 Walk(x.upper, mutator);
470 Walk(x.step, mutator);
471 mutator.Post(x);
472 }
473}
474template <typename V> void Walk(const CommonStmt &x, V &visitor) {
475 if (visitor.Pre(x)) {
476 Walk(x.blocks, visitor);
477 visitor.Post(x);
478 }
479}
480template <typename M> void Walk(CommonStmt &x, M &mutator) {
481 if (mutator.Pre(x)) {
482 Walk(x.blocks, mutator);
483 mutator.Post(x);
484 }
485}
486template <typename V> void Walk(const Expr &x, V &visitor) {
487 if (visitor.Pre(x)) {
488 Walk(x.source, visitor);
489 Walk(x.u, visitor);
490 visitor.Post(x);
491 }
492}
493template <typename M> void Walk(Expr &x, M &mutator) {
494 if (mutator.Pre(x)) {
495 Walk(x.source, mutator);
496 Walk(x.u, mutator);
497 mutator.Post(x);
498 }
499}
500template <typename V> void Walk(const Designator &x, V &visitor) {
501 if (visitor.Pre(x)) {
502 Walk(x.source, visitor);
503 Walk(x.u, visitor);
504 visitor.Post(x);
505 }
506}
507template <typename M> void Walk(Designator &x, M &mutator) {
508 if (mutator.Pre(x)) {
509 Walk(x.source, mutator);
510 Walk(x.u, mutator);
511 mutator.Post(x);
512 }
513}
514template <typename V> void Walk(const Call &x, V &visitor) {
515 if (visitor.Pre(x)) {
516 Walk(x.source, visitor);
517 Walk(x.t, visitor);
518 visitor.Post(x);
519 }
520}
521template <typename M> void Walk(Call &x, M &mutator) {
522 if (mutator.Pre(x)) {
523 Walk(x.source, mutator);
524 Walk(x.t, mutator);
525 mutator.Post(x);
526 }
527}
528template <typename V> void Walk(const PartRef &x, V &visitor) {
529 if (visitor.Pre(x)) {
530 Walk(x.name, visitor);
531 Walk(x.subscripts, visitor);
532 Walk(x.imageSelector, visitor);
533 visitor.Post(x);
534 }
535}
536template <typename M> void Walk(PartRef &x, M &mutator) {
537 if (mutator.Pre(x)) {
538 Walk(x.name, mutator);
539 Walk(x.subscripts, mutator);
540 Walk(x.imageSelector, mutator);
541 mutator.Post(x);
542 }
543}
544template <typename V> void Walk(const ReadStmt &x, V &visitor) {
545 if (visitor.Pre(x)) {
546 Walk(x.iounit, visitor);
547 Walk(x.format, visitor);
548 Walk(x.controls, visitor);
549 Walk(x.items, visitor);
550 visitor.Post(x);
551 }
552}
553template <typename M> void Walk(ReadStmt &x, M &mutator) {
554 if (mutator.Pre(x)) {
555 Walk(x.iounit, mutator);
556 Walk(x.format, mutator);
557 Walk(x.controls, mutator);
558 Walk(x.items, mutator);
559 mutator.Post(x);
560 }
561}
562template <typename V> void Walk(const SignedIntLiteralConstant &x, V &visitor) {
563 if (visitor.Pre(x)) {
564 Walk(x.source, visitor);
565 Walk(x.t, visitor);
566 visitor.Post(x);
567 }
568}
569template <typename M> void Walk(SignedIntLiteralConstant &x, M &mutator) {
570 if (mutator.Pre(x)) {
571 Walk(x.source, mutator);
572 Walk(x.t, mutator);
573 mutator.Post(x);
574 }
575}
576template <typename V> void Walk(const RealLiteralConstant &x, V &visitor) {
577 if (visitor.Pre(x)) {
578 Walk(x.real, visitor);
579 Walk(x.kind, visitor);
580 visitor.Post(x);
581 }
582}
583template <typename M> void Walk(RealLiteralConstant &x, M &mutator) {
584 if (mutator.Pre(x)) {
585 Walk(x.real, mutator);
586 Walk(x.kind, mutator);
587 mutator.Post(x);
588 }
589}
590template <typename V>
591void Walk(const RealLiteralConstant::Real &x, V &visitor) {
592 if (visitor.Pre(x)) {
593 Walk(x.source, visitor);
594 visitor.Post(x);
595 }
596}
597template <typename M> void Walk(RealLiteralConstant::Real &x, M &mutator) {
598 if (mutator.Pre(x)) {
599 Walk(x.source, mutator);
600 mutator.Post(x);
601 }
602}
603template <typename V> void Walk(const StructureComponent &x, V &visitor) {
604 if (visitor.Pre(x)) {
605 Walk(x.base, visitor);
606 Walk(x.component, visitor);
607 visitor.Post(x);
608 }
609}
610template <typename M> void Walk(StructureComponent &x, M &mutator) {
611 if (mutator.Pre(x)) {
612 Walk(x.base, mutator);
613 Walk(x.component, mutator);
614 mutator.Post(x);
615 }
616}
617template <typename V> void Walk(const Suffix &x, V &visitor) {
618 if (visitor.Pre(x)) {
619 Walk(x.binding, visitor);
620 Walk(x.resultName, visitor);
621 visitor.Post(x);
622 }
623}
624template <typename M> void Walk(Suffix &x, M &mutator) {
625 if (mutator.Pre(x)) {
626 Walk(x.binding, mutator);
627 Walk(x.resultName, mutator);
628 mutator.Post(x);
629 }
630}
631template <typename V>
632void Walk(const TypeBoundProcedureStmt::WithInterface &x, V &visitor) {
633 if (visitor.Pre(x)) {
634 Walk(x.interfaceName, visitor);
635 Walk(x.attributes, visitor);
636 Walk(x.bindingNames, visitor);
637 visitor.Post(x);
638 }
639}
640template <typename M>
641void Walk(TypeBoundProcedureStmt::WithInterface &x, M &mutator) {
642 if (mutator.Pre(x)) {
643 Walk(x.interfaceName, mutator);
644 Walk(x.attributes, mutator);
645 Walk(x.bindingNames, mutator);
646 mutator.Post(x);
647 }
648}
649template <typename V>
650void Walk(const TypeBoundProcedureStmt::WithoutInterface &x, V &visitor) {
651 if (visitor.Pre(x)) {
652 Walk(x.attributes, visitor);
653 Walk(x.declarations, visitor);
654 visitor.Post(x);
655 }
656}
657template <typename M>
658void Walk(TypeBoundProcedureStmt::WithoutInterface &x, M &mutator) {
659 if (mutator.Pre(x)) {
660 Walk(x.attributes, mutator);
661 Walk(x.declarations, mutator);
662 mutator.Post(x);
663 }
664}
665template <typename V> void Walk(const UseStmt &x, V &visitor) {
666 if (visitor.Pre(x)) {
667 Walk(x.nature, visitor);
668 Walk(x.moduleName, visitor);
669 Walk(x.u, visitor);
670 visitor.Post(x);
671 }
672}
673template <typename M> void Walk(UseStmt &x, M &mutator) {
674 if (mutator.Pre(x)) {
675 Walk(x.nature, mutator);
676 Walk(x.moduleName, mutator);
677 Walk(x.u, mutator);
678 mutator.Post(x);
679 }
680}
681template <typename V> void Walk(const WriteStmt &x, V &visitor) {
682 if (visitor.Pre(x)) {
683 Walk(x.iounit, visitor);
684 Walk(x.format, visitor);
685 Walk(x.controls, visitor);
686 Walk(x.items, visitor);
687 visitor.Post(x);
688 }
689}
690template <typename M> void Walk(WriteStmt &x, M &mutator) {
691 if (mutator.Pre(x)) {
692 Walk(x.iounit, mutator);
693 Walk(x.format, mutator);
694 Walk(x.controls, mutator);
695 Walk(x.items, mutator);
696 mutator.Post(x);
697 }
698}
699template <typename V> void Walk(const format::ControlEditDesc &x, V &visitor) {
700 if (visitor.Pre(x)) {
701 Walk(x.kind, visitor);
702 visitor.Post(x);
703 }
704}
705template <typename M> void Walk(format::ControlEditDesc &x, M &mutator) {
706 if (mutator.Pre(x)) {
707 Walk(x.kind, mutator);
708 mutator.Post(x);
709 }
710}
711template <typename V>
712void Walk(const format::DerivedTypeDataEditDesc &x, V &visitor) {
713 if (visitor.Pre(x)) {
714 Walk(x.type, visitor);
715 Walk(x.parameters, visitor);
716 visitor.Post(x);
717 }
718}
719template <typename M>
720void Walk(format::DerivedTypeDataEditDesc &x, M &mutator) {
721 if (mutator.Pre(x)) {
722 Walk(x.type, mutator);
723 Walk(x.parameters, mutator);
724 mutator.Post(x);
725 }
726}
727template <typename V> void Walk(const format::FormatItem &x, V &visitor) {
728 if (visitor.Pre(x)) {
729 Walk(x.repeatCount, visitor);
730 Walk(x.u, visitor);
731 visitor.Post(x);
732 }
733}
734template <typename M> void Walk(format::FormatItem &x, M &mutator) {
735 if (mutator.Pre(x)) {
736 Walk(x.repeatCount, mutator);
737 Walk(x.u, mutator);
738 mutator.Post(x);
739 }
740}
741template <typename V>
742void Walk(const format::FormatSpecification &x, V &visitor) {
743 if (visitor.Pre(x)) {
744 Walk(x.items, visitor);
745 Walk(x.unlimitedItems, visitor);
746 visitor.Post(x);
747 }
748}
749template <typename M> void Walk(format::FormatSpecification &x, M &mutator) {
750 if (mutator.Pre(x)) {
751 Walk(x.items, mutator);
752 Walk(x.unlimitedItems, mutator);
753 mutator.Post(x);
754 }
755}
756template <typename V>
757void Walk(const format::IntrinsicTypeDataEditDesc &x, V &visitor) {
758 if (visitor.Pre(x)) {
759 Walk(x.kind, visitor);
760 Walk(x.width, visitor);
761 Walk(x.digits, visitor);
762 Walk(x.exponentWidth, visitor);
763 visitor.Post(x);
764 }
765}
766template <typename M>
767void Walk(format::IntrinsicTypeDataEditDesc &x, M &mutator) {
768 if (mutator.Pre(x)) {
769 Walk(x.kind, mutator);
770 Walk(x.width, mutator);
771 Walk(x.digits, mutator);
772 Walk(x.exponentWidth, mutator);
773 mutator.Post(x);
774 }
775}
776template <typename V> void Walk(const CompilerDirective &x, V &visitor) {
777 if (visitor.Pre(x)) {
778 Walk(x.source, visitor);
779 Walk(x.u, visitor);
780 visitor.Post(x);
781 }
782}
783template <typename M> void Walk(CompilerDirective &x, M &mutator) {
784 if (mutator.Pre(x)) {
785 Walk(x.source, mutator);
786 Walk(x.u, mutator);
787 mutator.Post(x);
788 }
789}
790template <typename V>
791void Walk(const OmpLinearClause::WithModifier &x, V &visitor) {
792 if (visitor.Pre(x)) {
793 Walk(x.modifier, visitor);
794 Walk(x.names, visitor);
795 Walk(x.step, visitor);
796 visitor.Post(x);
797 }
798}
799template <typename M> void Walk(OmpLinearClause::WithModifier &x, M &mutator) {
800 if (mutator.Pre(x)) {
801 Walk(x.modifier, mutator);
802 Walk(x.names, mutator);
803 Walk(x.step, mutator);
804 mutator.Post(x);
805 }
806}
807template <typename V>
808void Walk(const OmpLinearClause::WithoutModifier &x, V &visitor) {
809 if (visitor.Pre(x)) {
810 Walk(x.names, visitor);
811 Walk(x.step, visitor);
812 visitor.Post(x);
813 }
814}
815template <typename M>
816void Walk(OmpLinearClause::WithoutModifier &x, M &mutator) {
817 if (mutator.Pre(x)) {
818 Walk(x.names, mutator);
819 Walk(x.step, mutator);
820 mutator.Post(x);
821 }
822}
823} // namespace Fortran::parser
824#endif // FORTRAN_PARSER_PARSE_TREE_VISITOR_H_