Bug Summary

File:build/source/flang/lib/Semantics/resolve-names.cpp
Warning:line 5411, column 7
Dereference of null pointer

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