File: | build/source/flang/lib/Semantics/resolve-names.cpp |
Warning: | line 3107, column 5 Value stored to 'parentScope' is never read |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
1 | //===-- lib/Semantics/resolve-names.cpp -----------------------------------===// |
2 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
3 | // See https://llvm.org/LICENSE.txt for license information. |
4 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
5 | // |
6 | //===----------------------------------------------------------------------===// |
7 | |
8 | #include "resolve-names.h" |
9 | #include "assignment.h" |
10 | #include "definable.h" |
11 | #include "mod-file.h" |
12 | #include "pointer-assignment.h" |
13 | #include "program-tree.h" |
14 | #include "resolve-directives.h" |
15 | #include "resolve-names-utils.h" |
16 | #include "rewrite-parse-tree.h" |
17 | #include "flang/Common/Fortran.h" |
18 | #include "flang/Common/default-kinds.h" |
19 | #include "flang/Common/indirection.h" |
20 | #include "flang/Common/restorer.h" |
21 | #include "flang/Common/visit.h" |
22 | #include "flang/Evaluate/characteristics.h" |
23 | #include "flang/Evaluate/check-expression.h" |
24 | #include "flang/Evaluate/common.h" |
25 | #include "flang/Evaluate/fold-designator.h" |
26 | #include "flang/Evaluate/fold.h" |
27 | #include "flang/Evaluate/intrinsics.h" |
28 | #include "flang/Evaluate/tools.h" |
29 | #include "flang/Evaluate/type.h" |
30 | #include "flang/Parser/parse-tree-visitor.h" |
31 | #include "flang/Parser/parse-tree.h" |
32 | #include "flang/Parser/tools.h" |
33 | #include "flang/Semantics/attr.h" |
34 | #include "flang/Semantics/expression.h" |
35 | #include "flang/Semantics/scope.h" |
36 | #include "flang/Semantics/semantics.h" |
37 | #include "flang/Semantics/symbol.h" |
38 | #include "flang/Semantics/tools.h" |
39 | #include "flang/Semantics/type.h" |
40 | #include "llvm/Support/raw_ostream.h" |
41 | #include <list> |
42 | #include <map> |
43 | #include <set> |
44 | #include <stack> |
45 | |
46 | namespace Fortran::semantics { |
47 | |
48 | using namespace parser::literals; |
49 | |
50 | template <typename T> using Indirection = common::Indirection<T>; |
51 | using Message = parser::Message; |
52 | using Messages = parser::Messages; |
53 | using MessageFixedText = parser::MessageFixedText; |
54 | using MessageFormattedText = parser::MessageFormattedText; |
55 | |
56 | class ResolveNamesVisitor; |
57 | class ScopeHandler; |
58 | |
59 | // ImplicitRules maps initial character of identifier to the DeclTypeSpec |
60 | // representing the implicit type; std::nullopt if none. |
61 | // It also records the presence of IMPLICIT NONE statements. |
62 | // When inheritFromParent is set, defaults come from the parent rules. |
63 | class ImplicitRules { |
64 | public: |
65 | ImplicitRules(SemanticsContext &context, ImplicitRules *parent) |
66 | : parent_{parent}, context_{context} { |
67 | inheritFromParent_ = parent != nullptr; |
68 | } |
69 | bool isImplicitNoneType() const; |
70 | bool isImplicitNoneExternal() const; |
71 | void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; } |
72 | void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; } |
73 | void set_inheritFromParent(bool x) { inheritFromParent_ = x; } |
74 | // Get the implicit type for this name. May be null. |
75 | const DeclTypeSpec *GetType( |
76 | SourceName, bool respectImplicitNone = true) const; |
77 | // Record the implicit type for the range of characters [fromLetter, |
78 | // toLetter]. |
79 | void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter, |
80 | parser::Location toLetter); |
81 | |
82 | private: |
83 | static char Incr(char ch); |
84 | |
85 | ImplicitRules *parent_; |
86 | SemanticsContext &context_; |
87 | bool inheritFromParent_{false}; // look in parent if not specified here |
88 | bool isImplicitNoneType_{ |
89 | context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)}; |
90 | bool isImplicitNoneExternal_{false}; |
91 | // map_ contains the mapping between letters and types that were defined |
92 | // by the IMPLICIT statements of the related scope. It does not contain |
93 | // the default Fortran mappings nor the mapping defined in parents. |
94 | std::map<char, common::Reference<const DeclTypeSpec>> map_; |
95 | |
96 | friend llvm::raw_ostream &operator<<( |
97 | llvm::raw_ostream &, const ImplicitRules &); |
98 | friend void ShowImplicitRule( |
99 | llvm::raw_ostream &, const ImplicitRules &, char); |
100 | }; |
101 | |
102 | // scope -> implicit rules for that scope |
103 | using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>; |
104 | |
105 | // Track statement source locations and save messages. |
106 | class MessageHandler { |
107 | public: |
108 | MessageHandler() { DIE("MessageHandler: default-constructed")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 | |
129 | private: |
130 | SemanticsContext *context_; |
131 | }; |
132 | |
133 | // Inheritance graph for the parse tree visitation classes that follow: |
134 | // BaseVisitor |
135 | // + AttrsVisitor |
136 | // | + DeclTypeSpecVisitor |
137 | // | + ImplicitRulesVisitor |
138 | // | + ScopeHandler -----------+--+ |
139 | // | + ModuleVisitor ========|==+ |
140 | // | + InterfaceVisitor | | |
141 | // | +-+ SubprogramVisitor ==|==+ |
142 | // + ArraySpecVisitor | | |
143 | // + DeclarationVisitor <--------+ | |
144 | // + ConstructVisitor | |
145 | // + ResolveNamesVisitor <------+ |
146 | |
147 | class BaseVisitor { |
148 | public: |
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 | |
227 | protected: |
228 | ImplicitRulesMap *implicitRulesMap_{nullptr}; |
229 | |
230 | private: |
231 | ResolveNamesVisitor *this_; |
232 | SemanticsContext *context_; |
233 | MessageHandler messageHandler_; |
234 | }; |
235 | |
236 | // Provide Post methods to collect attributes into a member variable. |
237 | class AttrsVisitor : public virtual BaseVisitor { |
238 | public: |
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 | |
282 | protected: |
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 | |
306 | private: |
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. |
316 | class DeclTypeSpecVisitor : public AttrsVisitor { |
317 | public: |
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 | |
340 | protected: |
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 | |
370 | private: |
371 | State state_; |
372 | |
373 | void MakeNumericType(TypeCategory, int kind); |
374 | }; |
375 | |
376 | // Visit ImplicitStmt and related parse tree nodes and updates implicit rules. |
377 | class ImplicitRulesVisitor : public DeclTypeSpecVisitor { |
378 | public: |
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 | |
406 | protected: |
407 | void BeginScope(const Scope &); |
408 | void SetScope(const Scope &); |
409 | |
410 | private: |
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 |
429 | class ArraySpecVisitor : public virtual BaseVisitor { |
430 | public: |
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 | |
437 | protected: |
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 | |
446 | private: |
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. |
463 | class FuncResultStack { |
464 | public: |
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 | |
491 | private: |
492 | ScopeHandler &scopeHandler_; |
493 | std::vector<FuncInfo> stack_; |
494 | }; |
495 | |
496 | // Manage a stack of Scopes |
497 | class ScopeHandler : public ImplicitRulesVisitor { |
498 | public: |
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 | |
662 | protected: |
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 | |
724 | private: |
725 | Scope *currScope_{nullptr}; |
726 | FuncResultStack funcResultStack_{*this}; |
727 | std::map<Scope *, DeferredDeclarationState> deferred_; |
728 | }; |
729 | |
730 | class ModuleVisitor : public virtual ScopeHandler { |
731 | public: |
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 | |
751 | private: |
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 | |
799 | class InterfaceVisitor : public virtual ScopeHandler { |
800 | public: |
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 | |
813 | protected: |
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 | |
818 | private: |
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 | |
840 | class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor { |
841 | public: |
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 | |
865 | protected: |
866 | // Set when we see a stmt function that is really an array element assignment |
867 | bool badStmtFuncFound_{false}; |
868 | |
869 | private: |
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 | |
887 | class DeclarationVisitor : public ArraySpecVisitor, |
888 | public virtual ScopeHandler { |
889 | public: |
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 | |
1001 | protected: |
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 | |
1048 | private: |
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. |
1166 | class ConstructVisitor : public virtual DeclarationVisitor { |
1167 | public: |
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 | |
1242 | private: |
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 |
1284 | class AccVisitor : public virtual DeclarationVisitor { |
1285 | public: |
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 | |
1315 | bool 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 | |
1330 | void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) { |
1331 | messageHandler().set_currStmtSource(source); |
1332 | currScope().AddSourceRange(source); |
1333 | } |
1334 | |
1335 | bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) { |
1336 | if (NeedsScope(x)) { |
1337 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
1338 | } |
1339 | return true; |
1340 | } |
1341 | |
1342 | void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) { |
1343 | if (NeedsScope(x)) { |
1344 | PopScope(); |
1345 | } |
1346 | } |
1347 | |
1348 | // Create scopes for OpenMP constructs |
1349 | class OmpVisitor : public virtual DeclarationVisitor { |
1350 | public: |
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 | |
1413 | bool 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 | |
1426 | void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) { |
1427 | messageHandler().set_currStmtSource(source); |
1428 | currScope().AddSourceRange(source); |
1429 | } |
1430 | |
1431 | bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) { |
1432 | if (NeedsScope(x)) { |
1433 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
1434 | } |
1435 | return true; |
1436 | } |
1437 | |
1438 | void 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. |
1445 | class ResolveNamesVisitor : public virtual ScopeHandler, |
1446 | public ModuleVisitor, |
1447 | public SubprogramVisitor, |
1448 | public ConstructVisitor, |
1449 | public OmpVisitor, |
1450 | public AccVisitor { |
1451 | public: |
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 | |
1536 | private: |
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 | |
1564 | bool 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 | |
1574 | bool 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 | |
1584 | const 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 | |
1602 | void 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'. |
1618 | char 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 | |
1631 | llvm::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 | } |
1642 | void 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 | |
1650 | template <typename T> void BaseVisitor::Walk(const T &x) { |
1651 | parser::Walk(x, *this_); |
1652 | } |
1653 | |
1654 | void 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 | |
1664 | bool 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 | } |
1669 | Attrs 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 | } |
1673 | Attrs AttrsVisitor::EndAttrs() { |
1674 | Attrs result{GetAttrs()}; |
1675 | attrs_.reset(); |
1676 | passName_ = std::nullopt; |
1677 | bindName_.reset(); |
1678 | return result; |
1679 | } |
1680 | |
1681 | bool 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 | |
1694 | void 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 | |
1728 | void 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 | } |
1736 | bool 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 | } |
1741 | bool 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 |
1752 | bool 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 |
1764 | bool 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 |
1775 | bool 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 | } |
1784 | bool 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 | |
1795 | const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { |
1796 | return state_.declTypeSpec; |
1797 | } |
1798 | |
1799 | void 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 | } |
1804 | void 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 | |
1809 | void 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 | |
1815 | bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) { |
1816 | BeginDeclTypeSpec(); |
1817 | return true; |
1818 | } |
1819 | void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { |
1820 | EndDeclTypeSpec(); |
1821 | } |
1822 | |
1823 | void 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 | |
1847 | void DeclTypeSpecVisitor::Post( |
1848 | const parser::IntrinsicTypeSpec::DoublePrecision &) { |
1849 | MakeNumericType(TypeCategory::Real, context().doublePrecisionKind()); |
1850 | } |
1851 | void DeclTypeSpecVisitor::Post( |
1852 | const parser::IntrinsicTypeSpec::DoubleComplex &) { |
1853 | MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind()); |
1854 | } |
1855 | void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { |
1856 | SetDeclTypeSpec(context().MakeNumericType(category, kind)); |
1857 | } |
1858 | |
1859 | void 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 | |
1865 | void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { |
1866 | SetDeclTypeSpec(context().globalScope().MakeClassStarType()); |
1867 | } |
1868 | void 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. |
1874 | void 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 | |
1880 | KindExpr DeclTypeSpecVisitor::GetKindParamExpr( |
1881 | TypeCategory category, const std::optional<parser::KindSelector> &kind) { |
1882 | return AnalyzeKindSelector(context(), category, kind); |
1883 | } |
1884 | |
1885 | // MessageHandler implementation |
1886 | |
1887 | Message &MessageHandler::Say(MessageFixedText &&msg) { |
1888 | return context_->Say(currStmtSource().value(), std::move(msg)); |
1889 | } |
1890 | Message &MessageHandler::Say(MessageFormattedText &&msg) { |
1891 | return context_->Say(currStmtSource().value(), std::move(msg)); |
1892 | } |
1893 | Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) { |
1894 | return Say(name, std::move(msg), name); |
1895 | } |
1896 | |
1897 | // ImplicitRulesVisitor implementation |
1898 | |
1899 | void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) { |
1900 | prevParameterStmt_ = currStmtSource(); |
1901 | } |
1902 | |
1903 | bool 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 | |
1924 | bool 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 | |
1939 | bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) { |
1940 | BeginDeclTypeSpec(); |
1941 | set_allowForwardReferenceToDerivedType(true); |
1942 | return true; |
1943 | } |
1944 | |
1945 | void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) { |
1946 | EndDeclTypeSpec(); |
1947 | } |
1948 | |
1949 | void 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 | } |
1956 | void 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 |
1963 | bool 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 | |
2022 | void 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 | } |
2026 | void 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 | } |
2030 | void 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 | |
2035 | const ArraySpec &ArraySpecVisitor::arraySpec() { |
2036 | return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_; |
2037 | } |
2038 | const ArraySpec &ArraySpecVisitor::coarraySpec() { |
2039 | return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_; |
2040 | } |
2041 | void 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 | } |
2047 | void 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 | } |
2053 | void 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 | |
2078 | FuncResultStack::~FuncResultStack() { CHECK(stack_.empty())((stack_.empty()) || (Fortran::common::die("CHECK(" "stack_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2078), false)); } |
2079 | |
2080 | void 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. |
2106 | void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) { |
2107 | if (FuncInfo * info{Top()}) { |
2108 | if (info->resultSymbol == &symbol) { |
2109 | CompleteFunctionResultType(); |
2110 | } |
2111 | } |
2112 | } |
2113 | |
2114 | void FuncResultStack::Pop() { |
2115 | if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) { |
2116 | stack_.pop_back(); |
2117 | } |
2118 | } |
2119 | |
2120 | // ScopeHandler implementation |
2121 | |
2122 | void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) { |
2123 | SayAlreadyDeclared(name.source, prev); |
2124 | } |
2125 | void 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 | } |
2140 | void 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 | |
2150 | void 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 | |
2157 | void 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 | |
2169 | void 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 | |
2176 | void 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 | } |
2183 | void 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 | } |
2187 | void 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 | } |
2193 | void 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). |
2203 | template <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 | |
2220 | Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); } |
2221 | |
2222 | Scope *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 | |
2234 | Scope &ScopeHandler::NonDerivedTypeScope() { |
2235 | return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_; |
2236 | } |
2237 | |
2238 | void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) { |
2239 | PushScope(currScope().MakeScope(kind, symbol)); |
2240 | } |
2241 | void 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 | } |
2272 | void 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 | } |
2284 | void ScopeHandler::SetScope(Scope &scope) { |
2285 | currScope_ = &scope; |
2286 | ImplicitRulesVisitor::SetScope(InclusiveScope()); |
2287 | } |
2288 | |
2289 | Symbol *ScopeHandler::FindSymbol(const parser::Name &name) { |
2290 | return FindSymbol(currScope(), name); |
2291 | } |
2292 | Symbol *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 | |
2309 | Symbol &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 | } |
2321 | Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) { |
2322 | return MakeSymbol(currScope(), name, attrs); |
2323 | } |
2324 | Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) { |
2325 | return Resolve(name, MakeSymbol(name.source, attrs)); |
2326 | } |
2327 | Symbol &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 | } |
2337 | Symbol &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. |
2343 | Symbol *ScopeHandler::FindInScope( |
2344 | const Scope &scope, const parser::Name &name) { |
2345 | return Resolve(name, FindInScope(scope, name.source)); |
2346 | } |
2347 | Symbol *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. |
2359 | Symbol *ScopeHandler::FindInTypeOrParents( |
2360 | const Scope &scope, const parser::Name &name) { |
2361 | return Resolve(name, scope.FindComponent(name.source)); |
2362 | } |
2363 | Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) { |
2364 | return FindInTypeOrParents(currScope(), name); |
2365 | } |
2366 | Symbol *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 | |
2381 | void ScopeHandler::EraseSymbol(const parser::Name &name) { |
2382 | currScope().erase(name.source); |
2383 | name.symbol = nullptr; |
2384 | } |
2385 | |
2386 | static 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 | |
2402 | void 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. |
2439 | bool 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. |
2474 | void 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 | |
2489 | const 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 | |
2508 | void 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. |
2519 | bool 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. |
2545 | bool 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 | |
2573 | const 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 | |
2583 | const DeclTypeSpec &ScopeHandler::MakeNumericType( |
2584 | TypeCategory category, int kind) { |
2585 | return context().MakeNumericType(category, kind); |
2586 | } |
2587 | |
2588 | const 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 | |
2598 | const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) { |
2599 | return context().MakeLogicalType(kind); |
2600 | } |
2601 | |
2602 | void 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 | |
2617 | std::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 | |
2626 | bool 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 | |
2656 | void 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 | |
2667 | bool 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 | |
2683 | bool 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 | |
2693 | bool 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 | |
2710 | bool 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 | } |
2722 | bool 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. |
2745 | bool 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 | |
2765 | void 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 | |
2798 | ModuleVisitor::SymbolRename ModuleVisitor::AddUse( |
2799 | const SourceName &localName, const SourceName &useName) { |
2800 | return AddUse(localName, useName, FindInScope(*useModuleScope_, useName)); |
2801 | } |
2802 | |
2803 | ModuleVisitor::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. |
2829 | static 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. |
2851 | void 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 | |
2865 | void 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 | |
3047 | void 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 |
3056 | Symbol &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 |
3065 | void 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 | |
3086 | bool 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(); |
Value stored to 'parentScope' is never read | |
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 | |
3117 | void 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. |
3130 | Scope *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 | |
3144 | void 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 | |
3155 | bool 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 | |
3161 | void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); } |
3162 | |
3163 | void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) { |
3164 | genericInfo_.pop(); |
3165 | } |
3166 | |
3167 | // Create a symbol in genericSymbol_ for this GenericSpec. |
3168 | bool 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 | |
3180 | bool 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 | |
3191 | bool InterfaceVisitor::Pre(const parser::GenericStmt &) { |
3192 | genericInfo_.emplace(/*isInterface*/ false); |
3193 | return true; |
3194 | } |
3195 | void 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 | |
3204 | bool InterfaceVisitor::inInterfaceBlock() const { |
3205 | return !genericInfo_.empty() && GetGenericInfo().isInterface; |
3206 | } |
3207 | bool InterfaceVisitor::isGeneric() const { |
3208 | return !genericInfo_.empty() && GetGenericInfo().symbol; |
3209 | } |
3210 | bool InterfaceVisitor::isAbstract() const { |
3211 | return !genericInfo_.empty() && GetGenericInfo().isAbstract; |
3212 | } |
3213 | |
3214 | void 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. |
3224 | void 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. |
3292 | void 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. |
3345 | bool 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 | |
3397 | bool 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 | |
3420 | bool 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 | |
3438 | bool 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 | } |
3443 | void 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 | } |
3448 | bool 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 | } |
3453 | void 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 | |
3460 | bool 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 | } |
3477 | bool 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 | } |
3483 | bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); } |
3484 | |
3485 | void 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 | |
3552 | Symbol &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 | |
3562 | void 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 | |
3570 | void 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 | |
3594 | void 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 | |
3739 | void 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 | |
3790 | Symbol *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 |
3817 | bool 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 |
3843 | bool 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 | |
3879 | void 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 | |
3896 | void 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 | |
3914 | bool 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 | |
3953 | void 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 | |
3969 | Symbol &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 | |
4012 | void 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. |
4032 | Symbol *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 | |
4094 | bool DeclarationVisitor::BeginDecl() { |
4095 | BeginDeclTypeSpec(); |
4096 | BeginArraySpec(); |
4097 | return BeginAttrs(); |
4098 | } |
4099 | void DeclarationVisitor::EndDecl() { |
4100 | EndDeclTypeSpec(); |
4101 | EndArraySpec(); |
4102 | EndAttrs(); |
4103 | } |
4104 | |
4105 | bool 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. |
4121 | void 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 | |
4130 | void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) { |
4131 | EndDecl(); |
4132 | } |
4133 | |
4134 | void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) { |
4135 | DeclareObjectEntity(std::get<parser::Name>(x.t)); |
4136 | } |
4137 | void DeclarationVisitor::Post(const parser::CodimensionDecl &x) { |
4138 | DeclareObjectEntity(std::get<parser::Name>(x.t)); |
4139 | } |
4140 | |
4141 | bool 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 | |
4148 | void 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 | |
4163 | void 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 | |
4189 | bool 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 | } |
4212 | bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) { |
4213 | inOldStyleParameterStmt_ = true; |
4214 | Walk(x.v); |
4215 | inOldStyleParameterStmt_ = false; |
4216 | return false; |
4217 | } |
4218 | bool 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 | } |
4270 | bool 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 | |
4280 | bool 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 | |
4331 | void DeclarationVisitor::Post(const parser::EnumDef &) { |
4332 | enumerationState_ = EnumeratorState{}; |
4333 | } |
4334 | |
4335 | bool 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 | |
4346 | bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) { |
4347 | return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v); |
4348 | } |
4349 | bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) { |
4350 | return HandleAttributeStmt(Attr::CONTIGUOUS, x.v); |
4351 | } |
4352 | bool 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 | } |
4376 | bool 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 | } |
4382 | bool 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 | } |
4411 | bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) { |
4412 | return CheckNotInBlock("OPTIONAL") && // C1107 |
4413 | HandleAttributeStmt(Attr::OPTIONAL, x.v); |
4414 | } |
4415 | bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) { |
4416 | return HandleAttributeStmt(Attr::PROTECTED, x.v); |
4417 | } |
4418 | bool DeclarationVisitor::Pre(const parser::ValueStmt &x) { |
4419 | return CheckNotInBlock("VALUE") && // C1107 |
4420 | HandleAttributeStmt(Attr::VALUE, x.v); |
4421 | } |
4422 | bool 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. |
4426 | bool 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 | } |
4433 | Symbol &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 |
4461 | bool 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 | |
4471 | void 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. |
4478 | Symbol &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 | |
4496 | bool 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 | |
4521 | Symbol &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 | |
4549 | Symbol &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 | |
4586 | void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { |
4587 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); |
4588 | } |
4589 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) { |
4590 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); |
4591 | } |
4592 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) { |
4593 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind)); |
4594 | } |
4595 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) { |
4596 | SetDeclTypeSpec(MakeLogicalType(x.kind)); |
4597 | } |
4598 | void 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 | } |
4610 | void 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 | } |
4624 | void 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 | } |
4633 | void 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 | |
4639 | bool 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 | |
4651 | bool 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 | |
4656 | void 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 | |
4663 | bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) { |
4664 | SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); |
4665 | return true; |
4666 | } |
4667 | |
4668 | void 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 | |
4679 | void 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 | |
4754 | void 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. |
4773 | bool 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 ¶mName : 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 | |
4838 | bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) { |
4839 | return BeginAttrs(); |
4840 | } |
4841 | void 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 | |
4878 | void 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 | } |
4898 | bool 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 | |
4908 | bool 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 | } |
4922 | bool 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 | } |
4930 | void 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 | } |
4985 | void 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 | } |
4995 | bool 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 | } |
5008 | void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) { |
5009 | interfaceName_ = nullptr; |
5010 | hasBindCName_ = false; |
5011 | EndDecl(); |
5012 | } |
5013 | bool 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 | } |
5039 | bool 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 | } |
5043 | void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) { |
5044 | interfaceName_ = nullptr; |
5045 | } |
5046 | bool 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 | } |
5061 | void 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 | } |
5067 | void 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 | |
5088 | bool 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_. |
5094 | void 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 | |
5126 | void 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 | |
5132 | void 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 | |
5157 | void 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 | |
5189 | void 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 | |
5207 | void 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 | |
5227 | bool 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. |
5274 | bool 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 | |
5327 | bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) { |
5328 | Say("support for UNION"_todo_en_US); // TODO |
5329 | return true; |
5330 | } |
5331 | |
5332 | bool 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 | |
5340 | void DeclarationVisitor::Post(const parser::StructureField &x) { |
5341 | if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>( |
5342 | x.u)) { |
5343 | EndDecl(); |
5344 | } |
5345 | } |
5346 | |
5347 | bool DeclarationVisitor::Pre(const parser::AllocateStmt &) { |
5348 | BeginDeclTypeSpec(); |
5349 | return true; |
5350 | } |
5351 | void DeclarationVisitor::Post(const parser::AllocateStmt &) { |
5352 | EndDeclTypeSpec(); |
5353 | } |
5354 | |
5355 | bool 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 | |
5384 | bool 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) { |
5390 | pointer = &MakeSymbol(pointerName, ObjectEntityDetails{}); |
5391 | } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) { |
5392 | SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US); |
5393 | } else if (pointer->Rank() > 0) { |
5394 | SayWithDecl(pointerName, *pointer, |
5395 | "Cray pointer '%s' must be a scalar"_err_en_US); |
5396 | } else if (pointer->test(Symbol::Flag::CrayPointee)) { |
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) { |
5405 | pointer->SetType(pointerType); |
5406 | } else if (*type != pointerType) { |
5407 | Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US, |
5408 | pointerName.source, pointerType.AsFortran()); |
5409 | } |
5410 | if (ResolveName(pointeeName)) { |
5411 | Symbol &pointee{*pointeeName.symbol}; |
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 | |
5456 | bool 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 | |
5472 | void 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 | |
5495 | bool 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 | |
5508 | bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { |
5509 | CheckNotInBlock("COMMON"); // C1107 |
5510 | return true; |
5511 | } |
5512 | |
5513 | bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) { |
5514 | BeginArraySpec(); |
5515 | return true; |
5516 | } |
5517 | |
5518 | void 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 | |
5529 | bool 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 | |
5539 | void 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 | |
5567 | bool 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 | |
5586 | void 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. |
5626 | Attrs 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. |
5634 | void 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. |
5644 | void 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 | |
5696 | Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { |
5697 | return Resolve(name, currScope().MakeCommonBlock(name.source)); |
5698 | } |
5699 | Symbol &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 | |
5708 | bool 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. |
5713 | void 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 | |
5751 | bool 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 |
5787 | bool 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 |
5801 | bool 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 | |
5853 | Symbol &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 | |
5866 | Symbol *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 | |
5874 | Symbol *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. |
5909 | void 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 | |
5955 | std::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 | |
5999 | std::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 | |
6012 | Symbol *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 | |
6022 | void 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. |
6037 | Symbol *DeclarationVisitor::MakeTypeSymbol( |
6038 | const parser::Name &name, Details &&details) { |
6039 | return Resolve(name, MakeTypeSymbol(name.source, std::move(details))); |
6040 | } |
6041 | Symbol *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. |
6069 | bool 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 | |
6112 | ParamValue 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 | |
6129 | void 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. |
6171 | bool 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 | |
6185 | bool 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 | |
6194 | bool 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 | |
6203 | bool 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 | |
6217 | bool 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 |
6225 | bool 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 | |
6247 | bool 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. |
6272 | bool 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 | |
6288 | bool 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 | |
6314 | bool 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 | |
6331 | bool ConstructVisitor::Pre(const parser::DoConstruct &x) { |
6332 | if (x.IsDoConcurrent()) { |
6333 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
6334 | } |
6335 | return true; |
6336 | } |
6337 | void ConstructVisitor::Post(const parser::DoConstruct &x) { |
6338 | if (x.IsDoConcurrent()) { |
6339 | PopScope(); |
6340 | } |
6341 | } |
6342 | |
6343 | bool ConstructVisitor::Pre(const parser::ForallConstruct &) { |
6344 | PushScope(Scope::Kind::Forall, nullptr); |
6345 | return true; |
6346 | } |
6347 | void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); } |
6348 | bool ConstructVisitor::Pre(const parser::ForallStmt &) { |
6349 | PushScope(Scope::Kind::Forall, nullptr); |
6350 | return true; |
6351 | } |
6352 | void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); } |
6353 | |
6354 | bool ConstructVisitor::Pre(const parser::BlockStmt &x) { |
6355 | CheckDef(x.v); |
6356 | PushScope(Scope::Kind::BlockConstruct, nullptr); |
6357 | return false; |
6358 | } |
6359 | bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) { |
6360 | PopScope(); |
6361 | CheckRef(x.v); |
6362 | return false; |
6363 | } |
6364 | |
6365 | void ConstructVisitor::Post(const parser::Selector &x) { |
6366 | GetCurrentAssociation().selector = ResolveSelector(x); |
6367 | } |
6368 | |
6369 | void 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 | |
6386 | void ConstructVisitor::Post(const parser::EndAssociateStmt &x) { |
6387 | PopScope(); |
6388 | CheckRef(x.v); |
6389 | } |
6390 | |
6391 | bool 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 | |
6398 | bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) { |
6399 | CheckDef(x.t); |
6400 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
6401 | PushAssociation(); |
6402 | return true; |
6403 | } |
6404 | |
6405 | void 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 | |
6424 | void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) { |
6425 | PopAssociation(); |
6426 | PopScope(); |
6427 | CheckRef(x.t); |
6428 | } |
6429 | |
6430 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) { |
6431 | PushAssociation(); |
6432 | return true; |
6433 | } |
6434 | |
6435 | void ConstructVisitor::Post(const parser::SelectTypeConstruct &) { |
6436 | PopAssociation(); |
6437 | } |
6438 | |
6439 | void 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 | |
6480 | void 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 | |
6489 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) { |
6490 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
6491 | return true; |
6492 | } |
6493 | void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) { |
6494 | PopScope(); |
6495 | } |
6496 | |
6497 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) { |
6498 | PushScope(Scope::Kind::OtherConstruct, nullptr); |
6499 | return true; |
6500 | } |
6501 | void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) { |
6502 | PopScope(); |
6503 | } |
6504 | |
6505 | bool 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 | |
6513 | void 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 | |
6524 | void 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 | |
6537 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) { |
6538 | PushAssociation(); |
6539 | return true; |
6540 | } |
6541 | |
6542 | void ConstructVisitor::Post(const parser::SelectRankConstruct &) { |
6543 | PopAssociation(); |
6544 | } |
6545 | |
6546 | bool 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 | |
6564 | void 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. |
6572 | Symbol *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. |
6597 | void 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. |
6624 | void 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 | |
6633 | ConstructVisitor::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. |
6649 | void 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 | |
6654 | ConstructVisitor::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 | |
6659 | void ConstructVisitor::PushAssociation() { |
6660 | associationStack_.emplace_back(Association{}); |
6661 | currentAssociation_ = &associationStack_.back(); |
6662 | } |
6663 | |
6664 | void 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 | |
6671 | const 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 | |
6699 | const 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 | |
6715 | bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) { |
6716 | HandleCall(Symbol::Flag::Function, x.v); |
6717 | return false; |
6718 | } |
6719 | bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) { |
6720 | HandleCall(Symbol::Flag::Subroutine, x.v); |
6721 | return false; |
6722 | } |
6723 | |
6724 | bool 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 | |
6776 | const parser::Name *DeclarationVisitor::ResolveStructureComponent( |
6777 | const parser::StructureComponent &x) { |
6778 | return FindComponent(ResolveDataRef(x.base), x.component); |
6779 | } |
6780 | |
6781 | const 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 | |
6794 | const 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. |
6825 | const 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(). |
6883 | bool 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 | |
6915 | bool 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). |
6928 | const 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 | |
7001 | void 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 | |
7051 | void 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 | } |
7073 | void 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 | |
7100 | void 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 | |
7131 | void 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 | |
7150 | void 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 | |
7219 | bool 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. |
7235 | void 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 | |
7260 | static 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 | |
7267 | static 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. |
7273 | bool 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 | |
7307 | bool 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. |
7337 | Symbol &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 | |
7357 | static 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 | |
7371 | bool 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. |
7398 | void 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 | |
7422 | void 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 | |
7437 | void 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 | |
7494 | void 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.) |
7547 | void 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 | |
7578 | void 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 | |
7603 | void 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 | |
7615 | bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { |
7616 | return CheckNotInBlock("IMPLICIT") && // C1107 |
7617 | ImplicitRulesVisitor::Pre(x); |
7618 | } |
7619 | |
7620 | void 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 | } |
7629 | void 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 | |
7639 | bool 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 | } |
7661 | void ResolveNamesVisitor::Post(const parser::Designator &x) { |
7662 | ResolveDesignator(x); |
7663 | } |
7664 | void 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 | |
7669 | void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) { |
7670 | ResolveStructureComponent(x.v.thing); |
7671 | } |
7672 | void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) { |
7673 | DeclTypeSpecVisitor::Post(x); |
7674 | ConstructVisitor::Post(x); |
7675 | } |
7676 | bool 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 | |
7689 | bool 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 | |
7703 | void 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 | } |
7709 | void 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 | |
7716 | void 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 | |
7806 | bool 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 | |
7822 | template <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 | |
7836 | bool 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. |
7920 | class ExecutionPartSkimmer { |
7921 | public: |
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 | |
7940 | private: |
7941 | ResolveNamesVisitor &resolver_; |
7942 | }; |
7943 | |
7944 | // Build the scope tree and resolve names in the specification parts of this |
7945 | // node and its children |
7946 | void 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. |
7996 | void 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. |
8037 | bool 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 | |
8061 | void 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. |
8093 | class DeferredCheckVisitor { |
8094 | public: |
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 | |
8153 | private: |
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. |
8170 | void 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. |
8196 | void 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 |
8226 | void 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 | |
8241 | void 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. |
8251 | static ImplicitRulesMap *sharedImplicitRulesMap{nullptr}; |
8252 | |
8253 | bool 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. |
8263 | void 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 |