File: | build/source/flang/lib/Semantics/resolve-names.cpp |
Warning: | line 5093, column 7 Called C++ object pointer is null |
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 *FindSeparateModuleProcedureInterface(const parser::Name &); | |||
557 | void EraseSymbol(const parser::Name &); | |||
558 | void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); } | |||
559 | // Make a new symbol with the name and attrs of an existing one | |||
560 | Symbol &CopySymbol(const SourceName &, const Symbol &); | |||
561 | ||||
562 | // Make symbols in the current or named scope | |||
563 | Symbol &MakeSymbol(Scope &, const SourceName &, Attrs); | |||
564 | Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{}); | |||
565 | Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{}); | |||
566 | Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &); | |||
567 | ||||
568 | template <typename D> | |||
569 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
570 | const parser::Name &name, D &&details) { | |||
571 | return MakeSymbol(name, Attrs{}, std::move(details)); | |||
572 | } | |||
573 | ||||
574 | template <typename D> | |||
575 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
576 | const parser::Name &name, const Attrs &attrs, D &&details) { | |||
577 | return Resolve(name, MakeSymbol(name.source, attrs, std::move(details))); | |||
578 | } | |||
579 | ||||
580 | template <typename D> | |||
581 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
582 | const SourceName &name, const Attrs &attrs, D &&details) { | |||
583 | // Note: don't use FindSymbol here. If this is a derived type scope, | |||
584 | // we want to detect whether the name is already declared as a component. | |||
585 | auto *symbol{FindInScope(name)}; | |||
586 | if (!symbol) { | |||
587 | symbol = &MakeSymbol(name, attrs); | |||
588 | symbol->set_details(std::move(details)); | |||
589 | return *symbol; | |||
590 | } | |||
591 | if constexpr (std::is_same_v<DerivedTypeDetails, D>) { | |||
592 | if (auto *d{symbol->detailsIf<GenericDetails>()}) { | |||
593 | if (!d->specific()) { | |||
594 | // derived type with same name as a generic | |||
595 | auto *derivedType{d->derivedType()}; | |||
596 | if (!derivedType) { | |||
597 | derivedType = | |||
598 | &currScope().MakeSymbol(name, attrs, std::move(details)); | |||
599 | d->set_derivedType(*derivedType); | |||
600 | } else if (derivedType->CanReplaceDetails(details)) { | |||
601 | // was forward-referenced | |||
602 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
603 | SetExplicitAttrs(*derivedType, attrs); | |||
604 | derivedType->set_details(std::move(details)); | |||
605 | } else { | |||
606 | SayAlreadyDeclared(name, *derivedType); | |||
607 | } | |||
608 | return *derivedType; | |||
609 | } | |||
610 | } | |||
611 | } | |||
612 | if (symbol->CanReplaceDetails(details)) { | |||
613 | // update the existing symbol | |||
614 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
615 | SetExplicitAttrs(*symbol, attrs); | |||
616 | if constexpr (std::is_same_v<SubprogramDetails, D>) { | |||
617 | // Dummy argument defined by explicit interface? | |||
618 | details.set_isDummy(IsDummy(*symbol)); | |||
619 | } | |||
620 | symbol->set_details(std::move(details)); | |||
621 | return *symbol; | |||
622 | } else if constexpr (std::is_same_v<UnknownDetails, D>) { | |||
623 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
624 | SetExplicitAttrs(*symbol, attrs); | |||
625 | return *symbol; | |||
626 | } else { | |||
627 | if (!CheckPossibleBadForwardRef(*symbol)) { | |||
628 | if (name.empty() && symbol->name().empty()) { | |||
629 | // report the error elsewhere | |||
630 | return *symbol; | |||
631 | } | |||
632 | SayAlreadyDeclared(name, *symbol); | |||
633 | } | |||
634 | // replace the old symbol with a new one with correct details | |||
635 | EraseSymbol(*symbol); | |||
636 | auto &result{MakeSymbol(name, attrs, std::move(details))}; | |||
637 | context().SetError(result); | |||
638 | return result; | |||
639 | } | |||
640 | } | |||
641 | ||||
642 | void MakeExternal(Symbol &); | |||
643 | ||||
644 | // C815 duplicated attribute checking; returns false on error | |||
645 | bool CheckDuplicatedAttr(SourceName, const Symbol &, Attr); | |||
646 | bool CheckDuplicatedAttrs(SourceName, const Symbol &, Attrs); | |||
647 | ||||
648 | void SetExplicitAttr(Symbol &symbol, Attr attr) const { | |||
649 | symbol.attrs().set(attr); | |||
650 | symbol.implicitAttrs().reset(attr); | |||
651 | } | |||
652 | void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const { | |||
653 | symbol.attrs() |= attrs; | |||
654 | symbol.implicitAttrs() &= ~attrs; | |||
655 | } | |||
656 | void SetImplicitAttr(Symbol &symbol, Attr attr) const { | |||
657 | symbol.attrs().set(attr); | |||
658 | symbol.implicitAttrs().set(attr); | |||
659 | } | |||
660 | ||||
661 | protected: | |||
662 | FuncResultStack &funcResultStack() { return funcResultStack_; } | |||
663 | ||||
664 | // Apply the implicit type rules to this symbol. | |||
665 | void ApplyImplicitRules(Symbol &, bool allowForwardReference = false); | |||
666 | bool ImplicitlyTypeForwardRef(Symbol &); | |||
667 | void AcquireIntrinsicProcedureFlags(Symbol &); | |||
668 | const DeclTypeSpec *GetImplicitType( | |||
669 | Symbol &, bool respectImplicitNoneType = true); | |||
670 | void CheckEntryDummyUse(SourceName, Symbol *); | |||
671 | bool ConvertToObjectEntity(Symbol &); | |||
672 | bool ConvertToProcEntity(Symbol &); | |||
673 | ||||
674 | const DeclTypeSpec &MakeNumericType( | |||
675 | TypeCategory, const std::optional<parser::KindSelector> &); | |||
676 | const DeclTypeSpec &MakeNumericType(TypeCategory, int); | |||
677 | const DeclTypeSpec &MakeLogicalType( | |||
678 | const std::optional<parser::KindSelector> &); | |||
679 | const DeclTypeSpec &MakeLogicalType(int); | |||
680 | void NotePossibleBadForwardRef(const parser::Name &); | |||
681 | std::optional<SourceName> HadForwardRef(const Symbol &) const; | |||
682 | bool CheckPossibleBadForwardRef(const Symbol &); | |||
683 | ||||
684 | bool inSpecificationPart_{false}; | |||
685 | bool inEquivalenceStmt_{false}; | |||
686 | ||||
687 | // Some information is collected from a specification part for deferred | |||
688 | // processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts()) | |||
689 | // that are called by ResolveNamesVisitor::FinishSpecificationPart(). Since | |||
690 | // specification parts can nest (e.g., INTERFACE bodies), the collected | |||
691 | // information that is not contained in the scope needs to be packaged | |||
692 | // and restorable. | |||
693 | struct SpecificationPartState { | |||
694 | std::set<SourceName> forwardRefs; | |||
695 | // Collect equivalence sets and process at end of specification part | |||
696 | std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets; | |||
697 | // Names of all common block objects in the scope | |||
698 | std::set<SourceName> commonBlockObjects; | |||
699 | // Info about about SAVE statements and attributes in current scope | |||
700 | struct { | |||
701 | std::optional<SourceName> saveAll; // "SAVE" without entity list | |||
702 | std::set<SourceName> entities; // names of entities with save attr | |||
703 | std::set<SourceName> commons; // names of common blocks with save attr | |||
704 | } saveInfo; | |||
705 | } specPartState_; | |||
706 | ||||
707 | // Some declaration processing can and should be deferred to | |||
708 | // ResolveExecutionParts() to avoid prematurely creating implicitly-typed | |||
709 | // local symbols that should be host associations. | |||
710 | struct DeferredDeclarationState { | |||
711 | // The content of each namelist group | |||
712 | std::list<const parser::NamelistStmt::Group *> namelistGroups; | |||
713 | }; | |||
714 | DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) { | |||
715 | if (!add && deferred_.find(&currScope()) == deferred_.end()) { | |||
716 | return nullptr; | |||
717 | } else { | |||
718 | return &deferred_.emplace(&currScope(), DeferredDeclarationState{}) | |||
719 | .first->second; | |||
720 | } | |||
721 | } | |||
722 | ||||
723 | private: | |||
724 | Scope *currScope_{nullptr}; | |||
725 | FuncResultStack funcResultStack_{*this}; | |||
726 | std::map<Scope *, DeferredDeclarationState> deferred_; | |||
727 | }; | |||
728 | ||||
729 | class ModuleVisitor : public virtual ScopeHandler { | |||
730 | public: | |||
731 | bool Pre(const parser::AccessStmt &); | |||
732 | bool Pre(const parser::Only &); | |||
733 | bool Pre(const parser::Rename::Names &); | |||
734 | bool Pre(const parser::Rename::Operators &); | |||
735 | bool Pre(const parser::UseStmt &); | |||
736 | void Post(const parser::UseStmt &); | |||
737 | ||||
738 | void BeginModule(const parser::Name &, bool isSubmodule); | |||
739 | bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &); | |||
740 | void ApplyDefaultAccess(); | |||
741 | Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &); | |||
742 | void AddAndCheckExplicitIntrinsicUse(SourceName, bool isIntrinsic); | |||
743 | void ClearUseRenames() { useRenames_.clear(); } | |||
744 | void ClearUseOnly() { useOnly_.clear(); } | |||
745 | void ClearExplicitIntrinsicUses() { | |||
746 | explicitIntrinsicUses_.clear(); | |||
747 | explicitNonIntrinsicUses_.clear(); | |||
748 | } | |||
749 | ||||
750 | private: | |||
751 | // The default access spec for this module. | |||
752 | Attr defaultAccess_{Attr::PUBLIC}; | |||
753 | // The location of the last AccessStmt without access-ids, if any. | |||
754 | std::optional<SourceName> prevAccessStmt_; | |||
755 | // The scope of the module during a UseStmt | |||
756 | Scope *useModuleScope_{nullptr}; | |||
757 | // Names that have appeared in a rename clause of a USE statement | |||
758 | std::set<std::pair<SourceName, Scope *>> useRenames_; | |||
759 | // Names that have appeared in an ONLY clause of a USE statement | |||
760 | std::set<std::pair<SourceName, Scope *>> useOnly_; | |||
761 | // Module names that have appeared in USE statements with explicit | |||
762 | // INTRINSIC or NON_INTRINSIC keywords | |||
763 | std::set<SourceName> explicitIntrinsicUses_; | |||
764 | std::set<SourceName> explicitNonIntrinsicUses_; | |||
765 | ||||
766 | Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr); | |||
767 | // A rename in a USE statement: local => use | |||
768 | struct SymbolRename { | |||
769 | Symbol *local{nullptr}; | |||
770 | Symbol *use{nullptr}; | |||
771 | }; | |||
772 | // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol | |||
773 | SymbolRename AddUse(const SourceName &localName, const SourceName &useName); | |||
774 | SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *); | |||
775 | void DoAddUse( | |||
776 | SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol); | |||
777 | void AddUse(const GenericSpecInfo &); | |||
778 | // If appropriate, erase a previously USE-associated symbol | |||
779 | void EraseRenamedSymbol(const Symbol &); | |||
780 | // Record a name appearing in a USE rename clause | |||
781 | void AddUseRename(const SourceName &name) { | |||
782 | useRenames_.emplace(std::make_pair(name, useModuleScope_)); | |||
783 | } | |||
784 | bool IsUseRenamed(const SourceName &name) const { | |||
785 | return useRenames_.find({name, useModuleScope_}) != useRenames_.end(); | |||
786 | } | |||
787 | // Record a name appearing in a USE ONLY clause | |||
788 | void AddUseOnly(const SourceName &name) { | |||
789 | useOnly_.emplace(std::make_pair(name, useModuleScope_)); | |||
790 | } | |||
791 | bool IsUseOnly(const SourceName &name) const { | |||
792 | return useOnly_.find({name, useModuleScope_}) != useOnly_.end(); | |||
793 | } | |||
794 | Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic, | |||
795 | Scope *ancestor = nullptr); | |||
796 | }; | |||
797 | ||||
798 | class InterfaceVisitor : public virtual ScopeHandler { | |||
799 | public: | |||
800 | bool Pre(const parser::InterfaceStmt &); | |||
801 | void Post(const parser::InterfaceStmt &); | |||
802 | void Post(const parser::EndInterfaceStmt &); | |||
803 | bool Pre(const parser::GenericSpec &); | |||
804 | bool Pre(const parser::ProcedureStmt &); | |||
805 | bool Pre(const parser::GenericStmt &); | |||
806 | void Post(const parser::GenericStmt &); | |||
807 | ||||
808 | bool inInterfaceBlock() const; | |||
809 | bool isGeneric() const; | |||
810 | bool isAbstract() const; | |||
811 | ||||
812 | protected: | |||
813 | Symbol &GetGenericSymbol() { return DEREF(genericInfo_.top().symbol)Fortran::common::Deref(genericInfo_.top().symbol, "flang/lib/Semantics/resolve-names.cpp" , 813); } | |||
814 | // Add to generic the symbol for the subprogram with the same name | |||
815 | void CheckGenericProcedures(Symbol &); | |||
816 | ||||
817 | private: | |||
818 | // A new GenericInfo is pushed for each interface block and generic stmt | |||
819 | struct GenericInfo { | |||
820 | GenericInfo(bool isInterface, bool isAbstract = false) | |||
821 | : isInterface{isInterface}, isAbstract{isAbstract} {} | |||
822 | bool isInterface; // in interface block | |||
823 | bool isAbstract; // in abstract interface block | |||
824 | Symbol *symbol{nullptr}; // the generic symbol being defined | |||
825 | }; | |||
826 | std::stack<GenericInfo> genericInfo_; | |||
827 | const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); } | |||
828 | void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; } | |||
829 | ||||
830 | using ProcedureKind = parser::ProcedureStmt::Kind; | |||
831 | // mapping of generic to its specific proc names and kinds | |||
832 | std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>> | |||
833 | specificProcs_; | |||
834 | ||||
835 | void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind); | |||
836 | void ResolveSpecificsInGeneric(Symbol &generic); | |||
837 | }; | |||
838 | ||||
839 | class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor { | |||
840 | public: | |||
841 | bool HandleStmtFunction(const parser::StmtFunctionStmt &); | |||
842 | bool Pre(const parser::SubroutineStmt &); | |||
843 | bool Pre(const parser::FunctionStmt &); | |||
844 | void Post(const parser::FunctionStmt &); | |||
845 | bool Pre(const parser::EntryStmt &); | |||
846 | void Post(const parser::EntryStmt &); | |||
847 | bool Pre(const parser::InterfaceBody::Subroutine &); | |||
848 | void Post(const parser::InterfaceBody::Subroutine &); | |||
849 | bool Pre(const parser::InterfaceBody::Function &); | |||
850 | void Post(const parser::InterfaceBody::Function &); | |||
851 | bool Pre(const parser::Suffix &); | |||
852 | bool Pre(const parser::PrefixSpec &); | |||
853 | ||||
854 | bool BeginSubprogram(const parser::Name &, Symbol::Flag, | |||
855 | bool hasModulePrefix = false, | |||
856 | const parser::LanguageBindingSpec * = nullptr, | |||
857 | const ProgramTree::EntryStmtList * = nullptr); | |||
858 | bool BeginMpSubprogram(const parser::Name &); | |||
859 | void PushBlockDataScope(const parser::Name &); | |||
860 | void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt, | |||
861 | const std::optional<parser::LanguageBindingSpec> * = nullptr, | |||
862 | const ProgramTree::EntryStmtList * = nullptr); | |||
863 | ||||
864 | protected: | |||
865 | // Set when we see a stmt function that is really an array element assignment | |||
866 | bool badStmtFuncFound_{false}; | |||
867 | ||||
868 | private: | |||
869 | // Edits an existing symbol created for earlier calls to a subprogram or ENTRY | |||
870 | // so that it can be replaced by a later definition. | |||
871 | bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag); | |||
872 | void CheckExtantProc(const parser::Name &, Symbol::Flag); | |||
873 | // Create a subprogram symbol in the current scope and push a new scope. | |||
874 | Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag, | |||
875 | const parser::LanguageBindingSpec * = nullptr); | |||
876 | Symbol *GetSpecificFromGeneric(const parser::Name &); | |||
877 | Symbol &PostSubprogramStmt(); | |||
878 | void CreateDummyArgument(SubprogramDetails &, const parser::Name &); | |||
879 | void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram); | |||
880 | void PostEntryStmt(const parser::EntryStmt &stmt); | |||
881 | void HandleLanguageBinding(Symbol *, | |||
882 | std::optional<parser::CharBlock> stmtSource, | |||
883 | const std::optional<parser::LanguageBindingSpec> *); | |||
884 | }; | |||
885 | ||||
886 | class DeclarationVisitor : public ArraySpecVisitor, | |||
887 | public virtual ScopeHandler { | |||
888 | public: | |||
889 | using ArraySpecVisitor::Post; | |||
890 | using ScopeHandler::Post; | |||
891 | using ScopeHandler::Pre; | |||
892 | ||||
893 | bool Pre(const parser::Initialization &); | |||
894 | void Post(const parser::EntityDecl &); | |||
895 | void Post(const parser::ObjectDecl &); | |||
896 | void Post(const parser::PointerDecl &); | |||
897 | bool Pre(const parser::BindStmt &) { return BeginAttrs(); } | |||
898 | void Post(const parser::BindStmt &) { EndAttrs(); } | |||
899 | bool Pre(const parser::BindEntity &); | |||
900 | bool Pre(const parser::OldParameterStmt &); | |||
901 | bool Pre(const parser::NamedConstantDef &); | |||
902 | bool Pre(const parser::NamedConstant &); | |||
903 | void Post(const parser::EnumDef &); | |||
904 | bool Pre(const parser::Enumerator &); | |||
905 | bool Pre(const parser::AccessSpec &); | |||
906 | bool Pre(const parser::AsynchronousStmt &); | |||
907 | bool Pre(const parser::ContiguousStmt &); | |||
908 | bool Pre(const parser::ExternalStmt &); | |||
909 | bool Pre(const parser::IntentStmt &); | |||
910 | bool Pre(const parser::IntrinsicStmt &); | |||
911 | bool Pre(const parser::OptionalStmt &); | |||
912 | bool Pre(const parser::ProtectedStmt &); | |||
913 | bool Pre(const parser::ValueStmt &); | |||
914 | bool Pre(const parser::VolatileStmt &); | |||
915 | bool Pre(const parser::AllocatableStmt &) { | |||
916 | objectDeclAttr_ = Attr::ALLOCATABLE; | |||
917 | return true; | |||
918 | } | |||
919 | void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; } | |||
920 | bool Pre(const parser::TargetStmt &) { | |||
921 | objectDeclAttr_ = Attr::TARGET; | |||
922 | return true; | |||
923 | } | |||
924 | void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; } | |||
925 | void Post(const parser::DimensionStmt::Declaration &); | |||
926 | void Post(const parser::CodimensionDecl &); | |||
927 | bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); } | |||
928 | void Post(const parser::TypeDeclarationStmt &); | |||
929 | void Post(const parser::IntegerTypeSpec &); | |||
930 | void Post(const parser::IntrinsicTypeSpec::Real &); | |||
931 | void Post(const parser::IntrinsicTypeSpec::Complex &); | |||
932 | void Post(const parser::IntrinsicTypeSpec::Logical &); | |||
933 | void Post(const parser::IntrinsicTypeSpec::Character &); | |||
934 | void Post(const parser::CharSelector::LengthAndKind &); | |||
935 | void Post(const parser::CharLength &); | |||
936 | void Post(const parser::LengthSelector &); | |||
937 | bool Pre(const parser::KindParam &); | |||
938 | bool Pre(const parser::DeclarationTypeSpec::Type &); | |||
939 | void Post(const parser::DeclarationTypeSpec::Type &); | |||
940 | bool Pre(const parser::DeclarationTypeSpec::Class &); | |||
941 | void Post(const parser::DeclarationTypeSpec::Class &); | |||
942 | void Post(const parser::DeclarationTypeSpec::Record &); | |||
943 | void Post(const parser::DerivedTypeSpec &); | |||
944 | bool Pre(const parser::DerivedTypeDef &); | |||
945 | bool Pre(const parser::DerivedTypeStmt &); | |||
946 | void Post(const parser::DerivedTypeStmt &); | |||
947 | bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); } | |||
948 | void Post(const parser::TypeParamDefStmt &); | |||
949 | bool Pre(const parser::TypeAttrSpec::Extends &); | |||
950 | bool Pre(const parser::PrivateStmt &); | |||
951 | bool Pre(const parser::SequenceStmt &); | |||
952 | bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); } | |||
953 | void Post(const parser::ComponentDefStmt &) { EndDecl(); } | |||
954 | void Post(const parser::ComponentDecl &); | |||
955 | void Post(const parser::FillDecl &); | |||
956 | bool Pre(const parser::ProcedureDeclarationStmt &); | |||
957 | void Post(const parser::ProcedureDeclarationStmt &); | |||
958 | bool Pre(const parser::DataComponentDefStmt &); // returns false | |||
959 | bool Pre(const parser::ProcComponentDefStmt &); | |||
960 | void Post(const parser::ProcComponentDefStmt &); | |||
961 | bool Pre(const parser::ProcPointerInit &); | |||
962 | void Post(const parser::ProcInterface &); | |||
963 | void Post(const parser::ProcDecl &); | |||
964 | bool Pre(const parser::TypeBoundProcedurePart &); | |||
965 | void Post(const parser::TypeBoundProcedurePart &); | |||
966 | void Post(const parser::ContainsStmt &); | |||
967 | bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); } | |||
968 | void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); } | |||
969 | void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &); | |||
970 | void Post(const parser::TypeBoundProcedureStmt::WithInterface &); | |||
971 | void Post(const parser::FinalProcedureStmt &); | |||
972 | bool Pre(const parser::TypeBoundGenericStmt &); | |||
973 | bool Pre(const parser::StructureDef &); // returns false | |||
974 | bool Pre(const parser::Union::UnionStmt &); | |||
975 | bool Pre(const parser::StructureField &); | |||
976 | void Post(const parser::StructureField &); | |||
977 | bool Pre(const parser::AllocateStmt &); | |||
978 | void Post(const parser::AllocateStmt &); | |||
979 | bool Pre(const parser::StructureConstructor &); | |||
980 | bool Pre(const parser::NamelistStmt::Group &); | |||
981 | bool Pre(const parser::IoControlSpec &); | |||
982 | bool Pre(const parser::CommonStmt::Block &); | |||
983 | bool Pre(const parser::CommonBlockObject &); | |||
984 | void Post(const parser::CommonBlockObject &); | |||
985 | bool Pre(const parser::EquivalenceStmt &); | |||
986 | bool Pre(const parser::SaveStmt &); | |||
987 | bool Pre(const parser::BasedPointerStmt &); | |||
988 | ||||
989 | void PointerInitialization( | |||
990 | const parser::Name &, const parser::InitialDataTarget &); | |||
991 | void PointerInitialization( | |||
992 | const parser::Name &, const parser::ProcPointerInit &); | |||
993 | void NonPointerInitialization( | |||
994 | const parser::Name &, const parser::ConstantExpr &); | |||
995 | void CheckExplicitInterface(const parser::Name &); | |||
996 | void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); | |||
997 | ||||
998 | const parser::Name *ResolveDesignator(const parser::Designator &); | |||
999 | ||||
1000 | protected: | |||
1001 | bool BeginDecl(); | |||
1002 | void EndDecl(); | |||
1003 | Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{}); | |||
1004 | // Make sure that there's an entity in an enclosing scope called Name | |||
1005 | Symbol &FindOrDeclareEnclosingEntity(const parser::Name &); | |||
1006 | // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified | |||
1007 | // it comes from the entity in the containing scope, or implicit rules. | |||
1008 | // Return pointer to the new symbol, or nullptr on error. | |||
1009 | Symbol *DeclareLocalEntity(const parser::Name &); | |||
1010 | // Declare a statement entity (i.e., an implied DO loop index for | |||
1011 | // a DATA statement or an array constructor). If there isn't an explict | |||
1012 | // type specified, implicit rules apply. Return pointer to the new symbol, | |||
1013 | // or nullptr on error. | |||
1014 | Symbol *DeclareStatementEntity(const parser::DoVariable &, | |||
1015 | const std::optional<parser::IntegerTypeSpec> &); | |||
1016 | Symbol &MakeCommonBlockSymbol(const parser::Name &); | |||
1017 | Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &); | |||
1018 | bool CheckUseError(const parser::Name &); | |||
1019 | void CheckAccessibility(const SourceName &, bool, Symbol &); | |||
1020 | void CheckCommonBlocks(); | |||
1021 | void CheckSaveStmts(); | |||
1022 | void CheckEquivalenceSets(); | |||
1023 | bool CheckNotInBlock(const char *); | |||
1024 | bool NameIsKnownOrIntrinsic(const parser::Name &); | |||
1025 | void FinishNamelists(); | |||
1026 | ||||
1027 | // Each of these returns a pointer to a resolved Name (i.e. with symbol) | |||
1028 | // or nullptr in case of error. | |||
1029 | const parser::Name *ResolveStructureComponent( | |||
1030 | const parser::StructureComponent &); | |||
1031 | const parser::Name *ResolveDataRef(const parser::DataRef &); | |||
1032 | const parser::Name *ResolveName(const parser::Name &); | |||
1033 | bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol); | |||
1034 | Symbol *NoteInterfaceName(const parser::Name &); | |||
1035 | bool IsUplevelReference(const Symbol &); | |||
1036 | ||||
1037 | std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds( | |||
1038 | const parser::DoVariable &name) { | |||
1039 | std::optional<SourceName> result{checkIndexUseInOwnBounds_}; | |||
1040 | checkIndexUseInOwnBounds_ = name.thing.thing.source; | |||
1041 | return result; | |||
1042 | } | |||
1043 | void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) { | |||
1044 | checkIndexUseInOwnBounds_ = restore; | |||
1045 | } | |||
1046 | ||||
1047 | private: | |||
1048 | // The attribute corresponding to the statement containing an ObjectDecl | |||
1049 | std::optional<Attr> objectDeclAttr_; | |||
1050 | // Info about current character type while walking DeclTypeSpec. | |||
1051 | // Also captures any "*length" specifier on an individual declaration. | |||
1052 | struct { | |||
1053 | std::optional<ParamValue> length; | |||
1054 | std::optional<KindExpr> kind; | |||
1055 | } charInfo_; | |||
1056 | // Info about current derived type or STRUCTURE while walking | |||
1057 | // DerivedTypeDef / StructureDef | |||
1058 | struct { | |||
1059 | const parser::Name *extends{nullptr}; // EXTENDS(name) | |||
1060 | bool privateComps{false}; // components are private by default | |||
1061 | bool privateBindings{false}; // bindings are private by default | |||
1062 | bool sawContains{false}; // currently processing bindings | |||
1063 | bool sequence{false}; // is a sequence type | |||
1064 | const Symbol *type{nullptr}; // derived type being defined | |||
1065 | bool isStructure{false}; // is a DEC STRUCTURE | |||
1066 | } derivedTypeInfo_; | |||
1067 | // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is | |||
1068 | // the interface name, if any. | |||
1069 | const parser::Name *interfaceName_{nullptr}; | |||
1070 | // Map type-bound generic to binding names of its specific bindings | |||
1071 | std::multimap<Symbol *, const parser::Name *> genericBindings_; | |||
1072 | // Info about current ENUM | |||
1073 | struct EnumeratorState { | |||
1074 | // Enum value must hold inside a C_INT (7.6.2). | |||
1075 | std::optional<int> value{0}; | |||
1076 | } enumerationState_; | |||
1077 | // Set for OldParameterStmt processing | |||
1078 | bool inOldStyleParameterStmt_{false}; | |||
1079 | // Set when walking DATA & array constructor implied DO loop bounds | |||
1080 | // to warn about use of the implied DO intex therein. | |||
1081 | std::optional<SourceName> checkIndexUseInOwnBounds_; | |||
1082 | bool hasBindCName_{false}; | |||
1083 | ||||
1084 | bool HandleAttributeStmt(Attr, const std::list<parser::Name> &); | |||
1085 | Symbol &HandleAttributeStmt(Attr, const parser::Name &); | |||
1086 | Symbol &DeclareUnknownEntity(const parser::Name &, Attrs); | |||
1087 | Symbol &DeclareProcEntity( | |||
1088 | const parser::Name &, Attrs, const Symbol *interface); | |||
1089 | void SetType(const parser::Name &, const DeclTypeSpec &); | |||
1090 | std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &); | |||
1091 | std::optional<DerivedTypeSpec> ResolveExtendsType( | |||
1092 | const parser::Name &, const parser::Name *); | |||
1093 | Symbol *MakeTypeSymbol(const SourceName &, Details &&); | |||
1094 | Symbol *MakeTypeSymbol(const parser::Name &, Details &&); | |||
1095 | bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr); | |||
1096 | ParamValue GetParamValue( | |||
1097 | const parser::TypeParamValue &, common::TypeParamAttr attr); | |||
1098 | void CheckCommonBlockDerivedType(const SourceName &, const Symbol &); | |||
1099 | std::optional<MessageFixedText> CheckSaveAttr(const Symbol &); | |||
1100 | Attrs HandleSaveName(const SourceName &, Attrs); | |||
1101 | void AddSaveName(std::set<SourceName> &, const SourceName &); | |||
1102 | void SetSaveAttr(Symbol &); | |||
1103 | bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &); | |||
1104 | const parser::Name *FindComponent(const parser::Name *, const parser::Name &); | |||
1105 | void Initialization(const parser::Name &, const parser::Initialization &, | |||
1106 | bool inComponentDecl); | |||
1107 | bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol); | |||
1108 | bool CheckForHostAssociatedImplicit(const parser::Name &); | |||
1109 | ||||
1110 | // Declare an object or procedure entity. | |||
1111 | // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails | |||
1112 | template <typename T> | |||
1113 | Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) { | |||
1114 | Symbol &symbol{MakeSymbol(name, attrs)}; | |||
1115 | if (context().HasError(symbol) || symbol.has<T>()) { | |||
1116 | return symbol; // OK or error already reported | |||
1117 | } else if (symbol.has<UnknownDetails>()) { | |||
1118 | symbol.set_details(T{}); | |||
1119 | return symbol; | |||
1120 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
1121 | symbol.set_details(T{std::move(*details)}); | |||
1122 | return symbol; | |||
1123 | } else if (std::is_same_v<EntityDetails, T> && | |||
1124 | (symbol.has<ObjectEntityDetails>() || | |||
1125 | symbol.has<ProcEntityDetails>())) { | |||
1126 | return symbol; // OK | |||
1127 | } else if (auto *details{symbol.detailsIf<UseDetails>()}) { | |||
1128 | Say(name.source, | |||
1129 | "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US, | |||
1130 | name.source, GetUsedModule(*details).name()); | |||
1131 | } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) { | |||
1132 | if (details->kind() == SubprogramKind::Module) { | |||
1133 | Say2(name, | |||
1134 | "Declaration of '%s' conflicts with its use as module procedure"_err_en_US, | |||
1135 | symbol, "Module procedure definition"_en_US); | |||
1136 | } else if (details->kind() == SubprogramKind::Internal) { | |||
1137 | Say2(name, | |||
1138 | "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US, | |||
1139 | symbol, "Internal procedure definition"_en_US); | |||
1140 | } else { | |||
1141 | DIE("unexpected kind")Fortran::common::die("unexpected kind" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1141); | |||
1142 | } | |||
1143 | } else if (std::is_same_v<ObjectEntityDetails, T> && | |||
1144 | symbol.has<ProcEntityDetails>()) { | |||
1145 | SayWithDecl( | |||
1146 | name, symbol, "'%s' is already declared as a procedure"_err_en_US); | |||
1147 | } else if (std::is_same_v<ProcEntityDetails, T> && | |||
1148 | symbol.has<ObjectEntityDetails>()) { | |||
1149 | if (FindCommonBlockContaining(symbol)) { | |||
1150 | SayWithDecl(name, symbol, | |||
1151 | "'%s' may not be a procedure as it is in a COMMON block"_err_en_US); | |||
1152 | } else { | |||
1153 | SayWithDecl( | |||
1154 | name, symbol, "'%s' is already declared as an object"_err_en_US); | |||
1155 | } | |||
1156 | } else if (!CheckPossibleBadForwardRef(symbol)) { | |||
1157 | SayAlreadyDeclared(name, symbol); | |||
1158 | } | |||
1159 | context().SetError(symbol); | |||
1160 | return symbol; | |||
1161 | } | |||
1162 | bool HasCycle(const Symbol &, const Symbol *interface); | |||
1163 | }; | |||
1164 | ||||
1165 | // Resolve construct entities and statement entities. | |||
1166 | // Check that construct names don't conflict with other names. | |||
1167 | class ConstructVisitor : public virtual DeclarationVisitor { | |||
1168 | public: | |||
1169 | bool Pre(const parser::ConcurrentHeader &); | |||
1170 | bool Pre(const parser::LocalitySpec::Local &); | |||
1171 | bool Pre(const parser::LocalitySpec::LocalInit &); | |||
1172 | bool Pre(const parser::LocalitySpec::Shared &); | |||
1173 | bool Pre(const parser::AcSpec &); | |||
1174 | bool Pre(const parser::AcImpliedDo &); | |||
1175 | bool Pre(const parser::DataImpliedDo &); | |||
1176 | bool Pre(const parser::DataIDoObject &); | |||
1177 | bool Pre(const parser::DataStmtObject &); | |||
1178 | bool Pre(const parser::DataStmtValue &); | |||
1179 | bool Pre(const parser::DoConstruct &); | |||
1180 | void Post(const parser::DoConstruct &); | |||
1181 | bool Pre(const parser::ForallConstruct &); | |||
1182 | void Post(const parser::ForallConstruct &); | |||
1183 | bool Pre(const parser::ForallStmt &); | |||
1184 | void Post(const parser::ForallStmt &); | |||
1185 | bool Pre(const parser::BlockStmt &); | |||
1186 | bool Pre(const parser::EndBlockStmt &); | |||
1187 | void Post(const parser::Selector &); | |||
1188 | void Post(const parser::AssociateStmt &); | |||
1189 | void Post(const parser::EndAssociateStmt &); | |||
1190 | bool Pre(const parser::Association &); | |||
1191 | void Post(const parser::SelectTypeStmt &); | |||
1192 | void Post(const parser::SelectRankStmt &); | |||
1193 | bool Pre(const parser::SelectTypeConstruct &); | |||
1194 | void Post(const parser::SelectTypeConstruct &); | |||
1195 | bool Pre(const parser::SelectTypeConstruct::TypeCase &); | |||
1196 | void Post(const parser::SelectTypeConstruct::TypeCase &); | |||
1197 | // Creates Block scopes with neither symbol name nor symbol details. | |||
1198 | bool Pre(const parser::SelectRankConstruct::RankCase &); | |||
1199 | void Post(const parser::SelectRankConstruct::RankCase &); | |||
1200 | bool Pre(const parser::TypeGuardStmt::Guard &); | |||
1201 | void Post(const parser::TypeGuardStmt::Guard &); | |||
1202 | void Post(const parser::SelectRankCaseStmt::Rank &); | |||
1203 | bool Pre(const parser::ChangeTeamStmt &); | |||
1204 | void Post(const parser::EndChangeTeamStmt &); | |||
1205 | void Post(const parser::CoarrayAssociation &); | |||
1206 | ||||
1207 | // Definitions of construct names | |||
1208 | bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); } | |||
1209 | bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); } | |||
1210 | bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); } | |||
1211 | bool Pre(const parser::LabelDoStmt &) { | |||
1212 | return false; // error recovery | |||
1213 | } | |||
1214 | bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); } | |||
1215 | bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); } | |||
1216 | bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); } | |||
1217 | bool Pre(const parser::SelectRankConstruct &); | |||
1218 | void Post(const parser::SelectRankConstruct &); | |||
1219 | bool Pre(const parser::SelectRankStmt &x) { | |||
1220 | return CheckDef(std::get<0>(x.t)); | |||
1221 | } | |||
1222 | bool Pre(const parser::SelectTypeStmt &x) { | |||
1223 | return CheckDef(std::get<0>(x.t)); | |||
1224 | } | |||
1225 | ||||
1226 | // References to construct names | |||
1227 | void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); } | |||
1228 | void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); } | |||
1229 | void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); } | |||
1230 | void Post(const parser::EndForallStmt &x) { CheckRef(x.v); } | |||
1231 | void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); } | |||
1232 | void Post(const parser::EndDoStmt &x) { CheckRef(x.v); } | |||
1233 | void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); } | |||
1234 | void Post(const parser::ElseStmt &x) { CheckRef(x.v); } | |||
1235 | void Post(const parser::EndIfStmt &x) { CheckRef(x.v); } | |||
1236 | void Post(const parser::CaseStmt &x) { CheckRef(x.t); } | |||
1237 | void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); } | |||
1238 | void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); } | |||
1239 | void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); } | |||
1240 | void Post(const parser::CycleStmt &x) { CheckRef(x.v); } | |||
1241 | void Post(const parser::ExitStmt &x) { CheckRef(x.v); } | |||
1242 | ||||
1243 | private: | |||
1244 | // R1105 selector -> expr | variable | |||
1245 | // expr is set in either case unless there were errors | |||
1246 | struct Selector { | |||
1247 | Selector() {} | |||
1248 | Selector(const SourceName &source, MaybeExpr &&expr) | |||
1249 | : source{source}, expr{std::move(expr)} {} | |||
1250 | operator bool() const { return expr.has_value(); } | |||
1251 | parser::CharBlock source; | |||
1252 | MaybeExpr expr; | |||
1253 | }; | |||
1254 | // association -> [associate-name =>] selector | |||
1255 | struct Association { | |||
1256 | const parser::Name *name{nullptr}; | |||
1257 | Selector selector; | |||
1258 | }; | |||
1259 | std::vector<Association> associationStack_; | |||
1260 | Association *currentAssociation_{nullptr}; | |||
1261 | ||||
1262 | template <typename T> bool CheckDef(const T &t) { | |||
1263 | return CheckDef(std::get<std::optional<parser::Name>>(t)); | |||
1264 | } | |||
1265 | template <typename T> void CheckRef(const T &t) { | |||
1266 | CheckRef(std::get<std::optional<parser::Name>>(t)); | |||
1267 | } | |||
1268 | bool CheckDef(const std::optional<parser::Name> &); | |||
1269 | void CheckRef(const std::optional<parser::Name> &); | |||
1270 | const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&); | |||
1271 | const DeclTypeSpec &ToDeclTypeSpec( | |||
1272 | evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length); | |||
1273 | Symbol *MakeAssocEntity(); | |||
1274 | void SetTypeFromAssociation(Symbol &); | |||
1275 | void SetAttrsFromAssociation(Symbol &); | |||
1276 | Selector ResolveSelector(const parser::Selector &); | |||
1277 | void ResolveIndexName(const parser::ConcurrentControl &control); | |||
1278 | void SetCurrentAssociation(std::size_t n); | |||
1279 | Association &GetCurrentAssociation(); | |||
1280 | void PushAssociation(); | |||
1281 | void PopAssociation(std::size_t count = 1); | |||
1282 | }; | |||
1283 | ||||
1284 | // Create scopes for OpenACC constructs | |||
1285 | class AccVisitor : public virtual DeclarationVisitor { | |||
1286 | public: | |||
1287 | void AddAccSourceRange(const parser::CharBlock &); | |||
1288 | ||||
1289 | static bool NeedsScope(const parser::OpenACCBlockConstruct &); | |||
1290 | ||||
1291 | bool Pre(const parser::OpenACCBlockConstruct &); | |||
1292 | void Post(const parser::OpenACCBlockConstruct &); | |||
1293 | bool Pre(const parser::AccBeginBlockDirective &x) { | |||
1294 | AddAccSourceRange(x.source); | |||
1295 | return true; | |||
1296 | } | |||
1297 | void Post(const parser::AccBeginBlockDirective &) { | |||
1298 | messageHandler().set_currStmtSource(std::nullopt); | |||
1299 | } | |||
1300 | bool Pre(const parser::AccEndBlockDirective &x) { | |||
1301 | AddAccSourceRange(x.source); | |||
1302 | return true; | |||
1303 | } | |||
1304 | void Post(const parser::AccEndBlockDirective &) { | |||
1305 | messageHandler().set_currStmtSource(std::nullopt); | |||
1306 | } | |||
1307 | bool Pre(const parser::AccBeginLoopDirective &x) { | |||
1308 | AddAccSourceRange(x.source); | |||
1309 | return true; | |||
1310 | } | |||
1311 | void Post(const parser::AccBeginLoopDirective &x) { | |||
1312 | messageHandler().set_currStmtSource(std::nullopt); | |||
1313 | } | |||
1314 | }; | |||
1315 | ||||
1316 | bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) { | |||
1317 | const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; | |||
1318 | const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; | |||
1319 | switch (beginDir.v) { | |||
1320 | case llvm::acc::Directive::ACCD_data: | |||
1321 | case llvm::acc::Directive::ACCD_host_data: | |||
1322 | case llvm::acc::Directive::ACCD_kernels: | |||
1323 | case llvm::acc::Directive::ACCD_parallel: | |||
1324 | case llvm::acc::Directive::ACCD_serial: | |||
1325 | return true; | |||
1326 | default: | |||
1327 | return false; | |||
1328 | } | |||
1329 | } | |||
1330 | ||||
1331 | void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) { | |||
1332 | messageHandler().set_currStmtSource(source); | |||
1333 | currScope().AddSourceRange(source); | |||
1334 | } | |||
1335 | ||||
1336 | bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) { | |||
1337 | if (NeedsScope(x)) { | |||
1338 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1339 | } | |||
1340 | return true; | |||
1341 | } | |||
1342 | ||||
1343 | void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) { | |||
1344 | if (NeedsScope(x)) { | |||
1345 | PopScope(); | |||
1346 | } | |||
1347 | } | |||
1348 | ||||
1349 | // Create scopes for OpenMP constructs | |||
1350 | class OmpVisitor : public virtual DeclarationVisitor { | |||
1351 | public: | |||
1352 | void AddOmpSourceRange(const parser::CharBlock &); | |||
1353 | ||||
1354 | static bool NeedsScope(const parser::OpenMPBlockConstruct &); | |||
1355 | ||||
1356 | bool Pre(const parser::OpenMPBlockConstruct &); | |||
1357 | void Post(const parser::OpenMPBlockConstruct &); | |||
1358 | bool Pre(const parser::OmpBeginBlockDirective &x) { | |||
1359 | AddOmpSourceRange(x.source); | |||
1360 | return true; | |||
1361 | } | |||
1362 | void Post(const parser::OmpBeginBlockDirective &) { | |||
1363 | messageHandler().set_currStmtSource(std::nullopt); | |||
1364 | } | |||
1365 | bool Pre(const parser::OmpEndBlockDirective &x) { | |||
1366 | AddOmpSourceRange(x.source); | |||
1367 | return true; | |||
1368 | } | |||
1369 | void Post(const parser::OmpEndBlockDirective &) { | |||
1370 | messageHandler().set_currStmtSource(std::nullopt); | |||
1371 | } | |||
1372 | ||||
1373 | bool Pre(const parser::OpenMPLoopConstruct &) { | |||
1374 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1375 | return true; | |||
1376 | } | |||
1377 | void Post(const parser::OpenMPLoopConstruct &) { PopScope(); } | |||
1378 | bool Pre(const parser::OmpBeginLoopDirective &x) { | |||
1379 | AddOmpSourceRange(x.source); | |||
1380 | return true; | |||
1381 | } | |||
1382 | void Post(const parser::OmpBeginLoopDirective &) { | |||
1383 | messageHandler().set_currStmtSource(std::nullopt); | |||
1384 | } | |||
1385 | bool Pre(const parser::OmpEndLoopDirective &x) { | |||
1386 | AddOmpSourceRange(x.source); | |||
1387 | return true; | |||
1388 | } | |||
1389 | void Post(const parser::OmpEndLoopDirective &) { | |||
1390 | messageHandler().set_currStmtSource(std::nullopt); | |||
1391 | } | |||
1392 | ||||
1393 | bool Pre(const parser::OpenMPSectionsConstruct &) { | |||
1394 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1395 | return true; | |||
1396 | } | |||
1397 | void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); } | |||
1398 | bool Pre(const parser::OmpBeginSectionsDirective &x) { | |||
1399 | AddOmpSourceRange(x.source); | |||
1400 | return true; | |||
1401 | } | |||
1402 | void Post(const parser::OmpBeginSectionsDirective &) { | |||
1403 | messageHandler().set_currStmtSource(std::nullopt); | |||
1404 | } | |||
1405 | bool Pre(const parser::OmpEndSectionsDirective &x) { | |||
1406 | AddOmpSourceRange(x.source); | |||
1407 | return true; | |||
1408 | } | |||
1409 | void Post(const parser::OmpEndSectionsDirective &) { | |||
1410 | messageHandler().set_currStmtSource(std::nullopt); | |||
1411 | } | |||
1412 | }; | |||
1413 | ||||
1414 | bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) { | |||
1415 | const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; | |||
1416 | const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; | |||
1417 | switch (beginDir.v) { | |||
1418 | case llvm::omp::Directive::OMPD_target_data: | |||
1419 | case llvm::omp::Directive::OMPD_master: | |||
1420 | case llvm::omp::Directive::OMPD_ordered: | |||
1421 | case llvm::omp::Directive::OMPD_taskgroup: | |||
1422 | return false; | |||
1423 | default: | |||
1424 | return true; | |||
1425 | } | |||
1426 | } | |||
1427 | ||||
1428 | void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) { | |||
1429 | messageHandler().set_currStmtSource(source); | |||
1430 | currScope().AddSourceRange(source); | |||
1431 | } | |||
1432 | ||||
1433 | bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) { | |||
1434 | if (NeedsScope(x)) { | |||
1435 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1436 | } | |||
1437 | return true; | |||
1438 | } | |||
1439 | ||||
1440 | void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) { | |||
1441 | if (NeedsScope(x)) { | |||
1442 | PopScope(); | |||
1443 | } | |||
1444 | } | |||
1445 | ||||
1446 | // Walk the parse tree and resolve names to symbols. | |||
1447 | class ResolveNamesVisitor : public virtual ScopeHandler, | |||
1448 | public ModuleVisitor, | |||
1449 | public SubprogramVisitor, | |||
1450 | public ConstructVisitor, | |||
1451 | public OmpVisitor, | |||
1452 | public AccVisitor { | |||
1453 | public: | |||
1454 | using AccVisitor::Post; | |||
1455 | using AccVisitor::Pre; | |||
1456 | using ArraySpecVisitor::Post; | |||
1457 | using ConstructVisitor::Post; | |||
1458 | using ConstructVisitor::Pre; | |||
1459 | using DeclarationVisitor::Post; | |||
1460 | using DeclarationVisitor::Pre; | |||
1461 | using ImplicitRulesVisitor::Post; | |||
1462 | using ImplicitRulesVisitor::Pre; | |||
1463 | using InterfaceVisitor::Post; | |||
1464 | using InterfaceVisitor::Pre; | |||
1465 | using ModuleVisitor::Post; | |||
1466 | using ModuleVisitor::Pre; | |||
1467 | using OmpVisitor::Post; | |||
1468 | using OmpVisitor::Pre; | |||
1469 | using ScopeHandler::Post; | |||
1470 | using ScopeHandler::Pre; | |||
1471 | using SubprogramVisitor::Post; | |||
1472 | using SubprogramVisitor::Pre; | |||
1473 | ||||
1474 | ResolveNamesVisitor( | |||
1475 | SemanticsContext &context, ImplicitRulesMap &rules, Scope &top) | |||
1476 | : BaseVisitor{context, *this, rules}, topScope_{top} { | |||
1477 | PushScope(top); | |||
1478 | } | |||
1479 | ||||
1480 | Scope &topScope() const { return topScope_; } | |||
1481 | ||||
1482 | // Default action for a parse tree node is to visit children. | |||
1483 | template <typename T> bool Pre(const T &) { return true; } | |||
1484 | template <typename T> void Post(const T &) {} | |||
1485 | ||||
1486 | bool Pre(const parser::SpecificationPart &); | |||
1487 | void Post(const parser::Program &); | |||
1488 | bool Pre(const parser::ImplicitStmt &); | |||
1489 | void Post(const parser::PointerObject &); | |||
1490 | void Post(const parser::AllocateObject &); | |||
1491 | bool Pre(const parser::PointerAssignmentStmt &); | |||
1492 | void Post(const parser::Designator &); | |||
1493 | void Post(const parser::SubstringInquiry &); | |||
1494 | template <typename A, typename B> | |||
1495 | void Post(const parser::LoopBounds<A, B> &x) { | |||
1496 | ResolveName(*parser::Unwrap<parser::Name>(x.name)); | |||
1497 | } | |||
1498 | void Post(const parser::ProcComponentRef &); | |||
1499 | bool Pre(const parser::FunctionReference &); | |||
1500 | bool Pre(const parser::CallStmt &); | |||
1501 | bool Pre(const parser::ImportStmt &); | |||
1502 | void Post(const parser::TypeGuardStmt &); | |||
1503 | bool Pre(const parser::StmtFunctionStmt &); | |||
1504 | bool Pre(const parser::DefinedOpName &); | |||
1505 | bool Pre(const parser::ProgramUnit &); | |||
1506 | void Post(const parser::AssignStmt &); | |||
1507 | void Post(const parser::AssignedGotoStmt &); | |||
1508 | ||||
1509 | // These nodes should never be reached: they are handled in ProgramUnit | |||
1510 | bool Pre(const parser::MainProgram &) { | |||
1511 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1511); | |||
1512 | } | |||
1513 | bool Pre(const parser::FunctionSubprogram &) { | |||
1514 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1514); | |||
1515 | } | |||
1516 | bool Pre(const parser::SubroutineSubprogram &) { | |||
1517 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1517); | |||
1518 | } | |||
1519 | bool Pre(const parser::SeparateModuleSubprogram &) { | |||
1520 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1520); | |||
1521 | } | |||
1522 | bool Pre(const parser::Module &) { | |||
1523 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1523); | |||
1524 | } | |||
1525 | bool Pre(const parser::Submodule &) { | |||
1526 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1526); | |||
1527 | } | |||
1528 | bool Pre(const parser::BlockData &) { | |||
1529 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1529); | |||
1530 | } | |||
1531 | ||||
1532 | void NoteExecutablePartCall(Symbol::Flag, const parser::Call &); | |||
1533 | ||||
1534 | friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &); | |||
1535 | ||||
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 | if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) { | |||
1701 | if (label) { // C1552: no NAME= allowed even if null | |||
1702 | Say(symbol.name(), | |||
1703 | "An internal procedure may not have a BIND(C,NAME=) binding label"_err_en_US); | |||
1704 | } | |||
1705 | return; | |||
1706 | } | |||
1707 | // 18.9.2(2): discard leading and trailing blanks | |||
1708 | if (label) { | |||
1709 | auto first{label->find_first_not_of(" ")}; | |||
1710 | if (first == std::string::npos) { | |||
1711 | // Empty NAME= means no binding at all (18.10.2p2) | |||
1712 | return; | |||
1713 | } | |||
1714 | auto last{label->find_last_not_of(" ")}; | |||
1715 | label = label->substr(first, last - first + 1); | |||
1716 | } else { | |||
1717 | label = parser::ToLowerCaseLetters(symbol.name().ToString()); | |||
1718 | } | |||
1719 | // Check if a symbol has two Bind names. | |||
1720 | std::string oldBindName; | |||
1721 | if (symbol.GetBindName()) { | |||
1722 | oldBindName = *symbol.GetBindName(); | |||
1723 | } | |||
1724 | symbol.SetBindName(std::move(*label)); | |||
1725 | if (!oldBindName.empty()) { | |||
1726 | if (const std::string * newBindName{symbol.GetBindName()}) { | |||
1727 | if (oldBindName != *newBindName) { | |||
1728 | Say(symbol.name(), "The entity '%s' has multiple BIND names"_err_en_US); | |||
1729 | } | |||
1730 | } | |||
1731 | } | |||
1732 | } | |||
1733 | ||||
1734 | void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) { | |||
1735 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1735) , false)); | |||
1736 | if (CheckAndSet(Attr::BIND_C)) { | |||
1737 | if (x.v) { | |||
1738 | bindName_ = EvaluateExpr(*x.v); | |||
1739 | } | |||
1740 | } | |||
1741 | } | |||
1742 | bool AttrsVisitor::Pre(const parser::IntentSpec &x) { | |||
1743 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1743) , false)); | |||
1744 | CheckAndSet(IntentSpecToAttr(x)); | |||
1745 | return false; | |||
1746 | } | |||
1747 | bool AttrsVisitor::Pre(const parser::Pass &x) { | |||
1748 | if (CheckAndSet(Attr::PASS)) { | |||
1749 | if (x.v) { | |||
1750 | passName_ = x.v->source; | |||
1751 | MakePlaceholder(*x.v, MiscDetails::Kind::PassName); | |||
1752 | } | |||
1753 | } | |||
1754 | return false; | |||
1755 | } | |||
1756 | ||||
1757 | // C730, C743, C755, C778, C1543 say no attribute or prefix repetitions | |||
1758 | bool AttrsVisitor::IsDuplicateAttr(Attr attrName) { | |||
1759 | if (attrs_->test(attrName)) { | |||
1760 | Say(currStmtSource().value(), | |||
1761 | "Attribute '%s' cannot be used more than once"_warn_en_US, | |||
1762 | AttrToString(attrName)); | |||
1763 | return true; | |||
1764 | } | |||
1765 | return false; | |||
1766 | } | |||
1767 | ||||
1768 | // See if attrName violates a constraint cause by a conflict. attr1 and attr2 | |||
1769 | // name attributes that cannot be used on the same declaration | |||
1770 | bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) { | |||
1771 | if ((attrName == attr1 && attrs_->test(attr2)) || | |||
1772 | (attrName == attr2 && attrs_->test(attr1))) { | |||
1773 | Say(currStmtSource().value(), | |||
1774 | "Attributes '%s' and '%s' conflict with each other"_err_en_US, | |||
1775 | AttrToString(attr1), AttrToString(attr2)); | |||
1776 | return true; | |||
1777 | } | |||
1778 | return false; | |||
1779 | } | |||
1780 | // C759, C1543 | |||
1781 | bool AttrsVisitor::IsConflictingAttr(Attr attrName) { | |||
1782 | return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) || | |||
1783 | HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) || | |||
1784 | HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) || | |||
1785 | HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781 | |||
1786 | HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) || | |||
1787 | HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) || | |||
1788 | HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE); | |||
1789 | } | |||
1790 | bool AttrsVisitor::CheckAndSet(Attr attrName) { | |||
1791 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1791) , false)); | |||
1792 | if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) { | |||
1793 | return false; | |||
1794 | } | |||
1795 | attrs_->set(attrName); | |||
1796 | return true; | |||
1797 | } | |||
1798 | ||||
1799 | // DeclTypeSpecVisitor implementation | |||
1800 | ||||
1801 | const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { | |||
1802 | return state_.declTypeSpec; | |||
1803 | } | |||
1804 | ||||
1805 | void DeclTypeSpecVisitor::BeginDeclTypeSpec() { | |||
1806 | CHECK(!state_.expectDeclTypeSpec)((!state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "!state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1806), false)); | |||
1807 | CHECK(!state_.declTypeSpec)((!state_.declTypeSpec) || (Fortran::common::die("CHECK(" "!state_.declTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 1807), false)); | |||
1808 | state_.expectDeclTypeSpec = true; | |||
1809 | } | |||
1810 | void DeclTypeSpecVisitor::EndDeclTypeSpec() { | |||
1811 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1811), false)); | |||
1812 | state_ = {}; | |||
1813 | } | |||
1814 | ||||
1815 | void DeclTypeSpecVisitor::SetDeclTypeSpecCategory( | |||
1816 | DeclTypeSpec::Category category) { | |||
1817 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1817), false)); | |||
1818 | state_.derived.category = category; | |||
1819 | } | |||
1820 | ||||
1821 | bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) { | |||
1822 | BeginDeclTypeSpec(); | |||
1823 | return true; | |||
1824 | } | |||
1825 | void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { | |||
1826 | EndDeclTypeSpec(); | |||
1827 | } | |||
1828 | ||||
1829 | void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) { | |||
1830 | // Record the resolved DeclTypeSpec in the parse tree for use by | |||
1831 | // expression semantics if the DeclTypeSpec is a valid TypeSpec. | |||
1832 | // The grammar ensures that it's an intrinsic or derived type spec, | |||
1833 | // not TYPE(*) or CLASS(*) or CLASS(T). | |||
1834 | if (const DeclTypeSpec * spec{state_.declTypeSpec}) { | |||
1835 | switch (spec->category()) { | |||
1836 | case DeclTypeSpec::Numeric: | |||
1837 | case DeclTypeSpec::Logical: | |||
1838 | case DeclTypeSpec::Character: | |||
1839 | typeSpec.declTypeSpec = spec; | |||
1840 | break; | |||
1841 | case DeclTypeSpec::TypeDerived: | |||
1842 | if (const DerivedTypeSpec * derived{spec->AsDerived()}) { | |||
1843 | CheckForAbstractType(derived->typeSymbol()); // C703 | |||
1844 | typeSpec.declTypeSpec = spec; | |||
1845 | } | |||
1846 | break; | |||
1847 | default: | |||
1848 | CRASH_NO_CASEFortran::common::die("no case" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1848); | |||
1849 | } | |||
1850 | } | |||
1851 | } | |||
1852 | ||||
1853 | void DeclTypeSpecVisitor::Post( | |||
1854 | const parser::IntrinsicTypeSpec::DoublePrecision &) { | |||
1855 | MakeNumericType(TypeCategory::Real, context().doublePrecisionKind()); | |||
1856 | } | |||
1857 | void DeclTypeSpecVisitor::Post( | |||
1858 | const parser::IntrinsicTypeSpec::DoubleComplex &) { | |||
1859 | MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind()); | |||
1860 | } | |||
1861 | void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { | |||
1862 | SetDeclTypeSpec(context().MakeNumericType(category, kind)); | |||
1863 | } | |||
1864 | ||||
1865 | void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) { | |||
1866 | if (typeSymbol.attrs().test(Attr::ABSTRACT)) { | |||
1867 | Say("ABSTRACT derived type may not be used here"_err_en_US); | |||
1868 | } | |||
1869 | } | |||
1870 | ||||
1871 | void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { | |||
1872 | SetDeclTypeSpec(context().globalScope().MakeClassStarType()); | |||
1873 | } | |||
1874 | void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) { | |||
1875 | SetDeclTypeSpec(context().globalScope().MakeTypeStarType()); | |||
1876 | } | |||
1877 | ||||
1878 | // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet) | |||
1879 | // and save it in state_.declTypeSpec. | |||
1880 | void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { | |||
1881 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1881), false)); | |||
1882 | CHECK(!state_.declTypeSpec)((!state_.declTypeSpec) || (Fortran::common::die("CHECK(" "!state_.declTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 1882), false)); | |||
1883 | state_.declTypeSpec = &declTypeSpec; | |||
1884 | } | |||
1885 | ||||
1886 | KindExpr DeclTypeSpecVisitor::GetKindParamExpr( | |||
1887 | TypeCategory category, const std::optional<parser::KindSelector> &kind) { | |||
1888 | return AnalyzeKindSelector(context(), category, kind); | |||
1889 | } | |||
1890 | ||||
1891 | // MessageHandler implementation | |||
1892 | ||||
1893 | Message &MessageHandler::Say(MessageFixedText &&msg) { | |||
1894 | return context_->Say(currStmtSource().value(), std::move(msg)); | |||
1895 | } | |||
1896 | Message &MessageHandler::Say(MessageFormattedText &&msg) { | |||
1897 | return context_->Say(currStmtSource().value(), std::move(msg)); | |||
1898 | } | |||
1899 | Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) { | |||
1900 | return Say(name, std::move(msg), name); | |||
1901 | } | |||
1902 | ||||
1903 | // ImplicitRulesVisitor implementation | |||
1904 | ||||
1905 | void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) { | |||
1906 | prevParameterStmt_ = currStmtSource(); | |||
1907 | } | |||
1908 | ||||
1909 | bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) { | |||
1910 | bool result{ | |||
1911 | common::visit(common::visitors{ | |||
1912 | [&](const std::list<ImplicitNoneNameSpec> &y) { | |||
1913 | return HandleImplicitNone(y); | |||
1914 | }, | |||
1915 | [&](const std::list<parser::ImplicitSpec> &) { | |||
1916 | if (prevImplicitNoneType_) { | |||
1917 | Say("IMPLICIT statement after IMPLICIT NONE or " | |||
1918 | "IMPLICIT NONE(TYPE) statement"_err_en_US); | |||
1919 | return false; | |||
1920 | } | |||
1921 | implicitRules_->set_isImplicitNoneType(false); | |||
1922 | return true; | |||
1923 | }, | |||
1924 | }, | |||
1925 | x.u)}; | |||
1926 | prevImplicit_ = currStmtSource(); | |||
1927 | return result; | |||
1928 | } | |||
1929 | ||||
1930 | bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) { | |||
1931 | auto loLoc{std::get<parser::Location>(x.t)}; | |||
1932 | auto hiLoc{loLoc}; | |||
1933 | if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) { | |||
1934 | hiLoc = *hiLocOpt; | |||
1935 | if (*hiLoc < *loLoc) { | |||
1936 | Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US, | |||
1937 | std::string(hiLoc, 1), std::string(loLoc, 1)); | |||
1938 | return false; | |||
1939 | } | |||
1940 | } | |||
1941 | implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc); | |||
1942 | return false; | |||
1943 | } | |||
1944 | ||||
1945 | bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) { | |||
1946 | BeginDeclTypeSpec(); | |||
1947 | set_allowForwardReferenceToDerivedType(true); | |||
1948 | return true; | |||
1949 | } | |||
1950 | ||||
1951 | void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) { | |||
1952 | EndDeclTypeSpec(); | |||
1953 | } | |||
1954 | ||||
1955 | void ImplicitRulesVisitor::SetScope(const Scope &scope) { | |||
1956 | implicitRules_ = &DEREF(implicitRulesMap_)Fortran::common::Deref(implicitRulesMap_, "flang/lib/Semantics/resolve-names.cpp" , 1956).at(&scope); | |||
1957 | prevImplicit_ = std::nullopt; | |||
1958 | prevImplicitNone_ = std::nullopt; | |||
1959 | prevImplicitNoneType_ = std::nullopt; | |||
1960 | prevParameterStmt_ = std::nullopt; | |||
1961 | } | |||
1962 | void ImplicitRulesVisitor::BeginScope(const Scope &scope) { | |||
1963 | // find or create implicit rules for this scope | |||
1964 | DEREF(implicitRulesMap_)Fortran::common::Deref(implicitRulesMap_, "flang/lib/Semantics/resolve-names.cpp" , 1964).try_emplace(&scope, context(), implicitRules_); | |||
1965 | SetScope(scope); | |||
1966 | } | |||
1967 | ||||
1968 | // TODO: for all of these errors, reference previous statement too | |||
1969 | bool ImplicitRulesVisitor::HandleImplicitNone( | |||
1970 | const std::list<ImplicitNoneNameSpec> &nameSpecs) { | |||
1971 | if (prevImplicitNone_) { | |||
1972 | Say("More than one IMPLICIT NONE statement"_err_en_US); | |||
1973 | Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US); | |||
1974 | return false; | |||
1975 | } | |||
1976 | if (prevParameterStmt_) { | |||
1977 | Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US); | |||
1978 | return false; | |||
1979 | } | |||
1980 | prevImplicitNone_ = currStmtSource(); | |||
1981 | bool implicitNoneTypeNever{ | |||
1982 | context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)}; | |||
1983 | if (nameSpecs.empty()) { | |||
1984 | if (!implicitNoneTypeNever) { | |||
1985 | prevImplicitNoneType_ = currStmtSource(); | |||
1986 | implicitRules_->set_isImplicitNoneType(true); | |||
1987 | if (prevImplicit_) { | |||
1988 | Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US); | |||
1989 | return false; | |||
1990 | } | |||
1991 | } | |||
1992 | } else { | |||
1993 | int sawType{0}; | |||
1994 | int sawExternal{0}; | |||
1995 | for (const auto noneSpec : nameSpecs) { | |||
1996 | switch (noneSpec) { | |||
1997 | case ImplicitNoneNameSpec::External: | |||
1998 | implicitRules_->set_isImplicitNoneExternal(true); | |||
1999 | ++sawExternal; | |||
2000 | break; | |||
2001 | case ImplicitNoneNameSpec::Type: | |||
2002 | if (!implicitNoneTypeNever) { | |||
2003 | prevImplicitNoneType_ = currStmtSource(); | |||
2004 | implicitRules_->set_isImplicitNoneType(true); | |||
2005 | if (prevImplicit_) { | |||
2006 | Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US); | |||
2007 | return false; | |||
2008 | } | |||
2009 | ++sawType; | |||
2010 | } | |||
2011 | break; | |||
2012 | } | |||
2013 | } | |||
2014 | if (sawType > 1) { | |||
2015 | Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US); | |||
2016 | return false; | |||
2017 | } | |||
2018 | if (sawExternal > 1) { | |||
2019 | Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US); | |||
2020 | return false; | |||
2021 | } | |||
2022 | } | |||
2023 | return true; | |||
2024 | } | |||
2025 | ||||
2026 | // ArraySpecVisitor implementation | |||
2027 | ||||
2028 | void ArraySpecVisitor::Post(const parser::ArraySpec &x) { | |||
2029 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2029), false)); | |||
2030 | arraySpec_ = AnalyzeArraySpec(context(), x); | |||
2031 | } | |||
2032 | void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) { | |||
2033 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2033), false)); | |||
2034 | arraySpec_ = AnalyzeArraySpec(context(), x); | |||
2035 | } | |||
2036 | void ArraySpecVisitor::Post(const parser::CoarraySpec &x) { | |||
2037 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2037), false)); | |||
2038 | coarraySpec_ = AnalyzeCoarraySpec(context(), x); | |||
2039 | } | |||
2040 | ||||
2041 | const ArraySpec &ArraySpecVisitor::arraySpec() { | |||
2042 | return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_; | |||
2043 | } | |||
2044 | const ArraySpec &ArraySpecVisitor::coarraySpec() { | |||
2045 | return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_; | |||
2046 | } | |||
2047 | void ArraySpecVisitor::BeginArraySpec() { | |||
2048 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2048), false)); | |||
2049 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2049), false)); | |||
2050 | CHECK(attrArraySpec_.empty())((attrArraySpec_.empty()) || (Fortran::common::die("CHECK(" "attrArraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2050), false)); | |||
2051 | CHECK(attrCoarraySpec_.empty())((attrCoarraySpec_.empty()) || (Fortran::common::die("CHECK(" "attrCoarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 2051), false)); | |||
2052 | } | |||
2053 | void ArraySpecVisitor::EndArraySpec() { | |||
2054 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2054), false)); | |||
2055 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2055), false)); | |||
2056 | attrArraySpec_.clear(); | |||
2057 | attrCoarraySpec_.clear(); | |||
2058 | } | |||
2059 | void ArraySpecVisitor::PostAttrSpec() { | |||
2060 | // Save dimension/codimension from attrs so we can process array/coarray-spec | |||
2061 | // on the entity-decl | |||
2062 | if (!arraySpec_.empty()) { | |||
2063 | if (attrArraySpec_.empty()) { | |||
2064 | attrArraySpec_ = arraySpec_; | |||
2065 | arraySpec_.clear(); | |||
2066 | } else { | |||
2067 | Say(currStmtSource().value(), | |||
2068 | "Attribute 'DIMENSION' cannot be used more than once"_err_en_US); | |||
2069 | } | |||
2070 | } | |||
2071 | if (!coarraySpec_.empty()) { | |||
2072 | if (attrCoarraySpec_.empty()) { | |||
2073 | attrCoarraySpec_ = coarraySpec_; | |||
2074 | coarraySpec_.clear(); | |||
2075 | } else { | |||
2076 | Say(currStmtSource().value(), | |||
2077 | "Attribute 'CODIMENSION' cannot be used more than once"_err_en_US); | |||
2078 | } | |||
2079 | } | |||
2080 | } | |||
2081 | ||||
2082 | // FuncResultStack implementation | |||
2083 | ||||
2084 | FuncResultStack::~FuncResultStack() { CHECK(stack_.empty())((stack_.empty()) || (Fortran::common::die("CHECK(" "stack_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2084), false)); } | |||
2085 | ||||
2086 | void FuncResultStack::CompleteFunctionResultType() { | |||
2087 | // If the function has a type in the prefix, process it now. | |||
2088 | FuncInfo *info{Top()}; | |||
2089 | if (info && &info->scope == &scopeHandler_.currScope()) { | |||
2090 | if (info->parsedType && info->resultSymbol) { | |||
2091 | scopeHandler_.messageHandler().set_currStmtSource(info->source); | |||
2092 | if (const auto *type{ | |||
2093 | scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) { | |||
2094 | Symbol &symbol{*info->resultSymbol}; | |||
2095 | if (!scopeHandler_.context().HasError(symbol)) { | |||
2096 | if (symbol.GetType()) { | |||
2097 | scopeHandler_.Say(symbol.name(), | |||
2098 | "Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US); | |||
2099 | scopeHandler_.context().SetError(symbol); | |||
2100 | } else { | |||
2101 | symbol.SetType(*type); | |||
2102 | } | |||
2103 | } | |||
2104 | } | |||
2105 | info->parsedType = nullptr; | |||
2106 | } | |||
2107 | } | |||
2108 | } | |||
2109 | ||||
2110 | // Called from ConvertTo{Object/Proc}Entity to cope with any appearance | |||
2111 | // of the function result in a specification expression. | |||
2112 | void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) { | |||
2113 | if (FuncInfo * info{Top()}) { | |||
2114 | if (info->resultSymbol == &symbol) { | |||
2115 | CompleteFunctionResultType(); | |||
2116 | } | |||
2117 | } | |||
2118 | } | |||
2119 | ||||
2120 | void FuncResultStack::Pop() { | |||
2121 | if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) { | |||
2122 | stack_.pop_back(); | |||
2123 | } | |||
2124 | } | |||
2125 | ||||
2126 | // ScopeHandler implementation | |||
2127 | ||||
2128 | void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) { | |||
2129 | SayAlreadyDeclared(name.source, prev); | |||
2130 | } | |||
2131 | void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) { | |||
2132 | if (context().HasError(prev)) { | |||
2133 | // don't report another error about prev | |||
2134 | } else { | |||
2135 | if (const auto *details{prev.detailsIf<UseDetails>()}) { | |||
2136 | Say(name, "'%s' is already declared in this scoping unit"_err_en_US) | |||
2137 | .Attach(details->location(), | |||
2138 | "It is use-associated with '%s' in module '%s'"_en_US, | |||
2139 | details->symbol().name(), GetUsedModule(*details).name()); | |||
2140 | } else { | |||
2141 | SayAlreadyDeclared(name, prev.name()); | |||
2142 | } | |||
2143 | context().SetError(prev); | |||
2144 | } | |||
2145 | } | |||
2146 | void ScopeHandler::SayAlreadyDeclared( | |||
2147 | const SourceName &name1, const SourceName &name2) { | |||
2148 | if (name1.begin() < name2.begin()) { | |||
2149 | SayAlreadyDeclared(name2, name1); | |||
2150 | } else { | |||
2151 | Say(name1, "'%s' is already declared in this scoping unit"_err_en_US) | |||
2152 | .Attach(name2, "Previous declaration of '%s'"_en_US, name2); | |||
2153 | } | |||
2154 | } | |||
2155 | ||||
2156 | void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol, | |||
2157 | MessageFixedText &&msg1, Message &&msg2) { | |||
2158 | bool isFatal{msg1.IsFatal()}; | |||
2159 | Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2)); | |||
2160 | context().SetError(symbol, isFatal); | |||
2161 | } | |||
2162 | ||||
2163 | void ScopeHandler::SayWithDecl( | |||
2164 | const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) { | |||
2165 | bool isFatal{msg.IsFatal()}; | |||
2166 | Say(name, std::move(msg), symbol.name()) | |||
2167 | .Attach(Message{name.source, | |||
2168 | symbol.test(Symbol::Flag::Implicit) | |||
2169 | ? "Implicit declaration of '%s'"_en_US | |||
2170 | : "Declaration of '%s'"_en_US, | |||
2171 | name.source}); | |||
2172 | context().SetError(symbol, isFatal); | |||
2173 | } | |||
2174 | ||||
2175 | void ScopeHandler::SayLocalMustBeVariable( | |||
2176 | const parser::Name &name, Symbol &symbol) { | |||
2177 | SayWithDecl(name, symbol, | |||
2178 | "The name '%s' must be a variable to appear" | |||
2179 | " in a locality-spec"_err_en_US); | |||
2180 | } | |||
2181 | ||||
2182 | void ScopeHandler::SayDerivedType( | |||
2183 | const SourceName &name, MessageFixedText &&msg, const Scope &type) { | |||
2184 | const Symbol &typeSymbol{DEREF(type.GetSymbol())Fortran::common::Deref(type.GetSymbol(), "flang/lib/Semantics/resolve-names.cpp" , 2184)}; | |||
2185 | Say(name, std::move(msg), name, typeSymbol.name()) | |||
2186 | .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US, | |||
2187 | typeSymbol.name()); | |||
2188 | } | |||
2189 | void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1, | |||
2190 | const SourceName &name2, MessageFixedText &&msg2) { | |||
2191 | Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2); | |||
2192 | } | |||
2193 | void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1, | |||
2194 | Symbol &symbol, MessageFixedText &&msg2) { | |||
2195 | bool isFatal{msg1.IsFatal()}; | |||
2196 | Say2(name, std::move(msg1), symbol.name(), std::move(msg2)); | |||
2197 | context().SetError(symbol, isFatal); | |||
2198 | } | |||
2199 | void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1, | |||
2200 | Symbol &symbol, MessageFixedText &&msg2) { | |||
2201 | bool isFatal{msg1.IsFatal()}; | |||
2202 | Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2)); | |||
2203 | context().SetError(symbol, isFatal); | |||
2204 | } | |||
2205 | ||||
2206 | // This is essentially GetProgramUnitContaining(), but it can return | |||
2207 | // a mutable Scope &, it ignores statement functions, and it fails | |||
2208 | // gracefully for error recovery (returning the original Scope). | |||
2209 | template <typename T> static T &GetInclusiveScope(T &scope) { | |||
2210 | for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) { | |||
2211 | switch (s->kind()) { | |||
2212 | case Scope::Kind::Module: | |||
2213 | case Scope::Kind::MainProgram: | |||
2214 | case Scope::Kind::Subprogram: | |||
2215 | case Scope::Kind::BlockData: | |||
2216 | if (!s->IsStmtFunction()) { | |||
2217 | return *s; | |||
2218 | } | |||
2219 | break; | |||
2220 | default:; | |||
2221 | } | |||
2222 | } | |||
2223 | return scope; | |||
2224 | } | |||
2225 | ||||
2226 | Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); } | |||
2227 | ||||
2228 | Scope *ScopeHandler::GetHostProcedure() { | |||
2229 | Scope &parent{InclusiveScope().parent()}; | |||
2230 | switch (parent.kind()) { | |||
2231 | case Scope::Kind::Subprogram: | |||
2232 | return &parent; | |||
2233 | case Scope::Kind::MainProgram: | |||
2234 | return &parent; | |||
2235 | default: | |||
2236 | return nullptr; | |||
2237 | } | |||
2238 | } | |||
2239 | ||||
2240 | Scope &ScopeHandler::NonDerivedTypeScope() { | |||
2241 | return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_; | |||
2242 | } | |||
2243 | ||||
2244 | void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) { | |||
2245 | PushScope(currScope().MakeScope(kind, symbol)); | |||
2246 | } | |||
2247 | void ScopeHandler::PushScope(Scope &scope) { | |||
2248 | currScope_ = &scope; | |||
2249 | auto kind{currScope_->kind()}; | |||
2250 | if (kind != Scope::Kind::BlockConstruct && | |||
2251 | kind != Scope::Kind::OtherConstruct) { | |||
2252 | BeginScope(scope); | |||
2253 | } | |||
2254 | // The name of a module or submodule cannot be "used" in its scope, | |||
2255 | // as we read 19.3.1(2), so we allow the name to be used as a local | |||
2256 | // identifier in the module or submodule too. Same with programs | |||
2257 | // (14.1(3)) and BLOCK DATA. | |||
2258 | if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module && | |||
2259 | kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) { | |||
2260 | if (auto *symbol{scope.symbol()}) { | |||
2261 | // Create a dummy symbol so we can't create another one with the same | |||
2262 | // name. It might already be there if we previously pushed the scope. | |||
2263 | SourceName name{symbol->name()}; | |||
2264 | if (!FindInScope(scope, name)) { | |||
2265 | auto &newSymbol{MakeSymbol(name)}; | |||
2266 | if (kind == Scope::Kind::Subprogram) { | |||
2267 | // Allow for recursive references. If this symbol is a function | |||
2268 | // without an explicit RESULT(), this new symbol will be discarded | |||
2269 | // and replaced with an object of the same name. | |||
2270 | newSymbol.set_details(HostAssocDetails{*symbol}); | |||
2271 | } else { | |||
2272 | newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName}); | |||
2273 | } | |||
2274 | } | |||
2275 | } | |||
2276 | } | |||
2277 | } | |||
2278 | void ScopeHandler::PopScope() { | |||
2279 | // Entities that are not yet classified as objects or procedures are now | |||
2280 | // assumed to be objects. | |||
2281 | // TODO: Statement functions | |||
2282 | for (auto &pair : currScope()) { | |||
2283 | ConvertToObjectEntity(*pair.second); | |||
2284 | } | |||
2285 | funcResultStack_.Pop(); | |||
2286 | // If popping back into a global scope, pop back to the main global scope. | |||
2287 | SetScope(currScope_->parent().IsGlobal() ? context().globalScope() | |||
2288 | : currScope_->parent()); | |||
2289 | } | |||
2290 | void ScopeHandler::SetScope(Scope &scope) { | |||
2291 | currScope_ = &scope; | |||
2292 | ImplicitRulesVisitor::SetScope(InclusiveScope()); | |||
2293 | } | |||
2294 | ||||
2295 | Symbol *ScopeHandler::FindSymbol(const parser::Name &name) { | |||
2296 | return FindSymbol(currScope(), name); | |||
2297 | } | |||
2298 | Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) { | |||
2299 | if (scope.IsDerivedType()) { | |||
2300 | if (Symbol * symbol{scope.FindComponent(name.source)}) { | |||
2301 | if (symbol->has<TypeParamDetails>()) { | |||
2302 | return Resolve(name, symbol); | |||
2303 | } | |||
2304 | } | |||
2305 | return FindSymbol(scope.parent(), name); | |||
2306 | } else { | |||
2307 | // In EQUIVALENCE statements only resolve names in the local scope, see | |||
2308 | // 19.5.1.4, paragraph 2, item (10) | |||
2309 | return Resolve(name, | |||
2310 | inEquivalenceStmt_ ? FindInScope(scope, name) | |||
2311 | : scope.FindSymbol(name.source)); | |||
2312 | } | |||
2313 | } | |||
2314 | ||||
2315 | Symbol &ScopeHandler::MakeSymbol( | |||
2316 | Scope &scope, const SourceName &name, Attrs attrs) { | |||
2317 | if (Symbol * symbol{FindInScope(scope, name)}) { | |||
2318 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
2319 | SetExplicitAttrs(*symbol, attrs); | |||
2320 | return *symbol; | |||
2321 | } else { | |||
2322 | const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})}; | |||
2323 | CHECK(pair.second)((pair.second) || (Fortran::common::die("CHECK(" "pair.second" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2323), false)); // name was not found, so must be able to add | |||
2324 | return *pair.first->second; | |||
2325 | } | |||
2326 | } | |||
2327 | Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) { | |||
2328 | return MakeSymbol(currScope(), name, attrs); | |||
2329 | } | |||
2330 | Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) { | |||
2331 | return Resolve(name, MakeSymbol(name.source, attrs)); | |||
2332 | } | |||
2333 | Symbol &ScopeHandler::MakeHostAssocSymbol( | |||
2334 | const parser::Name &name, const Symbol &hostSymbol) { | |||
2335 | Symbol &symbol{*NonDerivedTypeScope() | |||
2336 | .try_emplace(name.source, HostAssocDetails{hostSymbol}) | |||
2337 | .first->second}; | |||
2338 | name.symbol = &symbol; | |||
2339 | symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC? | |||
2340 | symbol.flags() = hostSymbol.flags(); | |||
2341 | return symbol; | |||
2342 | } | |||
2343 | Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) { | |||
2344 | CHECK(!FindInScope(name))((!FindInScope(name)) || (Fortran::common::die("CHECK(" "!FindInScope(name)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2344), false)); | |||
2345 | return MakeSymbol(currScope(), name, symbol.attrs()); | |||
2346 | } | |||
2347 | ||||
2348 | // Look for name only in scope, not in enclosing scopes. | |||
2349 | Symbol *ScopeHandler::FindInScope( | |||
2350 | const Scope &scope, const parser::Name &name) { | |||
2351 | return Resolve(name, FindInScope(scope, name.source)); | |||
2352 | } | |||
2353 | Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) { | |||
2354 | // all variants of names, e.g. "operator(.ne.)" for "operator(/=)" | |||
2355 | for (const std::string &n : GetAllNames(context(), name)) { | |||
2356 | auto it{scope.find(SourceName{n})}; | |||
2357 | if (it != scope.end()) { | |||
2358 | return &*it->second; | |||
2359 | } | |||
2360 | } | |||
2361 | return nullptr; | |||
2362 | } | |||
2363 | ||||
2364 | // Find a component or type parameter by name in a derived type or its parents. | |||
2365 | Symbol *ScopeHandler::FindInTypeOrParents( | |||
2366 | const Scope &scope, const parser::Name &name) { | |||
2367 | return Resolve(name, scope.FindComponent(name.source)); | |||
2368 | } | |||
2369 | Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) { | |||
2370 | return FindInTypeOrParents(currScope(), name); | |||
2371 | } | |||
2372 | ||||
2373 | void ScopeHandler::EraseSymbol(const parser::Name &name) { | |||
2374 | currScope().erase(name.source); | |||
2375 | name.symbol = nullptr; | |||
2376 | } | |||
2377 | ||||
2378 | static bool NeedsType(const Symbol &symbol) { | |||
2379 | return !symbol.GetType() && | |||
2380 | common::visit(common::visitors{ | |||
2381 | [](const EntityDetails &) { return true; }, | |||
2382 | [](const ObjectEntityDetails &) { return true; }, | |||
2383 | [](const AssocEntityDetails &) { return true; }, | |||
2384 | [&](const ProcEntityDetails &p) { | |||
2385 | return symbol.test(Symbol::Flag::Function) && | |||
2386 | !symbol.attrs().test(Attr::INTRINSIC) && | |||
2387 | !p.type() && !p.procInterface(); | |||
2388 | }, | |||
2389 | [](const auto &) { return false; }, | |||
2390 | }, | |||
2391 | symbol.details()); | |||
2392 | } | |||
2393 | ||||
2394 | void ScopeHandler::ApplyImplicitRules( | |||
2395 | Symbol &symbol, bool allowForwardReference) { | |||
2396 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2397 | if (context().HasError(symbol) || !NeedsType(symbol)) { | |||
2398 | return; | |||
2399 | } | |||
2400 | if (const DeclTypeSpec * type{GetImplicitType(symbol)}) { | |||
2401 | symbol.set(Symbol::Flag::Implicit); | |||
2402 | symbol.SetType(*type); | |||
2403 | return; | |||
2404 | } | |||
2405 | if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) { | |||
2406 | std::optional<Symbol::Flag> functionOrSubroutineFlag; | |||
2407 | if (symbol.test(Symbol::Flag::Function)) { | |||
2408 | functionOrSubroutineFlag = Symbol::Flag::Function; | |||
2409 | } else if (symbol.test(Symbol::Flag::Subroutine)) { | |||
2410 | functionOrSubroutineFlag = Symbol::Flag::Subroutine; | |||
2411 | } | |||
2412 | if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) { | |||
2413 | // type will be determined in expression semantics | |||
2414 | AcquireIntrinsicProcedureFlags(symbol); | |||
2415 | return; | |||
2416 | } | |||
2417 | } | |||
2418 | if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) { | |||
2419 | return; | |||
2420 | } | |||
2421 | if (!context().HasError(symbol)) { | |||
2422 | Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); | |||
2423 | context().SetError(symbol); | |||
2424 | } | |||
2425 | } | |||
2426 | ||||
2427 | // Extension: Allow forward references to scalar integer dummy arguments | |||
2428 | // to appear in specification expressions under IMPLICIT NONE(TYPE) when | |||
2429 | // what would otherwise have been their implicit type is default INTEGER. | |||
2430 | bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) { | |||
2431 | if (!inSpecificationPart_ || context().HasError(symbol) || !IsDummy(symbol) || | |||
2432 | symbol.Rank() != 0 || | |||
2433 | !context().languageFeatures().IsEnabled( | |||
2434 | common::LanguageFeature::ForwardRefDummyImplicitNone)) { | |||
2435 | return false; | |||
2436 | } | |||
2437 | const DeclTypeSpec *type{ | |||
2438 | GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)}; | |||
2439 | if (!type || !type->IsNumeric(TypeCategory::Integer)) { | |||
2440 | return false; | |||
2441 | } | |||
2442 | auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())}; | |||
2443 | if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) { | |||
2444 | return false; | |||
2445 | } | |||
2446 | if (!ConvertToObjectEntity(symbol)) { | |||
2447 | return false; | |||
2448 | } | |||
2449 | // TODO: check no INTENT(OUT)? | |||
2450 | if (context().languageFeatures().ShouldWarn( | |||
2451 | common::LanguageFeature::ForwardRefDummyImplicitNone)) { | |||
2452 | Say(symbol.name(), | |||
2453 | "Dummy argument '%s' was used without being explicitly typed"_warn_en_US, | |||
2454 | symbol.name()); | |||
2455 | } | |||
2456 | symbol.set(Symbol::Flag::Implicit); | |||
2457 | symbol.SetType(*type); | |||
2458 | return true; | |||
2459 | } | |||
2460 | ||||
2461 | // Ensure that the symbol for an intrinsic procedure is marked with | |||
2462 | // the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as | |||
2463 | // appropriate. | |||
2464 | void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) { | |||
2465 | SetImplicitAttr(symbol, Attr::INTRINSIC); | |||
2466 | switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) { | |||
2467 | case evaluate::IntrinsicClass::elementalFunction: | |||
2468 | case evaluate::IntrinsicClass::elementalSubroutine: | |||
2469 | SetExplicitAttr(symbol, Attr::ELEMENTAL); | |||
2470 | SetExplicitAttr(symbol, Attr::PURE); | |||
2471 | break; | |||
2472 | case evaluate::IntrinsicClass::impureSubroutine: | |||
2473 | break; | |||
2474 | default: | |||
2475 | SetExplicitAttr(symbol, Attr::PURE); | |||
2476 | } | |||
2477 | } | |||
2478 | ||||
2479 | const DeclTypeSpec *ScopeHandler::GetImplicitType( | |||
2480 | Symbol &symbol, bool respectImplicitNoneType) { | |||
2481 | const Scope *scope{&symbol.owner()}; | |||
2482 | if (scope->IsGlobal()) { | |||
2483 | scope = &currScope(); | |||
2484 | } | |||
2485 | scope = &GetInclusiveScope(*scope); | |||
2486 | const auto *type{implicitRulesMap_->at(scope).GetType( | |||
2487 | symbol.name(), respectImplicitNoneType)}; | |||
2488 | if (type) { | |||
2489 | if (const DerivedTypeSpec * derived{type->AsDerived()}) { | |||
2490 | // Resolve any forward-referenced derived type; a quick no-op else. | |||
2491 | auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)}; | |||
2492 | instantiatable.Instantiate(currScope()); | |||
2493 | } | |||
2494 | } | |||
2495 | return type; | |||
2496 | } | |||
2497 | ||||
2498 | void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) { | |||
2499 | if (!inSpecificationPart_ && symbol && | |||
2500 | symbol->test(Symbol::Flag::EntryDummyArgument)) { | |||
2501 | Say(source, | |||
2502 | "Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US, | |||
2503 | symbol->name()); | |||
2504 | symbol->set(Symbol::Flag::EntryDummyArgument, false); | |||
2505 | } | |||
2506 | } | |||
2507 | ||||
2508 | // Convert symbol to be a ObjectEntity or return false if it can't be. | |||
2509 | bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) { | |||
2510 | if (symbol.has<ObjectEntityDetails>()) { | |||
2511 | // nothing to do | |||
2512 | } else if (symbol.has<UnknownDetails>()) { | |||
2513 | // These are attributes that a name could have picked up from | |||
2514 | // an attribute statement or type declaration statement. | |||
2515 | if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) { | |||
2516 | return false; | |||
2517 | } | |||
2518 | symbol.set_details(ObjectEntityDetails{}); | |||
2519 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
2520 | if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) { | |||
2521 | return false; | |||
2522 | } | |||
2523 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2524 | symbol.set_details(ObjectEntityDetails{std::move(*details)}); | |||
2525 | } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) { | |||
2526 | return useDetails->symbol().has<ObjectEntityDetails>(); | |||
2527 | } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) { | |||
2528 | return hostDetails->symbol().has<ObjectEntityDetails>(); | |||
2529 | } else { | |||
2530 | return false; | |||
2531 | } | |||
2532 | return true; | |||
2533 | } | |||
2534 | // Convert symbol to be a ProcEntity or return false if it can't be. | |||
2535 | bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) { | |||
2536 | if (symbol.has<ProcEntityDetails>()) { | |||
2537 | // nothing to do | |||
2538 | } else if (symbol.has<UnknownDetails>()) { | |||
2539 | symbol.set_details(ProcEntityDetails{}); | |||
2540 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
2541 | if (IsFunctionResult(symbol) && | |||
2542 | !(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) { | |||
2543 | // Don't turn function result into a procedure pointer unless both | |||
2544 | // POINTER and EXTERNAL | |||
2545 | return false; | |||
2546 | } | |||
2547 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2548 | symbol.set_details(ProcEntityDetails{std::move(*details)}); | |||
2549 | if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) { | |||
2550 | CHECK(!symbol.test(Symbol::Flag::Subroutine))((!symbol.test(Symbol::Flag::Subroutine)) || (Fortran::common ::die("CHECK(" "!symbol.test(Symbol::Flag::Subroutine)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 2550) , false)); | |||
2551 | symbol.set(Symbol::Flag::Function); | |||
2552 | } | |||
2553 | } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) { | |||
2554 | return useDetails->symbol().has<ProcEntityDetails>(); | |||
2555 | } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) { | |||
2556 | return hostDetails->symbol().has<ProcEntityDetails>(); | |||
2557 | } else { | |||
2558 | return false; | |||
2559 | } | |||
2560 | return true; | |||
2561 | } | |||
2562 | ||||
2563 | const DeclTypeSpec &ScopeHandler::MakeNumericType( | |||
2564 | TypeCategory category, const std::optional<parser::KindSelector> &kind) { | |||
2565 | KindExpr value{GetKindParamExpr(category, kind)}; | |||
2566 | if (auto known{evaluate::ToInt64(value)}) { | |||
2567 | return MakeNumericType(category, static_cast<int>(*known)); | |||
2568 | } else { | |||
2569 | return currScope_->MakeNumericType(category, std::move(value)); | |||
2570 | } | |||
2571 | } | |||
2572 | ||||
2573 | const DeclTypeSpec &ScopeHandler::MakeNumericType( | |||
2574 | TypeCategory category, int kind) { | |||
2575 | return context().MakeNumericType(category, kind); | |||
2576 | } | |||
2577 | ||||
2578 | const DeclTypeSpec &ScopeHandler::MakeLogicalType( | |||
2579 | const std::optional<parser::KindSelector> &kind) { | |||
2580 | KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)}; | |||
2581 | if (auto known{evaluate::ToInt64(value)}) { | |||
2582 | return MakeLogicalType(static_cast<int>(*known)); | |||
2583 | } else { | |||
2584 | return currScope_->MakeLogicalType(std::move(value)); | |||
2585 | } | |||
2586 | } | |||
2587 | ||||
2588 | const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) { | |||
2589 | return context().MakeLogicalType(kind); | |||
2590 | } | |||
2591 | ||||
2592 | void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) { | |||
2593 | if (inSpecificationPart_ && name.symbol) { | |||
2594 | auto kind{currScope().kind()}; | |||
2595 | if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) || | |||
2596 | kind == Scope::Kind::BlockConstruct) { | |||
2597 | bool isHostAssociated{&name.symbol->owner() == &currScope() | |||
2598 | ? name.symbol->has<HostAssocDetails>() | |||
2599 | : name.symbol->owner().Contains(currScope())}; | |||
2600 | if (isHostAssociated) { | |||
2601 | specPartState_.forwardRefs.insert(name.source); | |||
2602 | } | |||
2603 | } | |||
2604 | } | |||
2605 | } | |||
2606 | ||||
2607 | std::optional<SourceName> ScopeHandler::HadForwardRef( | |||
2608 | const Symbol &symbol) const { | |||
2609 | auto iter{specPartState_.forwardRefs.find(symbol.name())}; | |||
2610 | if (iter != specPartState_.forwardRefs.end()) { | |||
2611 | return *iter; | |||
2612 | } | |||
2613 | return std::nullopt; | |||
2614 | } | |||
2615 | ||||
2616 | bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) { | |||
2617 | if (!context().HasError(symbol)) { | |||
2618 | if (auto fwdRef{HadForwardRef(symbol)}) { | |||
2619 | const Symbol *outer{symbol.owner().FindSymbol(symbol.name())}; | |||
2620 | if (outer && symbol.has<UseDetails>() && | |||
2621 | &symbol.GetUltimate() == &outer->GetUltimate()) { | |||
2622 | // e.g. IMPORT of host's USE association | |||
2623 | return false; | |||
2624 | } | |||
2625 | Say(*fwdRef, | |||
2626 | "Forward reference to '%s' is not allowed in the same specification part"_err_en_US, | |||
2627 | *fwdRef) | |||
2628 | .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef); | |||
2629 | context().SetError(symbol); | |||
2630 | return true; | |||
2631 | } | |||
2632 | if (IsDummy(symbol) && isImplicitNoneType() && | |||
2633 | symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) { | |||
2634 | // Dummy was implicitly typed despite IMPLICIT NONE(TYPE) in | |||
2635 | // ApplyImplicitRules() due to use in a specification expression, | |||
2636 | // and no explicit type declaration appeared later. | |||
2637 | Say(symbol.name(), | |||
2638 | "No explicit type declared for dummy argument '%s'"_err_en_US); | |||
2639 | context().SetError(symbol); | |||
2640 | return true; | |||
2641 | } | |||
2642 | } | |||
2643 | return false; | |||
2644 | } | |||
2645 | ||||
2646 | void ScopeHandler::MakeExternal(Symbol &symbol) { | |||
2647 | if (!symbol.attrs().test(Attr::EXTERNAL)) { | |||
2648 | SetImplicitAttr(symbol, Attr::EXTERNAL); | |||
2649 | if (symbol.attrs().test(Attr::INTRINSIC)) { // C840 | |||
2650 | Say(symbol.name(), | |||
2651 | "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, | |||
2652 | symbol.name()); | |||
2653 | } | |||
2654 | } | |||
2655 | } | |||
2656 | ||||
2657 | bool ScopeHandler::CheckDuplicatedAttr( | |||
2658 | SourceName name, const Symbol &symbol, Attr attr) { | |||
2659 | if (attr == Attr::SAVE || attr == Attr::BIND_C) { | |||
2660 | // these are checked elsewhere | |||
2661 | } else if (symbol.attrs().test(attr)) { // C815 | |||
2662 | if (symbol.implicitAttrs().test(attr)) { | |||
2663 | // Implied attribute is now confirmed explicitly | |||
2664 | } else { | |||
2665 | Say(name, "%s attribute was already specified on '%s'"_err_en_US, | |||
2666 | EnumToString(attr), name); | |||
2667 | return false; | |||
2668 | } | |||
2669 | } | |||
2670 | return true; | |||
2671 | } | |||
2672 | ||||
2673 | bool ScopeHandler::CheckDuplicatedAttrs( | |||
2674 | SourceName name, const Symbol &symbol, Attrs attrs) { | |||
2675 | bool ok{true}; | |||
2676 | attrs.IterateOverMembers( | |||
2677 | [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); }); | |||
2678 | return ok; | |||
2679 | } | |||
2680 | ||||
2681 | // ModuleVisitor implementation | |||
2682 | ||||
2683 | bool ModuleVisitor::Pre(const parser::Only &x) { | |||
2684 | common::visit(common::visitors{ | |||
2685 | [&](const Indirection<parser::GenericSpec> &generic) { | |||
2686 | GenericSpecInfo genericSpecInfo{generic.value()}; | |||
2687 | AddUseOnly(genericSpecInfo.symbolName()); | |||
2688 | AddUse(genericSpecInfo); | |||
2689 | }, | |||
2690 | [&](const parser::Name &name) { | |||
2691 | AddUseOnly(name.source); | |||
2692 | Resolve(name, AddUse(name.source, name.source).use); | |||
2693 | }, | |||
2694 | [&](const parser::Rename &rename) { Walk(rename); }, | |||
2695 | }, | |||
2696 | x.u); | |||
2697 | return false; | |||
2698 | } | |||
2699 | ||||
2700 | bool ModuleVisitor::Pre(const parser::Rename::Names &x) { | |||
2701 | const auto &localName{std::get<0>(x.t)}; | |||
2702 | const auto &useName{std::get<1>(x.t)}; | |||
2703 | AddUseRename(useName.source); | |||
2704 | SymbolRename rename{AddUse(localName.source, useName.source)}; | |||
2705 | if (rename.use) { | |||
2706 | EraseRenamedSymbol(*rename.use); | |||
2707 | } | |||
2708 | Resolve(useName, rename.use); | |||
2709 | Resolve(localName, rename.local); | |||
2710 | return false; | |||
2711 | } | |||
2712 | bool ModuleVisitor::Pre(const parser::Rename::Operators &x) { | |||
2713 | const parser::DefinedOpName &local{std::get<0>(x.t)}; | |||
2714 | const parser::DefinedOpName &use{std::get<1>(x.t)}; | |||
2715 | GenericSpecInfo localInfo{local}; | |||
2716 | GenericSpecInfo useInfo{use}; | |||
2717 | if (IsIntrinsicOperator(context(), local.v.source)) { | |||
2718 | Say(local.v, | |||
2719 | "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US); | |||
2720 | } else if (IsLogicalConstant(context(), local.v.source)) { | |||
2721 | Say(local.v, | |||
2722 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
2723 | } else { | |||
2724 | SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())}; | |||
2725 | if (rename.use) { | |||
2726 | EraseRenamedSymbol(*rename.use); | |||
2727 | } | |||
2728 | useInfo.Resolve(rename.use); | |||
2729 | localInfo.Resolve(rename.local); | |||
2730 | } | |||
2731 | return false; | |||
2732 | } | |||
2733 | ||||
2734 | // Set useModuleScope_ to the Scope of the module being used. | |||
2735 | bool ModuleVisitor::Pre(const parser::UseStmt &x) { | |||
2736 | std::optional<bool> isIntrinsic; | |||
2737 | if (x.nature) { | |||
2738 | isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic; | |||
2739 | AddAndCheckExplicitIntrinsicUse(x.moduleName.source, *isIntrinsic); | |||
2740 | } else if (currScope().IsModule() && currScope().symbol() && | |||
2741 | currScope().symbol()->attrs().test(Attr::INTRINSIC)) { | |||
2742 | // Intrinsic modules USE only other intrinsic modules | |||
2743 | isIntrinsic = true; | |||
2744 | } | |||
2745 | useModuleScope_ = FindModule(x.moduleName, isIntrinsic); | |||
2746 | if (!useModuleScope_) { | |||
2747 | return false; | |||
2748 | } | |||
2749 | // use the name from this source file | |||
2750 | useModuleScope_->symbol()->ReplaceName(x.moduleName.source); | |||
2751 | return true; | |||
2752 | } | |||
2753 | ||||
2754 | void ModuleVisitor::Post(const parser::UseStmt &x) { | |||
2755 | if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) { | |||
2756 | // Not a use-only: collect the names that were used in renames, | |||
2757 | // then add a use for each public name that was not renamed. | |||
2758 | std::set<SourceName> useNames; | |||
2759 | for (const auto &rename : *list) { | |||
2760 | common::visit(common::visitors{ | |||
2761 | [&](const parser::Rename::Names &names) { | |||
2762 | useNames.insert(std::get<1>(names.t).source); | |||
2763 | }, | |||
2764 | [&](const parser::Rename::Operators &ops) { | |||
2765 | useNames.insert(std::get<1>(ops.t).v.source); | |||
2766 | }, | |||
2767 | }, | |||
2768 | rename.u); | |||
2769 | } | |||
2770 | for (const auto &[name, symbol] : *useModuleScope_) { | |||
2771 | if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) && | |||
2772 | (!symbol->attrs().test(Attr::INTRINSIC) || | |||
2773 | symbol->has<UseDetails>()) && | |||
2774 | !symbol->has<MiscDetails>() && useNames.count(name) == 0) { | |||
2775 | SourceName location{x.moduleName.source}; | |||
2776 | if (auto *localSymbol{FindInScope(name)}) { | |||
2777 | DoAddUse(location, localSymbol->name(), *localSymbol, *symbol); | |||
2778 | } else { | |||
2779 | DoAddUse(location, location, CopySymbol(name, *symbol), *symbol); | |||
2780 | } | |||
2781 | } | |||
2782 | } | |||
2783 | } | |||
2784 | useModuleScope_ = nullptr; | |||
2785 | } | |||
2786 | ||||
2787 | ModuleVisitor::SymbolRename ModuleVisitor::AddUse( | |||
2788 | const SourceName &localName, const SourceName &useName) { | |||
2789 | return AddUse(localName, useName, FindInScope(*useModuleScope_, useName)); | |||
2790 | } | |||
2791 | ||||
2792 | ModuleVisitor::SymbolRename ModuleVisitor::AddUse( | |||
2793 | const SourceName &localName, const SourceName &useName, Symbol *useSymbol) { | |||
2794 | if (!useModuleScope_) { | |||
2795 | return {}; // error occurred finding module | |||
2796 | } | |||
2797 | if (!useSymbol) { | |||
2798 | Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName), | |||
2799 | useModuleScope_->GetName().value()); | |||
2800 | return {}; | |||
2801 | } | |||
2802 | if (useSymbol->attrs().test(Attr::PRIVATE) && | |||
2803 | !FindModuleFileContaining(currScope())) { | |||
2804 | // Privacy is not enforced in module files so that generic interfaces | |||
2805 | // can be resolved to private specific procedures in specification | |||
2806 | // expressions. | |||
2807 | Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName), | |||
2808 | useModuleScope_->GetName().value()); | |||
2809 | return {}; | |||
2810 | } | |||
2811 | auto &localSymbol{MakeSymbol(localName)}; | |||
2812 | DoAddUse(useName, localName, localSymbol, *useSymbol); | |||
2813 | return {&localSymbol, useSymbol}; | |||
2814 | } | |||
2815 | ||||
2816 | // symbol must be either a Use or a Generic formed by merging two uses. | |||
2817 | // Convert it to a UseError with this additional location. | |||
2818 | static bool ConvertToUseError( | |||
2819 | Symbol &symbol, const SourceName &location, const Scope &module) { | |||
2820 | const auto *useDetails{symbol.detailsIf<UseDetails>()}; | |||
2821 | if (!useDetails) { | |||
2822 | if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) { | |||
2823 | if (!genericDetails->uses().empty()) { | |||
2824 | useDetails = &genericDetails->uses().at(0)->get<UseDetails>(); | |||
2825 | } | |||
2826 | } | |||
2827 | } | |||
2828 | if (useDetails) { | |||
2829 | symbol.set_details( | |||
2830 | UseErrorDetails{*useDetails}.add_occurrence(location, module)); | |||
2831 | return true; | |||
2832 | } else { | |||
2833 | return false; | |||
2834 | } | |||
2835 | } | |||
2836 | ||||
2837 | // If a symbol has previously been USE-associated and did not appear in a USE | |||
2838 | // ONLY clause, erase it from the current scope. This is needed when a name | |||
2839 | // appears in a USE rename clause. | |||
2840 | void ModuleVisitor::EraseRenamedSymbol(const Symbol &useSymbol) { | |||
2841 | const SourceName &name{useSymbol.name()}; | |||
2842 | if (const Symbol * symbol{FindInScope(name)}) { | |||
2843 | if (auto *useDetails{symbol->detailsIf<UseDetails>()}) { | |||
2844 | const Symbol &moduleSymbol{useDetails->symbol()}; | |||
2845 | if (moduleSymbol.name() == name && | |||
2846 | moduleSymbol.owner() == useSymbol.owner() && IsUseRenamed(name) && | |||
2847 | !IsUseOnly(name)) { | |||
2848 | EraseSymbol(*symbol); | |||
2849 | } | |||
2850 | } | |||
2851 | } | |||
2852 | } | |||
2853 | ||||
2854 | void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, | |||
2855 | Symbol &localSymbol, const Symbol &useSymbol) { | |||
2856 | if (localName != useSymbol.name()) { | |||
2857 | EraseRenamedSymbol(useSymbol); | |||
2858 | } | |||
2859 | if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) { | |||
2860 | details->add_occurrence(location, *useModuleScope_); | |||
2861 | return; | |||
2862 | } | |||
2863 | ||||
2864 | if (localSymbol.has<UnknownDetails>()) { | |||
2865 | localSymbol.set_details(UseDetails{localName, useSymbol}); | |||
2866 | localSymbol.attrs() = | |||
2867 | useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; | |||
2868 | localSymbol.implicitAttrs() = | |||
2869 | localSymbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE}; | |||
2870 | localSymbol.flags() = useSymbol.flags(); | |||
2871 | return; | |||
2872 | } | |||
2873 | ||||
2874 | Symbol &localUltimate{localSymbol.GetUltimate()}; | |||
2875 | const Symbol &useUltimate{useSymbol.GetUltimate()}; | |||
2876 | if (&localUltimate == &useUltimate) { | |||
2877 | // use-associating the same symbol again -- ok | |||
2878 | return; | |||
2879 | } | |||
2880 | ||||
2881 | auto checkAmbiguousDerivedType{[this, location, localName]( | |||
2882 | const Symbol *t1, const Symbol *t2) { | |||
2883 | if (!t1 || !t2) { | |||
2884 | return true; | |||
2885 | } else { | |||
2886 | t1 = &t1->GetUltimate(); | |||
2887 | t2 = &t2->GetUltimate(); | |||
2888 | if (&t1 != &t2) { | |||
2889 | Say(location, | |||
2890 | "Generic interface '%s' has ambiguous derived types from modules '%s' and '%s'"_err_en_US, | |||
2891 | localName, t1->owner().GetName().value(), | |||
2892 | t2->owner().GetName().value()); | |||
2893 | return false; | |||
2894 | } | |||
2895 | } | |||
2896 | }}; | |||
2897 | ||||
2898 | auto *localGeneric{localUltimate.detailsIf<GenericDetails>()}; | |||
2899 | const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()}; | |||
2900 | auto combine{false}; | |||
2901 | if (localGeneric) { | |||
2902 | if (useGeneric) { | |||
2903 | if (!checkAmbiguousDerivedType( | |||
2904 | localGeneric->derivedType(), useGeneric->derivedType())) { | |||
2905 | return; | |||
2906 | } | |||
2907 | combine = true; | |||
2908 | } else if (useUltimate.has<DerivedTypeDetails>()) { | |||
2909 | if (checkAmbiguousDerivedType( | |||
2910 | &useUltimate, localGeneric->derivedType())) { | |||
2911 | combine = true; | |||
2912 | } else { | |||
2913 | return; | |||
2914 | } | |||
2915 | } else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) { | |||
2916 | return; // nothing to do; used subprogram is local's specific | |||
2917 | } | |||
2918 | } else if (useGeneric) { | |||
2919 | if (localUltimate.has<DerivedTypeDetails>()) { | |||
2920 | if (checkAmbiguousDerivedType( | |||
2921 | &localUltimate, useGeneric->derivedType())) { | |||
2922 | combine = true; | |||
2923 | } else { | |||
2924 | return; | |||
2925 | } | |||
2926 | } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate()) { | |||
2927 | // Local is the specific of the used generic; replace it. | |||
2928 | EraseSymbol(localSymbol); | |||
2929 | Symbol &newSymbol{MakeSymbol(localName, | |||
2930 | useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}, | |||
2931 | UseDetails{localName, useUltimate})}; | |||
2932 | newSymbol.flags() = useSymbol.flags(); | |||
2933 | return; | |||
2934 | } | |||
2935 | } else { | |||
2936 | auto localClass{ClassifyProcedure(localUltimate)}; | |||
2937 | auto useClass{ClassifyProcedure(useUltimate)}; | |||
2938 | if (localClass == useClass && | |||
2939 | (localClass == ProcedureDefinitionClass::Intrinsic || | |||
2940 | localClass == ProcedureDefinitionClass::External) && | |||
2941 | localUltimate.name() == useUltimate.name()) { | |||
2942 | auto localChars{evaluate::characteristics::Procedure::Characterize( | |||
2943 | localUltimate, GetFoldingContext())}; | |||
2944 | auto useChars{evaluate::characteristics::Procedure::Characterize( | |||
2945 | useUltimate, GetFoldingContext())}; | |||
2946 | if (localChars && useChars) { | |||
2947 | if (*localChars == *useChars) { | |||
2948 | // Same intrinsic or external procedure defined identically in two | |||
2949 | // modules | |||
2950 | return; | |||
2951 | } | |||
2952 | } | |||
2953 | } | |||
2954 | } | |||
2955 | if (!combine) { | |||
2956 | if (!ConvertToUseError(localSymbol, location, *useModuleScope_)) { | |||
2957 | Say(location, | |||
2958 | "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US, | |||
2959 | localName) | |||
2960 | .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US, | |||
2961 | localName); | |||
2962 | } | |||
2963 | return; | |||
2964 | } | |||
2965 | ||||
2966 | // Two items are being use-associated from different modules | |||
2967 | // to the same local name. At least one of them must be a generic, | |||
2968 | // and the other one can be a generic or a derived type. | |||
2969 | // (It could also have been the specific of the generic, but those | |||
2970 | // cases are handled above without needing to make a local copy of the | |||
2971 | // generic.) | |||
2972 | ||||
2973 | if (localGeneric) { | |||
2974 | if (localSymbol.has<UseDetails>()) { | |||
2975 | // Create a local copy of a previously use-associated generic so that | |||
2976 | // it can be locally extended without corrupting the original. | |||
2977 | GenericDetails generic; | |||
2978 | generic.CopyFrom(*localGeneric); | |||
2979 | if (localGeneric->specific()) { | |||
2980 | generic.set_specific(*localGeneric->specific()); | |||
2981 | } | |||
2982 | EraseSymbol(localSymbol); | |||
2983 | Symbol &newSymbol{MakeSymbol( | |||
2984 | localSymbol.name(), localSymbol.attrs(), std::move(generic))}; | |||
2985 | newSymbol.flags() = localSymbol.flags(); | |||
2986 | localGeneric = &newSymbol.get<GenericDetails>(); | |||
2987 | localGeneric->AddUse(localSymbol); | |||
2988 | } | |||
2989 | if (useGeneric) { | |||
2990 | // Combine two use-associated generics | |||
2991 | localSymbol.attrs() = | |||
2992 | useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; | |||
2993 | localSymbol.flags() = useSymbol.flags(); | |||
2994 | AddGenericUse(*localGeneric, localName, useUltimate); | |||
2995 | localGeneric->CopyFrom(*useGeneric); | |||
2996 | if (useGeneric->specific()) { | |||
2997 | if (!localGeneric->specific()) { | |||
2998 | localGeneric->set_specific( | |||
2999 | *const_cast<Symbol *>(useGeneric->specific())); | |||
3000 | } else if (&localGeneric->specific()->GetUltimate() != | |||
3001 | &useGeneric->specific()->GetUltimate()) { | |||
3002 | Say(location, | |||
3003 | "Cannot use-associate generic interface '%s' with specific procedure of the same name when another such generic is in scope"_err_en_US, | |||
3004 | localName) | |||
3005 | .Attach( | |||
3006 | localSymbol.name(), "Previous USE of '%s'"_en_US, localName); | |||
3007 | } | |||
3008 | } | |||
3009 | } else { | |||
3010 | CHECK(useUltimate.has<DerivedTypeDetails>())((useUltimate.has<DerivedTypeDetails>()) || (Fortran::common ::die("CHECK(" "useUltimate.has<DerivedTypeDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3010) , false)); | |||
3011 | localGeneric->set_derivedType( | |||
3012 | AddGenericUse(*localGeneric, localName, useUltimate)); | |||
3013 | } | |||
3014 | } else { | |||
3015 | CHECK(useGeneric && localUltimate.has<DerivedTypeDetails>())((useGeneric && localUltimate.has<DerivedTypeDetails >()) || (Fortran::common::die("CHECK(" "useGeneric && localUltimate.has<DerivedTypeDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3015), false)); | |||
3016 | CHECK(localSymbol.has<UseDetails>())((localSymbol.has<UseDetails>()) || (Fortran::common::die ("CHECK(" "localSymbol.has<UseDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3016), false )); | |||
3017 | // Create a local copy of the use-associated generic, then extend it | |||
3018 | // with the local derived type. | |||
3019 | GenericDetails generic; | |||
3020 | generic.CopyFrom(*useGeneric); | |||
3021 | if (useGeneric->specific()) { | |||
3022 | generic.set_specific(*const_cast<Symbol *>(useGeneric->specific())); | |||
3023 | } | |||
3024 | EraseSymbol(localSymbol); | |||
3025 | Symbol &newSymbol{MakeSymbol(localName, | |||
3026 | useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}, | |||
3027 | std::move(generic))}; | |||
3028 | newSymbol.flags() = useUltimate.flags(); | |||
3029 | auto &newUseGeneric{newSymbol.get<GenericDetails>()}; | |||
3030 | AddGenericUse(newUseGeneric, localName, useUltimate); | |||
3031 | newUseGeneric.AddUse(localSymbol); | |||
3032 | newUseGeneric.set_derivedType(localSymbol); | |||
3033 | } | |||
3034 | } | |||
3035 | ||||
3036 | void ModuleVisitor::AddUse(const GenericSpecInfo &info) { | |||
3037 | if (useModuleScope_) { | |||
3038 | const auto &name{info.symbolName()}; | |||
3039 | auto rename{AddUse(name, name, FindInScope(*useModuleScope_, name))}; | |||
3040 | info.Resolve(rename.use); | |||
3041 | } | |||
3042 | } | |||
3043 | ||||
3044 | // Create a UseDetails symbol for this USE and add it to generic | |||
3045 | Symbol &ModuleVisitor::AddGenericUse( | |||
3046 | GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) { | |||
3047 | Symbol &newSymbol{ | |||
3048 | currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})}; | |||
3049 | generic.AddUse(newSymbol); | |||
3050 | return newSymbol; | |||
3051 | } | |||
3052 | ||||
3053 | // Enforce C1406 | |||
3054 | void ModuleVisitor::AddAndCheckExplicitIntrinsicUse( | |||
3055 | SourceName name, bool isIntrinsic) { | |||
3056 | if (isIntrinsic) { | |||
3057 | if (auto iter{explicitNonIntrinsicUses_.find(name)}; | |||
3058 | iter != explicitNonIntrinsicUses_.end()) { | |||
3059 | Say(name, | |||
3060 | "Cannot USE,INTRINSIC module '%s' in the same scope as USE,NON_INTRINSIC"_err_en_US, | |||
3061 | name) | |||
3062 | .Attach(*iter, "Previous USE of '%s'"_en_US, *iter); | |||
3063 | } | |||
3064 | explicitIntrinsicUses_.insert(name); | |||
3065 | } else { | |||
3066 | if (auto iter{explicitIntrinsicUses_.find(name)}; | |||
3067 | iter != explicitIntrinsicUses_.end()) { | |||
3068 | Say(name, | |||
3069 | "Cannot USE,NON_INTRINSIC module '%s' in the same scope as USE,INTRINSIC"_err_en_US, | |||
3070 | name) | |||
3071 | .Attach(*iter, "Previous USE of '%s'"_en_US, *iter); | |||
3072 | } | |||
3073 | explicitNonIntrinsicUses_.insert(name); | |||
3074 | } | |||
3075 | } | |||
3076 | ||||
3077 | bool ModuleVisitor::BeginSubmodule( | |||
3078 | const parser::Name &name, const parser::ParentIdentifier &parentId) { | |||
3079 | const auto &ancestorName{std::get<parser::Name>(parentId.t)}; | |||
3080 | Scope *parentScope{nullptr}; | |||
3081 | Scope *ancestor{FindModule(ancestorName, false /*not intrinsic*/)}; | |||
3082 | if (ancestor) { | |||
3083 | if (const auto &parentName{ | |||
3084 | std::get<std::optional<parser::Name>>(parentId.t)}) { | |||
3085 | parentScope = FindModule(*parentName, false /*not intrinsic*/, ancestor); | |||
3086 | } else { | |||
3087 | parentScope = ancestor; | |||
3088 | } | |||
3089 | } | |||
3090 | if (parentScope) { | |||
3091 | PushScope(*parentScope); | |||
3092 | } else { | |||
3093 | // Error recovery: there's no ancestor scope, so create a dummy one to | |||
3094 | // hold the submodule's scope. | |||
3095 | SourceName dummyName{context().GetTempName(currScope())}; | |||
3096 | Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})}; | |||
3097 | PushScope(Scope::Kind::Module, &dummySymbol); | |||
3098 | parentScope = &currScope(); | |||
3099 | } | |||
3100 | BeginModule(name, true); | |||
3101 | if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) { | |||
3102 | Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US, | |||
3103 | ancestorName.source, name.source); | |||
3104 | } | |||
3105 | return true; | |||
3106 | } | |||
3107 | ||||
3108 | void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) { | |||
3109 | auto &symbol{MakeSymbol(name, ModuleDetails{isSubmodule})}; | |||
3110 | auto &details{symbol.get<ModuleDetails>()}; | |||
3111 | PushScope(Scope::Kind::Module, &symbol); | |||
3112 | details.set_scope(&currScope()); | |||
3113 | defaultAccess_ = Attr::PUBLIC; | |||
3114 | prevAccessStmt_ = std::nullopt; | |||
3115 | } | |||
3116 | ||||
3117 | // Find a module or submodule by name and return its scope. | |||
3118 | // If ancestor is present, look for a submodule of that ancestor module. | |||
3119 | // May have to read a .mod file to find it. | |||
3120 | // If an error occurs, report it and return nullptr. | |||
3121 | Scope *ModuleVisitor::FindModule(const parser::Name &name, | |||
3122 | std::optional<bool> isIntrinsic, Scope *ancestor) { | |||
3123 | ModFileReader reader{context()}; | |||
3124 | Scope *scope{reader.Read(name.source, isIntrinsic, ancestor)}; | |||
3125 | if (!scope) { | |||
3126 | return nullptr; | |||
3127 | } | |||
3128 | if (DoesScopeContain(scope, currScope())) { // 14.2.2(1) | |||
3129 | Say(name, "Module '%s' cannot USE itself"_err_en_US); | |||
3130 | } | |||
3131 | Resolve(name, scope->symbol()); | |||
3132 | return scope; | |||
3133 | } | |||
3134 | ||||
3135 | void ModuleVisitor::ApplyDefaultAccess() { | |||
3136 | for (auto &pair : currScope()) { | |||
3137 | Symbol &symbol = *pair.second; | |||
3138 | if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
3139 | SetImplicitAttr(symbol, defaultAccess_); | |||
3140 | } | |||
3141 | } | |||
3142 | } | |||
3143 | ||||
3144 | // InterfaceVistor implementation | |||
3145 | ||||
3146 | bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) { | |||
3147 | bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)}; | |||
3148 | genericInfo_.emplace(/*isInterface*/ true, isAbstract); | |||
3149 | return BeginAttrs(); | |||
3150 | } | |||
3151 | ||||
3152 | void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); } | |||
3153 | ||||
3154 | void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) { | |||
3155 | genericInfo_.pop(); | |||
3156 | } | |||
3157 | ||||
3158 | // Create a symbol in genericSymbol_ for this GenericSpec. | |||
3159 | bool InterfaceVisitor::Pre(const parser::GenericSpec &x) { | |||
3160 | if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) { | |||
3161 | SetGenericSymbol(*symbol); | |||
3162 | } | |||
3163 | return false; | |||
3164 | } | |||
3165 | ||||
3166 | bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) { | |||
3167 | if (!isGeneric()) { | |||
3168 | Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US); | |||
3169 | return false; | |||
3170 | } | |||
3171 | auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)}; | |||
3172 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
3173 | AddSpecificProcs(names, kind); | |||
3174 | return false; | |||
3175 | } | |||
3176 | ||||
3177 | bool InterfaceVisitor::Pre(const parser::GenericStmt &) { | |||
3178 | genericInfo_.emplace(/*isInterface*/ false); | |||
3179 | return true; | |||
3180 | } | |||
3181 | void InterfaceVisitor::Post(const parser::GenericStmt &x) { | |||
3182 | if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) { | |||
3183 | SetExplicitAttr(*GetGenericInfo().symbol, AccessSpecToAttr(*accessSpec)); | |||
3184 | } | |||
3185 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
3186 | AddSpecificProcs(names, ProcedureKind::Procedure); | |||
3187 | genericInfo_.pop(); | |||
3188 | } | |||
3189 | ||||
3190 | bool InterfaceVisitor::inInterfaceBlock() const { | |||
3191 | return !genericInfo_.empty() && GetGenericInfo().isInterface; | |||
3192 | } | |||
3193 | bool InterfaceVisitor::isGeneric() const { | |||
3194 | return !genericInfo_.empty() && GetGenericInfo().symbol; | |||
3195 | } | |||
3196 | bool InterfaceVisitor::isAbstract() const { | |||
3197 | return !genericInfo_.empty() && GetGenericInfo().isAbstract; | |||
3198 | } | |||
3199 | ||||
3200 | void InterfaceVisitor::AddSpecificProcs( | |||
3201 | const std::list<parser::Name> &names, ProcedureKind kind) { | |||
3202 | for (const auto &name : names) { | |||
3203 | specificProcs_.emplace( | |||
3204 | GetGenericInfo().symbol, std::make_pair(&name, kind)); | |||
3205 | } | |||
3206 | } | |||
3207 | ||||
3208 | // By now we should have seen all specific procedures referenced by name in | |||
3209 | // this generic interface. Resolve those names to symbols. | |||
3210 | void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) { | |||
3211 | auto &details{generic.get<GenericDetails>()}; | |||
3212 | UnorderedSymbolSet symbolsSeen; | |||
3213 | for (const Symbol &symbol : details.specificProcs()) { | |||
3214 | symbolsSeen.insert(symbol.GetUltimate()); | |||
3215 | } | |||
3216 | auto range{specificProcs_.equal_range(&generic)}; | |||
3217 | for (auto it{range.first}; it != range.second; ++it) { | |||
3218 | const parser::Name *name{it->second.first}; | |||
3219 | auto kind{it->second.second}; | |||
3220 | const auto *symbol{FindSymbol(*name)}; | |||
3221 | if (!symbol) { | |||
3222 | Say(*name, "Procedure '%s' not found"_err_en_US); | |||
3223 | continue; | |||
3224 | } | |||
3225 | // Subtlety: when *symbol is a use- or host-association, the specific | |||
3226 | // procedure that is recorded in the GenericDetails below must be *symbol, | |||
3227 | // not the specific procedure shadowed by a generic, because that specific | |||
3228 | // procedure may be a symbol from another module and its name unavailable to | |||
3229 | // emit to a module file. | |||
3230 | const Symbol &bypassed{BypassGeneric(*symbol)}; | |||
3231 | const Symbol &specific{ | |||
3232 | symbol == &symbol->GetUltimate() ? bypassed : *symbol}; | |||
3233 | const Symbol &ultimate{bypassed.GetUltimate()}; | |||
3234 | ProcedureDefinitionClass defClass{ClassifyProcedure(ultimate)}; | |||
3235 | if (defClass == ProcedureDefinitionClass::Module) { | |||
3236 | // ok | |||
3237 | } else if (kind == ProcedureKind::ModuleProcedure) { | |||
3238 | Say(*name, "'%s' is not a module procedure"_err_en_US); | |||
3239 | continue; | |||
3240 | } else { | |||
3241 | switch (defClass) { | |||
3242 | case ProcedureDefinitionClass::Intrinsic: | |||
3243 | case ProcedureDefinitionClass::External: | |||
3244 | case ProcedureDefinitionClass::Internal: | |||
3245 | case ProcedureDefinitionClass::Dummy: | |||
3246 | case ProcedureDefinitionClass::Pointer: | |||
3247 | break; | |||
3248 | case ProcedureDefinitionClass::None: | |||
3249 | Say(*name, "'%s' is not a procedure"_err_en_US); | |||
3250 | continue; | |||
3251 | default: | |||
3252 | Say(*name, | |||
3253 | "'%s' is not a procedure that can appear in a generic interface"_err_en_US); | |||
3254 | continue; | |||
3255 | } | |||
3256 | } | |||
3257 | if (symbolsSeen.insert(ultimate).second /*true if added*/) { | |||
3258 | // When a specific procedure is a USE association, that association | |||
3259 | // is saved in the generic's specifics, not its ultimate symbol, | |||
3260 | // so that module file output of interfaces can distinguish them. | |||
3261 | details.AddSpecificProc(specific, name->source); | |||
3262 | } else if (&specific == &ultimate) { | |||
3263 | Say(name->source, | |||
3264 | "Procedure '%s' is already specified in generic '%s'"_err_en_US, | |||
3265 | name->source, MakeOpName(generic.name())); | |||
3266 | } else { | |||
3267 | Say(name->source, | |||
3268 | "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US, | |||
3269 | ultimate.name(), ultimate.owner().GetName().value(), | |||
3270 | MakeOpName(generic.name())); | |||
3271 | } | |||
3272 | } | |||
3273 | specificProcs_.erase(range.first, range.second); | |||
3274 | } | |||
3275 | ||||
3276 | // Mixed interfaces are allowed by the standard. | |||
3277 | // If there is a derived type with the same name, they must all be functions. | |||
3278 | void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) { | |||
3279 | ResolveSpecificsInGeneric(generic); | |||
3280 | auto &details{generic.get<GenericDetails>()}; | |||
3281 | if (auto *proc{details.CheckSpecific()}) { | |||
3282 | auto msg{ | |||
3283 | "'%s' should not be the name of both a generic interface and a" | |||
3284 | " procedure unless it is a specific procedure of the generic"_warn_en_US}; | |||
3285 | if (proc->name().begin() > generic.name().begin()) { | |||
3286 | Say(proc->name(), std::move(msg)); | |||
3287 | } else { | |||
3288 | Say(generic.name(), std::move(msg)); | |||
3289 | } | |||
3290 | } | |||
3291 | auto &specifics{details.specificProcs()}; | |||
3292 | if (specifics.empty()) { | |||
3293 | if (details.derivedType()) { | |||
3294 | generic.set(Symbol::Flag::Function); | |||
3295 | } | |||
3296 | return; | |||
3297 | } | |||
3298 | const Symbol &firstSpecific{specifics.front()}; | |||
3299 | bool isFunction{firstSpecific.test(Symbol::Flag::Function)}; | |||
3300 | bool isBoth{false}; | |||
3301 | for (const Symbol &specific : specifics) { | |||
3302 | if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514 | |||
3303 | auto &msg{Say(generic.name(), | |||
3304 | "Generic interface '%s' has both a function and a subroutine"_warn_en_US)}; | |||
3305 | if (isFunction) { | |||
3306 | msg.Attach(firstSpecific.name(), "Function declaration"_en_US); | |||
3307 | msg.Attach(specific.name(), "Subroutine declaration"_en_US); | |||
3308 | } else { | |||
3309 | msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US); | |||
3310 | msg.Attach(specific.name(), "Function declaration"_en_US); | |||
3311 | } | |||
3312 | isFunction = false; | |||
3313 | isBoth = true; | |||
3314 | break; | |||
3315 | } | |||
3316 | } | |||
3317 | if (!isFunction && details.derivedType()) { | |||
3318 | SayDerivedType(generic.name(), | |||
3319 | "Generic interface '%s' may only contain functions due to derived type" | |||
3320 | " with same name"_err_en_US, | |||
3321 | *details.derivedType()->GetUltimate().scope()); | |||
3322 | } | |||
3323 | if (!isBoth) { | |||
3324 | generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine); | |||
3325 | } | |||
3326 | } | |||
3327 | ||||
3328 | // SubprogramVisitor implementation | |||
3329 | ||||
3330 | // Return false if it is actually an assignment statement. | |||
3331 | bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) { | |||
3332 | const auto &name{std::get<parser::Name>(x.t)}; | |||
3333 | const DeclTypeSpec *resultType{nullptr}; | |||
3334 | // Look up name: provides return type or tells us if it's an array | |||
3335 | if (auto *symbol{FindSymbol(name)}) { | |||
3336 | auto *details{symbol->detailsIf<EntityDetails>()}; | |||
3337 | if (!details || symbol->has<ObjectEntityDetails>() || | |||
3338 | symbol->has<ProcEntityDetails>()) { | |||
3339 | badStmtFuncFound_ = true; | |||
3340 | return false; | |||
3341 | } | |||
3342 | // TODO: check that attrs are compatible with stmt func | |||
3343 | resultType = details->type(); | |||
3344 | symbol->details() = UnknownDetails{}; // will be replaced below | |||
3345 | } | |||
3346 | if (badStmtFuncFound_) { | |||
3347 | Say(name, "'%s' has not been declared as an array"_err_en_US); | |||
3348 | return false; | |||
3349 | } | |||
3350 | auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)}; | |||
3351 | symbol.set(Symbol::Flag::StmtFunction); | |||
3352 | EraseSymbol(symbol); // removes symbol added by PushSubprogramScope | |||
3353 | auto &details{symbol.get<SubprogramDetails>()}; | |||
3354 | for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) { | |||
3355 | ObjectEntityDetails dummyDetails{true}; | |||
3356 | if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) { | |||
3357 | if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) { | |||
3358 | if (d->type()) { | |||
3359 | dummyDetails.set_type(*d->type()); | |||
3360 | } | |||
3361 | } | |||
3362 | } | |||
3363 | Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))}; | |||
3364 | ApplyImplicitRules(dummy); | |||
3365 | details.add_dummyArg(dummy); | |||
3366 | } | |||
3367 | ObjectEntityDetails resultDetails; | |||
3368 | if (resultType) { | |||
3369 | resultDetails.set_type(*resultType); | |||
3370 | } | |||
3371 | resultDetails.set_funcResult(true); | |||
3372 | Symbol &result{MakeSymbol(name, std::move(resultDetails))}; | |||
3373 | result.flags().set(Symbol::Flag::StmtFunction); | |||
3374 | ApplyImplicitRules(result); | |||
3375 | details.set_result(result); | |||
3376 | // The analysis of the expression that constitutes the body of the | |||
3377 | // statement function is deferred to FinishSpecificationPart() so that | |||
3378 | // all declarations and implicit typing are complete. | |||
3379 | PopScope(); | |||
3380 | return true; | |||
3381 | } | |||
3382 | ||||
3383 | bool SubprogramVisitor::Pre(const parser::Suffix &suffix) { | |||
3384 | if (suffix.resultName) { | |||
3385 | if (IsFunction(currScope())) { | |||
3386 | if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) { | |||
3387 | if (info->inFunctionStmt) { | |||
3388 | info->resultName = &suffix.resultName.value(); | |||
3389 | } else { | |||
3390 | // will check the result name in Post(EntryStmt) | |||
3391 | } | |||
3392 | } | |||
3393 | } else { | |||
3394 | Message &msg{Say(*suffix.resultName, | |||
3395 | "RESULT(%s) may appear only in a function"_err_en_US)}; | |||
3396 | if (const Symbol * subprogram{InclusiveScope().symbol()}) { | |||
3397 | msg.Attach(subprogram->name(), "Containing subprogram"_en_US); | |||
3398 | } | |||
3399 | } | |||
3400 | } | |||
3401 | // LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt, | |||
3402 | // all the way to EndSubprogram(). | |||
3403 | return false; | |||
3404 | } | |||
3405 | ||||
3406 | bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) { | |||
3407 | // Save this to process after UseStmt and ImplicitPart | |||
3408 | if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) { | |||
3409 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3409)}; | |||
3410 | if (info.parsedType) { // C1543 | |||
3411 | Say(currStmtSource().value(), | |||
3412 | "FUNCTION prefix cannot specify the type more than once"_err_en_US); | |||
3413 | return false; | |||
3414 | } else { | |||
3415 | info.parsedType = parsedType; | |||
3416 | info.source = currStmtSource(); | |||
3417 | return false; | |||
3418 | } | |||
3419 | } else { | |||
3420 | return true; | |||
3421 | } | |||
3422 | } | |||
3423 | ||||
3424 | bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) { | |||
3425 | const auto &name{std::get<parser::Name>( | |||
3426 | std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)}; | |||
3427 | return BeginSubprogram(name, Symbol::Flag::Subroutine); | |||
3428 | } | |||
3429 | void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) { | |||
3430 | const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)}; | |||
3431 | EndSubprogram(stmt.source, | |||
3432 | &std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t)); | |||
3433 | } | |||
3434 | bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) { | |||
3435 | const auto &name{std::get<parser::Name>( | |||
3436 | std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)}; | |||
3437 | return BeginSubprogram(name, Symbol::Flag::Function); | |||
3438 | } | |||
3439 | void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) { | |||
3440 | const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)}; | |||
3441 | const auto &maybeSuffix{ | |||
3442 | std::get<std::optional<parser::Suffix>>(stmt.statement.t)}; | |||
3443 | EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr); | |||
3444 | } | |||
3445 | ||||
3446 | bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) { | |||
3447 | BeginAttrs(); | |||
3448 | Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t)); | |||
3449 | Walk(std::get<parser::Name>(stmt.t)); | |||
3450 | Walk(std::get<std::list<parser::DummyArg>>(stmt.t)); | |||
3451 | // Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram. | |||
3452 | Symbol &symbol{PostSubprogramStmt()}; | |||
3453 | SubprogramDetails &details{symbol.get<SubprogramDetails>()}; | |||
3454 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3455 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3456 | CreateDummyArgument(details, *dummyName); | |||
3457 | } else { | |||
3458 | details.add_alternateReturn(); | |||
3459 | } | |||
3460 | } | |||
3461 | return false; | |||
3462 | } | |||
3463 | bool SubprogramVisitor::Pre(const parser::FunctionStmt &) { | |||
3464 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3464)}; | |||
3465 | CHECK(!info.inFunctionStmt)((!info.inFunctionStmt) || (Fortran::common::die("CHECK(" "!info.inFunctionStmt" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3465), false)); | |||
3466 | info.inFunctionStmt = true; | |||
3467 | return BeginAttrs(); | |||
3468 | } | |||
3469 | bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); } | |||
3470 | ||||
3471 | void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { | |||
3472 | const auto &name{std::get<parser::Name>(stmt.t)}; | |||
3473 | Symbol &symbol{PostSubprogramStmt()}; | |||
3474 | SubprogramDetails &details{symbol.get<SubprogramDetails>()}; | |||
3475 | for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) { | |||
3476 | CreateDummyArgument(details, dummyName); | |||
3477 | } | |||
3478 | const parser::Name *funcResultName; | |||
3479 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3479)}; | |||
3480 | CHECK(info.inFunctionStmt)((info.inFunctionStmt) || (Fortran::common::die("CHECK(" "info.inFunctionStmt" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3480), false)); | |||
3481 | info.inFunctionStmt = false; | |||
3482 | bool distinctResultName{ | |||
3483 | info.resultName && info.resultName->source != name.source}; | |||
3484 | if (distinctResultName) { | |||
3485 | // Note that RESULT is ignored if it has the same name as the function. | |||
3486 | // The symbol created by PushScope() is retained as a place-holder | |||
3487 | // for error detection. | |||
3488 | funcResultName = info.resultName; | |||
3489 | } else { | |||
3490 | EraseSymbol(name); // was added by PushScope() | |||
3491 | funcResultName = &name; | |||
3492 | } | |||
3493 | if (details.isFunction()) { | |||
3494 | CHECK(context().HasError(currScope().symbol()))((context().HasError(currScope().symbol())) || (Fortran::common ::die("CHECK(" "context().HasError(currScope().symbol())" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3494) , false)); | |||
3495 | } else { | |||
3496 | // RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY | |||
3497 | // statement. | |||
3498 | Symbol *result{nullptr}; | |||
3499 | if (distinctResultName) { | |||
3500 | if (auto iter{currScope().find(funcResultName->source)}; | |||
3501 | iter != currScope().end()) { | |||
3502 | Symbol &entryResult{*iter->second}; | |||
3503 | if (IsFunctionResult(entryResult)) { | |||
3504 | result = &entryResult; | |||
3505 | } | |||
3506 | } | |||
3507 | } | |||
3508 | if (result) { | |||
3509 | Resolve(*funcResultName, *result); | |||
3510 | } else { | |||
3511 | // add function result to function scope | |||
3512 | EntityDetails funcResultDetails; | |||
3513 | funcResultDetails.set_funcResult(true); | |||
3514 | result = &MakeSymbol(*funcResultName, std::move(funcResultDetails)); | |||
3515 | } | |||
3516 | info.resultSymbol = result; | |||
3517 | details.set_result(*result); | |||
3518 | } | |||
3519 | // C1560. | |||
3520 | if (info.resultName && !distinctResultName) { | |||
3521 | Say(info.resultName->source, | |||
3522 | "The function name should not appear in RESULT, references to '%s' " | |||
3523 | "inside the function will be considered as references to the " | |||
3524 | "result only"_warn_en_US, | |||
3525 | name.source); | |||
3526 | // RESULT name was ignored above, the only side effect from doing so will be | |||
3527 | // the inability to make recursive calls. The related parser::Name is still | |||
3528 | // resolved to the created function result symbol because every parser::Name | |||
3529 | // should be resolved to avoid internal errors. | |||
3530 | Resolve(*info.resultName, info.resultSymbol); | |||
3531 | } | |||
3532 | name.symbol = &symbol; // must not be function result symbol | |||
3533 | // Clear the RESULT() name now in case an ENTRY statement in the implicit-part | |||
3534 | // has a RESULT() suffix. | |||
3535 | info.resultName = nullptr; | |||
3536 | } | |||
3537 | ||||
3538 | Symbol &SubprogramVisitor::PostSubprogramStmt() { | |||
3539 | Symbol &symbol{*currScope().symbol()}; | |||
3540 | SetExplicitAttrs(symbol, EndAttrs()); | |||
3541 | if (symbol.attrs().test(Attr::MODULE)) { | |||
3542 | symbol.attrs().set(Attr::EXTERNAL, false); | |||
3543 | symbol.implicitAttrs().set(Attr::EXTERNAL, false); | |||
3544 | } | |||
3545 | return symbol; | |||
3546 | } | |||
3547 | ||||
3548 | void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { | |||
3549 | if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) { | |||
3550 | Walk(suffix->binding); | |||
3551 | } | |||
3552 | PostEntryStmt(stmt); | |||
3553 | EndAttrs(); | |||
3554 | } | |||
3555 | ||||
3556 | void SubprogramVisitor::CreateDummyArgument( | |||
3557 | SubprogramDetails &details, const parser::Name &name) { | |||
3558 | Symbol *dummy{FindInScope(name)}; | |||
3559 | if (dummy) { | |||
3560 | if (IsDummy(*dummy)) { | |||
3561 | if (dummy->test(Symbol::Flag::EntryDummyArgument)) { | |||
3562 | dummy->set(Symbol::Flag::EntryDummyArgument, false); | |||
3563 | } else { | |||
3564 | Say(name, | |||
3565 | "'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US, | |||
3566 | name.source); | |||
3567 | return; | |||
3568 | } | |||
3569 | } else { | |||
3570 | SayWithDecl(name, *dummy, | |||
3571 | "'%s' may not appear as a dummy argument name in this subprogram"_err_en_US); | |||
3572 | return; | |||
3573 | } | |||
3574 | } else { | |||
3575 | dummy = &MakeSymbol(name, EntityDetails{true}); | |||
3576 | } | |||
3577 | details.add_dummyArg(DEREF(dummy)Fortran::common::Deref(dummy, "flang/lib/Semantics/resolve-names.cpp" , 3577)); | |||
3578 | } | |||
3579 | ||||
3580 | void SubprogramVisitor::CreateEntry( | |||
3581 | const parser::EntryStmt &stmt, Symbol &subprogram) { | |||
3582 | const auto &entryName{std::get<parser::Name>(stmt.t)}; | |||
3583 | Scope &outer{currScope().parent()}; | |||
3584 | Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function) | |||
3585 | ? Symbol::Flag::Function | |||
3586 | : Symbol::Flag::Subroutine}; | |||
3587 | Attrs attrs; | |||
3588 | const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}; | |||
3589 | bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding && | |||
3590 | suffix->binding->v.has_value()}; | |||
3591 | if (!hasGlobalBindingName) { | |||
3592 | if (Symbol * extant{FindSymbol(outer, entryName)}) { | |||
3593 | if (!HandlePreviousCalls(entryName, *extant, subpFlag)) { | |||
3594 | if (outer.IsTopLevel()) { | |||
3595 | Say2(entryName, | |||
3596 | "'%s' is already defined as a global identifier"_err_en_US, | |||
3597 | *extant, "Previous definition of '%s'"_en_US); | |||
3598 | } else { | |||
3599 | SayAlreadyDeclared(entryName, *extant); | |||
3600 | } | |||
3601 | return; | |||
3602 | } | |||
3603 | attrs = extant->attrs(); | |||
3604 | } | |||
3605 | } | |||
3606 | bool badResultName{false}; | |||
3607 | std::optional<SourceName> distinctResultName; | |||
3608 | if (suffix && suffix->resultName && | |||
3609 | suffix->resultName->source != entryName.source) { | |||
3610 | distinctResultName = suffix->resultName->source; | |||
3611 | const parser::Name &resultName{*suffix->resultName}; | |||
3612 | if (resultName.source == subprogram.name()) { // C1574 | |||
3613 | Say2(resultName.source, | |||
3614 | "RESULT(%s) may not have the same name as the function"_err_en_US, | |||
3615 | subprogram, "Containing function"_en_US); | |||
3616 | badResultName = true; | |||
3617 | } else if (const Symbol * extant{FindSymbol(outer, resultName)}) { // C1574 | |||
3618 | if (const auto *details{extant->detailsIf<SubprogramDetails>()}) { | |||
3619 | if (details->entryScope() == &currScope()) { | |||
3620 | Say2(resultName.source, | |||
3621 | "RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US, | |||
3622 | extant->name(), "Conflicting ENTRY"_en_US); | |||
3623 | badResultName = true; | |||
3624 | } | |||
3625 | } | |||
3626 | } | |||
3627 | } | |||
3628 | if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) { | |||
3629 | attrs.set(Attr::PUBLIC); | |||
3630 | } | |||
3631 | Symbol *entrySymbol{nullptr}; | |||
3632 | if (hasGlobalBindingName) { | |||
3633 | // Hide the entry's symbol in a new anonymous global scope so | |||
3634 | // that its name doesn't clash with anything. | |||
3635 | Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})}; | |||
3636 | symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName}); | |||
3637 | Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)}; | |||
3638 | entrySymbol = &MakeSymbol(hidden, entryName.source, attrs); | |||
3639 | } else { | |||
3640 | entrySymbol = FindInScope(outer, entryName.source); | |||
3641 | if (entrySymbol) { | |||
3642 | if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) { | |||
3643 | if (auto *specific{generic->specific()}) { | |||
3644 | // Forward reference to ENTRY from a generic interface | |||
3645 | entrySymbol = specific; | |||
3646 | CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs); | |||
3647 | SetExplicitAttrs(*entrySymbol, attrs); | |||
3648 | } | |||
3649 | } | |||
3650 | } else { | |||
3651 | entrySymbol = &MakeSymbol(outer, entryName.source, attrs); | |||
3652 | } | |||
3653 | } | |||
3654 | SubprogramDetails entryDetails; | |||
3655 | entryDetails.set_entryScope(currScope()); | |||
3656 | entrySymbol->set(subpFlag); | |||
3657 | if (subpFlag == Symbol::Flag::Function) { | |||
3658 | Symbol *result{nullptr}; | |||
3659 | EntityDetails resultDetails; | |||
3660 | resultDetails.set_funcResult(true); | |||
3661 | if (distinctResultName) { | |||
3662 | if (!badResultName) { | |||
3663 | // RESULT(x) can be the same explicitly-named RESULT(x) as | |||
3664 | // the enclosing function or another ENTRY. | |||
3665 | if (auto iter{currScope().find(suffix->resultName->source)}; | |||
3666 | iter != currScope().end()) { | |||
3667 | result = &*iter->second; | |||
3668 | } | |||
3669 | if (!result) { | |||
3670 | result = &MakeSymbol( | |||
3671 | *distinctResultName, Attrs{}, std::move(resultDetails)); | |||
3672 | } | |||
3673 | Resolve(*suffix->resultName, *result); | |||
3674 | } | |||
3675 | } else { | |||
3676 | result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails)); | |||
3677 | } | |||
3678 | if (result) { | |||
3679 | entryDetails.set_result(*result); | |||
3680 | } | |||
3681 | } | |||
3682 | if (subpFlag == Symbol::Flag::Subroutine || | |||
3683 | (distinctResultName && !badResultName)) { | |||
3684 | Symbol &assoc{MakeSymbol(entryName.source)}; | |||
3685 | assoc.set_details(HostAssocDetails{*entrySymbol}); | |||
3686 | assoc.set(Symbol::Flag::Subroutine); | |||
3687 | } | |||
3688 | Resolve(entryName, *entrySymbol); | |||
3689 | std::set<SourceName> dummies; | |||
3690 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3691 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3692 | auto pair{dummies.insert(dummyName->source)}; | |||
3693 | if (!pair.second) { | |||
3694 | Say(*dummyName, | |||
3695 | "'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US, | |||
3696 | dummyName->source); | |||
3697 | continue; | |||
3698 | } | |||
3699 | Symbol *dummy{FindInScope(*dummyName)}; | |||
3700 | if (dummy) { | |||
3701 | if (!IsDummy(*dummy)) { | |||
3702 | evaluate::AttachDeclaration( | |||
3703 | Say(*dummyName, | |||
3704 | "'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US, | |||
3705 | dummyName->source), | |||
3706 | *dummy); | |||
3707 | continue; | |||
3708 | } | |||
3709 | } else { | |||
3710 | dummy = &MakeSymbol(*dummyName, EntityDetails{true}); | |||
3711 | dummy->set(Symbol::Flag::EntryDummyArgument); | |||
3712 | } | |||
3713 | entryDetails.add_dummyArg(DEREF(dummy)Fortran::common::Deref(dummy, "flang/lib/Semantics/resolve-names.cpp" , 3713)); | |||
3714 | } else if (subpFlag == Symbol::Flag::Function) { // C1573 | |||
3715 | Say(entryName, | |||
3716 | "ENTRY in a function may not have an alternate return dummy argument"_err_en_US); | |||
3717 | break; | |||
3718 | } else { | |||
3719 | entryDetails.add_alternateReturn(); | |||
3720 | } | |||
3721 | } | |||
3722 | entrySymbol->set_details(std::move(entryDetails)); | |||
3723 | } | |||
3724 | ||||
3725 | void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) { | |||
3726 | // The entry symbol should have already been created and resolved | |||
3727 | // in CreateEntry(), called by BeginSubprogram(), with one exception (below). | |||
3728 | const auto &name{std::get<parser::Name>(stmt.t)}; | |||
3729 | Scope &inclusiveScope{InclusiveScope()}; | |||
3730 | if (!name.symbol) { | |||
3731 | if (inclusiveScope.kind() != Scope::Kind::Subprogram) { | |||
3732 | Say(name.source, | |||
3733 | "ENTRY '%s' may appear only in a subroutine or function"_err_en_US, | |||
3734 | name.source); | |||
3735 | } else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) { | |||
3736 | Say(name.source, | |||
3737 | "ENTRY '%s' may not appear in a separate module procedure"_err_en_US, | |||
3738 | name.source); | |||
3739 | } else { | |||
3740 | // C1571 - entry is nested, so was not put into the program tree; error | |||
3741 | // is emitted from MiscChecker in semantics.cpp. | |||
3742 | } | |||
3743 | return; | |||
3744 | } | |||
3745 | Symbol &entrySymbol{*name.symbol}; | |||
3746 | if (context().HasError(entrySymbol)) { | |||
3747 | return; | |||
3748 | } | |||
3749 | if (!entrySymbol.has<SubprogramDetails>()) { | |||
3750 | SayAlreadyDeclared(name, entrySymbol); | |||
3751 | return; | |||
3752 | } | |||
3753 | SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()}; | |||
3754 | CHECK(entryDetails.entryScope() == &inclusiveScope)((entryDetails.entryScope() == &inclusiveScope) || (Fortran ::common::die("CHECK(" "entryDetails.entryScope() == &inclusiveScope" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3754), false)); | |||
3755 | entrySymbol.attrs() |= GetAttrs(); | |||
3756 | SetBindNameOn(entrySymbol); | |||
3757 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3758 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3759 | if (Symbol * dummy{FindInScope(*dummyName)}) { | |||
3760 | if (dummy->test(Symbol::Flag::EntryDummyArgument)) { | |||
3761 | const auto *subp{dummy->detailsIf<SubprogramDetails>()}; | |||
3762 | if (subp && subp->isInterface()) { // ok | |||
3763 | } else if (!dummy->has<EntityDetails>() && | |||
3764 | !dummy->has<ObjectEntityDetails>() && | |||
3765 | !dummy->has<ProcEntityDetails>()) { | |||
3766 | SayWithDecl(*dummyName, *dummy, | |||
3767 | "ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US); | |||
3768 | } | |||
3769 | dummy->set(Symbol::Flag::EntryDummyArgument, false); | |||
3770 | } | |||
3771 | } | |||
3772 | } | |||
3773 | } | |||
3774 | } | |||
3775 | ||||
3776 | Symbol *ScopeHandler::FindSeparateModuleProcedureInterface( | |||
3777 | const parser::Name &name) { | |||
3778 | auto *symbol{FindSymbol(name)}; | |||
3779 | if (symbol && symbol->has<SubprogramNameDetails>()) { | |||
3780 | const Scope *parent{nullptr}; | |||
3781 | if (currScope().IsSubmodule()) { | |||
3782 | parent = currScope().symbol()->get<ModuleDetails>().parent(); | |||
3783 | } | |||
3784 | symbol = parent ? FindSymbol(*parent, name) : nullptr; | |||
3785 | } | |||
3786 | if (symbol) { | |||
3787 | if (auto *generic{symbol->detailsIf<GenericDetails>()}) { | |||
3788 | symbol = generic->specific(); | |||
3789 | } | |||
3790 | } | |||
3791 | if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) { | |||
3792 | // Error recovery in case of multiple definitions | |||
3793 | symbol = const_cast<Symbol *>(defnIface); | |||
3794 | } | |||
3795 | if (!IsSeparateModuleProcedureInterface(symbol)) { | |||
3796 | Say(name, "'%s' was not declared a separate module procedure"_err_en_US); | |||
3797 | symbol = nullptr; | |||
3798 | } | |||
3799 | return symbol; | |||
3800 | } | |||
3801 | ||||
3802 | // A subprogram declared with MODULE PROCEDURE | |||
3803 | bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) { | |||
3804 | Symbol *symbol{FindSeparateModuleProcedureInterface(name)}; | |||
3805 | if (!symbol) { | |||
3806 | return false; | |||
3807 | } | |||
3808 | if (symbol->owner() == currScope() && symbol->scope()) { | |||
3809 | // This is a MODULE PROCEDURE whose interface appears in its host. | |||
3810 | // Convert the module procedure's interface into a subprogram. | |||
3811 | SetScope(DEREF(symbol->scope())Fortran::common::Deref(symbol->scope(), "flang/lib/Semantics/resolve-names.cpp" , 3811)); | |||
3812 | symbol->get<SubprogramDetails>().set_isInterface(false); | |||
3813 | } else { | |||
3814 | // Copy the interface into a new subprogram scope. | |||
3815 | EraseSymbol(name); | |||
3816 | Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})}; | |||
3817 | PushScope(Scope::Kind::Subprogram, &newSymbol); | |||
3818 | newSymbol.get<SubprogramDetails>().set_moduleInterface(*symbol); | |||
3819 | newSymbol.attrs() |= symbol->attrs(); | |||
3820 | newSymbol.set(symbol->test(Symbol::Flag::Subroutine) | |||
3821 | ? Symbol::Flag::Subroutine | |||
3822 | : Symbol::Flag::Function); | |||
3823 | MapSubprogramToNewSymbols(*symbol, newSymbol, currScope()); | |||
3824 | } | |||
3825 | return true; | |||
3826 | } | |||
3827 | ||||
3828 | // A subprogram or interface declared with SUBROUTINE or FUNCTION | |||
3829 | bool SubprogramVisitor::BeginSubprogram(const parser::Name &name, | |||
3830 | Symbol::Flag subpFlag, bool hasModulePrefix, | |||
3831 | const parser::LanguageBindingSpec *bindingSpec, | |||
3832 | const ProgramTree::EntryStmtList *entryStmts) { | |||
3833 | if (hasModulePrefix && currScope().IsGlobal()) { // C1547 | |||
3834 | Say(name, | |||
3835 | "'%s' is a MODULE procedure which must be declared within a " | |||
3836 | "MODULE or SUBMODULE"_err_en_US); | |||
3837 | return false; | |||
3838 | } | |||
3839 | Symbol *moduleInterface{nullptr}; | |||
3840 | if (hasModulePrefix && !inInterfaceBlock()) { | |||
3841 | moduleInterface = FindSeparateModuleProcedureInterface(name); | |||
3842 | if (moduleInterface && &moduleInterface->owner() == &currScope()) { | |||
3843 | // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface | |||
3844 | // previously defined in the same scope. | |||
3845 | EraseSymbol(name); | |||
3846 | } | |||
3847 | } | |||
3848 | Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)}; | |||
3849 | if (moduleInterface) { | |||
3850 | newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface); | |||
3851 | if (moduleInterface->attrs().test(Attr::PRIVATE)) { | |||
3852 | SetImplicitAttr(newSymbol, Attr::PRIVATE); | |||
3853 | } else if (moduleInterface->attrs().test(Attr::PUBLIC)) { | |||
3854 | SetImplicitAttr(newSymbol, Attr::PUBLIC); | |||
3855 | } | |||
3856 | } | |||
3857 | if (entryStmts) { | |||
3858 | for (const auto &ref : *entryStmts) { | |||
3859 | CreateEntry(*ref, newSymbol); | |||
3860 | } | |||
3861 | } | |||
3862 | return true; | |||
3863 | } | |||
3864 | ||||
3865 | void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol, | |||
3866 | std::optional<parser::CharBlock> stmtSource, | |||
3867 | const std::optional<parser::LanguageBindingSpec> *binding) { | |||
3868 | if (binding && *binding && symbol) { | |||
3869 | // Finally process the BIND(C,NAME=name) now that symbols in the name | |||
3870 | // expression will resolve to local names if needed. | |||
3871 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)}; | |||
3872 | auto originalStmtSource{messageHandler().currStmtSource()}; | |||
3873 | messageHandler().set_currStmtSource(stmtSource); | |||
3874 | BeginAttrs(); | |||
3875 | Walk(**binding); | |||
3876 | SetBindNameOn(*symbol); | |||
3877 | symbol->attrs() |= EndAttrs(); | |||
3878 | messageHandler().set_currStmtSource(originalStmtSource); | |||
3879 | } | |||
3880 | } | |||
3881 | ||||
3882 | void SubprogramVisitor::EndSubprogram( | |||
3883 | std::optional<parser::CharBlock> stmtSource, | |||
3884 | const std::optional<parser::LanguageBindingSpec> *binding, | |||
3885 | const ProgramTree::EntryStmtList *entryStmts) { | |||
3886 | HandleLanguageBinding(currScope().symbol(), stmtSource, binding); | |||
3887 | if (entryStmts) { | |||
3888 | for (const auto &ref : *entryStmts) { | |||
3889 | const parser::EntryStmt &entryStmt{*ref}; | |||
3890 | if (const auto &suffix{ | |||
3891 | std::get<std::optional<parser::Suffix>>(entryStmt.t)}) { | |||
3892 | const auto &name{std::get<parser::Name>(entryStmt.t)}; | |||
3893 | HandleLanguageBinding(name.symbol, name.source, &suffix->binding); | |||
3894 | } | |||
3895 | } | |||
3896 | } | |||
3897 | PopScope(); | |||
3898 | } | |||
3899 | ||||
3900 | bool SubprogramVisitor::HandlePreviousCalls( | |||
3901 | const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) { | |||
3902 | // If the extant symbol is a generic, check its homonymous specific | |||
3903 | // procedure instead if it has one. | |||
3904 | if (auto *generic{symbol.detailsIf<GenericDetails>()}) { | |||
3905 | return generic->specific() && | |||
3906 | HandlePreviousCalls(name, *generic->specific(), subpFlag); | |||
3907 | } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc && | |||
3908 | !proc->isDummy() && | |||
3909 | !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) { | |||
3910 | // There's a symbol created for previous calls to this subprogram or | |||
3911 | // ENTRY's name. We have to replace that symbol in situ to avoid the | |||
3912 | // obligation to rewrite symbol pointers in the parse tree. | |||
3913 | if (!symbol.test(subpFlag)) { | |||
3914 | Say2(name, | |||
3915 | subpFlag == Symbol::Flag::Function | |||
3916 | ? "'%s' was previously called as a subroutine"_err_en_US | |||
3917 | : "'%s' was previously called as a function"_err_en_US, | |||
3918 | symbol, "Previous call of '%s'"_en_US); | |||
3919 | } | |||
3920 | EntityDetails entity; | |||
3921 | if (proc->type()) { | |||
3922 | entity.set_type(*proc->type()); | |||
3923 | } | |||
3924 | symbol.details() = std::move(entity); | |||
3925 | return true; | |||
3926 | } else { | |||
3927 | return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>(); | |||
3928 | } | |||
3929 | } | |||
3930 | ||||
3931 | void SubprogramVisitor::CheckExtantProc( | |||
3932 | const parser::Name &name, Symbol::Flag subpFlag) { | |||
3933 | if (auto *prev{FindSymbol(name)}) { | |||
3934 | if (IsDummy(*prev)) { | |||
3935 | } else if (auto *entity{prev->detailsIf<EntityDetails>()}; | |||
3936 | IsPointer(*prev) && entity && !entity->type()) { | |||
3937 | // POINTER attribute set before interface | |||
3938 | } else if (inInterfaceBlock() && currScope() != prev->owner()) { | |||
3939 | // Procedures in an INTERFACE block do not resolve to symbols | |||
3940 | // in scopes between the global scope and the current scope. | |||
3941 | } else if (!HandlePreviousCalls(name, *prev, subpFlag)) { | |||
3942 | SayAlreadyDeclared(name, *prev); | |||
3943 | } | |||
3944 | } | |||
3945 | } | |||
3946 | ||||
3947 | Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name, | |||
3948 | Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) { | |||
3949 | Symbol *symbol{GetSpecificFromGeneric(name)}; | |||
3950 | if (!symbol) { | |||
3951 | if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) { | |||
3952 | // Create this new top-level subprogram with a binding label | |||
3953 | // in a new global scope, so that its symbol's name won't clash | |||
3954 | // with another symbol that has a distinct binding label. | |||
3955 | PushScope(Scope::Kind::Global, | |||
3956 | &MakeSymbol(context().GetTempName(currScope()), Attrs{}, | |||
3957 | MiscDetails{MiscDetails::Kind::ScopeName})); | |||
3958 | } | |||
3959 | CheckExtantProc(name, subpFlag); | |||
3960 | symbol = &MakeSymbol(name, SubprogramDetails{}); | |||
3961 | } | |||
3962 | symbol->ReplaceName(name.source); | |||
3963 | symbol->set(subpFlag); | |||
3964 | PushScope(Scope::Kind::Subprogram, symbol); | |||
3965 | if (subpFlag == Symbol::Flag::Function) { | |||
3966 | funcResultStack().Push(currScope()); | |||
3967 | } | |||
3968 | if (inInterfaceBlock()) { | |||
3969 | auto &details{symbol->get<SubprogramDetails>()}; | |||
3970 | details.set_isInterface(); | |||
3971 | if (isAbstract()) { | |||
3972 | SetExplicitAttr(*symbol, Attr::ABSTRACT); | |||
3973 | } else { | |||
3974 | MakeExternal(*symbol); | |||
3975 | } | |||
3976 | if (isGeneric()) { | |||
3977 | Symbol &genericSymbol{GetGenericSymbol()}; | |||
3978 | if (genericSymbol.has<GenericDetails>()) { | |||
3979 | genericSymbol.get<GenericDetails>().AddSpecificProc( | |||
3980 | *symbol, name.source); | |||
3981 | } else { | |||
3982 | CHECK(context().HasError(genericSymbol))((context().HasError(genericSymbol)) || (Fortran::common::die ("CHECK(" "context().HasError(genericSymbol)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3982), false )); | |||
3983 | } | |||
3984 | } | |||
3985 | set_inheritFromParent(false); | |||
3986 | } | |||
3987 | FindSymbol(name)->set(subpFlag); // PushScope() created symbol | |||
3988 | return *symbol; | |||
3989 | } | |||
3990 | ||||
3991 | void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) { | |||
3992 | if (auto *prev{FindSymbol(name)}) { | |||
3993 | if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) { | |||
3994 | if (prev->test(Symbol::Flag::Subroutine) || | |||
3995 | prev->test(Symbol::Flag::Function)) { | |||
3996 | Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev, | |||
3997 | "Previous call of '%s'"_en_US); | |||
3998 | } | |||
3999 | EraseSymbol(name); | |||
4000 | } | |||
4001 | } | |||
4002 | if (name.source.empty()) { | |||
4003 | // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM | |||
4004 | PushScope(Scope::Kind::BlockData, nullptr); | |||
4005 | } else { | |||
4006 | PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{})); | |||
4007 | } | |||
4008 | } | |||
4009 | ||||
4010 | // If name is a generic, return specific subprogram with the same name. | |||
4011 | Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) { | |||
4012 | // Search for the name but don't resolve it | |||
4013 | if (auto *symbol{currScope().FindSymbol(name.source)}) { | |||
4014 | if (symbol->has<SubprogramNameDetails>()) { | |||
4015 | if (inInterfaceBlock()) { | |||
4016 | // Subtle: clear any MODULE flag so that the new interface | |||
4017 | // symbol doesn't inherit it and ruin the ability to check it. | |||
4018 | symbol->attrs().reset(Attr::MODULE); | |||
4019 | } | |||
4020 | } else if (auto *details{symbol->detailsIf<GenericDetails>()}) { | |||
4021 | // found generic, want specific procedure | |||
4022 | auto *specific{details->specific()}; | |||
4023 | if (inInterfaceBlock()) { | |||
4024 | if (specific) { | |||
4025 | // Defining an interface in a generic of the same name which is | |||
4026 | // already shadowing another procedure. In some cases, the shadowed | |||
4027 | // procedure is about to be replaced. | |||
4028 | if (specific->has<SubprogramNameDetails>() && | |||
4029 | specific->attrs().test(Attr::MODULE)) { | |||
4030 | // The shadowed procedure is a separate module procedure that is | |||
4031 | // actually defined later in this (sub)module. | |||
4032 | // Define its interface now as a new symbol. | |||
4033 | specific = nullptr; | |||
4034 | } else if (&specific->owner() != &symbol->owner()) { | |||
4035 | // The shadowed procedure was from an enclosing scope and will be | |||
4036 | // overridden by this interface definition. | |||
4037 | specific = nullptr; | |||
4038 | } | |||
4039 | if (!specific) { | |||
4040 | details->clear_specific(); | |||
4041 | } | |||
4042 | } else if (const auto *dType{details->derivedType()}) { | |||
4043 | if (&dType->owner() != &symbol->owner()) { | |||
4044 | // The shadowed derived type was from an enclosing scope and | |||
4045 | // will be overridden by this interface definition. | |||
4046 | details->clear_derivedType(); | |||
4047 | } | |||
4048 | } | |||
4049 | } | |||
4050 | if (!specific) { | |||
4051 | specific = | |||
4052 | &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{}); | |||
4053 | if (details->derivedType()) { | |||
4054 | // A specific procedure with the same name as a derived type | |||
4055 | SayAlreadyDeclared(name, *details->derivedType()); | |||
4056 | } else { | |||
4057 | details->set_specific(Resolve(name, *specific)); | |||
4058 | } | |||
4059 | } else if (isGeneric()) { | |||
4060 | SayAlreadyDeclared(name, *specific); | |||
4061 | } | |||
4062 | if (specific->has<SubprogramNameDetails>()) { | |||
4063 | specific->set_details(Details{SubprogramDetails{}}); | |||
4064 | } | |||
4065 | return specific; | |||
4066 | } | |||
4067 | } | |||
4068 | return nullptr; | |||
4069 | } | |||
4070 | ||||
4071 | // DeclarationVisitor implementation | |||
4072 | ||||
4073 | bool DeclarationVisitor::BeginDecl() { | |||
4074 | BeginDeclTypeSpec(); | |||
4075 | BeginArraySpec(); | |||
4076 | return BeginAttrs(); | |||
4077 | } | |||
4078 | void DeclarationVisitor::EndDecl() { | |||
4079 | EndDeclTypeSpec(); | |||
4080 | EndArraySpec(); | |||
4081 | EndAttrs(); | |||
4082 | } | |||
4083 | ||||
4084 | bool DeclarationVisitor::CheckUseError(const parser::Name &name) { | |||
4085 | const auto *details{ | |||
4086 | name.symbol ? name.symbol->detailsIf<UseErrorDetails>() : nullptr}; | |||
4087 | if (!details) { | |||
4088 | return false; | |||
4089 | } | |||
4090 | Message &msg{Say(name, "Reference to '%s' is ambiguous"_err_en_US)}; | |||
4091 | for (const auto &[location, module] : details->occurrences()) { | |||
4092 | msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, | |||
4093 | name.source, module->GetName().value()); | |||
4094 | } | |||
4095 | context().SetError(*name.symbol); | |||
4096 | return true; | |||
4097 | } | |||
4098 | ||||
4099 | // Report error if accessibility of symbol doesn't match isPrivate. | |||
4100 | void DeclarationVisitor::CheckAccessibility( | |||
4101 | const SourceName &name, bool isPrivate, Symbol &symbol) { | |||
4102 | if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) { | |||
4103 | Say2(name, | |||
4104 | "'%s' does not have the same accessibility as its previous declaration"_err_en_US, | |||
4105 | symbol, "Previous declaration of '%s'"_en_US); | |||
4106 | } | |||
4107 | } | |||
4108 | ||||
4109 | void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) { | |||
4110 | EndDecl(); | |||
4111 | } | |||
4112 | ||||
4113 | void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) { | |||
4114 | DeclareObjectEntity(std::get<parser::Name>(x.t)); | |||
4115 | } | |||
4116 | void DeclarationVisitor::Post(const parser::CodimensionDecl &x) { | |||
4117 | DeclareObjectEntity(std::get<parser::Name>(x.t)); | |||
4118 | } | |||
4119 | ||||
4120 | bool DeclarationVisitor::Pre(const parser::Initialization &) { | |||
4121 | // Defer inspection of initializers to Initialization() so that the | |||
4122 | // symbol being initialized will be available within the initialization | |||
4123 | // expression. | |||
4124 | return false; | |||
4125 | } | |||
4126 | ||||
4127 | void DeclarationVisitor::Post(const parser::EntityDecl &x) { | |||
4128 | const auto &name{std::get<parser::ObjectName>(x.t)}; | |||
4129 | Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}}; | |||
4130 | Symbol &symbol{DeclareUnknownEntity(name, attrs)}; | |||
4131 | symbol.ReplaceName(name.source); | |||
4132 | if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { | |||
4133 | ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol); | |||
4134 | symbol.set( | |||
4135 | Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors | |||
4136 | Initialization(name, *init, false); | |||
4137 | } else if (attrs.test(Attr::PARAMETER)) { // C882, C883 | |||
4138 | Say(name, "Missing initialization for parameter '%s'"_err_en_US); | |||
4139 | } | |||
4140 | } | |||
4141 | ||||
4142 | void DeclarationVisitor::Post(const parser::PointerDecl &x) { | |||
4143 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4144 | if (const auto &deferredShapeSpecs{ | |||
4145 | std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) { | |||
4146 | CHECK(arraySpec().empty())((arraySpec().empty()) || (Fortran::common::die("CHECK(" "arraySpec().empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4146), false)); | |||
4147 | BeginArraySpec(); | |||
4148 | set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs)); | |||
4149 | Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})}; | |||
4150 | symbol.ReplaceName(name.source); | |||
4151 | EndArraySpec(); | |||
4152 | } else { | |||
4153 | if (const auto *symbol{FindInScope(name)}) { | |||
4154 | const auto *subp{symbol->detailsIf<SubprogramDetails>()}; | |||
4155 | if (!symbol->has<UseDetails>() && // error caught elsewhere | |||
4156 | !symbol->has<ObjectEntityDetails>() && | |||
4157 | !symbol->has<ProcEntityDetails>() && | |||
4158 | !symbol->CanReplaceDetails(ObjectEntityDetails{}) && | |||
4159 | !symbol->CanReplaceDetails(ProcEntityDetails{}) && | |||
4160 | !(subp && subp->isInterface())) { | |||
4161 | Say(name, "'%s' cannot have the POINTER attribute"_err_en_US); | |||
4162 | } | |||
4163 | } | |||
4164 | HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t)); | |||
4165 | } | |||
4166 | } | |||
4167 | ||||
4168 | bool DeclarationVisitor::Pre(const parser::BindEntity &x) { | |||
4169 | auto kind{std::get<parser::BindEntity::Kind>(x.t)}; | |||
4170 | auto &name{std::get<parser::Name>(x.t)}; | |||
4171 | Symbol *symbol; | |||
4172 | if (kind == parser::BindEntity::Kind::Object) { | |||
4173 | symbol = &HandleAttributeStmt(Attr::BIND_C, name); | |||
4174 | } else { | |||
4175 | symbol = &MakeCommonBlockSymbol(name); | |||
4176 | SetExplicitAttr(*symbol, Attr::BIND_C); | |||
4177 | } | |||
4178 | // 8.6.4(1) | |||
4179 | // Some entities such as named constant or module name need to checked | |||
4180 | // elsewhere. This is to skip the ICE caused by setting Bind name for non-name | |||
4181 | // things such as data type and also checks for procedures. | |||
4182 | if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() || | |||
4183 | symbol->has<EntityDetails>()) { | |||
4184 | SetBindNameOn(*symbol); | |||
4185 | } else { | |||
4186 | Say(name, | |||
4187 | "Only variable and named common block can be in BIND statement"_err_en_US); | |||
4188 | } | |||
4189 | return false; | |||
4190 | } | |||
4191 | bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) { | |||
4192 | inOldStyleParameterStmt_ = true; | |||
4193 | Walk(x.v); | |||
4194 | inOldStyleParameterStmt_ = false; | |||
4195 | return false; | |||
4196 | } | |||
4197 | bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { | |||
4198 | auto &name{std::get<parser::NamedConstant>(x.t).v}; | |||
4199 | auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)}; | |||
4200 | if (!ConvertToObjectEntity(symbol) || | |||
4201 | symbol.test(Symbol::Flag::CrayPointer) || | |||
4202 | symbol.test(Symbol::Flag::CrayPointee)) { | |||
4203 | SayWithDecl( | |||
4204 | name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US); | |||
4205 | return false; | |||
4206 | } | |||
4207 | const auto &expr{std::get<parser::ConstantExpr>(x.t)}; | |||
4208 | auto &details{symbol.get<ObjectEntityDetails>()}; | |||
4209 | if (inOldStyleParameterStmt_) { | |||
4210 | // non-standard extension PARAMETER statement (no parentheses) | |||
4211 | Walk(expr); | |||
4212 | auto folded{EvaluateExpr(expr)}; | |||
4213 | if (details.type()) { | |||
4214 | SayWithDecl(name, symbol, | |||
4215 | "Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US); | |||
4216 | } else if (folded) { | |||
4217 | auto at{expr.thing.value().source}; | |||
4218 | if (evaluate::IsActuallyConstant(*folded)) { | |||
4219 | if (const auto *type{currScope().GetType(*folded)}) { | |||
4220 | if (type->IsPolymorphic()) { | |||
4221 | Say(at, "The expression must not be polymorphic"_err_en_US); | |||
4222 | } else if (auto shape{ToArraySpec( | |||
4223 | GetFoldingContext(), evaluate::GetShape(*folded))}) { | |||
4224 | // The type of the named constant is assumed from the expression. | |||
4225 | details.set_type(*type); | |||
4226 | details.set_init(std::move(*folded)); | |||
4227 | details.set_shape(std::move(*shape)); | |||
4228 | } else { | |||
4229 | Say(at, "The expression must have constant shape"_err_en_US); | |||
4230 | } | |||
4231 | } else { | |||
4232 | Say(at, "The expression must have a known type"_err_en_US); | |||
4233 | } | |||
4234 | } else { | |||
4235 | Say(at, "The expression must be a constant of known type"_err_en_US); | |||
4236 | } | |||
4237 | } | |||
4238 | } else { | |||
4239 | // standard-conforming PARAMETER statement (with parentheses) | |||
4240 | ApplyImplicitRules(symbol); | |||
4241 | Walk(expr); | |||
4242 | if (auto converted{EvaluateNonPointerInitializer( | |||
4243 | symbol, expr, expr.thing.value().source)}) { | |||
4244 | details.set_init(std::move(*converted)); | |||
4245 | } | |||
4246 | } | |||
4247 | return false; | |||
4248 | } | |||
4249 | bool DeclarationVisitor::Pre(const parser::NamedConstant &x) { | |||
4250 | const parser::Name &name{x.v}; | |||
4251 | if (!FindSymbol(name)) { | |||
4252 | Say(name, "Named constant '%s' not found"_err_en_US); | |||
4253 | } else { | |||
4254 | CheckUseError(name); | |||
4255 | } | |||
4256 | return false; | |||
4257 | } | |||
4258 | ||||
4259 | bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) { | |||
4260 | const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v}; | |||
4261 | Symbol *symbol{FindInScope(name)}; | |||
4262 | if (symbol && !symbol->has<UnknownDetails>()) { | |||
4263 | // Contrary to named constants appearing in a PARAMETER statement, | |||
4264 | // enumerator names should not have their type, dimension or any other | |||
4265 | // attributes defined before they are declared in the enumerator statement, | |||
4266 | // with the exception of accessibility. | |||
4267 | // This is not explicitly forbidden by the standard, but they are scalars | |||
4268 | // which type is left for the compiler to chose, so do not let users try to | |||
4269 | // tamper with that. | |||
4270 | SayAlreadyDeclared(name, *symbol); | |||
4271 | symbol = nullptr; | |||
4272 | } else { | |||
4273 | // Enumerators are treated as PARAMETER (section 7.6 paragraph (4)) | |||
4274 | symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{}); | |||
4275 | symbol->SetType(context().MakeNumericType( | |||
4276 | TypeCategory::Integer, evaluate::CInteger::kind)); | |||
4277 | } | |||
4278 | ||||
4279 | if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>( | |||
4280 | enumerator.t)}) { | |||
4281 | Walk(*init); // Resolve names in expression before evaluation. | |||
4282 | if (auto value{EvaluateInt64(context(), *init)}) { | |||
4283 | // Cast all init expressions to C_INT so that they can then be | |||
4284 | // safely incremented (see 7.6 Note 2). | |||
4285 | enumerationState_.value = static_cast<int>(*value); | |||
4286 | } else { | |||
4287 | Say(name, | |||
4288 | "Enumerator value could not be computed " | |||
4289 | "from the given expression"_err_en_US); | |||
4290 | // Prevent resolution of next enumerators value | |||
4291 | enumerationState_.value = std::nullopt; | |||
4292 | } | |||
4293 | } | |||
4294 | ||||
4295 | if (symbol) { | |||
4296 | if (enumerationState_.value) { | |||
4297 | symbol->get<ObjectEntityDetails>().set_init(SomeExpr{ | |||
4298 | evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}}); | |||
4299 | } else { | |||
4300 | context().SetError(*symbol); | |||
4301 | } | |||
4302 | } | |||
4303 | ||||
4304 | if (enumerationState_.value) { | |||
4305 | (*enumerationState_.value)++; | |||
4306 | } | |||
4307 | return false; | |||
4308 | } | |||
4309 | ||||
4310 | void DeclarationVisitor::Post(const parser::EnumDef &) { | |||
4311 | enumerationState_ = EnumeratorState{}; | |||
4312 | } | |||
4313 | ||||
4314 | bool DeclarationVisitor::Pre(const parser::AccessSpec &x) { | |||
4315 | Attr attr{AccessSpecToAttr(x)}; | |||
4316 | if (!NonDerivedTypeScope().IsModule()) { // C817 | |||
4317 | Say(currStmtSource().value(), | |||
4318 | "%s attribute may only appear in the specification part of a module"_err_en_US, | |||
4319 | EnumToString(attr)); | |||
4320 | } | |||
4321 | CheckAndSet(attr); | |||
4322 | return false; | |||
4323 | } | |||
4324 | ||||
4325 | bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) { | |||
4326 | return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v); | |||
4327 | } | |||
4328 | bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) { | |||
4329 | return HandleAttributeStmt(Attr::CONTIGUOUS, x.v); | |||
4330 | } | |||
4331 | bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) { | |||
4332 | HandleAttributeStmt(Attr::EXTERNAL, x.v); | |||
4333 | for (const auto &name : x.v) { | |||
4334 | auto *symbol{FindSymbol(name)}; | |||
4335 | if (!ConvertToProcEntity(DEREF(symbol)Fortran::common::Deref(symbol, "flang/lib/Semantics/resolve-names.cpp" , 4335))) { | |||
4336 | SayWithDecl( | |||
4337 | name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US); | |||
4338 | } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840 | |||
4339 | Say(symbol->name(), | |||
4340 | "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US, | |||
4341 | symbol->name()); | |||
4342 | } | |||
4343 | } | |||
4344 | return false; | |||
4345 | } | |||
4346 | bool DeclarationVisitor::Pre(const parser::IntentStmt &x) { | |||
4347 | auto &intentSpec{std::get<parser::IntentSpec>(x.t)}; | |||
4348 | auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
4349 | return CheckNotInBlock("INTENT") && // C1107 | |||
4350 | HandleAttributeStmt(IntentSpecToAttr(intentSpec), names); | |||
4351 | } | |||
4352 | bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) { | |||
4353 | HandleAttributeStmt(Attr::INTRINSIC, x.v); | |||
4354 | for (const auto &name : x.v) { | |||
4355 | if (!IsIntrinsic(name.source, std::nullopt)) { | |||
4356 | Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US); | |||
4357 | } | |||
4358 | auto &symbol{DEREF(FindSymbol(name))Fortran::common::Deref(FindSymbol(name), "flang/lib/Semantics/resolve-names.cpp" , 4358)}; | |||
4359 | if (symbol.has<GenericDetails>()) { | |||
4360 | // Generic interface is extending intrinsic; ok | |||
4361 | } else if (!ConvertToProcEntity(symbol)) { | |||
4362 | SayWithDecl( | |||
4363 | name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US); | |||
4364 | } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840 | |||
4365 | Say(symbol.name(), | |||
4366 | "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, | |||
4367 | symbol.name()); | |||
4368 | } else if (symbol.GetType()) { | |||
4369 | // These warnings are worded so that they should make sense in either | |||
4370 | // order. | |||
4371 | Say(symbol.name(), | |||
4372 | "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US, | |||
4373 | symbol.name()) | |||
4374 | .Attach(name.source, | |||
4375 | "INTRINSIC statement for explicitly-typed '%s'"_en_US, | |||
4376 | name.source); | |||
4377 | } | |||
4378 | } | |||
4379 | return false; | |||
4380 | } | |||
4381 | bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) { | |||
4382 | return CheckNotInBlock("OPTIONAL") && // C1107 | |||
4383 | HandleAttributeStmt(Attr::OPTIONAL, x.v); | |||
4384 | } | |||
4385 | bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) { | |||
4386 | return HandleAttributeStmt(Attr::PROTECTED, x.v); | |||
4387 | } | |||
4388 | bool DeclarationVisitor::Pre(const parser::ValueStmt &x) { | |||
4389 | return CheckNotInBlock("VALUE") && // C1107 | |||
4390 | HandleAttributeStmt(Attr::VALUE, x.v); | |||
4391 | } | |||
4392 | bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) { | |||
4393 | return HandleAttributeStmt(Attr::VOLATILE, x.v); | |||
4394 | } | |||
4395 | // Handle a statement that sets an attribute on a list of names. | |||
4396 | bool DeclarationVisitor::HandleAttributeStmt( | |||
4397 | Attr attr, const std::list<parser::Name> &names) { | |||
4398 | for (const auto &name : names) { | |||
4399 | HandleAttributeStmt(attr, name); | |||
4400 | } | |||
4401 | return false; | |||
4402 | } | |||
4403 | Symbol &DeclarationVisitor::HandleAttributeStmt( | |||
4404 | Attr attr, const parser::Name &name) { | |||
4405 | auto *symbol{FindInScope(name)}; | |||
4406 | if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) { | |||
4407 | // these can be set on a symbol that is host-assoc or use-assoc | |||
4408 | if (!symbol && | |||
4409 | (currScope().kind() == Scope::Kind::Subprogram || | |||
4410 | currScope().kind() == Scope::Kind::BlockConstruct)) { | |||
4411 | if (auto *hostSymbol{FindSymbol(name)}) { | |||
4412 | symbol = &MakeHostAssocSymbol(name, *hostSymbol); | |||
4413 | } | |||
4414 | } | |||
4415 | } else if (symbol && symbol->has<UseDetails>()) { | |||
4416 | Say(currStmtSource().value(), | |||
4417 | "Cannot change %s attribute on use-associated '%s'"_err_en_US, | |||
4418 | EnumToString(attr), name.source); | |||
4419 | return *symbol; | |||
4420 | } | |||
4421 | if (!symbol) { | |||
4422 | symbol = &MakeSymbol(name, EntityDetails{}); | |||
4423 | } | |||
4424 | if (CheckDuplicatedAttr(name.source, *symbol, attr)) { | |||
4425 | SetExplicitAttr(*symbol, attr); | |||
4426 | symbol->attrs() = HandleSaveName(name.source, symbol->attrs()); | |||
4427 | } | |||
4428 | return *symbol; | |||
4429 | } | |||
4430 | // C1107 | |||
4431 | bool DeclarationVisitor::CheckNotInBlock(const char *stmt) { | |||
4432 | if (currScope().kind() == Scope::Kind::BlockConstruct) { | |||
4433 | Say(MessageFormattedText{ | |||
4434 | "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt}); | |||
4435 | return false; | |||
4436 | } else { | |||
4437 | return true; | |||
4438 | } | |||
4439 | } | |||
4440 | ||||
4441 | void DeclarationVisitor::Post(const parser::ObjectDecl &x) { | |||
4442 | CHECK(objectDeclAttr_)((objectDeclAttr_) || (Fortran::common::die("CHECK(" "objectDeclAttr_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4442), false)); | |||
4443 | const auto &name{std::get<parser::ObjectName>(x.t)}; | |||
4444 | DeclareObjectEntity(name, Attrs{*objectDeclAttr_}); | |||
4445 | } | |||
4446 | ||||
4447 | // Declare an entity not yet known to be an object or proc. | |||
4448 | Symbol &DeclarationVisitor::DeclareUnknownEntity( | |||
4449 | const parser::Name &name, Attrs attrs) { | |||
4450 | if (!arraySpec().empty() || !coarraySpec().empty()) { | |||
4451 | return DeclareObjectEntity(name, attrs); | |||
4452 | } else { | |||
4453 | Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)}; | |||
4454 | if (auto *type{GetDeclTypeSpec()}) { | |||
4455 | SetType(name, *type); | |||
4456 | } | |||
4457 | charInfo_.length.reset(); | |||
4458 | if (symbol.attrs().test(Attr::EXTERNAL)) { | |||
4459 | ConvertToProcEntity(symbol); | |||
4460 | } | |||
4461 | SetBindNameOn(symbol); | |||
4462 | return symbol; | |||
4463 | } | |||
4464 | } | |||
4465 | ||||
4466 | bool DeclarationVisitor::HasCycle( | |||
4467 | const Symbol &procSymbol, const Symbol *interface) { | |||
4468 | SourceOrderedSymbolSet procsInCycle; | |||
4469 | procsInCycle.insert(procSymbol); | |||
4470 | while (interface) { | |||
4471 | if (procsInCycle.count(*interface) > 0) { | |||
4472 | for (const auto &procInCycle : procsInCycle) { | |||
4473 | Say(procInCycle->name(), | |||
4474 | "The interface for procedure '%s' is recursively " | |||
4475 | "defined"_err_en_US, | |||
4476 | procInCycle->name()); | |||
4477 | context().SetError(*procInCycle); | |||
4478 | } | |||
4479 | return true; | |||
4480 | } else if (const auto *procDetails{ | |||
4481 | interface->detailsIf<ProcEntityDetails>()}) { | |||
4482 | procsInCycle.insert(*interface); | |||
4483 | interface = procDetails->procInterface(); | |||
4484 | } else { | |||
4485 | break; | |||
4486 | } | |||
4487 | } | |||
4488 | return false; | |||
4489 | } | |||
4490 | ||||
4491 | Symbol &DeclarationVisitor::DeclareProcEntity( | |||
4492 | const parser::Name &name, Attrs attrs, const Symbol *interface) { | |||
4493 | Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)}; | |||
4494 | if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) { | |||
4495 | if (details->IsInterfaceSet()) { | |||
4496 | SayWithDecl(name, symbol, | |||
4497 | "The interface for procedure '%s' has already been " | |||
4498 | "declared"_err_en_US); | |||
4499 | context().SetError(symbol); | |||
4500 | } else if (HasCycle(symbol, interface)) { | |||
4501 | return symbol; | |||
4502 | } else if (interface) { | |||
4503 | details->set_procInterface(*interface); | |||
4504 | if (interface->test(Symbol::Flag::Function)) { | |||
4505 | symbol.set(Symbol::Flag::Function); | |||
4506 | } else if (interface->test(Symbol::Flag::Subroutine)) { | |||
4507 | symbol.set(Symbol::Flag::Subroutine); | |||
4508 | } | |||
4509 | } else if (auto *type{GetDeclTypeSpec()}) { | |||
4510 | SetType(name, *type); | |||
4511 | symbol.set(Symbol::Flag::Function); | |||
4512 | } | |||
4513 | SetBindNameOn(symbol); | |||
4514 | SetPassNameOn(symbol); | |||
4515 | } | |||
4516 | return symbol; | |||
4517 | } | |||
4518 | ||||
4519 | Symbol &DeclarationVisitor::DeclareObjectEntity( | |||
4520 | const parser::Name &name, Attrs attrs) { | |||
4521 | Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)}; | |||
4522 | if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { | |||
4523 | if (auto *type{GetDeclTypeSpec()}) { | |||
4524 | SetType(name, *type); | |||
4525 | } | |||
4526 | if (!arraySpec().empty()) { | |||
4527 | if (details->IsArray()) { | |||
4528 | if (!context().HasError(symbol)) { | |||
4529 | Say(name, | |||
4530 | "The dimensions of '%s' have already been declared"_err_en_US); | |||
4531 | context().SetError(symbol); | |||
4532 | } | |||
4533 | } else { | |||
4534 | details->set_shape(arraySpec()); | |||
4535 | } | |||
4536 | } | |||
4537 | if (!coarraySpec().empty()) { | |||
4538 | if (details->IsCoarray()) { | |||
4539 | if (!context().HasError(symbol)) { | |||
4540 | Say(name, | |||
4541 | "The codimensions of '%s' have already been declared"_err_en_US); | |||
4542 | context().SetError(symbol); | |||
4543 | } | |||
4544 | } else { | |||
4545 | details->set_coshape(coarraySpec()); | |||
4546 | } | |||
4547 | } | |||
4548 | SetBindNameOn(symbol); | |||
4549 | } | |||
4550 | ClearArraySpec(); | |||
4551 | ClearCoarraySpec(); | |||
4552 | charInfo_.length.reset(); | |||
4553 | return symbol; | |||
4554 | } | |||
4555 | ||||
4556 | void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { | |||
4557 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); | |||
4558 | } | |||
4559 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) { | |||
4560 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); | |||
4561 | } | |||
4562 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) { | |||
4563 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind)); | |||
4564 | } | |||
4565 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) { | |||
4566 | SetDeclTypeSpec(MakeLogicalType(x.kind)); | |||
4567 | } | |||
4568 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) { | |||
4569 | if (!charInfo_.length) { | |||
4570 | charInfo_.length = ParamValue{1, common::TypeParamAttr::Len}; | |||
4571 | } | |||
4572 | if (!charInfo_.kind) { | |||
4573 | charInfo_.kind = | |||
4574 | KindExpr{context().GetDefaultKind(TypeCategory::Character)}; | |||
4575 | } | |||
4576 | SetDeclTypeSpec(currScope().MakeCharacterType( | |||
4577 | std::move(*charInfo_.length), std::move(*charInfo_.kind))); | |||
4578 | charInfo_ = {}; | |||
4579 | } | |||
4580 | void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) { | |||
4581 | charInfo_.kind = EvaluateSubscriptIntExpr(x.kind); | |||
4582 | std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)}; | |||
4583 | if (intKind && | |||
4584 | !context().targetCharacteristics().IsTypeEnabled( | |||
4585 | TypeCategory::Character, *intKind)) { // C715, C719 | |||
4586 | Say(currStmtSource().value(), | |||
4587 | "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind); | |||
4588 | charInfo_.kind = std::nullopt; // prevent further errors | |||
4589 | } | |||
4590 | if (x.length) { | |||
4591 | charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len); | |||
4592 | } | |||
4593 | } | |||
4594 | void DeclarationVisitor::Post(const parser::CharLength &x) { | |||
4595 | if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) { | |||
4596 | charInfo_.length = ParamValue{ | |||
4597 | static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len}; | |||
4598 | } else { | |||
4599 | charInfo_.length = GetParamValue( | |||
4600 | std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len); | |||
4601 | } | |||
4602 | } | |||
4603 | void DeclarationVisitor::Post(const parser::LengthSelector &x) { | |||
4604 | if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) { | |||
4605 | charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len); | |||
4606 | } | |||
4607 | } | |||
4608 | ||||
4609 | bool DeclarationVisitor::Pre(const parser::KindParam &x) { | |||
4610 | if (const auto *kind{std::get_if< | |||
4611 | parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>( | |||
4612 | &x.u)}) { | |||
4613 | const parser::Name &name{kind->thing.thing.thing}; | |||
4614 | if (!FindSymbol(name)) { | |||
4615 | Say(name, "Parameter '%s' not found"_err_en_US); | |||
4616 | } | |||
4617 | } | |||
4618 | return false; | |||
4619 | } | |||
4620 | ||||
4621 | bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) { | |||
4622 | CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived)((GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived ) || (Fortran::common::die("CHECK(" "GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4622), false)); | |||
4623 | return true; | |||
4624 | } | |||
4625 | ||||
4626 | void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) { | |||
4627 | const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)}; | |||
4628 | if (const Symbol * derivedSymbol{derivedName.symbol}) { | |||
4629 | CheckForAbstractType(*derivedSymbol); // C706 | |||
4630 | } | |||
4631 | } | |||
4632 | ||||
4633 | bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) { | |||
4634 | SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); | |||
4635 | return true; | |||
4636 | } | |||
4637 | ||||
4638 | void DeclarationVisitor::Post( | |||
4639 | const parser::DeclarationTypeSpec::Class &parsedClass) { | |||
4640 | const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)}; | |||
4641 | if (auto spec{ResolveDerivedType(typeName)}; | |||
4642 | spec && !IsExtensibleType(&*spec)) { // C705 | |||
4643 | SayWithDecl(typeName, *typeName.symbol, | |||
4644 | "Non-extensible derived type '%s' may not be used with CLASS" | |||
4645 | " keyword"_err_en_US); | |||
4646 | } | |||
4647 | } | |||
4648 | ||||
4649 | void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { | |||
4650 | const auto &typeName{std::get<parser::Name>(x.t)}; | |||
4651 | auto spec{ResolveDerivedType(typeName)}; | |||
4652 | if (!spec) { | |||
4653 | return; | |||
4654 | } | |||
4655 | bool seenAnyName{false}; | |||
4656 | for (const auto &typeParamSpec : | |||
4657 | std::get<std::list<parser::TypeParamSpec>>(x.t)) { | |||
4658 | const auto &optKeyword{ | |||
4659 | std::get<std::optional<parser::Keyword>>(typeParamSpec.t)}; | |||
4660 | std::optional<SourceName> name; | |||
4661 | if (optKeyword) { | |||
4662 | seenAnyName = true; | |||
4663 | name = optKeyword->v.source; | |||
4664 | } else if (seenAnyName) { | |||
4665 | Say(typeName.source, "Type parameter value must have a name"_err_en_US); | |||
4666 | continue; | |||
4667 | } | |||
4668 | const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)}; | |||
4669 | // The expressions in a derived type specifier whose values define | |||
4670 | // non-defaulted type parameters are evaluated (folded) in the enclosing | |||
4671 | // scope. The KIND/LEN distinction is resolved later in | |||
4672 | // DerivedTypeSpec::CookParameters(). | |||
4673 | ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)}; | |||
4674 | if (!param.isExplicit() || param.GetExplicit()) { | |||
4675 | spec->AddRawParamValue( | |||
4676 | common::GetPtrFromOptional(optKeyword), std::move(param)); | |||
4677 | } | |||
4678 | } | |||
4679 | // The DerivedTypeSpec *spec is used initially as a search key. | |||
4680 | // If it turns out to have the same name and actual parameter | |||
4681 | // value expressions as another DerivedTypeSpec in the current | |||
4682 | // scope does, then we'll use that extant spec; otherwise, when this | |||
4683 | // spec is distinct from all derived types previously instantiated | |||
4684 | // in the current scope, this spec will be moved into that collection. | |||
4685 | const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()}; | |||
4686 | auto category{GetDeclTypeSpecCategory()}; | |||
4687 | if (dtDetails.isForwardReferenced()) { | |||
4688 | DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; | |||
4689 | SetDeclTypeSpec(type); | |||
4690 | return; | |||
4691 | } | |||
4692 | // Normalize parameters to produce a better search key. | |||
4693 | spec->CookParameters(GetFoldingContext()); | |||
4694 | if (!spec->MightBeParameterized()) { | |||
4695 | spec->EvaluateParameters(context()); | |||
4696 | } | |||
4697 | if (const DeclTypeSpec * | |||
4698 | extant{currScope().FindInstantiatedDerivedType(*spec, category)}) { | |||
4699 | // This derived type and parameter expressions (if any) are already present | |||
4700 | // in this scope. | |||
4701 | SetDeclTypeSpec(*extant); | |||
4702 | } else { | |||
4703 | DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; | |||
4704 | DerivedTypeSpec &derived{type.derivedTypeSpec()}; | |||
4705 | if (derived.MightBeParameterized() && | |||
4706 | currScope().IsParameterizedDerivedType()) { | |||
4707 | // Defer instantiation; use the derived type's definition's scope. | |||
4708 | derived.set_scope(DEREF(spec->typeSymbol().scope())Fortran::common::Deref(spec->typeSymbol().scope(), "flang/lib/Semantics/resolve-names.cpp" , 4708)); | |||
4709 | } else if (&currScope() == spec->typeSymbol().scope()) { | |||
4710 | // Direct recursive use of a type in the definition of one of its | |||
4711 | // components: defer instantiation | |||
4712 | } else { | |||
4713 | auto restorer{ | |||
4714 | GetFoldingContext().messages().SetLocation(currStmtSource().value())}; | |||
4715 | derived.Instantiate(currScope()); | |||
4716 | } | |||
4717 | SetDeclTypeSpec(type); | |||
4718 | } | |||
4719 | // Capture the DerivedTypeSpec in the parse tree for use in building | |||
4720 | // structure constructor expressions. | |||
4721 | x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec(); | |||
4722 | } | |||
4723 | ||||
4724 | void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) { | |||
4725 | const auto &typeName{rec.v}; | |||
4726 | if (auto spec{ResolveDerivedType(typeName)}) { | |||
4727 | spec->CookParameters(GetFoldingContext()); | |||
4728 | spec->EvaluateParameters(context()); | |||
4729 | if (const DeclTypeSpec * | |||
4730 | extant{currScope().FindInstantiatedDerivedType( | |||
4731 | *spec, DeclTypeSpec::TypeDerived)}) { | |||
4732 | SetDeclTypeSpec(*extant); | |||
4733 | } else { | |||
4734 | Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US, | |||
4735 | typeName.source); | |||
4736 | } | |||
4737 | } | |||
4738 | } | |||
4739 | ||||
4740 | // The descendents of DerivedTypeDef in the parse tree are visited directly | |||
4741 | // in this Pre() routine so that recursive use of the derived type can be | |||
4742 | // supported in the components. | |||
4743 | bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { | |||
4744 | auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)}; | |||
4745 | Walk(stmt); | |||
4746 | Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t)); | |||
4747 | auto &scope{currScope()}; | |||
4748 | CHECK(scope.symbol())((scope.symbol()) || (Fortran::common::die("CHECK(" "scope.symbol()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4748), false)); | |||
4749 | CHECK(scope.symbol()->scope() == &scope)((scope.symbol()->scope() == &scope) || (Fortran::common ::die("CHECK(" "scope.symbol()->scope() == &scope" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 4749) , false)); | |||
4750 | auto &details{scope.symbol()->get<DerivedTypeDetails>()}; | |||
4751 | details.set_isForwardReferenced(false); | |||
4752 | std::set<SourceName> paramNames; | |||
4753 | for (auto ¶mName : std::get<std::list<parser::Name>>(stmt.statement.t)) { | |||
4754 | details.add_paramName(paramName.source); | |||
4755 | auto *symbol{FindInScope(scope, paramName)}; | |||
4756 | if (!symbol) { | |||
4757 | Say(paramName, | |||
4758 | "No definition found for type parameter '%s'"_err_en_US); // C742 | |||
4759 | // No symbol for a type param. Create one and mark it as containing an | |||
4760 | // error to improve subsequent semantic processing | |||
4761 | BeginAttrs(); | |||
4762 | Symbol *typeParam{MakeTypeSymbol( | |||
4763 | paramName, TypeParamDetails{common::TypeParamAttr::Len})}; | |||
4764 | context().SetError(*typeParam); | |||
4765 | EndAttrs(); | |||
4766 | } else if (!symbol->has<TypeParamDetails>()) { | |||
4767 | Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US, | |||
4768 | *symbol, "Definition of '%s'"_en_US); // C741 | |||
4769 | } | |||
4770 | if (!paramNames.insert(paramName.source).second) { | |||
4771 | Say(paramName, | |||
4772 | "Duplicate type parameter name: '%s'"_err_en_US); // C731 | |||
4773 | } | |||
4774 | } | |||
4775 | for (const auto &[name, symbol] : currScope()) { | |||
4776 | if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) { | |||
4777 | SayDerivedType(name, | |||
4778 | "'%s' is not a type parameter of this derived type"_err_en_US, | |||
4779 | currScope()); // C741 | |||
4780 | } | |||
4781 | } | |||
4782 | Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t)); | |||
4783 | const auto &componentDefs{ | |||
4784 | std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)}; | |||
4785 | Walk(componentDefs); | |||
4786 | if (derivedTypeInfo_.sequence) { | |||
4787 | details.set_sequence(true); | |||
4788 | if (componentDefs.empty()) { // C740 | |||
4789 | Say(stmt.source, | |||
4790 | "A sequence type must have at least one component"_err_en_US); | |||
4791 | } | |||
4792 | if (!details.paramNames().empty()) { // C740 | |||
4793 | Say(stmt.source, | |||
4794 | "A sequence type may not have type parameters"_err_en_US); | |||
4795 | } | |||
4796 | if (derivedTypeInfo_.extends) { // C735 | |||
4797 | Say(stmt.source, | |||
4798 | "A sequence type may not have the EXTENDS attribute"_err_en_US); | |||
4799 | } | |||
4800 | } | |||
4801 | Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t)); | |||
4802 | Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t)); | |||
4803 | derivedTypeInfo_ = {}; | |||
4804 | PopScope(); | |||
4805 | return false; | |||
4806 | } | |||
4807 | ||||
4808 | bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) { | |||
4809 | return BeginAttrs(); | |||
4810 | } | |||
4811 | void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { | |||
4812 | auto &name{std::get<parser::Name>(x.t)}; | |||
4813 | // Resolve the EXTENDS() clause before creating the derived | |||
4814 | // type's symbol to foil attempts to recursively extend a type. | |||
4815 | auto *extendsName{derivedTypeInfo_.extends}; | |||
4816 | std::optional<DerivedTypeSpec> extendsType{ | |||
4817 | ResolveExtendsType(name, extendsName)}; | |||
4818 | auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})}; | |||
4819 | symbol.ReplaceName(name.source); | |||
4820 | derivedTypeInfo_.type = &symbol; | |||
4821 | PushScope(Scope::Kind::DerivedType, &symbol); | |||
4822 | if (extendsType) { | |||
4823 | // Declare the "parent component"; private if the type is. | |||
4824 | // Any symbol stored in the EXTENDS() clause is temporarily | |||
4825 | // hidden so that a new symbol can be created for the parent | |||
4826 | // component without producing spurious errors about already | |||
4827 | // existing. | |||
4828 | const Symbol &extendsSymbol{extendsType->typeSymbol()}; | |||
4829 | auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; | |||
4830 | if (OkToAddComponent(*extendsName, &extendsSymbol)) { | |||
4831 | auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})}; | |||
4832 | comp.attrs().set( | |||
4833 | Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE)); | |||
4834 | comp.implicitAttrs().set( | |||
4835 | Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE)); | |||
4836 | comp.set(Symbol::Flag::ParentComp); | |||
4837 | DeclTypeSpec &type{currScope().MakeDerivedType( | |||
4838 | DeclTypeSpec::TypeDerived, std::move(*extendsType))}; | |||
4839 | type.derivedTypeSpec().set_scope(*extendsSymbol.scope()); | |||
4840 | comp.SetType(type); | |||
4841 | DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()}; | |||
4842 | details.add_component(comp); | |||
4843 | } | |||
4844 | } | |||
4845 | EndAttrs(); | |||
4846 | } | |||
4847 | ||||
4848 | void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) { | |||
4849 | auto *type{GetDeclTypeSpec()}; | |||
4850 | auto attr{std::get<common::TypeParamAttr>(x.t)}; | |||
4851 | for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) { | |||
4852 | auto &name{std::get<parser::Name>(decl.t)}; | |||
4853 | if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{attr})}) { | |||
4854 | SetType(name, *type); | |||
4855 | if (auto &init{ | |||
4856 | std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) { | |||
4857 | if (auto maybeExpr{EvaluateNonPointerInitializer( | |||
4858 | *symbol, *init, init->thing.thing.thing.value().source)}) { | |||
4859 | if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) { | |||
4860 | symbol->get<TypeParamDetails>().set_init(std::move(*intExpr)); | |||
4861 | } | |||
4862 | } | |||
4863 | } | |||
4864 | } | |||
4865 | } | |||
4866 | EndDecl(); | |||
4867 | } | |||
4868 | bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) { | |||
4869 | if (derivedTypeInfo_.extends) { | |||
4870 | Say(currStmtSource().value(), | |||
4871 | "Attribute 'EXTENDS' cannot be used more than once"_err_en_US); | |||
4872 | } else { | |||
4873 | derivedTypeInfo_.extends = &x.v; | |||
4874 | } | |||
4875 | return false; | |||
4876 | } | |||
4877 | ||||
4878 | bool DeclarationVisitor::Pre(const parser::PrivateStmt &) { | |||
4879 | if (!currScope().parent().IsModule()) { | |||
4880 | Say("PRIVATE is only allowed in a derived type that is" | |||
4881 | " in a module"_err_en_US); // C766 | |||
4882 | } else if (derivedTypeInfo_.sawContains) { | |||
4883 | derivedTypeInfo_.privateBindings = true; | |||
4884 | } else if (!derivedTypeInfo_.privateComps) { | |||
4885 | derivedTypeInfo_.privateComps = true; | |||
4886 | } else { | |||
4887 | Say("PRIVATE may not appear more than once in" | |||
4888 | " derived type components"_warn_en_US); // C738 | |||
4889 | } | |||
4890 | return false; | |||
4891 | } | |||
4892 | bool DeclarationVisitor::Pre(const parser::SequenceStmt &) { | |||
4893 | if (derivedTypeInfo_.sequence) { | |||
4894 | Say("SEQUENCE may not appear more than once in" | |||
4895 | " derived type components"_warn_en_US); // C738 | |||
4896 | } | |||
4897 | derivedTypeInfo_.sequence = true; | |||
4898 | return false; | |||
4899 | } | |||
4900 | void DeclarationVisitor::Post(const parser::ComponentDecl &x) { | |||
4901 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4902 | auto attrs{GetAttrs()}; | |||
4903 | if (derivedTypeInfo_.privateComps && | |||
4904 | !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
4905 | attrs.set(Attr::PRIVATE); | |||
4906 | } | |||
4907 | if (const auto *declType{GetDeclTypeSpec()}) { | |||
4908 | if (const auto *derived{declType->AsDerived()}) { | |||
4909 | if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { | |||
4910 | if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 | |||
4911 | Say("Recursive use of the derived type requires " | |||
4912 | "POINTER or ALLOCATABLE"_err_en_US); | |||
4913 | } | |||
4914 | } | |||
4915 | // TODO: This would be more appropriate in CheckDerivedType() | |||
4916 | if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 | |||
4917 | std::string ultimateName{it.BuildResultDesignatorName()}; | |||
4918 | // Strip off the leading "%" | |||
4919 | if (ultimateName.length() > 1) { | |||
4920 | ultimateName.erase(0, 1); | |||
4921 | if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { | |||
4922 | evaluate::AttachDeclaration( | |||
4923 | Say(name.source, | |||
4924 | "A component with a POINTER or ALLOCATABLE attribute may " | |||
4925 | "not " | |||
4926 | "be of a type with a coarray ultimate component (named " | |||
4927 | "'%s')"_err_en_US, | |||
4928 | ultimateName), | |||
4929 | derived->typeSymbol()); | |||
4930 | } | |||
4931 | if (!arraySpec().empty() || !coarraySpec().empty()) { | |||
4932 | evaluate::AttachDeclaration( | |||
4933 | Say(name.source, | |||
4934 | "An array or coarray component may not be of a type with a " | |||
4935 | "coarray ultimate component (named '%s')"_err_en_US, | |||
4936 | ultimateName), | |||
4937 | derived->typeSymbol()); | |||
4938 | } | |||
4939 | } | |||
4940 | } | |||
4941 | } | |||
4942 | } | |||
4943 | if (OkToAddComponent(name)) { | |||
4944 | auto &symbol{DeclareObjectEntity(name, attrs)}; | |||
4945 | if (symbol.has<ObjectEntityDetails>()) { | |||
4946 | if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { | |||
4947 | Initialization(name, *init, true); | |||
4948 | } | |||
4949 | } | |||
4950 | currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); | |||
4951 | } | |||
4952 | ClearArraySpec(); | |||
4953 | ClearCoarraySpec(); | |||
4954 | } | |||
4955 | void DeclarationVisitor::Post(const parser::FillDecl &x) { | |||
4956 | // Replace "%FILL" with a distinct generated name | |||
4957 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4958 | const_cast<SourceName &>(name.source) = context().GetTempName(currScope()); | |||
4959 | if (OkToAddComponent(name)) { | |||
4960 | auto &symbol{DeclareObjectEntity(name, GetAttrs())}; | |||
4961 | currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); | |||
4962 | } | |||
4963 | ClearArraySpec(); | |||
4964 | } | |||
4965 | bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) { | |||
4966 | CHECK(!interfaceName_)((!interfaceName_) || (Fortran::common::die("CHECK(" "!interfaceName_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4966), false)); | |||
4967 | const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)}; | |||
4968 | for (const parser::ProcAttrSpec &procAttr : procAttrSpec) { | |||
4969 | if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) { | |||
4970 | if (bindC->v.has_value()) { | |||
4971 | hasBindCName_ = true; | |||
4972 | break; | |||
4973 | } | |||
4974 | } | |||
4975 | } | |||
4976 | return BeginDecl(); | |||
4977 | } | |||
4978 | void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) { | |||
4979 | interfaceName_ = nullptr; | |||
4980 | hasBindCName_ = false; | |||
4981 | EndDecl(); | |||
4982 | } | |||
4983 | bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) { | |||
4984 | // Overrides parse tree traversal so as to handle attributes first, | |||
4985 | // so POINTER & ALLOCATABLE enable forward references to derived types. | |||
4986 | Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t)); | |||
4987 | set_allowForwardReferenceToDerivedType( | |||
4988 | GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})); | |||
4989 | Walk(std::get<parser::DeclarationTypeSpec>(x.t)); | |||
4990 | set_allowForwardReferenceToDerivedType(false); | |||
4991 | if (derivedTypeInfo_.sequence) { // C740 | |||
4992 | if (const auto *declType{GetDeclTypeSpec()}) { | |||
4993 | if (!declType->AsIntrinsic() && !declType->IsSequenceType() && | |||
4994 | !InModuleFile()) { | |||
4995 | if (GetAttrs().test(Attr::POINTER) && | |||
4996 | context().IsEnabled(common::LanguageFeature::PointerInSeqType)) { | |||
4997 | if (context().ShouldWarn(common::LanguageFeature::PointerInSeqType)) { | |||
4998 | Say("A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US); | |||
4999 | } | |||
5000 | } else { | |||
5001 | Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US); | |||
5002 | } | |||
5003 | } | |||
5004 | } | |||
5005 | } | |||
5006 | Walk(std::get<std::list<parser::ComponentOrFill>>(x.t)); | |||
5007 | return false; | |||
5008 | } | |||
5009 | bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) { | |||
5010 | CHECK(!interfaceName_)((!interfaceName_) || (Fortran::common::die("CHECK(" "!interfaceName_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5010), false)); | |||
5011 | return true; | |||
5012 | } | |||
5013 | void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) { | |||
5014 | interfaceName_ = nullptr; | |||
5015 | } | |||
5016 | bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) { | |||
5017 | if (auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5018 | return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(*name); | |||
5019 | } else { | |||
5020 | const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))Fortran::common::Deref(std::get_if<parser::NullInit>(& x.u), "flang/lib/Semantics/resolve-names.cpp", 5020)}; | |||
5021 | Walk(null); | |||
5022 | if (auto nullInit{EvaluateExpr(null)}) { | |||
5023 | if (!evaluate::IsNullPointer(*nullInit)) { | |||
5024 | Say(null.v.value().source, | |||
5025 | "Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US); | |||
5026 | } | |||
5027 | } | |||
5028 | return false; | |||
5029 | } | |||
5030 | } | |||
5031 | void DeclarationVisitor::Post(const parser::ProcInterface &x) { | |||
5032 | if (auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5033 | interfaceName_ = name; | |||
5034 | NoteInterfaceName(*name); | |||
5035 | } | |||
5036 | } | |||
5037 | void DeclarationVisitor::Post(const parser::ProcDecl &x) { | |||
5038 | const auto &name{std::get<parser::Name>(x.t)}; | |||
5039 | const Symbol *procInterface{nullptr}; | |||
5040 | if (interfaceName_) { | |||
5041 | procInterface = interfaceName_->symbol; | |||
5042 | } | |||
5043 | auto attrs{HandleSaveName(name.source, GetAttrs())}; | |||
5044 | DerivedTypeDetails *dtDetails{nullptr}; | |||
5045 | if (Symbol * symbol{currScope().symbol()}) { | |||
5046 | dtDetails = symbol->detailsIf<DerivedTypeDetails>(); | |||
5047 | } | |||
5048 | if (!dtDetails) { | |||
5049 | attrs.set(Attr::EXTERNAL); | |||
5050 | } | |||
5051 | Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)}; | |||
5052 | symbol.ReplaceName(name.source); | |||
5053 | if (dtDetails) { | |||
5054 | dtDetails->add_component(symbol); | |||
5055 | } | |||
5056 | if (hasBindCName_ && (IsPointer(symbol) || IsDummy(symbol))) { | |||
5057 | Say(symbol.name(), | |||
5058 | "BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure"_err_en_US); | |||
5059 | } | |||
5060 | } | |||
5061 | ||||
5062 | bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) { | |||
5063 | derivedTypeInfo_.sawContains = true; | |||
5064 | return true; | |||
5065 | } | |||
5066 | ||||
5067 | // Resolve binding names from type-bound generics, saved in genericBindings_. | |||
5068 | void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) { | |||
5069 | // track specifics seen for the current generic to detect duplicates: | |||
5070 | const Symbol *currGeneric{nullptr}; | |||
5071 | std::set<SourceName> specifics; | |||
5072 | for (const auto &[generic, bindingName] : genericBindings_) { | |||
5073 | if (generic != currGeneric) { | |||
5074 | currGeneric = generic; | |||
5075 | specifics.clear(); | |||
5076 | } | |||
5077 | auto [it, inserted]{specifics.insert(bindingName->source)}; | |||
5078 | if (!inserted) { | |||
5079 | Say(*bindingName, // C773 | |||
5080 | "Binding name '%s' was already specified for generic '%s'"_err_en_US, | |||
5081 | bindingName->source, generic->name()) | |||
5082 | .Attach(*it, "Previous specification of '%s'"_en_US, *it); | |||
5083 | continue; | |||
5084 | } | |||
5085 | auto *symbol{FindInTypeOrParents(*bindingName)}; | |||
5086 | if (!symbol) { | |||
5087 | Say(*bindingName, // C772 | |||
5088 | "Binding name '%s' not found in this derived type"_err_en_US); | |||
5089 | } else if (!symbol->has<ProcBindingDetails>()) { | |||
5090 | SayWithDecl(*bindingName, *symbol, // C772 | |||
5091 | "'%s' is not the name of a specific binding of this type"_err_en_US); | |||
5092 | } else { | |||
5093 | generic->get<GenericDetails>().AddSpecificProc( | |||
| ||||
5094 | *symbol, bindingName->source); | |||
5095 | } | |||
5096 | } | |||
5097 | genericBindings_.clear(); | |||
5098 | } | |||
5099 | ||||
5100 | void DeclarationVisitor::Post(const parser::ContainsStmt &) { | |||
5101 | if (derivedTypeInfo_.sequence) { | |||
5102 | Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740 | |||
5103 | } | |||
5104 | } | |||
5105 | ||||
5106 | void DeclarationVisitor::Post( | |||
5107 | const parser::TypeBoundProcedureStmt::WithoutInterface &x) { | |||
5108 | if (GetAttrs().test(Attr::DEFERRED)) { // C783 | |||
5109 | Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US); | |||
5110 | } | |||
5111 | for (auto &declaration : x.declarations) { | |||
5112 | auto &bindingName{std::get<parser::Name>(declaration.t)}; | |||
5113 | auto &optName{std::get<std::optional<parser::Name>>(declaration.t)}; | |||
5114 | const parser::Name &procedureName{optName ? *optName : bindingName}; | |||
5115 | Symbol *procedure{FindSymbol(procedureName)}; | |||
5116 | if (!procedure) { | |||
5117 | procedure = NoteInterfaceName(procedureName); | |||
5118 | } | |||
5119 | if (procedure) { | |||
5120 | if (auto *s{ | |||
5121 | MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) { | |||
5122 | SetPassNameOn(*s); | |||
5123 | if (GetAttrs().test(Attr::DEFERRED)) { | |||
5124 | context().SetError(*s); | |||
5125 | } | |||
5126 | } | |||
5127 | } | |||
5128 | } | |||
5129 | } | |||
5130 | ||||
5131 | void DeclarationVisitor::CheckBindings( | |||
5132 | const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { | |||
5133 | CHECK(currScope().IsDerivedType())((currScope().IsDerivedType()) || (Fortran::common::die("CHECK(" "currScope().IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 5133), false)); | |||
5134 | for (auto &declaration : tbps.declarations) { | |||
5135 | auto &bindingName{std::get<parser::Name>(declaration.t)}; | |||
5136 | if (Symbol * binding{FindInScope(bindingName)}) { | |||
5137 | if (auto *details{binding->detailsIf<ProcBindingDetails>()}) { | |||
5138 | const Symbol *procedure{FindSubprogram(details->symbol())}; | |||
5139 | if (!CanBeTypeBoundProc(procedure)) { | |||
5140 | if (details->symbol().name() != binding->name()) { | |||
5141 | Say(binding->name(), | |||
5142 | "The binding of '%s' ('%s') must be either an accessible " | |||
5143 | "module procedure or an external procedure with " | |||
5144 | "an explicit interface"_err_en_US, | |||
5145 | binding->name(), details->symbol().name()); | |||
5146 | } else { | |||
5147 | Say(binding->name(), | |||
5148 | "'%s' must be either an accessible module procedure " | |||
5149 | "or an external procedure with an explicit interface"_err_en_US, | |||
5150 | binding->name()); | |||
5151 | } | |||
5152 | context().SetError(*binding); | |||
5153 | } | |||
5154 | } | |||
5155 | } | |||
5156 | } | |||
5157 | } | |||
5158 | ||||
5159 | void DeclarationVisitor::Post( | |||
5160 | const parser::TypeBoundProcedureStmt::WithInterface &x) { | |||
5161 | if (!GetAttrs().test(Attr::DEFERRED)) { // C783 | |||
5162 | Say("DEFERRED is required when an interface-name is provided"_err_en_US); | |||
5163 | } | |||
5164 | if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) { | |||
5165 | for (auto &bindingName : x.bindingNames) { | |||
5166 | if (auto *s{ | |||
5167 | MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) { | |||
5168 | SetPassNameOn(*s); | |||
5169 | if (!GetAttrs().test(Attr::DEFERRED)) { | |||
5170 | context().SetError(*s); | |||
5171 | } | |||
5172 | } | |||
5173 | } | |||
5174 | } | |||
5175 | } | |||
5176 | ||||
5177 | void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) { | |||
5178 | if (currScope().IsDerivedType() && currScope().symbol()) { | |||
5179 | if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) { | |||
5180 | for (const auto &subrName : x.v) { | |||
5181 | if (const auto *name{ResolveName(subrName)}) { | |||
5182 | auto pair{ | |||
5183 | details->finals().emplace(name->source, DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 5183))}; | |||
5184 | if (!pair.second) { // C787 | |||
5185 | Say(name->source, | |||
5186 | "FINAL subroutine '%s' already appeared in this derived type"_err_en_US, | |||
5187 | name->source) | |||
5188 | .Attach(pair.first->first, | |||
5189 | "earlier appearance of this FINAL subroutine"_en_US); | |||
5190 | } | |||
5191 | } | |||
5192 | } | |||
5193 | } | |||
5194 | } | |||
5195 | } | |||
5196 | ||||
5197 | bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { | |||
5198 | const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}; | |||
5199 | const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)}; | |||
5200 | const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)}; | |||
5201 | auto info{GenericSpecInfo{genericSpec.value()}}; | |||
5202 | SourceName symbolName{info.symbolName()}; | |||
5203 | bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private | |||
5204 | : derivedTypeInfo_.privateBindings}; | |||
5205 | auto *genericSymbol{FindInScope(symbolName)}; | |||
5206 | if (genericSymbol) { | |||
5207 | if (!genericSymbol->has<GenericDetails>()) { | |||
5208 | genericSymbol = nullptr; // MakeTypeSymbol will report the error below | |||
5209 | } | |||
5210 | } else { | |||
5211 | // look in parent types: | |||
5212 | Symbol *inheritedSymbol{nullptr}; | |||
5213 | for (const auto &name : GetAllNames(context(), symbolName)) { | |||
5214 | inheritedSymbol = currScope().FindComponent(SourceName{name}); | |||
5215 | if (inheritedSymbol) { | |||
5216 | break; | |||
5217 | } | |||
5218 | } | |||
5219 | if (inheritedSymbol && inheritedSymbol->has<GenericDetails>()) { | |||
5220 | CheckAccessibility(symbolName, isPrivate, *inheritedSymbol); // C771 | |||
5221 | } | |||
5222 | } | |||
5223 | if (genericSymbol) { | |||
5224 | CheckAccessibility(symbolName, isPrivate, *genericSymbol); // C771 | |||
5225 | } else { | |||
5226 | genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{}); | |||
5227 | if (!genericSymbol) { | |||
5228 | return false; | |||
5229 | } | |||
5230 | if (isPrivate) { | |||
5231 | SetExplicitAttr(*genericSymbol, Attr::PRIVATE); | |||
5232 | } | |||
5233 | } | |||
5234 | for (const parser::Name &bindingName : bindingNames) { | |||
5235 | genericBindings_.emplace(genericSymbol, &bindingName); | |||
5236 | } | |||
5237 | info.Resolve(genericSymbol); | |||
5238 | return false; | |||
5239 | } | |||
5240 | ||||
5241 | // DEC STRUCTUREs are handled thus to allow for nested definitions. | |||
5242 | bool DeclarationVisitor::Pre(const parser::StructureDef &def) { | |||
5243 | const auto &structureStatement{ | |||
5244 | std::get<parser::Statement<parser::StructureStmt>>(def.t)}; | |||
5245 | auto saveDerivedTypeInfo{derivedTypeInfo_}; | |||
5246 | derivedTypeInfo_ = {}; | |||
5247 | derivedTypeInfo_.isStructure = true; | |||
5248 | derivedTypeInfo_.sequence = true; | |||
5249 | Scope *previousStructure{nullptr}; | |||
5250 | if (saveDerivedTypeInfo.isStructure) { | |||
5251 | previousStructure = &currScope(); | |||
5252 | PopScope(); | |||
5253 | } | |||
5254 | const parser::StructureStmt &structStmt{structureStatement.statement}; | |||
5255 | const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)}; | |||
5256 | if (!name) { | |||
5257 | // Construct a distinct generated name for an anonymous structure | |||
5258 | auto &mutableName{const_cast<std::optional<parser::Name> &>(name)}; | |||
5259 | mutableName.emplace( | |||
5260 | parser::Name{context().GetTempName(currScope()), nullptr}); | |||
5261 | } | |||
5262 | auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})}; | |||
5263 | symbol.ReplaceName(name->source); | |||
5264 | symbol.get<DerivedTypeDetails>().set_sequence(true); | |||
5265 | symbol.get<DerivedTypeDetails>().set_isDECStructure(true); | |||
5266 | derivedTypeInfo_.type = &symbol; | |||
5267 | PushScope(Scope::Kind::DerivedType, &symbol); | |||
5268 | const auto &fields{std::get<std::list<parser::StructureField>>(def.t)}; | |||
5269 | Walk(fields); | |||
5270 | PopScope(); | |||
5271 | // Complete the definition | |||
5272 | DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol}; | |||
5273 | derivedTypeSpec.set_scope(DEREF(symbol.scope())Fortran::common::Deref(symbol.scope(), "flang/lib/Semantics/resolve-names.cpp" , 5273)); | |||
5274 | derivedTypeSpec.CookParameters(GetFoldingContext()); | |||
5275 | derivedTypeSpec.EvaluateParameters(context()); | |||
5276 | DeclTypeSpec &type{currScope().MakeDerivedType( | |||
5277 | DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))}; | |||
5278 | type.derivedTypeSpec().Instantiate(currScope()); | |||
5279 | // Restore previous structure definition context, if any | |||
5280 | derivedTypeInfo_ = saveDerivedTypeInfo; | |||
5281 | if (previousStructure) { | |||
5282 | PushScope(*previousStructure); | |||
5283 | } | |||
5284 | // Handle any entity declarations on the STRUCTURE statement | |||
5285 | const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)}; | |||
5286 | if (!decls.empty()) { | |||
5287 | BeginDecl(); | |||
5288 | SetDeclTypeSpec(type); | |||
5289 | Walk(decls); | |||
5290 | EndDecl(); | |||
5291 | } | |||
5292 | return false; | |||
5293 | } | |||
5294 | ||||
5295 | bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) { | |||
5296 | Say("support for UNION"_todo_en_US); // TODO | |||
5297 | return true; | |||
5298 | } | |||
5299 | ||||
5300 | bool DeclarationVisitor::Pre(const parser::StructureField &x) { | |||
5301 | if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>( | |||
5302 | x.u)) { | |||
5303 | BeginDecl(); | |||
5304 | } | |||
5305 | return true; | |||
5306 | } | |||
5307 | ||||
5308 | void DeclarationVisitor::Post(const parser::StructureField &x) { | |||
5309 | if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>( | |||
5310 | x.u)) { | |||
5311 | EndDecl(); | |||
5312 | } | |||
5313 | } | |||
5314 | ||||
5315 | bool DeclarationVisitor::Pre(const parser::AllocateStmt &) { | |||
5316 | BeginDeclTypeSpec(); | |||
5317 | return true; | |||
5318 | } | |||
5319 | void DeclarationVisitor::Post(const parser::AllocateStmt &) { | |||
5320 | EndDeclTypeSpec(); | |||
5321 | } | |||
5322 | ||||
5323 | bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { | |||
5324 | auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)}; | |||
5325 | const DeclTypeSpec *type{ProcessTypeSpec(parsedType)}; | |||
5326 | if (!type) { | |||
5327 | return false; | |||
5328 | } | |||
5329 | const DerivedTypeSpec *spec{type->AsDerived()}; | |||
5330 | const Scope *typeScope{spec ? spec->scope() : nullptr}; | |||
5331 | if (!typeScope) { | |||
5332 | return false; | |||
5333 | } | |||
5334 | ||||
5335 | // N.B C7102 is implicitly enforced by having inaccessible types not | |||
5336 | // being found in resolution. | |||
5337 | // More constraints are enforced in expression.cpp so that they | |||
5338 | // can apply to structure constructors that have been converted | |||
5339 | // from misparsed function references. | |||
5340 | for (const auto &component : | |||
5341 | std::get<std::list<parser::ComponentSpec>>(x.t)) { | |||
5342 | // Visit the component spec expression, but not the keyword, since | |||
5343 | // we need to resolve its symbol in the scope of the derived type. | |||
5344 | Walk(std::get<parser::ComponentDataSource>(component.t)); | |||
5345 | if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) { | |||
5346 | FindInTypeOrParents(*typeScope, kw->v); | |||
5347 | } | |||
5348 | } | |||
5349 | return false; | |||
5350 | } | |||
5351 | ||||
5352 | bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) { | |||
5353 | for (const parser::BasedPointer &bp : x.v) { | |||
5354 | const parser::ObjectName &pointerName{std::get<0>(bp.t)}; | |||
5355 | const parser::ObjectName &pointeeName{std::get<1>(bp.t)}; | |||
5356 | auto *pointer{FindSymbol(pointerName)}; | |||
5357 | if (!pointer) { | |||
5358 | pointer = &MakeSymbol(pointerName, ObjectEntityDetails{}); | |||
5359 | } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) { | |||
5360 | SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US); | |||
5361 | } else if (pointer->Rank() > 0) { | |||
5362 | SayWithDecl(pointerName, *pointer, | |||
5363 | "Cray pointer '%s' must be a scalar"_err_en_US); | |||
5364 | } else if (pointer->test(Symbol::Flag::CrayPointee)) { | |||
5365 | Say(pointerName, | |||
5366 | "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US); | |||
5367 | } | |||
5368 | pointer->set(Symbol::Flag::CrayPointer); | |||
5369 | const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer, | |||
5370 | context().defaultKinds().subscriptIntegerKind())}; | |||
5371 | const auto *type{pointer->GetType()}; | |||
5372 | if (!type) { | |||
5373 | pointer->SetType(pointerType); | |||
5374 | } else if (*type != pointerType) { | |||
5375 | Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US, | |||
5376 | pointerName.source, pointerType.AsFortran()); | |||
5377 | } | |||
5378 | if (ResolveName(pointeeName)) { | |||
5379 | Symbol &pointee{*pointeeName.symbol}; | |||
5380 | if (pointee.has<UseDetails>()) { | |||
5381 | Say(pointeeName, | |||
5382 | "'%s' cannot be a Cray pointee as it is use-associated"_err_en_US); | |||
5383 | continue; | |||
5384 | } else if (!ConvertToObjectEntity(pointee) || IsNamedConstant(pointee)) { | |||
5385 | Say(pointeeName, "'%s' is not a variable"_err_en_US); | |||
5386 | continue; | |||
5387 | } else if (pointee.test(Symbol::Flag::CrayPointer)) { | |||
5388 | Say(pointeeName, | |||
5389 | "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US); | |||
5390 | } else if (pointee.test(Symbol::Flag::CrayPointee)) { | |||
5391 | Say(pointeeName, | |||
5392 | "'%s' was already declared as a Cray pointee"_err_en_US); | |||
5393 | } else { | |||
5394 | pointee.set(Symbol::Flag::CrayPointee); | |||
5395 | } | |||
5396 | if (const auto *pointeeType{pointee.GetType()}) { | |||
5397 | if (const auto *derived{pointeeType->AsDerived()}) { | |||
5398 | if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) { | |||
5399 | Say(pointeeName, | |||
5400 | "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US); | |||
5401 | } | |||
5402 | } | |||
5403 | } | |||
5404 | // process the pointee array-spec, if present | |||
5405 | BeginArraySpec(); | |||
5406 | Walk(std::get<std::optional<parser::ArraySpec>>(bp.t)); | |||
5407 | const auto &spec{arraySpec()}; | |||
5408 | if (!spec.empty()) { | |||
5409 | auto &details{pointee.get<ObjectEntityDetails>()}; | |||
5410 | if (details.shape().empty()) { | |||
5411 | details.set_shape(spec); | |||
5412 | } else { | |||
5413 | SayWithDecl(pointeeName, pointee, | |||
5414 | "Array spec was already declared for '%s'"_err_en_US); | |||
5415 | } | |||
5416 | } | |||
5417 | ClearArraySpec(); | |||
5418 | currScope().add_crayPointer(pointeeName.source, *pointer); | |||
5419 | } | |||
5420 | } | |||
5421 | return false; | |||
5422 | } | |||
5423 | ||||
5424 | bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) { | |||
5425 | if (!CheckNotInBlock("NAMELIST")) { // C1107 | |||
5426 | return false; | |||
5427 | } | |||
5428 | const auto &groupName{std::get<parser::Name>(x.t)}; | |||
5429 | auto *groupSymbol{FindInScope(groupName)}; | |||
5430 | if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) { | |||
5431 | groupSymbol = &MakeSymbol(groupName, NamelistDetails{}); | |||
5432 | groupSymbol->ReplaceName(groupName.source); | |||
5433 | } | |||
5434 | // Name resolution of group items is deferred to FinishNamelists() | |||
5435 | // so that host association is handled correctly. | |||
5436 | GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x); | |||
5437 | return false; | |||
5438 | } | |||
5439 | ||||
5440 | void DeclarationVisitor::FinishNamelists() { | |||
5441 | if (auto *deferred{GetDeferredDeclarationState()}) { | |||
5442 | for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) { | |||
5443 | if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) { | |||
5444 | if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) { | |||
5445 | for (const auto &name : std::get<std::list<parser::Name>>(group->t)) { | |||
5446 | auto *symbol{FindSymbol(name)}; | |||
5447 | if (!symbol) { | |||
5448 | symbol = &MakeSymbol(name, ObjectEntityDetails{}); | |||
5449 | ApplyImplicitRules(*symbol); | |||
5450 | } else if (!ConvertToObjectEntity(*symbol)) { | |||
5451 | SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); | |||
5452 | } | |||
5453 | symbol->GetUltimate().set(Symbol::Flag::InNamelist); | |||
5454 | details->add_object(*symbol); | |||
5455 | } | |||
5456 | } | |||
5457 | } | |||
5458 | } | |||
5459 | deferred->namelistGroups.clear(); | |||
5460 | } | |||
5461 | } | |||
5462 | ||||
5463 | bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { | |||
5464 | if (const auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5465 | auto *symbol{FindSymbol(*name)}; | |||
5466 | if (!symbol) { | |||
5467 | Say(*name, "Namelist group '%s' not found"_err_en_US); | |||
5468 | } else if (!symbol->GetUltimate().has<NamelistDetails>()) { | |||
5469 | SayWithDecl( | |||
5470 | *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US); | |||
5471 | } | |||
5472 | } | |||
5473 | return true; | |||
5474 | } | |||
5475 | ||||
5476 | bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { | |||
5477 | CheckNotInBlock("COMMON"); // C1107 | |||
5478 | return true; | |||
5479 | } | |||
5480 | ||||
5481 | bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) { | |||
5482 | BeginArraySpec(); | |||
5483 | return true; | |||
5484 | } | |||
5485 | ||||
5486 | void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { | |||
5487 | const auto &name{std::get<parser::Name>(x.t)}; | |||
5488 | DeclareObjectEntity(name); | |||
5489 | auto pair{specPartState_.commonBlockObjects.insert(name.source)}; | |||
5490 | if (!pair.second) { | |||
5491 | const SourceName &prev{*pair.first}; | |||
5492 | Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev, | |||
5493 | "Previous occurrence of '%s' in a COMMON block"_en_US); | |||
5494 | } | |||
5495 | } | |||
5496 | ||||
5497 | bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) { | |||
5498 | // save equivalence sets to be processed after specification part | |||
5499 | if (CheckNotInBlock("EQUIVALENCE")) { // C1107 | |||
5500 | for (const std::list<parser::EquivalenceObject> &set : x.v) { | |||
5501 | specPartState_.equivalenceSets.push_back(&set); | |||
5502 | } | |||
5503 | } | |||
5504 | return false; // don't implicitly declare names yet | |||
5505 | } | |||
5506 | ||||
5507 | void DeclarationVisitor::CheckEquivalenceSets() { | |||
5508 | EquivalenceSets equivSets{context()}; | |||
5509 | inEquivalenceStmt_ = true; | |||
5510 | for (const auto *set : specPartState_.equivalenceSets) { | |||
5511 | const auto &source{set->front().v.value().source}; | |||
5512 | if (set->size() <= 1) { // R871 | |||
5513 | Say(source, "Equivalence set must have more than one object"_err_en_US); | |||
5514 | } | |||
5515 | for (const parser::EquivalenceObject &object : *set) { | |||
5516 | const auto &designator{object.v.value()}; | |||
5517 | // The designator was not resolved when it was encountered so do it now. | |||
5518 | // AnalyzeExpr causes array sections to be changed to substrings as needed | |||
5519 | Walk(designator); | |||
5520 | if (AnalyzeExpr(context(), designator)) { | |||
5521 | equivSets.AddToSet(designator); | |||
5522 | } | |||
5523 | } | |||
5524 | equivSets.FinishSet(source); | |||
5525 | } | |||
5526 | inEquivalenceStmt_ = false; | |||
5527 | for (auto &set : equivSets.sets()) { | |||
5528 | if (!set.empty()) { | |||
5529 | currScope().add_equivalenceSet(std::move(set)); | |||
5530 | } | |||
5531 | } | |||
5532 | specPartState_.equivalenceSets.clear(); | |||
5533 | } | |||
5534 | ||||
5535 | bool DeclarationVisitor::Pre(const parser::SaveStmt &x) { | |||
5536 | if (x.v.empty()) { | |||
5537 | specPartState_.saveInfo.saveAll = currStmtSource(); | |||
5538 | currScope().set_hasSAVE(); | |||
5539 | } else { | |||
5540 | for (const parser::SavedEntity &y : x.v) { | |||
5541 | auto kind{std::get<parser::SavedEntity::Kind>(y.t)}; | |||
5542 | const auto &name{std::get<parser::Name>(y.t)}; | |||
5543 | if (kind == parser::SavedEntity::Kind::Common) { | |||
5544 | MakeCommonBlockSymbol(name); | |||
5545 | AddSaveName(specPartState_.saveInfo.commons, name.source); | |||
5546 | } else { | |||
5547 | HandleAttributeStmt(Attr::SAVE, name); | |||
5548 | } | |||
5549 | } | |||
5550 | } | |||
5551 | return false; | |||
5552 | } | |||
5553 | ||||
5554 | void DeclarationVisitor::CheckSaveStmts() { | |||
5555 | for (const SourceName &name : specPartState_.saveInfo.entities) { | |||
5556 | auto *symbol{FindInScope(name)}; | |||
5557 | if (!symbol) { | |||
5558 | // error was reported | |||
5559 | } else if (specPartState_.saveInfo.saveAll) { | |||
5560 | // C889 - note that pgi, ifort, xlf do not enforce this constraint | |||
5561 | Say2(name, | |||
5562 | "Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US, | |||
5563 | *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US); | |||
5564 | } else if (auto msg{CheckSaveAttr(*symbol)}) { | |||
5565 | Say(name, std::move(*msg)); | |||
5566 | context().SetError(*symbol); | |||
5567 | } else { | |||
5568 | SetSaveAttr(*symbol); | |||
5569 | } | |||
5570 | } | |||
5571 | for (const SourceName &name : specPartState_.saveInfo.commons) { | |||
5572 | if (auto *symbol{currScope().FindCommonBlock(name)}) { | |||
5573 | auto &objects{symbol->get<CommonBlockDetails>().objects()}; | |||
5574 | if (objects.empty()) { | |||
5575 | if (currScope().kind() != Scope::Kind::BlockConstruct) { | |||
5576 | Say(name, | |||
5577 | "'%s' appears as a COMMON block in a SAVE statement but not in" | |||
5578 | " a COMMON statement"_err_en_US); | |||
5579 | } else { // C1108 | |||
5580 | Say(name, | |||
5581 | "SAVE statement in BLOCK construct may not contain a" | |||
5582 | " common block name '%s'"_err_en_US); | |||
5583 | } | |||
5584 | } else { | |||
5585 | for (auto &object : symbol->get<CommonBlockDetails>().objects()) { | |||
5586 | SetSaveAttr(*object); | |||
5587 | } | |||
5588 | } | |||
5589 | } | |||
5590 | } | |||
5591 | if (specPartState_.saveInfo.saveAll) { | |||
5592 | // Apply SAVE attribute to applicable symbols | |||
5593 | for (auto pair : currScope()) { | |||
5594 | auto &symbol{*pair.second}; | |||
5595 | if (!CheckSaveAttr(symbol)) { | |||
5596 | SetSaveAttr(symbol); | |||
5597 | } | |||
5598 | } | |||
5599 | } | |||
5600 | specPartState_.saveInfo = {}; | |||
5601 | } | |||
5602 | ||||
5603 | // If SAVE attribute can't be set on symbol, return error message. | |||
5604 | std::optional<MessageFixedText> DeclarationVisitor::CheckSaveAttr( | |||
5605 | const Symbol &symbol) { | |||
5606 | if (IsDummy(symbol)) { | |||
5607 | return "SAVE attribute may not be applied to dummy argument '%s'"_err_en_US; | |||
5608 | } else if (symbol.IsFuncResult()) { | |||
5609 | return "SAVE attribute may not be applied to function result '%s'"_err_en_US; | |||
5610 | } else if (symbol.has<ProcEntityDetails>() && | |||
5611 | !symbol.attrs().test(Attr::POINTER)) { | |||
5612 | return "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US; | |||
5613 | } else if (IsAutomatic(symbol)) { | |||
5614 | return "SAVE attribute may not be applied to automatic data object '%s'"_err_en_US; | |||
5615 | } else { | |||
5616 | return std::nullopt; | |||
5617 | } | |||
5618 | } | |||
5619 | ||||
5620 | // Record SAVEd names in specPartState_.saveInfo.entities. | |||
5621 | Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) { | |||
5622 | if (attrs.test(Attr::SAVE)) { | |||
5623 | AddSaveName(specPartState_.saveInfo.entities, name); | |||
5624 | } | |||
5625 | return attrs; | |||
5626 | } | |||
5627 | ||||
5628 | // Record a name in a set of those to be saved. | |||
5629 | void DeclarationVisitor::AddSaveName( | |||
5630 | std::set<SourceName> &set, const SourceName &name) { | |||
5631 | auto pair{set.insert(name)}; | |||
5632 | if (!pair.second) { | |||
5633 | Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US, | |||
5634 | *pair.first, "Previous specification of SAVE attribute"_en_US); | |||
5635 | } | |||
5636 | } | |||
5637 | ||||
5638 | // Set the SAVE attribute on symbol unless it is implicitly saved anyway. | |||
5639 | void DeclarationVisitor::SetSaveAttr(Symbol &symbol) { | |||
5640 | if (!IsSaved(symbol)) { | |||
5641 | SetImplicitAttr(symbol, Attr::SAVE); | |||
5642 | } | |||
5643 | } | |||
5644 | ||||
5645 | // Check types of common block objects, now that they are known. | |||
5646 | void DeclarationVisitor::CheckCommonBlocks() { | |||
5647 | // check for empty common blocks | |||
5648 | for (const auto &pair : currScope().commonBlocks()) { | |||
5649 | const auto &symbol{*pair.second}; | |||
5650 | if (symbol.get<CommonBlockDetails>().objects().empty() && | |||
5651 | symbol.attrs().test(Attr::BIND_C)) { | |||
5652 | Say(symbol.name(), | |||
5653 | "'%s' appears as a COMMON block in a BIND statement but not in" | |||
5654 | " a COMMON statement"_err_en_US); | |||
5655 | } | |||
5656 | } | |||
5657 | // check objects in common blocks | |||
5658 | for (const auto &name : specPartState_.commonBlockObjects) { | |||
5659 | const auto *symbol{currScope().FindSymbol(name)}; | |||
5660 | if (!symbol) { | |||
5661 | continue; | |||
5662 | } | |||
5663 | const auto &attrs{symbol->attrs()}; | |||
5664 | if (attrs.test(Attr::ALLOCATABLE)) { | |||
5665 | Say(name, | |||
5666 | "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US); | |||
5667 | } else if (attrs.test(Attr::BIND_C)) { | |||
5668 | Say(name, | |||
5669 | "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US); | |||
5670 | } else if (IsNamedConstant(*symbol)) { | |||
5671 | Say(name, | |||
5672 | "A named constant '%s' may not appear in a COMMON block"_err_en_US); | |||
5673 | } else if (IsDummy(*symbol)) { | |||
5674 | Say(name, | |||
5675 | "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); | |||
5676 | } else if (symbol->IsFuncResult()) { | |||
5677 | Say(name, | |||
5678 | "Function result '%s' may not appear in a COMMON block"_err_en_US); | |||
5679 | } else if (const DeclTypeSpec * type{symbol->GetType()}) { | |||
5680 | if (type->category() == DeclTypeSpec::ClassStar) { | |||
5681 | Say(name, | |||
5682 | "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US); | |||
5683 | } else if (const auto *derived{type->AsDerived()}) { | |||
5684 | auto &typeSymbol{derived->typeSymbol()}; | |||
5685 | if (!typeSymbol.attrs().test(Attr::BIND_C) && | |||
5686 | !typeSymbol.get<DerivedTypeDetails>().sequence()) { | |||
5687 | Say(name, | |||
5688 | "Derived type '%s' in COMMON block must have the BIND or" | |||
5689 | " SEQUENCE attribute"_err_en_US); | |||
5690 | } | |||
5691 | CheckCommonBlockDerivedType(name, typeSymbol); | |||
5692 | } | |||
5693 | } | |||
5694 | } | |||
5695 | specPartState_.commonBlockObjects = {}; | |||
5696 | } | |||
5697 | ||||
5698 | Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { | |||
5699 | return Resolve(name, currScope().MakeCommonBlock(name.source)); | |||
5700 | } | |||
5701 | Symbol &DeclarationVisitor::MakeCommonBlockSymbol( | |||
5702 | const std::optional<parser::Name> &name) { | |||
5703 | if (name) { | |||
5704 | return MakeCommonBlockSymbol(*name); | |||
5705 | } else { | |||
5706 | return MakeCommonBlockSymbol(parser::Name{}); | |||
5707 | } | |||
5708 | } | |||
5709 | ||||
5710 | bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) { | |||
5711 | return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name); | |||
5712 | } | |||
5713 | ||||
5714 | // Check if this derived type can be in a COMMON block. | |||
5715 | void DeclarationVisitor::CheckCommonBlockDerivedType( | |||
5716 | const SourceName &name, const Symbol &typeSymbol) { | |||
5717 | if (const auto *scope{typeSymbol.scope()}) { | |||
5718 | for (const auto &pair : *scope) { | |||
5719 | const Symbol &component{*pair.second}; | |||
5720 | if (component.attrs().test(Attr::ALLOCATABLE)) { | |||
5721 | Say2(name, | |||
5722 | "Derived type variable '%s' may not appear in a COMMON block" | |||
5723 | " due to ALLOCATABLE component"_err_en_US, | |||
5724 | component.name(), "Component with ALLOCATABLE attribute"_en_US); | |||
5725 | return; | |||
5726 | } | |||
5727 | const auto *details{component.detailsIf<ObjectEntityDetails>()}; | |||
5728 | if (component.test(Symbol::Flag::InDataStmt) || | |||
5729 | (details && details->init())) { | |||
5730 | Say2(name, | |||
5731 | "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US, | |||
5732 | component.name(), "Component with default initialization"_en_US); | |||
5733 | return; | |||
5734 | } | |||
5735 | if (details) { | |||
5736 | if (const auto *type{details->type()}) { | |||
5737 | if (const auto *derived{type->AsDerived()}) { | |||
5738 | CheckCommonBlockDerivedType(name, derived->typeSymbol()); | |||
5739 | } | |||
5740 | } | |||
5741 | } | |||
5742 | } | |||
5743 | } | |||
5744 | } | |||
5745 | ||||
5746 | bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( | |||
5747 | const parser::Name &name) { | |||
5748 | if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction( | |||
5749 | name.source.ToString())}) { | |||
5750 | // Unrestricted specific intrinsic function names (e.g., "cos") | |||
5751 | // are acceptable as procedure interfaces. The presence of the | |||
5752 | // INTRINSIC flag will cause this symbol to have a complete interface | |||
5753 | // recreated for it later on demand, but capturing its result type here | |||
5754 | // will make GetType() return a correct result without having to | |||
5755 | // probe the intrinsics table again. | |||
5756 | Symbol &symbol{ | |||
5757 | MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})}; | |||
5758 | CHECK(interface->functionResult.has_value())((interface->functionResult.has_value()) || (Fortran::common ::die("CHECK(" "interface->functionResult.has_value()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 5758) , false)); | |||
5759 | evaluate::DynamicType dyType{ | |||
5760 | DEREF(interface->functionResult->GetTypeAndShape())Fortran::common::Deref(interface->functionResult->GetTypeAndShape (), "flang/lib/Semantics/resolve-names.cpp", 5760).type()}; | |||
5761 | CHECK(common::IsNumericTypeCategory(dyType.category()))((common::IsNumericTypeCategory(dyType.category())) || (Fortran ::common::die("CHECK(" "common::IsNumericTypeCategory(dyType.category())" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5761), false)); | |||
5762 | const DeclTypeSpec &typeSpec{ | |||
5763 | MakeNumericType(dyType.category(), dyType.kind())}; | |||
5764 | ProcEntityDetails details; | |||
5765 | details.set_type(typeSpec); | |||
5766 | symbol.set_details(std::move(details)); | |||
5767 | symbol.set(Symbol::Flag::Function); | |||
5768 | if (interface->IsElemental()) { | |||
5769 | SetExplicitAttr(symbol, Attr::ELEMENTAL); | |||
5770 | } | |||
5771 | if (interface->IsPure()) { | |||
5772 | SetExplicitAttr(symbol, Attr::PURE); | |||
5773 | } | |||
5774 | Resolve(name, symbol); | |||
5775 | return true; | |||
5776 | } else { | |||
5777 | return false; | |||
5778 | } | |||
5779 | } | |||
5780 | ||||
5781 | // Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED | |||
5782 | bool DeclarationVisitor::PassesSharedLocalityChecks( | |||
5783 | const parser::Name &name, Symbol &symbol) { | |||
5784 | if (!IsVariableName(symbol)) { | |||
5785 | SayLocalMustBeVariable(name, symbol); // C1124 | |||
5786 | return false; | |||
5787 | } | |||
5788 | if (symbol.owner() == currScope()) { // C1125 and C1126 | |||
5789 | SayAlreadyDeclared(name, symbol); | |||
5790 | return false; | |||
5791 | } | |||
5792 | return true; | |||
5793 | } | |||
5794 | ||||
5795 | // Checks for locality-specs LOCAL and LOCAL_INIT | |||
5796 | bool DeclarationVisitor::PassesLocalityChecks( | |||
5797 | const parser::Name &name, Symbol &symbol) { | |||
5798 | if (IsAllocatable(symbol)) { // C1128 | |||
5799 | SayWithDecl(name, symbol, | |||
5800 | "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US); | |||
5801 | return false; | |||
5802 | } | |||
5803 | if (IsOptional(symbol)) { // C1128 | |||
5804 | SayWithDecl(name, symbol, | |||
5805 | "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US); | |||
5806 | return false; | |||
5807 | } | |||
5808 | if (IsIntentIn(symbol)) { // C1128 | |||
5809 | SayWithDecl(name, symbol, | |||
5810 | "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US); | |||
5811 | return false; | |||
5812 | } | |||
5813 | if (IsFinalizable(symbol)) { // C1128 | |||
5814 | SayWithDecl(name, symbol, | |||
5815 | "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US); | |||
5816 | return false; | |||
5817 | } | |||
5818 | if (evaluate::IsCoarray(symbol)) { // C1128 | |||
5819 | SayWithDecl( | |||
5820 | name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US); | |||
5821 | return false; | |||
5822 | } | |||
5823 | if (const DeclTypeSpec * type{symbol.GetType()}) { | |||
5824 | if (type->IsPolymorphic() && IsDummy(symbol) && | |||
5825 | !IsPointer(symbol)) { // C1128 | |||
5826 | SayWithDecl(name, symbol, | |||
5827 | "Nonpointer polymorphic argument '%s' not allowed in a " | |||
5828 | "locality-spec"_err_en_US); | |||
5829 | return false; | |||
5830 | } | |||
5831 | } | |||
5832 | if (IsAssumedSizeArray(symbol)) { // C1128 | |||
5833 | SayWithDecl(name, symbol, | |||
5834 | "Assumed size array '%s' not allowed in a locality-spec"_err_en_US); | |||
5835 | return false; | |||
5836 | } | |||
5837 | if (std::optional<Message> whyNot{WhyNotDefinable( | |||
5838 | name.source, currScope(), DefinabilityFlags{}, symbol)}) { | |||
5839 | SayWithReason(name, symbol, | |||
5840 | "'%s' may not appear in a locality-spec because it is not " | |||
5841 | "definable"_err_en_US, | |||
5842 | std::move(*whyNot)); | |||
5843 | return false; | |||
5844 | } | |||
5845 | return PassesSharedLocalityChecks(name, symbol); | |||
5846 | } | |||
5847 | ||||
5848 | Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity( | |||
5849 | const parser::Name &name) { | |||
5850 | Symbol *prev{FindSymbol(name)}; | |||
5851 | if (!prev) { | |||
5852 | // Declare the name as an object in the enclosing scope so that | |||
5853 | // the name can't be repurposed there later as something else. | |||
5854 | prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{}); | |||
5855 | ConvertToObjectEntity(*prev); | |||
5856 | ApplyImplicitRules(*prev); | |||
5857 | } | |||
5858 | return *prev; | |||
5859 | } | |||
5860 | ||||
5861 | Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) { | |||
5862 | Symbol &prev{FindOrDeclareEnclosingEntity(name)}; | |||
5863 | if (!PassesLocalityChecks(name, prev)) { | |||
5864 | return nullptr; | |||
5865 | } | |||
5866 | return &MakeHostAssocSymbol(name, prev); | |||
5867 | } | |||
5868 | ||||
5869 | Symbol *DeclarationVisitor::DeclareStatementEntity( | |||
5870 | const parser::DoVariable &doVar, | |||
5871 | const std::optional<parser::IntegerTypeSpec> &type) { | |||
5872 | const parser::Name &name{doVar.thing.thing}; | |||
5873 | const DeclTypeSpec *declTypeSpec{nullptr}; | |||
5874 | if (auto *prev{FindSymbol(name)}) { | |||
5875 | if (prev->owner() == currScope()) { | |||
5876 | SayAlreadyDeclared(name, *prev); | |||
5877 | return nullptr; | |||
5878 | } | |||
5879 | name.symbol = nullptr; | |||
5880 | declTypeSpec = prev->GetType(); | |||
5881 | } | |||
5882 | Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})}; | |||
5883 | if (!symbol.has<ObjectEntityDetails>()) { | |||
5884 | return nullptr; // error was reported in DeclareEntity | |||
5885 | } | |||
5886 | if (type) { | |||
5887 | declTypeSpec = ProcessTypeSpec(*type); | |||
5888 | } | |||
5889 | if (declTypeSpec) { | |||
5890 | // Subtlety: Don't let a "*length" specifier (if any is pending) affect the | |||
5891 | // declaration of this implied DO loop control variable. | |||
5892 | auto restorer{ | |||
5893 | common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})}; | |||
5894 | SetType(name, *declTypeSpec); | |||
5895 | } else { | |||
5896 | ApplyImplicitRules(symbol); | |||
5897 | } | |||
5898 | Symbol *result{Resolve(name, &symbol)}; | |||
5899 | AnalyzeExpr(context(), doVar); // enforce INTEGER type | |||
5900 | return result; | |||
5901 | } | |||
5902 | ||||
5903 | // Set the type of an entity or report an error. | |||
5904 | void DeclarationVisitor::SetType( | |||
5905 | const parser::Name &name, const DeclTypeSpec &type) { | |||
5906 | CHECK(name.symbol)((name.symbol) || (Fortran::common::die("CHECK(" "name.symbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5906), false)); | |||
5907 | auto &symbol{*name.symbol}; | |||
5908 | if (charInfo_.length) { // Declaration has "*length" (R723) | |||
5909 | auto length{std::move(*charInfo_.length)}; | |||
5910 | charInfo_.length.reset(); | |||
5911 | if (type.category() == DeclTypeSpec::Character) { | |||
5912 | auto kind{type.characterTypeSpec().kind()}; | |||
5913 | // Recurse with correct type. | |||
5914 | SetType(name, | |||
5915 | currScope().MakeCharacterType(std::move(length), std::move(kind))); | |||
5916 | return; | |||
5917 | } else { // C753 | |||
5918 | Say(name, | |||
5919 | "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US); | |||
5920 | } | |||
5921 | } | |||
5922 | if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) { | |||
5923 | if (proc->procInterface()) { | |||
5924 | Say(name, | |||
5925 | "'%s' has an explicit interface and may not also have a type"_err_en_US); | |||
5926 | context().SetError(symbol); | |||
5927 | return; | |||
5928 | } | |||
5929 | } | |||
5930 | auto *prevType{symbol.GetType()}; | |||
5931 | if (!prevType) { | |||
5932 | symbol.SetType(type); | |||
5933 | } else if (symbol.has<UseDetails>()) { | |||
5934 | // error recovery case, redeclaration of use-associated name | |||
5935 | } else if (HadForwardRef(symbol)) { | |||
5936 | // error recovery after use of host-associated name | |||
5937 | } else if (!symbol.test(Symbol::Flag::Implicit)) { | |||
5938 | SayWithDecl( | |||
5939 | name, symbol, "The type of '%s' has already been declared"_err_en_US); | |||
5940 | context().SetError(symbol); | |||
5941 | } else if (type != *prevType) { | |||
5942 | SayWithDecl(name, symbol, | |||
5943 | "The type of '%s' has already been implicitly declared"_err_en_US); | |||
5944 | context().SetError(symbol); | |||
5945 | } else { | |||
5946 | symbol.set(Symbol::Flag::Implicit, false); | |||
5947 | } | |||
5948 | } | |||
5949 | ||||
5950 | std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType( | |||
5951 | const parser::Name &name) { | |||
5952 | Scope &outer{NonDerivedTypeScope()}; | |||
5953 | Symbol *symbol{FindSymbol(outer, name)}; | |||
5954 | Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr}; | |||
5955 | auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr}; | |||
5956 | if (generic) { | |||
5957 | if (Symbol * genDT{generic->derivedType()}) { | |||
5958 | symbol = genDT; | |||
5959 | generic = nullptr; | |||
5960 | } | |||
5961 | } | |||
5962 | if (!symbol || symbol->has<UnknownDetails>() || | |||
5963 | (generic && &ultimate->owner() == &outer)) { | |||
5964 | if (allowForwardReferenceToDerivedType()) { | |||
5965 | if (!symbol) { | |||
5966 | symbol = &MakeSymbol(outer, name.source, Attrs{}); | |||
5967 | Resolve(name, *symbol); | |||
5968 | } else if (generic) { | |||
5969 | // forward ref to type with later homonymous generic | |||
5970 | symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{}); | |||
5971 | generic->set_derivedType(*symbol); | |||
5972 | name.symbol = symbol; | |||
5973 | } | |||
5974 | DerivedTypeDetails details; | |||
5975 | details.set_isForwardReferenced(true); | |||
5976 | symbol->set_details(std::move(details)); | |||
5977 | } else { // C732 | |||
5978 | Say(name, "Derived type '%s' not found"_err_en_US); | |||
5979 | return std::nullopt; | |||
5980 | } | |||
5981 | } | |||
5982 | if (CheckUseError(name)) { | |||
5983 | return std::nullopt; | |||
5984 | } | |||
5985 | symbol = &symbol->GetUltimate(); | |||
5986 | if (symbol->has<DerivedTypeDetails>()) { | |||
5987 | return DerivedTypeSpec{name.source, *symbol}; | |||
5988 | } else { | |||
5989 | Say(name, "'%s' is not a derived type"_err_en_US); | |||
5990 | return std::nullopt; | |||
5991 | } | |||
5992 | } | |||
5993 | ||||
5994 | std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType( | |||
5995 | const parser::Name &typeName, const parser::Name *extendsName) { | |||
5996 | if (!extendsName) { | |||
5997 | return std::nullopt; | |||
5998 | } else if (typeName.source == extendsName->source) { | |||
5999 | Say(extendsName->source, | |||
6000 | "Derived type '%s' cannot extend itself"_err_en_US); | |||
6001 | return std::nullopt; | |||
6002 | } else { | |||
6003 | return ResolveDerivedType(*extendsName); | |||
6004 | } | |||
6005 | } | |||
6006 | ||||
6007 | Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) { | |||
6008 | // The symbol is checked later by CheckExplicitInterface() and | |||
6009 | // CheckBindings(). It can be a forward reference. | |||
6010 | if (!NameIsKnownOrIntrinsic(name)) { | |||
6011 | Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})}; | |||
6012 | Resolve(name, symbol); | |||
6013 | } | |||
6014 | return name.symbol; | |||
6015 | } | |||
6016 | ||||
6017 | void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) { | |||
6018 | if (const Symbol * symbol{name.symbol}) { | |||
6019 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
6020 | if (!context().HasError(*symbol) && !context().HasError(ultimate) && | |||
6021 | !ultimate.HasExplicitInterface()) { | |||
6022 | Say(name, | |||
6023 | "'%s' must be an abstract interface or a procedure with " | |||
6024 | "an explicit interface"_err_en_US, | |||
6025 | symbol->name()); | |||
6026 | } | |||
6027 | } | |||
6028 | } | |||
6029 | ||||
6030 | // Create a symbol for a type parameter, component, or procedure binding in | |||
6031 | // the current derived type scope. Return false on error. | |||
6032 | Symbol *DeclarationVisitor::MakeTypeSymbol( | |||
6033 | const parser::Name &name, Details &&details) { | |||
6034 | return Resolve(name, MakeTypeSymbol(name.source, std::move(details))); | |||
6035 | } | |||
6036 | Symbol *DeclarationVisitor::MakeTypeSymbol( | |||
6037 | const SourceName &name, Details &&details) { | |||
6038 | Scope &derivedType{currScope()}; | |||
6039 | CHECK(derivedType.IsDerivedType())((derivedType.IsDerivedType()) || (Fortran::common::die("CHECK(" "derivedType.IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6039), false)); | |||
6040 | if (auto *symbol{FindInScope(derivedType, name)}) { // C742 | |||
6041 | Say2(name, | |||
6042 | "Type parameter, component, or procedure binding '%s'" | |||
6043 | " already defined in this type"_err_en_US, | |||
6044 | *symbol, "Previous definition of '%s'"_en_US); | |||
6045 | return nullptr; | |||
6046 | } else { | |||
6047 | auto attrs{GetAttrs()}; | |||
6048 | // Apply binding-private-stmt if present and this is a procedure binding | |||
6049 | if (derivedTypeInfo_.privateBindings && | |||
6050 | !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) && | |||
6051 | std::holds_alternative<ProcBindingDetails>(details)) { | |||
6052 | attrs.set(Attr::PRIVATE); | |||
6053 | } | |||
6054 | Symbol &result{MakeSymbol(name, attrs, std::move(details))}; | |||
6055 | if (result.has<TypeParamDetails>()) { | |||
6056 | derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result); | |||
6057 | } | |||
6058 | return &result; | |||
6059 | } | |||
6060 | } | |||
6061 | ||||
6062 | // Return true if it is ok to declare this component in the current scope. | |||
6063 | // Otherwise, emit an error and return false. | |||
6064 | bool DeclarationVisitor::OkToAddComponent( | |||
6065 | const parser::Name &name, const Symbol *extends) { | |||
6066 | for (const Scope *scope{&currScope()}; scope;) { | |||
6067 | CHECK(scope->IsDerivedType())((scope->IsDerivedType()) || (Fortran::common::die("CHECK(" "scope->IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6067), false)); | |||
6068 | if (auto *prev{FindInScope(*scope, name.source)}) { | |||
6069 | std::optional<parser::MessageFixedText> msg; | |||
6070 | if (context().HasError(*prev)) { // don't pile on | |||
6071 | } else if (extends) { | |||
6072 | msg = "Type cannot be extended as it has a component named" | |||
6073 | " '%s'"_err_en_US; | |||
6074 | } else if (CheckAccessibleSymbol(currScope(), *prev)) { | |||
6075 | // inaccessible component -- redeclaration is ok | |||
6076 | msg = "Component '%s' is inaccessibly declared in or as a " | |||
6077 | "parent of this derived type"_warn_en_US; | |||
6078 | } else if (prev->test(Symbol::Flag::ParentComp)) { | |||
6079 | msg = "'%s' is a parent type of this type and so cannot be" | |||
6080 | " a component"_err_en_US; | |||
6081 | } else if (scope == &currScope()) { | |||
6082 | msg = "Component '%s' is already declared in this" | |||
6083 | " derived type"_err_en_US; | |||
6084 | } else { | |||
6085 | msg = "Component '%s' is already declared in a parent of this" | |||
6086 | " derived type"_err_en_US; | |||
6087 | } | |||
6088 | if (msg) { | |||
6089 | Say2( | |||
6090 | name, std::move(*msg), *prev, "Previous declaration of '%s'"_en_US); | |||
6091 | if (msg->severity() == parser::Severity::Error) { | |||
6092 | Resolve(name, *prev); | |||
6093 | return false; | |||
6094 | } | |||
6095 | } | |||
6096 | } | |||
6097 | if (scope == &currScope() && extends) { | |||
6098 | // The parent component has not yet been added to the scope. | |||
6099 | scope = extends->scope(); | |||
6100 | } else { | |||
6101 | scope = scope->GetDerivedTypeParent(); | |||
6102 | } | |||
6103 | } | |||
6104 | return true; | |||
6105 | } | |||
6106 | ||||
6107 | ParamValue DeclarationVisitor::GetParamValue( | |||
6108 | const parser::TypeParamValue &x, common::TypeParamAttr attr) { | |||
6109 | return common::visit( | |||
6110 | common::visitors{ | |||
6111 | [=](const parser::ScalarIntExpr &x) { // C704 | |||
6112 | return ParamValue{EvaluateIntExpr(x), attr}; | |||
6113 | }, | |||
6114 | [=](const parser::Star &) { return ParamValue::Assumed(attr); }, | |||
6115 | [=](const parser::TypeParamValue::Deferred &) { | |||
6116 | return ParamValue::Deferred(attr); | |||
6117 | }, | |||
6118 | }, | |||
6119 | x.u); | |||
6120 | } | |||
6121 | ||||
6122 | // ConstructVisitor implementation | |||
6123 | ||||
6124 | void ConstructVisitor::ResolveIndexName( | |||
6125 | const parser::ConcurrentControl &control) { | |||
6126 | const parser::Name &name{std::get<parser::Name>(control.t)}; | |||
6127 | auto *prev{FindSymbol(name)}; | |||
6128 | if (prev) { | |||
6129 | if (prev->owner().kind() == Scope::Kind::Forall || | |||
6130 | prev->owner() == currScope()) { | |||
6131 | SayAlreadyDeclared(name, *prev); | |||
6132 | return; | |||
6133 | } | |||
6134 | name.symbol = nullptr; | |||
6135 | } | |||
6136 | auto &symbol{DeclareObjectEntity(name)}; | |||
6137 | if (symbol.GetType()) { | |||
6138 | // type came from explicit type-spec | |||
6139 | } else if (!prev) { | |||
6140 | ApplyImplicitRules(symbol); | |||
6141 | } else { | |||
6142 | const Symbol &prevRoot{prev->GetUltimate()}; | |||
6143 | // prev could be host- use- or construct-associated with another symbol | |||
6144 | if (!prevRoot.has<ObjectEntityDetails>() && | |||
6145 | !prevRoot.has<AssocEntityDetails>()) { | |||
6146 | Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US, | |||
6147 | *prev, "Previous declaration of '%s'"_en_US); | |||
6148 | context().SetError(symbol); | |||
6149 | return; | |||
6150 | } else { | |||
6151 | if (const auto *type{prevRoot.GetType()}) { | |||
6152 | symbol.SetType(*type); | |||
6153 | } | |||
6154 | if (prevRoot.IsObjectArray()) { | |||
6155 | SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US); | |||
6156 | return; | |||
6157 | } | |||
6158 | } | |||
6159 | } | |||
6160 | EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}}); | |||
6161 | } | |||
6162 | ||||
6163 | // We need to make sure that all of the index-names get declared before the | |||
6164 | // expressions in the loop control are evaluated so that references to the | |||
6165 | // index-names in the expressions are correctly detected. | |||
6166 | bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) { | |||
6167 | BeginDeclTypeSpec(); | |||
6168 | Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t)); | |||
6169 | const auto &controls{ | |||
6170 | std::get<std::list<parser::ConcurrentControl>>(header.t)}; | |||
6171 | for (const auto &control : controls) { | |||
6172 | ResolveIndexName(control); | |||
6173 | } | |||
6174 | Walk(controls); | |||
6175 | Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)); | |||
6176 | EndDeclTypeSpec(); | |||
6177 | return false; | |||
6178 | } | |||
6179 | ||||
6180 | bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) { | |||
6181 | for (auto &name : x.v) { | |||
6182 | if (auto *symbol{DeclareLocalEntity(name)}) { | |||
6183 | symbol->set(Symbol::Flag::LocalityLocal); | |||
6184 | } | |||
6185 | } | |||
6186 | return false; | |||
6187 | } | |||
6188 | ||||
6189 | bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) { | |||
6190 | for (auto &name : x.v) { | |||
6191 | if (auto *symbol{DeclareLocalEntity(name)}) { | |||
6192 | symbol->set(Symbol::Flag::LocalityLocalInit); | |||
6193 | } | |||
6194 | } | |||
6195 | return false; | |||
6196 | } | |||
6197 | ||||
6198 | bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) { | |||
6199 | for (const auto &name : x.v) { | |||
6200 | if (!FindSymbol(name)) { | |||
6201 | Say(name, | |||
6202 | "Variable '%s' with SHARED locality implicitly declared"_warn_en_US); | |||
6203 | } | |||
6204 | Symbol &prev{FindOrDeclareEnclosingEntity(name)}; | |||
6205 | if (PassesSharedLocalityChecks(name, prev)) { | |||
6206 | MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared); | |||
6207 | } | |||
6208 | } | |||
6209 | return false; | |||
6210 | } | |||
6211 | ||||
6212 | bool ConstructVisitor::Pre(const parser::AcSpec &x) { | |||
6213 | ProcessTypeSpec(x.type); | |||
6214 | Walk(x.values); | |||
6215 | return false; | |||
6216 | } | |||
6217 | ||||
6218 | // Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the | |||
6219 | // enclosing ac-implied-do | |||
6220 | bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) { | |||
6221 | auto &values{std::get<std::list<parser::AcValue>>(x.t)}; | |||
6222 | auto &control{std::get<parser::AcImpliedDoControl>(x.t)}; | |||
6223 | auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)}; | |||
6224 | auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)}; | |||
6225 | // F'2018 has the scope of the implied DO variable covering the entire | |||
6226 | // implied DO production (19.4(5)), which seems wrong in cases where the name | |||
6227 | // of the implied DO variable appears in one of the bound expressions. Thus | |||
6228 | // this extension, which shrinks the scope of the variable to exclude the | |||
6229 | // expressions in the bounds. | |||
6230 | auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)}; | |||
6231 | Walk(bounds.lower); | |||
6232 | Walk(bounds.upper); | |||
6233 | Walk(bounds.step); | |||
6234 | EndCheckOnIndexUseInOwnBounds(restore); | |||
6235 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6236 | DeclareStatementEntity(bounds.name, type); | |||
6237 | Walk(values); | |||
6238 | PopScope(); | |||
6239 | return false; | |||
6240 | } | |||
6241 | ||||
6242 | bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { | |||
6243 | auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)}; | |||
6244 | auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)}; | |||
6245 | auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)}; | |||
6246 | // See comment in Pre(AcImpliedDo) above. | |||
6247 | auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)}; | |||
6248 | Walk(bounds.lower); | |||
6249 | Walk(bounds.upper); | |||
6250 | Walk(bounds.step); | |||
6251 | EndCheckOnIndexUseInOwnBounds(restore); | |||
6252 | bool pushScope{currScope().kind() != Scope::Kind::ImpliedDos}; | |||
6253 | if (pushScope) { | |||
6254 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6255 | } | |||
6256 | DeclareStatementEntity(bounds.name, type); | |||
6257 | Walk(objects); | |||
6258 | if (pushScope) { | |||
6259 | PopScope(); | |||
6260 | } | |||
6261 | return false; | |||
6262 | } | |||
6263 | ||||
6264 | // Sets InDataStmt flag on a variable (or misidentified function) in a DATA | |||
6265 | // statement so that the predicate IsInitialized() will be true | |||
6266 | // during semantic analysis before the symbol's initializer is constructed. | |||
6267 | bool ConstructVisitor::Pre(const parser::DataIDoObject &x) { | |||
6268 | common::visit( | |||
6269 | common::visitors{ | |||
6270 | [&](const parser::Scalar<Indirection<parser::Designator>> &y) { | |||
6271 | Walk(y.thing.value()); | |||
6272 | const parser::Name &first{parser::GetFirstName(y.thing.value())}; | |||
6273 | if (first.symbol) { | |||
6274 | first.symbol->set(Symbol::Flag::InDataStmt); | |||
6275 | } | |||
6276 | }, | |||
6277 | [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); }, | |||
6278 | }, | |||
6279 | x.u); | |||
6280 | return false; | |||
6281 | } | |||
6282 | ||||
6283 | bool ConstructVisitor::Pre(const parser::DataStmtObject &x) { | |||
6284 | // Subtle: DATA statements may appear in both the specification and | |||
6285 | // execution parts, but should be treated as if in the execution part | |||
6286 | // for purposes of implicit variable declaration vs. host association. | |||
6287 | // When a name first appears as an object in a DATA statement, it should | |||
6288 | // be implicitly declared locally as if it had been assigned. | |||
6289 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)}; | |||
6290 | common::visit(common::visitors{ | |||
6291 | [&](const Indirection<parser::Variable> &y) { | |||
6292 | Walk(y.value()); | |||
6293 | const parser::Name &first{ | |||
6294 | parser::GetFirstName(y.value())}; | |||
6295 | if (first.symbol) { | |||
6296 | first.symbol->set(Symbol::Flag::InDataStmt); | |||
6297 | } | |||
6298 | }, | |||
6299 | [&](const parser::DataImpliedDo &y) { | |||
6300 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6301 | Walk(y); | |||
6302 | PopScope(); | |||
6303 | }, | |||
6304 | }, | |||
6305 | x.u); | |||
6306 | return false; | |||
6307 | } | |||
6308 | ||||
6309 | bool ConstructVisitor::Pre(const parser::DataStmtValue &x) { | |||
6310 | const auto &data{std::get<parser::DataStmtConstant>(x.t)}; | |||
6311 | auto &mutableData{const_cast<parser::DataStmtConstant &>(data)}; | |||
6312 | if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) { | |||
6313 | if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) { | |||
6314 | if (const Symbol * symbol{FindSymbol(*name)}) { | |||
6315 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
6316 | if (ultimate.has<DerivedTypeDetails>()) { | |||
6317 | mutableData.u = elem->ConvertToStructureConstructor( | |||
6318 | DerivedTypeSpec{name->source, ultimate}); | |||
6319 | } | |||
6320 | } | |||
6321 | } | |||
6322 | } | |||
6323 | return true; | |||
6324 | } | |||
6325 | ||||
6326 | bool ConstructVisitor::Pre(const parser::DoConstruct &x) { | |||
6327 | if (x.IsDoConcurrent()) { | |||
6328 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6329 | } | |||
6330 | return true; | |||
6331 | } | |||
6332 | void ConstructVisitor::Post(const parser::DoConstruct &x) { | |||
6333 | if (x.IsDoConcurrent()) { | |||
6334 | PopScope(); | |||
6335 | } | |||
6336 | } | |||
6337 | ||||
6338 | bool ConstructVisitor::Pre(const parser::ForallConstruct &) { | |||
6339 | PushScope(Scope::Kind::Forall, nullptr); | |||
6340 | return true; | |||
6341 | } | |||
6342 | void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); } | |||
6343 | bool ConstructVisitor::Pre(const parser::ForallStmt &) { | |||
6344 | PushScope(Scope::Kind::Forall, nullptr); | |||
6345 | return true; | |||
6346 | } | |||
6347 | void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); } | |||
6348 | ||||
6349 | bool ConstructVisitor::Pre(const parser::BlockStmt &x) { | |||
6350 | CheckDef(x.v); | |||
6351 | PushScope(Scope::Kind::BlockConstruct, nullptr); | |||
6352 | return false; | |||
6353 | } | |||
6354 | bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) { | |||
6355 | PopScope(); | |||
6356 | CheckRef(x.v); | |||
6357 | return false; | |||
6358 | } | |||
6359 | ||||
6360 | void ConstructVisitor::Post(const parser::Selector &x) { | |||
6361 | GetCurrentAssociation().selector = ResolveSelector(x); | |||
6362 | } | |||
6363 | ||||
6364 | void ConstructVisitor::Post(const parser::AssociateStmt &x) { | |||
6365 | CheckDef(x.t); | |||
6366 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6367 | const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()}; | |||
6368 | for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) { | |||
6369 | SetCurrentAssociation(nthLastAssoc); | |||
6370 | if (auto *symbol{MakeAssocEntity()}) { | |||
6371 | if (ExtractCoarrayRef(GetCurrentAssociation().selector.expr)) { // C1103 | |||
6372 | Say("Selector must not be a coindexed object"_err_en_US); | |||
6373 | } | |||
6374 | SetTypeFromAssociation(*symbol); | |||
6375 | SetAttrsFromAssociation(*symbol); | |||
6376 | } | |||
6377 | } | |||
6378 | PopAssociation(assocCount); | |||
6379 | } | |||
6380 | ||||
6381 | void ConstructVisitor::Post(const parser::EndAssociateStmt &x) { | |||
6382 | PopScope(); | |||
6383 | CheckRef(x.v); | |||
6384 | } | |||
6385 | ||||
6386 | bool ConstructVisitor::Pre(const parser::Association &x) { | |||
6387 | PushAssociation(); | |||
6388 | const auto &name{std::get<parser::Name>(x.t)}; | |||
6389 | GetCurrentAssociation().name = &name; | |||
6390 | return true; | |||
6391 | } | |||
6392 | ||||
6393 | bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) { | |||
6394 | CheckDef(x.t); | |||
6395 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6396 | PushAssociation(); | |||
6397 | return true; | |||
6398 | } | |||
6399 | ||||
6400 | void ConstructVisitor::Post(const parser::CoarrayAssociation &x) { | |||
6401 | const auto &decl{std::get<parser::CodimensionDecl>(x.t)}; | |||
6402 | const auto &name{std::get<parser::Name>(decl.t)}; | |||
6403 | if (auto *symbol{FindInScope(name)}) { | |||
6404 | const auto &selector{std::get<parser::Selector>(x.t)}; | |||
6405 | if (auto sel{ResolveSelector(selector)}) { | |||
6406 | const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)}; | |||
6407 | if (!whole || whole->Corank() == 0) { | |||
6408 | Say(sel.source, // C1116 | |||
6409 | "Selector in coarray association must name a coarray"_err_en_US); | |||
6410 | } else if (auto dynType{sel.expr->GetType()}) { | |||
6411 | if (!symbol->GetType()) { | |||
6412 | symbol->SetType(ToDeclTypeSpec(std::move(*dynType))); | |||
6413 | } | |||
6414 | } | |||
6415 | } | |||
6416 | } | |||
6417 | } | |||
6418 | ||||
6419 | void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) { | |||
6420 | PopAssociation(); | |||
6421 | PopScope(); | |||
6422 | CheckRef(x.t); | |||
6423 | } | |||
6424 | ||||
6425 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) { | |||
6426 | PushAssociation(); | |||
6427 | return true; | |||
6428 | } | |||
6429 | ||||
6430 | void ConstructVisitor::Post(const parser::SelectTypeConstruct &) { | |||
6431 | PopAssociation(); | |||
6432 | } | |||
6433 | ||||
6434 | void ConstructVisitor::Post(const parser::SelectTypeStmt &x) { | |||
6435 | auto &association{GetCurrentAssociation()}; | |||
6436 | if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { | |||
6437 | // This isn't a name in the current scope, it is in each TypeGuardStmt | |||
6438 | MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName); | |||
6439 | association.name = &*name; | |||
6440 | if (ExtractCoarrayRef(association.selector.expr)) { // C1103 | |||
6441 | Say("Selector must not be a coindexed object"_err_en_US); | |||
6442 | } | |||
6443 | if (association.selector.expr) { | |||
6444 | auto exprType{association.selector.expr->GetType()}; | |||
6445 | if (exprType && !exprType->IsPolymorphic()) { // C1159 | |||
6446 | Say(association.selector.source, | |||
6447 | "Selector '%s' in SELECT TYPE statement must be " | |||
6448 | "polymorphic"_err_en_US); | |||
6449 | } | |||
6450 | } | |||
6451 | } else { | |||
6452 | if (const Symbol * | |||
6453 | whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { | |||
6454 | ConvertToObjectEntity(const_cast<Symbol &>(*whole)); | |||
6455 | if (!IsVariableName(*whole)) { | |||
6456 | Say(association.selector.source, // C901 | |||
6457 | "Selector is not a variable"_err_en_US); | |||
6458 | association = {}; | |||
6459 | } | |||
6460 | if (const DeclTypeSpec * type{whole->GetType()}) { | |||
6461 | if (!type->IsPolymorphic()) { // C1159 | |||
6462 | Say(association.selector.source, | |||
6463 | "Selector '%s' in SELECT TYPE statement must be " | |||
6464 | "polymorphic"_err_en_US); | |||
6465 | } | |||
6466 | } | |||
6467 | } else { | |||
6468 | Say(association.selector.source, // C1157 | |||
6469 | "Selector is not a named variable: 'associate-name =>' is required"_err_en_US); | |||
6470 | association = {}; | |||
6471 | } | |||
6472 | } | |||
6473 | } | |||
6474 | ||||
6475 | void ConstructVisitor::Post(const parser::SelectRankStmt &x) { | |||
6476 | auto &association{GetCurrentAssociation()}; | |||
6477 | if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { | |||
6478 | // This isn't a name in the current scope, it is in each SelectRankCaseStmt | |||
6479 | MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName); | |||
6480 | association.name = &*name; | |||
6481 | } | |||
6482 | } | |||
6483 | ||||
6484 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) { | |||
6485 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6486 | return true; | |||
6487 | } | |||
6488 | void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) { | |||
6489 | PopScope(); | |||
6490 | } | |||
6491 | ||||
6492 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) { | |||
6493 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6494 | return true; | |||
6495 | } | |||
6496 | void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) { | |||
6497 | PopScope(); | |||
6498 | } | |||
6499 | ||||
6500 | bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) { | |||
6501 | if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) { | |||
6502 | // CLASS IS (t) | |||
6503 | SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); | |||
6504 | } | |||
6505 | return true; | |||
6506 | } | |||
6507 | ||||
6508 | void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) { | |||
6509 | if (auto *symbol{MakeAssocEntity()}) { | |||
6510 | if (std::holds_alternative<parser::Default>(x.u)) { | |||
6511 | SetTypeFromAssociation(*symbol); | |||
6512 | } else if (const auto *type{GetDeclTypeSpec()}) { | |||
6513 | symbol->SetType(*type); | |||
6514 | } | |||
6515 | SetAttrsFromAssociation(*symbol); | |||
6516 | } | |||
6517 | } | |||
6518 | ||||
6519 | void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) { | |||
6520 | if (auto *symbol{MakeAssocEntity()}) { | |||
6521 | SetTypeFromAssociation(*symbol); | |||
6522 | SetAttrsFromAssociation(*symbol); | |||
6523 | if (const auto *init{std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) { | |||
6524 | if (auto val{EvaluateInt64(context(), *init)}) { | |||
6525 | auto &details{symbol->get<AssocEntityDetails>()}; | |||
6526 | details.set_rank(*val); | |||
6527 | } | |||
6528 | } | |||
6529 | } | |||
6530 | } | |||
6531 | ||||
6532 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) { | |||
6533 | PushAssociation(); | |||
6534 | return true; | |||
6535 | } | |||
6536 | ||||
6537 | void ConstructVisitor::Post(const parser::SelectRankConstruct &) { | |||
6538 | PopAssociation(); | |||
6539 | } | |||
6540 | ||||
6541 | bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) { | |||
6542 | if (x) { | |||
6543 | MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); | |||
6544 | } | |||
6545 | return true; | |||
6546 | } | |||
6547 | ||||
6548 | void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) { | |||
6549 | if (x) { | |||
6550 | // Just add an occurrence of this name; checking is done in ValidateLabels | |||
6551 | FindSymbol(*x); | |||
6552 | } | |||
6553 | } | |||
6554 | ||||
6555 | // Make a symbol for the associating entity of the current association. | |||
6556 | Symbol *ConstructVisitor::MakeAssocEntity() { | |||
6557 | Symbol *symbol{nullptr}; | |||
6558 | auto &association{GetCurrentAssociation()}; | |||
6559 | if (association.name) { | |||
6560 | symbol = &MakeSymbol(*association.name, UnknownDetails{}); | |||
6561 | if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) { | |||
6562 | Say(*association.name, // C1102 | |||
6563 | "The associate name '%s' is already used in this associate statement"_err_en_US); | |||
6564 | return nullptr; | |||
6565 | } | |||
6566 | } else if (const Symbol * | |||
6567 | whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { | |||
6568 | symbol = &MakeSymbol(whole->name()); | |||
6569 | } else { | |||
6570 | return nullptr; | |||
6571 | } | |||
6572 | if (auto &expr{association.selector.expr}) { | |||
6573 | symbol->set_details(AssocEntityDetails{common::Clone(*expr)}); | |||
6574 | } else { | |||
6575 | symbol->set_details(AssocEntityDetails{}); | |||
6576 | } | |||
6577 | return symbol; | |||
6578 | } | |||
6579 | ||||
6580 | // Set the type of symbol based on the current association selector. | |||
6581 | void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) { | |||
6582 | auto &details{symbol.get<AssocEntityDetails>()}; | |||
6583 | const MaybeExpr *pexpr{&details.expr()}; | |||
6584 | if (!*pexpr) { | |||
6585 | pexpr = &GetCurrentAssociation().selector.expr; | |||
6586 | } | |||
6587 | if (*pexpr) { | |||
6588 | const SomeExpr &expr{**pexpr}; | |||
6589 | if (std::optional<evaluate::DynamicType> type{expr.GetType()}) { | |||
6590 | if (const auto *charExpr{ | |||
6591 | evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>( | |||
6592 | expr)}) { | |||
6593 | symbol.SetType(ToDeclTypeSpec(std::move(*type), | |||
6594 | FoldExpr(common::visit( | |||
6595 | [](const auto &kindChar) { return kindChar.LEN(); }, | |||
6596 | charExpr->u)))); | |||
6597 | } else { | |||
6598 | symbol.SetType(ToDeclTypeSpec(std::move(*type))); | |||
6599 | } | |||
6600 | } else { | |||
6601 | // BOZ literals, procedure designators, &c. are not acceptable | |||
6602 | Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US); | |||
6603 | } | |||
6604 | } | |||
6605 | } | |||
6606 | ||||
6607 | // If current selector is a variable, set some of its attributes on symbol. | |||
6608 | void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) { | |||
6609 | Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)}; | |||
6610 | symbol.attrs() |= attrs & | |||
6611 | Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::CONTIGUOUS}; | |||
6612 | if (attrs.test(Attr::POINTER)) { | |||
6613 | SetImplicitAttr(symbol, Attr::TARGET); | |||
6614 | } | |||
6615 | } | |||
6616 | ||||
6617 | ConstructVisitor::Selector ConstructVisitor::ResolveSelector( | |||
6618 | const parser::Selector &x) { | |||
6619 | return common::visit(common::visitors{ | |||
6620 | [&](const parser::Expr &expr) { | |||
6621 | return Selector{expr.source, EvaluateExpr(x)}; | |||
6622 | }, | |||
6623 | [&](const parser::Variable &var) { | |||
6624 | return Selector{var.GetSource(), EvaluateExpr(x)}; | |||
6625 | }, | |||
6626 | }, | |||
6627 | x.u); | |||
6628 | } | |||
6629 | ||||
6630 | // Set the current association to the nth to the last association on the | |||
6631 | // association stack. The top of the stack is at n = 1. This allows access | |||
6632 | // to the interior of a list of associations at the top of the stack. | |||
6633 | void ConstructVisitor::SetCurrentAssociation(std::size_t n) { | |||
6634 | CHECK(n > 0 && n <= associationStack_.size())((n > 0 && n <= associationStack_.size()) || (Fortran ::common::die("CHECK(" "n > 0 && n <= associationStack_.size()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6634), false)); | |||
6635 | currentAssociation_ = &associationStack_[associationStack_.size() - n]; | |||
6636 | } | |||
6637 | ||||
6638 | ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() { | |||
6639 | CHECK(currentAssociation_)((currentAssociation_) || (Fortran::common::die("CHECK(" "currentAssociation_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6639), false)); | |||
6640 | return *currentAssociation_; | |||
6641 | } | |||
6642 | ||||
6643 | void ConstructVisitor::PushAssociation() { | |||
6644 | associationStack_.emplace_back(Association{}); | |||
6645 | currentAssociation_ = &associationStack_.back(); | |||
6646 | } | |||
6647 | ||||
6648 | void ConstructVisitor::PopAssociation(std::size_t count) { | |||
6649 | CHECK(count > 0 && count <= associationStack_.size())((count > 0 && count <= associationStack_.size( )) || (Fortran::common::die("CHECK(" "count > 0 && count <= associationStack_.size()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6649), false)); | |||
6650 | associationStack_.resize(associationStack_.size() - count); | |||
6651 | currentAssociation_ = | |||
6652 | associationStack_.empty() ? nullptr : &associationStack_.back(); | |||
6653 | } | |||
6654 | ||||
6655 | const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( | |||
6656 | evaluate::DynamicType &&type) { | |||
6657 | switch (type.category()) { | |||
6658 | SWITCH_COVERS_ALL_CASES | |||
6659 | case common::TypeCategory::Integer: | |||
6660 | case common::TypeCategory::Real: | |||
6661 | case common::TypeCategory::Complex: | |||
6662 | return context().MakeNumericType(type.category(), type.kind()); | |||
6663 | case common::TypeCategory::Logical: | |||
6664 | return context().MakeLogicalType(type.kind()); | |||
6665 | case common::TypeCategory::Derived: | |||
6666 | if (type.IsAssumedType()) { | |||
6667 | return currScope().MakeTypeStarType(); | |||
6668 | } else if (type.IsUnlimitedPolymorphic()) { | |||
6669 | return currScope().MakeClassStarType(); | |||
6670 | } else { | |||
6671 | return currScope().MakeDerivedType( | |||
6672 | type.IsPolymorphic() ? DeclTypeSpec::ClassDerived | |||
6673 | : DeclTypeSpec::TypeDerived, | |||
6674 | common::Clone(type.GetDerivedTypeSpec()) | |||
6675 | ||||
6676 | ); | |||
6677 | } | |||
6678 | case common::TypeCategory::Character: | |||
6679 | CRASH_NO_CASEFortran::common::die("no case" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6679); | |||
6680 | } | |||
6681 | } | |||
6682 | ||||
6683 | const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( | |||
6684 | evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) { | |||
6685 | CHECK(type.category() == common::TypeCategory::Character)((type.category() == common::TypeCategory::Character) || (Fortran ::common::die("CHECK(" "type.category() == common::TypeCategory::Character" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6685), false)); | |||
6686 | if (length) { | |||
6687 | return currScope().MakeCharacterType( | |||
6688 | ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len}, | |||
6689 | KindExpr{type.kind()}); | |||
6690 | } else { | |||
6691 | return currScope().MakeCharacterType( | |||
6692 | ParamValue::Deferred(common::TypeParamAttr::Len), | |||
6693 | KindExpr{type.kind()}); | |||
6694 | } | |||
6695 | } | |||
6696 | ||||
6697 | // ResolveNamesVisitor implementation | |||
6698 | ||||
6699 | bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) { | |||
6700 | HandleCall(Symbol::Flag::Function, x.v); | |||
6701 | return false; | |||
6702 | } | |||
6703 | bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) { | |||
6704 | HandleCall(Symbol::Flag::Subroutine, x.v); | |||
6705 | return false; | |||
6706 | } | |||
6707 | ||||
6708 | bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) { | |||
6709 | auto &scope{currScope()}; | |||
6710 | // Check C896 and C899: where IMPORT statements are allowed | |||
6711 | switch (scope.kind()) { | |||
6712 | case Scope::Kind::Module: | |||
6713 | if (scope.IsModule()) { | |||
6714 | Say("IMPORT is not allowed in a module scoping unit"_err_en_US); | |||
6715 | return false; | |||
6716 | } else if (x.kind == common::ImportKind::None) { | |||
6717 | Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US); | |||
6718 | return false; | |||
6719 | } | |||
6720 | break; | |||
6721 | case Scope::Kind::MainProgram: | |||
6722 | Say("IMPORT is not allowed in a main program scoping unit"_err_en_US); | |||
6723 | return false; | |||
6724 | case Scope::Kind::Subprogram: | |||
6725 | if (scope.parent().IsGlobal()) { | |||
6726 | Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US); | |||
6727 | return false; | |||
6728 | } | |||
6729 | break; | |||
6730 | case Scope::Kind::BlockData: // C1415 (in part) | |||
6731 | Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US); | |||
6732 | return false; | |||
6733 | default:; | |||
6734 | } | |||
6735 | if (auto error{scope.SetImportKind(x.kind)}) { | |||
6736 | Say(std::move(*error)); | |||
6737 | } | |||
6738 | for (auto &name : x.names) { | |||
6739 | if (FindSymbol(scope.parent(), name)) { | |||
6740 | scope.add_importName(name.source); | |||
6741 | } else { | |||
6742 | Say(name, "'%s' not found in host scope"_err_en_US); | |||
6743 | } | |||
6744 | } | |||
6745 | prevImportStmt_ = currStmtSource(); | |||
6746 | return false; | |||
6747 | } | |||
6748 | ||||
6749 | const parser::Name *DeclarationVisitor::ResolveStructureComponent( | |||
6750 | const parser::StructureComponent &x) { | |||
6751 | return FindComponent(ResolveDataRef(x.base), x.component); | |||
6752 | } | |||
6753 | ||||
6754 | const parser::Name *DeclarationVisitor::ResolveDesignator( | |||
6755 | const parser::Designator &x) { | |||
6756 | return common::visit( | |||
6757 | common::visitors{ | |||
6758 | [&](const parser::DataRef &x) { return ResolveDataRef(x); }, | |||
6759 | [&](const parser::Substring &x) { | |||
6760 | Walk(std::get<parser::SubstringRange>(x.t).t); | |||
6761 | return ResolveDataRef(std::get<parser::DataRef>(x.t)); | |||
6762 | }, | |||
6763 | }, | |||
6764 | x.u); | |||
6765 | } | |||
6766 | ||||
6767 | const parser::Name *DeclarationVisitor::ResolveDataRef( | |||
6768 | const parser::DataRef &x) { | |||
6769 | return common::visit( | |||
6770 | common::visitors{ | |||
6771 | [=](const parser::Name &y) { return ResolveName(y); }, | |||
6772 | [=](const Indirection<parser::StructureComponent> &y) { | |||
6773 | return ResolveStructureComponent(y.value()); | |||
6774 | }, | |||
6775 | [&](const Indirection<parser::ArrayElement> &y) { | |||
6776 | Walk(y.value().subscripts); | |||
6777 | const parser::Name *name{ResolveDataRef(y.value().base)}; | |||
6778 | if (name && name->symbol) { | |||
6779 | if (!IsProcedure(*name->symbol)) { | |||
6780 | ConvertToObjectEntity(*name->symbol); | |||
6781 | } else if (!context().HasError(*name->symbol)) { | |||
6782 | SayWithDecl(*name, *name->symbol, | |||
6783 | "Cannot reference function '%s' as data"_err_en_US); | |||
6784 | } | |||
6785 | } | |||
6786 | return name; | |||
6787 | }, | |||
6788 | [&](const Indirection<parser::CoindexedNamedObject> &y) { | |||
6789 | Walk(y.value().imageSelector); | |||
6790 | return ResolveDataRef(y.value().base); | |||
6791 | }, | |||
6792 | }, | |||
6793 | x.u); | |||
6794 | } | |||
6795 | ||||
6796 | // If implicit types are allowed, ensure name is in the symbol table. | |||
6797 | // Otherwise, report an error if it hasn't been declared. | |||
6798 | const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) { | |||
6799 | FindSymbol(name); | |||
6800 | if (CheckForHostAssociatedImplicit(name)) { | |||
6801 | NotePossibleBadForwardRef(name); | |||
6802 | return &name; | |||
6803 | } | |||
6804 | if (Symbol * symbol{name.symbol}) { | |||
6805 | if (CheckUseError(name)) { | |||
6806 | return nullptr; // reported an error | |||
6807 | } | |||
6808 | NotePossibleBadForwardRef(name); | |||
6809 | symbol->set(Symbol::Flag::ImplicitOrError, false); | |||
6810 | if (IsUplevelReference(*symbol)) { | |||
6811 | MakeHostAssocSymbol(name, *symbol); | |||
6812 | } else if (IsDummy(*symbol) || | |||
6813 | (!symbol->GetType() && FindCommonBlockContaining(*symbol))) { | |||
6814 | CheckEntryDummyUse(name.source, symbol); | |||
6815 | ConvertToObjectEntity(*symbol); | |||
6816 | ApplyImplicitRules(*symbol); | |||
6817 | } | |||
6818 | if (checkIndexUseInOwnBounds_ && | |||
6819 | *checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) { | |||
6820 | Say(name, | |||
6821 | "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US, | |||
6822 | name.source); | |||
6823 | } | |||
6824 | return &name; | |||
6825 | } | |||
6826 | if (isImplicitNoneType()) { | |||
6827 | Say(name, "No explicit type declared for '%s'"_err_en_US); | |||
6828 | return nullptr; | |||
6829 | } | |||
6830 | // Create the symbol then ensure it is accessible | |||
6831 | if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) { | |||
6832 | Say(name, | |||
6833 | "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US, | |||
6834 | name.source); | |||
6835 | } | |||
6836 | MakeSymbol(InclusiveScope(), name.source, Attrs{}); | |||
6837 | auto *symbol{FindSymbol(name)}; | |||
6838 | if (!symbol) { | |||
6839 | Say(name, | |||
6840 | "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US); | |||
6841 | return nullptr; | |||
6842 | } | |||
6843 | ConvertToObjectEntity(*symbol); | |||
6844 | ApplyImplicitRules(*symbol); | |||
6845 | NotePossibleBadForwardRef(name); | |||
6846 | return &name; | |||
6847 | } | |||
6848 | ||||
6849 | // A specification expression may refer to a symbol in the host procedure that | |||
6850 | // is implicitly typed. Because specification parts are processed before | |||
6851 | // execution parts, this may be the first time we see the symbol. It can't be a | |||
6852 | // local in the current scope (because it's in a specification expression) so | |||
6853 | // either it is implicitly declared in the host procedure or it is an error. | |||
6854 | // We create a symbol in the host assuming it is the former; if that proves to | |||
6855 | // be wrong we report an error later in CheckDeclarations(). | |||
6856 | bool DeclarationVisitor::CheckForHostAssociatedImplicit( | |||
6857 | const parser::Name &name) { | |||
6858 | if (!inSpecificationPart_) { | |||
6859 | return false; | |||
6860 | } | |||
6861 | if (name.symbol) { | |||
6862 | ApplyImplicitRules(*name.symbol, true); | |||
6863 | } | |||
6864 | Symbol *hostSymbol; | |||
6865 | Scope *host{GetHostProcedure()}; | |||
6866 | if (!host || isImplicitNoneType(*host)) { | |||
6867 | return false; | |||
6868 | } | |||
6869 | if (!name.symbol) { | |||
6870 | hostSymbol = &MakeSymbol(*host, name.source, Attrs{}); | |||
6871 | ConvertToObjectEntity(*hostSymbol); | |||
6872 | ApplyImplicitRules(*hostSymbol); | |||
6873 | hostSymbol->set(Symbol::Flag::ImplicitOrError); | |||
6874 | } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) { | |||
6875 | hostSymbol = name.symbol; | |||
6876 | } else { | |||
6877 | return false; | |||
6878 | } | |||
6879 | Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)}; | |||
6880 | if (isImplicitNoneType()) { | |||
6881 | symbol.get<HostAssocDetails>().implicitOrExplicitTypeError = true; | |||
6882 | } else { | |||
6883 | symbol.get<HostAssocDetails>().implicitOrSpecExprError = true; | |||
6884 | } | |||
6885 | return true; | |||
6886 | } | |||
6887 | ||||
6888 | bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) { | |||
6889 | const Scope &symbolUnit{GetProgramUnitContaining(symbol)}; | |||
6890 | if (symbolUnit == GetProgramUnitContaining(currScope())) { | |||
6891 | return false; | |||
6892 | } else { | |||
6893 | Scope::Kind kind{symbolUnit.kind()}; | |||
6894 | return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram; | |||
6895 | } | |||
6896 | } | |||
6897 | ||||
6898 | // base is a part-ref of a derived type; find the named component in its type. | |||
6899 | // Also handles intrinsic type parameter inquiries (%kind, %len) and | |||
6900 | // COMPLEX component references (%re, %im). | |||
6901 | const parser::Name *DeclarationVisitor::FindComponent( | |||
6902 | const parser::Name *base, const parser::Name &component) { | |||
6903 | if (!base || !base->symbol) { | |||
6904 | return nullptr; | |||
6905 | } | |||
6906 | if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) { | |||
6907 | if (component.source == "kind") { | |||
6908 | if (misc->kind() == MiscDetails::Kind::ComplexPartRe || | |||
6909 | misc->kind() == MiscDetails::Kind::ComplexPartIm || | |||
6910 | misc->kind() == MiscDetails::Kind::KindParamInquiry || | |||
6911 | misc->kind() == MiscDetails::Kind::LenParamInquiry) { | |||
6912 | // x%{re,im,kind,len}%kind | |||
6913 | MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry); | |||
6914 | return &component; | |||
6915 | } | |||
6916 | } | |||
6917 | } | |||
6918 | CheckEntryDummyUse(base->source, base->symbol); | |||
6919 | auto &symbol{base->symbol->GetUltimate()}; | |||
6920 | if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) { | |||
6921 | SayWithDecl(*base, symbol, | |||
6922 | "'%s' is an invalid base for a component reference"_err_en_US); | |||
6923 | return nullptr; | |||
6924 | } | |||
6925 | auto *type{symbol.GetType()}; | |||
6926 | if (!type) { | |||
6927 | return nullptr; // should have already reported error | |||
6928 | } | |||
6929 | if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) { | |||
6930 | auto category{intrinsic->category()}; | |||
6931 | MiscDetails::Kind miscKind{MiscDetails::Kind::None}; | |||
6932 | if (component.source == "kind") { | |||
6933 | miscKind = MiscDetails::Kind::KindParamInquiry; | |||
6934 | } else if (category == TypeCategory::Character) { | |||
6935 | if (component.source == "len") { | |||
6936 | miscKind = MiscDetails::Kind::LenParamInquiry; | |||
6937 | } | |||
6938 | } else if (category == TypeCategory::Complex) { | |||
6939 | if (component.source == "re") { | |||
6940 | miscKind = MiscDetails::Kind::ComplexPartRe; | |||
6941 | } else if (component.source == "im") { | |||
6942 | miscKind = MiscDetails::Kind::ComplexPartIm; | |||
6943 | } | |||
6944 | } | |||
6945 | if (miscKind != MiscDetails::Kind::None) { | |||
6946 | MakePlaceholder(component, miscKind); | |||
6947 | return &component; | |||
6948 | } | |||
6949 | } else if (DerivedTypeSpec * derived{type->AsDerived()}) { | |||
6950 | derived->Instantiate(currScope()); // in case of forward referenced type | |||
6951 | if (const Scope * scope{derived->scope()}) { | |||
6952 | if (Resolve(component, scope->FindComponent(component.source))) { | |||
6953 | if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) { | |||
6954 | context().Say(component.source, *msg); | |||
6955 | } | |||
6956 | return &component; | |||
6957 | } else { | |||
6958 | SayDerivedType(component.source, | |||
6959 | "Component '%s' not found in derived type '%s'"_err_en_US, *scope); | |||
6960 | } | |||
6961 | } | |||
6962 | return nullptr; | |||
6963 | } | |||
6964 | if (symbol.test(Symbol::Flag::Implicit)) { | |||
6965 | Say(*base, | |||
6966 | "'%s' is not an object of derived type; it is implicitly typed"_err_en_US); | |||
6967 | } else { | |||
6968 | SayWithDecl( | |||
6969 | *base, symbol, "'%s' is not an object of derived type"_err_en_US); | |||
6970 | } | |||
6971 | return nullptr; | |||
6972 | } | |||
6973 | ||||
6974 | void DeclarationVisitor::Initialization(const parser::Name &name, | |||
6975 | const parser::Initialization &init, bool inComponentDecl) { | |||
6976 | // Traversal of the initializer was deferred to here so that the | |||
6977 | // symbol being declared can be available for use in the expression, e.g.: | |||
6978 | // real, parameter :: x = tiny(x) | |||
6979 | if (!name.symbol) { | |||
6980 | return; | |||
6981 | } | |||
6982 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
6983 | // TODO: check C762 - all bounds and type parameters of component | |||
6984 | // are colons or constant expressions if component is initialized | |||
6985 | common::visit( | |||
6986 | common::visitors{ | |||
6987 | [&](const parser::ConstantExpr &expr) { | |||
6988 | NonPointerInitialization(name, expr); | |||
6989 | }, | |||
6990 | [&](const parser::NullInit &null) { // => NULL() | |||
6991 | Walk(null); | |||
6992 | if (auto nullInit{EvaluateExpr(null)}) { | |||
6993 | if (!evaluate::IsNullPointer(*nullInit)) { // C813 | |||
6994 | Say(null.v.value().source, | |||
6995 | "Pointer initializer must be intrinsic NULL()"_err_en_US); | |||
6996 | } else if (IsPointer(ultimate)) { | |||
6997 | if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
6998 | object->set_init(std::move(*nullInit)); | |||
6999 | } else if (auto *procPtr{ | |||
7000 | ultimate.detailsIf<ProcEntityDetails>()}) { | |||
7001 | procPtr->set_init(nullptr); | |||
7002 | } | |||
7003 | } else { | |||
7004 | Say(name, | |||
7005 | "Non-pointer component '%s' initialized with null pointer"_err_en_US); | |||
7006 | } | |||
7007 | } | |||
7008 | }, | |||
7009 | [&](const parser::InitialDataTarget &) { | |||
7010 | // Defer analysis to the end of the specification part | |||
7011 | // so that forward references and attribute checks like SAVE | |||
7012 | // work better. | |||
7013 | ultimate.set(Symbol::Flag::InDataStmt); | |||
7014 | }, | |||
7015 | [&](const std::list<Indirection<parser::DataStmtValue>> &values) { | |||
7016 | // Handled later in data-to-inits conversion | |||
7017 | ultimate.set(Symbol::Flag::InDataStmt); | |||
7018 | Walk(values); | |||
7019 | }, | |||
7020 | }, | |||
7021 | init.u); | |||
7022 | } | |||
7023 | ||||
7024 | void DeclarationVisitor::PointerInitialization( | |||
7025 | const parser::Name &name, const parser::InitialDataTarget &target) { | |||
7026 | if (name.symbol) { | |||
7027 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7028 | if (!context().HasError(ultimate)) { | |||
7029 | if (IsPointer(ultimate)) { | |||
7030 | if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
7031 | CHECK(!details->init())((!details->init()) || (Fortran::common::die("CHECK(" "!details->init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7031), false)); | |||
7032 | Walk(target); | |||
7033 | if (MaybeExpr expr{EvaluateExpr(target)}) { | |||
7034 | // Validation is done in declaration checking. | |||
7035 | details->set_init(std::move(*expr)); | |||
7036 | } | |||
7037 | } | |||
7038 | } else { | |||
7039 | Say(name, | |||
7040 | "'%s' is not a pointer but is initialized like one"_err_en_US); | |||
7041 | context().SetError(ultimate); | |||
7042 | } | |||
7043 | } | |||
7044 | } | |||
7045 | } | |||
7046 | void DeclarationVisitor::PointerInitialization( | |||
7047 | const parser::Name &name, const parser::ProcPointerInit &target) { | |||
7048 | if (name.symbol) { | |||
7049 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7050 | if (!context().HasError(ultimate)) { | |||
7051 | if (IsProcedurePointer(ultimate)) { | |||
7052 | auto &details{ultimate.get<ProcEntityDetails>()}; | |||
7053 | CHECK(!details.init())((!details.init()) || (Fortran::common::die("CHECK(" "!details.init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7053), false)); | |||
7054 | if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) { | |||
7055 | Walk(target); | |||
7056 | if (!CheckUseError(*targetName) && targetName->symbol) { | |||
7057 | // Validation is done in declaration checking. | |||
7058 | details.set_init(*targetName->symbol); | |||
7059 | } | |||
7060 | } else { // explicit NULL | |||
7061 | details.set_init(nullptr); | |||
7062 | } | |||
7063 | } else { | |||
7064 | Say(name, | |||
7065 | "'%s' is not a procedure pointer but is initialized " | |||
7066 | "like one"_err_en_US); | |||
7067 | context().SetError(ultimate); | |||
7068 | } | |||
7069 | } | |||
7070 | } | |||
7071 | } | |||
7072 | ||||
7073 | void DeclarationVisitor::NonPointerInitialization( | |||
7074 | const parser::Name &name, const parser::ConstantExpr &expr) { | |||
7075 | if (name.symbol) { | |||
7076 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7077 | if (!context().HasError(ultimate) && !context().HasError(name.symbol)) { | |||
7078 | if (IsPointer(ultimate)) { | |||
7079 | Say(name, | |||
7080 | "'%s' is a pointer but is not initialized like one"_err_en_US); | |||
7081 | } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
7082 | CHECK(!details->init())((!details->init()) || (Fortran::common::die("CHECK(" "!details->init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7082), false)); | |||
7083 | if (IsAllocatable(ultimate)) { | |||
7084 | Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US); | |||
7085 | return; | |||
7086 | } | |||
7087 | Walk(expr); | |||
7088 | if (ultimate.owner().IsParameterizedDerivedType()) { | |||
7089 | // Save the expression for per-instantiation analysis. | |||
7090 | details->set_unanalyzedPDTComponentInit(&expr.thing.value()); | |||
7091 | } else { | |||
7092 | if (MaybeExpr folded{EvaluateNonPointerInitializer( | |||
7093 | ultimate, expr, expr.thing.value().source)}) { | |||
7094 | details->set_init(std::move(*folded)); | |||
7095 | } | |||
7096 | } | |||
7097 | } else { | |||
7098 | Say(name, "'%s' is not an object that can be initialized"_err_en_US); | |||
7099 | } | |||
7100 | } | |||
7101 | } | |||
7102 | } | |||
7103 | ||||
7104 | void ResolveNamesVisitor::HandleCall( | |||
7105 | Symbol::Flag procFlag, const parser::Call &call) { | |||
7106 | common::visit( | |||
7107 | common::visitors{ | |||
7108 | [&](const parser::Name &x) { HandleProcedureName(procFlag, x); }, | |||
7109 | [&](const parser::ProcComponentRef &x) { | |||
7110 | Walk(x); | |||
7111 | const parser::Name &name{x.v.thing.component}; | |||
7112 | if (Symbol * symbol{name.symbol}) { | |||
7113 | if (IsProcedure(*symbol)) { | |||
7114 | SetProcFlag(name, *symbol, procFlag); | |||
7115 | } | |||
7116 | } | |||
7117 | }, | |||
7118 | }, | |||
7119 | std::get<parser::ProcedureDesignator>(call.t).u); | |||
7120 | Walk(std::get<std::list<parser::ActualArgSpec>>(call.t)); | |||
7121 | } | |||
7122 | ||||
7123 | void ResolveNamesVisitor::HandleProcedureName( | |||
7124 | Symbol::Flag flag, const parser::Name &name) { | |||
7125 | CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine)((flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine ) || (Fortran::common::die("CHECK(" "flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7125), false)); | |||
7126 | auto *symbol{FindSymbol(NonDerivedTypeScope(), name)}; | |||
7127 | if (!symbol) { | |||
7128 | if (IsIntrinsic(name.source, flag)) { | |||
7129 | symbol = | |||
7130 | &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC}); | |||
7131 | } else { | |||
7132 | symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); | |||
7133 | } | |||
7134 | Resolve(name, *symbol); | |||
7135 | if (!symbol->attrs().test(Attr::INTRINSIC)) { | |||
7136 | if (CheckImplicitNoneExternal(name.source, *symbol)) { | |||
7137 | MakeExternal(*symbol); | |||
7138 | } | |||
7139 | } | |||
7140 | CheckEntryDummyUse(name.source, symbol); | |||
7141 | ConvertToProcEntity(*symbol); | |||
7142 | SetProcFlag(name, *symbol, flag); | |||
7143 | } else if (CheckUseError(name)) { | |||
7144 | // error was reported | |||
7145 | } else { | |||
7146 | auto &nonUltimateSymbol{*symbol}; | |||
7147 | symbol = &Resolve(name, symbol)->GetUltimate(); | |||
7148 | CheckEntryDummyUse(name.source, symbol); | |||
7149 | bool convertedToProcEntity{ConvertToProcEntity(*symbol)}; | |||
7150 | if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) && | |||
7151 | IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) { | |||
7152 | AcquireIntrinsicProcedureFlags(*symbol); | |||
7153 | } | |||
7154 | if (!SetProcFlag(name, *symbol, flag)) { | |||
7155 | return; // reported error | |||
7156 | } | |||
7157 | if (!symbol->has<GenericDetails>()) { | |||
7158 | CheckImplicitNoneExternal(name.source, *symbol); | |||
7159 | } | |||
7160 | if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() || | |||
7161 | symbol->has<AssocEntityDetails>()) { | |||
7162 | // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted | |||
7163 | // here as procedure-designators because this means the related | |||
7164 | // FunctionReference are mis-parsed structure constructors or array | |||
7165 | // references that will be fixed later when analyzing expressions. | |||
7166 | } else if (symbol->has<ObjectEntityDetails>()) { | |||
7167 | // Symbols with ObjectEntityDetails are also accepted because this can be | |||
7168 | // a mis-parsed array references that will be fixed later. Ensure that if | |||
7169 | // this is a symbol from a host procedure, a symbol with HostAssocDetails | |||
7170 | // is created for the current scope. | |||
7171 | // Operate on non ultimate symbol so that HostAssocDetails are also | |||
7172 | // created for symbols used associated in the host procedure. | |||
7173 | if (IsUplevelReference(nonUltimateSymbol)) { | |||
7174 | MakeHostAssocSymbol(name, nonUltimateSymbol); | |||
7175 | } | |||
7176 | } else if (symbol->test(Symbol::Flag::Implicit)) { | |||
7177 | Say(name, | |||
7178 | "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US); | |||
7179 | } else { | |||
7180 | SayWithDecl(name, *symbol, | |||
7181 | "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); | |||
7182 | } | |||
7183 | } | |||
7184 | } | |||
7185 | ||||
7186 | bool ResolveNamesVisitor::CheckImplicitNoneExternal( | |||
7187 | const SourceName &name, const Symbol &symbol) { | |||
7188 | if (isImplicitNoneExternal() && !symbol.attrs().test(Attr::EXTERNAL) && | |||
7189 | !symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) { | |||
7190 | Say(name, | |||
7191 | "'%s' is an external procedure without the EXTERNAL" | |||
7192 | " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US); | |||
7193 | return false; | |||
7194 | } | |||
7195 | return true; | |||
7196 | } | |||
7197 | ||||
7198 | // Variant of HandleProcedureName() for use while skimming the executable | |||
7199 | // part of a subprogram to catch calls to dummy procedures that are part | |||
7200 | // of the subprogram's interface, and to mark as procedures any symbols | |||
7201 | // that might otherwise have been miscategorized as objects. | |||
7202 | void ResolveNamesVisitor::NoteExecutablePartCall( | |||
7203 | Symbol::Flag flag, const parser::Call &call) { | |||
7204 | auto &designator{std::get<parser::ProcedureDesignator>(call.t)}; | |||
7205 | if (const auto *name{std::get_if<parser::Name>(&designator.u)}) { | |||
7206 | // Subtlety: The symbol pointers in the parse tree are not set, because | |||
7207 | // they might end up resolving elsewhere (e.g., construct entities in | |||
7208 | // SELECT TYPE). | |||
7209 | if (Symbol * symbol{currScope().FindSymbol(name->source)}) { | |||
7210 | Symbol::Flag other{flag == Symbol::Flag::Subroutine | |||
7211 | ? Symbol::Flag::Function | |||
7212 | : Symbol::Flag::Subroutine}; | |||
7213 | if (!symbol->test(other)) { | |||
7214 | ConvertToProcEntity(*symbol); | |||
7215 | if (symbol->has<ProcEntityDetails>()) { | |||
7216 | symbol->set(flag); | |||
7217 | if (IsDummy(*symbol)) { | |||
7218 | SetImplicitAttr(*symbol, Attr::EXTERNAL); | |||
7219 | } | |||
7220 | ApplyImplicitRules(*symbol); | |||
7221 | } | |||
7222 | } | |||
7223 | } | |||
7224 | } | |||
7225 | } | |||
7226 | ||||
7227 | static bool IsLocallyImplicitGlobalSymbol( | |||
7228 | const Symbol &symbol, const parser::Name &localName) { | |||
7229 | return symbol.owner().IsGlobal() && | |||
7230 | (!symbol.scope() || | |||
7231 | !symbol.scope()->sourceRange().Contains(localName.source)); | |||
7232 | } | |||
7233 | ||||
7234 | static bool TypesMismatchIfNonNull( | |||
7235 | const DeclTypeSpec *type1, const DeclTypeSpec *type2) { | |||
7236 | return type1 && type2 && *type1 != *type2; | |||
7237 | } | |||
7238 | ||||
7239 | // Check and set the Function or Subroutine flag on symbol; false on error. | |||
7240 | bool ResolveNamesVisitor::SetProcFlag( | |||
7241 | const parser::Name &name, Symbol &symbol, Symbol::Flag flag) { | |||
7242 | if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) { | |||
7243 | SayWithDecl( | |||
7244 | name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); | |||
7245 | return false; | |||
7246 | } else if (symbol.test(Symbol::Flag::Subroutine) && | |||
7247 | flag == Symbol::Flag::Function) { | |||
7248 | SayWithDecl( | |||
7249 | name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US); | |||
7250 | return false; | |||
7251 | } else if (flag == Symbol::Flag::Function && | |||
7252 | IsLocallyImplicitGlobalSymbol(symbol, name) && | |||
7253 | TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) { | |||
7254 | SayWithDecl(name, symbol, | |||
7255 | "Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US); | |||
7256 | return false; | |||
7257 | } else if (symbol.has<ProcEntityDetails>()) { | |||
7258 | symbol.set(flag); // in case it hasn't been set yet | |||
7259 | if (flag == Symbol::Flag::Function) { | |||
7260 | ApplyImplicitRules(symbol); | |||
7261 | } | |||
7262 | if (symbol.attrs().test(Attr::INTRINSIC)) { | |||
7263 | AcquireIntrinsicProcedureFlags(symbol); | |||
7264 | } | |||
7265 | } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) { | |||
7266 | SayWithDecl( | |||
7267 | name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); | |||
7268 | } else if (symbol.attrs().test(Attr::INTRINSIC)) { | |||
7269 | AcquireIntrinsicProcedureFlags(symbol); | |||
7270 | } | |||
7271 | return true; | |||
7272 | } | |||
7273 | ||||
7274 | bool ModuleVisitor::Pre(const parser::AccessStmt &x) { | |||
7275 | Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))}; | |||
7276 | if (!currScope().IsModule()) { // C869 | |||
7277 | Say(currStmtSource().value(), | |||
7278 | "%s statement may only appear in the specification part of a module"_err_en_US, | |||
7279 | EnumToString(accessAttr)); | |||
7280 | return false; | |||
7281 | } | |||
7282 | const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)}; | |||
7283 | if (accessIds.empty()) { | |||
7284 | if (prevAccessStmt_) { // C869 | |||
7285 | Say("The default accessibility of this module has already been declared"_err_en_US) | |||
7286 | .Attach(*prevAccessStmt_, "Previous declaration"_en_US); | |||
7287 | } | |||
7288 | prevAccessStmt_ = currStmtSource(); | |||
7289 | defaultAccess_ = accessAttr; | |||
7290 | } else { | |||
7291 | for (const auto &accessId : accessIds) { | |||
7292 | GenericSpecInfo info{accessId.v.value()}; | |||
7293 | auto *symbol{FindInScope(info.symbolName())}; | |||
7294 | if (!symbol && !info.kind().IsName()) { | |||
7295 | symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{}); | |||
7296 | } | |||
7297 | info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol)); | |||
7298 | } | |||
7299 | } | |||
7300 | return false; | |||
7301 | } | |||
7302 | ||||
7303 | // Set the access specification for this symbol. | |||
7304 | Symbol &ModuleVisitor::SetAccess( | |||
7305 | const SourceName &name, Attr attr, Symbol *symbol) { | |||
7306 | if (!symbol) { | |||
7307 | symbol = &MakeSymbol(name); | |||
7308 | } | |||
7309 | Attrs &attrs{symbol->attrs()}; | |||
7310 | if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
7311 | // PUBLIC/PRIVATE already set: make it a fatal error if it changed | |||
7312 | Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE; | |||
7313 | Say(name, | |||
7314 | WithSeverity( | |||
7315 | "The accessibility of '%s' has already been specified as %s"_warn_en_US, | |||
7316 | attr != prev ? parser::Severity::Error : parser::Severity::Warning), | |||
7317 | MakeOpName(name), EnumToString(prev)); | |||
7318 | } else { | |||
7319 | attrs.set(attr); | |||
7320 | } | |||
7321 | return *symbol; | |||
7322 | } | |||
7323 | ||||
7324 | static bool NeedsExplicitType(const Symbol &symbol) { | |||
7325 | if (symbol.has<UnknownDetails>()) { | |||
7326 | return true; | |||
7327 | } else if (const auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
7328 | return !details->type(); | |||
7329 | } else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { | |||
7330 | return !details->type(); | |||
7331 | } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) { | |||
7332 | return !details->procInterface() && !details->type(); | |||
7333 | } else { | |||
7334 | return false; | |||
7335 | } | |||
7336 | } | |||
7337 | ||||
7338 | bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) { | |||
7339 | const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts, | |||
7340 | implicitPart, decls] = x.t; | |||
7341 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)}; | |||
7342 | auto stateRestorer{ | |||
7343 | common::ScopedSet(specPartState_, SpecificationPartState{})}; | |||
7344 | Walk(accDecls); | |||
7345 | Walk(ompDecls); | |||
7346 | Walk(compilerDirectives); | |||
7347 | Walk(useStmts); | |||
7348 | ClearUseRenames(); | |||
7349 | ClearUseOnly(); | |||
7350 | ClearExplicitIntrinsicUses(); | |||
7351 | Walk(importStmts); | |||
7352 | Walk(implicitPart); | |||
7353 | for (const auto &decl : decls) { | |||
7354 | if (const auto *spec{ | |||
7355 | std::get_if<parser::SpecificationConstruct>(&decl.u)}) { | |||
7356 | PreSpecificationConstruct(*spec); | |||
7357 | } | |||
7358 | } | |||
7359 | Walk(decls); | |||
7360 | FinishSpecificationPart(decls); | |||
7361 | return false; | |||
7362 | } | |||
7363 | ||||
7364 | // Initial processing on specification constructs, before visiting them. | |||
7365 | void ResolveNamesVisitor::PreSpecificationConstruct( | |||
7366 | const parser::SpecificationConstruct &spec) { | |||
7367 | common::visit( | |||
7368 | common::visitors{ | |||
7369 | [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) { | |||
7370 | CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t)); | |||
7371 | }, | |||
7372 | [&](const Indirection<parser::InterfaceBlock> &y) { | |||
7373 | const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>( | |||
7374 | y.value().t)}; | |||
7375 | if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) { | |||
7376 | CreateGeneric(*spec); | |||
7377 | } | |||
7378 | }, | |||
7379 | [&](const parser::Statement<parser::OtherSpecificationStmt> &y) { | |||
7380 | if (const auto *commonStmt{parser::Unwrap<parser::CommonStmt>(y)}) { | |||
7381 | CreateCommonBlockSymbols(*commonStmt); | |||
7382 | } | |||
7383 | }, | |||
7384 | [&](const auto &) {}, | |||
7385 | }, | |||
7386 | spec.u); | |||
7387 | } | |||
7388 | ||||
7389 | void ResolveNamesVisitor::CreateCommonBlockSymbols( | |||
7390 | const parser::CommonStmt &commonStmt) { | |||
7391 | for (const parser::CommonStmt::Block &block : commonStmt.blocks) { | |||
7392 | const auto &[name, objects] = block.t; | |||
7393 | Symbol &commonBlock{MakeCommonBlockSymbol(name)}; | |||
7394 | for (const auto &object : objects) { | |||
7395 | Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))}; | |||
7396 | if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) { | |||
7397 | details->set_commonBlock(commonBlock); | |||
7398 | commonBlock.get<CommonBlockDetails>().add_object(obj); | |||
7399 | } | |||
7400 | } | |||
7401 | } | |||
7402 | } | |||
7403 | ||||
7404 | void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) { | |||
7405 | auto info{GenericSpecInfo{x}}; | |||
7406 | SourceName symbolName{info.symbolName()}; | |||
7407 | if (IsLogicalConstant(context(), symbolName)) { | |||
7408 | Say(symbolName, | |||
7409 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
7410 | return; | |||
7411 | } | |||
7412 | GenericDetails genericDetails; | |||
7413 | Symbol *existing{nullptr}; | |||
7414 | // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)" | |||
7415 | for (const std::string &n : GetAllNames(context(), symbolName)) { | |||
7416 | existing = currScope().FindSymbol(SourceName{n}); | |||
7417 | if (existing) { | |||
7418 | break; | |||
7419 | } | |||
7420 | } | |||
7421 | if (existing) { | |||
7422 | Symbol &ultimate{existing->GetUltimate()}; | |||
7423 | if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) { | |||
7424 | if (const auto *existingUse{existing->detailsIf<UseDetails>()}) { | |||
7425 | // Create a local copy of a use associated generic so that | |||
7426 | // it can be locally extended without corrupting the original. | |||
7427 | genericDetails.CopyFrom(*existingGeneric); | |||
7428 | if (existingGeneric->specific()) { | |||
7429 | genericDetails.set_specific(*existingGeneric->specific()); | |||
7430 | } | |||
7431 | AddGenericUse(genericDetails, existing->name(), existingUse->symbol()); | |||
7432 | } else if (&existing->owner() == &currScope()) { | |||
7433 | if (existing == &ultimate) { | |||
7434 | // Extending an extant generic in the same scope | |||
7435 | info.Resolve(existing); | |||
7436 | return; | |||
7437 | } else { | |||
7438 | // Host association of a generic is handled elsewhere | |||
7439 | CHECK(existing->has<HostAssocDetails>())((existing->has<HostAssocDetails>()) || (Fortran::common ::die("CHECK(" "existing->has<HostAssocDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 7439) , false)); | |||
7440 | } | |||
7441 | } | |||
7442 | } else if (ultimate.has<SubprogramDetails>() || | |||
7443 | ultimate.has<SubprogramNameDetails>()) { | |||
7444 | genericDetails.set_specific(*existing); | |||
7445 | } else if (ultimate.has<DerivedTypeDetails>()) { | |||
7446 | genericDetails.set_derivedType(*existing); | |||
7447 | } else if (&existing->owner() == &currScope()) { | |||
7448 | SayAlreadyDeclared(symbolName, *existing); | |||
7449 | return; | |||
7450 | } | |||
7451 | if (&existing->owner() == &currScope()) { | |||
7452 | EraseSymbol(*existing); | |||
7453 | } | |||
7454 | } | |||
7455 | info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails))); | |||
7456 | } | |||
7457 | ||||
7458 | void ResolveNamesVisitor::FinishSpecificationPart( | |||
7459 | const std::list<parser::DeclarationConstruct> &decls) { | |||
7460 | badStmtFuncFound_ = false; | |||
7461 | funcResultStack().CompleteFunctionResultType(); | |||
7462 | CheckImports(); | |||
7463 | bool inModule{currScope().kind() == Scope::Kind::Module}; | |||
7464 | for (auto &pair : currScope()) { | |||
7465 | auto &symbol{*pair.second}; | |||
7466 | if (NeedsExplicitType(symbol)) { | |||
7467 | ApplyImplicitRules(symbol); | |||
7468 | } | |||
7469 | if (IsDummy(symbol) && isImplicitNoneType() && | |||
7470 | symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) { | |||
7471 | Say(symbol.name(), | |||
7472 | "No explicit type declared for dummy argument '%s'"_err_en_US); | |||
7473 | context().SetError(symbol); | |||
7474 | } | |||
7475 | if (symbol.has<GenericDetails>()) { | |||
7476 | CheckGenericProcedures(symbol); | |||
7477 | } | |||
7478 | if (inModule && symbol.attrs().test(Attr::EXTERNAL) && | |||
7479 | !symbol.test(Symbol::Flag::Function) && | |||
7480 | !symbol.test(Symbol::Flag::Subroutine)) { | |||
7481 | // in a module, external proc without return type is subroutine | |||
7482 | symbol.set( | |||
7483 | symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine); | |||
7484 | } | |||
7485 | if (!symbol.has<HostAssocDetails>()) { | |||
7486 | CheckPossibleBadForwardRef(symbol); | |||
7487 | } | |||
7488 | } | |||
7489 | currScope().InstantiateDerivedTypes(); | |||
7490 | for (const auto &decl : decls) { | |||
7491 | if (const auto *statement{std::get_if< | |||
7492 | parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>( | |||
7493 | &decl.u)}) { | |||
7494 | AnalyzeStmtFunctionStmt(statement->statement.value()); | |||
7495 | } | |||
7496 | } | |||
7497 | // TODO: what about instantiations in BLOCK? | |||
7498 | CheckSaveStmts(); | |||
7499 | CheckCommonBlocks(); | |||
7500 | if (!inInterfaceBlock()) { | |||
7501 | // TODO: warn for the case where the EQUIVALENCE statement is in a | |||
7502 | // procedure declaration in an interface block | |||
7503 | CheckEquivalenceSets(); | |||
7504 | } | |||
7505 | } | |||
7506 | ||||
7507 | // Analyze the bodies of statement functions now that the symbols in this | |||
7508 | // specification part have been fully declared and implicitly typed. | |||
7509 | // (Statement function references are not allowed in specification | |||
7510 | // expressions, so it's safe to defer processing their definitions.) | |||
7511 | void ResolveNamesVisitor::AnalyzeStmtFunctionStmt( | |||
7512 | const parser::StmtFunctionStmt &stmtFunc) { | |||
7513 | const auto &name{std::get<parser::Name>(stmtFunc.t)}; | |||
7514 | Symbol *symbol{name.symbol}; | |||
7515 | auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}; | |||
7516 | if (!details || !symbol->scope()) { | |||
7517 | return; | |||
7518 | } | |||
7519 | // Resolve the symbols on the RHS of the statement function. | |||
7520 | PushScope(*symbol->scope()); | |||
7521 | const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)}; | |||
7522 | Walk(parsedExpr); | |||
7523 | PopScope(); | |||
7524 | if (auto expr{AnalyzeExpr(context(), stmtFunc)}) { | |||
7525 | if (auto type{evaluate::DynamicType::From(*symbol)}) { | |||
7526 | if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) { | |||
7527 | details->set_stmtFunction(std::move(*converted)); | |||
7528 | } else { | |||
7529 | Say(name.source, | |||
7530 | "Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US, | |||
7531 | name.source, type->AsFortran()); | |||
7532 | } | |||
7533 | } else { | |||
7534 | details->set_stmtFunction(std::move(*expr)); | |||
7535 | } | |||
7536 | } | |||
7537 | if (!details->stmtFunction()) { | |||
7538 | context().SetError(*symbol); | |||
7539 | } | |||
7540 | } | |||
7541 | ||||
7542 | void ResolveNamesVisitor::CheckImports() { | |||
7543 | auto &scope{currScope()}; | |||
7544 | switch (scope.GetImportKind()) { | |||
7545 | case common::ImportKind::None: | |||
7546 | break; | |||
7547 | case common::ImportKind::All: | |||
7548 | // C8102: all entities in host must not be hidden | |||
7549 | for (const auto &pair : scope.parent()) { | |||
7550 | auto &name{pair.first}; | |||
7551 | std::optional<SourceName> scopeName{scope.GetName()}; | |||
7552 | if (!scopeName || name != *scopeName) { | |||
7553 | CheckImport(prevImportStmt_.value(), name); | |||
7554 | } | |||
7555 | } | |||
7556 | break; | |||
7557 | case common::ImportKind::Default: | |||
7558 | case common::ImportKind::Only: | |||
7559 | // C8102: entities named in IMPORT must not be hidden | |||
7560 | for (auto &name : scope.importNames()) { | |||
7561 | CheckImport(name, name); | |||
7562 | } | |||
7563 | break; | |||
7564 | } | |||
7565 | } | |||
7566 | ||||
7567 | void ResolveNamesVisitor::CheckImport( | |||
7568 | const SourceName &location, const SourceName &name) { | |||
7569 | if (auto *symbol{FindInScope(name)}) { | |||
7570 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
7571 | if (&ultimate.owner() == &currScope()) { | |||
7572 | Say(location, "'%s' from host is not accessible"_err_en_US, name) | |||
7573 | .Attach(symbol->name(), "'%s' is hidden by this entity"_en_US, | |||
7574 | symbol->name()); | |||
7575 | } | |||
7576 | } | |||
7577 | } | |||
7578 | ||||
7579 | bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { | |||
7580 | return CheckNotInBlock("IMPLICIT") && // C1107 | |||
7581 | ImplicitRulesVisitor::Pre(x); | |||
7582 | } | |||
7583 | ||||
7584 | void ResolveNamesVisitor::Post(const parser::PointerObject &x) { | |||
7585 | common::visit(common::visitors{ | |||
7586 | [&](const parser::Name &x) { ResolveName(x); }, | |||
7587 | [&](const parser::StructureComponent &x) { | |||
7588 | ResolveStructureComponent(x); | |||
7589 | }, | |||
7590 | }, | |||
7591 | x.u); | |||
7592 | } | |||
7593 | void ResolveNamesVisitor::Post(const parser::AllocateObject &x) { | |||
7594 | common::visit(common::visitors{ | |||
7595 | [&](const parser::Name &x) { ResolveName(x); }, | |||
7596 | [&](const parser::StructureComponent &x) { | |||
7597 | ResolveStructureComponent(x); | |||
7598 | }, | |||
7599 | }, | |||
7600 | x.u); | |||
7601 | } | |||
7602 | ||||
7603 | bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) { | |||
7604 | const auto &dataRef{std::get<parser::DataRef>(x.t)}; | |||
7605 | const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)}; | |||
7606 | const auto &expr{std::get<parser::Expr>(x.t)}; | |||
7607 | ResolveDataRef(dataRef); | |||
7608 | Walk(bounds); | |||
7609 | // Resolve unrestricted specific intrinsic procedures as in "p => cos". | |||
7610 | if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) { | |||
7611 | if (NameIsKnownOrIntrinsic(*name)) { | |||
7612 | // If the name is known because it is an object entity from a host | |||
7613 | // procedure, create a host associated symbol. | |||
7614 | if (Symbol * symbol{name->symbol}; symbol && | |||
7615 | symbol->GetUltimate().has<ObjectEntityDetails>() && | |||
7616 | IsUplevelReference(*symbol)) { | |||
7617 | MakeHostAssocSymbol(*name, *symbol); | |||
7618 | } | |||
7619 | return false; | |||
7620 | } | |||
7621 | } | |||
7622 | Walk(expr); | |||
7623 | return false; | |||
7624 | } | |||
7625 | void ResolveNamesVisitor::Post(const parser::Designator &x) { | |||
7626 | ResolveDesignator(x); | |||
7627 | } | |||
7628 | void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) { | |||
7629 | Walk(std::get<parser::SubstringRange>(x.v.t).t); | |||
7630 | ResolveDataRef(std::get<parser::DataRef>(x.v.t)); | |||
7631 | } | |||
7632 | ||||
7633 | void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) { | |||
7634 | ResolveStructureComponent(x.v.thing); | |||
7635 | } | |||
7636 | void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) { | |||
7637 | DeclTypeSpecVisitor::Post(x); | |||
7638 | ConstructVisitor::Post(x); | |||
7639 | } | |||
7640 | bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) { | |||
7641 | CheckNotInBlock("STATEMENT FUNCTION"); // C1107 | |||
7642 | if (HandleStmtFunction(x)) { | |||
7643 | return false; | |||
7644 | } else { | |||
7645 | // This is an array element assignment: resolve names of indices | |||
7646 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
7647 | for (auto &name : names) { | |||
7648 | ResolveName(name); | |||
7649 | } | |||
7650 | return true; | |||
7651 | } | |||
7652 | } | |||
7653 | ||||
7654 | bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) { | |||
7655 | const parser::Name &name{x.v}; | |||
7656 | if (FindSymbol(name)) { | |||
7657 | // OK | |||
7658 | } else if (IsLogicalConstant(context(), name.source)) { | |||
7659 | Say(name, | |||
7660 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
7661 | } else { | |||
7662 | // Resolved later in expression semantics | |||
7663 | MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp); | |||
7664 | } | |||
7665 | return false; | |||
7666 | } | |||
7667 | ||||
7668 | void ResolveNamesVisitor::Post(const parser::AssignStmt &x) { | |||
7669 | if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { | |||
7670 | CheckEntryDummyUse(name->source, name->symbol); | |||
7671 | ConvertToObjectEntity(DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 7671)); | |||
7672 | } | |||
7673 | } | |||
7674 | void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) { | |||
7675 | if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { | |||
7676 | CheckEntryDummyUse(name->source, name->symbol); | |||
7677 | ConvertToObjectEntity(DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 7677)); | |||
7678 | } | |||
7679 | } | |||
7680 | ||||
7681 | bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) { | |||
7682 | if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>( | |||
7683 | x.u)) { | |||
7684 | // TODO: global directives | |||
7685 | return true; | |||
7686 | } | |||
7687 | auto root{ProgramTree::Build(x)}; | |||
7688 | SetScope(topScope_); | |||
7689 | ResolveSpecificationParts(root); | |||
7690 | FinishSpecificationParts(root); | |||
7691 | ResolveExecutionParts(root); | |||
7692 | ResolveAccParts(context(), x); | |||
7693 | ResolveOmpParts(context(), x); | |||
7694 | return false; | |||
7695 | } | |||
7696 | ||||
7697 | // References to procedures need to record that their symbols are known | |||
7698 | // to be procedures, so that they don't get converted to objects by default. | |||
7699 | class ExecutionPartSkimmer { | |||
7700 | public: | |||
7701 | explicit ExecutionPartSkimmer(ResolveNamesVisitor &resolver) | |||
7702 | : resolver_{resolver} {} | |||
7703 | ||||
7704 | void Walk(const parser::ExecutionPart *exec) { | |||
7705 | if (exec) { | |||
7706 | parser::Walk(*exec, *this); | |||
7707 | } | |||
7708 | } | |||
7709 | ||||
7710 | template <typename A> bool Pre(const A &) { return true; } | |||
7711 | template <typename A> void Post(const A &) {} | |||
7712 | void Post(const parser::FunctionReference &fr) { | |||
7713 | resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v); | |||
7714 | } | |||
7715 | void Post(const parser::CallStmt &cs) { | |||
7716 | resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.v); | |||
7717 | } | |||
7718 | ||||
7719 | private: | |||
7720 | ResolveNamesVisitor &resolver_; | |||
7721 | }; | |||
7722 | ||||
7723 | // Build the scope tree and resolve names in the specification parts of this | |||
7724 | // node and its children | |||
7725 | void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) { | |||
7726 | if (node.isSpecificationPartResolved()) { | |||
7727 | return; // been here already | |||
7728 | } | |||
7729 | node.set_isSpecificationPartResolved(); | |||
7730 | if (!BeginScopeForNode(node)) { | |||
7731 | return; // an error prevented scope from being created | |||
7732 | } | |||
7733 | Scope &scope{currScope()}; | |||
7734 | node.set_scope(scope); | |||
7735 | AddSubpNames(node); | |||
7736 | common::visit( | |||
7737 | [&](const auto *x) { | |||
7738 | if (x) { | |||
7739 | Walk(*x); | |||
7740 | } | |||
7741 | }, | |||
7742 | node.stmt()); | |||
7743 | Walk(node.spec()); | |||
7744 | // If this is a function, convert result to an object. This is to prevent the | |||
7745 | // result from being converted later to a function symbol if it is called | |||
7746 | // inside the function. | |||
7747 | // If the result is function pointer, then ConvertToObjectEntity will not | |||
7748 | // convert the result to an object, and calling the symbol inside the function | |||
7749 | // will result in calls to the result pointer. | |||
7750 | // A function cannot be called recursively if RESULT was not used to define a | |||
7751 | // distinct result name (15.6.2.2 point 4.). | |||
7752 | if (Symbol * symbol{scope.symbol()}) { | |||
7753 | if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { | |||
7754 | if (details->isFunction()) { | |||
7755 | ConvertToObjectEntity(const_cast<Symbol &>(details->result())); | |||
7756 | } | |||
7757 | } | |||
7758 | } | |||
7759 | if (node.IsModule()) { | |||
7760 | ApplyDefaultAccess(); | |||
7761 | } | |||
7762 | for (auto &child : node.children()) { | |||
7763 | ResolveSpecificationParts(child); | |||
7764 | } | |||
7765 | ExecutionPartSkimmer{*this}.Walk(node.exec()); | |||
7766 | EndScopeForNode(node); | |||
7767 | // Ensure that every object entity has a type. | |||
7768 | for (auto &pair : *node.scope()) { | |||
7769 | ApplyImplicitRules(*pair.second); | |||
7770 | } | |||
7771 | } | |||
7772 | ||||
7773 | // Add SubprogramNameDetails symbols for module and internal subprograms and | |||
7774 | // their ENTRY statements. | |||
7775 | void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) { | |||
7776 | auto kind{ | |||
7777 | node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal}; | |||
7778 | for (auto &child : node.children()) { | |||
7779 | auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})}; | |||
7780 | if (child.HasModulePrefix()) { | |||
7781 | SetExplicitAttr(symbol, Attr::MODULE); | |||
7782 | } | |||
7783 | auto childKind{child.GetKind()}; | |||
7784 | if (childKind == ProgramTree::Kind::Function) { | |||
7785 | symbol.set(Symbol::Flag::Function); | |||
7786 | } else if (childKind == ProgramTree::Kind::Subroutine) { | |||
7787 | symbol.set(Symbol::Flag::Subroutine); | |||
7788 | } else { | |||
7789 | continue; // make ENTRY symbols only where valid | |||
7790 | } | |||
7791 | for (const auto &entryStmt : child.entryStmts()) { | |||
7792 | SubprogramNameDetails details{kind, child}; | |||
7793 | auto &symbol{ | |||
7794 | MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))}; | |||
7795 | symbol.set(child.GetSubpFlag()); | |||
7796 | if (child.HasModulePrefix()) { | |||
7797 | SetExplicitAttr(symbol, Attr::MODULE); | |||
7798 | } | |||
7799 | } | |||
7800 | } | |||
7801 | for (const auto &generic : node.genericSpecs()) { | |||
7802 | if (const auto *name{std::get_if<parser::Name>(&generic->u)}) { | |||
7803 | if (currScope().find(name->source) != currScope().end()) { | |||
7804 | // If this scope has both a generic interface and a contained | |||
7805 | // subprogram with the same name, create the generic's symbol | |||
7806 | // now so that any other generics of the same name that are pulled | |||
7807 | // into scope later via USE association will properly merge instead | |||
7808 | // of raising a bogus error due a conflict with the subprogram. | |||
7809 | CreateGeneric(*generic); | |||
7810 | } | |||
7811 | } | |||
7812 | } | |||
7813 | } | |||
7814 | ||||
7815 | // Push a new scope for this node or return false on error. | |||
7816 | bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) { | |||
7817 | switch (node.GetKind()) { | |||
7818 | SWITCH_COVERS_ALL_CASES | |||
7819 | case ProgramTree::Kind::Program: | |||
7820 | PushScope(Scope::Kind::MainProgram, | |||
7821 | &MakeSymbol(node.name(), MainProgramDetails{})); | |||
7822 | return true; | |||
7823 | case ProgramTree::Kind::Function: | |||
7824 | case ProgramTree::Kind::Subroutine: | |||
7825 | return BeginSubprogram(node.name(), node.GetSubpFlag(), | |||
7826 | node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts()); | |||
7827 | case ProgramTree::Kind::MpSubprogram: | |||
7828 | return BeginMpSubprogram(node.name()); | |||
7829 | case ProgramTree::Kind::Module: | |||
7830 | BeginModule(node.name(), false); | |||
7831 | return true; | |||
7832 | case ProgramTree::Kind::Submodule: | |||
7833 | return BeginSubmodule(node.name(), node.GetParentId()); | |||
7834 | case ProgramTree::Kind::BlockData: | |||
7835 | PushBlockDataScope(node.name()); | |||
7836 | return true; | |||
7837 | } | |||
7838 | } | |||
7839 | ||||
7840 | void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) { | |||
7841 | std::optional<parser::CharBlock> stmtSource; | |||
7842 | const std::optional<parser::LanguageBindingSpec> *binding{nullptr}; | |||
7843 | common::visit( | |||
7844 | common::visitors{ | |||
7845 | [&](const parser::Statement<parser::FunctionStmt> *stmt) { | |||
7846 | if (stmt) { | |||
7847 | stmtSource = stmt->source; | |||
7848 | if (const auto &maybeSuffix{ | |||
7849 | std::get<std::optional<parser::Suffix>>( | |||
7850 | stmt->statement.t)}) { | |||
7851 | binding = &maybeSuffix->binding; | |||
7852 | } | |||
7853 | } | |||
7854 | }, | |||
7855 | [&](const parser::Statement<parser::SubroutineStmt> *stmt) { | |||
7856 | if (stmt) { | |||
7857 | stmtSource = stmt->source; | |||
7858 | binding = &std::get<std::optional<parser::LanguageBindingSpec>>( | |||
7859 | stmt->statement.t); | |||
7860 | } | |||
7861 | }, | |||
7862 | [](const auto *) {}, | |||
7863 | }, | |||
7864 | node.stmt()); | |||
7865 | EndSubprogram(stmtSource, binding, &node.entryStmts()); | |||
7866 | } | |||
7867 | ||||
7868 | // Some analyses and checks, such as the processing of initializers of | |||
7869 | // pointers, are deferred until all of the pertinent specification parts | |||
7870 | // have been visited. This deferred processing enables the use of forward | |||
7871 | // references in these circumstances. | |||
7872 | class DeferredCheckVisitor { | |||
7873 | public: | |||
7874 | explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver) | |||
7875 | : resolver_{resolver} {} | |||
7876 | ||||
7877 | template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } | |||
7878 | ||||
7879 | template <typename A> bool Pre(const A &) { return true; } | |||
7880 | template <typename A> void Post(const A &) {} | |||
7881 | ||||
7882 | void Post(const parser::DerivedTypeStmt &x) { | |||
7883 | const auto &name{std::get<parser::Name>(x.t)}; | |||
7884 | if (Symbol * symbol{name.symbol}) { | |||
7885 | if (Scope * scope{symbol->scope()}) { | |||
7886 | if (scope->IsDerivedType()) { | |||
7887 | resolver_.PushScope(*scope); | |||
7888 | pushedScope_ = true; | |||
7889 | } | |||
7890 | } | |||
7891 | } | |||
7892 | } | |||
7893 | void Post(const parser::EndTypeStmt &) { | |||
7894 | if (pushedScope_) { | |||
7895 | resolver_.PopScope(); | |||
7896 | pushedScope_ = false; | |||
7897 | } | |||
7898 | } | |||
7899 | ||||
7900 | void Post(const parser::ProcInterface &pi) { | |||
7901 | if (const auto *name{std::get_if<parser::Name>(&pi.u)}) { | |||
7902 | resolver_.CheckExplicitInterface(*name); | |||
7903 | } | |||
7904 | } | |||
7905 | bool Pre(const parser::EntityDecl &decl) { | |||
7906 | Init(std::get<parser::Name>(decl.t), | |||
7907 | std::get<std::optional<parser::Initialization>>(decl.t)); | |||
7908 | return false; | |||
7909 | } | |||
7910 | bool Pre(const parser::ComponentDecl &decl) { | |||
7911 | Init(std::get<parser::Name>(decl.t), | |||
7912 | std::get<std::optional<parser::Initialization>>(decl.t)); | |||
7913 | return false; | |||
7914 | } | |||
7915 | bool Pre(const parser::ProcDecl &decl) { | |||
7916 | if (const auto &init{ | |||
7917 | std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) { | |||
7918 | resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init); | |||
7919 | } | |||
7920 | return false; | |||
7921 | } | |||
7922 | void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) { | |||
7923 | resolver_.CheckExplicitInterface(tbps.interfaceName); | |||
7924 | } | |||
7925 | void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { | |||
7926 | if (pushedScope_) { | |||
7927 | resolver_.CheckBindings(tbps); | |||
7928 | } | |||
7929 | } | |||
7930 | bool Pre(const parser::StmtFunctionStmt &stmtFunc) { return false; } | |||
7931 | ||||
7932 | private: | |||
7933 | void Init(const parser::Name &name, | |||
7934 | const std::optional<parser::Initialization> &init) { | |||
7935 | if (init) { | |||
7936 | if (const auto *target{ | |||
7937 | std::get_if<parser::InitialDataTarget>(&init->u)}) { | |||
7938 | resolver_.PointerInitialization(name, *target); | |||
7939 | } | |||
7940 | } | |||
7941 | } | |||
7942 | ||||
7943 | ResolveNamesVisitor &resolver_; | |||
7944 | bool pushedScope_{false}; | |||
7945 | }; | |||
7946 | ||||
7947 | // Perform checks and completions that need to happen after all of | |||
7948 | // the specification parts but before any of the execution parts. | |||
7949 | void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) { | |||
7950 | if (!node.scope()) { | |||
7951 | return; // error occurred creating scope | |||
7952 | } | |||
7953 | SetScope(*node.scope()); | |||
7954 | // The initializers of pointers, the default initializers of pointer | |||
7955 | // components, non-deferred type-bound procedure bindings have not | |||
7956 | // yet been traversed. | |||
7957 | // We do that now, when any (formerly) forward references that appear | |||
7958 | // in those initializers will resolve to the right symbols without | |||
7959 | // incurring spurious errors with IMPLICIT NONE. | |||
7960 | DeferredCheckVisitor{*this}.Walk(node.spec()); | |||
7961 | DeferredCheckVisitor{*this}.Walk(node.exec()); // for BLOCK | |||
7962 | for (Scope &childScope : currScope().children()) { | |||
7963 | if (childScope.IsParameterizedDerivedTypeInstantiation()) { | |||
7964 | FinishDerivedTypeInstantiation(childScope); | |||
7965 | } | |||
7966 | } | |||
7967 | for (const auto &child : node.children()) { | |||
7968 | FinishSpecificationParts(child); | |||
7969 | } | |||
7970 | } | |||
7971 | ||||
7972 | // Duplicate and fold component object pointer default initializer designators | |||
7973 | // using the actual type parameter values of each particular instantiation. | |||
7974 | // Validation is done later in declaration checking. | |||
7975 | void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) { | |||
7976 | CHECK(scope.IsDerivedType() && !scope.symbol())((scope.IsDerivedType() && !scope.symbol()) || (Fortran ::common::die("CHECK(" "scope.IsDerivedType() && !scope.symbol()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7976), false)); | |||
7977 | if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) { | |||
7978 | spec->Instantiate(currScope()); | |||
7979 | const Symbol &origTypeSymbol{spec->typeSymbol()}; | |||
7980 | if (const Scope * origTypeScope{origTypeSymbol.scope()}) { | |||
7981 | CHECK(origTypeScope->IsDerivedType() &&((origTypeScope->IsDerivedType() && origTypeScope-> symbol() == &origTypeSymbol) || (Fortran::common::die("CHECK(" "origTypeScope->IsDerivedType() && origTypeScope->symbol() == &origTypeSymbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7982), false)) | |||
7982 | origTypeScope->symbol() == &origTypeSymbol)((origTypeScope->IsDerivedType() && origTypeScope-> symbol() == &origTypeSymbol) || (Fortran::common::die("CHECK(" "origTypeScope->IsDerivedType() && origTypeScope->symbol() == &origTypeSymbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7982), false)); | |||
7983 | auto &foldingContext{GetFoldingContext()}; | |||
7984 | auto restorer{foldingContext.WithPDTInstance(*spec)}; | |||
7985 | for (auto &pair : scope) { | |||
7986 | Symbol &comp{*pair.second}; | |||
7987 | const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))Fortran::common::Deref(FindInScope(*origTypeScope, comp.name( )), "flang/lib/Semantics/resolve-names.cpp", 7987)}; | |||
7988 | if (IsPointer(comp)) { | |||
7989 | if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) { | |||
7990 | auto origDetails{origComp.get<ObjectEntityDetails>()}; | |||
7991 | if (const MaybeExpr & init{origDetails.init()}) { | |||
7992 | SomeExpr newInit{*init}; | |||
7993 | MaybeExpr folded{ | |||
7994 | evaluate::Fold(foldingContext, std::move(newInit))}; | |||
7995 | details->set_init(std::move(folded)); | |||
7996 | } | |||
7997 | } | |||
7998 | } | |||
7999 | } | |||
8000 | } | |||
8001 | } | |||
8002 | } | |||
8003 | ||||
8004 | // Resolve names in the execution part of this node and its children | |||
8005 | void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) { | |||
8006 | if (!node.scope()) { | |||
8007 | return; // error occurred creating scope | |||
8008 | } | |||
8009 | SetScope(*node.scope()); | |||
8010 | if (const auto *exec{node.exec()}) { | |||
8011 | Walk(*exec); | |||
8012 | } | |||
8013 | FinishNamelists(); | |||
8014 | PopScope(); // converts unclassified entities into objects | |||
8015 | for (const auto &child : node.children()) { | |||
8016 | ResolveExecutionParts(child); | |||
8017 | } | |||
8018 | } | |||
8019 | ||||
8020 | void ResolveNamesVisitor::Post(const parser::Program &) { | |||
8021 | // ensure that all temps were deallocated | |||
8022 | CHECK(!attrs_)((!attrs_) || (Fortran::common::die("CHECK(" "!attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 8022) , false)); | |||
8023 | CHECK(!GetDeclTypeSpec())((!GetDeclTypeSpec()) || (Fortran::common::die("CHECK(" "!GetDeclTypeSpec()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 8023), false)); | |||
8024 | } | |||
8025 | ||||
8026 | // A singleton instance of the scope -> IMPLICIT rules mapping is | |||
8027 | // shared by all instances of ResolveNamesVisitor and accessed by this | |||
8028 | // pointer when the visitors (other than the top-level original) are | |||
8029 | // constructed. | |||
8030 | static ImplicitRulesMap *sharedImplicitRulesMap{nullptr}; | |||
8031 | ||||
8032 | bool ResolveNames( | |||
8033 | SemanticsContext &context, const parser::Program &program, Scope &top) { | |||
8034 | ImplicitRulesMap implicitRulesMap; | |||
8035 | auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)}; | |||
8036 | ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program); | |||
8037 | return !context.AnyFatalError(); | |||
8038 | } | |||
8039 | ||||
8040 | // Processes a module (but not internal) function when it is referenced | |||
8041 | // in a specification expression in a sibling procedure. | |||
8042 | void ResolveSpecificationParts( | |||
8043 | SemanticsContext &context, const Symbol &subprogram) { | |||
8044 | auto originalLocation{context.location()}; | |||
8045 | ImplicitRulesMap implicitRulesMap; | |||
8046 | bool localImplicitRulesMap{false}; | |||
8047 | if (!sharedImplicitRulesMap) { | |||
8048 | sharedImplicitRulesMap = &implicitRulesMap; | |||
8049 | localImplicitRulesMap = true; | |||
8050 | } | |||
8051 | ResolveNamesVisitor visitor{ | |||
8052 | context, *sharedImplicitRulesMap, context.globalScope()}; | |||
8053 | const auto &details{subprogram.get<SubprogramNameDetails>()}; | |||
8054 | ProgramTree &node{details.node()}; | |||
8055 | const Scope &moduleScope{subprogram.owner()}; | |||
8056 | if (localImplicitRulesMap) { | |||
8057 | visitor.BeginScope(const_cast<Scope &>(moduleScope)); | |||
8058 | } else { | |||
8059 | visitor.SetScope(const_cast<Scope &>(moduleScope)); | |||
8060 | } | |||
8061 | visitor.ResolveSpecificationParts(node); | |||
8062 | context.set_location(std::move(originalLocation)); | |||
8063 | if (localImplicitRulesMap) { | |||
8064 | sharedImplicitRulesMap = nullptr; | |||
8065 | } | |||
8066 | } | |||
8067 | ||||
8068 | } // namespace Fortran::semantics |
1 | //===-- include/flang/Parser/parse-tree-visitor.h ---------------*- C++ -*-===// |
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #ifndef FORTRAN_PARSER_PARSE_TREE_VISITOR_H_ |
10 | #define FORTRAN_PARSER_PARSE_TREE_VISITOR_H_ |
11 | |
12 | #include "parse-tree.h" |
13 | #include "flang/Common/visit.h" |
14 | #include <cstddef> |
15 | #include <optional> |
16 | #include <tuple> |
17 | #include <utility> |
18 | #include <variant> |
19 | |
20 | /// Parse tree visitor |
21 | /// Call Walk(x, visitor) to visit x and, by default, each node under x. |
22 | /// If x is non-const, the visitor member functions can modify the tree. |
23 | /// |
24 | /// visitor.Pre(x) is called before visiting x and its children are not |
25 | /// visited if it returns false. |
26 | /// |
27 | /// visitor.Post(x) is called after visiting x. |
28 | |
29 | namespace Fortran::parser { |
30 | |
31 | // Default case for visitation of non-class data members, strings, and |
32 | // any other non-decomposable values. |
33 | template <typename A, typename V> |
34 | std::enable_if_t<!std::is_class_v<A> || std::is_same_v<std::string, A> || |
35 | std::is_same_v<CharBlock, A>> |
36 | Walk(const A &x, V &visitor) { |
37 | if (visitor.Pre(x)) { |
38 | visitor.Post(x); |
39 | } |
40 | } |
41 | template <typename A, typename M> |
42 | std::enable_if_t<!std::is_class_v<A> || std::is_same_v<std::string, A> || |
43 | std::is_same_v<CharBlock, A>> |
44 | Walk(A &x, M &mutator) { |
45 | if (mutator.Pre(x)) { |
46 | mutator.Post(x); |
47 | } |
48 | } |
49 | |
50 | template <typename V> void Walk(const format::ControlEditDesc &, V &); |
51 | template <typename M> void Walk(format::ControlEditDesc &, M &); |
52 | template <typename V> void Walk(const format::DerivedTypeDataEditDesc &, V &); |
53 | template <typename M> void Walk(format::DerivedTypeDataEditDesc &, M &); |
54 | template <typename V> void Walk(const format::FormatItem &, V &); |
55 | template <typename M> void Walk(format::FormatItem &, M &); |
56 | template <typename V> void Walk(const format::FormatSpecification &, V &); |
57 | template <typename M> void Walk(format::FormatSpecification &, M &); |
58 | template <typename V> void Walk(const format::IntrinsicTypeDataEditDesc &, V &); |
59 | template <typename M> void Walk(format::IntrinsicTypeDataEditDesc &, M &); |
60 | |
61 | // Traversal of needed STL template classes (optional, list, tuple, variant) |
62 | template <typename T, typename V> |
63 | void Walk(const std::optional<T> &x, V &visitor) { |
64 | if (x) { |
65 | Walk(*x, visitor); |
66 | } |
67 | } |
68 | template <typename T, typename M> void Walk(std::optional<T> &x, M &mutator) { |
69 | if (x) { |
70 | Walk(*x, mutator); |
71 | } |
72 | } |
73 | // For most lists, just traverse the elements; but when a list constitutes |
74 | // a Block (i.e., std::list<ExecutionPartConstruct>), also invoke the |
75 | // visitor/mutator on the list itself. |
76 | template <typename T, typename V> void Walk(const std::list<T> &x, V &visitor) { |
77 | for (const auto &elem : x) { |
78 | Walk(elem, visitor); |
79 | } |
80 | } |
81 | template <typename T, typename M> void Walk(std::list<T> &x, M &mutator) { |
82 | for (auto &elem : x) { |
83 | Walk(elem, mutator); |
84 | } |
85 | } |
86 | template <typename V> void Walk(const Block &x, V &visitor) { |
87 | if (visitor.Pre(x)) { |
88 | for (const auto &elem : x) { |
89 | Walk(elem, visitor); |
90 | } |
91 | visitor.Post(x); |
92 | } |
93 | } |
94 | template <typename M> void Walk(Block &x, M &mutator) { |
95 | if (mutator.Pre(x)) { |
96 | for (auto &elem : x) { |
97 | Walk(elem, mutator); |
98 | } |
99 | mutator.Post(x); |
100 | } |
101 | } |
102 | template <std::size_t I = 0, typename Func, typename T> |
103 | void ForEachInTuple(const T &tuple, Func func) { |
104 | func(std::get<I>(tuple)); |
105 | if constexpr (I + 1 < std::tuple_size_v<T>) { |
106 | ForEachInTuple<I + 1>(tuple, func); |
107 | } |
108 | } |
109 | template <typename V, typename... A> |
110 | void Walk(const std::tuple<A...> &x, V &visitor) { |
111 | if (sizeof...(A) > 0) { |
112 | if (visitor.Pre(x)) { |
113 | ForEachInTuple(x, [&](const auto &y) { Walk(y, visitor); }); |
114 | visitor.Post(x); |
115 | } |
116 | } |
117 | } |
118 | template <std::size_t I = 0, typename Func, typename T> |
119 | void ForEachInTuple(T &tuple, Func func) { |
120 | func(std::get<I>(tuple)); |
121 | if constexpr (I + 1 < std::tuple_size_v<T>) { |
122 | ForEachInTuple<I + 1>(tuple, func); |
123 | } |
124 | } |
125 | template <typename M, typename... A> |
126 | void Walk(std::tuple<A...> &x, M &mutator) { |
127 | if (sizeof...(A) > 0) { |
128 | if (mutator.Pre(x)) { |
129 | ForEachInTuple(x, [&](auto &y) { Walk(y, mutator); }); |
130 | mutator.Post(x); |
131 | } |
132 | } |
133 | } |
134 | template <typename V, typename... A> |
135 | void Walk(const std::variant<A...> &x, V &visitor) { |
136 | if (visitor.Pre(x)) { |
137 | common::visit([&](const auto &y) { Walk(y, visitor); }, x); |
138 | visitor.Post(x); |
139 | } |
140 | } |
141 | template <typename M, typename... A> |
142 | void Walk(std::variant<A...> &x, M &mutator) { |
143 | if (mutator.Pre(x)) { |
144 | common::visit([&](auto &y) { Walk(y, mutator); }, x); |
145 | mutator.Post(x); |
146 | } |
147 | } |
148 | template <typename A, typename B, typename V> |
149 | void Walk(const std::pair<A, B> &x, V &visitor) { |
150 | if (visitor.Pre(x)) { |
151 | Walk(x.first, visitor); |
152 | Walk(x.second, visitor); |
153 | } |
154 | } |
155 | template <typename A, typename B, typename M> |
156 | void Walk(std::pair<A, B> &x, M &mutator) { |
157 | if (mutator.Pre(x)) { |
158 | Walk(x.first, mutator); |
159 | Walk(x.second, mutator); |
160 | } |
161 | } |
162 | |
163 | // Trait-determined traversal of empty, tuple, union, wrapper, |
164 | // and constraint-checking classes. |
165 | template <typename A, typename V> |
166 | std::enable_if_t<EmptyTrait<A>> Walk(const A &x, V &visitor) { |
167 | if (visitor.Pre(x)) { |
168 | visitor.Post(x); |
169 | } |
170 | } |
171 | template <typename A, typename M> |
172 | std::enable_if_t<EmptyTrait<A>> Walk(A &x, M &mutator) { |
173 | if (mutator.Pre(x)) { |
174 | mutator.Post(x); |
175 | } |
176 | } |
177 | |
178 | template <typename A, typename V> |
179 | std::enable_if_t<TupleTrait<A>> Walk(const A &x, V &visitor) { |
180 | if (visitor.Pre(x)) { |
181 | Walk(x.t, visitor); |
182 | visitor.Post(x); |
183 | } |
184 | } |
185 | template <typename A, typename M> |
186 | std::enable_if_t<TupleTrait<A>> Walk(A &x, M &mutator) { |
187 | if (mutator.Pre(x)) { |
188 | Walk(x.t, mutator); |
189 | mutator.Post(x); |
190 | } |
191 | } |
192 | |
193 | template <typename A, typename V> |
194 | std::enable_if_t<UnionTrait<A>> Walk(const A &x, V &visitor) { |
195 | if (visitor.Pre(x)) { |
196 | Walk(x.u, visitor); |
197 | visitor.Post(x); |
198 | } |
199 | } |
200 | template <typename A, typename M> |
201 | std::enable_if_t<UnionTrait<A>> Walk(A &x, M &mutator) { |
202 | if (mutator.Pre(x)) { |
203 | Walk(x.u, mutator); |
204 | mutator.Post(x); |
205 | } |
206 | } |
207 | |
208 | template <typename A, typename V> |
209 | std::enable_if_t<WrapperTrait<A>> Walk(const A &x, V &visitor) { |
210 | if (visitor.Pre(x)) { |
211 | Walk(x.v, visitor); |
212 | visitor.Post(x); |
213 | } |
214 | } |
215 | template <typename A, typename M> |
216 | std::enable_if_t<WrapperTrait<A>> Walk(A &x, M &mutator) { |
217 | if (mutator.Pre(x)) { |
218 | Walk(x.v, mutator); |
219 | mutator.Post(x); |
220 | } |
221 | } |
222 | |
223 | template <typename A, typename V> |
224 | std::enable_if_t<ConstraintTrait<A>> Walk(const A &x, V &visitor) { |
225 | if (visitor.Pre(x)) { |
226 | Walk(x.thing, visitor); |
227 | visitor.Post(x); |
228 | } |
229 | } |
230 | template <typename A, typename M> |
231 | std::enable_if_t<ConstraintTrait<A>> Walk(A &x, M &mutator) { |
232 | if (mutator.Pre(x)) { |
233 | Walk(x.thing, mutator); |
234 | mutator.Post(x); |
235 | } |
236 | } |
237 | |
238 | template <typename T, typename V> |
239 | void Walk(const common::Indirection<T> &x, V &visitor) { |
240 | Walk(x.value(), visitor); |
241 | } |
242 | template <typename T, typename M> |
243 | void Walk(common::Indirection<T> &x, M &mutator) { |
244 | Walk(x.value(), mutator); |
245 | } |
246 | |
247 | template <typename T, typename V> void Walk(const Statement<T> &x, V &visitor) { |
248 | if (visitor.Pre(x)) { |
249 | // N.B. The label, if any, is not visited. |
250 | Walk(x.source, visitor); |
251 | Walk(x.statement, visitor); |
252 | visitor.Post(x); |
253 | } |
254 | } |
255 | template <typename T, typename M> void Walk(Statement<T> &x, M &mutator) { |
256 | if (mutator.Pre(x)) { |
257 | // N.B. The label, if any, is not visited. |
258 | Walk(x.source, mutator); |
259 | Walk(x.statement, mutator); |
260 | mutator.Post(x); |
261 | } |
262 | } |
263 | |
264 | template <typename T, typename V> |
265 | void Walk(const UnlabeledStatement<T> &x, V &visitor) { |
266 | if (visitor.Pre(x)) { |
267 | Walk(x.source, visitor); |
268 | Walk(x.statement, visitor); |
269 | visitor.Post(x); |
270 | } |
271 | } |
272 | template <typename T, typename M> |
273 | void Walk(UnlabeledStatement<T> &x, M &mutator) { |
274 | if (mutator.Pre(x)) { |
275 | Walk(x.source, mutator); |
276 | Walk(x.statement, mutator); |
277 | mutator.Post(x); |
278 | } |
279 | } |
280 | |
281 | template <typename V> void Walk(const Name &x, V &visitor) { |
282 | if (visitor.Pre(x)) { |
283 | Walk(x.source, visitor); |
284 | visitor.Post(x); |
285 | } |
286 | } |
287 | template <typename M> void Walk(Name &x, M &mutator) { |
288 | if (mutator.Pre(x)) { |
289 | Walk(x.source, mutator); |
290 | mutator.Post(x); |
291 | } |
292 | } |
293 | |
294 | template <typename V> void Walk(const AcSpec &x, V &visitor) { |
295 | if (visitor.Pre(x)) { |
296 | Walk(x.type, visitor); |
297 | Walk(x.values, visitor); |
298 | visitor.Post(x); |
299 | } |
300 | } |
301 | template <typename M> void Walk(AcSpec &x, M &mutator) { |
302 | if (mutator.Pre(x)) { |
303 | Walk(x.type, mutator); |
304 | Walk(x.values, mutator); |
305 | mutator.Post(x); |
306 | } |
307 | } |
308 | template <typename V> void Walk(const ArrayElement &x, V &visitor) { |
309 | if (visitor.Pre(x)) { |
310 | Walk(x.base, visitor); |
311 | Walk(x.subscripts, visitor); |
312 | visitor.Post(x); |
313 | } |
314 | } |
315 | template <typename M> void Walk(ArrayElement &x, M &mutator) { |
316 | if (mutator.Pre(x)) { |
317 | Walk(x.base, mutator); |
318 | Walk(x.subscripts, mutator); |
319 | mutator.Post(x); |
320 | } |
321 | } |
322 | template <typename V> |
323 | void Walk(const CharSelector::LengthAndKind &x, V &visitor) { |
324 | if (visitor.Pre(x)) { |
325 | Walk(x.length, visitor); |
326 | Walk(x.kind, visitor); |
327 | visitor.Post(x); |
328 | } |
329 | } |
330 | template <typename M> void Walk(CharSelector::LengthAndKind &x, M &mutator) { |
331 | if (mutator.Pre(x)) { |
332 | Walk(x.length, mutator); |
333 | Walk(x.kind, mutator); |
334 | mutator.Post(x); |
335 | } |
336 | } |
337 | template <typename V> void Walk(const CaseValueRange::Range &x, V &visitor) { |
338 | if (visitor.Pre(x)) { |
339 | Walk(x.lower, visitor); |
340 | Walk(x.upper, visitor); |
341 | visitor.Post(x); |
342 | } |
343 | } |
344 | template <typename M> void Walk(CaseValueRange::Range &x, M &mutator) { |
345 | if (mutator.Pre(x)) { |
346 | Walk(x.lower, mutator); |
347 | Walk(x.upper, mutator); |
348 | mutator.Post(x); |
349 | } |
350 | } |
351 | template <typename V> void Walk(const CoindexedNamedObject &x, V &visitor) { |
352 | if (visitor.Pre(x)) { |
353 | Walk(x.base, visitor); |
354 | Walk(x.imageSelector, visitor); |
355 | visitor.Post(x); |
356 | } |
357 | } |
358 | template <typename M> void Walk(CoindexedNamedObject &x, M &mutator) { |
359 | if (mutator.Pre(x)) { |
360 | Walk(x.base, mutator); |
361 | Walk(x.imageSelector, mutator); |
362 | mutator.Post(x); |
363 | } |
364 | } |
365 | template <typename V> |
366 | void Walk(const DeclarationTypeSpec::Class &x, V &visitor) { |
367 | if (visitor.Pre(x)) { |
368 | Walk(x.derived, visitor); |
369 | visitor.Post(x); |
370 | } |
371 | } |
372 | template <typename M> void Walk(DeclarationTypeSpec::Class &x, M &mutator) { |
373 | if (mutator.Pre(x)) { |
374 | Walk(x.derived, mutator); |
375 | mutator.Post(x); |
376 | } |
377 | } |
378 | template <typename V> |
379 | void Walk(const DeclarationTypeSpec::Type &x, V &visitor) { |
380 | if (visitor.Pre(x)) { |
381 | Walk(x.derived, visitor); |
382 | visitor.Post(x); |
383 | } |
384 | } |
385 | template <typename M> void Walk(DeclarationTypeSpec::Type &x, M &mutator) { |
386 | if (mutator.Pre(x)) { |
387 | Walk(x.derived, mutator); |
388 | mutator.Post(x); |
389 | } |
390 | } |
391 | template <typename V> void Walk(const ImportStmt &x, V &visitor) { |
392 | if (visitor.Pre(x)) { |
393 | Walk(x.names, visitor); |
394 | visitor.Post(x); |
395 | } |
396 | } |
397 | template <typename M> void Walk(ImportStmt &x, M &mutator) { |
398 | if (mutator.Pre(x)) { |
399 | Walk(x.names, mutator); |
400 | mutator.Post(x); |
401 | } |
402 | } |
403 | template <typename V> |
404 | void Walk(const IntrinsicTypeSpec::Character &x, V &visitor) { |
405 | if (visitor.Pre(x)) { |
406 | Walk(x.selector, visitor); |
407 | visitor.Post(x); |
408 | } |
409 | } |
410 | template <typename M> void Walk(IntrinsicTypeSpec::Character &x, M &mutator) { |
411 | if (mutator.Pre(x)) { |
412 | Walk(x.selector, mutator); |
413 | mutator.Post(x); |
414 | } |
415 | } |
416 | template <typename V> |
417 | void Walk(const IntrinsicTypeSpec::Complex &x, V &visitor) { |
418 | if (visitor.Pre(x)) { |
419 | Walk(x.kind, visitor); |
420 | visitor.Post(x); |
421 | } |
422 | } |
423 | template <typename M> void Walk(IntrinsicTypeSpec::Complex &x, M &mutator) { |
424 | if (mutator.Pre(x)) { |
425 | Walk(x.kind, mutator); |
426 | mutator.Post(x); |
427 | } |
428 | } |
429 | template <typename V> |
430 | void Walk(const IntrinsicTypeSpec::Logical &x, V &visitor) { |
431 | if (visitor.Pre(x)) { |
432 | Walk(x.kind, visitor); |
433 | visitor.Post(x); |
434 | } |
435 | } |
436 | template <typename M> void Walk(IntrinsicTypeSpec::Logical &x, M &mutator) { |
437 | if (mutator.Pre(x)) { |
438 | Walk(x.kind, mutator); |
439 | mutator.Post(x); |
440 | } |
441 | } |
442 | template <typename V> void Walk(const IntrinsicTypeSpec::Real &x, V &visitor) { |
443 | if (visitor.Pre(x)) { |
444 | Walk(x.kind, visitor); |
445 | visitor.Post(x); |
446 | } |
447 | } |
448 | template <typename M> void Walk(IntrinsicTypeSpec::Real &x, M &mutator) { |
449 | if (mutator.Pre(x)) { |
450 | Walk(x.kind, mutator); |
451 | mutator.Post(x); |
452 | } |
453 | } |
454 | template <typename A, typename B, typename V> |
455 | void Walk(const LoopBounds<A, B> &x, V &visitor) { |
456 | if (visitor.Pre(x)) { |
457 | Walk(x.name, visitor); |
458 | Walk(x.lower, visitor); |
459 | Walk(x.upper, visitor); |
460 | Walk(x.step, visitor); |
461 | visitor.Post(x); |
462 | } |
463 | } |
464 | template <typename A, typename B, typename M> |
465 | void Walk(LoopBounds<A, B> &x, M &mutator) { |
466 | if (mutator.Pre(x)) { |
467 | Walk(x.name, mutator); |
468 | Walk(x.lower, mutator); |
469 | Walk(x.upper, mutator); |
470 | Walk(x.step, mutator); |
471 | mutator.Post(x); |
472 | } |
473 | } |
474 | template <typename V> void Walk(const CommonStmt &x, V &visitor) { |
475 | if (visitor.Pre(x)) { |
476 | Walk(x.blocks, visitor); |
477 | visitor.Post(x); |
478 | } |
479 | } |
480 | template <typename M> void Walk(CommonStmt &x, M &mutator) { |
481 | if (mutator.Pre(x)) { |
482 | Walk(x.blocks, mutator); |
483 | mutator.Post(x); |
484 | } |
485 | } |
486 | template <typename V> void Walk(const Expr &x, V &visitor) { |
487 | if (visitor.Pre(x)) { |
488 | Walk(x.source, visitor); |
489 | Walk(x.u, visitor); |
490 | visitor.Post(x); |
491 | } |
492 | } |
493 | template <typename M> void Walk(Expr &x, M &mutator) { |
494 | if (mutator.Pre(x)) { |
495 | Walk(x.source, mutator); |
496 | Walk(x.u, mutator); |
497 | mutator.Post(x); |
498 | } |
499 | } |
500 | template <typename V> void Walk(const Designator &x, V &visitor) { |
501 | if (visitor.Pre(x)) { |
502 | Walk(x.source, visitor); |
503 | Walk(x.u, visitor); |
504 | visitor.Post(x); |
505 | } |
506 | } |
507 | template <typename M> void Walk(Designator &x, M &mutator) { |
508 | if (mutator.Pre(x)) { |
509 | Walk(x.source, mutator); |
510 | Walk(x.u, mutator); |
511 | mutator.Post(x); |
512 | } |
513 | } |
514 | template <typename V> void Walk(const Call &x, V &visitor) { |
515 | if (visitor.Pre(x)) { |
516 | Walk(x.source, visitor); |
517 | Walk(x.t, visitor); |
518 | visitor.Post(x); |
519 | } |
520 | } |
521 | template <typename M> void Walk(Call &x, M &mutator) { |
522 | if (mutator.Pre(x)) { |
523 | Walk(x.source, mutator); |
524 | Walk(x.t, mutator); |
525 | mutator.Post(x); |
526 | } |
527 | } |
528 | template <typename V> void Walk(const PartRef &x, V &visitor) { |
529 | if (visitor.Pre(x)) { |
530 | Walk(x.name, visitor); |
531 | Walk(x.subscripts, visitor); |
532 | Walk(x.imageSelector, visitor); |
533 | visitor.Post(x); |
534 | } |
535 | } |
536 | template <typename M> void Walk(PartRef &x, M &mutator) { |
537 | if (mutator.Pre(x)) { |
538 | Walk(x.name, mutator); |
539 | Walk(x.subscripts, mutator); |
540 | Walk(x.imageSelector, mutator); |
541 | mutator.Post(x); |
542 | } |
543 | } |
544 | template <typename V> void Walk(const ReadStmt &x, V &visitor) { |
545 | if (visitor.Pre(x)) { |
546 | Walk(x.iounit, visitor); |
547 | Walk(x.format, visitor); |
548 | Walk(x.controls, visitor); |
549 | Walk(x.items, visitor); |
550 | visitor.Post(x); |
551 | } |
552 | } |
553 | template <typename M> void Walk(ReadStmt &x, M &mutator) { |
554 | if (mutator.Pre(x)) { |
555 | Walk(x.iounit, mutator); |
556 | Walk(x.format, mutator); |
557 | Walk(x.controls, mutator); |
558 | Walk(x.items, mutator); |
559 | mutator.Post(x); |
560 | } |
561 | } |
562 | template <typename V> void Walk(const SignedIntLiteralConstant &x, V &visitor) { |
563 | if (visitor.Pre(x)) { |
564 | Walk(x.source, visitor); |
565 | Walk(x.t, visitor); |
566 | visitor.Post(x); |
567 | } |
568 | } |
569 | template <typename M> void Walk(SignedIntLiteralConstant &x, M &mutator) { |
570 | if (mutator.Pre(x)) { |
571 | Walk(x.source, mutator); |
572 | Walk(x.t, mutator); |
573 | mutator.Post(x); |
574 | } |
575 | } |
576 | template <typename V> void Walk(const RealLiteralConstant &x, V &visitor) { |
577 | if (visitor.Pre(x)) { |
578 | Walk(x.real, visitor); |
579 | Walk(x.kind, visitor); |
580 | visitor.Post(x); |
581 | } |
582 | } |
583 | template <typename M> void Walk(RealLiteralConstant &x, M &mutator) { |
584 | if (mutator.Pre(x)) { |
585 | Walk(x.real, mutator); |
586 | Walk(x.kind, mutator); |
587 | mutator.Post(x); |
588 | } |
589 | } |
590 | template <typename V> |
591 | void Walk(const RealLiteralConstant::Real &x, V &visitor) { |
592 | if (visitor.Pre(x)) { |
593 | Walk(x.source, visitor); |
594 | visitor.Post(x); |
595 | } |
596 | } |
597 | template <typename M> void Walk(RealLiteralConstant::Real &x, M &mutator) { |
598 | if (mutator.Pre(x)) { |
599 | Walk(x.source, mutator); |
600 | mutator.Post(x); |
601 | } |
602 | } |
603 | template <typename V> void Walk(const StructureComponent &x, V &visitor) { |
604 | if (visitor.Pre(x)) { |
605 | Walk(x.base, visitor); |
606 | Walk(x.component, visitor); |
607 | visitor.Post(x); |
608 | } |
609 | } |
610 | template <typename M> void Walk(StructureComponent &x, M &mutator) { |
611 | if (mutator.Pre(x)) { |
612 | Walk(x.base, mutator); |
613 | Walk(x.component, mutator); |
614 | mutator.Post(x); |
615 | } |
616 | } |
617 | template <typename V> void Walk(const Suffix &x, V &visitor) { |
618 | if (visitor.Pre(x)) { |
619 | Walk(x.binding, visitor); |
620 | Walk(x.resultName, visitor); |
621 | visitor.Post(x); |
622 | } |
623 | } |
624 | template <typename M> void Walk(Suffix &x, M &mutator) { |
625 | if (mutator.Pre(x)) { |
626 | Walk(x.binding, mutator); |
627 | Walk(x.resultName, mutator); |
628 | mutator.Post(x); |
629 | } |
630 | } |
631 | template <typename V> |
632 | void Walk(const TypeBoundProcedureStmt::WithInterface &x, V &visitor) { |
633 | if (visitor.Pre(x)) { |
634 | Walk(x.interfaceName, visitor); |
635 | Walk(x.attributes, visitor); |
636 | Walk(x.bindingNames, visitor); |
637 | visitor.Post(x); |
638 | } |
639 | } |
640 | template <typename M> |
641 | void Walk(TypeBoundProcedureStmt::WithInterface &x, M &mutator) { |
642 | if (mutator.Pre(x)) { |
643 | Walk(x.interfaceName, mutator); |
644 | Walk(x.attributes, mutator); |
645 | Walk(x.bindingNames, mutator); |
646 | mutator.Post(x); |
647 | } |
648 | } |
649 | template <typename V> |
650 | void Walk(const TypeBoundProcedureStmt::WithoutInterface &x, V &visitor) { |
651 | if (visitor.Pre(x)) { |
652 | Walk(x.attributes, visitor); |
653 | Walk(x.declarations, visitor); |
654 | visitor.Post(x); |
655 | } |
656 | } |
657 | template <typename M> |
658 | void Walk(TypeBoundProcedureStmt::WithoutInterface &x, M &mutator) { |
659 | if (mutator.Pre(x)) { |
660 | Walk(x.attributes, mutator); |
661 | Walk(x.declarations, mutator); |
662 | mutator.Post(x); |
663 | } |
664 | } |
665 | template <typename V> void Walk(const UseStmt &x, V &visitor) { |
666 | if (visitor.Pre(x)) { |
667 | Walk(x.nature, visitor); |
668 | Walk(x.moduleName, visitor); |
669 | Walk(x.u, visitor); |
670 | visitor.Post(x); |
671 | } |
672 | } |
673 | template <typename M> void Walk(UseStmt &x, M &mutator) { |
674 | if (mutator.Pre(x)) { |
675 | Walk(x.nature, mutator); |
676 | Walk(x.moduleName, mutator); |
677 | Walk(x.u, mutator); |
678 | mutator.Post(x); |
679 | } |
680 | } |
681 | template <typename V> void Walk(const WriteStmt &x, V &visitor) { |
682 | if (visitor.Pre(x)) { |
683 | Walk(x.iounit, visitor); |
684 | Walk(x.format, visitor); |
685 | Walk(x.controls, visitor); |
686 | Walk(x.items, visitor); |
687 | visitor.Post(x); |
688 | } |
689 | } |
690 | template <typename M> void Walk(WriteStmt &x, M &mutator) { |
691 | if (mutator.Pre(x)) { |
692 | Walk(x.iounit, mutator); |
693 | Walk(x.format, mutator); |
694 | Walk(x.controls, mutator); |
695 | Walk(x.items, mutator); |
696 | mutator.Post(x); |
697 | } |
698 | } |
699 | template <typename V> void Walk(const format::ControlEditDesc &x, V &visitor) { |
700 | if (visitor.Pre(x)) { |
701 | Walk(x.kind, visitor); |
702 | visitor.Post(x); |
703 | } |
704 | } |
705 | template <typename M> void Walk(format::ControlEditDesc &x, M &mutator) { |
706 | if (mutator.Pre(x)) { |
707 | Walk(x.kind, mutator); |
708 | mutator.Post(x); |
709 | } |
710 | } |
711 | template <typename V> |
712 | void Walk(const format::DerivedTypeDataEditDesc &x, V &visitor) { |
713 | if (visitor.Pre(x)) { |
714 | Walk(x.type, visitor); |
715 | Walk(x.parameters, visitor); |
716 | visitor.Post(x); |
717 | } |
718 | } |
719 | template <typename M> |
720 | void Walk(format::DerivedTypeDataEditDesc &x, M &mutator) { |
721 | if (mutator.Pre(x)) { |
722 | Walk(x.type, mutator); |
723 | Walk(x.parameters, mutator); |
724 | mutator.Post(x); |
725 | } |
726 | } |
727 | template <typename V> void Walk(const format::FormatItem &x, V &visitor) { |
728 | if (visitor.Pre(x)) { |
729 | Walk(x.repeatCount, visitor); |
730 | Walk(x.u, visitor); |
731 | visitor.Post(x); |
732 | } |
733 | } |
734 | template <typename M> void Walk(format::FormatItem &x, M &mutator) { |
735 | if (mutator.Pre(x)) { |
736 | Walk(x.repeatCount, mutator); |
737 | Walk(x.u, mutator); |
738 | mutator.Post(x); |
739 | } |
740 | } |
741 | template <typename V> |
742 | void Walk(const format::FormatSpecification &x, V &visitor) { |
743 | if (visitor.Pre(x)) { |
744 | Walk(x.items, visitor); |
745 | Walk(x.unlimitedItems, visitor); |
746 | visitor.Post(x); |
747 | } |
748 | } |
749 | template <typename M> void Walk(format::FormatSpecification &x, M &mutator) { |
750 | if (mutator.Pre(x)) { |
751 | Walk(x.items, mutator); |
752 | Walk(x.unlimitedItems, mutator); |
753 | mutator.Post(x); |
754 | } |
755 | } |
756 | template <typename V> |
757 | void Walk(const format::IntrinsicTypeDataEditDesc &x, V &visitor) { |
758 | if (visitor.Pre(x)) { |
759 | Walk(x.kind, visitor); |
760 | Walk(x.width, visitor); |
761 | Walk(x.digits, visitor); |
762 | Walk(x.exponentWidth, visitor); |
763 | visitor.Post(x); |
764 | } |
765 | } |
766 | template <typename M> |
767 | void Walk(format::IntrinsicTypeDataEditDesc &x, M &mutator) { |
768 | if (mutator.Pre(x)) { |
769 | Walk(x.kind, mutator); |
770 | Walk(x.width, mutator); |
771 | Walk(x.digits, mutator); |
772 | Walk(x.exponentWidth, mutator); |
773 | mutator.Post(x); |
774 | } |
775 | } |
776 | template <typename V> void Walk(const CompilerDirective &x, V &visitor) { |
777 | if (visitor.Pre(x)) { |
778 | Walk(x.source, visitor); |
779 | Walk(x.u, visitor); |
780 | visitor.Post(x); |
781 | } |
782 | } |
783 | template <typename M> void Walk(CompilerDirective &x, M &mutator) { |
784 | if (mutator.Pre(x)) { |
785 | Walk(x.source, mutator); |
786 | Walk(x.u, mutator); |
787 | mutator.Post(x); |
788 | } |
789 | } |
790 | template <typename V> |
791 | void Walk(const OmpLinearClause::WithModifier &x, V &visitor) { |
792 | if (visitor.Pre(x)) { |
793 | Walk(x.modifier, visitor); |
794 | Walk(x.names, visitor); |
795 | Walk(x.step, visitor); |
796 | visitor.Post(x); |
797 | } |
798 | } |
799 | template <typename M> void Walk(OmpLinearClause::WithModifier &x, M &mutator) { |
800 | if (mutator.Pre(x)) { |
801 | Walk(x.modifier, mutator); |
802 | Walk(x.names, mutator); |
803 | Walk(x.step, mutator); |
804 | mutator.Post(x); |
805 | } |
806 | } |
807 | template <typename V> |
808 | void Walk(const OmpLinearClause::WithoutModifier &x, V &visitor) { |
809 | if (visitor.Pre(x)) { |
810 | Walk(x.names, visitor); |
811 | Walk(x.step, visitor); |
812 | visitor.Post(x); |
813 | } |
814 | } |
815 | template <typename M> |
816 | void Walk(OmpLinearClause::WithoutModifier &x, M &mutator) { |
817 | if (mutator.Pre(x)) { |
818 | Walk(x.names, mutator); |
819 | Walk(x.step, mutator); |
820 | mutator.Post(x); |
821 | } |
822 | } |
823 | } // namespace Fortran::parser |
824 | #endif // FORTRAN_PARSER_PARSE_TREE_VISITOR_H_ |