File: | build/source/flang/lib/Semantics/resolve-names.cpp |
Warning: | line 5411, column 7 Dereference of null pointer |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
1 | //===-- lib/Semantics/resolve-names.cpp -----------------------------------===// | |||
2 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. | |||
3 | // See https://llvm.org/LICENSE.txt for license information. | |||
4 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception | |||
5 | // | |||
6 | //===----------------------------------------------------------------------===// | |||
7 | ||||
8 | #include "resolve-names.h" | |||
9 | #include "assignment.h" | |||
10 | #include "definable.h" | |||
11 | #include "mod-file.h" | |||
12 | #include "pointer-assignment.h" | |||
13 | #include "program-tree.h" | |||
14 | #include "resolve-directives.h" | |||
15 | #include "resolve-names-utils.h" | |||
16 | #include "rewrite-parse-tree.h" | |||
17 | #include "flang/Common/Fortran.h" | |||
18 | #include "flang/Common/default-kinds.h" | |||
19 | #include "flang/Common/indirection.h" | |||
20 | #include "flang/Common/restorer.h" | |||
21 | #include "flang/Common/visit.h" | |||
22 | #include "flang/Evaluate/characteristics.h" | |||
23 | #include "flang/Evaluate/check-expression.h" | |||
24 | #include "flang/Evaluate/common.h" | |||
25 | #include "flang/Evaluate/fold-designator.h" | |||
26 | #include "flang/Evaluate/fold.h" | |||
27 | #include "flang/Evaluate/intrinsics.h" | |||
28 | #include "flang/Evaluate/tools.h" | |||
29 | #include "flang/Evaluate/type.h" | |||
30 | #include "flang/Parser/parse-tree-visitor.h" | |||
31 | #include "flang/Parser/parse-tree.h" | |||
32 | #include "flang/Parser/tools.h" | |||
33 | #include "flang/Semantics/attr.h" | |||
34 | #include "flang/Semantics/expression.h" | |||
35 | #include "flang/Semantics/scope.h" | |||
36 | #include "flang/Semantics/semantics.h" | |||
37 | #include "flang/Semantics/symbol.h" | |||
38 | #include "flang/Semantics/tools.h" | |||
39 | #include "flang/Semantics/type.h" | |||
40 | #include "llvm/Support/raw_ostream.h" | |||
41 | #include <list> | |||
42 | #include <map> | |||
43 | #include <set> | |||
44 | #include <stack> | |||
45 | ||||
46 | namespace Fortran::semantics { | |||
47 | ||||
48 | using namespace parser::literals; | |||
49 | ||||
50 | template <typename T> using Indirection = common::Indirection<T>; | |||
51 | using Message = parser::Message; | |||
52 | using Messages = parser::Messages; | |||
53 | using MessageFixedText = parser::MessageFixedText; | |||
54 | using MessageFormattedText = parser::MessageFormattedText; | |||
55 | ||||
56 | class ResolveNamesVisitor; | |||
57 | class ScopeHandler; | |||
58 | ||||
59 | // ImplicitRules maps initial character of identifier to the DeclTypeSpec | |||
60 | // representing the implicit type; std::nullopt if none. | |||
61 | // It also records the presence of IMPLICIT NONE statements. | |||
62 | // When inheritFromParent is set, defaults come from the parent rules. | |||
63 | class ImplicitRules { | |||
64 | public: | |||
65 | ImplicitRules(SemanticsContext &context, ImplicitRules *parent) | |||
66 | : parent_{parent}, context_{context} { | |||
67 | inheritFromParent_ = parent != nullptr; | |||
68 | } | |||
69 | bool isImplicitNoneType() const; | |||
70 | bool isImplicitNoneExternal() const; | |||
71 | void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; } | |||
72 | void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; } | |||
73 | void set_inheritFromParent(bool x) { inheritFromParent_ = x; } | |||
74 | // Get the implicit type for this name. May be null. | |||
75 | const DeclTypeSpec *GetType( | |||
76 | SourceName, bool respectImplicitNone = true) const; | |||
77 | // Record the implicit type for the range of characters [fromLetter, | |||
78 | // toLetter]. | |||
79 | void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter, | |||
80 | parser::Location toLetter); | |||
81 | ||||
82 | private: | |||
83 | static char Incr(char ch); | |||
84 | ||||
85 | ImplicitRules *parent_; | |||
86 | SemanticsContext &context_; | |||
87 | bool inheritFromParent_{false}; // look in parent if not specified here | |||
88 | bool isImplicitNoneType_{ | |||
89 | context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)}; | |||
90 | bool isImplicitNoneExternal_{false}; | |||
91 | // map_ contains the mapping between letters and types that were defined | |||
92 | // by the IMPLICIT statements of the related scope. It does not contain | |||
93 | // the default Fortran mappings nor the mapping defined in parents. | |||
94 | std::map<char, common::Reference<const DeclTypeSpec>> map_; | |||
95 | ||||
96 | friend llvm::raw_ostream &operator<<( | |||
97 | llvm::raw_ostream &, const ImplicitRules &); | |||
98 | friend void ShowImplicitRule( | |||
99 | llvm::raw_ostream &, const ImplicitRules &, char); | |||
100 | }; | |||
101 | ||||
102 | // scope -> implicit rules for that scope | |||
103 | using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>; | |||
104 | ||||
105 | // Track statement source locations and save messages. | |||
106 | class MessageHandler { | |||
107 | public: | |||
108 | MessageHandler() { DIE("MessageHandler: default-constructed")Fortran::common::die("MessageHandler: default-constructed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 108); } | |||
109 | explicit MessageHandler(SemanticsContext &c) : context_{&c} {} | |||
110 | Messages &messages() { return context_->messages(); }; | |||
111 | const std::optional<SourceName> &currStmtSource() { | |||
112 | return context_->location(); | |||
113 | } | |||
114 | void set_currStmtSource(const std::optional<SourceName> &source) { | |||
115 | context_->set_location(source); | |||
116 | } | |||
117 | ||||
118 | // Emit a message associated with the current statement source. | |||
119 | Message &Say(MessageFixedText &&); | |||
120 | Message &Say(MessageFormattedText &&); | |||
121 | // Emit a message about a SourceName | |||
122 | Message &Say(const SourceName &, MessageFixedText &&); | |||
123 | // Emit a formatted message associated with a source location. | |||
124 | template <typename... A> | |||
125 | Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) { | |||
126 | return context_->Say(source, std::move(msg), std::forward<A>(args)...); | |||
127 | } | |||
128 | ||||
129 | private: | |||
130 | SemanticsContext *context_; | |||
131 | }; | |||
132 | ||||
133 | // Inheritance graph for the parse tree visitation classes that follow: | |||
134 | // BaseVisitor | |||
135 | // + AttrsVisitor | |||
136 | // | + DeclTypeSpecVisitor | |||
137 | // | + ImplicitRulesVisitor | |||
138 | // | + ScopeHandler -----------+--+ | |||
139 | // | + ModuleVisitor ========|==+ | |||
140 | // | + InterfaceVisitor | | | |||
141 | // | +-+ SubprogramVisitor ==|==+ | |||
142 | // + ArraySpecVisitor | | | |||
143 | // + DeclarationVisitor <--------+ | | |||
144 | // + ConstructVisitor | | |||
145 | // + ResolveNamesVisitor <------+ | |||
146 | ||||
147 | class BaseVisitor { | |||
148 | public: | |||
149 | BaseVisitor() { DIE("BaseVisitor: default-constructed")Fortran::common::die("BaseVisitor: default-constructed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 149); } | |||
150 | BaseVisitor( | |||
151 | SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules) | |||
152 | : implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} { | |||
153 | } | |||
154 | template <typename T> void Walk(const T &); | |||
155 | ||||
156 | MessageHandler &messageHandler() { return messageHandler_; } | |||
157 | const std::optional<SourceName> &currStmtSource() { | |||
158 | return context_->location(); | |||
159 | } | |||
160 | SemanticsContext &context() const { return *context_; } | |||
161 | evaluate::FoldingContext &GetFoldingContext() const { | |||
162 | return context_->foldingContext(); | |||
163 | } | |||
164 | bool IsIntrinsic( | |||
165 | const SourceName &name, std::optional<Symbol::Flag> flag) const { | |||
166 | if (!flag) { | |||
167 | return context_->intrinsics().IsIntrinsic(name.ToString()); | |||
168 | } else if (flag == Symbol::Flag::Function) { | |||
169 | return context_->intrinsics().IsIntrinsicFunction(name.ToString()); | |||
170 | } else if (flag == Symbol::Flag::Subroutine) { | |||
171 | return context_->intrinsics().IsIntrinsicSubroutine(name.ToString()); | |||
172 | } else { | |||
173 | DIE("expected Subroutine or Function flag")Fortran::common::die("expected Subroutine or Function flag" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 173); | |||
174 | } | |||
175 | } | |||
176 | ||||
177 | bool InModuleFile() const { return GetFoldingContext().inModuleFile(); } | |||
178 | ||||
179 | // Make a placeholder symbol for a Name that otherwise wouldn't have one. | |||
180 | // It is not in any scope and always has MiscDetails. | |||
181 | void MakePlaceholder(const parser::Name &, MiscDetails::Kind); | |||
182 | ||||
183 | template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) { | |||
184 | return evaluate::Fold(GetFoldingContext(), std::move(expr)); | |||
185 | } | |||
186 | ||||
187 | template <typename T> MaybeExpr EvaluateExpr(const T &expr) { | |||
188 | return FoldExpr(AnalyzeExpr(*context_, expr)); | |||
189 | } | |||
190 | ||||
191 | template <typename T> | |||
192 | MaybeExpr EvaluateNonPointerInitializer( | |||
193 | const Symbol &symbol, const T &expr, parser::CharBlock source) { | |||
194 | if (!context().HasError(symbol)) { | |||
195 | if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) { | |||
196 | auto restorer{GetFoldingContext().messages().SetLocation(source)}; | |||
197 | return evaluate::NonPointerInitializationExpr( | |||
198 | symbol, std::move(*maybeExpr), GetFoldingContext()); | |||
199 | } | |||
200 | } | |||
201 | return std::nullopt; | |||
202 | } | |||
203 | ||||
204 | template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) { | |||
205 | return semantics::EvaluateIntExpr(*context_, expr); | |||
206 | } | |||
207 | ||||
208 | template <typename T> | |||
209 | MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) { | |||
210 | if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) { | |||
211 | return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>( | |||
212 | std::move(*maybeIntExpr))); | |||
213 | } else { | |||
214 | return std::nullopt; | |||
215 | } | |||
216 | } | |||
217 | ||||
218 | template <typename... A> Message &Say(A &&...args) { | |||
219 | return messageHandler_.Say(std::forward<A>(args)...); | |||
220 | } | |||
221 | template <typename... A> | |||
222 | Message &Say( | |||
223 | const parser::Name &name, MessageFixedText &&text, const A &...args) { | |||
224 | return messageHandler_.Say(name.source, std::move(text), args...); | |||
225 | } | |||
226 | ||||
227 | protected: | |||
228 | ImplicitRulesMap *implicitRulesMap_{nullptr}; | |||
229 | ||||
230 | private: | |||
231 | ResolveNamesVisitor *this_; | |||
232 | SemanticsContext *context_; | |||
233 | MessageHandler messageHandler_; | |||
234 | }; | |||
235 | ||||
236 | // Provide Post methods to collect attributes into a member variable. | |||
237 | class AttrsVisitor : public virtual BaseVisitor { | |||
238 | public: | |||
239 | bool BeginAttrs(); // always returns true | |||
240 | Attrs GetAttrs(); | |||
241 | Attrs EndAttrs(); | |||
242 | bool SetPassNameOn(Symbol &); | |||
243 | void SetBindNameOn(Symbol &); | |||
244 | void Post(const parser::LanguageBindingSpec &); | |||
245 | bool Pre(const parser::IntentSpec &); | |||
246 | bool Pre(const parser::Pass &); | |||
247 | ||||
248 | bool CheckAndSet(Attr); | |||
249 | ||||
250 | // Simple case: encountering CLASSNAME causes ATTRNAME to be set. | |||
251 | #define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \ | |||
252 | bool Pre(const parser::CLASSNAME &) { \ | |||
253 | CheckAndSet(Attr::ATTRNAME); \ | |||
254 | return false; \ | |||
255 | } | |||
256 | HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL) | |||
257 | HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE) | |||
258 | HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE) | |||
259 | HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE) | |||
260 | HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE) | |||
261 | HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE) | |||
262 | HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C) | |||
263 | HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED) | |||
264 | HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE) | |||
265 | HANDLE_ATTR_CLASS(Abstract, ABSTRACT) | |||
266 | HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE) | |||
267 | HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS) | |||
268 | HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS) | |||
269 | HANDLE_ATTR_CLASS(External, EXTERNAL) | |||
270 | HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC) | |||
271 | HANDLE_ATTR_CLASS(NoPass, NOPASS) | |||
272 | HANDLE_ATTR_CLASS(Optional, OPTIONAL) | |||
273 | HANDLE_ATTR_CLASS(Parameter, PARAMETER) | |||
274 | HANDLE_ATTR_CLASS(Pointer, POINTER) | |||
275 | HANDLE_ATTR_CLASS(Protected, PROTECTED) | |||
276 | HANDLE_ATTR_CLASS(Save, SAVE) | |||
277 | HANDLE_ATTR_CLASS(Target, TARGET) | |||
278 | HANDLE_ATTR_CLASS(Value, VALUE) | |||
279 | HANDLE_ATTR_CLASS(Volatile, VOLATILE) | |||
280 | #undef HANDLE_ATTR_CLASS | |||
281 | ||||
282 | protected: | |||
283 | std::optional<Attrs> attrs_; | |||
284 | ||||
285 | Attr AccessSpecToAttr(const parser::AccessSpec &x) { | |||
286 | switch (x.v) { | |||
287 | case parser::AccessSpec::Kind::Public: | |||
288 | return Attr::PUBLIC; | |||
289 | case parser::AccessSpec::Kind::Private: | |||
290 | return Attr::PRIVATE; | |||
291 | } | |||
292 | llvm_unreachable("Switch covers all cases")::llvm::llvm_unreachable_internal("Switch covers all cases", "flang/lib/Semantics/resolve-names.cpp" , 292); // suppress g++ warning | |||
293 | } | |||
294 | Attr IntentSpecToAttr(const parser::IntentSpec &x) { | |||
295 | switch (x.v) { | |||
296 | case parser::IntentSpec::Intent::In: | |||
297 | return Attr::INTENT_IN; | |||
298 | case parser::IntentSpec::Intent::Out: | |||
299 | return Attr::INTENT_OUT; | |||
300 | case parser::IntentSpec::Intent::InOut: | |||
301 | return Attr::INTENT_INOUT; | |||
302 | } | |||
303 | llvm_unreachable("Switch covers all cases")::llvm::llvm_unreachable_internal("Switch covers all cases", "flang/lib/Semantics/resolve-names.cpp" , 303); // suppress g++ warning | |||
304 | } | |||
305 | ||||
306 | private: | |||
307 | bool IsDuplicateAttr(Attr); | |||
308 | bool HaveAttrConflict(Attr, Attr, Attr); | |||
309 | bool IsConflictingAttr(Attr); | |||
310 | ||||
311 | MaybeExpr bindName_; // from BIND(C, NAME="...") | |||
312 | std::optional<SourceName> passName_; // from PASS(...) | |||
313 | }; | |||
314 | ||||
315 | // Find and create types from declaration-type-spec nodes. | |||
316 | class DeclTypeSpecVisitor : public AttrsVisitor { | |||
317 | public: | |||
318 | using AttrsVisitor::Post; | |||
319 | using AttrsVisitor::Pre; | |||
320 | void Post(const parser::IntrinsicTypeSpec::DoublePrecision &); | |||
321 | void Post(const parser::IntrinsicTypeSpec::DoubleComplex &); | |||
322 | void Post(const parser::DeclarationTypeSpec::ClassStar &); | |||
323 | void Post(const parser::DeclarationTypeSpec::TypeStar &); | |||
324 | bool Pre(const parser::TypeGuardStmt &); | |||
325 | void Post(const parser::TypeGuardStmt &); | |||
326 | void Post(const parser::TypeSpec &); | |||
327 | ||||
328 | // Walk the parse tree of a type spec and return the DeclTypeSpec for it. | |||
329 | template <typename T> | |||
330 | const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) { | |||
331 | auto restorer{common::ScopedSet(state_, State{})}; | |||
332 | set_allowForwardReferenceToDerivedType(allowForward); | |||
333 | BeginDeclTypeSpec(); | |||
334 | Walk(x); | |||
335 | const auto *type{GetDeclTypeSpec()}; | |||
336 | EndDeclTypeSpec(); | |||
337 | return type; | |||
338 | } | |||
339 | ||||
340 | protected: | |||
341 | struct State { | |||
342 | bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true | |||
343 | const DeclTypeSpec *declTypeSpec{nullptr}; | |||
344 | struct { | |||
345 | DerivedTypeSpec *type{nullptr}; | |||
346 | DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived}; | |||
347 | } derived; | |||
348 | bool allowForwardReferenceToDerivedType{false}; | |||
349 | }; | |||
350 | ||||
351 | bool allowForwardReferenceToDerivedType() const { | |||
352 | return state_.allowForwardReferenceToDerivedType; | |||
353 | } | |||
354 | void set_allowForwardReferenceToDerivedType(bool yes) { | |||
355 | state_.allowForwardReferenceToDerivedType = yes; | |||
356 | } | |||
357 | ||||
358 | const DeclTypeSpec *GetDeclTypeSpec(); | |||
359 | void BeginDeclTypeSpec(); | |||
360 | void EndDeclTypeSpec(); | |||
361 | void SetDeclTypeSpec(const DeclTypeSpec &); | |||
362 | void SetDeclTypeSpecCategory(DeclTypeSpec::Category); | |||
363 | DeclTypeSpec::Category GetDeclTypeSpecCategory() const { | |||
364 | return state_.derived.category; | |||
365 | } | |||
366 | KindExpr GetKindParamExpr( | |||
367 | TypeCategory, const std::optional<parser::KindSelector> &); | |||
368 | void CheckForAbstractType(const Symbol &typeSymbol); | |||
369 | ||||
370 | private: | |||
371 | State state_; | |||
372 | ||||
373 | void MakeNumericType(TypeCategory, int kind); | |||
374 | }; | |||
375 | ||||
376 | // Visit ImplicitStmt and related parse tree nodes and updates implicit rules. | |||
377 | class ImplicitRulesVisitor : public DeclTypeSpecVisitor { | |||
378 | public: | |||
379 | using DeclTypeSpecVisitor::Post; | |||
380 | using DeclTypeSpecVisitor::Pre; | |||
381 | using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec; | |||
382 | ||||
383 | void Post(const parser::ParameterStmt &); | |||
384 | bool Pre(const parser::ImplicitStmt &); | |||
385 | bool Pre(const parser::LetterSpec &); | |||
386 | bool Pre(const parser::ImplicitSpec &); | |||
387 | void Post(const parser::ImplicitSpec &); | |||
388 | ||||
389 | const DeclTypeSpec *GetType( | |||
390 | SourceName name, bool respectImplicitNoneType = true) { | |||
391 | return implicitRules_->GetType(name, respectImplicitNoneType); | |||
392 | } | |||
393 | bool isImplicitNoneType() const { | |||
394 | return implicitRules_->isImplicitNoneType(); | |||
395 | } | |||
396 | bool isImplicitNoneType(const Scope &scope) const { | |||
397 | return implicitRulesMap_->at(&scope).isImplicitNoneType(); | |||
398 | } | |||
399 | bool isImplicitNoneExternal() const { | |||
400 | return implicitRules_->isImplicitNoneExternal(); | |||
401 | } | |||
402 | void set_inheritFromParent(bool x) { | |||
403 | implicitRules_->set_inheritFromParent(x); | |||
404 | } | |||
405 | ||||
406 | protected: | |||
407 | void BeginScope(const Scope &); | |||
408 | void SetScope(const Scope &); | |||
409 | ||||
410 | private: | |||
411 | // implicit rules in effect for current scope | |||
412 | ImplicitRules *implicitRules_{nullptr}; | |||
413 | std::optional<SourceName> prevImplicit_; | |||
414 | std::optional<SourceName> prevImplicitNone_; | |||
415 | std::optional<SourceName> prevImplicitNoneType_; | |||
416 | std::optional<SourceName> prevParameterStmt_; | |||
417 | ||||
418 | bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs); | |||
419 | }; | |||
420 | ||||
421 | // Track array specifications. They can occur in AttrSpec, EntityDecl, | |||
422 | // ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt. | |||
423 | // 1. INTEGER, DIMENSION(10) :: x | |||
424 | // 2. INTEGER :: x(10) | |||
425 | // 3. ALLOCATABLE :: x(:) | |||
426 | // 4. DIMENSION :: x(10) | |||
427 | // 5. COMMON x(10) | |||
428 | // 6. BasedPointerStmt | |||
429 | class ArraySpecVisitor : public virtual BaseVisitor { | |||
430 | public: | |||
431 | void Post(const parser::ArraySpec &); | |||
432 | void Post(const parser::ComponentArraySpec &); | |||
433 | void Post(const parser::CoarraySpec &); | |||
434 | void Post(const parser::AttrSpec &) { PostAttrSpec(); } | |||
435 | void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); } | |||
436 | ||||
437 | protected: | |||
438 | const ArraySpec &arraySpec(); | |||
439 | void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; } | |||
440 | const ArraySpec &coarraySpec(); | |||
441 | void BeginArraySpec(); | |||
442 | void EndArraySpec(); | |||
443 | void ClearArraySpec() { arraySpec_.clear(); } | |||
444 | void ClearCoarraySpec() { coarraySpec_.clear(); } | |||
445 | ||||
446 | private: | |||
447 | // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec | |||
448 | ArraySpec arraySpec_; | |||
449 | ArraySpec coarraySpec_; | |||
450 | // When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved | |||
451 | // into attrArraySpec_ | |||
452 | ArraySpec attrArraySpec_; | |||
453 | ArraySpec attrCoarraySpec_; | |||
454 | ||||
455 | void PostAttrSpec(); | |||
456 | }; | |||
457 | ||||
458 | // Manages a stack of function result information. We defer the processing | |||
459 | // of a type specification that appears in the prefix of a FUNCTION statement | |||
460 | // until the function result variable appears in the specification part | |||
461 | // or the end of the specification part. This allows for forward references | |||
462 | // in the type specification to resolve to local names. | |||
463 | class FuncResultStack { | |||
464 | public: | |||
465 | explicit FuncResultStack(ScopeHandler &scopeHandler) | |||
466 | : scopeHandler_{scopeHandler} {} | |||
467 | ~FuncResultStack(); | |||
468 | ||||
469 | struct FuncInfo { | |||
470 | explicit FuncInfo(const Scope &s) : scope{s} {} | |||
471 | const Scope &scope; | |||
472 | // Parse tree of the type specification in the FUNCTION prefix | |||
473 | const parser::DeclarationTypeSpec *parsedType{nullptr}; | |||
474 | // Name of the function RESULT in the FUNCTION suffix, if any | |||
475 | const parser::Name *resultName{nullptr}; | |||
476 | // Result symbol | |||
477 | Symbol *resultSymbol{nullptr}; | |||
478 | std::optional<SourceName> source; | |||
479 | bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt | |||
480 | }; | |||
481 | ||||
482 | // Completes the definition of the top function's result. | |||
483 | void CompleteFunctionResultType(); | |||
484 | // Completes the definition of a symbol if it is the top function's result. | |||
485 | void CompleteTypeIfFunctionResult(Symbol &); | |||
486 | ||||
487 | FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); } | |||
488 | FuncInfo &Push(const Scope &scope) { return stack_.emplace_back(scope); } | |||
489 | void Pop(); | |||
490 | ||||
491 | private: | |||
492 | ScopeHandler &scopeHandler_; | |||
493 | std::vector<FuncInfo> stack_; | |||
494 | }; | |||
495 | ||||
496 | // Manage a stack of Scopes | |||
497 | class ScopeHandler : public ImplicitRulesVisitor { | |||
498 | public: | |||
499 | using ImplicitRulesVisitor::Post; | |||
500 | using ImplicitRulesVisitor::Pre; | |||
501 | ||||
502 | Scope &currScope() { return DEREF(currScope_)Fortran::common::Deref(currScope_, "flang/lib/Semantics/resolve-names.cpp" , 502); } | |||
503 | // The enclosing host procedure if current scope is in an internal procedure | |||
504 | Scope *GetHostProcedure(); | |||
505 | // The innermost enclosing program unit scope, ignoring BLOCK and other | |||
506 | // construct scopes. | |||
507 | Scope &InclusiveScope(); | |||
508 | // The enclosing scope, skipping derived types. | |||
509 | Scope &NonDerivedTypeScope(); | |||
510 | ||||
511 | // Create a new scope and push it on the scope stack. | |||
512 | void PushScope(Scope::Kind kind, Symbol *symbol); | |||
513 | void PushScope(Scope &scope); | |||
514 | void PopScope(); | |||
515 | void SetScope(Scope &); | |||
516 | ||||
517 | template <typename T> bool Pre(const parser::Statement<T> &x) { | |||
518 | messageHandler().set_currStmtSource(x.source); | |||
519 | currScope_->AddSourceRange(x.source); | |||
520 | return true; | |||
521 | } | |||
522 | template <typename T> void Post(const parser::Statement<T> &) { | |||
523 | messageHandler().set_currStmtSource(std::nullopt); | |||
524 | } | |||
525 | ||||
526 | // Special messages: already declared; referencing symbol's declaration; | |||
527 | // about a type; two names & locations | |||
528 | void SayAlreadyDeclared(const parser::Name &, Symbol &); | |||
529 | void SayAlreadyDeclared(const SourceName &, Symbol &); | |||
530 | void SayAlreadyDeclared(const SourceName &, const SourceName &); | |||
531 | void SayWithReason( | |||
532 | const parser::Name &, Symbol &, MessageFixedText &&, Message &&); | |||
533 | void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&); | |||
534 | void SayLocalMustBeVariable(const parser::Name &, Symbol &); | |||
535 | void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &); | |||
536 | void Say2(const SourceName &, MessageFixedText &&, const SourceName &, | |||
537 | MessageFixedText &&); | |||
538 | void Say2( | |||
539 | const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&); | |||
540 | void Say2( | |||
541 | const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&); | |||
542 | ||||
543 | // Search for symbol by name in current, parent derived type, and | |||
544 | // containing scopes | |||
545 | Symbol *FindSymbol(const parser::Name &); | |||
546 | Symbol *FindSymbol(const Scope &, const parser::Name &); | |||
547 | // Search for name only in scope, not in enclosing scopes. | |||
548 | Symbol *FindInScope(const Scope &, const parser::Name &); | |||
549 | Symbol *FindInScope(const Scope &, const SourceName &); | |||
550 | template <typename T> Symbol *FindInScope(const T &name) { | |||
551 | return FindInScope(currScope(), name); | |||
552 | } | |||
553 | // Search for name in a derived type scope and its parents. | |||
554 | Symbol *FindInTypeOrParents(const Scope &, const parser::Name &); | |||
555 | Symbol *FindInTypeOrParents(const parser::Name &); | |||
556 | Symbol *FindInScopeOrBlockConstructs(const Scope &, SourceName); | |||
557 | Symbol *FindSeparateModuleProcedureInterface(const parser::Name &); | |||
558 | void EraseSymbol(const parser::Name &); | |||
559 | void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); } | |||
560 | // Make a new symbol with the name and attrs of an existing one | |||
561 | Symbol &CopySymbol(const SourceName &, const Symbol &); | |||
562 | ||||
563 | // Make symbols in the current or named scope | |||
564 | Symbol &MakeSymbol(Scope &, const SourceName &, Attrs); | |||
565 | Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{}); | |||
566 | Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{}); | |||
567 | Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &); | |||
568 | ||||
569 | template <typename D> | |||
570 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
571 | const parser::Name &name, D &&details) { | |||
572 | return MakeSymbol(name, Attrs{}, std::move(details)); | |||
573 | } | |||
574 | ||||
575 | template <typename D> | |||
576 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
577 | const parser::Name &name, const Attrs &attrs, D &&details) { | |||
578 | return Resolve(name, MakeSymbol(name.source, attrs, std::move(details))); | |||
579 | } | |||
580 | ||||
581 | template <typename D> | |||
582 | common::IfNoLvalue<Symbol &, D> MakeSymbol( | |||
583 | const SourceName &name, const Attrs &attrs, D &&details) { | |||
584 | // Note: don't use FindSymbol here. If this is a derived type scope, | |||
585 | // we want to detect whether the name is already declared as a component. | |||
586 | auto *symbol{FindInScope(name)}; | |||
587 | if (!symbol) { | |||
588 | symbol = &MakeSymbol(name, attrs); | |||
589 | symbol->set_details(std::move(details)); | |||
590 | return *symbol; | |||
591 | } | |||
592 | if constexpr (std::is_same_v<DerivedTypeDetails, D>) { | |||
593 | if (auto *d{symbol->detailsIf<GenericDetails>()}) { | |||
594 | if (!d->specific()) { | |||
595 | // derived type with same name as a generic | |||
596 | auto *derivedType{d->derivedType()}; | |||
597 | if (!derivedType) { | |||
598 | derivedType = | |||
599 | &currScope().MakeSymbol(name, attrs, std::move(details)); | |||
600 | d->set_derivedType(*derivedType); | |||
601 | } else if (derivedType->CanReplaceDetails(details)) { | |||
602 | // was forward-referenced | |||
603 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
604 | SetExplicitAttrs(*derivedType, attrs); | |||
605 | derivedType->set_details(std::move(details)); | |||
606 | } else { | |||
607 | SayAlreadyDeclared(name, *derivedType); | |||
608 | } | |||
609 | return *derivedType; | |||
610 | } | |||
611 | } | |||
612 | } | |||
613 | if (symbol->CanReplaceDetails(details)) { | |||
614 | // update the existing symbol | |||
615 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
616 | SetExplicitAttrs(*symbol, attrs); | |||
617 | if constexpr (std::is_same_v<SubprogramDetails, D>) { | |||
618 | // Dummy argument defined by explicit interface? | |||
619 | details.set_isDummy(IsDummy(*symbol)); | |||
620 | } | |||
621 | symbol->set_details(std::move(details)); | |||
622 | return *symbol; | |||
623 | } else if constexpr (std::is_same_v<UnknownDetails, D>) { | |||
624 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
625 | SetExplicitAttrs(*symbol, attrs); | |||
626 | return *symbol; | |||
627 | } else { | |||
628 | if (!CheckPossibleBadForwardRef(*symbol)) { | |||
629 | if (name.empty() && symbol->name().empty()) { | |||
630 | // report the error elsewhere | |||
631 | return *symbol; | |||
632 | } | |||
633 | SayAlreadyDeclared(name, *symbol); | |||
634 | } | |||
635 | // replace the old symbol with a new one with correct details | |||
636 | EraseSymbol(*symbol); | |||
637 | auto &result{MakeSymbol(name, attrs, std::move(details))}; | |||
638 | context().SetError(result); | |||
639 | return result; | |||
640 | } | |||
641 | } | |||
642 | ||||
643 | void MakeExternal(Symbol &); | |||
644 | ||||
645 | // C815 duplicated attribute checking; returns false on error | |||
646 | bool CheckDuplicatedAttr(SourceName, const Symbol &, Attr); | |||
647 | bool CheckDuplicatedAttrs(SourceName, const Symbol &, Attrs); | |||
648 | ||||
649 | void SetExplicitAttr(Symbol &symbol, Attr attr) const { | |||
650 | symbol.attrs().set(attr); | |||
651 | symbol.implicitAttrs().reset(attr); | |||
652 | } | |||
653 | void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const { | |||
654 | symbol.attrs() |= attrs; | |||
655 | symbol.implicitAttrs() &= ~attrs; | |||
656 | } | |||
657 | void SetImplicitAttr(Symbol &symbol, Attr attr) const { | |||
658 | symbol.attrs().set(attr); | |||
659 | symbol.implicitAttrs().set(attr); | |||
660 | } | |||
661 | ||||
662 | protected: | |||
663 | FuncResultStack &funcResultStack() { return funcResultStack_; } | |||
664 | ||||
665 | // Apply the implicit type rules to this symbol. | |||
666 | void ApplyImplicitRules(Symbol &, bool allowForwardReference = false); | |||
667 | bool ImplicitlyTypeForwardRef(Symbol &); | |||
668 | void AcquireIntrinsicProcedureFlags(Symbol &); | |||
669 | const DeclTypeSpec *GetImplicitType( | |||
670 | Symbol &, bool respectImplicitNoneType = true); | |||
671 | void CheckEntryDummyUse(SourceName, Symbol *); | |||
672 | bool ConvertToObjectEntity(Symbol &); | |||
673 | bool ConvertToProcEntity(Symbol &); | |||
674 | ||||
675 | const DeclTypeSpec &MakeNumericType( | |||
676 | TypeCategory, const std::optional<parser::KindSelector> &); | |||
677 | const DeclTypeSpec &MakeNumericType(TypeCategory, int); | |||
678 | const DeclTypeSpec &MakeLogicalType( | |||
679 | const std::optional<parser::KindSelector> &); | |||
680 | const DeclTypeSpec &MakeLogicalType(int); | |||
681 | void NotePossibleBadForwardRef(const parser::Name &); | |||
682 | std::optional<SourceName> HadForwardRef(const Symbol &) const; | |||
683 | bool CheckPossibleBadForwardRef(const Symbol &); | |||
684 | ||||
685 | bool inSpecificationPart_{false}; | |||
686 | bool inEquivalenceStmt_{false}; | |||
687 | ||||
688 | // Some information is collected from a specification part for deferred | |||
689 | // processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts()) | |||
690 | // that are called by ResolveNamesVisitor::FinishSpecificationPart(). Since | |||
691 | // specification parts can nest (e.g., INTERFACE bodies), the collected | |||
692 | // information that is not contained in the scope needs to be packaged | |||
693 | // and restorable. | |||
694 | struct SpecificationPartState { | |||
695 | std::set<SourceName> forwardRefs; | |||
696 | // Collect equivalence sets and process at end of specification part | |||
697 | std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets; | |||
698 | // Names of all common block objects in the scope | |||
699 | std::set<SourceName> commonBlockObjects; | |||
700 | // Info about about SAVE statements and attributes in current scope | |||
701 | struct { | |||
702 | std::optional<SourceName> saveAll; // "SAVE" without entity list | |||
703 | std::set<SourceName> entities; // names of entities with save attr | |||
704 | std::set<SourceName> commons; // names of common blocks with save attr | |||
705 | } saveInfo; | |||
706 | } specPartState_; | |||
707 | ||||
708 | // Some declaration processing can and should be deferred to | |||
709 | // ResolveExecutionParts() to avoid prematurely creating implicitly-typed | |||
710 | // local symbols that should be host associations. | |||
711 | struct DeferredDeclarationState { | |||
712 | // The content of each namelist group | |||
713 | std::list<const parser::NamelistStmt::Group *> namelistGroups; | |||
714 | }; | |||
715 | DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) { | |||
716 | if (!add && deferred_.find(&currScope()) == deferred_.end()) { | |||
717 | return nullptr; | |||
718 | } else { | |||
719 | return &deferred_.emplace(&currScope(), DeferredDeclarationState{}) | |||
720 | .first->second; | |||
721 | } | |||
722 | } | |||
723 | ||||
724 | private: | |||
725 | Scope *currScope_{nullptr}; | |||
726 | FuncResultStack funcResultStack_{*this}; | |||
727 | std::map<Scope *, DeferredDeclarationState> deferred_; | |||
728 | }; | |||
729 | ||||
730 | class ModuleVisitor : public virtual ScopeHandler { | |||
731 | public: | |||
732 | bool Pre(const parser::AccessStmt &); | |||
733 | bool Pre(const parser::Only &); | |||
734 | bool Pre(const parser::Rename::Names &); | |||
735 | bool Pre(const parser::Rename::Operators &); | |||
736 | bool Pre(const parser::UseStmt &); | |||
737 | void Post(const parser::UseStmt &); | |||
738 | ||||
739 | void BeginModule(const parser::Name &, bool isSubmodule); | |||
740 | bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &); | |||
741 | void ApplyDefaultAccess(); | |||
742 | Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &); | |||
743 | void AddAndCheckModuleUse(SourceName, bool isIntrinsic); | |||
744 | void ClearUseRenames() { useRenames_.clear(); } | |||
745 | void ClearUseOnly() { useOnly_.clear(); } | |||
746 | void ClearModuleUses() { | |||
747 | intrinsicUses_.clear(); | |||
748 | nonIntrinsicUses_.clear(); | |||
749 | } | |||
750 | ||||
751 | private: | |||
752 | // The default access spec for this module. | |||
753 | Attr defaultAccess_{Attr::PUBLIC}; | |||
754 | // The location of the last AccessStmt without access-ids, if any. | |||
755 | std::optional<SourceName> prevAccessStmt_; | |||
756 | // The scope of the module during a UseStmt | |||
757 | Scope *useModuleScope_{nullptr}; | |||
758 | // Names that have appeared in a rename clause of a USE statement | |||
759 | std::set<std::pair<SourceName, Scope *>> useRenames_; | |||
760 | // Names that have appeared in an ONLY clause of a USE statement | |||
761 | std::set<std::pair<SourceName, Scope *>> useOnly_; | |||
762 | // Intrinsic and non-intrinsic (explicit or not) module names that | |||
763 | // have appeared in USE statements; used for C1406 warnings. | |||
764 | std::set<SourceName> intrinsicUses_; | |||
765 | std::set<SourceName> nonIntrinsicUses_; | |||
766 | ||||
767 | Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr); | |||
768 | // A rename in a USE statement: local => use | |||
769 | struct SymbolRename { | |||
770 | Symbol *local{nullptr}; | |||
771 | Symbol *use{nullptr}; | |||
772 | }; | |||
773 | // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol | |||
774 | SymbolRename AddUse(const SourceName &localName, const SourceName &useName); | |||
775 | SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *); | |||
776 | void DoAddUse( | |||
777 | SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol); | |||
778 | void AddUse(const GenericSpecInfo &); | |||
779 | // If appropriate, erase a previously USE-associated symbol | |||
780 | void EraseRenamedSymbol(const Symbol &); | |||
781 | // Record a name appearing in a USE rename clause | |||
782 | void AddUseRename(const SourceName &name) { | |||
783 | useRenames_.emplace(std::make_pair(name, useModuleScope_)); | |||
784 | } | |||
785 | bool IsUseRenamed(const SourceName &name) const { | |||
786 | return useRenames_.find({name, useModuleScope_}) != useRenames_.end(); | |||
787 | } | |||
788 | // Record a name appearing in a USE ONLY clause | |||
789 | void AddUseOnly(const SourceName &name) { | |||
790 | useOnly_.emplace(std::make_pair(name, useModuleScope_)); | |||
791 | } | |||
792 | bool IsUseOnly(const SourceName &name) const { | |||
793 | return useOnly_.find({name, useModuleScope_}) != useOnly_.end(); | |||
794 | } | |||
795 | Scope *FindModule(const parser::Name &, std::optional<bool> isIntrinsic, | |||
796 | Scope *ancestor = nullptr); | |||
797 | }; | |||
798 | ||||
799 | class InterfaceVisitor : public virtual ScopeHandler { | |||
800 | public: | |||
801 | bool Pre(const parser::InterfaceStmt &); | |||
802 | void Post(const parser::InterfaceStmt &); | |||
803 | void Post(const parser::EndInterfaceStmt &); | |||
804 | bool Pre(const parser::GenericSpec &); | |||
805 | bool Pre(const parser::ProcedureStmt &); | |||
806 | bool Pre(const parser::GenericStmt &); | |||
807 | void Post(const parser::GenericStmt &); | |||
808 | ||||
809 | bool inInterfaceBlock() const; | |||
810 | bool isGeneric() const; | |||
811 | bool isAbstract() const; | |||
812 | ||||
813 | protected: | |||
814 | Symbol &GetGenericSymbol() { return DEREF(genericInfo_.top().symbol)Fortran::common::Deref(genericInfo_.top().symbol, "flang/lib/Semantics/resolve-names.cpp" , 814); } | |||
815 | // Add to generic the symbol for the subprogram with the same name | |||
816 | void CheckGenericProcedures(Symbol &); | |||
817 | ||||
818 | private: | |||
819 | // A new GenericInfo is pushed for each interface block and generic stmt | |||
820 | struct GenericInfo { | |||
821 | GenericInfo(bool isInterface, bool isAbstract = false) | |||
822 | : isInterface{isInterface}, isAbstract{isAbstract} {} | |||
823 | bool isInterface; // in interface block | |||
824 | bool isAbstract; // in abstract interface block | |||
825 | Symbol *symbol{nullptr}; // the generic symbol being defined | |||
826 | }; | |||
827 | std::stack<GenericInfo> genericInfo_; | |||
828 | const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); } | |||
829 | void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; } | |||
830 | ||||
831 | using ProcedureKind = parser::ProcedureStmt::Kind; | |||
832 | // mapping of generic to its specific proc names and kinds | |||
833 | std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>> | |||
834 | specificProcs_; | |||
835 | ||||
836 | void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind); | |||
837 | void ResolveSpecificsInGeneric(Symbol &generic); | |||
838 | }; | |||
839 | ||||
840 | class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor { | |||
841 | public: | |||
842 | bool HandleStmtFunction(const parser::StmtFunctionStmt &); | |||
843 | bool Pre(const parser::SubroutineStmt &); | |||
844 | bool Pre(const parser::FunctionStmt &); | |||
845 | void Post(const parser::FunctionStmt &); | |||
846 | bool Pre(const parser::EntryStmt &); | |||
847 | void Post(const parser::EntryStmt &); | |||
848 | bool Pre(const parser::InterfaceBody::Subroutine &); | |||
849 | void Post(const parser::InterfaceBody::Subroutine &); | |||
850 | bool Pre(const parser::InterfaceBody::Function &); | |||
851 | void Post(const parser::InterfaceBody::Function &); | |||
852 | bool Pre(const parser::Suffix &); | |||
853 | bool Pre(const parser::PrefixSpec &); | |||
854 | ||||
855 | bool BeginSubprogram(const parser::Name &, Symbol::Flag, | |||
856 | bool hasModulePrefix = false, | |||
857 | const parser::LanguageBindingSpec * = nullptr, | |||
858 | const ProgramTree::EntryStmtList * = nullptr); | |||
859 | bool BeginMpSubprogram(const parser::Name &); | |||
860 | void PushBlockDataScope(const parser::Name &); | |||
861 | void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt, | |||
862 | const std::optional<parser::LanguageBindingSpec> * = nullptr, | |||
863 | const ProgramTree::EntryStmtList * = nullptr); | |||
864 | ||||
865 | protected: | |||
866 | // Set when we see a stmt function that is really an array element assignment | |||
867 | bool badStmtFuncFound_{false}; | |||
868 | ||||
869 | private: | |||
870 | // Edits an existing symbol created for earlier calls to a subprogram or ENTRY | |||
871 | // so that it can be replaced by a later definition. | |||
872 | bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag); | |||
873 | void CheckExtantProc(const parser::Name &, Symbol::Flag); | |||
874 | // Create a subprogram symbol in the current scope and push a new scope. | |||
875 | Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag, | |||
876 | const parser::LanguageBindingSpec * = nullptr); | |||
877 | Symbol *GetSpecificFromGeneric(const parser::Name &); | |||
878 | Symbol &PostSubprogramStmt(); | |||
879 | void CreateDummyArgument(SubprogramDetails &, const parser::Name &); | |||
880 | void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram); | |||
881 | void PostEntryStmt(const parser::EntryStmt &stmt); | |||
882 | void HandleLanguageBinding(Symbol *, | |||
883 | std::optional<parser::CharBlock> stmtSource, | |||
884 | const std::optional<parser::LanguageBindingSpec> *); | |||
885 | }; | |||
886 | ||||
887 | class DeclarationVisitor : public ArraySpecVisitor, | |||
888 | public virtual ScopeHandler { | |||
889 | public: | |||
890 | using ArraySpecVisitor::Post; | |||
891 | using ScopeHandler::Post; | |||
892 | using ScopeHandler::Pre; | |||
893 | ||||
894 | bool Pre(const parser::Initialization &); | |||
895 | void Post(const parser::EntityDecl &); | |||
896 | void Post(const parser::ObjectDecl &); | |||
897 | void Post(const parser::PointerDecl &); | |||
898 | bool Pre(const parser::BindStmt &) { return BeginAttrs(); } | |||
899 | void Post(const parser::BindStmt &) { EndAttrs(); } | |||
900 | bool Pre(const parser::BindEntity &); | |||
901 | bool Pre(const parser::OldParameterStmt &); | |||
902 | bool Pre(const parser::NamedConstantDef &); | |||
903 | bool Pre(const parser::NamedConstant &); | |||
904 | void Post(const parser::EnumDef &); | |||
905 | bool Pre(const parser::Enumerator &); | |||
906 | bool Pre(const parser::AccessSpec &); | |||
907 | bool Pre(const parser::AsynchronousStmt &); | |||
908 | bool Pre(const parser::ContiguousStmt &); | |||
909 | bool Pre(const parser::ExternalStmt &); | |||
910 | bool Pre(const parser::IntentStmt &); | |||
911 | bool Pre(const parser::IntrinsicStmt &); | |||
912 | bool Pre(const parser::OptionalStmt &); | |||
913 | bool Pre(const parser::ProtectedStmt &); | |||
914 | bool Pre(const parser::ValueStmt &); | |||
915 | bool Pre(const parser::VolatileStmt &); | |||
916 | bool Pre(const parser::AllocatableStmt &) { | |||
917 | objectDeclAttr_ = Attr::ALLOCATABLE; | |||
918 | return true; | |||
919 | } | |||
920 | void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; } | |||
921 | bool Pre(const parser::TargetStmt &) { | |||
922 | objectDeclAttr_ = Attr::TARGET; | |||
923 | return true; | |||
924 | } | |||
925 | void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; } | |||
926 | void Post(const parser::DimensionStmt::Declaration &); | |||
927 | void Post(const parser::CodimensionDecl &); | |||
928 | bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); } | |||
929 | void Post(const parser::TypeDeclarationStmt &); | |||
930 | void Post(const parser::IntegerTypeSpec &); | |||
931 | void Post(const parser::IntrinsicTypeSpec::Real &); | |||
932 | void Post(const parser::IntrinsicTypeSpec::Complex &); | |||
933 | void Post(const parser::IntrinsicTypeSpec::Logical &); | |||
934 | void Post(const parser::IntrinsicTypeSpec::Character &); | |||
935 | void Post(const parser::CharSelector::LengthAndKind &); | |||
936 | void Post(const parser::CharLength &); | |||
937 | void Post(const parser::LengthSelector &); | |||
938 | bool Pre(const parser::KindParam &); | |||
939 | bool Pre(const parser::DeclarationTypeSpec::Type &); | |||
940 | void Post(const parser::DeclarationTypeSpec::Type &); | |||
941 | bool Pre(const parser::DeclarationTypeSpec::Class &); | |||
942 | void Post(const parser::DeclarationTypeSpec::Class &); | |||
943 | void Post(const parser::DeclarationTypeSpec::Record &); | |||
944 | void Post(const parser::DerivedTypeSpec &); | |||
945 | bool Pre(const parser::DerivedTypeDef &); | |||
946 | bool Pre(const parser::DerivedTypeStmt &); | |||
947 | void Post(const parser::DerivedTypeStmt &); | |||
948 | bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); } | |||
949 | void Post(const parser::TypeParamDefStmt &); | |||
950 | bool Pre(const parser::TypeAttrSpec::Extends &); | |||
951 | bool Pre(const parser::PrivateStmt &); | |||
952 | bool Pre(const parser::SequenceStmt &); | |||
953 | bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); } | |||
954 | void Post(const parser::ComponentDefStmt &) { EndDecl(); } | |||
955 | void Post(const parser::ComponentDecl &); | |||
956 | void Post(const parser::FillDecl &); | |||
957 | bool Pre(const parser::ProcedureDeclarationStmt &); | |||
958 | void Post(const parser::ProcedureDeclarationStmt &); | |||
959 | bool Pre(const parser::DataComponentDefStmt &); // returns false | |||
960 | bool Pre(const parser::ProcComponentDefStmt &); | |||
961 | void Post(const parser::ProcComponentDefStmt &); | |||
962 | bool Pre(const parser::ProcPointerInit &); | |||
963 | void Post(const parser::ProcInterface &); | |||
964 | void Post(const parser::ProcDecl &); | |||
965 | bool Pre(const parser::TypeBoundProcedurePart &); | |||
966 | void Post(const parser::TypeBoundProcedurePart &); | |||
967 | void Post(const parser::ContainsStmt &); | |||
968 | bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); } | |||
969 | void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); } | |||
970 | void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &); | |||
971 | void Post(const parser::TypeBoundProcedureStmt::WithInterface &); | |||
972 | void Post(const parser::FinalProcedureStmt &); | |||
973 | bool Pre(const parser::TypeBoundGenericStmt &); | |||
974 | bool Pre(const parser::StructureDef &); // returns false | |||
975 | bool Pre(const parser::Union::UnionStmt &); | |||
976 | bool Pre(const parser::StructureField &); | |||
977 | void Post(const parser::StructureField &); | |||
978 | bool Pre(const parser::AllocateStmt &); | |||
979 | void Post(const parser::AllocateStmt &); | |||
980 | bool Pre(const parser::StructureConstructor &); | |||
981 | bool Pre(const parser::NamelistStmt::Group &); | |||
982 | bool Pre(const parser::IoControlSpec &); | |||
983 | bool Pre(const parser::CommonStmt::Block &); | |||
984 | bool Pre(const parser::CommonBlockObject &); | |||
985 | void Post(const parser::CommonBlockObject &); | |||
986 | bool Pre(const parser::EquivalenceStmt &); | |||
987 | bool Pre(const parser::SaveStmt &); | |||
988 | bool Pre(const parser::BasedPointerStmt &); | |||
989 | ||||
990 | void PointerInitialization( | |||
991 | const parser::Name &, const parser::InitialDataTarget &); | |||
992 | void PointerInitialization( | |||
993 | const parser::Name &, const parser::ProcPointerInit &); | |||
994 | void NonPointerInitialization( | |||
995 | const parser::Name &, const parser::ConstantExpr &); | |||
996 | void CheckExplicitInterface(const parser::Name &); | |||
997 | void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); | |||
998 | ||||
999 | const parser::Name *ResolveDesignator(const parser::Designator &); | |||
1000 | ||||
1001 | protected: | |||
1002 | bool BeginDecl(); | |||
1003 | void EndDecl(); | |||
1004 | Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{}); | |||
1005 | // Make sure that there's an entity in an enclosing scope called Name | |||
1006 | Symbol &FindOrDeclareEnclosingEntity(const parser::Name &); | |||
1007 | // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified | |||
1008 | // it comes from the entity in the containing scope, or implicit rules. | |||
1009 | // Return pointer to the new symbol, or nullptr on error. | |||
1010 | Symbol *DeclareLocalEntity(const parser::Name &); | |||
1011 | // Declare a statement entity (i.e., an implied DO loop index for | |||
1012 | // a DATA statement or an array constructor). If there isn't an explict | |||
1013 | // type specified, implicit rules apply. Return pointer to the new symbol, | |||
1014 | // or nullptr on error. | |||
1015 | Symbol *DeclareStatementEntity(const parser::DoVariable &, | |||
1016 | const std::optional<parser::IntegerTypeSpec> &); | |||
1017 | Symbol &MakeCommonBlockSymbol(const parser::Name &); | |||
1018 | Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &); | |||
1019 | bool CheckUseError(const parser::Name &); | |||
1020 | void CheckAccessibility(const SourceName &, bool, Symbol &); | |||
1021 | void CheckCommonBlocks(); | |||
1022 | void CheckSaveStmts(); | |||
1023 | void CheckEquivalenceSets(); | |||
1024 | bool CheckNotInBlock(const char *); | |||
1025 | bool NameIsKnownOrIntrinsic(const parser::Name &); | |||
1026 | void FinishNamelists(); | |||
1027 | ||||
1028 | // Each of these returns a pointer to a resolved Name (i.e. with symbol) | |||
1029 | // or nullptr in case of error. | |||
1030 | const parser::Name *ResolveStructureComponent( | |||
1031 | const parser::StructureComponent &); | |||
1032 | const parser::Name *ResolveDataRef(const parser::DataRef &); | |||
1033 | const parser::Name *ResolveName(const parser::Name &); | |||
1034 | bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol); | |||
1035 | Symbol *NoteInterfaceName(const parser::Name &); | |||
1036 | bool IsUplevelReference(const Symbol &); | |||
1037 | ||||
1038 | std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds( | |||
1039 | const parser::DoVariable &name) { | |||
1040 | std::optional<SourceName> result{checkIndexUseInOwnBounds_}; | |||
1041 | checkIndexUseInOwnBounds_ = name.thing.thing.source; | |||
1042 | return result; | |||
1043 | } | |||
1044 | void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) { | |||
1045 | checkIndexUseInOwnBounds_ = restore; | |||
1046 | } | |||
1047 | ||||
1048 | private: | |||
1049 | // The attribute corresponding to the statement containing an ObjectDecl | |||
1050 | std::optional<Attr> objectDeclAttr_; | |||
1051 | // Info about current character type while walking DeclTypeSpec. | |||
1052 | // Also captures any "*length" specifier on an individual declaration. | |||
1053 | struct { | |||
1054 | std::optional<ParamValue> length; | |||
1055 | std::optional<KindExpr> kind; | |||
1056 | } charInfo_; | |||
1057 | // Info about current derived type or STRUCTURE while walking | |||
1058 | // DerivedTypeDef / StructureDef | |||
1059 | struct { | |||
1060 | const parser::Name *extends{nullptr}; // EXTENDS(name) | |||
1061 | bool privateComps{false}; // components are private by default | |||
1062 | bool privateBindings{false}; // bindings are private by default | |||
1063 | bool sawContains{false}; // currently processing bindings | |||
1064 | bool sequence{false}; // is a sequence type | |||
1065 | const Symbol *type{nullptr}; // derived type being defined | |||
1066 | bool isStructure{false}; // is a DEC STRUCTURE | |||
1067 | } derivedTypeInfo_; | |||
1068 | // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is | |||
1069 | // the interface name, if any. | |||
1070 | const parser::Name *interfaceName_{nullptr}; | |||
1071 | // Map type-bound generic to binding names of its specific bindings | |||
1072 | std::multimap<Symbol *, const parser::Name *> genericBindings_; | |||
1073 | // Info about current ENUM | |||
1074 | struct EnumeratorState { | |||
1075 | // Enum value must hold inside a C_INT (7.6.2). | |||
1076 | std::optional<int> value{0}; | |||
1077 | } enumerationState_; | |||
1078 | // Set for OldParameterStmt processing | |||
1079 | bool inOldStyleParameterStmt_{false}; | |||
1080 | // Set when walking DATA & array constructor implied DO loop bounds | |||
1081 | // to warn about use of the implied DO intex therein. | |||
1082 | std::optional<SourceName> checkIndexUseInOwnBounds_; | |||
1083 | bool hasBindCName_{false}; | |||
1084 | ||||
1085 | bool HandleAttributeStmt(Attr, const std::list<parser::Name> &); | |||
1086 | Symbol &HandleAttributeStmt(Attr, const parser::Name &); | |||
1087 | Symbol &DeclareUnknownEntity(const parser::Name &, Attrs); | |||
1088 | Symbol &DeclareProcEntity( | |||
1089 | const parser::Name &, Attrs, const Symbol *interface); | |||
1090 | void SetType(const parser::Name &, const DeclTypeSpec &); | |||
1091 | std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &); | |||
1092 | std::optional<DerivedTypeSpec> ResolveExtendsType( | |||
1093 | const parser::Name &, const parser::Name *); | |||
1094 | Symbol *MakeTypeSymbol(const SourceName &, Details &&); | |||
1095 | Symbol *MakeTypeSymbol(const parser::Name &, Details &&); | |||
1096 | bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr); | |||
1097 | ParamValue GetParamValue( | |||
1098 | const parser::TypeParamValue &, common::TypeParamAttr attr); | |||
1099 | void CheckCommonBlockDerivedType(const SourceName &, const Symbol &); | |||
1100 | Attrs HandleSaveName(const SourceName &, Attrs); | |||
1101 | void AddSaveName(std::set<SourceName> &, const SourceName &); | |||
1102 | bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &); | |||
1103 | const parser::Name *FindComponent(const parser::Name *, const parser::Name &); | |||
1104 | void Initialization(const parser::Name &, const parser::Initialization &, | |||
1105 | bool inComponentDecl); | |||
1106 | bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol); | |||
1107 | bool CheckForHostAssociatedImplicit(const parser::Name &); | |||
1108 | ||||
1109 | // Declare an object or procedure entity. | |||
1110 | // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails | |||
1111 | template <typename T> | |||
1112 | Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) { | |||
1113 | Symbol &symbol{MakeSymbol(name, attrs)}; | |||
1114 | if (context().HasError(symbol) || symbol.has<T>()) { | |||
1115 | return symbol; // OK or error already reported | |||
1116 | } else if (symbol.has<UnknownDetails>()) { | |||
1117 | symbol.set_details(T{}); | |||
1118 | return symbol; | |||
1119 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
1120 | symbol.set_details(T{std::move(*details)}); | |||
1121 | return symbol; | |||
1122 | } else if (std::is_same_v<EntityDetails, T> && | |||
1123 | (symbol.has<ObjectEntityDetails>() || | |||
1124 | symbol.has<ProcEntityDetails>())) { | |||
1125 | return symbol; // OK | |||
1126 | } else if (auto *details{symbol.detailsIf<UseDetails>()}) { | |||
1127 | Say(name.source, | |||
1128 | "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US, | |||
1129 | name.source, GetUsedModule(*details).name()); | |||
1130 | } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) { | |||
1131 | if (details->kind() == SubprogramKind::Module) { | |||
1132 | Say2(name, | |||
1133 | "Declaration of '%s' conflicts with its use as module procedure"_err_en_US, | |||
1134 | symbol, "Module procedure definition"_en_US); | |||
1135 | } else if (details->kind() == SubprogramKind::Internal) { | |||
1136 | Say2(name, | |||
1137 | "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US, | |||
1138 | symbol, "Internal procedure definition"_en_US); | |||
1139 | } else { | |||
1140 | DIE("unexpected kind")Fortran::common::die("unexpected kind" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1140); | |||
1141 | } | |||
1142 | } else if (std::is_same_v<ObjectEntityDetails, T> && | |||
1143 | symbol.has<ProcEntityDetails>()) { | |||
1144 | SayWithDecl( | |||
1145 | name, symbol, "'%s' is already declared as a procedure"_err_en_US); | |||
1146 | } else if (std::is_same_v<ProcEntityDetails, T> && | |||
1147 | symbol.has<ObjectEntityDetails>()) { | |||
1148 | if (FindCommonBlockContaining(symbol)) { | |||
1149 | SayWithDecl(name, symbol, | |||
1150 | "'%s' may not be a procedure as it is in a COMMON block"_err_en_US); | |||
1151 | } else { | |||
1152 | SayWithDecl( | |||
1153 | name, symbol, "'%s' is already declared as an object"_err_en_US); | |||
1154 | } | |||
1155 | } else if (!CheckPossibleBadForwardRef(symbol)) { | |||
1156 | SayAlreadyDeclared(name, symbol); | |||
1157 | } | |||
1158 | context().SetError(symbol); | |||
1159 | return symbol; | |||
1160 | } | |||
1161 | bool HasCycle(const Symbol &, const Symbol *interface); | |||
1162 | }; | |||
1163 | ||||
1164 | // Resolve construct entities and statement entities. | |||
1165 | // Check that construct names don't conflict with other names. | |||
1166 | class ConstructVisitor : public virtual DeclarationVisitor { | |||
1167 | public: | |||
1168 | bool Pre(const parser::ConcurrentHeader &); | |||
1169 | bool Pre(const parser::LocalitySpec::Local &); | |||
1170 | bool Pre(const parser::LocalitySpec::LocalInit &); | |||
1171 | bool Pre(const parser::LocalitySpec::Shared &); | |||
1172 | bool Pre(const parser::AcSpec &); | |||
1173 | bool Pre(const parser::AcImpliedDo &); | |||
1174 | bool Pre(const parser::DataImpliedDo &); | |||
1175 | bool Pre(const parser::DataIDoObject &); | |||
1176 | bool Pre(const parser::DataStmtObject &); | |||
1177 | bool Pre(const parser::DataStmtValue &); | |||
1178 | bool Pre(const parser::DoConstruct &); | |||
1179 | void Post(const parser::DoConstruct &); | |||
1180 | bool Pre(const parser::ForallConstruct &); | |||
1181 | void Post(const parser::ForallConstruct &); | |||
1182 | bool Pre(const parser::ForallStmt &); | |||
1183 | void Post(const parser::ForallStmt &); | |||
1184 | bool Pre(const parser::BlockStmt &); | |||
1185 | bool Pre(const parser::EndBlockStmt &); | |||
1186 | void Post(const parser::Selector &); | |||
1187 | void Post(const parser::AssociateStmt &); | |||
1188 | void Post(const parser::EndAssociateStmt &); | |||
1189 | bool Pre(const parser::Association &); | |||
1190 | void Post(const parser::SelectTypeStmt &); | |||
1191 | void Post(const parser::SelectRankStmt &); | |||
1192 | bool Pre(const parser::SelectTypeConstruct &); | |||
1193 | void Post(const parser::SelectTypeConstruct &); | |||
1194 | bool Pre(const parser::SelectTypeConstruct::TypeCase &); | |||
1195 | void Post(const parser::SelectTypeConstruct::TypeCase &); | |||
1196 | // Creates Block scopes with neither symbol name nor symbol details. | |||
1197 | bool Pre(const parser::SelectRankConstruct::RankCase &); | |||
1198 | void Post(const parser::SelectRankConstruct::RankCase &); | |||
1199 | bool Pre(const parser::TypeGuardStmt::Guard &); | |||
1200 | void Post(const parser::TypeGuardStmt::Guard &); | |||
1201 | void Post(const parser::SelectRankCaseStmt::Rank &); | |||
1202 | bool Pre(const parser::ChangeTeamStmt &); | |||
1203 | void Post(const parser::EndChangeTeamStmt &); | |||
1204 | void Post(const parser::CoarrayAssociation &); | |||
1205 | ||||
1206 | // Definitions of construct names | |||
1207 | bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); } | |||
1208 | bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); } | |||
1209 | bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); } | |||
1210 | bool Pre(const parser::LabelDoStmt &) { | |||
1211 | return false; // error recovery | |||
1212 | } | |||
1213 | bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); } | |||
1214 | bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); } | |||
1215 | bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); } | |||
1216 | bool Pre(const parser::SelectRankConstruct &); | |||
1217 | void Post(const parser::SelectRankConstruct &); | |||
1218 | bool Pre(const parser::SelectRankStmt &x) { | |||
1219 | return CheckDef(std::get<0>(x.t)); | |||
1220 | } | |||
1221 | bool Pre(const parser::SelectTypeStmt &x) { | |||
1222 | return CheckDef(std::get<0>(x.t)); | |||
1223 | } | |||
1224 | ||||
1225 | // References to construct names | |||
1226 | void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); } | |||
1227 | void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); } | |||
1228 | void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); } | |||
1229 | void Post(const parser::EndForallStmt &x) { CheckRef(x.v); } | |||
1230 | void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); } | |||
1231 | void Post(const parser::EndDoStmt &x) { CheckRef(x.v); } | |||
1232 | void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); } | |||
1233 | void Post(const parser::ElseStmt &x) { CheckRef(x.v); } | |||
1234 | void Post(const parser::EndIfStmt &x) { CheckRef(x.v); } | |||
1235 | void Post(const parser::CaseStmt &x) { CheckRef(x.t); } | |||
1236 | void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); } | |||
1237 | void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); } | |||
1238 | void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); } | |||
1239 | void Post(const parser::CycleStmt &x) { CheckRef(x.v); } | |||
1240 | void Post(const parser::ExitStmt &x) { CheckRef(x.v); } | |||
1241 | ||||
1242 | private: | |||
1243 | // R1105 selector -> expr | variable | |||
1244 | // expr is set in either case unless there were errors | |||
1245 | struct Selector { | |||
1246 | Selector() {} | |||
1247 | Selector(const SourceName &source, MaybeExpr &&expr) | |||
1248 | : source{source}, expr{std::move(expr)} {} | |||
1249 | operator bool() const { return expr.has_value(); } | |||
1250 | parser::CharBlock source; | |||
1251 | MaybeExpr expr; | |||
1252 | }; | |||
1253 | // association -> [associate-name =>] selector | |||
1254 | struct Association { | |||
1255 | const parser::Name *name{nullptr}; | |||
1256 | Selector selector; | |||
1257 | }; | |||
1258 | std::vector<Association> associationStack_; | |||
1259 | Association *currentAssociation_{nullptr}; | |||
1260 | ||||
1261 | template <typename T> bool CheckDef(const T &t) { | |||
1262 | return CheckDef(std::get<std::optional<parser::Name>>(t)); | |||
1263 | } | |||
1264 | template <typename T> void CheckRef(const T &t) { | |||
1265 | CheckRef(std::get<std::optional<parser::Name>>(t)); | |||
1266 | } | |||
1267 | bool CheckDef(const std::optional<parser::Name> &); | |||
1268 | void CheckRef(const std::optional<parser::Name> &); | |||
1269 | const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&); | |||
1270 | const DeclTypeSpec &ToDeclTypeSpec( | |||
1271 | evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length); | |||
1272 | Symbol *MakeAssocEntity(); | |||
1273 | void SetTypeFromAssociation(Symbol &); | |||
1274 | void SetAttrsFromAssociation(Symbol &); | |||
1275 | Selector ResolveSelector(const parser::Selector &); | |||
1276 | void ResolveIndexName(const parser::ConcurrentControl &control); | |||
1277 | void SetCurrentAssociation(std::size_t n); | |||
1278 | Association &GetCurrentAssociation(); | |||
1279 | void PushAssociation(); | |||
1280 | void PopAssociation(std::size_t count = 1); | |||
1281 | }; | |||
1282 | ||||
1283 | // Create scopes for OpenACC constructs | |||
1284 | class AccVisitor : public virtual DeclarationVisitor { | |||
1285 | public: | |||
1286 | void AddAccSourceRange(const parser::CharBlock &); | |||
1287 | ||||
1288 | static bool NeedsScope(const parser::OpenACCBlockConstruct &); | |||
1289 | ||||
1290 | bool Pre(const parser::OpenACCBlockConstruct &); | |||
1291 | void Post(const parser::OpenACCBlockConstruct &); | |||
1292 | bool Pre(const parser::AccBeginBlockDirective &x) { | |||
1293 | AddAccSourceRange(x.source); | |||
1294 | return true; | |||
1295 | } | |||
1296 | void Post(const parser::AccBeginBlockDirective &) { | |||
1297 | messageHandler().set_currStmtSource(std::nullopt); | |||
1298 | } | |||
1299 | bool Pre(const parser::AccEndBlockDirective &x) { | |||
1300 | AddAccSourceRange(x.source); | |||
1301 | return true; | |||
1302 | } | |||
1303 | void Post(const parser::AccEndBlockDirective &) { | |||
1304 | messageHandler().set_currStmtSource(std::nullopt); | |||
1305 | } | |||
1306 | bool Pre(const parser::AccBeginLoopDirective &x) { | |||
1307 | AddAccSourceRange(x.source); | |||
1308 | return true; | |||
1309 | } | |||
1310 | void Post(const parser::AccBeginLoopDirective &x) { | |||
1311 | messageHandler().set_currStmtSource(std::nullopt); | |||
1312 | } | |||
1313 | }; | |||
1314 | ||||
1315 | bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) { | |||
1316 | const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; | |||
1317 | const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; | |||
1318 | switch (beginDir.v) { | |||
1319 | case llvm::acc::Directive::ACCD_data: | |||
1320 | case llvm::acc::Directive::ACCD_host_data: | |||
1321 | case llvm::acc::Directive::ACCD_kernels: | |||
1322 | case llvm::acc::Directive::ACCD_parallel: | |||
1323 | case llvm::acc::Directive::ACCD_serial: | |||
1324 | return true; | |||
1325 | default: | |||
1326 | return false; | |||
1327 | } | |||
1328 | } | |||
1329 | ||||
1330 | void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) { | |||
1331 | messageHandler().set_currStmtSource(source); | |||
1332 | currScope().AddSourceRange(source); | |||
1333 | } | |||
1334 | ||||
1335 | bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) { | |||
1336 | if (NeedsScope(x)) { | |||
1337 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1338 | } | |||
1339 | return true; | |||
1340 | } | |||
1341 | ||||
1342 | void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) { | |||
1343 | if (NeedsScope(x)) { | |||
1344 | PopScope(); | |||
1345 | } | |||
1346 | } | |||
1347 | ||||
1348 | // Create scopes for OpenMP constructs | |||
1349 | class OmpVisitor : public virtual DeclarationVisitor { | |||
1350 | public: | |||
1351 | void AddOmpSourceRange(const parser::CharBlock &); | |||
1352 | ||||
1353 | static bool NeedsScope(const parser::OpenMPBlockConstruct &); | |||
1354 | ||||
1355 | bool Pre(const parser::OpenMPBlockConstruct &); | |||
1356 | void Post(const parser::OpenMPBlockConstruct &); | |||
1357 | bool Pre(const parser::OmpBeginBlockDirective &x) { | |||
1358 | AddOmpSourceRange(x.source); | |||
1359 | return true; | |||
1360 | } | |||
1361 | void Post(const parser::OmpBeginBlockDirective &) { | |||
1362 | messageHandler().set_currStmtSource(std::nullopt); | |||
1363 | } | |||
1364 | bool Pre(const parser::OmpEndBlockDirective &x) { | |||
1365 | AddOmpSourceRange(x.source); | |||
1366 | return true; | |||
1367 | } | |||
1368 | void Post(const parser::OmpEndBlockDirective &) { | |||
1369 | messageHandler().set_currStmtSource(std::nullopt); | |||
1370 | } | |||
1371 | ||||
1372 | bool Pre(const parser::OpenMPLoopConstruct &) { | |||
1373 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1374 | return true; | |||
1375 | } | |||
1376 | void Post(const parser::OpenMPLoopConstruct &) { PopScope(); } | |||
1377 | bool Pre(const parser::OmpBeginLoopDirective &x) { | |||
1378 | AddOmpSourceRange(x.source); | |||
1379 | return true; | |||
1380 | } | |||
1381 | void Post(const parser::OmpBeginLoopDirective &) { | |||
1382 | messageHandler().set_currStmtSource(std::nullopt); | |||
1383 | } | |||
1384 | bool Pre(const parser::OmpEndLoopDirective &x) { | |||
1385 | AddOmpSourceRange(x.source); | |||
1386 | return true; | |||
1387 | } | |||
1388 | void Post(const parser::OmpEndLoopDirective &) { | |||
1389 | messageHandler().set_currStmtSource(std::nullopt); | |||
1390 | } | |||
1391 | ||||
1392 | bool Pre(const parser::OpenMPSectionsConstruct &) { | |||
1393 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1394 | return true; | |||
1395 | } | |||
1396 | void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); } | |||
1397 | bool Pre(const parser::OmpBeginSectionsDirective &x) { | |||
1398 | AddOmpSourceRange(x.source); | |||
1399 | return true; | |||
1400 | } | |||
1401 | void Post(const parser::OmpBeginSectionsDirective &) { | |||
1402 | messageHandler().set_currStmtSource(std::nullopt); | |||
1403 | } | |||
1404 | bool Pre(const parser::OmpEndSectionsDirective &x) { | |||
1405 | AddOmpSourceRange(x.source); | |||
1406 | return true; | |||
1407 | } | |||
1408 | void Post(const parser::OmpEndSectionsDirective &) { | |||
1409 | messageHandler().set_currStmtSource(std::nullopt); | |||
1410 | } | |||
1411 | }; | |||
1412 | ||||
1413 | bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) { | |||
1414 | const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; | |||
1415 | const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; | |||
1416 | switch (beginDir.v) { | |||
1417 | case llvm::omp::Directive::OMPD_master: | |||
1418 | case llvm::omp::Directive::OMPD_ordered: | |||
1419 | case llvm::omp::Directive::OMPD_taskgroup: | |||
1420 | return false; | |||
1421 | default: | |||
1422 | return true; | |||
1423 | } | |||
1424 | } | |||
1425 | ||||
1426 | void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) { | |||
1427 | messageHandler().set_currStmtSource(source); | |||
1428 | currScope().AddSourceRange(source); | |||
1429 | } | |||
1430 | ||||
1431 | bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) { | |||
1432 | if (NeedsScope(x)) { | |||
1433 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
1434 | } | |||
1435 | return true; | |||
1436 | } | |||
1437 | ||||
1438 | void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) { | |||
1439 | if (NeedsScope(x)) { | |||
1440 | PopScope(); | |||
1441 | } | |||
1442 | } | |||
1443 | ||||
1444 | // Walk the parse tree and resolve names to symbols. | |||
1445 | class ResolveNamesVisitor : public virtual ScopeHandler, | |||
1446 | public ModuleVisitor, | |||
1447 | public SubprogramVisitor, | |||
1448 | public ConstructVisitor, | |||
1449 | public OmpVisitor, | |||
1450 | public AccVisitor { | |||
1451 | public: | |||
1452 | using AccVisitor::Post; | |||
1453 | using AccVisitor::Pre; | |||
1454 | using ArraySpecVisitor::Post; | |||
1455 | using ConstructVisitor::Post; | |||
1456 | using ConstructVisitor::Pre; | |||
1457 | using DeclarationVisitor::Post; | |||
1458 | using DeclarationVisitor::Pre; | |||
1459 | using ImplicitRulesVisitor::Post; | |||
1460 | using ImplicitRulesVisitor::Pre; | |||
1461 | using InterfaceVisitor::Post; | |||
1462 | using InterfaceVisitor::Pre; | |||
1463 | using ModuleVisitor::Post; | |||
1464 | using ModuleVisitor::Pre; | |||
1465 | using OmpVisitor::Post; | |||
1466 | using OmpVisitor::Pre; | |||
1467 | using ScopeHandler::Post; | |||
1468 | using ScopeHandler::Pre; | |||
1469 | using SubprogramVisitor::Post; | |||
1470 | using SubprogramVisitor::Pre; | |||
1471 | ||||
1472 | ResolveNamesVisitor( | |||
1473 | SemanticsContext &context, ImplicitRulesMap &rules, Scope &top) | |||
1474 | : BaseVisitor{context, *this, rules}, topScope_{top} { | |||
1475 | PushScope(top); | |||
1476 | } | |||
1477 | ||||
1478 | Scope &topScope() const { return topScope_; } | |||
1479 | ||||
1480 | // Default action for a parse tree node is to visit children. | |||
1481 | template <typename T> bool Pre(const T &) { return true; } | |||
1482 | template <typename T> void Post(const T &) {} | |||
1483 | ||||
1484 | bool Pre(const parser::SpecificationPart &); | |||
1485 | bool Pre(const parser::Program &); | |||
1486 | void Post(const parser::Program &); | |||
1487 | bool Pre(const parser::ImplicitStmt &); | |||
1488 | void Post(const parser::PointerObject &); | |||
1489 | void Post(const parser::AllocateObject &); | |||
1490 | bool Pre(const parser::PointerAssignmentStmt &); | |||
1491 | void Post(const parser::Designator &); | |||
1492 | void Post(const parser::SubstringInquiry &); | |||
1493 | template <typename A, typename B> | |||
1494 | void Post(const parser::LoopBounds<A, B> &x) { | |||
1495 | ResolveName(*parser::Unwrap<parser::Name>(x.name)); | |||
1496 | } | |||
1497 | void Post(const parser::ProcComponentRef &); | |||
1498 | bool Pre(const parser::FunctionReference &); | |||
1499 | bool Pre(const parser::CallStmt &); | |||
1500 | bool Pre(const parser::ImportStmt &); | |||
1501 | void Post(const parser::TypeGuardStmt &); | |||
1502 | bool Pre(const parser::StmtFunctionStmt &); | |||
1503 | bool Pre(const parser::DefinedOpName &); | |||
1504 | bool Pre(const parser::ProgramUnit &); | |||
1505 | void Post(const parser::AssignStmt &); | |||
1506 | void Post(const parser::AssignedGotoStmt &); | |||
1507 | void Post(const parser::CompilerDirective &); | |||
1508 | ||||
1509 | // These nodes should never be reached: they are handled in ProgramUnit | |||
1510 | bool Pre(const parser::MainProgram &) { | |||
1511 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1511); | |||
1512 | } | |||
1513 | bool Pre(const parser::FunctionSubprogram &) { | |||
1514 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1514); | |||
1515 | } | |||
1516 | bool Pre(const parser::SubroutineSubprogram &) { | |||
1517 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1517); | |||
1518 | } | |||
1519 | bool Pre(const parser::SeparateModuleSubprogram &) { | |||
1520 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1520); | |||
1521 | } | |||
1522 | bool Pre(const parser::Module &) { | |||
1523 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1523); | |||
1524 | } | |||
1525 | bool Pre(const parser::Submodule &) { | |||
1526 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1526); | |||
1527 | } | |||
1528 | bool Pre(const parser::BlockData &) { | |||
1529 | llvm_unreachable("This node is handled in ProgramUnit")::llvm::llvm_unreachable_internal("This node is handled in ProgramUnit" , "flang/lib/Semantics/resolve-names.cpp", 1529); | |||
1530 | } | |||
1531 | ||||
1532 | void NoteExecutablePartCall(Symbol::Flag, const parser::Call &); | |||
1533 | ||||
1534 | friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &); | |||
1535 | ||||
1536 | private: | |||
1537 | // Kind of procedure we are expecting to see in a ProcedureDesignator | |||
1538 | std::optional<Symbol::Flag> expectedProcFlag_; | |||
1539 | std::optional<SourceName> prevImportStmt_; | |||
1540 | Scope &topScope_; | |||
1541 | ||||
1542 | void PreSpecificationConstruct(const parser::SpecificationConstruct &); | |||
1543 | void CreateCommonBlockSymbols(const parser::CommonStmt &); | |||
1544 | void CreateGeneric(const parser::GenericSpec &); | |||
1545 | void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &); | |||
1546 | void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &); | |||
1547 | void CheckImports(); | |||
1548 | void CheckImport(const SourceName &, const SourceName &); | |||
1549 | void HandleCall(Symbol::Flag, const parser::Call &); | |||
1550 | void HandleProcedureName(Symbol::Flag, const parser::Name &); | |||
1551 | bool CheckImplicitNoneExternal(const SourceName &, const Symbol &); | |||
1552 | bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag); | |||
1553 | void ResolveSpecificationParts(ProgramTree &); | |||
1554 | void AddSubpNames(ProgramTree &); | |||
1555 | bool BeginScopeForNode(const ProgramTree &); | |||
1556 | void EndScopeForNode(const ProgramTree &); | |||
1557 | void FinishSpecificationParts(const ProgramTree &); | |||
1558 | void FinishDerivedTypeInstantiation(Scope &); | |||
1559 | void ResolveExecutionParts(const ProgramTree &); | |||
1560 | }; | |||
1561 | ||||
1562 | // ImplicitRules implementation | |||
1563 | ||||
1564 | bool ImplicitRules::isImplicitNoneType() const { | |||
1565 | if (isImplicitNoneType_) { | |||
1566 | return true; | |||
1567 | } else if (map_.empty() && inheritFromParent_) { | |||
1568 | return parent_->isImplicitNoneType(); | |||
1569 | } else { | |||
1570 | return false; // default if not specified | |||
1571 | } | |||
1572 | } | |||
1573 | ||||
1574 | bool ImplicitRules::isImplicitNoneExternal() const { | |||
1575 | if (isImplicitNoneExternal_) { | |||
1576 | return true; | |||
1577 | } else if (inheritFromParent_) { | |||
1578 | return parent_->isImplicitNoneExternal(); | |||
1579 | } else { | |||
1580 | return false; // default if not specified | |||
1581 | } | |||
1582 | } | |||
1583 | ||||
1584 | const DeclTypeSpec *ImplicitRules::GetType( | |||
1585 | SourceName name, bool respectImplicitNoneType) const { | |||
1586 | char ch{name.begin()[0]}; | |||
1587 | if (isImplicitNoneType_ && respectImplicitNoneType) { | |||
1588 | return nullptr; | |||
1589 | } else if (auto it{map_.find(ch)}; it != map_.end()) { | |||
1590 | return &*it->second; | |||
1591 | } else if (inheritFromParent_) { | |||
1592 | return parent_->GetType(name, respectImplicitNoneType); | |||
1593 | } else if (ch >= 'i' && ch <= 'n') { | |||
1594 | return &context_.MakeNumericType(TypeCategory::Integer); | |||
1595 | } else if (ch >= 'a' && ch <= 'z') { | |||
1596 | return &context_.MakeNumericType(TypeCategory::Real); | |||
1597 | } else { | |||
1598 | return nullptr; | |||
1599 | } | |||
1600 | } | |||
1601 | ||||
1602 | void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type, | |||
1603 | parser::Location fromLetter, parser::Location toLetter) { | |||
1604 | for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) { | |||
1605 | auto res{map_.emplace(ch, type)}; | |||
1606 | if (!res.second) { | |||
1607 | context_.Say(parser::CharBlock{fromLetter}, | |||
1608 | "More than one implicit type specified for '%c'"_err_en_US, ch); | |||
1609 | } | |||
1610 | if (ch == *toLetter) { | |||
1611 | break; | |||
1612 | } | |||
1613 | } | |||
1614 | } | |||
1615 | ||||
1616 | // Return the next char after ch in a way that works for ASCII or EBCDIC. | |||
1617 | // Return '\0' for the char after 'z'. | |||
1618 | char ImplicitRules::Incr(char ch) { | |||
1619 | switch (ch) { | |||
1620 | case 'i': | |||
1621 | return 'j'; | |||
1622 | case 'r': | |||
1623 | return 's'; | |||
1624 | case 'z': | |||
1625 | return '\0'; | |||
1626 | default: | |||
1627 | return ch + 1; | |||
1628 | } | |||
1629 | } | |||
1630 | ||||
1631 | llvm::raw_ostream &operator<<( | |||
1632 | llvm::raw_ostream &o, const ImplicitRules &implicitRules) { | |||
1633 | o << "ImplicitRules:\n"; | |||
1634 | for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) { | |||
1635 | ShowImplicitRule(o, implicitRules, ch); | |||
1636 | } | |||
1637 | ShowImplicitRule(o, implicitRules, '_'); | |||
1638 | ShowImplicitRule(o, implicitRules, '$'); | |||
1639 | ShowImplicitRule(o, implicitRules, '@'); | |||
1640 | return o; | |||
1641 | } | |||
1642 | void ShowImplicitRule( | |||
1643 | llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) { | |||
1644 | auto it{implicitRules.map_.find(ch)}; | |||
1645 | if (it != implicitRules.map_.end()) { | |||
1646 | o << " " << ch << ": " << *it->second << '\n'; | |||
1647 | } | |||
1648 | } | |||
1649 | ||||
1650 | template <typename T> void BaseVisitor::Walk(const T &x) { | |||
1651 | parser::Walk(x, *this_); | |||
1652 | } | |||
1653 | ||||
1654 | void BaseVisitor::MakePlaceholder( | |||
1655 | const parser::Name &name, MiscDetails::Kind kind) { | |||
1656 | if (!name.symbol) { | |||
1657 | name.symbol = &context_->globalScope().MakeSymbol( | |||
1658 | name.source, Attrs{}, MiscDetails{kind}); | |||
1659 | } | |||
1660 | } | |||
1661 | ||||
1662 | // AttrsVisitor implementation | |||
1663 | ||||
1664 | bool AttrsVisitor::BeginAttrs() { | |||
1665 | CHECK(!attrs_)((!attrs_) || (Fortran::common::die("CHECK(" "!attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1665) , false)); | |||
1666 | attrs_ = std::make_optional<Attrs>(); | |||
1667 | return true; | |||
1668 | } | |||
1669 | Attrs AttrsVisitor::GetAttrs() { | |||
1670 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1670) , false)); | |||
1671 | return *attrs_; | |||
1672 | } | |||
1673 | Attrs AttrsVisitor::EndAttrs() { | |||
1674 | Attrs result{GetAttrs()}; | |||
1675 | attrs_.reset(); | |||
1676 | passName_ = std::nullopt; | |||
1677 | bindName_.reset(); | |||
1678 | return result; | |||
1679 | } | |||
1680 | ||||
1681 | bool AttrsVisitor::SetPassNameOn(Symbol &symbol) { | |||
1682 | if (!passName_) { | |||
1683 | return false; | |||
1684 | } | |||
1685 | common::visit(common::visitors{ | |||
1686 | [&](ProcEntityDetails &x) { x.set_passName(*passName_); }, | |||
1687 | [&](ProcBindingDetails &x) { x.set_passName(*passName_); }, | |||
1688 | [](auto &) { common::die("unexpected pass name"); }, | |||
1689 | }, | |||
1690 | symbol.details()); | |||
1691 | return true; | |||
1692 | } | |||
1693 | ||||
1694 | void AttrsVisitor::SetBindNameOn(Symbol &symbol) { | |||
1695 | if (!attrs_ || !attrs_->test(Attr::BIND_C)) { | |||
1696 | return; | |||
1697 | } | |||
1698 | std::optional<std::string> label{ | |||
1699 | evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)}; | |||
1700 | // 18.9.2(2): discard leading and trailing blanks | |||
1701 | if (label) { | |||
1702 | symbol.SetIsExplicitBindName(true); | |||
1703 | auto first{label->find_first_not_of(" ")}; | |||
1704 | if (first == std::string::npos) { | |||
1705 | // Empty NAME= means no binding at all (18.10.2p2) | |||
1706 | return; | |||
1707 | } | |||
1708 | auto last{label->find_last_not_of(" ")}; | |||
1709 | label = label->substr(first, last - first + 1); | |||
1710 | } else { | |||
1711 | label = symbol.name().ToString(); | |||
1712 | } | |||
1713 | // Check if a symbol has two Bind names. | |||
1714 | std::string oldBindName; | |||
1715 | if (symbol.GetBindName()) { | |||
1716 | oldBindName = *symbol.GetBindName(); | |||
1717 | } | |||
1718 | symbol.SetBindName(std::move(*label)); | |||
1719 | if (!oldBindName.empty()) { | |||
1720 | if (const std::string * newBindName{symbol.GetBindName()}) { | |||
1721 | if (oldBindName != *newBindName) { | |||
1722 | Say(symbol.name(), "The entity '%s' has multiple BIND names"_err_en_US); | |||
1723 | } | |||
1724 | } | |||
1725 | } | |||
1726 | } | |||
1727 | ||||
1728 | void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) { | |||
1729 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1729) , false)); | |||
1730 | if (CheckAndSet(Attr::BIND_C)) { | |||
1731 | if (x.v) { | |||
1732 | bindName_ = EvaluateExpr(*x.v); | |||
1733 | } | |||
1734 | } | |||
1735 | } | |||
1736 | bool AttrsVisitor::Pre(const parser::IntentSpec &x) { | |||
1737 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1737) , false)); | |||
1738 | CheckAndSet(IntentSpecToAttr(x)); | |||
1739 | return false; | |||
1740 | } | |||
1741 | bool AttrsVisitor::Pre(const parser::Pass &x) { | |||
1742 | if (CheckAndSet(Attr::PASS)) { | |||
1743 | if (x.v) { | |||
1744 | passName_ = x.v->source; | |||
1745 | MakePlaceholder(*x.v, MiscDetails::Kind::PassName); | |||
1746 | } | |||
1747 | } | |||
1748 | return false; | |||
1749 | } | |||
1750 | ||||
1751 | // C730, C743, C755, C778, C1543 say no attribute or prefix repetitions | |||
1752 | bool AttrsVisitor::IsDuplicateAttr(Attr attrName) { | |||
1753 | if (attrs_->test(attrName)) { | |||
1754 | Say(currStmtSource().value(), | |||
1755 | "Attribute '%s' cannot be used more than once"_warn_en_US, | |||
1756 | AttrToString(attrName)); | |||
1757 | return true; | |||
1758 | } | |||
1759 | return false; | |||
1760 | } | |||
1761 | ||||
1762 | // See if attrName violates a constraint cause by a conflict. attr1 and attr2 | |||
1763 | // name attributes that cannot be used on the same declaration | |||
1764 | bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) { | |||
1765 | if ((attrName == attr1 && attrs_->test(attr2)) || | |||
1766 | (attrName == attr2 && attrs_->test(attr1))) { | |||
1767 | Say(currStmtSource().value(), | |||
1768 | "Attributes '%s' and '%s' conflict with each other"_err_en_US, | |||
1769 | AttrToString(attr1), AttrToString(attr2)); | |||
1770 | return true; | |||
1771 | } | |||
1772 | return false; | |||
1773 | } | |||
1774 | // C759, C1543 | |||
1775 | bool AttrsVisitor::IsConflictingAttr(Attr attrName) { | |||
1776 | return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) || | |||
1777 | HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) || | |||
1778 | HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) || | |||
1779 | HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781 | |||
1780 | HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) || | |||
1781 | HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) || | |||
1782 | HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE); | |||
1783 | } | |||
1784 | bool AttrsVisitor::CheckAndSet(Attr attrName) { | |||
1785 | CHECK(attrs_)((attrs_) || (Fortran::common::die("CHECK(" "attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1785) , false)); | |||
1786 | if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) { | |||
1787 | return false; | |||
1788 | } | |||
1789 | attrs_->set(attrName); | |||
1790 | return true; | |||
1791 | } | |||
1792 | ||||
1793 | // DeclTypeSpecVisitor implementation | |||
1794 | ||||
1795 | const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { | |||
1796 | return state_.declTypeSpec; | |||
1797 | } | |||
1798 | ||||
1799 | void DeclTypeSpecVisitor::BeginDeclTypeSpec() { | |||
1800 | CHECK(!state_.expectDeclTypeSpec)((!state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "!state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1800), false)); | |||
1801 | CHECK(!state_.declTypeSpec)((!state_.declTypeSpec) || (Fortran::common::die("CHECK(" "!state_.declTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 1801), false)); | |||
1802 | state_.expectDeclTypeSpec = true; | |||
1803 | } | |||
1804 | void DeclTypeSpecVisitor::EndDeclTypeSpec() { | |||
1805 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1805), false)); | |||
1806 | state_ = {}; | |||
1807 | } | |||
1808 | ||||
1809 | void DeclTypeSpecVisitor::SetDeclTypeSpecCategory( | |||
1810 | DeclTypeSpec::Category category) { | |||
1811 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1811), false)); | |||
1812 | state_.derived.category = category; | |||
1813 | } | |||
1814 | ||||
1815 | bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) { | |||
1816 | BeginDeclTypeSpec(); | |||
1817 | return true; | |||
1818 | } | |||
1819 | void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { | |||
1820 | EndDeclTypeSpec(); | |||
1821 | } | |||
1822 | ||||
1823 | void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) { | |||
1824 | // Record the resolved DeclTypeSpec in the parse tree for use by | |||
1825 | // expression semantics if the DeclTypeSpec is a valid TypeSpec. | |||
1826 | // The grammar ensures that it's an intrinsic or derived type spec, | |||
1827 | // not TYPE(*) or CLASS(*) or CLASS(T). | |||
1828 | if (const DeclTypeSpec * spec{state_.declTypeSpec}) { | |||
1829 | switch (spec->category()) { | |||
1830 | case DeclTypeSpec::Numeric: | |||
1831 | case DeclTypeSpec::Logical: | |||
1832 | case DeclTypeSpec::Character: | |||
1833 | typeSpec.declTypeSpec = spec; | |||
1834 | break; | |||
1835 | case DeclTypeSpec::TypeDerived: | |||
1836 | if (const DerivedTypeSpec * derived{spec->AsDerived()}) { | |||
1837 | CheckForAbstractType(derived->typeSymbol()); // C703 | |||
1838 | typeSpec.declTypeSpec = spec; | |||
1839 | } | |||
1840 | break; | |||
1841 | default: | |||
1842 | CRASH_NO_CASEFortran::common::die("no case" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1842); | |||
1843 | } | |||
1844 | } | |||
1845 | } | |||
1846 | ||||
1847 | void DeclTypeSpecVisitor::Post( | |||
1848 | const parser::IntrinsicTypeSpec::DoublePrecision &) { | |||
1849 | MakeNumericType(TypeCategory::Real, context().doublePrecisionKind()); | |||
1850 | } | |||
1851 | void DeclTypeSpecVisitor::Post( | |||
1852 | const parser::IntrinsicTypeSpec::DoubleComplex &) { | |||
1853 | MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind()); | |||
1854 | } | |||
1855 | void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { | |||
1856 | SetDeclTypeSpec(context().MakeNumericType(category, kind)); | |||
1857 | } | |||
1858 | ||||
1859 | void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) { | |||
1860 | if (typeSymbol.attrs().test(Attr::ABSTRACT)) { | |||
1861 | Say("ABSTRACT derived type may not be used here"_err_en_US); | |||
1862 | } | |||
1863 | } | |||
1864 | ||||
1865 | void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { | |||
1866 | SetDeclTypeSpec(context().globalScope().MakeClassStarType()); | |||
1867 | } | |||
1868 | void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) { | |||
1869 | SetDeclTypeSpec(context().globalScope().MakeTypeStarType()); | |||
1870 | } | |||
1871 | ||||
1872 | // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet) | |||
1873 | // and save it in state_.declTypeSpec. | |||
1874 | void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { | |||
1875 | CHECK(state_.expectDeclTypeSpec)((state_.expectDeclTypeSpec) || (Fortran::common::die("CHECK(" "state_.expectDeclTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 1875), false)); | |||
1876 | CHECK(!state_.declTypeSpec)((!state_.declTypeSpec) || (Fortran::common::die("CHECK(" "!state_.declTypeSpec" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 1876), false)); | |||
1877 | state_.declTypeSpec = &declTypeSpec; | |||
1878 | } | |||
1879 | ||||
1880 | KindExpr DeclTypeSpecVisitor::GetKindParamExpr( | |||
1881 | TypeCategory category, const std::optional<parser::KindSelector> &kind) { | |||
1882 | return AnalyzeKindSelector(context(), category, kind); | |||
1883 | } | |||
1884 | ||||
1885 | // MessageHandler implementation | |||
1886 | ||||
1887 | Message &MessageHandler::Say(MessageFixedText &&msg) { | |||
1888 | return context_->Say(currStmtSource().value(), std::move(msg)); | |||
1889 | } | |||
1890 | Message &MessageHandler::Say(MessageFormattedText &&msg) { | |||
1891 | return context_->Say(currStmtSource().value(), std::move(msg)); | |||
1892 | } | |||
1893 | Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) { | |||
1894 | return Say(name, std::move(msg), name); | |||
1895 | } | |||
1896 | ||||
1897 | // ImplicitRulesVisitor implementation | |||
1898 | ||||
1899 | void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) { | |||
1900 | prevParameterStmt_ = currStmtSource(); | |||
1901 | } | |||
1902 | ||||
1903 | bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) { | |||
1904 | bool result{ | |||
1905 | common::visit(common::visitors{ | |||
1906 | [&](const std::list<ImplicitNoneNameSpec> &y) { | |||
1907 | return HandleImplicitNone(y); | |||
1908 | }, | |||
1909 | [&](const std::list<parser::ImplicitSpec> &) { | |||
1910 | if (prevImplicitNoneType_) { | |||
1911 | Say("IMPLICIT statement after IMPLICIT NONE or " | |||
1912 | "IMPLICIT NONE(TYPE) statement"_err_en_US); | |||
1913 | return false; | |||
1914 | } | |||
1915 | implicitRules_->set_isImplicitNoneType(false); | |||
1916 | return true; | |||
1917 | }, | |||
1918 | }, | |||
1919 | x.u)}; | |||
1920 | prevImplicit_ = currStmtSource(); | |||
1921 | return result; | |||
1922 | } | |||
1923 | ||||
1924 | bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) { | |||
1925 | auto loLoc{std::get<parser::Location>(x.t)}; | |||
1926 | auto hiLoc{loLoc}; | |||
1927 | if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) { | |||
1928 | hiLoc = *hiLocOpt; | |||
1929 | if (*hiLoc < *loLoc) { | |||
1930 | Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US, | |||
1931 | std::string(hiLoc, 1), std::string(loLoc, 1)); | |||
1932 | return false; | |||
1933 | } | |||
1934 | } | |||
1935 | implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc); | |||
1936 | return false; | |||
1937 | } | |||
1938 | ||||
1939 | bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) { | |||
1940 | BeginDeclTypeSpec(); | |||
1941 | set_allowForwardReferenceToDerivedType(true); | |||
1942 | return true; | |||
1943 | } | |||
1944 | ||||
1945 | void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) { | |||
1946 | EndDeclTypeSpec(); | |||
1947 | } | |||
1948 | ||||
1949 | void ImplicitRulesVisitor::SetScope(const Scope &scope) { | |||
1950 | implicitRules_ = &DEREF(implicitRulesMap_)Fortran::common::Deref(implicitRulesMap_, "flang/lib/Semantics/resolve-names.cpp" , 1950).at(&scope); | |||
1951 | prevImplicit_ = std::nullopt; | |||
1952 | prevImplicitNone_ = std::nullopt; | |||
1953 | prevImplicitNoneType_ = std::nullopt; | |||
1954 | prevParameterStmt_ = std::nullopt; | |||
1955 | } | |||
1956 | void ImplicitRulesVisitor::BeginScope(const Scope &scope) { | |||
1957 | // find or create implicit rules for this scope | |||
1958 | DEREF(implicitRulesMap_)Fortran::common::Deref(implicitRulesMap_, "flang/lib/Semantics/resolve-names.cpp" , 1958).try_emplace(&scope, context(), implicitRules_); | |||
1959 | SetScope(scope); | |||
1960 | } | |||
1961 | ||||
1962 | // TODO: for all of these errors, reference previous statement too | |||
1963 | bool ImplicitRulesVisitor::HandleImplicitNone( | |||
1964 | const std::list<ImplicitNoneNameSpec> &nameSpecs) { | |||
1965 | if (prevImplicitNone_) { | |||
1966 | Say("More than one IMPLICIT NONE statement"_err_en_US); | |||
1967 | Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US); | |||
1968 | return false; | |||
1969 | } | |||
1970 | if (prevParameterStmt_) { | |||
1971 | Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US); | |||
1972 | return false; | |||
1973 | } | |||
1974 | prevImplicitNone_ = currStmtSource(); | |||
1975 | bool implicitNoneTypeNever{ | |||
1976 | context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)}; | |||
1977 | if (nameSpecs.empty()) { | |||
1978 | if (!implicitNoneTypeNever) { | |||
1979 | prevImplicitNoneType_ = currStmtSource(); | |||
1980 | implicitRules_->set_isImplicitNoneType(true); | |||
1981 | if (prevImplicit_) { | |||
1982 | Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US); | |||
1983 | return false; | |||
1984 | } | |||
1985 | } | |||
1986 | } else { | |||
1987 | int sawType{0}; | |||
1988 | int sawExternal{0}; | |||
1989 | for (const auto noneSpec : nameSpecs) { | |||
1990 | switch (noneSpec) { | |||
1991 | case ImplicitNoneNameSpec::External: | |||
1992 | implicitRules_->set_isImplicitNoneExternal(true); | |||
1993 | ++sawExternal; | |||
1994 | break; | |||
1995 | case ImplicitNoneNameSpec::Type: | |||
1996 | if (!implicitNoneTypeNever) { | |||
1997 | prevImplicitNoneType_ = currStmtSource(); | |||
1998 | implicitRules_->set_isImplicitNoneType(true); | |||
1999 | if (prevImplicit_) { | |||
2000 | Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US); | |||
2001 | return false; | |||
2002 | } | |||
2003 | ++sawType; | |||
2004 | } | |||
2005 | break; | |||
2006 | } | |||
2007 | } | |||
2008 | if (sawType > 1) { | |||
2009 | Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US); | |||
2010 | return false; | |||
2011 | } | |||
2012 | if (sawExternal > 1) { | |||
2013 | Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US); | |||
2014 | return false; | |||
2015 | } | |||
2016 | } | |||
2017 | return true; | |||
2018 | } | |||
2019 | ||||
2020 | // ArraySpecVisitor implementation | |||
2021 | ||||
2022 | void ArraySpecVisitor::Post(const parser::ArraySpec &x) { | |||
2023 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2023), false)); | |||
2024 | arraySpec_ = AnalyzeArraySpec(context(), x); | |||
2025 | } | |||
2026 | void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) { | |||
2027 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2027), false)); | |||
2028 | arraySpec_ = AnalyzeArraySpec(context(), x); | |||
2029 | } | |||
2030 | void ArraySpecVisitor::Post(const parser::CoarraySpec &x) { | |||
2031 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2031), false)); | |||
2032 | coarraySpec_ = AnalyzeCoarraySpec(context(), x); | |||
2033 | } | |||
2034 | ||||
2035 | const ArraySpec &ArraySpecVisitor::arraySpec() { | |||
2036 | return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_; | |||
2037 | } | |||
2038 | const ArraySpec &ArraySpecVisitor::coarraySpec() { | |||
2039 | return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_; | |||
2040 | } | |||
2041 | void ArraySpecVisitor::BeginArraySpec() { | |||
2042 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2042), false)); | |||
2043 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2043), false)); | |||
2044 | CHECK(attrArraySpec_.empty())((attrArraySpec_.empty()) || (Fortran::common::die("CHECK(" "attrArraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2044), false)); | |||
2045 | CHECK(attrCoarraySpec_.empty())((attrCoarraySpec_.empty()) || (Fortran::common::die("CHECK(" "attrCoarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 2045), false)); | |||
2046 | } | |||
2047 | void ArraySpecVisitor::EndArraySpec() { | |||
2048 | CHECK(arraySpec_.empty())((arraySpec_.empty()) || (Fortran::common::die("CHECK(" "arraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2048), false)); | |||
2049 | CHECK(coarraySpec_.empty())((coarraySpec_.empty()) || (Fortran::common::die("CHECK(" "coarraySpec_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2049), false)); | |||
2050 | attrArraySpec_.clear(); | |||
2051 | attrCoarraySpec_.clear(); | |||
2052 | } | |||
2053 | void ArraySpecVisitor::PostAttrSpec() { | |||
2054 | // Save dimension/codimension from attrs so we can process array/coarray-spec | |||
2055 | // on the entity-decl | |||
2056 | if (!arraySpec_.empty()) { | |||
2057 | if (attrArraySpec_.empty()) { | |||
2058 | attrArraySpec_ = arraySpec_; | |||
2059 | arraySpec_.clear(); | |||
2060 | } else { | |||
2061 | Say(currStmtSource().value(), | |||
2062 | "Attribute 'DIMENSION' cannot be used more than once"_err_en_US); | |||
2063 | } | |||
2064 | } | |||
2065 | if (!coarraySpec_.empty()) { | |||
2066 | if (attrCoarraySpec_.empty()) { | |||
2067 | attrCoarraySpec_ = coarraySpec_; | |||
2068 | coarraySpec_.clear(); | |||
2069 | } else { | |||
2070 | Say(currStmtSource().value(), | |||
2071 | "Attribute 'CODIMENSION' cannot be used more than once"_err_en_US); | |||
2072 | } | |||
2073 | } | |||
2074 | } | |||
2075 | ||||
2076 | // FuncResultStack implementation | |||
2077 | ||||
2078 | FuncResultStack::~FuncResultStack() { CHECK(stack_.empty())((stack_.empty()) || (Fortran::common::die("CHECK(" "stack_.empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2078), false)); } | |||
2079 | ||||
2080 | void FuncResultStack::CompleteFunctionResultType() { | |||
2081 | // If the function has a type in the prefix, process it now. | |||
2082 | FuncInfo *info{Top()}; | |||
2083 | if (info && &info->scope == &scopeHandler_.currScope()) { | |||
2084 | if (info->parsedType && info->resultSymbol) { | |||
2085 | scopeHandler_.messageHandler().set_currStmtSource(info->source); | |||
2086 | if (const auto *type{ | |||
2087 | scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) { | |||
2088 | Symbol &symbol{*info->resultSymbol}; | |||
2089 | if (!scopeHandler_.context().HasError(symbol)) { | |||
2090 | if (symbol.GetType()) { | |||
2091 | scopeHandler_.Say(symbol.name(), | |||
2092 | "Function cannot have both an explicit type prefix and a RESULT suffix"_err_en_US); | |||
2093 | scopeHandler_.context().SetError(symbol); | |||
2094 | } else { | |||
2095 | symbol.SetType(*type); | |||
2096 | } | |||
2097 | } | |||
2098 | } | |||
2099 | info->parsedType = nullptr; | |||
2100 | } | |||
2101 | } | |||
2102 | } | |||
2103 | ||||
2104 | // Called from ConvertTo{Object/Proc}Entity to cope with any appearance | |||
2105 | // of the function result in a specification expression. | |||
2106 | void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) { | |||
2107 | if (FuncInfo * info{Top()}) { | |||
2108 | if (info->resultSymbol == &symbol) { | |||
2109 | CompleteFunctionResultType(); | |||
2110 | } | |||
2111 | } | |||
2112 | } | |||
2113 | ||||
2114 | void FuncResultStack::Pop() { | |||
2115 | if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) { | |||
2116 | stack_.pop_back(); | |||
2117 | } | |||
2118 | } | |||
2119 | ||||
2120 | // ScopeHandler implementation | |||
2121 | ||||
2122 | void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) { | |||
2123 | SayAlreadyDeclared(name.source, prev); | |||
2124 | } | |||
2125 | void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) { | |||
2126 | if (context().HasError(prev)) { | |||
2127 | // don't report another error about prev | |||
2128 | } else { | |||
2129 | if (const auto *details{prev.detailsIf<UseDetails>()}) { | |||
2130 | Say(name, "'%s' is already declared in this scoping unit"_err_en_US) | |||
2131 | .Attach(details->location(), | |||
2132 | "It is use-associated with '%s' in module '%s'"_en_US, | |||
2133 | details->symbol().name(), GetUsedModule(*details).name()); | |||
2134 | } else { | |||
2135 | SayAlreadyDeclared(name, prev.name()); | |||
2136 | } | |||
2137 | context().SetError(prev); | |||
2138 | } | |||
2139 | } | |||
2140 | void ScopeHandler::SayAlreadyDeclared( | |||
2141 | const SourceName &name1, const SourceName &name2) { | |||
2142 | if (name1.begin() < name2.begin()) { | |||
2143 | SayAlreadyDeclared(name2, name1); | |||
2144 | } else { | |||
2145 | Say(name1, "'%s' is already declared in this scoping unit"_err_en_US) | |||
2146 | .Attach(name2, "Previous declaration of '%s'"_en_US, name2); | |||
2147 | } | |||
2148 | } | |||
2149 | ||||
2150 | void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol, | |||
2151 | MessageFixedText &&msg1, Message &&msg2) { | |||
2152 | bool isFatal{msg1.IsFatal()}; | |||
2153 | Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2)); | |||
2154 | context().SetError(symbol, isFatal); | |||
2155 | } | |||
2156 | ||||
2157 | void ScopeHandler::SayWithDecl( | |||
2158 | const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) { | |||
2159 | bool isFatal{msg.IsFatal()}; | |||
2160 | Say(name, std::move(msg), symbol.name()) | |||
2161 | .Attach(Message{name.source, | |||
2162 | symbol.test(Symbol::Flag::Implicit) | |||
2163 | ? "Implicit declaration of '%s'"_en_US | |||
2164 | : "Declaration of '%s'"_en_US, | |||
2165 | name.source}); | |||
2166 | context().SetError(symbol, isFatal); | |||
2167 | } | |||
2168 | ||||
2169 | void ScopeHandler::SayLocalMustBeVariable( | |||
2170 | const parser::Name &name, Symbol &symbol) { | |||
2171 | SayWithDecl(name, symbol, | |||
2172 | "The name '%s' must be a variable to appear" | |||
2173 | " in a locality-spec"_err_en_US); | |||
2174 | } | |||
2175 | ||||
2176 | void ScopeHandler::SayDerivedType( | |||
2177 | const SourceName &name, MessageFixedText &&msg, const Scope &type) { | |||
2178 | const Symbol &typeSymbol{DEREF(type.GetSymbol())Fortran::common::Deref(type.GetSymbol(), "flang/lib/Semantics/resolve-names.cpp" , 2178)}; | |||
2179 | Say(name, std::move(msg), name, typeSymbol.name()) | |||
2180 | .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US, | |||
2181 | typeSymbol.name()); | |||
2182 | } | |||
2183 | void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1, | |||
2184 | const SourceName &name2, MessageFixedText &&msg2) { | |||
2185 | Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2); | |||
2186 | } | |||
2187 | void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1, | |||
2188 | Symbol &symbol, MessageFixedText &&msg2) { | |||
2189 | bool isFatal{msg1.IsFatal()}; | |||
2190 | Say2(name, std::move(msg1), symbol.name(), std::move(msg2)); | |||
2191 | context().SetError(symbol, isFatal); | |||
2192 | } | |||
2193 | void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1, | |||
2194 | Symbol &symbol, MessageFixedText &&msg2) { | |||
2195 | bool isFatal{msg1.IsFatal()}; | |||
2196 | Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2)); | |||
2197 | context().SetError(symbol, isFatal); | |||
2198 | } | |||
2199 | ||||
2200 | // This is essentially GetProgramUnitContaining(), but it can return | |||
2201 | // a mutable Scope &, it ignores statement functions, and it fails | |||
2202 | // gracefully for error recovery (returning the original Scope). | |||
2203 | template <typename T> static T &GetInclusiveScope(T &scope) { | |||
2204 | for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) { | |||
2205 | switch (s->kind()) { | |||
2206 | case Scope::Kind::Module: | |||
2207 | case Scope::Kind::MainProgram: | |||
2208 | case Scope::Kind::Subprogram: | |||
2209 | case Scope::Kind::BlockData: | |||
2210 | if (!s->IsStmtFunction()) { | |||
2211 | return *s; | |||
2212 | } | |||
2213 | break; | |||
2214 | default:; | |||
2215 | } | |||
2216 | } | |||
2217 | return scope; | |||
2218 | } | |||
2219 | ||||
2220 | Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); } | |||
2221 | ||||
2222 | Scope *ScopeHandler::GetHostProcedure() { | |||
2223 | Scope &parent{InclusiveScope().parent()}; | |||
2224 | switch (parent.kind()) { | |||
2225 | case Scope::Kind::Subprogram: | |||
2226 | return &parent; | |||
2227 | case Scope::Kind::MainProgram: | |||
2228 | return &parent; | |||
2229 | default: | |||
2230 | return nullptr; | |||
2231 | } | |||
2232 | } | |||
2233 | ||||
2234 | Scope &ScopeHandler::NonDerivedTypeScope() { | |||
2235 | return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_; | |||
2236 | } | |||
2237 | ||||
2238 | void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) { | |||
2239 | PushScope(currScope().MakeScope(kind, symbol)); | |||
2240 | } | |||
2241 | void ScopeHandler::PushScope(Scope &scope) { | |||
2242 | currScope_ = &scope; | |||
2243 | auto kind{currScope_->kind()}; | |||
2244 | if (kind != Scope::Kind::BlockConstruct && | |||
2245 | kind != Scope::Kind::OtherConstruct) { | |||
2246 | BeginScope(scope); | |||
2247 | } | |||
2248 | // The name of a module or submodule cannot be "used" in its scope, | |||
2249 | // as we read 19.3.1(2), so we allow the name to be used as a local | |||
2250 | // identifier in the module or submodule too. Same with programs | |||
2251 | // (14.1(3)) and BLOCK DATA. | |||
2252 | if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module && | |||
2253 | kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) { | |||
2254 | if (auto *symbol{scope.symbol()}) { | |||
2255 | // Create a dummy symbol so we can't create another one with the same | |||
2256 | // name. It might already be there if we previously pushed the scope. | |||
2257 | SourceName name{symbol->name()}; | |||
2258 | if (!FindInScope(scope, name)) { | |||
2259 | auto &newSymbol{MakeSymbol(name)}; | |||
2260 | if (kind == Scope::Kind::Subprogram) { | |||
2261 | // Allow for recursive references. If this symbol is a function | |||
2262 | // without an explicit RESULT(), this new symbol will be discarded | |||
2263 | // and replaced with an object of the same name. | |||
2264 | newSymbol.set_details(HostAssocDetails{*symbol}); | |||
2265 | } else { | |||
2266 | newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName}); | |||
2267 | } | |||
2268 | } | |||
2269 | } | |||
2270 | } | |||
2271 | } | |||
2272 | void ScopeHandler::PopScope() { | |||
2273 | // Entities that are not yet classified as objects or procedures are now | |||
2274 | // assumed to be objects. | |||
2275 | // TODO: Statement functions | |||
2276 | for (auto &pair : currScope()) { | |||
2277 | ConvertToObjectEntity(*pair.second); | |||
2278 | } | |||
2279 | funcResultStack_.Pop(); | |||
2280 | // If popping back into a global scope, pop back to the main global scope. | |||
2281 | SetScope(currScope_->parent().IsGlobal() ? context().globalScope() | |||
2282 | : currScope_->parent()); | |||
2283 | } | |||
2284 | void ScopeHandler::SetScope(Scope &scope) { | |||
2285 | currScope_ = &scope; | |||
2286 | ImplicitRulesVisitor::SetScope(InclusiveScope()); | |||
2287 | } | |||
2288 | ||||
2289 | Symbol *ScopeHandler::FindSymbol(const parser::Name &name) { | |||
2290 | return FindSymbol(currScope(), name); | |||
2291 | } | |||
2292 | Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) { | |||
2293 | if (scope.IsDerivedType()) { | |||
2294 | if (Symbol * symbol{scope.FindComponent(name.source)}) { | |||
2295 | if (symbol->has<TypeParamDetails>()) { | |||
2296 | return Resolve(name, symbol); | |||
2297 | } | |||
2298 | } | |||
2299 | return FindSymbol(scope.parent(), name); | |||
2300 | } else { | |||
2301 | // In EQUIVALENCE statements only resolve names in the local scope, see | |||
2302 | // 19.5.1.4, paragraph 2, item (10) | |||
2303 | return Resolve(name, | |||
2304 | inEquivalenceStmt_ ? FindInScope(scope, name) | |||
2305 | : scope.FindSymbol(name.source)); | |||
2306 | } | |||
2307 | } | |||
2308 | ||||
2309 | Symbol &ScopeHandler::MakeSymbol( | |||
2310 | Scope &scope, const SourceName &name, Attrs attrs) { | |||
2311 | if (Symbol * symbol{FindInScope(scope, name)}) { | |||
2312 | CheckDuplicatedAttrs(name, *symbol, attrs); | |||
2313 | SetExplicitAttrs(*symbol, attrs); | |||
2314 | return *symbol; | |||
2315 | } else { | |||
2316 | const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})}; | |||
2317 | CHECK(pair.second)((pair.second) || (Fortran::common::die("CHECK(" "pair.second" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2317), false)); // name was not found, so must be able to add | |||
2318 | return *pair.first->second; | |||
2319 | } | |||
2320 | } | |||
2321 | Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) { | |||
2322 | return MakeSymbol(currScope(), name, attrs); | |||
2323 | } | |||
2324 | Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) { | |||
2325 | return Resolve(name, MakeSymbol(name.source, attrs)); | |||
2326 | } | |||
2327 | Symbol &ScopeHandler::MakeHostAssocSymbol( | |||
2328 | const parser::Name &name, const Symbol &hostSymbol) { | |||
2329 | Symbol &symbol{*NonDerivedTypeScope() | |||
2330 | .try_emplace(name.source, HostAssocDetails{hostSymbol}) | |||
2331 | .first->second}; | |||
2332 | name.symbol = &symbol; | |||
2333 | symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC? | |||
2334 | symbol.flags() = hostSymbol.flags(); | |||
2335 | return symbol; | |||
2336 | } | |||
2337 | Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) { | |||
2338 | CHECK(!FindInScope(name))((!FindInScope(name)) || (Fortran::common::die("CHECK(" "!FindInScope(name)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 2338), false)); | |||
2339 | return MakeSymbol(currScope(), name, symbol.attrs()); | |||
2340 | } | |||
2341 | ||||
2342 | // Look for name only in scope, not in enclosing scopes. | |||
2343 | Symbol *ScopeHandler::FindInScope( | |||
2344 | const Scope &scope, const parser::Name &name) { | |||
2345 | return Resolve(name, FindInScope(scope, name.source)); | |||
2346 | } | |||
2347 | Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) { | |||
2348 | // all variants of names, e.g. "operator(.ne.)" for "operator(/=)" | |||
2349 | for (const std::string &n : GetAllNames(context(), name)) { | |||
2350 | auto it{scope.find(SourceName{n})}; | |||
2351 | if (it != scope.end()) { | |||
2352 | return &*it->second; | |||
2353 | } | |||
2354 | } | |||
2355 | return nullptr; | |||
2356 | } | |||
2357 | ||||
2358 | // Find a component or type parameter by name in a derived type or its parents. | |||
2359 | Symbol *ScopeHandler::FindInTypeOrParents( | |||
2360 | const Scope &scope, const parser::Name &name) { | |||
2361 | return Resolve(name, scope.FindComponent(name.source)); | |||
2362 | } | |||
2363 | Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) { | |||
2364 | return FindInTypeOrParents(currScope(), name); | |||
2365 | } | |||
2366 | Symbol *ScopeHandler::FindInScopeOrBlockConstructs( | |||
2367 | const Scope &scope, SourceName name) { | |||
2368 | if (Symbol * symbol{FindInScope(scope, name)}) { | |||
2369 | return symbol; | |||
2370 | } | |||
2371 | for (const Scope &child : scope.children()) { | |||
2372 | if (child.kind() == Scope::Kind::BlockConstruct) { | |||
2373 | if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) { | |||
2374 | return symbol; | |||
2375 | } | |||
2376 | } | |||
2377 | } | |||
2378 | return nullptr; | |||
2379 | } | |||
2380 | ||||
2381 | void ScopeHandler::EraseSymbol(const parser::Name &name) { | |||
2382 | currScope().erase(name.source); | |||
2383 | name.symbol = nullptr; | |||
2384 | } | |||
2385 | ||||
2386 | static bool NeedsType(const Symbol &symbol) { | |||
2387 | return !symbol.GetType() && | |||
2388 | common::visit(common::visitors{ | |||
2389 | [](const EntityDetails &) { return true; }, | |||
2390 | [](const ObjectEntityDetails &) { return true; }, | |||
2391 | [](const AssocEntityDetails &) { return true; }, | |||
2392 | [&](const ProcEntityDetails &p) { | |||
2393 | return symbol.test(Symbol::Flag::Function) && | |||
2394 | !symbol.attrs().test(Attr::INTRINSIC) && | |||
2395 | !p.type() && !p.procInterface(); | |||
2396 | }, | |||
2397 | [](const auto &) { return false; }, | |||
2398 | }, | |||
2399 | symbol.details()); | |||
2400 | } | |||
2401 | ||||
2402 | void ScopeHandler::ApplyImplicitRules( | |||
2403 | Symbol &symbol, bool allowForwardReference) { | |||
2404 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2405 | if (context().HasError(symbol) || !NeedsType(symbol)) { | |||
2406 | return; | |||
2407 | } | |||
2408 | if (const DeclTypeSpec * type{GetImplicitType(symbol)}) { | |||
2409 | symbol.set(Symbol::Flag::Implicit); | |||
2410 | symbol.SetType(*type); | |||
2411 | return; | |||
2412 | } | |||
2413 | if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) { | |||
2414 | std::optional<Symbol::Flag> functionOrSubroutineFlag; | |||
2415 | if (symbol.test(Symbol::Flag::Function)) { | |||
2416 | functionOrSubroutineFlag = Symbol::Flag::Function; | |||
2417 | } else if (symbol.test(Symbol::Flag::Subroutine)) { | |||
2418 | functionOrSubroutineFlag = Symbol::Flag::Subroutine; | |||
2419 | } | |||
2420 | if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) { | |||
2421 | // type will be determined in expression semantics | |||
2422 | AcquireIntrinsicProcedureFlags(symbol); | |||
2423 | return; | |||
2424 | } | |||
2425 | } | |||
2426 | if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) { | |||
2427 | return; | |||
2428 | } | |||
2429 | if (!context().HasError(symbol)) { | |||
2430 | Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); | |||
2431 | context().SetError(symbol); | |||
2432 | } | |||
2433 | } | |||
2434 | ||||
2435 | // Extension: Allow forward references to scalar integer dummy arguments | |||
2436 | // or variables in COMMON to appear in specification expressions under | |||
2437 | // IMPLICIT NONE(TYPE) when what would otherwise have been their implicit | |||
2438 | // type is default INTEGER. | |||
2439 | bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) { | |||
2440 | if (!inSpecificationPart_ || context().HasError(symbol) || | |||
2441 | !(IsDummy(symbol) || FindCommonBlockContaining(symbol)) || | |||
2442 | symbol.Rank() != 0 || | |||
2443 | !context().languageFeatures().IsEnabled( | |||
2444 | common::LanguageFeature::ForwardRefImplicitNone)) { | |||
2445 | return false; | |||
2446 | } | |||
2447 | const DeclTypeSpec *type{ | |||
2448 | GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)}; | |||
2449 | if (!type || !type->IsNumeric(TypeCategory::Integer)) { | |||
2450 | return false; | |||
2451 | } | |||
2452 | auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())}; | |||
2453 | if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) { | |||
2454 | return false; | |||
2455 | } | |||
2456 | if (!ConvertToObjectEntity(symbol)) { | |||
2457 | return false; | |||
2458 | } | |||
2459 | // TODO: check no INTENT(OUT) if dummy? | |||
2460 | if (context().languageFeatures().ShouldWarn( | |||
2461 | common::LanguageFeature::ForwardRefImplicitNone)) { | |||
2462 | Say(symbol.name(), | |||
2463 | "'%s' was used without (or before) being explicitly typed"_warn_en_US, | |||
2464 | symbol.name()); | |||
2465 | } | |||
2466 | symbol.set(Symbol::Flag::Implicit); | |||
2467 | symbol.SetType(*type); | |||
2468 | return true; | |||
2469 | } | |||
2470 | ||||
2471 | // Ensure that the symbol for an intrinsic procedure is marked with | |||
2472 | // the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as | |||
2473 | // appropriate. | |||
2474 | void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) { | |||
2475 | SetImplicitAttr(symbol, Attr::INTRINSIC); | |||
2476 | switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) { | |||
2477 | case evaluate::IntrinsicClass::elementalFunction: | |||
2478 | case evaluate::IntrinsicClass::elementalSubroutine: | |||
2479 | SetExplicitAttr(symbol, Attr::ELEMENTAL); | |||
2480 | SetExplicitAttr(symbol, Attr::PURE); | |||
2481 | break; | |||
2482 | case evaluate::IntrinsicClass::impureSubroutine: | |||
2483 | break; | |||
2484 | default: | |||
2485 | SetExplicitAttr(symbol, Attr::PURE); | |||
2486 | } | |||
2487 | } | |||
2488 | ||||
2489 | const DeclTypeSpec *ScopeHandler::GetImplicitType( | |||
2490 | Symbol &symbol, bool respectImplicitNoneType) { | |||
2491 | const Scope *scope{&symbol.owner()}; | |||
2492 | if (scope->IsGlobal()) { | |||
2493 | scope = &currScope(); | |||
2494 | } | |||
2495 | scope = &GetInclusiveScope(*scope); | |||
2496 | const auto *type{implicitRulesMap_->at(scope).GetType( | |||
2497 | symbol.name(), respectImplicitNoneType)}; | |||
2498 | if (type) { | |||
2499 | if (const DerivedTypeSpec * derived{type->AsDerived()}) { | |||
2500 | // Resolve any forward-referenced derived type; a quick no-op else. | |||
2501 | auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)}; | |||
2502 | instantiatable.Instantiate(currScope()); | |||
2503 | } | |||
2504 | } | |||
2505 | return type; | |||
2506 | } | |||
2507 | ||||
2508 | void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) { | |||
2509 | if (!inSpecificationPart_ && symbol && | |||
2510 | symbol->test(Symbol::Flag::EntryDummyArgument)) { | |||
2511 | Say(source, | |||
2512 | "Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US, | |||
2513 | symbol->name()); | |||
2514 | symbol->set(Symbol::Flag::EntryDummyArgument, false); | |||
2515 | } | |||
2516 | } | |||
2517 | ||||
2518 | // Convert symbol to be a ObjectEntity or return false if it can't be. | |||
2519 | bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) { | |||
2520 | if (symbol.has<ObjectEntityDetails>()) { | |||
2521 | // nothing to do | |||
2522 | } else if (symbol.has<UnknownDetails>()) { | |||
2523 | // These are attributes that a name could have picked up from | |||
2524 | // an attribute statement or type declaration statement. | |||
2525 | if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) { | |||
2526 | return false; | |||
2527 | } | |||
2528 | symbol.set_details(ObjectEntityDetails{}); | |||
2529 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
2530 | if (symbol.attrs().HasAny({Attr::EXTERNAL, Attr::INTRINSIC})) { | |||
2531 | return false; | |||
2532 | } | |||
2533 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2534 | symbol.set_details(ObjectEntityDetails{std::move(*details)}); | |||
2535 | } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) { | |||
2536 | return useDetails->symbol().has<ObjectEntityDetails>(); | |||
2537 | } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) { | |||
2538 | return hostDetails->symbol().has<ObjectEntityDetails>(); | |||
2539 | } else { | |||
2540 | return false; | |||
2541 | } | |||
2542 | return true; | |||
2543 | } | |||
2544 | // Convert symbol to be a ProcEntity or return false if it can't be. | |||
2545 | bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) { | |||
2546 | if (symbol.has<ProcEntityDetails>()) { | |||
2547 | // nothing to do | |||
2548 | } else if (symbol.has<UnknownDetails>()) { | |||
2549 | symbol.set_details(ProcEntityDetails{}); | |||
2550 | } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
2551 | if (IsFunctionResult(symbol) && | |||
2552 | !(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) { | |||
2553 | // Don't turn function result into a procedure pointer unless both | |||
2554 | // POINTER and EXTERNAL | |||
2555 | return false; | |||
2556 | } | |||
2557 | funcResultStack_.CompleteTypeIfFunctionResult(symbol); | |||
2558 | symbol.set_details(ProcEntityDetails{std::move(*details)}); | |||
2559 | if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) { | |||
2560 | CHECK(!symbol.test(Symbol::Flag::Subroutine))((!symbol.test(Symbol::Flag::Subroutine)) || (Fortran::common ::die("CHECK(" "!symbol.test(Symbol::Flag::Subroutine)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 2560) , false)); | |||
2561 | symbol.set(Symbol::Flag::Function); | |||
2562 | } | |||
2563 | } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) { | |||
2564 | return useDetails->symbol().has<ProcEntityDetails>(); | |||
2565 | } else if (auto *hostDetails{symbol.detailsIf<HostAssocDetails>()}) { | |||
2566 | return hostDetails->symbol().has<ProcEntityDetails>(); | |||
2567 | } else { | |||
2568 | return false; | |||
2569 | } | |||
2570 | return true; | |||
2571 | } | |||
2572 | ||||
2573 | const DeclTypeSpec &ScopeHandler::MakeNumericType( | |||
2574 | TypeCategory category, const std::optional<parser::KindSelector> &kind) { | |||
2575 | KindExpr value{GetKindParamExpr(category, kind)}; | |||
2576 | if (auto known{evaluate::ToInt64(value)}) { | |||
2577 | return MakeNumericType(category, static_cast<int>(*known)); | |||
2578 | } else { | |||
2579 | return currScope_->MakeNumericType(category, std::move(value)); | |||
2580 | } | |||
2581 | } | |||
2582 | ||||
2583 | const DeclTypeSpec &ScopeHandler::MakeNumericType( | |||
2584 | TypeCategory category, int kind) { | |||
2585 | return context().MakeNumericType(category, kind); | |||
2586 | } | |||
2587 | ||||
2588 | const DeclTypeSpec &ScopeHandler::MakeLogicalType( | |||
2589 | const std::optional<parser::KindSelector> &kind) { | |||
2590 | KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)}; | |||
2591 | if (auto known{evaluate::ToInt64(value)}) { | |||
2592 | return MakeLogicalType(static_cast<int>(*known)); | |||
2593 | } else { | |||
2594 | return currScope_->MakeLogicalType(std::move(value)); | |||
2595 | } | |||
2596 | } | |||
2597 | ||||
2598 | const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) { | |||
2599 | return context().MakeLogicalType(kind); | |||
2600 | } | |||
2601 | ||||
2602 | void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) { | |||
2603 | if (inSpecificationPart_ && name.symbol) { | |||
2604 | auto kind{currScope().kind()}; | |||
2605 | if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) || | |||
2606 | kind == Scope::Kind::BlockConstruct) { | |||
2607 | bool isHostAssociated{&name.symbol->owner() == &currScope() | |||
2608 | ? name.symbol->has<HostAssocDetails>() | |||
2609 | : name.symbol->owner().Contains(currScope())}; | |||
2610 | if (isHostAssociated) { | |||
2611 | specPartState_.forwardRefs.insert(name.source); | |||
2612 | } | |||
2613 | } | |||
2614 | } | |||
2615 | } | |||
2616 | ||||
2617 | std::optional<SourceName> ScopeHandler::HadForwardRef( | |||
2618 | const Symbol &symbol) const { | |||
2619 | auto iter{specPartState_.forwardRefs.find(symbol.name())}; | |||
2620 | if (iter != specPartState_.forwardRefs.end()) { | |||
2621 | return *iter; | |||
2622 | } | |||
2623 | return std::nullopt; | |||
2624 | } | |||
2625 | ||||
2626 | bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) { | |||
2627 | if (!context().HasError(symbol)) { | |||
2628 | if (auto fwdRef{HadForwardRef(symbol)}) { | |||
2629 | const Symbol *outer{symbol.owner().FindSymbol(symbol.name())}; | |||
2630 | if (outer && symbol.has<UseDetails>() && | |||
2631 | &symbol.GetUltimate() == &outer->GetUltimate()) { | |||
2632 | // e.g. IMPORT of host's USE association | |||
2633 | return false; | |||
2634 | } | |||
2635 | Say(*fwdRef, | |||
2636 | "Forward reference to '%s' is not allowed in the same specification part"_err_en_US, | |||
2637 | *fwdRef) | |||
2638 | .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef); | |||
2639 | context().SetError(symbol); | |||
2640 | return true; | |||
2641 | } | |||
2642 | if ((IsDummy(symbol) || FindCommonBlockContaining(symbol)) && | |||
2643 | isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) && | |||
2644 | !context().HasError(symbol)) { | |||
2645 | // Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in | |||
2646 | // ApplyImplicitRules() due to use in a specification expression, | |||
2647 | // and no explicit type declaration appeared later. | |||
2648 | Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); | |||
2649 | context().SetError(symbol); | |||
2650 | return true; | |||
2651 | } | |||
2652 | } | |||
2653 | return false; | |||
2654 | } | |||
2655 | ||||
2656 | void ScopeHandler::MakeExternal(Symbol &symbol) { | |||
2657 | if (!symbol.attrs().test(Attr::EXTERNAL)) { | |||
2658 | SetImplicitAttr(symbol, Attr::EXTERNAL); | |||
2659 | if (symbol.attrs().test(Attr::INTRINSIC)) { // C840 | |||
2660 | Say(symbol.name(), | |||
2661 | "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, | |||
2662 | symbol.name()); | |||
2663 | } | |||
2664 | } | |||
2665 | } | |||
2666 | ||||
2667 | bool ScopeHandler::CheckDuplicatedAttr( | |||
2668 | SourceName name, const Symbol &symbol, Attr attr) { | |||
2669 | if (attr == Attr::SAVE) { | |||
2670 | // checked elsewhere | |||
2671 | } else if (symbol.attrs().test(attr)) { // C815 | |||
2672 | if (symbol.implicitAttrs().test(attr)) { | |||
2673 | // Implied attribute is now confirmed explicitly | |||
2674 | } else { | |||
2675 | Say(name, "%s attribute was already specified on '%s'"_err_en_US, | |||
2676 | EnumToString(attr), name); | |||
2677 | return false; | |||
2678 | } | |||
2679 | } | |||
2680 | return true; | |||
2681 | } | |||
2682 | ||||
2683 | bool ScopeHandler::CheckDuplicatedAttrs( | |||
2684 | SourceName name, const Symbol &symbol, Attrs attrs) { | |||
2685 | bool ok{true}; | |||
2686 | attrs.IterateOverMembers( | |||
2687 | [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); }); | |||
2688 | return ok; | |||
2689 | } | |||
2690 | ||||
2691 | // ModuleVisitor implementation | |||
2692 | ||||
2693 | bool ModuleVisitor::Pre(const parser::Only &x) { | |||
2694 | common::visit(common::visitors{ | |||
2695 | [&](const Indirection<parser::GenericSpec> &generic) { | |||
2696 | GenericSpecInfo genericSpecInfo{generic.value()}; | |||
2697 | AddUseOnly(genericSpecInfo.symbolName()); | |||
2698 | AddUse(genericSpecInfo); | |||
2699 | }, | |||
2700 | [&](const parser::Name &name) { | |||
2701 | AddUseOnly(name.source); | |||
2702 | Resolve(name, AddUse(name.source, name.source).use); | |||
2703 | }, | |||
2704 | [&](const parser::Rename &rename) { Walk(rename); }, | |||
2705 | }, | |||
2706 | x.u); | |||
2707 | return false; | |||
2708 | } | |||
2709 | ||||
2710 | bool ModuleVisitor::Pre(const parser::Rename::Names &x) { | |||
2711 | const auto &localName{std::get<0>(x.t)}; | |||
2712 | const auto &useName{std::get<1>(x.t)}; | |||
2713 | AddUseRename(useName.source); | |||
2714 | SymbolRename rename{AddUse(localName.source, useName.source)}; | |||
2715 | if (rename.use && localName.source != useName.source) { | |||
2716 | EraseRenamedSymbol(*rename.use); | |||
2717 | } | |||
2718 | Resolve(useName, rename.use); | |||
2719 | Resolve(localName, rename.local); | |||
2720 | return false; | |||
2721 | } | |||
2722 | bool ModuleVisitor::Pre(const parser::Rename::Operators &x) { | |||
2723 | const parser::DefinedOpName &local{std::get<0>(x.t)}; | |||
2724 | const parser::DefinedOpName &use{std::get<1>(x.t)}; | |||
2725 | GenericSpecInfo localInfo{local}; | |||
2726 | GenericSpecInfo useInfo{use}; | |||
2727 | if (IsIntrinsicOperator(context(), local.v.source)) { | |||
2728 | Say(local.v, | |||
2729 | "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US); | |||
2730 | } else if (IsLogicalConstant(context(), local.v.source)) { | |||
2731 | Say(local.v, | |||
2732 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
2733 | } else { | |||
2734 | SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())}; | |||
2735 | if (rename.use) { | |||
2736 | EraseRenamedSymbol(*rename.use); | |||
2737 | } | |||
2738 | useInfo.Resolve(rename.use); | |||
2739 | localInfo.Resolve(rename.local); | |||
2740 | } | |||
2741 | return false; | |||
2742 | } | |||
2743 | ||||
2744 | // Set useModuleScope_ to the Scope of the module being used. | |||
2745 | bool ModuleVisitor::Pre(const parser::UseStmt &x) { | |||
2746 | std::optional<bool> isIntrinsic; | |||
2747 | if (x.nature) { | |||
2748 | isIntrinsic = *x.nature == parser::UseStmt::ModuleNature::Intrinsic; | |||
2749 | } else if (currScope().IsModule() && currScope().symbol() && | |||
2750 | currScope().symbol()->attrs().test(Attr::INTRINSIC)) { | |||
2751 | // Intrinsic modules USE only other intrinsic modules | |||
2752 | isIntrinsic = true; | |||
2753 | } | |||
2754 | useModuleScope_ = FindModule(x.moduleName, isIntrinsic); | |||
2755 | if (!useModuleScope_) { | |||
2756 | return false; | |||
2757 | } | |||
2758 | AddAndCheckModuleUse(x.moduleName.source, | |||
2759 | useModuleScope_->parent().kind() == Scope::Kind::IntrinsicModules); | |||
2760 | // use the name from this source file | |||
2761 | useModuleScope_->symbol()->ReplaceName(x.moduleName.source); | |||
2762 | return true; | |||
2763 | } | |||
2764 | ||||
2765 | void ModuleVisitor::Post(const parser::UseStmt &x) { | |||
2766 | if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) { | |||
2767 | // Not a use-only: collect the names that were used in renames, | |||
2768 | // then add a use for each public name that was not renamed. | |||
2769 | std::set<SourceName> useNames; | |||
2770 | for (const auto &rename : *list) { | |||
2771 | common::visit(common::visitors{ | |||
2772 | [&](const parser::Rename::Names &names) { | |||
2773 | useNames.insert(std::get<1>(names.t).source); | |||
2774 | }, | |||
2775 | [&](const parser::Rename::Operators &ops) { | |||
2776 | useNames.insert(std::get<1>(ops.t).v.source); | |||
2777 | }, | |||
2778 | }, | |||
2779 | rename.u); | |||
2780 | } | |||
2781 | for (const auto &[name, symbol] : *useModuleScope_) { | |||
2782 | if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) && | |||
2783 | (!symbol->attrs().test(Attr::INTRINSIC) || | |||
2784 | symbol->has<UseDetails>()) && | |||
2785 | !symbol->has<MiscDetails>() && useNames.count(name) == 0) { | |||
2786 | SourceName location{x.moduleName.source}; | |||
2787 | if (auto *localSymbol{FindInScope(name)}) { | |||
2788 | DoAddUse(location, localSymbol->name(), *localSymbol, *symbol); | |||
2789 | } else { | |||
2790 | DoAddUse(location, location, CopySymbol(name, *symbol), *symbol); | |||
2791 | } | |||
2792 | } | |||
2793 | } | |||
2794 | } | |||
2795 | useModuleScope_ = nullptr; | |||
2796 | } | |||
2797 | ||||
2798 | ModuleVisitor::SymbolRename ModuleVisitor::AddUse( | |||
2799 | const SourceName &localName, const SourceName &useName) { | |||
2800 | return AddUse(localName, useName, FindInScope(*useModuleScope_, useName)); | |||
2801 | } | |||
2802 | ||||
2803 | ModuleVisitor::SymbolRename ModuleVisitor::AddUse( | |||
2804 | const SourceName &localName, const SourceName &useName, Symbol *useSymbol) { | |||
2805 | if (!useModuleScope_) { | |||
2806 | return {}; // error occurred finding module | |||
2807 | } | |||
2808 | if (!useSymbol) { | |||
2809 | Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName), | |||
2810 | useModuleScope_->GetName().value()); | |||
2811 | return {}; | |||
2812 | } | |||
2813 | if (useSymbol->attrs().test(Attr::PRIVATE) && | |||
2814 | !FindModuleFileContaining(currScope())) { | |||
2815 | // Privacy is not enforced in module files so that generic interfaces | |||
2816 | // can be resolved to private specific procedures in specification | |||
2817 | // expressions. | |||
2818 | Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName), | |||
2819 | useModuleScope_->GetName().value()); | |||
2820 | return {}; | |||
2821 | } | |||
2822 | auto &localSymbol{MakeSymbol(localName)}; | |||
2823 | DoAddUse(useName, localName, localSymbol, *useSymbol); | |||
2824 | return {&localSymbol, useSymbol}; | |||
2825 | } | |||
2826 | ||||
2827 | // symbol must be either a Use or a Generic formed by merging two uses. | |||
2828 | // Convert it to a UseError with this additional location. | |||
2829 | static bool ConvertToUseError( | |||
2830 | Symbol &symbol, const SourceName &location, const Scope &module) { | |||
2831 | const auto *useDetails{symbol.detailsIf<UseDetails>()}; | |||
2832 | if (!useDetails) { | |||
2833 | if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) { | |||
2834 | if (!genericDetails->uses().empty()) { | |||
2835 | useDetails = &genericDetails->uses().at(0)->get<UseDetails>(); | |||
2836 | } | |||
2837 | } | |||
2838 | } | |||
2839 | if (useDetails) { | |||
2840 | symbol.set_details( | |||
2841 | UseErrorDetails{*useDetails}.add_occurrence(location, module)); | |||
2842 | return true; | |||
2843 | } else { | |||
2844 | return false; | |||
2845 | } | |||
2846 | } | |||
2847 | ||||
2848 | // If a symbol has previously been USE-associated and did not appear in a USE | |||
2849 | // ONLY clause, erase it from the current scope. This is needed when a name | |||
2850 | // appears in a USE rename clause. | |||
2851 | void ModuleVisitor::EraseRenamedSymbol(const Symbol &useSymbol) { | |||
2852 | const SourceName &name{useSymbol.name()}; | |||
2853 | if (const Symbol * symbol{FindInScope(name)}) { | |||
2854 | if (auto *useDetails{symbol->detailsIf<UseDetails>()}) { | |||
2855 | const Symbol &moduleSymbol{useDetails->symbol()}; | |||
2856 | if (moduleSymbol.name() == name && | |||
2857 | moduleSymbol.owner() == useSymbol.owner() && IsUseRenamed(name) && | |||
2858 | !IsUseOnly(name)) { | |||
2859 | EraseSymbol(*symbol); | |||
2860 | } | |||
2861 | } | |||
2862 | } | |||
2863 | } | |||
2864 | ||||
2865 | void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, | |||
2866 | Symbol &localSymbol, const Symbol &useSymbol) { | |||
2867 | if (localName != useSymbol.name()) { | |||
2868 | EraseRenamedSymbol(useSymbol); | |||
2869 | } | |||
2870 | if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) { | |||
2871 | details->add_occurrence(location, *useModuleScope_); | |||
2872 | return; | |||
2873 | } | |||
2874 | ||||
2875 | if (localSymbol.has<UnknownDetails>()) { | |||
2876 | localSymbol.set_details(UseDetails{localName, useSymbol}); | |||
2877 | localSymbol.attrs() = | |||
2878 | useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::SAVE}; | |||
2879 | localSymbol.implicitAttrs() = | |||
2880 | localSymbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE}; | |||
2881 | localSymbol.flags() = useSymbol.flags(); | |||
2882 | return; | |||
2883 | } | |||
2884 | ||||
2885 | Symbol &localUltimate{localSymbol.GetUltimate()}; | |||
2886 | const Symbol &useUltimate{useSymbol.GetUltimate()}; | |||
2887 | if (&localUltimate == &useUltimate) { | |||
2888 | // use-associating the same symbol again -- ok | |||
2889 | return; | |||
2890 | } | |||
2891 | ||||
2892 | auto checkAmbiguousDerivedType{[this, location, localName]( | |||
2893 | const Symbol *t1, const Symbol *t2) { | |||
2894 | if (!t1 || !t2) { | |||
2895 | return true; | |||
2896 | } else { | |||
2897 | t1 = &t1->GetUltimate(); | |||
2898 | t2 = &t2->GetUltimate(); | |||
2899 | if (&t1 != &t2) { | |||
2900 | Say(location, | |||
2901 | "Generic interface '%s' has ambiguous derived types from modules '%s' and '%s'"_err_en_US, | |||
2902 | localName, t1->owner().GetName().value(), | |||
2903 | t2->owner().GetName().value()); | |||
2904 | return false; | |||
2905 | } | |||
2906 | } | |||
2907 | }}; | |||
2908 | ||||
2909 | auto *localGeneric{localUltimate.detailsIf<GenericDetails>()}; | |||
2910 | const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()}; | |||
2911 | auto combine{false}; | |||
2912 | if (localGeneric) { | |||
2913 | if (useGeneric) { | |||
2914 | if (!checkAmbiguousDerivedType( | |||
2915 | localGeneric->derivedType(), useGeneric->derivedType())) { | |||
2916 | return; | |||
2917 | } | |||
2918 | combine = true; | |||
2919 | } else if (useUltimate.has<DerivedTypeDetails>()) { | |||
2920 | if (checkAmbiguousDerivedType( | |||
2921 | &useUltimate, localGeneric->derivedType())) { | |||
2922 | combine = true; | |||
2923 | } else { | |||
2924 | return; | |||
2925 | } | |||
2926 | } else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) { | |||
2927 | return; // nothing to do; used subprogram is local's specific | |||
2928 | } | |||
2929 | } else if (useGeneric) { | |||
2930 | if (localUltimate.has<DerivedTypeDetails>()) { | |||
2931 | if (checkAmbiguousDerivedType( | |||
2932 | &localUltimate, useGeneric->derivedType())) { | |||
2933 | combine = true; | |||
2934 | } else { | |||
2935 | return; | |||
2936 | } | |||
2937 | } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate()) { | |||
2938 | // Local is the specific of the used generic; replace it. | |||
2939 | EraseSymbol(localSymbol); | |||
2940 | Symbol &newSymbol{MakeSymbol(localName, | |||
2941 | useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}, | |||
2942 | UseDetails{localName, useUltimate})}; | |||
2943 | newSymbol.flags() = useSymbol.flags(); | |||
2944 | return; | |||
2945 | } | |||
2946 | } else { | |||
2947 | auto localClass{ClassifyProcedure(localUltimate)}; | |||
2948 | auto useClass{ClassifyProcedure(useUltimate)}; | |||
2949 | if (localClass == useClass && | |||
2950 | (localClass == ProcedureDefinitionClass::Intrinsic || | |||
2951 | localClass == ProcedureDefinitionClass::External) && | |||
2952 | localUltimate.name() == useUltimate.name()) { | |||
2953 | auto localChars{evaluate::characteristics::Procedure::Characterize( | |||
2954 | localUltimate, GetFoldingContext())}; | |||
2955 | auto useChars{evaluate::characteristics::Procedure::Characterize( | |||
2956 | useUltimate, GetFoldingContext())}; | |||
2957 | if (localChars && useChars) { | |||
2958 | if (*localChars == *useChars) { | |||
2959 | // Same intrinsic or external procedure defined identically in two | |||
2960 | // modules | |||
2961 | return; | |||
2962 | } | |||
2963 | } | |||
2964 | } | |||
2965 | } | |||
2966 | if (!combine) { | |||
2967 | if (!ConvertToUseError(localSymbol, location, *useModuleScope_)) { | |||
2968 | Say(location, | |||
2969 | "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US, | |||
2970 | localName) | |||
2971 | .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US, | |||
2972 | localName); | |||
2973 | } | |||
2974 | return; | |||
2975 | } | |||
2976 | ||||
2977 | // Two items are being use-associated from different modules | |||
2978 | // to the same local name. At least one of them must be a generic, | |||
2979 | // and the other one can be a generic or a derived type. | |||
2980 | // (It could also have been the specific of the generic, but those | |||
2981 | // cases are handled above without needing to make a local copy of the | |||
2982 | // generic.) | |||
2983 | ||||
2984 | if (localGeneric) { | |||
2985 | if (localSymbol.has<UseDetails>()) { | |||
2986 | // Create a local copy of a previously use-associated generic so that | |||
2987 | // it can be locally extended without corrupting the original. | |||
2988 | GenericDetails generic; | |||
2989 | generic.CopyFrom(*localGeneric); | |||
2990 | if (localGeneric->specific()) { | |||
2991 | generic.set_specific(*localGeneric->specific()); | |||
2992 | } | |||
2993 | EraseSymbol(localSymbol); | |||
2994 | Symbol &newSymbol{MakeSymbol( | |||
2995 | localSymbol.name(), localSymbol.attrs(), std::move(generic))}; | |||
2996 | newSymbol.flags() = localSymbol.flags(); | |||
2997 | localGeneric = &newSymbol.get<GenericDetails>(); | |||
2998 | localGeneric->AddUse(localSymbol); | |||
2999 | } | |||
3000 | if (useGeneric) { | |||
3001 | // Combine two use-associated generics | |||
3002 | localSymbol.attrs() = | |||
3003 | useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; | |||
3004 | localSymbol.flags() = useSymbol.flags(); | |||
3005 | AddGenericUse(*localGeneric, localName, useUltimate); | |||
3006 | localGeneric->CopyFrom(*useGeneric); | |||
3007 | if (useGeneric->specific()) { | |||
3008 | if (!localGeneric->specific()) { | |||
3009 | localGeneric->set_specific( | |||
3010 | *const_cast<Symbol *>(useGeneric->specific())); | |||
3011 | } else if (&localGeneric->specific()->GetUltimate() != | |||
3012 | &useGeneric->specific()->GetUltimate()) { | |||
3013 | Say(location, | |||
3014 | "Cannot use-associate generic interface '%s' with specific procedure of the same name when another such generic is in scope"_err_en_US, | |||
3015 | localName) | |||
3016 | .Attach( | |||
3017 | localSymbol.name(), "Previous USE of '%s'"_en_US, localName); | |||
3018 | } | |||
3019 | } | |||
3020 | } else { | |||
3021 | CHECK(useUltimate.has<DerivedTypeDetails>())((useUltimate.has<DerivedTypeDetails>()) || (Fortran::common ::die("CHECK(" "useUltimate.has<DerivedTypeDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3021) , false)); | |||
3022 | localGeneric->set_derivedType( | |||
3023 | AddGenericUse(*localGeneric, localName, useUltimate)); | |||
3024 | } | |||
3025 | } else { | |||
3026 | CHECK(useGeneric && localUltimate.has<DerivedTypeDetails>())((useGeneric && localUltimate.has<DerivedTypeDetails >()) || (Fortran::common::die("CHECK(" "useGeneric && localUltimate.has<DerivedTypeDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3026), false)); | |||
3027 | CHECK(localSymbol.has<UseDetails>())((localSymbol.has<UseDetails>()) || (Fortran::common::die ("CHECK(" "localSymbol.has<UseDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3027), false )); | |||
3028 | // Create a local copy of the use-associated generic, then extend it | |||
3029 | // with the local derived type. | |||
3030 | GenericDetails generic; | |||
3031 | generic.CopyFrom(*useGeneric); | |||
3032 | if (useGeneric->specific()) { | |||
3033 | generic.set_specific(*const_cast<Symbol *>(useGeneric->specific())); | |||
3034 | } | |||
3035 | EraseSymbol(localSymbol); | |||
3036 | Symbol &newSymbol{MakeSymbol(localName, | |||
3037 | useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}, | |||
3038 | std::move(generic))}; | |||
3039 | newSymbol.flags() = useUltimate.flags(); | |||
3040 | auto &newUseGeneric{newSymbol.get<GenericDetails>()}; | |||
3041 | AddGenericUse(newUseGeneric, localName, useUltimate); | |||
3042 | newUseGeneric.AddUse(localSymbol); | |||
3043 | newUseGeneric.set_derivedType(localSymbol); | |||
3044 | } | |||
3045 | } | |||
3046 | ||||
3047 | void ModuleVisitor::AddUse(const GenericSpecInfo &info) { | |||
3048 | if (useModuleScope_) { | |||
3049 | const auto &name{info.symbolName()}; | |||
3050 | auto rename{AddUse(name, name, FindInScope(*useModuleScope_, name))}; | |||
3051 | info.Resolve(rename.use); | |||
3052 | } | |||
3053 | } | |||
3054 | ||||
3055 | // Create a UseDetails symbol for this USE and add it to generic | |||
3056 | Symbol &ModuleVisitor::AddGenericUse( | |||
3057 | GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) { | |||
3058 | Symbol &newSymbol{ | |||
3059 | currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})}; | |||
3060 | generic.AddUse(newSymbol); | |||
3061 | return newSymbol; | |||
3062 | } | |||
3063 | ||||
3064 | // Enforce C1406 as a warning | |||
3065 | void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) { | |||
3066 | if (isIntrinsic) { | |||
3067 | if (auto iter{nonIntrinsicUses_.find(name)}; | |||
3068 | iter != nonIntrinsicUses_.end()) { | |||
3069 | Say(name, | |||
3070 | "Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US, | |||
3071 | name) | |||
3072 | .Attach(*iter, "Previous USE of '%s'"_en_US, *iter); | |||
3073 | } | |||
3074 | intrinsicUses_.insert(name); | |||
3075 | } else { | |||
3076 | if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) { | |||
3077 | Say(name, | |||
3078 | "Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US, | |||
3079 | name) | |||
3080 | .Attach(*iter, "Previous USE of '%s'"_en_US, *iter); | |||
3081 | } | |||
3082 | nonIntrinsicUses_.insert(name); | |||
3083 | } | |||
3084 | } | |||
3085 | ||||
3086 | bool ModuleVisitor::BeginSubmodule( | |||
3087 | const parser::Name &name, const parser::ParentIdentifier &parentId) { | |||
3088 | const auto &ancestorName{std::get<parser::Name>(parentId.t)}; | |||
3089 | Scope *parentScope{nullptr}; | |||
3090 | Scope *ancestor{FindModule(ancestorName, false /*not intrinsic*/)}; | |||
3091 | if (ancestor) { | |||
3092 | if (const auto &parentName{ | |||
3093 | std::get<std::optional<parser::Name>>(parentId.t)}) { | |||
3094 | parentScope = FindModule(*parentName, false /*not intrinsic*/, ancestor); | |||
3095 | } else { | |||
3096 | parentScope = ancestor; | |||
3097 | } | |||
3098 | } | |||
3099 | if (parentScope) { | |||
3100 | PushScope(*parentScope); | |||
3101 | } else { | |||
3102 | // Error recovery: there's no ancestor scope, so create a dummy one to | |||
3103 | // hold the submodule's scope. | |||
3104 | SourceName dummyName{context().GetTempName(currScope())}; | |||
3105 | Symbol &dummySymbol{MakeSymbol(dummyName, Attrs{}, ModuleDetails{false})}; | |||
3106 | PushScope(Scope::Kind::Module, &dummySymbol); | |||
3107 | parentScope = &currScope(); | |||
3108 | } | |||
3109 | BeginModule(name, true); | |||
3110 | if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) { | |||
3111 | Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US, | |||
3112 | ancestorName.source, name.source); | |||
3113 | } | |||
3114 | return true; | |||
3115 | } | |||
3116 | ||||
3117 | void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) { | |||
3118 | auto &symbol{MakeSymbol(name, ModuleDetails{isSubmodule})}; | |||
3119 | auto &details{symbol.get<ModuleDetails>()}; | |||
3120 | PushScope(Scope::Kind::Module, &symbol); | |||
3121 | details.set_scope(&currScope()); | |||
3122 | defaultAccess_ = Attr::PUBLIC; | |||
3123 | prevAccessStmt_ = std::nullopt; | |||
3124 | } | |||
3125 | ||||
3126 | // Find a module or submodule by name and return its scope. | |||
3127 | // If ancestor is present, look for a submodule of that ancestor module. | |||
3128 | // May have to read a .mod file to find it. | |||
3129 | // If an error occurs, report it and return nullptr. | |||
3130 | Scope *ModuleVisitor::FindModule(const parser::Name &name, | |||
3131 | std::optional<bool> isIntrinsic, Scope *ancestor) { | |||
3132 | ModFileReader reader{context()}; | |||
3133 | Scope *scope{reader.Read(name.source, isIntrinsic, ancestor)}; | |||
3134 | if (!scope) { | |||
3135 | return nullptr; | |||
3136 | } | |||
3137 | if (DoesScopeContain(scope, currScope())) { // 14.2.2(1) | |||
3138 | Say(name, "Module '%s' cannot USE itself"_err_en_US); | |||
3139 | } | |||
3140 | Resolve(name, scope->symbol()); | |||
3141 | return scope; | |||
3142 | } | |||
3143 | ||||
3144 | void ModuleVisitor::ApplyDefaultAccess() { | |||
3145 | for (auto &pair : currScope()) { | |||
3146 | Symbol &symbol = *pair.second; | |||
3147 | if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
3148 | SetImplicitAttr(symbol, defaultAccess_); | |||
3149 | } | |||
3150 | } | |||
3151 | } | |||
3152 | ||||
3153 | // InterfaceVistor implementation | |||
3154 | ||||
3155 | bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) { | |||
3156 | bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)}; | |||
3157 | genericInfo_.emplace(/*isInterface*/ true, isAbstract); | |||
3158 | return BeginAttrs(); | |||
3159 | } | |||
3160 | ||||
3161 | void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); } | |||
3162 | ||||
3163 | void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) { | |||
3164 | genericInfo_.pop(); | |||
3165 | } | |||
3166 | ||||
3167 | // Create a symbol in genericSymbol_ for this GenericSpec. | |||
3168 | bool InterfaceVisitor::Pre(const parser::GenericSpec &x) { | |||
3169 | if (auto *symbol{FindInScope(GenericSpecInfo{x}.symbolName())}) { | |||
3170 | SetGenericSymbol(*symbol); | |||
3171 | } | |||
3172 | if (const auto *opr{std::get_if<parser::DefinedOperator>(&x.u)}; opr && | |||
3173 | std::holds_alternative<parser::DefinedOperator::IntrinsicOperator>( | |||
3174 | opr->u)) { | |||
3175 | context().set_anyDefinedIntrinsicOperator(true); | |||
3176 | } | |||
3177 | return false; | |||
3178 | } | |||
3179 | ||||
3180 | bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) { | |||
3181 | if (!isGeneric()) { | |||
3182 | Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US); | |||
3183 | return false; | |||
3184 | } | |||
3185 | auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)}; | |||
3186 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
3187 | AddSpecificProcs(names, kind); | |||
3188 | return false; | |||
3189 | } | |||
3190 | ||||
3191 | bool InterfaceVisitor::Pre(const parser::GenericStmt &) { | |||
3192 | genericInfo_.emplace(/*isInterface*/ false); | |||
3193 | return true; | |||
3194 | } | |||
3195 | void InterfaceVisitor::Post(const parser::GenericStmt &x) { | |||
3196 | if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) { | |||
3197 | SetExplicitAttr(*GetGenericInfo().symbol, AccessSpecToAttr(*accessSpec)); | |||
3198 | } | |||
3199 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
3200 | AddSpecificProcs(names, ProcedureKind::Procedure); | |||
3201 | genericInfo_.pop(); | |||
3202 | } | |||
3203 | ||||
3204 | bool InterfaceVisitor::inInterfaceBlock() const { | |||
3205 | return !genericInfo_.empty() && GetGenericInfo().isInterface; | |||
3206 | } | |||
3207 | bool InterfaceVisitor::isGeneric() const { | |||
3208 | return !genericInfo_.empty() && GetGenericInfo().symbol; | |||
3209 | } | |||
3210 | bool InterfaceVisitor::isAbstract() const { | |||
3211 | return !genericInfo_.empty() && GetGenericInfo().isAbstract; | |||
3212 | } | |||
3213 | ||||
3214 | void InterfaceVisitor::AddSpecificProcs( | |||
3215 | const std::list<parser::Name> &names, ProcedureKind kind) { | |||
3216 | for (const auto &name : names) { | |||
3217 | specificProcs_.emplace( | |||
3218 | GetGenericInfo().symbol, std::make_pair(&name, kind)); | |||
3219 | } | |||
3220 | } | |||
3221 | ||||
3222 | // By now we should have seen all specific procedures referenced by name in | |||
3223 | // this generic interface. Resolve those names to symbols. | |||
3224 | void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) { | |||
3225 | auto &details{generic.get<GenericDetails>()}; | |||
3226 | UnorderedSymbolSet symbolsSeen; | |||
3227 | for (const Symbol &symbol : details.specificProcs()) { | |||
3228 | symbolsSeen.insert(symbol.GetUltimate()); | |||
3229 | } | |||
3230 | auto range{specificProcs_.equal_range(&generic)}; | |||
3231 | for (auto it{range.first}; it != range.second; ++it) { | |||
3232 | const parser::Name *name{it->second.first}; | |||
3233 | auto kind{it->second.second}; | |||
3234 | const auto *symbol{FindSymbol(*name)}; | |||
3235 | if (!symbol) { | |||
3236 | Say(*name, "Procedure '%s' not found"_err_en_US); | |||
3237 | continue; | |||
3238 | } | |||
3239 | // Subtlety: when *symbol is a use- or host-association, the specific | |||
3240 | // procedure that is recorded in the GenericDetails below must be *symbol, | |||
3241 | // not the specific procedure shadowed by a generic, because that specific | |||
3242 | // procedure may be a symbol from another module and its name unavailable to | |||
3243 | // emit to a module file. | |||
3244 | const Symbol &bypassed{BypassGeneric(*symbol)}; | |||
3245 | const Symbol &specific{ | |||
3246 | symbol == &symbol->GetUltimate() ? bypassed : *symbol}; | |||
3247 | const Symbol &ultimate{bypassed.GetUltimate()}; | |||
3248 | ProcedureDefinitionClass defClass{ClassifyProcedure(ultimate)}; | |||
3249 | if (defClass == ProcedureDefinitionClass::Module) { | |||
3250 | // ok | |||
3251 | } else if (kind == ProcedureKind::ModuleProcedure) { | |||
3252 | Say(*name, "'%s' is not a module procedure"_err_en_US); | |||
3253 | continue; | |||
3254 | } else { | |||
3255 | switch (defClass) { | |||
3256 | case ProcedureDefinitionClass::Intrinsic: | |||
3257 | case ProcedureDefinitionClass::External: | |||
3258 | case ProcedureDefinitionClass::Internal: | |||
3259 | case ProcedureDefinitionClass::Dummy: | |||
3260 | case ProcedureDefinitionClass::Pointer: | |||
3261 | break; | |||
3262 | case ProcedureDefinitionClass::None: | |||
3263 | Say(*name, "'%s' is not a procedure"_err_en_US); | |||
3264 | continue; | |||
3265 | default: | |||
3266 | Say(*name, | |||
3267 | "'%s' is not a procedure that can appear in a generic interface"_err_en_US); | |||
3268 | continue; | |||
3269 | } | |||
3270 | } | |||
3271 | if (symbolsSeen.insert(ultimate).second /*true if added*/) { | |||
3272 | // When a specific procedure is a USE association, that association | |||
3273 | // is saved in the generic's specifics, not its ultimate symbol, | |||
3274 | // so that module file output of interfaces can distinguish them. | |||
3275 | details.AddSpecificProc(specific, name->source); | |||
3276 | } else if (&specific == &ultimate) { | |||
3277 | Say(name->source, | |||
3278 | "Procedure '%s' is already specified in generic '%s'"_err_en_US, | |||
3279 | name->source, MakeOpName(generic.name())); | |||
3280 | } else { | |||
3281 | Say(name->source, | |||
3282 | "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US, | |||
3283 | ultimate.name(), ultimate.owner().GetName().value(), | |||
3284 | MakeOpName(generic.name())); | |||
3285 | } | |||
3286 | } | |||
3287 | specificProcs_.erase(range.first, range.second); | |||
3288 | } | |||
3289 | ||||
3290 | // Mixed interfaces are allowed by the standard. | |||
3291 | // If there is a derived type with the same name, they must all be functions. | |||
3292 | void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) { | |||
3293 | ResolveSpecificsInGeneric(generic); | |||
3294 | auto &details{generic.get<GenericDetails>()}; | |||
3295 | if (auto *proc{details.CheckSpecific()}) { | |||
3296 | auto msg{ | |||
3297 | "'%s' should not be the name of both a generic interface and a" | |||
3298 | " procedure unless it is a specific procedure of the generic"_warn_en_US}; | |||
3299 | if (proc->name().begin() > generic.name().begin()) { | |||
3300 | Say(proc->name(), std::move(msg)); | |||
3301 | } else { | |||
3302 | Say(generic.name(), std::move(msg)); | |||
3303 | } | |||
3304 | } | |||
3305 | auto &specifics{details.specificProcs()}; | |||
3306 | if (specifics.empty()) { | |||
3307 | if (details.derivedType()) { | |||
3308 | generic.set(Symbol::Flag::Function); | |||
3309 | } | |||
3310 | return; | |||
3311 | } | |||
3312 | const Symbol &firstSpecific{specifics.front()}; | |||
3313 | bool isFunction{firstSpecific.test(Symbol::Flag::Function)}; | |||
3314 | bool isBoth{false}; | |||
3315 | for (const Symbol &specific : specifics) { | |||
3316 | if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514 | |||
3317 | auto &msg{Say(generic.name(), | |||
3318 | "Generic interface '%s' has both a function and a subroutine"_warn_en_US)}; | |||
3319 | if (isFunction) { | |||
3320 | msg.Attach(firstSpecific.name(), "Function declaration"_en_US); | |||
3321 | msg.Attach(specific.name(), "Subroutine declaration"_en_US); | |||
3322 | } else { | |||
3323 | msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US); | |||
3324 | msg.Attach(specific.name(), "Function declaration"_en_US); | |||
3325 | } | |||
3326 | isFunction = false; | |||
3327 | isBoth = true; | |||
3328 | break; | |||
3329 | } | |||
3330 | } | |||
3331 | if (!isFunction && details.derivedType()) { | |||
3332 | SayDerivedType(generic.name(), | |||
3333 | "Generic interface '%s' may only contain functions due to derived type" | |||
3334 | " with same name"_err_en_US, | |||
3335 | *details.derivedType()->GetUltimate().scope()); | |||
3336 | } | |||
3337 | if (!isBoth) { | |||
3338 | generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine); | |||
3339 | } | |||
3340 | } | |||
3341 | ||||
3342 | // SubprogramVisitor implementation | |||
3343 | ||||
3344 | // Return false if it is actually an assignment statement. | |||
3345 | bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) { | |||
3346 | const auto &name{std::get<parser::Name>(x.t)}; | |||
3347 | const DeclTypeSpec *resultType{nullptr}; | |||
3348 | // Look up name: provides return type or tells us if it's an array | |||
3349 | if (auto *symbol{FindSymbol(name)}) { | |||
3350 | auto *details{symbol->detailsIf<EntityDetails>()}; | |||
3351 | if (!details || symbol->has<ObjectEntityDetails>() || | |||
3352 | symbol->has<ProcEntityDetails>()) { | |||
3353 | badStmtFuncFound_ = true; | |||
3354 | return false; | |||
3355 | } | |||
3356 | // TODO: check that attrs are compatible with stmt func | |||
3357 | resultType = details->type(); | |||
3358 | symbol->details() = UnknownDetails{}; // will be replaced below | |||
3359 | } | |||
3360 | if (badStmtFuncFound_) { | |||
3361 | Say(name, "'%s' has not been declared as an array"_err_en_US); | |||
3362 | return false; | |||
3363 | } | |||
3364 | auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)}; | |||
3365 | symbol.set(Symbol::Flag::StmtFunction); | |||
3366 | EraseSymbol(symbol); // removes symbol added by PushSubprogramScope | |||
3367 | auto &details{symbol.get<SubprogramDetails>()}; | |||
3368 | for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) { | |||
3369 | ObjectEntityDetails dummyDetails{true}; | |||
3370 | if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) { | |||
3371 | if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) { | |||
3372 | if (d->type()) { | |||
3373 | dummyDetails.set_type(*d->type()); | |||
3374 | } | |||
3375 | } | |||
3376 | } | |||
3377 | Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))}; | |||
3378 | ApplyImplicitRules(dummy); | |||
3379 | details.add_dummyArg(dummy); | |||
3380 | } | |||
3381 | ObjectEntityDetails resultDetails; | |||
3382 | if (resultType) { | |||
3383 | resultDetails.set_type(*resultType); | |||
3384 | } | |||
3385 | resultDetails.set_funcResult(true); | |||
3386 | Symbol &result{MakeSymbol(name, std::move(resultDetails))}; | |||
3387 | result.flags().set(Symbol::Flag::StmtFunction); | |||
3388 | ApplyImplicitRules(result); | |||
3389 | details.set_result(result); | |||
3390 | // The analysis of the expression that constitutes the body of the | |||
3391 | // statement function is deferred to FinishSpecificationPart() so that | |||
3392 | // all declarations and implicit typing are complete. | |||
3393 | PopScope(); | |||
3394 | return true; | |||
3395 | } | |||
3396 | ||||
3397 | bool SubprogramVisitor::Pre(const parser::Suffix &suffix) { | |||
3398 | if (suffix.resultName) { | |||
3399 | if (IsFunction(currScope())) { | |||
3400 | if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) { | |||
3401 | if (info->inFunctionStmt) { | |||
3402 | info->resultName = &suffix.resultName.value(); | |||
3403 | } else { | |||
3404 | // will check the result name in Post(EntryStmt) | |||
3405 | } | |||
3406 | } | |||
3407 | } else { | |||
3408 | Message &msg{Say(*suffix.resultName, | |||
3409 | "RESULT(%s) may appear only in a function"_err_en_US)}; | |||
3410 | if (const Symbol * subprogram{InclusiveScope().symbol()}) { | |||
3411 | msg.Attach(subprogram->name(), "Containing subprogram"_en_US); | |||
3412 | } | |||
3413 | } | |||
3414 | } | |||
3415 | // LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt, | |||
3416 | // all the way to EndSubprogram(). | |||
3417 | return false; | |||
3418 | } | |||
3419 | ||||
3420 | bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) { | |||
3421 | // Save this to process after UseStmt and ImplicitPart | |||
3422 | if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) { | |||
3423 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3423)}; | |||
3424 | if (info.parsedType) { // C1543 | |||
3425 | Say(currStmtSource().value(), | |||
3426 | "FUNCTION prefix cannot specify the type more than once"_err_en_US); | |||
3427 | return false; | |||
3428 | } else { | |||
3429 | info.parsedType = parsedType; | |||
3430 | info.source = currStmtSource(); | |||
3431 | return false; | |||
3432 | } | |||
3433 | } else { | |||
3434 | return true; | |||
3435 | } | |||
3436 | } | |||
3437 | ||||
3438 | bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) { | |||
3439 | const auto &name{std::get<parser::Name>( | |||
3440 | std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)}; | |||
3441 | return BeginSubprogram(name, Symbol::Flag::Subroutine); | |||
3442 | } | |||
3443 | void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) { | |||
3444 | const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)}; | |||
3445 | EndSubprogram(stmt.source, | |||
3446 | &std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t)); | |||
3447 | } | |||
3448 | bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) { | |||
3449 | const auto &name{std::get<parser::Name>( | |||
3450 | std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)}; | |||
3451 | return BeginSubprogram(name, Symbol::Flag::Function); | |||
3452 | } | |||
3453 | void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) { | |||
3454 | const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)}; | |||
3455 | const auto &maybeSuffix{ | |||
3456 | std::get<std::optional<parser::Suffix>>(stmt.statement.t)}; | |||
3457 | EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr); | |||
3458 | } | |||
3459 | ||||
3460 | bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) { | |||
3461 | BeginAttrs(); | |||
3462 | Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t)); | |||
3463 | Walk(std::get<parser::Name>(stmt.t)); | |||
3464 | Walk(std::get<std::list<parser::DummyArg>>(stmt.t)); | |||
3465 | // Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram. | |||
3466 | Symbol &symbol{PostSubprogramStmt()}; | |||
3467 | SubprogramDetails &details{symbol.get<SubprogramDetails>()}; | |||
3468 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3469 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3470 | CreateDummyArgument(details, *dummyName); | |||
3471 | } else { | |||
3472 | details.add_alternateReturn(); | |||
3473 | } | |||
3474 | } | |||
3475 | return false; | |||
3476 | } | |||
3477 | bool SubprogramVisitor::Pre(const parser::FunctionStmt &) { | |||
3478 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3478)}; | |||
3479 | CHECK(!info.inFunctionStmt)((!info.inFunctionStmt) || (Fortran::common::die("CHECK(" "!info.inFunctionStmt" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3479), false)); | |||
3480 | info.inFunctionStmt = true; | |||
3481 | return BeginAttrs(); | |||
3482 | } | |||
3483 | bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); } | |||
3484 | ||||
3485 | void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { | |||
3486 | const auto &name{std::get<parser::Name>(stmt.t)}; | |||
3487 | Symbol &symbol{PostSubprogramStmt()}; | |||
3488 | SubprogramDetails &details{symbol.get<SubprogramDetails>()}; | |||
3489 | for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) { | |||
3490 | CreateDummyArgument(details, dummyName); | |||
3491 | } | |||
3492 | const parser::Name *funcResultName; | |||
3493 | FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())Fortran::common::Deref(funcResultStack().Top(), "flang/lib/Semantics/resolve-names.cpp" , 3493)}; | |||
3494 | CHECK(info.inFunctionStmt)((info.inFunctionStmt) || (Fortran::common::die("CHECK(" "info.inFunctionStmt" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3494), false)); | |||
3495 | info.inFunctionStmt = false; | |||
3496 | bool distinctResultName{ | |||
3497 | info.resultName && info.resultName->source != name.source}; | |||
3498 | if (distinctResultName) { | |||
3499 | // Note that RESULT is ignored if it has the same name as the function. | |||
3500 | // The symbol created by PushScope() is retained as a place-holder | |||
3501 | // for error detection. | |||
3502 | funcResultName = info.resultName; | |||
3503 | } else { | |||
3504 | EraseSymbol(name); // was added by PushScope() | |||
3505 | funcResultName = &name; | |||
3506 | } | |||
3507 | if (details.isFunction()) { | |||
3508 | CHECK(context().HasError(currScope().symbol()))((context().HasError(currScope().symbol())) || (Fortran::common ::die("CHECK(" "context().HasError(currScope().symbol())" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 3508) , false)); | |||
3509 | } else { | |||
3510 | // RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY | |||
3511 | // statement. | |||
3512 | Symbol *result{nullptr}; | |||
3513 | if (distinctResultName) { | |||
3514 | if (auto iter{currScope().find(funcResultName->source)}; | |||
3515 | iter != currScope().end()) { | |||
3516 | Symbol &entryResult{*iter->second}; | |||
3517 | if (IsFunctionResult(entryResult)) { | |||
3518 | result = &entryResult; | |||
3519 | } | |||
3520 | } | |||
3521 | } | |||
3522 | if (result) { | |||
3523 | Resolve(*funcResultName, *result); | |||
3524 | } else { | |||
3525 | // add function result to function scope | |||
3526 | EntityDetails funcResultDetails; | |||
3527 | funcResultDetails.set_funcResult(true); | |||
3528 | result = &MakeSymbol(*funcResultName, std::move(funcResultDetails)); | |||
3529 | } | |||
3530 | info.resultSymbol = result; | |||
3531 | details.set_result(*result); | |||
3532 | } | |||
3533 | // C1560. | |||
3534 | if (info.resultName && !distinctResultName) { | |||
3535 | Say(info.resultName->source, | |||
3536 | "The function name should not appear in RESULT, references to '%s' " | |||
3537 | "inside the function will be considered as references to the " | |||
3538 | "result only"_warn_en_US, | |||
3539 | name.source); | |||
3540 | // RESULT name was ignored above, the only side effect from doing so will be | |||
3541 | // the inability to make recursive calls. The related parser::Name is still | |||
3542 | // resolved to the created function result symbol because every parser::Name | |||
3543 | // should be resolved to avoid internal errors. | |||
3544 | Resolve(*info.resultName, info.resultSymbol); | |||
3545 | } | |||
3546 | name.symbol = &symbol; // must not be function result symbol | |||
3547 | // Clear the RESULT() name now in case an ENTRY statement in the implicit-part | |||
3548 | // has a RESULT() suffix. | |||
3549 | info.resultName = nullptr; | |||
3550 | } | |||
3551 | ||||
3552 | Symbol &SubprogramVisitor::PostSubprogramStmt() { | |||
3553 | Symbol &symbol{*currScope().symbol()}; | |||
3554 | SetExplicitAttrs(symbol, EndAttrs()); | |||
3555 | if (symbol.attrs().test(Attr::MODULE)) { | |||
3556 | symbol.attrs().set(Attr::EXTERNAL, false); | |||
3557 | symbol.implicitAttrs().set(Attr::EXTERNAL, false); | |||
3558 | } | |||
3559 | return symbol; | |||
3560 | } | |||
3561 | ||||
3562 | void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { | |||
3563 | if (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) { | |||
3564 | Walk(suffix->binding); | |||
3565 | } | |||
3566 | PostEntryStmt(stmt); | |||
3567 | EndAttrs(); | |||
3568 | } | |||
3569 | ||||
3570 | void SubprogramVisitor::CreateDummyArgument( | |||
3571 | SubprogramDetails &details, const parser::Name &name) { | |||
3572 | Symbol *dummy{FindInScope(name)}; | |||
3573 | if (dummy) { | |||
3574 | if (IsDummy(*dummy)) { | |||
3575 | if (dummy->test(Symbol::Flag::EntryDummyArgument)) { | |||
3576 | dummy->set(Symbol::Flag::EntryDummyArgument, false); | |||
3577 | } else { | |||
3578 | Say(name, | |||
3579 | "'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US, | |||
3580 | name.source); | |||
3581 | return; | |||
3582 | } | |||
3583 | } else { | |||
3584 | SayWithDecl(name, *dummy, | |||
3585 | "'%s' may not appear as a dummy argument name in this subprogram"_err_en_US); | |||
3586 | return; | |||
3587 | } | |||
3588 | } else { | |||
3589 | dummy = &MakeSymbol(name, EntityDetails{true}); | |||
3590 | } | |||
3591 | details.add_dummyArg(DEREF(dummy)Fortran::common::Deref(dummy, "flang/lib/Semantics/resolve-names.cpp" , 3591)); | |||
3592 | } | |||
3593 | ||||
3594 | void SubprogramVisitor::CreateEntry( | |||
3595 | const parser::EntryStmt &stmt, Symbol &subprogram) { | |||
3596 | const auto &entryName{std::get<parser::Name>(stmt.t)}; | |||
3597 | Scope &outer{currScope().parent()}; | |||
3598 | Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function) | |||
3599 | ? Symbol::Flag::Function | |||
3600 | : Symbol::Flag::Subroutine}; | |||
3601 | Attrs attrs; | |||
3602 | const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}; | |||
3603 | bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding && | |||
3604 | suffix->binding->v.has_value()}; | |||
3605 | if (!hasGlobalBindingName) { | |||
3606 | if (Symbol * extant{FindSymbol(outer, entryName)}) { | |||
3607 | if (!HandlePreviousCalls(entryName, *extant, subpFlag)) { | |||
3608 | if (outer.IsTopLevel()) { | |||
3609 | Say2(entryName, | |||
3610 | "'%s' is already defined as a global identifier"_err_en_US, | |||
3611 | *extant, "Previous definition of '%s'"_en_US); | |||
3612 | } else { | |||
3613 | SayAlreadyDeclared(entryName, *extant); | |||
3614 | } | |||
3615 | return; | |||
3616 | } | |||
3617 | attrs = extant->attrs(); | |||
3618 | } | |||
3619 | } | |||
3620 | bool badResultName{false}; | |||
3621 | std::optional<SourceName> distinctResultName; | |||
3622 | if (suffix && suffix->resultName && | |||
3623 | suffix->resultName->source != entryName.source) { | |||
3624 | distinctResultName = suffix->resultName->source; | |||
3625 | const parser::Name &resultName{*suffix->resultName}; | |||
3626 | if (resultName.source == subprogram.name()) { // C1574 | |||
3627 | Say2(resultName.source, | |||
3628 | "RESULT(%s) may not have the same name as the function"_err_en_US, | |||
3629 | subprogram, "Containing function"_en_US); | |||
3630 | badResultName = true; | |||
3631 | } else if (const Symbol * extant{FindSymbol(outer, resultName)}) { // C1574 | |||
3632 | if (const auto *details{extant->detailsIf<SubprogramDetails>()}) { | |||
3633 | if (details->entryScope() == &currScope()) { | |||
3634 | Say2(resultName.source, | |||
3635 | "RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US, | |||
3636 | extant->name(), "Conflicting ENTRY"_en_US); | |||
3637 | badResultName = true; | |||
3638 | } | |||
3639 | } | |||
3640 | } | |||
3641 | } | |||
3642 | if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) { | |||
3643 | attrs.set(Attr::PUBLIC); | |||
3644 | } | |||
3645 | Symbol *entrySymbol{nullptr}; | |||
3646 | if (hasGlobalBindingName) { | |||
3647 | // Hide the entry's symbol in a new anonymous global scope so | |||
3648 | // that its name doesn't clash with anything. | |||
3649 | Symbol &symbol{MakeSymbol(outer, context().GetTempName(outer), Attrs{})}; | |||
3650 | symbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName}); | |||
3651 | Scope &hidden{outer.MakeScope(Scope::Kind::Global, &symbol)}; | |||
3652 | entrySymbol = &MakeSymbol(hidden, entryName.source, attrs); | |||
3653 | } else { | |||
3654 | entrySymbol = FindInScope(outer, entryName.source); | |||
3655 | if (entrySymbol) { | |||
3656 | if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) { | |||
3657 | if (auto *specific{generic->specific()}) { | |||
3658 | // Forward reference to ENTRY from a generic interface | |||
3659 | entrySymbol = specific; | |||
3660 | CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs); | |||
3661 | SetExplicitAttrs(*entrySymbol, attrs); | |||
3662 | } | |||
3663 | } | |||
3664 | } else { | |||
3665 | entrySymbol = &MakeSymbol(outer, entryName.source, attrs); | |||
3666 | } | |||
3667 | } | |||
3668 | SubprogramDetails entryDetails; | |||
3669 | entryDetails.set_entryScope(currScope()); | |||
3670 | entrySymbol->set(subpFlag); | |||
3671 | if (subpFlag == Symbol::Flag::Function) { | |||
3672 | Symbol *result{nullptr}; | |||
3673 | EntityDetails resultDetails; | |||
3674 | resultDetails.set_funcResult(true); | |||
3675 | if (distinctResultName) { | |||
3676 | if (!badResultName) { | |||
3677 | // RESULT(x) can be the same explicitly-named RESULT(x) as | |||
3678 | // the enclosing function or another ENTRY. | |||
3679 | if (auto iter{currScope().find(suffix->resultName->source)}; | |||
3680 | iter != currScope().end()) { | |||
3681 | result = &*iter->second; | |||
3682 | } | |||
3683 | if (!result) { | |||
3684 | result = &MakeSymbol( | |||
3685 | *distinctResultName, Attrs{}, std::move(resultDetails)); | |||
3686 | } | |||
3687 | Resolve(*suffix->resultName, *result); | |||
3688 | } | |||
3689 | } else { | |||
3690 | result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails)); | |||
3691 | } | |||
3692 | if (result) { | |||
3693 | entryDetails.set_result(*result); | |||
3694 | } | |||
3695 | } | |||
3696 | if (subpFlag == Symbol::Flag::Subroutine || | |||
3697 | (distinctResultName && !badResultName)) { | |||
3698 | Symbol &assoc{MakeSymbol(entryName.source)}; | |||
3699 | assoc.set_details(HostAssocDetails{*entrySymbol}); | |||
3700 | assoc.set(Symbol::Flag::Subroutine); | |||
3701 | } | |||
3702 | Resolve(entryName, *entrySymbol); | |||
3703 | std::set<SourceName> dummies; | |||
3704 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3705 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3706 | auto pair{dummies.insert(dummyName->source)}; | |||
3707 | if (!pair.second) { | |||
3708 | Say(*dummyName, | |||
3709 | "'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US, | |||
3710 | dummyName->source); | |||
3711 | continue; | |||
3712 | } | |||
3713 | Symbol *dummy{FindInScope(*dummyName)}; | |||
3714 | if (dummy) { | |||
3715 | if (!IsDummy(*dummy)) { | |||
3716 | evaluate::AttachDeclaration( | |||
3717 | Say(*dummyName, | |||
3718 | "'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US, | |||
3719 | dummyName->source), | |||
3720 | *dummy); | |||
3721 | continue; | |||
3722 | } | |||
3723 | } else { | |||
3724 | dummy = &MakeSymbol(*dummyName, EntityDetails{true}); | |||
3725 | dummy->set(Symbol::Flag::EntryDummyArgument); | |||
3726 | } | |||
3727 | entryDetails.add_dummyArg(DEREF(dummy)Fortran::common::Deref(dummy, "flang/lib/Semantics/resolve-names.cpp" , 3727)); | |||
3728 | } else if (subpFlag == Symbol::Flag::Function) { // C1573 | |||
3729 | Say(entryName, | |||
3730 | "ENTRY in a function may not have an alternate return dummy argument"_err_en_US); | |||
3731 | break; | |||
3732 | } else { | |||
3733 | entryDetails.add_alternateReturn(); | |||
3734 | } | |||
3735 | } | |||
3736 | entrySymbol->set_details(std::move(entryDetails)); | |||
3737 | } | |||
3738 | ||||
3739 | void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) { | |||
3740 | // The entry symbol should have already been created and resolved | |||
3741 | // in CreateEntry(), called by BeginSubprogram(), with one exception (below). | |||
3742 | const auto &name{std::get<parser::Name>(stmt.t)}; | |||
3743 | Scope &inclusiveScope{InclusiveScope()}; | |||
3744 | if (!name.symbol) { | |||
3745 | if (inclusiveScope.kind() != Scope::Kind::Subprogram) { | |||
3746 | Say(name.source, | |||
3747 | "ENTRY '%s' may appear only in a subroutine or function"_err_en_US, | |||
3748 | name.source); | |||
3749 | } else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) { | |||
3750 | Say(name.source, | |||
3751 | "ENTRY '%s' may not appear in a separate module procedure"_err_en_US, | |||
3752 | name.source); | |||
3753 | } else { | |||
3754 | // C1571 - entry is nested, so was not put into the program tree; error | |||
3755 | // is emitted from MiscChecker in semantics.cpp. | |||
3756 | } | |||
3757 | return; | |||
3758 | } | |||
3759 | Symbol &entrySymbol{*name.symbol}; | |||
3760 | if (context().HasError(entrySymbol)) { | |||
3761 | return; | |||
3762 | } | |||
3763 | if (!entrySymbol.has<SubprogramDetails>()) { | |||
3764 | SayAlreadyDeclared(name, entrySymbol); | |||
3765 | return; | |||
3766 | } | |||
3767 | SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()}; | |||
3768 | CHECK(entryDetails.entryScope() == &inclusiveScope)((entryDetails.entryScope() == &inclusiveScope) || (Fortran ::common::die("CHECK(" "entryDetails.entryScope() == &inclusiveScope" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 3768), false)); | |||
3769 | entrySymbol.attrs() |= GetAttrs(); | |||
3770 | SetBindNameOn(entrySymbol); | |||
3771 | for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { | |||
3772 | if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { | |||
3773 | if (Symbol * dummy{FindInScope(*dummyName)}) { | |||
3774 | if (dummy->test(Symbol::Flag::EntryDummyArgument)) { | |||
3775 | const auto *subp{dummy->detailsIf<SubprogramDetails>()}; | |||
3776 | if (subp && subp->isInterface()) { // ok | |||
3777 | } else if (!dummy->has<EntityDetails>() && | |||
3778 | !dummy->has<ObjectEntityDetails>() && | |||
3779 | !dummy->has<ProcEntityDetails>()) { | |||
3780 | SayWithDecl(*dummyName, *dummy, | |||
3781 | "ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US); | |||
3782 | } | |||
3783 | dummy->set(Symbol::Flag::EntryDummyArgument, false); | |||
3784 | } | |||
3785 | } | |||
3786 | } | |||
3787 | } | |||
3788 | } | |||
3789 | ||||
3790 | Symbol *ScopeHandler::FindSeparateModuleProcedureInterface( | |||
3791 | const parser::Name &name) { | |||
3792 | auto *symbol{FindSymbol(name)}; | |||
3793 | if (symbol && symbol->has<SubprogramNameDetails>()) { | |||
3794 | const Scope *parent{nullptr}; | |||
3795 | if (currScope().IsSubmodule()) { | |||
3796 | parent = currScope().symbol()->get<ModuleDetails>().parent(); | |||
3797 | } | |||
3798 | symbol = parent ? FindSymbol(*parent, name) : nullptr; | |||
3799 | } | |||
3800 | if (symbol) { | |||
3801 | if (auto *generic{symbol->detailsIf<GenericDetails>()}) { | |||
3802 | symbol = generic->specific(); | |||
3803 | } | |||
3804 | } | |||
3805 | if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) { | |||
3806 | // Error recovery in case of multiple definitions | |||
3807 | symbol = const_cast<Symbol *>(defnIface); | |||
3808 | } | |||
3809 | if (!IsSeparateModuleProcedureInterface(symbol)) { | |||
3810 | Say(name, "'%s' was not declared a separate module procedure"_err_en_US); | |||
3811 | symbol = nullptr; | |||
3812 | } | |||
3813 | return symbol; | |||
3814 | } | |||
3815 | ||||
3816 | // A subprogram declared with MODULE PROCEDURE | |||
3817 | bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) { | |||
3818 | Symbol *symbol{FindSeparateModuleProcedureInterface(name)}; | |||
3819 | if (!symbol) { | |||
3820 | return false; | |||
3821 | } | |||
3822 | if (symbol->owner() == currScope() && symbol->scope()) { | |||
3823 | // This is a MODULE PROCEDURE whose interface appears in its host. | |||
3824 | // Convert the module procedure's interface into a subprogram. | |||
3825 | SetScope(DEREF(symbol->scope())Fortran::common::Deref(symbol->scope(), "flang/lib/Semantics/resolve-names.cpp" , 3825)); | |||
3826 | symbol->get<SubprogramDetails>().set_isInterface(false); | |||
3827 | } else { | |||
3828 | // Copy the interface into a new subprogram scope. | |||
3829 | EraseSymbol(name); | |||
3830 | Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})}; | |||
3831 | PushScope(Scope::Kind::Subprogram, &newSymbol); | |||
3832 | newSymbol.get<SubprogramDetails>().set_moduleInterface(*symbol); | |||
3833 | newSymbol.attrs() |= symbol->attrs(); | |||
3834 | newSymbol.set(symbol->test(Symbol::Flag::Subroutine) | |||
3835 | ? Symbol::Flag::Subroutine | |||
3836 | : Symbol::Flag::Function); | |||
3837 | MapSubprogramToNewSymbols(*symbol, newSymbol, currScope()); | |||
3838 | } | |||
3839 | return true; | |||
3840 | } | |||
3841 | ||||
3842 | // A subprogram or interface declared with SUBROUTINE or FUNCTION | |||
3843 | bool SubprogramVisitor::BeginSubprogram(const parser::Name &name, | |||
3844 | Symbol::Flag subpFlag, bool hasModulePrefix, | |||
3845 | const parser::LanguageBindingSpec *bindingSpec, | |||
3846 | const ProgramTree::EntryStmtList *entryStmts) { | |||
3847 | if (hasModulePrefix && currScope().IsGlobal()) { // C1547 | |||
3848 | Say(name, | |||
3849 | "'%s' is a MODULE procedure which must be declared within a " | |||
3850 | "MODULE or SUBMODULE"_err_en_US); | |||
3851 | return false; | |||
3852 | } | |||
3853 | Symbol *moduleInterface{nullptr}; | |||
3854 | if (hasModulePrefix && !inInterfaceBlock()) { | |||
3855 | moduleInterface = FindSeparateModuleProcedureInterface(name); | |||
3856 | if (moduleInterface && &moduleInterface->owner() == &currScope()) { | |||
3857 | // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface | |||
3858 | // previously defined in the same scope. | |||
3859 | EraseSymbol(name); | |||
3860 | } | |||
3861 | } | |||
3862 | Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)}; | |||
3863 | if (moduleInterface) { | |||
3864 | newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface); | |||
3865 | if (moduleInterface->attrs().test(Attr::PRIVATE)) { | |||
3866 | SetImplicitAttr(newSymbol, Attr::PRIVATE); | |||
3867 | } else if (moduleInterface->attrs().test(Attr::PUBLIC)) { | |||
3868 | SetImplicitAttr(newSymbol, Attr::PUBLIC); | |||
3869 | } | |||
3870 | } | |||
3871 | if (entryStmts) { | |||
3872 | for (const auto &ref : *entryStmts) { | |||
3873 | CreateEntry(*ref, newSymbol); | |||
3874 | } | |||
3875 | } | |||
3876 | return true; | |||
3877 | } | |||
3878 | ||||
3879 | void SubprogramVisitor::HandleLanguageBinding(Symbol *symbol, | |||
3880 | std::optional<parser::CharBlock> stmtSource, | |||
3881 | const std::optional<parser::LanguageBindingSpec> *binding) { | |||
3882 | if (binding && *binding && symbol) { | |||
3883 | // Finally process the BIND(C,NAME=name) now that symbols in the name | |||
3884 | // expression will resolve to local names if needed. | |||
3885 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)}; | |||
3886 | auto originalStmtSource{messageHandler().currStmtSource()}; | |||
3887 | messageHandler().set_currStmtSource(stmtSource); | |||
3888 | BeginAttrs(); | |||
3889 | Walk(**binding); | |||
3890 | SetBindNameOn(*symbol); | |||
3891 | symbol->attrs() |= EndAttrs(); | |||
3892 | messageHandler().set_currStmtSource(originalStmtSource); | |||
3893 | } | |||
3894 | } | |||
3895 | ||||
3896 | void SubprogramVisitor::EndSubprogram( | |||
3897 | std::optional<parser::CharBlock> stmtSource, | |||
3898 | const std::optional<parser::LanguageBindingSpec> *binding, | |||
3899 | const ProgramTree::EntryStmtList *entryStmts) { | |||
3900 | HandleLanguageBinding(currScope().symbol(), stmtSource, binding); | |||
3901 | if (entryStmts) { | |||
3902 | for (const auto &ref : *entryStmts) { | |||
3903 | const parser::EntryStmt &entryStmt{*ref}; | |||
3904 | if (const auto &suffix{ | |||
3905 | std::get<std::optional<parser::Suffix>>(entryStmt.t)}) { | |||
3906 | const auto &name{std::get<parser::Name>(entryStmt.t)}; | |||
3907 | HandleLanguageBinding(name.symbol, name.source, &suffix->binding); | |||
3908 | } | |||
3909 | } | |||
3910 | } | |||
3911 | PopScope(); | |||
3912 | } | |||
3913 | ||||
3914 | bool SubprogramVisitor::HandlePreviousCalls( | |||
3915 | const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) { | |||
3916 | // If the extant symbol is a generic, check its homonymous specific | |||
3917 | // procedure instead if it has one. | |||
3918 | if (auto *generic{symbol.detailsIf<GenericDetails>()}) { | |||
3919 | return generic->specific() && | |||
3920 | HandlePreviousCalls(name, *generic->specific(), subpFlag); | |||
3921 | } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc && | |||
3922 | !proc->isDummy() && | |||
3923 | !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) { | |||
3924 | // There's a symbol created for previous calls to this subprogram or | |||
3925 | // ENTRY's name. We have to replace that symbol in situ to avoid the | |||
3926 | // obligation to rewrite symbol pointers in the parse tree. | |||
3927 | if (!symbol.test(subpFlag)) { | |||
3928 | // External statements issue an explicit EXTERNAL attribute. | |||
3929 | if (symbol.attrs().test(Attr::EXTERNAL) && | |||
3930 | !symbol.implicitAttrs().test(Attr::EXTERNAL)) { | |||
3931 | // Warn if external statement previously declared. | |||
3932 | Say(name, | |||
3933 | "EXTERNAL attribute was already specified on '%s'"_warn_en_US); | |||
3934 | } else { | |||
3935 | Say2(name, | |||
3936 | subpFlag == Symbol::Flag::Function | |||
3937 | ? "'%s' was previously called as a subroutine"_err_en_US | |||
3938 | : "'%s' was previously called as a function"_err_en_US, | |||
3939 | symbol, "Previous call of '%s'"_en_US); | |||
3940 | } | |||
3941 | } | |||
3942 | EntityDetails entity; | |||
3943 | if (proc->type()) { | |||
3944 | entity.set_type(*proc->type()); | |||
3945 | } | |||
3946 | symbol.details() = std::move(entity); | |||
3947 | return true; | |||
3948 | } else { | |||
3949 | return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>(); | |||
3950 | } | |||
3951 | } | |||
3952 | ||||
3953 | void SubprogramVisitor::CheckExtantProc( | |||
3954 | const parser::Name &name, Symbol::Flag subpFlag) { | |||
3955 | if (auto *prev{FindSymbol(name)}) { | |||
3956 | if (IsDummy(*prev)) { | |||
3957 | } else if (auto *entity{prev->detailsIf<EntityDetails>()}; | |||
3958 | IsPointer(*prev) && entity && !entity->type()) { | |||
3959 | // POINTER attribute set before interface | |||
3960 | } else if (inInterfaceBlock() && currScope() != prev->owner()) { | |||
3961 | // Procedures in an INTERFACE block do not resolve to symbols | |||
3962 | // in scopes between the global scope and the current scope. | |||
3963 | } else if (!HandlePreviousCalls(name, *prev, subpFlag)) { | |||
3964 | SayAlreadyDeclared(name, *prev); | |||
3965 | } | |||
3966 | } | |||
3967 | } | |||
3968 | ||||
3969 | Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name, | |||
3970 | Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) { | |||
3971 | Symbol *symbol{GetSpecificFromGeneric(name)}; | |||
3972 | if (!symbol) { | |||
3973 | if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) { | |||
3974 | // Create this new top-level subprogram with a binding label | |||
3975 | // in a new global scope, so that its symbol's name won't clash | |||
3976 | // with another symbol that has a distinct binding label. | |||
3977 | PushScope(Scope::Kind::Global, | |||
3978 | &MakeSymbol(context().GetTempName(currScope()), Attrs{}, | |||
3979 | MiscDetails{MiscDetails::Kind::ScopeName})); | |||
3980 | } | |||
3981 | CheckExtantProc(name, subpFlag); | |||
3982 | symbol = &MakeSymbol(name, SubprogramDetails{}); | |||
3983 | } | |||
3984 | symbol->ReplaceName(name.source); | |||
3985 | symbol->set(subpFlag); | |||
3986 | PushScope(Scope::Kind::Subprogram, symbol); | |||
3987 | if (subpFlag == Symbol::Flag::Function) { | |||
3988 | funcResultStack().Push(currScope()); | |||
3989 | } | |||
3990 | if (inInterfaceBlock()) { | |||
3991 | auto &details{symbol->get<SubprogramDetails>()}; | |||
3992 | details.set_isInterface(); | |||
3993 | if (isAbstract()) { | |||
3994 | SetExplicitAttr(*symbol, Attr::ABSTRACT); | |||
3995 | } else { | |||
3996 | MakeExternal(*symbol); | |||
3997 | } | |||
3998 | if (isGeneric()) { | |||
3999 | Symbol &genericSymbol{GetGenericSymbol()}; | |||
4000 | if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) { | |||
4001 | details->AddSpecificProc(*symbol, name.source); | |||
4002 | } else { | |||
4003 | CHECK(context().HasError(genericSymbol))((context().HasError(genericSymbol)) || (Fortran::common::die ("CHECK(" "context().HasError(genericSymbol)" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 4003), false )); | |||
4004 | } | |||
4005 | } | |||
4006 | set_inheritFromParent(false); | |||
4007 | } | |||
4008 | FindSymbol(name)->set(subpFlag); // PushScope() created symbol | |||
4009 | return *symbol; | |||
4010 | } | |||
4011 | ||||
4012 | void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) { | |||
4013 | if (auto *prev{FindSymbol(name)}) { | |||
4014 | if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) { | |||
4015 | if (prev->test(Symbol::Flag::Subroutine) || | |||
4016 | prev->test(Symbol::Flag::Function)) { | |||
4017 | Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev, | |||
4018 | "Previous call of '%s'"_en_US); | |||
4019 | } | |||
4020 | EraseSymbol(name); | |||
4021 | } | |||
4022 | } | |||
4023 | if (name.source.empty()) { | |||
4024 | // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM | |||
4025 | PushScope(Scope::Kind::BlockData, nullptr); | |||
4026 | } else { | |||
4027 | PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{})); | |||
4028 | } | |||
4029 | } | |||
4030 | ||||
4031 | // If name is a generic, return specific subprogram with the same name. | |||
4032 | Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) { | |||
4033 | // Search for the name but don't resolve it | |||
4034 | if (auto *symbol{currScope().FindSymbol(name.source)}) { | |||
4035 | if (symbol->has<SubprogramNameDetails>()) { | |||
4036 | if (inInterfaceBlock()) { | |||
4037 | // Subtle: clear any MODULE flag so that the new interface | |||
4038 | // symbol doesn't inherit it and ruin the ability to check it. | |||
4039 | symbol->attrs().reset(Attr::MODULE); | |||
4040 | } | |||
4041 | } else if (auto *details{symbol->detailsIf<GenericDetails>()}) { | |||
4042 | // found generic, want specific procedure | |||
4043 | auto *specific{details->specific()}; | |||
4044 | if (inInterfaceBlock()) { | |||
4045 | if (specific) { | |||
4046 | // Defining an interface in a generic of the same name which is | |||
4047 | // already shadowing another procedure. In some cases, the shadowed | |||
4048 | // procedure is about to be replaced. | |||
4049 | if (specific->has<SubprogramNameDetails>() && | |||
4050 | specific->attrs().test(Attr::MODULE)) { | |||
4051 | // The shadowed procedure is a separate module procedure that is | |||
4052 | // actually defined later in this (sub)module. | |||
4053 | // Define its interface now as a new symbol. | |||
4054 | specific = nullptr; | |||
4055 | } else if (&specific->owner() != &symbol->owner()) { | |||
4056 | // The shadowed procedure was from an enclosing scope and will be | |||
4057 | // overridden by this interface definition. | |||
4058 | specific = nullptr; | |||
4059 | } | |||
4060 | if (!specific) { | |||
4061 | details->clear_specific(); | |||
4062 | } | |||
4063 | } else if (const auto *dType{details->derivedType()}) { | |||
4064 | if (&dType->owner() != &symbol->owner()) { | |||
4065 | // The shadowed derived type was from an enclosing scope and | |||
4066 | // will be overridden by this interface definition. | |||
4067 | details->clear_derivedType(); | |||
4068 | } | |||
4069 | } | |||
4070 | } | |||
4071 | if (!specific) { | |||
4072 | specific = | |||
4073 | &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{}); | |||
4074 | if (details->derivedType()) { | |||
4075 | // A specific procedure with the same name as a derived type | |||
4076 | SayAlreadyDeclared(name, *details->derivedType()); | |||
4077 | } else { | |||
4078 | details->set_specific(Resolve(name, *specific)); | |||
4079 | } | |||
4080 | } else if (isGeneric()) { | |||
4081 | SayAlreadyDeclared(name, *specific); | |||
4082 | } | |||
4083 | if (specific->has<SubprogramNameDetails>()) { | |||
4084 | specific->set_details(Details{SubprogramDetails{}}); | |||
4085 | } | |||
4086 | return specific; | |||
4087 | } | |||
4088 | } | |||
4089 | return nullptr; | |||
4090 | } | |||
4091 | ||||
4092 | // DeclarationVisitor implementation | |||
4093 | ||||
4094 | bool DeclarationVisitor::BeginDecl() { | |||
4095 | BeginDeclTypeSpec(); | |||
4096 | BeginArraySpec(); | |||
4097 | return BeginAttrs(); | |||
4098 | } | |||
4099 | void DeclarationVisitor::EndDecl() { | |||
4100 | EndDeclTypeSpec(); | |||
4101 | EndArraySpec(); | |||
4102 | EndAttrs(); | |||
4103 | } | |||
4104 | ||||
4105 | bool DeclarationVisitor::CheckUseError(const parser::Name &name) { | |||
4106 | const auto *details{ | |||
4107 | name.symbol ? name.symbol->detailsIf<UseErrorDetails>() : nullptr}; | |||
4108 | if (!details) { | |||
4109 | return false; | |||
4110 | } | |||
4111 | Message &msg{Say(name, "Reference to '%s' is ambiguous"_err_en_US)}; | |||
4112 | for (const auto &[location, module] : details->occurrences()) { | |||
4113 | msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, | |||
4114 | name.source, module->GetName().value()); | |||
4115 | } | |||
4116 | context().SetError(*name.symbol); | |||
4117 | return true; | |||
4118 | } | |||
4119 | ||||
4120 | // Report error if accessibility of symbol doesn't match isPrivate. | |||
4121 | void DeclarationVisitor::CheckAccessibility( | |||
4122 | const SourceName &name, bool isPrivate, Symbol &symbol) { | |||
4123 | if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) { | |||
4124 | Say2(name, | |||
4125 | "'%s' does not have the same accessibility as its previous declaration"_err_en_US, | |||
4126 | symbol, "Previous declaration of '%s'"_en_US); | |||
4127 | } | |||
4128 | } | |||
4129 | ||||
4130 | void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) { | |||
4131 | EndDecl(); | |||
4132 | } | |||
4133 | ||||
4134 | void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) { | |||
4135 | DeclareObjectEntity(std::get<parser::Name>(x.t)); | |||
4136 | } | |||
4137 | void DeclarationVisitor::Post(const parser::CodimensionDecl &x) { | |||
4138 | DeclareObjectEntity(std::get<parser::Name>(x.t)); | |||
4139 | } | |||
4140 | ||||
4141 | bool DeclarationVisitor::Pre(const parser::Initialization &) { | |||
4142 | // Defer inspection of initializers to Initialization() so that the | |||
4143 | // symbol being initialized will be available within the initialization | |||
4144 | // expression. | |||
4145 | return false; | |||
4146 | } | |||
4147 | ||||
4148 | void DeclarationVisitor::Post(const parser::EntityDecl &x) { | |||
4149 | const auto &name{std::get<parser::ObjectName>(x.t)}; | |||
4150 | Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}}; | |||
4151 | Symbol &symbol{DeclareUnknownEntity(name, attrs)}; | |||
4152 | symbol.ReplaceName(name.source); | |||
4153 | if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { | |||
4154 | ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol); | |||
4155 | symbol.set( | |||
4156 | Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors | |||
4157 | Initialization(name, *init, false); | |||
4158 | } else if (attrs.test(Attr::PARAMETER)) { // C882, C883 | |||
4159 | Say(name, "Missing initialization for parameter '%s'"_err_en_US); | |||
4160 | } | |||
4161 | } | |||
4162 | ||||
4163 | void DeclarationVisitor::Post(const parser::PointerDecl &x) { | |||
4164 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4165 | if (const auto &deferredShapeSpecs{ | |||
4166 | std::get<std::optional<parser::DeferredShapeSpecList>>(x.t)}) { | |||
4167 | CHECK(arraySpec().empty())((arraySpec().empty()) || (Fortran::common::die("CHECK(" "arraySpec().empty()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4167), false)); | |||
4168 | BeginArraySpec(); | |||
4169 | set_arraySpec(AnalyzeDeferredShapeSpecList(context(), *deferredShapeSpecs)); | |||
4170 | Symbol &symbol{DeclareObjectEntity(name, Attrs{Attr::POINTER})}; | |||
4171 | symbol.ReplaceName(name.source); | |||
4172 | EndArraySpec(); | |||
4173 | } else { | |||
4174 | if (const auto *symbol{FindInScope(name)}) { | |||
4175 | const auto *subp{symbol->detailsIf<SubprogramDetails>()}; | |||
4176 | if (!symbol->has<UseDetails>() && // error caught elsewhere | |||
4177 | !symbol->has<ObjectEntityDetails>() && | |||
4178 | !symbol->has<ProcEntityDetails>() && | |||
4179 | !symbol->CanReplaceDetails(ObjectEntityDetails{}) && | |||
4180 | !symbol->CanReplaceDetails(ProcEntityDetails{}) && | |||
4181 | !(subp && subp->isInterface())) { | |||
4182 | Say(name, "'%s' cannot have the POINTER attribute"_err_en_US); | |||
4183 | } | |||
4184 | } | |||
4185 | HandleAttributeStmt(Attr::POINTER, std::get<parser::Name>(x.t)); | |||
4186 | } | |||
4187 | } | |||
4188 | ||||
4189 | bool DeclarationVisitor::Pre(const parser::BindEntity &x) { | |||
4190 | auto kind{std::get<parser::BindEntity::Kind>(x.t)}; | |||
4191 | auto &name{std::get<parser::Name>(x.t)}; | |||
4192 | Symbol *symbol; | |||
4193 | if (kind == parser::BindEntity::Kind::Object) { | |||
4194 | symbol = &HandleAttributeStmt(Attr::BIND_C, name); | |||
4195 | } else { | |||
4196 | symbol = &MakeCommonBlockSymbol(name); | |||
4197 | SetExplicitAttr(*symbol, Attr::BIND_C); | |||
4198 | } | |||
4199 | // 8.6.4(1) | |||
4200 | // Some entities such as named constant or module name need to checked | |||
4201 | // elsewhere. This is to skip the ICE caused by setting Bind name for non-name | |||
4202 | // things such as data type and also checks for procedures. | |||
4203 | if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() || | |||
4204 | symbol->has<EntityDetails>()) { | |||
4205 | SetBindNameOn(*symbol); | |||
4206 | } else { | |||
4207 | Say(name, | |||
4208 | "Only variable and named common block can be in BIND statement"_err_en_US); | |||
4209 | } | |||
4210 | return false; | |||
4211 | } | |||
4212 | bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) { | |||
4213 | inOldStyleParameterStmt_ = true; | |||
4214 | Walk(x.v); | |||
4215 | inOldStyleParameterStmt_ = false; | |||
4216 | return false; | |||
4217 | } | |||
4218 | bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { | |||
4219 | auto &name{std::get<parser::NamedConstant>(x.t).v}; | |||
4220 | auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)}; | |||
4221 | if (!ConvertToObjectEntity(symbol) || | |||
4222 | symbol.test(Symbol::Flag::CrayPointer) || | |||
4223 | symbol.test(Symbol::Flag::CrayPointee)) { | |||
4224 | SayWithDecl( | |||
4225 | name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US); | |||
4226 | return false; | |||
4227 | } | |||
4228 | const auto &expr{std::get<parser::ConstantExpr>(x.t)}; | |||
4229 | auto &details{symbol.get<ObjectEntityDetails>()}; | |||
4230 | if (inOldStyleParameterStmt_) { | |||
4231 | // non-standard extension PARAMETER statement (no parentheses) | |||
4232 | Walk(expr); | |||
4233 | auto folded{EvaluateExpr(expr)}; | |||
4234 | if (details.type()) { | |||
4235 | SayWithDecl(name, symbol, | |||
4236 | "Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US); | |||
4237 | } else if (folded) { | |||
4238 | auto at{expr.thing.value().source}; | |||
4239 | if (evaluate::IsActuallyConstant(*folded)) { | |||
4240 | if (const auto *type{currScope().GetType(*folded)}) { | |||
4241 | if (type->IsPolymorphic()) { | |||
4242 | Say(at, "The expression must not be polymorphic"_err_en_US); | |||
4243 | } else if (auto shape{ToArraySpec( | |||
4244 | GetFoldingContext(), evaluate::GetShape(*folded))}) { | |||
4245 | // The type of the named constant is assumed from the expression. | |||
4246 | details.set_type(*type); | |||
4247 | details.set_init(std::move(*folded)); | |||
4248 | details.set_shape(std::move(*shape)); | |||
4249 | } else { | |||
4250 | Say(at, "The expression must have constant shape"_err_en_US); | |||
4251 | } | |||
4252 | } else { | |||
4253 | Say(at, "The expression must have a known type"_err_en_US); | |||
4254 | } | |||
4255 | } else { | |||
4256 | Say(at, "The expression must be a constant of known type"_err_en_US); | |||
4257 | } | |||
4258 | } | |||
4259 | } else { | |||
4260 | // standard-conforming PARAMETER statement (with parentheses) | |||
4261 | ApplyImplicitRules(symbol); | |||
4262 | Walk(expr); | |||
4263 | if (auto converted{EvaluateNonPointerInitializer( | |||
4264 | symbol, expr, expr.thing.value().source)}) { | |||
4265 | details.set_init(std::move(*converted)); | |||
4266 | } | |||
4267 | } | |||
4268 | return false; | |||
4269 | } | |||
4270 | bool DeclarationVisitor::Pre(const parser::NamedConstant &x) { | |||
4271 | const parser::Name &name{x.v}; | |||
4272 | if (!FindSymbol(name)) { | |||
4273 | Say(name, "Named constant '%s' not found"_err_en_US); | |||
4274 | } else { | |||
4275 | CheckUseError(name); | |||
4276 | } | |||
4277 | return false; | |||
4278 | } | |||
4279 | ||||
4280 | bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) { | |||
4281 | const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v}; | |||
4282 | Symbol *symbol{FindInScope(name)}; | |||
4283 | if (symbol && !symbol->has<UnknownDetails>()) { | |||
4284 | // Contrary to named constants appearing in a PARAMETER statement, | |||
4285 | // enumerator names should not have their type, dimension or any other | |||
4286 | // attributes defined before they are declared in the enumerator statement, | |||
4287 | // with the exception of accessibility. | |||
4288 | // This is not explicitly forbidden by the standard, but they are scalars | |||
4289 | // which type is left for the compiler to chose, so do not let users try to | |||
4290 | // tamper with that. | |||
4291 | SayAlreadyDeclared(name, *symbol); | |||
4292 | symbol = nullptr; | |||
4293 | } else { | |||
4294 | // Enumerators are treated as PARAMETER (section 7.6 paragraph (4)) | |||
4295 | symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{}); | |||
4296 | symbol->SetType(context().MakeNumericType( | |||
4297 | TypeCategory::Integer, evaluate::CInteger::kind)); | |||
4298 | } | |||
4299 | ||||
4300 | if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>( | |||
4301 | enumerator.t)}) { | |||
4302 | Walk(*init); // Resolve names in expression before evaluation. | |||
4303 | if (auto value{EvaluateInt64(context(), *init)}) { | |||
4304 | // Cast all init expressions to C_INT so that they can then be | |||
4305 | // safely incremented (see 7.6 Note 2). | |||
4306 | enumerationState_.value = static_cast<int>(*value); | |||
4307 | } else { | |||
4308 | Say(name, | |||
4309 | "Enumerator value could not be computed " | |||
4310 | "from the given expression"_err_en_US); | |||
4311 | // Prevent resolution of next enumerators value | |||
4312 | enumerationState_.value = std::nullopt; | |||
4313 | } | |||
4314 | } | |||
4315 | ||||
4316 | if (symbol) { | |||
4317 | if (enumerationState_.value) { | |||
4318 | symbol->get<ObjectEntityDetails>().set_init(SomeExpr{ | |||
4319 | evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}}); | |||
4320 | } else { | |||
4321 | context().SetError(*symbol); | |||
4322 | } | |||
4323 | } | |||
4324 | ||||
4325 | if (enumerationState_.value) { | |||
4326 | (*enumerationState_.value)++; | |||
4327 | } | |||
4328 | return false; | |||
4329 | } | |||
4330 | ||||
4331 | void DeclarationVisitor::Post(const parser::EnumDef &) { | |||
4332 | enumerationState_ = EnumeratorState{}; | |||
4333 | } | |||
4334 | ||||
4335 | bool DeclarationVisitor::Pre(const parser::AccessSpec &x) { | |||
4336 | Attr attr{AccessSpecToAttr(x)}; | |||
4337 | if (!NonDerivedTypeScope().IsModule()) { // C817 | |||
4338 | Say(currStmtSource().value(), | |||
4339 | "%s attribute may only appear in the specification part of a module"_err_en_US, | |||
4340 | EnumToString(attr)); | |||
4341 | } | |||
4342 | CheckAndSet(attr); | |||
4343 | return false; | |||
4344 | } | |||
4345 | ||||
4346 | bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) { | |||
4347 | return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v); | |||
4348 | } | |||
4349 | bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) { | |||
4350 | return HandleAttributeStmt(Attr::CONTIGUOUS, x.v); | |||
4351 | } | |||
4352 | bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) { | |||
4353 | HandleAttributeStmt(Attr::EXTERNAL, x.v); | |||
4354 | for (const auto &name : x.v) { | |||
4355 | auto *symbol{FindSymbol(name)}; | |||
4356 | if (!ConvertToProcEntity(DEREF(symbol)Fortran::common::Deref(symbol, "flang/lib/Semantics/resolve-names.cpp" , 4356))) { | |||
4357 | // Check if previous symbol is an interface. | |||
4358 | if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { | |||
4359 | if (details->isInterface()) { | |||
4360 | // Warn if interface previously declared. | |||
4361 | Say(name, | |||
4362 | "EXTERNAL attribute was already specified on '%s'"_warn_en_US); | |||
4363 | } | |||
4364 | } else { | |||
4365 | SayWithDecl( | |||
4366 | name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US); | |||
4367 | } | |||
4368 | } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840 | |||
4369 | Say(symbol->name(), | |||
4370 | "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US, | |||
4371 | symbol->name()); | |||
4372 | } | |||
4373 | } | |||
4374 | return false; | |||
4375 | } | |||
4376 | bool DeclarationVisitor::Pre(const parser::IntentStmt &x) { | |||
4377 | auto &intentSpec{std::get<parser::IntentSpec>(x.t)}; | |||
4378 | auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
4379 | return CheckNotInBlock("INTENT") && // C1107 | |||
4380 | HandleAttributeStmt(IntentSpecToAttr(intentSpec), names); | |||
4381 | } | |||
4382 | bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) { | |||
4383 | HandleAttributeStmt(Attr::INTRINSIC, x.v); | |||
4384 | for (const auto &name : x.v) { | |||
4385 | if (!IsIntrinsic(name.source, std::nullopt)) { | |||
4386 | Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US); | |||
4387 | } | |||
4388 | auto &symbol{DEREF(FindSymbol(name))Fortran::common::Deref(FindSymbol(name), "flang/lib/Semantics/resolve-names.cpp" , 4388)}; | |||
4389 | if (symbol.has<GenericDetails>()) { | |||
4390 | // Generic interface is extending intrinsic; ok | |||
4391 | } else if (!ConvertToProcEntity(symbol)) { | |||
4392 | SayWithDecl( | |||
4393 | name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US); | |||
4394 | } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840 | |||
4395 | Say(symbol.name(), | |||
4396 | "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, | |||
4397 | symbol.name()); | |||
4398 | } else if (symbol.GetType()) { | |||
4399 | // These warnings are worded so that they should make sense in either | |||
4400 | // order. | |||
4401 | Say(symbol.name(), | |||
4402 | "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US, | |||
4403 | symbol.name()) | |||
4404 | .Attach(name.source, | |||
4405 | "INTRINSIC statement for explicitly-typed '%s'"_en_US, | |||
4406 | name.source); | |||
4407 | } | |||
4408 | } | |||
4409 | return false; | |||
4410 | } | |||
4411 | bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) { | |||
4412 | return CheckNotInBlock("OPTIONAL") && // C1107 | |||
4413 | HandleAttributeStmt(Attr::OPTIONAL, x.v); | |||
4414 | } | |||
4415 | bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) { | |||
4416 | return HandleAttributeStmt(Attr::PROTECTED, x.v); | |||
4417 | } | |||
4418 | bool DeclarationVisitor::Pre(const parser::ValueStmt &x) { | |||
4419 | return CheckNotInBlock("VALUE") && // C1107 | |||
4420 | HandleAttributeStmt(Attr::VALUE, x.v); | |||
4421 | } | |||
4422 | bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) { | |||
4423 | return HandleAttributeStmt(Attr::VOLATILE, x.v); | |||
4424 | } | |||
4425 | // Handle a statement that sets an attribute on a list of names. | |||
4426 | bool DeclarationVisitor::HandleAttributeStmt( | |||
4427 | Attr attr, const std::list<parser::Name> &names) { | |||
4428 | for (const auto &name : names) { | |||
4429 | HandleAttributeStmt(attr, name); | |||
4430 | } | |||
4431 | return false; | |||
4432 | } | |||
4433 | Symbol &DeclarationVisitor::HandleAttributeStmt( | |||
4434 | Attr attr, const parser::Name &name) { | |||
4435 | auto *symbol{FindInScope(name)}; | |||
4436 | if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) { | |||
4437 | // these can be set on a symbol that is host-assoc or use-assoc | |||
4438 | if (!symbol && | |||
4439 | (currScope().kind() == Scope::Kind::Subprogram || | |||
4440 | currScope().kind() == Scope::Kind::BlockConstruct)) { | |||
4441 | if (auto *hostSymbol{FindSymbol(name)}) { | |||
4442 | symbol = &MakeHostAssocSymbol(name, *hostSymbol); | |||
4443 | } | |||
4444 | } | |||
4445 | } else if (symbol && symbol->has<UseDetails>()) { | |||
4446 | Say(currStmtSource().value(), | |||
4447 | "Cannot change %s attribute on use-associated '%s'"_err_en_US, | |||
4448 | EnumToString(attr), name.source); | |||
4449 | return *symbol; | |||
4450 | } | |||
4451 | if (!symbol) { | |||
4452 | symbol = &MakeSymbol(name, EntityDetails{}); | |||
4453 | } | |||
4454 | if (CheckDuplicatedAttr(name.source, *symbol, attr)) { | |||
4455 | SetExplicitAttr(*symbol, attr); | |||
4456 | symbol->attrs() = HandleSaveName(name.source, symbol->attrs()); | |||
4457 | } | |||
4458 | return *symbol; | |||
4459 | } | |||
4460 | // C1107 | |||
4461 | bool DeclarationVisitor::CheckNotInBlock(const char *stmt) { | |||
4462 | if (currScope().kind() == Scope::Kind::BlockConstruct) { | |||
4463 | Say(MessageFormattedText{ | |||
4464 | "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt}); | |||
4465 | return false; | |||
4466 | } else { | |||
4467 | return true; | |||
4468 | } | |||
4469 | } | |||
4470 | ||||
4471 | void DeclarationVisitor::Post(const parser::ObjectDecl &x) { | |||
4472 | CHECK(objectDeclAttr_)((objectDeclAttr_) || (Fortran::common::die("CHECK(" "objectDeclAttr_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4472), false)); | |||
4473 | const auto &name{std::get<parser::ObjectName>(x.t)}; | |||
4474 | DeclareObjectEntity(name, Attrs{*objectDeclAttr_}); | |||
4475 | } | |||
4476 | ||||
4477 | // Declare an entity not yet known to be an object or proc. | |||
4478 | Symbol &DeclarationVisitor::DeclareUnknownEntity( | |||
4479 | const parser::Name &name, Attrs attrs) { | |||
4480 | if (!arraySpec().empty() || !coarraySpec().empty()) { | |||
4481 | return DeclareObjectEntity(name, attrs); | |||
4482 | } else { | |||
4483 | Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)}; | |||
4484 | if (auto *type{GetDeclTypeSpec()}) { | |||
4485 | SetType(name, *type); | |||
4486 | } | |||
4487 | charInfo_.length.reset(); | |||
4488 | if (symbol.attrs().test(Attr::EXTERNAL)) { | |||
4489 | ConvertToProcEntity(symbol); | |||
4490 | } | |||
4491 | SetBindNameOn(symbol); | |||
4492 | return symbol; | |||
4493 | } | |||
4494 | } | |||
4495 | ||||
4496 | bool DeclarationVisitor::HasCycle( | |||
4497 | const Symbol &procSymbol, const Symbol *interface) { | |||
4498 | SourceOrderedSymbolSet procsInCycle; | |||
4499 | procsInCycle.insert(procSymbol); | |||
4500 | while (interface) { | |||
4501 | if (procsInCycle.count(*interface) > 0) { | |||
4502 | for (const auto &procInCycle : procsInCycle) { | |||
4503 | Say(procInCycle->name(), | |||
4504 | "The interface for procedure '%s' is recursively " | |||
4505 | "defined"_err_en_US, | |||
4506 | procInCycle->name()); | |||
4507 | context().SetError(*procInCycle); | |||
4508 | } | |||
4509 | return true; | |||
4510 | } else if (const auto *procDetails{ | |||
4511 | interface->detailsIf<ProcEntityDetails>()}) { | |||
4512 | procsInCycle.insert(*interface); | |||
4513 | interface = procDetails->procInterface(); | |||
4514 | } else { | |||
4515 | break; | |||
4516 | } | |||
4517 | } | |||
4518 | return false; | |||
4519 | } | |||
4520 | ||||
4521 | Symbol &DeclarationVisitor::DeclareProcEntity( | |||
4522 | const parser::Name &name, Attrs attrs, const Symbol *interface) { | |||
4523 | Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)}; | |||
4524 | if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) { | |||
4525 | if (details->IsInterfaceSet()) { | |||
4526 | SayWithDecl(name, symbol, | |||
4527 | "The interface for procedure '%s' has already been " | |||
4528 | "declared"_err_en_US); | |||
4529 | context().SetError(symbol); | |||
4530 | } else if (HasCycle(symbol, interface)) { | |||
4531 | return symbol; | |||
4532 | } else if (interface) { | |||
4533 | details->set_procInterface(*interface); | |||
4534 | if (interface->test(Symbol::Flag::Function)) { | |||
4535 | symbol.set(Symbol::Flag::Function); | |||
4536 | } else if (interface->test(Symbol::Flag::Subroutine)) { | |||
4537 | symbol.set(Symbol::Flag::Subroutine); | |||
4538 | } | |||
4539 | } else if (auto *type{GetDeclTypeSpec()}) { | |||
4540 | SetType(name, *type); | |||
4541 | symbol.set(Symbol::Flag::Function); | |||
4542 | } | |||
4543 | SetBindNameOn(symbol); | |||
4544 | SetPassNameOn(symbol); | |||
4545 | } | |||
4546 | return symbol; | |||
4547 | } | |||
4548 | ||||
4549 | Symbol &DeclarationVisitor::DeclareObjectEntity( | |||
4550 | const parser::Name &name, Attrs attrs) { | |||
4551 | Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)}; | |||
4552 | if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { | |||
4553 | if (auto *type{GetDeclTypeSpec()}) { | |||
4554 | SetType(name, *type); | |||
4555 | } | |||
4556 | if (!arraySpec().empty()) { | |||
4557 | if (details->IsArray()) { | |||
4558 | if (!context().HasError(symbol)) { | |||
4559 | Say(name, | |||
4560 | "The dimensions of '%s' have already been declared"_err_en_US); | |||
4561 | context().SetError(symbol); | |||
4562 | } | |||
4563 | } else { | |||
4564 | details->set_shape(arraySpec()); | |||
4565 | } | |||
4566 | } | |||
4567 | if (!coarraySpec().empty()) { | |||
4568 | if (details->IsCoarray()) { | |||
4569 | if (!context().HasError(symbol)) { | |||
4570 | Say(name, | |||
4571 | "The codimensions of '%s' have already been declared"_err_en_US); | |||
4572 | context().SetError(symbol); | |||
4573 | } | |||
4574 | } else { | |||
4575 | details->set_coshape(coarraySpec()); | |||
4576 | } | |||
4577 | } | |||
4578 | SetBindNameOn(symbol); | |||
4579 | } | |||
4580 | ClearArraySpec(); | |||
4581 | ClearCoarraySpec(); | |||
4582 | charInfo_.length.reset(); | |||
4583 | return symbol; | |||
4584 | } | |||
4585 | ||||
4586 | void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { | |||
4587 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); | |||
4588 | } | |||
4589 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) { | |||
4590 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); | |||
4591 | } | |||
4592 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) { | |||
4593 | SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind)); | |||
4594 | } | |||
4595 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) { | |||
4596 | SetDeclTypeSpec(MakeLogicalType(x.kind)); | |||
4597 | } | |||
4598 | void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) { | |||
4599 | if (!charInfo_.length) { | |||
4600 | charInfo_.length = ParamValue{1, common::TypeParamAttr::Len}; | |||
4601 | } | |||
4602 | if (!charInfo_.kind) { | |||
4603 | charInfo_.kind = | |||
4604 | KindExpr{context().GetDefaultKind(TypeCategory::Character)}; | |||
4605 | } | |||
4606 | SetDeclTypeSpec(currScope().MakeCharacterType( | |||
4607 | std::move(*charInfo_.length), std::move(*charInfo_.kind))); | |||
4608 | charInfo_ = {}; | |||
4609 | } | |||
4610 | void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) { | |||
4611 | charInfo_.kind = EvaluateSubscriptIntExpr(x.kind); | |||
4612 | std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)}; | |||
4613 | if (intKind && | |||
4614 | !context().targetCharacteristics().IsTypeEnabled( | |||
4615 | TypeCategory::Character, *intKind)) { // C715, C719 | |||
4616 | Say(currStmtSource().value(), | |||
4617 | "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind); | |||
4618 | charInfo_.kind = std::nullopt; // prevent further errors | |||
4619 | } | |||
4620 | if (x.length) { | |||
4621 | charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len); | |||
4622 | } | |||
4623 | } | |||
4624 | void DeclarationVisitor::Post(const parser::CharLength &x) { | |||
4625 | if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) { | |||
4626 | charInfo_.length = ParamValue{ | |||
4627 | static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len}; | |||
4628 | } else { | |||
4629 | charInfo_.length = GetParamValue( | |||
4630 | std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len); | |||
4631 | } | |||
4632 | } | |||
4633 | void DeclarationVisitor::Post(const parser::LengthSelector &x) { | |||
4634 | if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) { | |||
4635 | charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len); | |||
4636 | } | |||
4637 | } | |||
4638 | ||||
4639 | bool DeclarationVisitor::Pre(const parser::KindParam &x) { | |||
4640 | if (const auto *kind{std::get_if< | |||
4641 | parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>( | |||
4642 | &x.u)}) { | |||
4643 | const parser::Name &name{kind->thing.thing.thing}; | |||
4644 | if (!FindSymbol(name)) { | |||
4645 | Say(name, "Parameter '%s' not found"_err_en_US); | |||
4646 | } | |||
4647 | } | |||
4648 | return false; | |||
4649 | } | |||
4650 | ||||
4651 | bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) { | |||
4652 | CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived)((GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived ) || (Fortran::common::die("CHECK(" "GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4652), false)); | |||
4653 | return true; | |||
4654 | } | |||
4655 | ||||
4656 | void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) { | |||
4657 | const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)}; | |||
4658 | if (const Symbol * derivedSymbol{derivedName.symbol}) { | |||
4659 | CheckForAbstractType(*derivedSymbol); // C706 | |||
4660 | } | |||
4661 | } | |||
4662 | ||||
4663 | bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) { | |||
4664 | SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); | |||
4665 | return true; | |||
4666 | } | |||
4667 | ||||
4668 | void DeclarationVisitor::Post( | |||
4669 | const parser::DeclarationTypeSpec::Class &parsedClass) { | |||
4670 | const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)}; | |||
4671 | if (auto spec{ResolveDerivedType(typeName)}; | |||
4672 | spec && !IsExtensibleType(&*spec)) { // C705 | |||
4673 | SayWithDecl(typeName, *typeName.symbol, | |||
4674 | "Non-extensible derived type '%s' may not be used with CLASS" | |||
4675 | " keyword"_err_en_US); | |||
4676 | } | |||
4677 | } | |||
4678 | ||||
4679 | void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { | |||
4680 | const auto &typeName{std::get<parser::Name>(x.t)}; | |||
4681 | auto spec{ResolveDerivedType(typeName)}; | |||
4682 | if (!spec) { | |||
4683 | return; | |||
4684 | } | |||
4685 | bool seenAnyName{false}; | |||
4686 | for (const auto &typeParamSpec : | |||
4687 | std::get<std::list<parser::TypeParamSpec>>(x.t)) { | |||
4688 | const auto &optKeyword{ | |||
4689 | std::get<std::optional<parser::Keyword>>(typeParamSpec.t)}; | |||
4690 | std::optional<SourceName> name; | |||
4691 | if (optKeyword) { | |||
4692 | seenAnyName = true; | |||
4693 | name = optKeyword->v.source; | |||
4694 | } else if (seenAnyName) { | |||
4695 | Say(typeName.source, "Type parameter value must have a name"_err_en_US); | |||
4696 | continue; | |||
4697 | } | |||
4698 | const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)}; | |||
4699 | // The expressions in a derived type specifier whose values define | |||
4700 | // non-defaulted type parameters are evaluated (folded) in the enclosing | |||
4701 | // scope. The KIND/LEN distinction is resolved later in | |||
4702 | // DerivedTypeSpec::CookParameters(). | |||
4703 | ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)}; | |||
4704 | if (!param.isExplicit() || param.GetExplicit()) { | |||
4705 | spec->AddRawParamValue( | |||
4706 | common::GetPtrFromOptional(optKeyword), std::move(param)); | |||
4707 | } | |||
4708 | } | |||
4709 | // The DerivedTypeSpec *spec is used initially as a search key. | |||
4710 | // If it turns out to have the same name and actual parameter | |||
4711 | // value expressions as another DerivedTypeSpec in the current | |||
4712 | // scope does, then we'll use that extant spec; otherwise, when this | |||
4713 | // spec is distinct from all derived types previously instantiated | |||
4714 | // in the current scope, this spec will be moved into that collection. | |||
4715 | const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()}; | |||
4716 | auto category{GetDeclTypeSpecCategory()}; | |||
4717 | if (dtDetails.isForwardReferenced()) { | |||
4718 | DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; | |||
4719 | SetDeclTypeSpec(type); | |||
4720 | return; | |||
4721 | } | |||
4722 | // Normalize parameters to produce a better search key. | |||
4723 | spec->CookParameters(GetFoldingContext()); | |||
4724 | if (!spec->MightBeParameterized()) { | |||
4725 | spec->EvaluateParameters(context()); | |||
4726 | } | |||
4727 | if (const DeclTypeSpec * | |||
4728 | extant{currScope().FindInstantiatedDerivedType(*spec, category)}) { | |||
4729 | // This derived type and parameter expressions (if any) are already present | |||
4730 | // in this scope. | |||
4731 | SetDeclTypeSpec(*extant); | |||
4732 | } else { | |||
4733 | DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; | |||
4734 | DerivedTypeSpec &derived{type.derivedTypeSpec()}; | |||
4735 | if (derived.MightBeParameterized() && | |||
4736 | currScope().IsParameterizedDerivedType()) { | |||
4737 | // Defer instantiation; use the derived type's definition's scope. | |||
4738 | derived.set_scope(DEREF(spec->typeSymbol().scope())Fortran::common::Deref(spec->typeSymbol().scope(), "flang/lib/Semantics/resolve-names.cpp" , 4738)); | |||
4739 | } else if (&currScope() == spec->typeSymbol().scope()) { | |||
4740 | // Direct recursive use of a type in the definition of one of its | |||
4741 | // components: defer instantiation | |||
4742 | } else { | |||
4743 | auto restorer{ | |||
4744 | GetFoldingContext().messages().SetLocation(currStmtSource().value())}; | |||
4745 | derived.Instantiate(currScope()); | |||
4746 | } | |||
4747 | SetDeclTypeSpec(type); | |||
4748 | } | |||
4749 | // Capture the DerivedTypeSpec in the parse tree for use in building | |||
4750 | // structure constructor expressions. | |||
4751 | x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec(); | |||
4752 | } | |||
4753 | ||||
4754 | void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) { | |||
4755 | const auto &typeName{rec.v}; | |||
4756 | if (auto spec{ResolveDerivedType(typeName)}) { | |||
4757 | spec->CookParameters(GetFoldingContext()); | |||
4758 | spec->EvaluateParameters(context()); | |||
4759 | if (const DeclTypeSpec * | |||
4760 | extant{currScope().FindInstantiatedDerivedType( | |||
4761 | *spec, DeclTypeSpec::TypeDerived)}) { | |||
4762 | SetDeclTypeSpec(*extant); | |||
4763 | } else { | |||
4764 | Say(typeName.source, "%s is not a known STRUCTURE"_err_en_US, | |||
4765 | typeName.source); | |||
4766 | } | |||
4767 | } | |||
4768 | } | |||
4769 | ||||
4770 | // The descendents of DerivedTypeDef in the parse tree are visited directly | |||
4771 | // in this Pre() routine so that recursive use of the derived type can be | |||
4772 | // supported in the components. | |||
4773 | bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { | |||
4774 | auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)}; | |||
4775 | Walk(stmt); | |||
4776 | Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t)); | |||
4777 | auto &scope{currScope()}; | |||
4778 | CHECK(scope.symbol())((scope.symbol()) || (Fortran::common::die("CHECK(" "scope.symbol()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4778), false)); | |||
4779 | CHECK(scope.symbol()->scope() == &scope)((scope.symbol()->scope() == &scope) || (Fortran::common ::die("CHECK(" "scope.symbol()->scope() == &scope" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 4779) , false)); | |||
4780 | auto &details{scope.symbol()->get<DerivedTypeDetails>()}; | |||
4781 | details.set_isForwardReferenced(false); | |||
4782 | std::set<SourceName> paramNames; | |||
4783 | for (auto ¶mName : std::get<std::list<parser::Name>>(stmt.statement.t)) { | |||
4784 | details.add_paramName(paramName.source); | |||
4785 | auto *symbol{FindInScope(scope, paramName)}; | |||
4786 | if (!symbol) { | |||
4787 | Say(paramName, | |||
4788 | "No definition found for type parameter '%s'"_err_en_US); // C742 | |||
4789 | // No symbol for a type param. Create one and mark it as containing an | |||
4790 | // error to improve subsequent semantic processing | |||
4791 | BeginAttrs(); | |||
4792 | Symbol *typeParam{MakeTypeSymbol( | |||
4793 | paramName, TypeParamDetails{common::TypeParamAttr::Len})}; | |||
4794 | context().SetError(*typeParam); | |||
4795 | EndAttrs(); | |||
4796 | } else if (!symbol->has<TypeParamDetails>()) { | |||
4797 | Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US, | |||
4798 | *symbol, "Definition of '%s'"_en_US); // C741 | |||
4799 | } | |||
4800 | if (!paramNames.insert(paramName.source).second) { | |||
4801 | Say(paramName, | |||
4802 | "Duplicate type parameter name: '%s'"_err_en_US); // C731 | |||
4803 | } | |||
4804 | } | |||
4805 | for (const auto &[name, symbol] : currScope()) { | |||
4806 | if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) { | |||
4807 | SayDerivedType(name, | |||
4808 | "'%s' is not a type parameter of this derived type"_err_en_US, | |||
4809 | currScope()); // C741 | |||
4810 | } | |||
4811 | } | |||
4812 | Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t)); | |||
4813 | const auto &componentDefs{ | |||
4814 | std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)}; | |||
4815 | Walk(componentDefs); | |||
4816 | if (derivedTypeInfo_.sequence) { | |||
4817 | details.set_sequence(true); | |||
4818 | if (componentDefs.empty()) { // C740 | |||
4819 | Say(stmt.source, | |||
4820 | "A sequence type must have at least one component"_err_en_US); | |||
4821 | } | |||
4822 | if (!details.paramNames().empty()) { // C740 | |||
4823 | Say(stmt.source, | |||
4824 | "A sequence type may not have type parameters"_err_en_US); | |||
4825 | } | |||
4826 | if (derivedTypeInfo_.extends) { // C735 | |||
4827 | Say(stmt.source, | |||
4828 | "A sequence type may not have the EXTENDS attribute"_err_en_US); | |||
4829 | } | |||
4830 | } | |||
4831 | Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t)); | |||
4832 | Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t)); | |||
4833 | derivedTypeInfo_ = {}; | |||
4834 | PopScope(); | |||
4835 | return false; | |||
4836 | } | |||
4837 | ||||
4838 | bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) { | |||
4839 | return BeginAttrs(); | |||
4840 | } | |||
4841 | void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { | |||
4842 | auto &name{std::get<parser::Name>(x.t)}; | |||
4843 | // Resolve the EXTENDS() clause before creating the derived | |||
4844 | // type's symbol to foil attempts to recursively extend a type. | |||
4845 | auto *extendsName{derivedTypeInfo_.extends}; | |||
4846 | std::optional<DerivedTypeSpec> extendsType{ | |||
4847 | ResolveExtendsType(name, extendsName)}; | |||
4848 | auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})}; | |||
4849 | symbol.ReplaceName(name.source); | |||
4850 | derivedTypeInfo_.type = &symbol; | |||
4851 | PushScope(Scope::Kind::DerivedType, &symbol); | |||
4852 | if (extendsType) { | |||
4853 | // Declare the "parent component"; private if the type is. | |||
4854 | // Any symbol stored in the EXTENDS() clause is temporarily | |||
4855 | // hidden so that a new symbol can be created for the parent | |||
4856 | // component without producing spurious errors about already | |||
4857 | // existing. | |||
4858 | const Symbol &extendsSymbol{extendsType->typeSymbol()}; | |||
4859 | auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; | |||
4860 | if (OkToAddComponent(*extendsName, &extendsSymbol)) { | |||
4861 | auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})}; | |||
4862 | comp.attrs().set( | |||
4863 | Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE)); | |||
4864 | comp.implicitAttrs().set( | |||
4865 | Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE)); | |||
4866 | comp.set(Symbol::Flag::ParentComp); | |||
4867 | DeclTypeSpec &type{currScope().MakeDerivedType( | |||
4868 | DeclTypeSpec::TypeDerived, std::move(*extendsType))}; | |||
4869 | type.derivedTypeSpec().set_scope(*extendsSymbol.scope()); | |||
4870 | comp.SetType(type); | |||
4871 | DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()}; | |||
4872 | details.add_component(comp); | |||
4873 | } | |||
4874 | } | |||
4875 | EndAttrs(); | |||
4876 | } | |||
4877 | ||||
4878 | void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) { | |||
4879 | auto *type{GetDeclTypeSpec()}; | |||
4880 | auto attr{std::get<common::TypeParamAttr>(x.t)}; | |||
4881 | for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) { | |||
4882 | auto &name{std::get<parser::Name>(decl.t)}; | |||
4883 | if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{attr})}) { | |||
4884 | SetType(name, *type); | |||
4885 | if (auto &init{ | |||
4886 | std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) { | |||
4887 | if (auto maybeExpr{EvaluateNonPointerInitializer( | |||
4888 | *symbol, *init, init->thing.thing.thing.value().source)}) { | |||
4889 | if (auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}) { | |||
4890 | symbol->get<TypeParamDetails>().set_init(std::move(*intExpr)); | |||
4891 | } | |||
4892 | } | |||
4893 | } | |||
4894 | } | |||
4895 | } | |||
4896 | EndDecl(); | |||
4897 | } | |||
4898 | bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) { | |||
4899 | if (derivedTypeInfo_.extends) { | |||
4900 | Say(currStmtSource().value(), | |||
4901 | "Attribute 'EXTENDS' cannot be used more than once"_err_en_US); | |||
4902 | } else { | |||
4903 | derivedTypeInfo_.extends = &x.v; | |||
4904 | } | |||
4905 | return false; | |||
4906 | } | |||
4907 | ||||
4908 | bool DeclarationVisitor::Pre(const parser::PrivateStmt &) { | |||
4909 | if (!currScope().parent().IsModule()) { | |||
4910 | Say("PRIVATE is only allowed in a derived type that is" | |||
4911 | " in a module"_err_en_US); // C766 | |||
4912 | } else if (derivedTypeInfo_.sawContains) { | |||
4913 | derivedTypeInfo_.privateBindings = true; | |||
4914 | } else if (!derivedTypeInfo_.privateComps) { | |||
4915 | derivedTypeInfo_.privateComps = true; | |||
4916 | } else { | |||
4917 | Say("PRIVATE may not appear more than once in" | |||
4918 | " derived type components"_warn_en_US); // C738 | |||
4919 | } | |||
4920 | return false; | |||
4921 | } | |||
4922 | bool DeclarationVisitor::Pre(const parser::SequenceStmt &) { | |||
4923 | if (derivedTypeInfo_.sequence) { | |||
4924 | Say("SEQUENCE may not appear more than once in" | |||
4925 | " derived type components"_warn_en_US); // C738 | |||
4926 | } | |||
4927 | derivedTypeInfo_.sequence = true; | |||
4928 | return false; | |||
4929 | } | |||
4930 | void DeclarationVisitor::Post(const parser::ComponentDecl &x) { | |||
4931 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4932 | auto attrs{GetAttrs()}; | |||
4933 | if (derivedTypeInfo_.privateComps && | |||
4934 | !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
4935 | attrs.set(Attr::PRIVATE); | |||
4936 | } | |||
4937 | if (const auto *declType{GetDeclTypeSpec()}) { | |||
4938 | if (const auto *derived{declType->AsDerived()}) { | |||
4939 | if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { | |||
4940 | if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 | |||
4941 | Say("Recursive use of the derived type requires " | |||
4942 | "POINTER or ALLOCATABLE"_err_en_US); | |||
4943 | } | |||
4944 | } | |||
4945 | // TODO: This would be more appropriate in CheckDerivedType() | |||
4946 | if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 | |||
4947 | std::string ultimateName{it.BuildResultDesignatorName()}; | |||
4948 | // Strip off the leading "%" | |||
4949 | if (ultimateName.length() > 1) { | |||
4950 | ultimateName.erase(0, 1); | |||
4951 | if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { | |||
4952 | evaluate::AttachDeclaration( | |||
4953 | Say(name.source, | |||
4954 | "A component with a POINTER or ALLOCATABLE attribute may " | |||
4955 | "not " | |||
4956 | "be of a type with a coarray ultimate component (named " | |||
4957 | "'%s')"_err_en_US, | |||
4958 | ultimateName), | |||
4959 | derived->typeSymbol()); | |||
4960 | } | |||
4961 | if (!arraySpec().empty() || !coarraySpec().empty()) { | |||
4962 | evaluate::AttachDeclaration( | |||
4963 | Say(name.source, | |||
4964 | "An array or coarray component may not be of a type with a " | |||
4965 | "coarray ultimate component (named '%s')"_err_en_US, | |||
4966 | ultimateName), | |||
4967 | derived->typeSymbol()); | |||
4968 | } | |||
4969 | } | |||
4970 | } | |||
4971 | } | |||
4972 | } | |||
4973 | if (OkToAddComponent(name)) { | |||
4974 | auto &symbol{DeclareObjectEntity(name, attrs)}; | |||
4975 | if (symbol.has<ObjectEntityDetails>()) { | |||
4976 | if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { | |||
4977 | Initialization(name, *init, true); | |||
4978 | } | |||
4979 | } | |||
4980 | currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); | |||
4981 | } | |||
4982 | ClearArraySpec(); | |||
4983 | ClearCoarraySpec(); | |||
4984 | } | |||
4985 | void DeclarationVisitor::Post(const parser::FillDecl &x) { | |||
4986 | // Replace "%FILL" with a distinct generated name | |||
4987 | const auto &name{std::get<parser::Name>(x.t)}; | |||
4988 | const_cast<SourceName &>(name.source) = context().GetTempName(currScope()); | |||
4989 | if (OkToAddComponent(name)) { | |||
4990 | auto &symbol{DeclareObjectEntity(name, GetAttrs())}; | |||
4991 | currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); | |||
4992 | } | |||
4993 | ClearArraySpec(); | |||
4994 | } | |||
4995 | bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) { | |||
4996 | CHECK(!interfaceName_)((!interfaceName_) || (Fortran::common::die("CHECK(" "!interfaceName_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 4996), false)); | |||
4997 | const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)}; | |||
4998 | for (const parser::ProcAttrSpec &procAttr : procAttrSpec) { | |||
4999 | if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) { | |||
5000 | if (bindC->v.has_value()) { | |||
5001 | hasBindCName_ = true; | |||
5002 | break; | |||
5003 | } | |||
5004 | } | |||
5005 | } | |||
5006 | return BeginDecl(); | |||
5007 | } | |||
5008 | void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) { | |||
5009 | interfaceName_ = nullptr; | |||
5010 | hasBindCName_ = false; | |||
5011 | EndDecl(); | |||
5012 | } | |||
5013 | bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) { | |||
5014 | // Overrides parse tree traversal so as to handle attributes first, | |||
5015 | // so POINTER & ALLOCATABLE enable forward references to derived types. | |||
5016 | Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t)); | |||
5017 | set_allowForwardReferenceToDerivedType( | |||
5018 | GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})); | |||
5019 | Walk(std::get<parser::DeclarationTypeSpec>(x.t)); | |||
5020 | set_allowForwardReferenceToDerivedType(false); | |||
5021 | if (derivedTypeInfo_.sequence) { // C740 | |||
5022 | if (const auto *declType{GetDeclTypeSpec()}) { | |||
5023 | if (!declType->AsIntrinsic() && !declType->IsSequenceType() && | |||
5024 | !InModuleFile()) { | |||
5025 | if (GetAttrs().test(Attr::POINTER) && | |||
5026 | context().IsEnabled(common::LanguageFeature::PointerInSeqType)) { | |||
5027 | if (context().ShouldWarn(common::LanguageFeature::PointerInSeqType)) { | |||
5028 | Say("A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US); | |||
5029 | } | |||
5030 | } else { | |||
5031 | Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US); | |||
5032 | } | |||
5033 | } | |||
5034 | } | |||
5035 | } | |||
5036 | Walk(std::get<std::list<parser::ComponentOrFill>>(x.t)); | |||
5037 | return false; | |||
5038 | } | |||
5039 | bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) { | |||
5040 | CHECK(!interfaceName_)((!interfaceName_) || (Fortran::common::die("CHECK(" "!interfaceName_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5040), false)); | |||
5041 | return true; | |||
5042 | } | |||
5043 | void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) { | |||
5044 | interfaceName_ = nullptr; | |||
5045 | } | |||
5046 | bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) { | |||
5047 | if (auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5048 | return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(*name); | |||
5049 | } else { | |||
5050 | const auto &null{DEREF(std::get_if<parser::NullInit>(&x.u))Fortran::common::Deref(std::get_if<parser::NullInit>(& x.u), "flang/lib/Semantics/resolve-names.cpp", 5050)}; | |||
5051 | Walk(null); | |||
5052 | if (auto nullInit{EvaluateExpr(null)}) { | |||
5053 | if (!evaluate::IsNullPointer(*nullInit)) { | |||
5054 | Say(null.v.value().source, | |||
5055 | "Procedure pointer initializer must be a name or intrinsic NULL()"_err_en_US); | |||
5056 | } | |||
5057 | } | |||
5058 | return false; | |||
5059 | } | |||
5060 | } | |||
5061 | void DeclarationVisitor::Post(const parser::ProcInterface &x) { | |||
5062 | if (auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5063 | interfaceName_ = name; | |||
5064 | NoteInterfaceName(*name); | |||
5065 | } | |||
5066 | } | |||
5067 | void DeclarationVisitor::Post(const parser::ProcDecl &x) { | |||
5068 | const auto &name{std::get<parser::Name>(x.t)}; | |||
5069 | const Symbol *procInterface{nullptr}; | |||
5070 | if (interfaceName_) { | |||
5071 | procInterface = interfaceName_->symbol; | |||
5072 | } | |||
5073 | auto attrs{HandleSaveName(name.source, GetAttrs())}; | |||
5074 | DerivedTypeDetails *dtDetails{nullptr}; | |||
5075 | if (Symbol * symbol{currScope().symbol()}) { | |||
5076 | dtDetails = symbol->detailsIf<DerivedTypeDetails>(); | |||
5077 | } | |||
5078 | if (!dtDetails) { | |||
5079 | attrs.set(Attr::EXTERNAL); | |||
5080 | } | |||
5081 | Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)}; | |||
5082 | symbol.ReplaceName(name.source); | |||
5083 | if (dtDetails) { | |||
5084 | dtDetails->add_component(symbol); | |||
5085 | } | |||
5086 | } | |||
5087 | ||||
5088 | bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) { | |||
5089 | derivedTypeInfo_.sawContains = true; | |||
5090 | return true; | |||
5091 | } | |||
5092 | ||||
5093 | // Resolve binding names from type-bound generics, saved in genericBindings_. | |||
5094 | void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) { | |||
5095 | // track specifics seen for the current generic to detect duplicates: | |||
5096 | const Symbol *currGeneric{nullptr}; | |||
5097 | std::set<SourceName> specifics; | |||
5098 | for (const auto &[generic, bindingName] : genericBindings_) { | |||
5099 | if (generic != currGeneric) { | |||
5100 | currGeneric = generic; | |||
5101 | specifics.clear(); | |||
5102 | } | |||
5103 | auto [it, inserted]{specifics.insert(bindingName->source)}; | |||
5104 | if (!inserted) { | |||
5105 | Say(*bindingName, // C773 | |||
5106 | "Binding name '%s' was already specified for generic '%s'"_err_en_US, | |||
5107 | bindingName->source, generic->name()) | |||
5108 | .Attach(*it, "Previous specification of '%s'"_en_US, *it); | |||
5109 | continue; | |||
5110 | } | |||
5111 | auto *symbol{FindInTypeOrParents(*bindingName)}; | |||
5112 | if (!symbol) { | |||
5113 | Say(*bindingName, // C772 | |||
5114 | "Binding name '%s' not found in this derived type"_err_en_US); | |||
5115 | } else if (!symbol->has<ProcBindingDetails>()) { | |||
5116 | SayWithDecl(*bindingName, *symbol, // C772 | |||
5117 | "'%s' is not the name of a specific binding of this type"_err_en_US); | |||
5118 | } else { | |||
5119 | generic->get<GenericDetails>().AddSpecificProc( | |||
5120 | *symbol, bindingName->source); | |||
5121 | } | |||
5122 | } | |||
5123 | genericBindings_.clear(); | |||
5124 | } | |||
5125 | ||||
5126 | void DeclarationVisitor::Post(const parser::ContainsStmt &) { | |||
5127 | if (derivedTypeInfo_.sequence) { | |||
5128 | Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740 | |||
5129 | } | |||
5130 | } | |||
5131 | ||||
5132 | void DeclarationVisitor::Post( | |||
5133 | const parser::TypeBoundProcedureStmt::WithoutInterface &x) { | |||
5134 | if (GetAttrs().test(Attr::DEFERRED)) { // C783 | |||
5135 | Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US); | |||
5136 | } | |||
5137 | for (auto &declaration : x.declarations) { | |||
5138 | auto &bindingName{std::get<parser::Name>(declaration.t)}; | |||
5139 | auto &optName{std::get<std::optional<parser::Name>>(declaration.t)}; | |||
5140 | const parser::Name &procedureName{optName ? *optName : bindingName}; | |||
5141 | Symbol *procedure{FindSymbol(procedureName)}; | |||
5142 | if (!procedure) { | |||
5143 | procedure = NoteInterfaceName(procedureName); | |||
5144 | } | |||
5145 | if (procedure) { | |||
5146 | const Symbol &bindTo{BypassGeneric(*procedure)}; | |||
5147 | if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{bindTo})}) { | |||
5148 | SetPassNameOn(*s); | |||
5149 | if (GetAttrs().test(Attr::DEFERRED)) { | |||
5150 | context().SetError(*s); | |||
5151 | } | |||
5152 | } | |||
5153 | } | |||
5154 | } | |||
5155 | } | |||
5156 | ||||
5157 | void DeclarationVisitor::CheckBindings( | |||
5158 | const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { | |||
5159 | CHECK(currScope().IsDerivedType())((currScope().IsDerivedType()) || (Fortran::common::die("CHECK(" "currScope().IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 5159), false)); | |||
5160 | for (auto &declaration : tbps.declarations) { | |||
5161 | auto &bindingName{std::get<parser::Name>(declaration.t)}; | |||
5162 | if (Symbol * binding{FindInScope(bindingName)}) { | |||
5163 | if (auto *details{binding->detailsIf<ProcBindingDetails>()}) { | |||
5164 | const Symbol &ultimate{details->symbol().GetUltimate()}; | |||
5165 | const Symbol &procedure{BypassGeneric(ultimate)}; | |||
5166 | if (&procedure != &ultimate) { | |||
5167 | details->ReplaceSymbol(procedure); | |||
5168 | } | |||
5169 | if (!CanBeTypeBoundProc(procedure)) { | |||
5170 | if (details->symbol().name() != binding->name()) { | |||
5171 | Say(binding->name(), | |||
5172 | "The binding of '%s' ('%s') must be either an accessible " | |||
5173 | "module procedure or an external procedure with " | |||
5174 | "an explicit interface"_err_en_US, | |||
5175 | binding->name(), details->symbol().name()); | |||
5176 | } else { | |||
5177 | Say(binding->name(), | |||
5178 | "'%s' must be either an accessible module procedure " | |||
5179 | "or an external procedure with an explicit interface"_err_en_US, | |||
5180 | binding->name()); | |||
5181 | } | |||
5182 | context().SetError(*binding); | |||
5183 | } | |||
5184 | } | |||
5185 | } | |||
5186 | } | |||
5187 | } | |||
5188 | ||||
5189 | void DeclarationVisitor::Post( | |||
5190 | const parser::TypeBoundProcedureStmt::WithInterface &x) { | |||
5191 | if (!GetAttrs().test(Attr::DEFERRED)) { // C783 | |||
5192 | Say("DEFERRED is required when an interface-name is provided"_err_en_US); | |||
5193 | } | |||
5194 | if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) { | |||
5195 | for (auto &bindingName : x.bindingNames) { | |||
5196 | if (auto *s{ | |||
5197 | MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) { | |||
5198 | SetPassNameOn(*s); | |||
5199 | if (!GetAttrs().test(Attr::DEFERRED)) { | |||
5200 | context().SetError(*s); | |||
5201 | } | |||
5202 | } | |||
5203 | } | |||
5204 | } | |||
5205 | } | |||
5206 | ||||
5207 | void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) { | |||
5208 | if (currScope().IsDerivedType() && currScope().symbol()) { | |||
5209 | if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) { | |||
5210 | for (const auto &subrName : x.v) { | |||
5211 | if (const auto *name{ResolveName(subrName)}) { | |||
5212 | auto pair{ | |||
5213 | details->finals().emplace(name->source, DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 5213))}; | |||
5214 | if (!pair.second) { // C787 | |||
5215 | Say(name->source, | |||
5216 | "FINAL subroutine '%s' already appeared in this derived type"_err_en_US, | |||
5217 | name->source) | |||
5218 | .Attach(pair.first->first, | |||
5219 | "earlier appearance of this FINAL subroutine"_en_US); | |||
5220 | } | |||
5221 | } | |||
5222 | } | |||
5223 | } | |||
5224 | } | |||
5225 | } | |||
5226 | ||||
5227 | bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { | |||
5228 | const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}; | |||
5229 | const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)}; | |||
5230 | const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)}; | |||
5231 | GenericSpecInfo info{genericSpec.value()}; | |||
5232 | SourceName symbolName{info.symbolName()}; | |||
5233 | bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private | |||
5234 | : derivedTypeInfo_.privateBindings}; | |||
5235 | auto *genericSymbol{FindInScope(symbolName)}; | |||
5236 | if (genericSymbol) { | |||
5237 | if (!genericSymbol->has<GenericDetails>()) { | |||
5238 | genericSymbol = nullptr; // MakeTypeSymbol will report the error below | |||
5239 | } | |||
5240 | } else { | |||
5241 | // look in ancestor types for a generic of the same name | |||
5242 | for (const auto &name : GetAllNames(context(), symbolName)) { | |||
5243 | if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) { | |||
5244 | if (inherited->has<GenericDetails>()) { | |||
5245 | CheckAccessibility(symbolName, isPrivate, *inherited); // C771 | |||
5246 | } else { | |||
5247 | Say(symbolName, | |||
5248 | "Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US) | |||
5249 | .Attach(inherited->name(), "Inherited symbol"_en_US); | |||
5250 | } | |||
5251 | break; | |||
5252 | } | |||
5253 | } | |||
5254 | } | |||
5255 | if (genericSymbol) { | |||
5256 | CheckAccessibility(symbolName, isPrivate, *genericSymbol); // C771 | |||
5257 | } else { | |||
5258 | genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{}); | |||
5259 | if (!genericSymbol) { | |||
5260 | return false; | |||
5261 | } | |||
5262 | if (isPrivate) { | |||
5263 | SetExplicitAttr(*genericSymbol, Attr::PRIVATE); | |||
5264 | } | |||
5265 | } | |||
5266 | for (const parser::Name &bindingName : bindingNames) { | |||
5267 | genericBindings_.emplace(genericSymbol, &bindingName); | |||
5268 | } | |||
5269 | info.Resolve(genericSymbol); | |||
5270 | return false; | |||
5271 | } | |||
5272 | ||||
5273 | // DEC STRUCTUREs are handled thus to allow for nested definitions. | |||
5274 | bool DeclarationVisitor::Pre(const parser::StructureDef &def) { | |||
5275 | const auto &structureStatement{ | |||
5276 | std::get<parser::Statement<parser::StructureStmt>>(def.t)}; | |||
5277 | auto saveDerivedTypeInfo{derivedTypeInfo_}; | |||
5278 | derivedTypeInfo_ = {}; | |||
5279 | derivedTypeInfo_.isStructure = true; | |||
5280 | derivedTypeInfo_.sequence = true; | |||
5281 | Scope *previousStructure{nullptr}; | |||
5282 | if (saveDerivedTypeInfo.isStructure) { | |||
5283 | previousStructure = &currScope(); | |||
5284 | PopScope(); | |||
5285 | } | |||
5286 | const parser::StructureStmt &structStmt{structureStatement.statement}; | |||
5287 | const auto &name{std::get<std::optional<parser::Name>>(structStmt.t)}; | |||
5288 | if (!name) { | |||
5289 | // Construct a distinct generated name for an anonymous structure | |||
5290 | auto &mutableName{const_cast<std::optional<parser::Name> &>(name)}; | |||
5291 | mutableName.emplace( | |||
5292 | parser::Name{context().GetTempName(currScope()), nullptr}); | |||
5293 | } | |||
5294 | auto &symbol{MakeSymbol(*name, DerivedTypeDetails{})}; | |||
5295 | symbol.ReplaceName(name->source); | |||
5296 | symbol.get<DerivedTypeDetails>().set_sequence(true); | |||
5297 | symbol.get<DerivedTypeDetails>().set_isDECStructure(true); | |||
5298 | derivedTypeInfo_.type = &symbol; | |||
5299 | PushScope(Scope::Kind::DerivedType, &symbol); | |||
5300 | const auto &fields{std::get<std::list<parser::StructureField>>(def.t)}; | |||
5301 | Walk(fields); | |||
5302 | PopScope(); | |||
5303 | // Complete the definition | |||
5304 | DerivedTypeSpec derivedTypeSpec{symbol.name(), symbol}; | |||
5305 | derivedTypeSpec.set_scope(DEREF(symbol.scope())Fortran::common::Deref(symbol.scope(), "flang/lib/Semantics/resolve-names.cpp" , 5305)); | |||
5306 | derivedTypeSpec.CookParameters(GetFoldingContext()); | |||
5307 | derivedTypeSpec.EvaluateParameters(context()); | |||
5308 | DeclTypeSpec &type{currScope().MakeDerivedType( | |||
5309 | DeclTypeSpec::TypeDerived, std::move(derivedTypeSpec))}; | |||
5310 | type.derivedTypeSpec().Instantiate(currScope()); | |||
5311 | // Restore previous structure definition context, if any | |||
5312 | derivedTypeInfo_ = saveDerivedTypeInfo; | |||
5313 | if (previousStructure) { | |||
5314 | PushScope(*previousStructure); | |||
5315 | } | |||
5316 | // Handle any entity declarations on the STRUCTURE statement | |||
5317 | const auto &decls{std::get<std::list<parser::EntityDecl>>(structStmt.t)}; | |||
5318 | if (!decls.empty()) { | |||
5319 | BeginDecl(); | |||
5320 | SetDeclTypeSpec(type); | |||
5321 | Walk(decls); | |||
5322 | EndDecl(); | |||
5323 | } | |||
5324 | return false; | |||
5325 | } | |||
5326 | ||||
5327 | bool DeclarationVisitor::Pre(const parser::Union::UnionStmt &) { | |||
5328 | Say("support for UNION"_todo_en_US); // TODO | |||
5329 | return true; | |||
5330 | } | |||
5331 | ||||
5332 | bool DeclarationVisitor::Pre(const parser::StructureField &x) { | |||
5333 | if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>( | |||
5334 | x.u)) { | |||
5335 | BeginDecl(); | |||
5336 | } | |||
5337 | return true; | |||
5338 | } | |||
5339 | ||||
5340 | void DeclarationVisitor::Post(const parser::StructureField &x) { | |||
5341 | if (std::holds_alternative<parser::Statement<parser::DataComponentDefStmt>>( | |||
5342 | x.u)) { | |||
5343 | EndDecl(); | |||
5344 | } | |||
5345 | } | |||
5346 | ||||
5347 | bool DeclarationVisitor::Pre(const parser::AllocateStmt &) { | |||
5348 | BeginDeclTypeSpec(); | |||
5349 | return true; | |||
5350 | } | |||
5351 | void DeclarationVisitor::Post(const parser::AllocateStmt &) { | |||
5352 | EndDeclTypeSpec(); | |||
5353 | } | |||
5354 | ||||
5355 | bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { | |||
5356 | auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)}; | |||
5357 | const DeclTypeSpec *type{ProcessTypeSpec(parsedType)}; | |||
5358 | if (!type) { | |||
5359 | return false; | |||
5360 | } | |||
5361 | const DerivedTypeSpec *spec{type->AsDerived()}; | |||
5362 | const Scope *typeScope{spec ? spec->scope() : nullptr}; | |||
5363 | if (!typeScope) { | |||
5364 | return false; | |||
5365 | } | |||
5366 | ||||
5367 | // N.B C7102 is implicitly enforced by having inaccessible types not | |||
5368 | // being found in resolution. | |||
5369 | // More constraints are enforced in expression.cpp so that they | |||
5370 | // can apply to structure constructors that have been converted | |||
5371 | // from misparsed function references. | |||
5372 | for (const auto &component : | |||
5373 | std::get<std::list<parser::ComponentSpec>>(x.t)) { | |||
5374 | // Visit the component spec expression, but not the keyword, since | |||
5375 | // we need to resolve its symbol in the scope of the derived type. | |||
5376 | Walk(std::get<parser::ComponentDataSource>(component.t)); | |||
5377 | if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) { | |||
5378 | FindInTypeOrParents(*typeScope, kw->v); | |||
5379 | } | |||
5380 | } | |||
5381 | return false; | |||
5382 | } | |||
5383 | ||||
5384 | bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) { | |||
5385 | for (const parser::BasedPointer &bp : x.v) { | |||
5386 | const parser::ObjectName &pointerName{std::get<0>(bp.t)}; | |||
5387 | const parser::ObjectName &pointeeName{std::get<1>(bp.t)}; | |||
5388 | auto *pointer{FindSymbol(pointerName)}; | |||
5389 | if (!pointer) { | |||
| ||||
5390 | pointer = &MakeSymbol(pointerName, ObjectEntityDetails{}); | |||
5391 | } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) { | |||
5392 | SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US); | |||
5393 | } else if (pointer->Rank() > 0) { | |||
5394 | SayWithDecl(pointerName, *pointer, | |||
5395 | "Cray pointer '%s' must be a scalar"_err_en_US); | |||
5396 | } else if (pointer->test(Symbol::Flag::CrayPointee)) { | |||
5397 | Say(pointerName, | |||
5398 | "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US); | |||
5399 | } | |||
5400 | pointer->set(Symbol::Flag::CrayPointer); | |||
5401 | const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer, | |||
5402 | context().defaultKinds().subscriptIntegerKind())}; | |||
5403 | const auto *type{pointer->GetType()}; | |||
5404 | if (!type) { | |||
5405 | pointer->SetType(pointerType); | |||
5406 | } else if (*type != pointerType) { | |||
5407 | Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US, | |||
5408 | pointerName.source, pointerType.AsFortran()); | |||
5409 | } | |||
5410 | if (ResolveName(pointeeName)) { | |||
5411 | Symbol &pointee{*pointeeName.symbol}; | |||
| ||||
5412 | if (pointee.has<UseDetails>()) { | |||
5413 | Say(pointeeName, | |||
5414 | "'%s' cannot be a Cray pointee as it is use-associated"_err_en_US); | |||
5415 | continue; | |||
5416 | } else if (!ConvertToObjectEntity(pointee) || IsNamedConstant(pointee)) { | |||
5417 | Say(pointeeName, "'%s' is not a variable"_err_en_US); | |||
5418 | continue; | |||
5419 | } else if (pointee.test(Symbol::Flag::CrayPointer)) { | |||
5420 | Say(pointeeName, | |||
5421 | "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US); | |||
5422 | } else if (pointee.test(Symbol::Flag::CrayPointee)) { | |||
5423 | Say(pointeeName, | |||
5424 | "'%s' was already declared as a Cray pointee"_err_en_US); | |||
5425 | } else { | |||
5426 | pointee.set(Symbol::Flag::CrayPointee); | |||
5427 | } | |||
5428 | if (const auto *pointeeType{pointee.GetType()}) { | |||
5429 | if (const auto *derived{pointeeType->AsDerived()}) { | |||
5430 | if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) { | |||
5431 | Say(pointeeName, | |||
5432 | "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US); | |||
5433 | } | |||
5434 | } | |||
5435 | } | |||
5436 | // process the pointee array-spec, if present | |||
5437 | BeginArraySpec(); | |||
5438 | Walk(std::get<std::optional<parser::ArraySpec>>(bp.t)); | |||
5439 | const auto &spec{arraySpec()}; | |||
5440 | if (!spec.empty()) { | |||
5441 | auto &details{pointee.get<ObjectEntityDetails>()}; | |||
5442 | if (details.shape().empty()) { | |||
5443 | details.set_shape(spec); | |||
5444 | } else { | |||
5445 | SayWithDecl(pointeeName, pointee, | |||
5446 | "Array spec was already declared for '%s'"_err_en_US); | |||
5447 | } | |||
5448 | } | |||
5449 | ClearArraySpec(); | |||
5450 | currScope().add_crayPointer(pointeeName.source, *pointer); | |||
5451 | } | |||
5452 | } | |||
5453 | return false; | |||
5454 | } | |||
5455 | ||||
5456 | bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) { | |||
5457 | if (!CheckNotInBlock("NAMELIST")) { // C1107 | |||
5458 | return false; | |||
5459 | } | |||
5460 | const auto &groupName{std::get<parser::Name>(x.t)}; | |||
5461 | auto *groupSymbol{FindInScope(groupName)}; | |||
5462 | if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) { | |||
5463 | groupSymbol = &MakeSymbol(groupName, NamelistDetails{}); | |||
5464 | groupSymbol->ReplaceName(groupName.source); | |||
5465 | } | |||
5466 | // Name resolution of group items is deferred to FinishNamelists() | |||
5467 | // so that host association is handled correctly. | |||
5468 | GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x); | |||
5469 | return false; | |||
5470 | } | |||
5471 | ||||
5472 | void DeclarationVisitor::FinishNamelists() { | |||
5473 | if (auto *deferred{GetDeferredDeclarationState()}) { | |||
5474 | for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) { | |||
5475 | if (auto *groupSymbol{FindInScope(std::get<parser::Name>(group->t))}) { | |||
5476 | if (auto *details{groupSymbol->detailsIf<NamelistDetails>()}) { | |||
5477 | for (const auto &name : std::get<std::list<parser::Name>>(group->t)) { | |||
5478 | auto *symbol{FindSymbol(name)}; | |||
5479 | if (!symbol) { | |||
5480 | symbol = &MakeSymbol(name, ObjectEntityDetails{}); | |||
5481 | ApplyImplicitRules(*symbol); | |||
5482 | } else if (!ConvertToObjectEntity(*symbol)) { | |||
5483 | SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); | |||
5484 | } | |||
5485 | symbol->GetUltimate().set(Symbol::Flag::InNamelist); | |||
5486 | details->add_object(*symbol); | |||
5487 | } | |||
5488 | } | |||
5489 | } | |||
5490 | } | |||
5491 | deferred->namelistGroups.clear(); | |||
5492 | } | |||
5493 | } | |||
5494 | ||||
5495 | bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { | |||
5496 | if (const auto *name{std::get_if<parser::Name>(&x.u)}) { | |||
5497 | auto *symbol{FindSymbol(*name)}; | |||
5498 | if (!symbol) { | |||
5499 | Say(*name, "Namelist group '%s' not found"_err_en_US); | |||
5500 | } else if (!symbol->GetUltimate().has<NamelistDetails>()) { | |||
5501 | SayWithDecl( | |||
5502 | *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US); | |||
5503 | } | |||
5504 | } | |||
5505 | return true; | |||
5506 | } | |||
5507 | ||||
5508 | bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { | |||
5509 | CheckNotInBlock("COMMON"); // C1107 | |||
5510 | return true; | |||
5511 | } | |||
5512 | ||||
5513 | bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) { | |||
5514 | BeginArraySpec(); | |||
5515 | return true; | |||
5516 | } | |||
5517 | ||||
5518 | void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { | |||
5519 | const auto &name{std::get<parser::Name>(x.t)}; | |||
5520 | DeclareObjectEntity(name); | |||
5521 | auto pair{specPartState_.commonBlockObjects.insert(name.source)}; | |||
5522 | if (!pair.second) { | |||
5523 | const SourceName &prev{*pair.first}; | |||
5524 | Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev, | |||
5525 | "Previous occurrence of '%s' in a COMMON block"_en_US); | |||
5526 | } | |||
5527 | } | |||
5528 | ||||
5529 | bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) { | |||
5530 | // save equivalence sets to be processed after specification part | |||
5531 | if (CheckNotInBlock("EQUIVALENCE")) { // C1107 | |||
5532 | for (const std::list<parser::EquivalenceObject> &set : x.v) { | |||
5533 | specPartState_.equivalenceSets.push_back(&set); | |||
5534 | } | |||
5535 | } | |||
5536 | return false; // don't implicitly declare names yet | |||
5537 | } | |||
5538 | ||||
5539 | void DeclarationVisitor::CheckEquivalenceSets() { | |||
5540 | EquivalenceSets equivSets{context()}; | |||
5541 | inEquivalenceStmt_ = true; | |||
5542 | for (const auto *set : specPartState_.equivalenceSets) { | |||
5543 | const auto &source{set->front().v.value().source}; | |||
5544 | if (set->size() <= 1) { // R871 | |||
5545 | Say(source, "Equivalence set must have more than one object"_err_en_US); | |||
5546 | } | |||
5547 | for (const parser::EquivalenceObject &object : *set) { | |||
5548 | const auto &designator{object.v.value()}; | |||
5549 | // The designator was not resolved when it was encountered so do it now. | |||
5550 | // AnalyzeExpr causes array sections to be changed to substrings as needed | |||
5551 | Walk(designator); | |||
5552 | if (AnalyzeExpr(context(), designator)) { | |||
5553 | equivSets.AddToSet(designator); | |||
5554 | } | |||
5555 | } | |||
5556 | equivSets.FinishSet(source); | |||
5557 | } | |||
5558 | inEquivalenceStmt_ = false; | |||
5559 | for (auto &set : equivSets.sets()) { | |||
5560 | if (!set.empty()) { | |||
5561 | currScope().add_equivalenceSet(std::move(set)); | |||
5562 | } | |||
5563 | } | |||
5564 | specPartState_.equivalenceSets.clear(); | |||
5565 | } | |||
5566 | ||||
5567 | bool DeclarationVisitor::Pre(const parser::SaveStmt &x) { | |||
5568 | if (x.v.empty()) { | |||
5569 | specPartState_.saveInfo.saveAll = currStmtSource(); | |||
5570 | currScope().set_hasSAVE(); | |||
5571 | } else { | |||
5572 | for (const parser::SavedEntity &y : x.v) { | |||
5573 | auto kind{std::get<parser::SavedEntity::Kind>(y.t)}; | |||
5574 | const auto &name{std::get<parser::Name>(y.t)}; | |||
5575 | if (kind == parser::SavedEntity::Kind::Common) { | |||
5576 | MakeCommonBlockSymbol(name); | |||
5577 | AddSaveName(specPartState_.saveInfo.commons, name.source); | |||
5578 | } else { | |||
5579 | HandleAttributeStmt(Attr::SAVE, name); | |||
5580 | } | |||
5581 | } | |||
5582 | } | |||
5583 | return false; | |||
5584 | } | |||
5585 | ||||
5586 | void DeclarationVisitor::CheckSaveStmts() { | |||
5587 | for (const SourceName &name : specPartState_.saveInfo.entities) { | |||
5588 | auto *symbol{FindInScope(name)}; | |||
5589 | if (!symbol) { | |||
5590 | // error was reported | |||
5591 | } else if (specPartState_.saveInfo.saveAll) { | |||
5592 | // C889 - note that pgi, ifort, xlf do not enforce this constraint | |||
5593 | Say2(name, | |||
5594 | "Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US, | |||
5595 | *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US); | |||
5596 | } else if (!IsSaved(*symbol)) { | |||
5597 | SetExplicitAttr(*symbol, Attr::SAVE); | |||
5598 | } | |||
5599 | } | |||
5600 | for (const SourceName &name : specPartState_.saveInfo.commons) { | |||
5601 | if (auto *symbol{currScope().FindCommonBlock(name)}) { | |||
5602 | auto &objects{symbol->get<CommonBlockDetails>().objects()}; | |||
5603 | if (objects.empty()) { | |||
5604 | if (currScope().kind() != Scope::Kind::BlockConstruct) { | |||
5605 | Say(name, | |||
5606 | "'%s' appears as a COMMON block in a SAVE statement but not in" | |||
5607 | " a COMMON statement"_err_en_US); | |||
5608 | } else { // C1108 | |||
5609 | Say(name, | |||
5610 | "SAVE statement in BLOCK construct may not contain a" | |||
5611 | " common block name '%s'"_err_en_US); | |||
5612 | } | |||
5613 | } else { | |||
5614 | for (auto &object : symbol->get<CommonBlockDetails>().objects()) { | |||
5615 | if (!IsSaved(*object)) { | |||
5616 | SetImplicitAttr(*object, Attr::SAVE); | |||
5617 | } | |||
5618 | } | |||
5619 | } | |||
5620 | } | |||
5621 | } | |||
5622 | specPartState_.saveInfo = {}; | |||
5623 | } | |||
5624 | ||||
5625 | // Record SAVEd names in specPartState_.saveInfo.entities. | |||
5626 | Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) { | |||
5627 | if (attrs.test(Attr::SAVE)) { | |||
5628 | AddSaveName(specPartState_.saveInfo.entities, name); | |||
5629 | } | |||
5630 | return attrs; | |||
5631 | } | |||
5632 | ||||
5633 | // Record a name in a set of those to be saved. | |||
5634 | void DeclarationVisitor::AddSaveName( | |||
5635 | std::set<SourceName> &set, const SourceName &name) { | |||
5636 | auto pair{set.insert(name)}; | |||
5637 | if (!pair.second) { | |||
5638 | Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US, | |||
5639 | *pair.first, "Previous specification of SAVE attribute"_en_US); | |||
5640 | } | |||
5641 | } | |||
5642 | ||||
5643 | // Check types of common block objects, now that they are known. | |||
5644 | void DeclarationVisitor::CheckCommonBlocks() { | |||
5645 | // check for empty common blocks | |||
5646 | for (const auto &pair : currScope().commonBlocks()) { | |||
5647 | const auto &symbol{*pair.second}; | |||
5648 | if (symbol.get<CommonBlockDetails>().objects().empty() && | |||
5649 | symbol.attrs().test(Attr::BIND_C)) { | |||
5650 | Say(symbol.name(), | |||
5651 | "'%s' appears as a COMMON block in a BIND statement but not in" | |||
5652 | " a COMMON statement"_err_en_US); | |||
5653 | } | |||
5654 | } | |||
5655 | // check objects in common blocks | |||
5656 | for (const auto &name : specPartState_.commonBlockObjects) { | |||
5657 | const auto *symbol{currScope().FindSymbol(name)}; | |||
5658 | if (!symbol) { | |||
5659 | continue; | |||
5660 | } | |||
5661 | const auto &attrs{symbol->attrs()}; | |||
5662 | if (attrs.test(Attr::ALLOCATABLE)) { | |||
5663 | Say(name, | |||
5664 | "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US); | |||
5665 | } else if (attrs.test(Attr::BIND_C)) { | |||
5666 | Say(name, | |||
5667 | "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US); | |||
5668 | } else if (IsNamedConstant(*symbol)) { | |||
5669 | Say(name, | |||
5670 | "A named constant '%s' may not appear in a COMMON block"_err_en_US); | |||
5671 | } else if (IsDummy(*symbol)) { | |||
5672 | Say(name, | |||
5673 | "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); | |||
5674 | } else if (symbol->IsFuncResult()) { | |||
5675 | Say(name, | |||
5676 | "Function result '%s' may not appear in a COMMON block"_err_en_US); | |||
5677 | } else if (const DeclTypeSpec * type{symbol->GetType()}) { | |||
5678 | if (type->category() == DeclTypeSpec::ClassStar) { | |||
5679 | Say(name, | |||
5680 | "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US); | |||
5681 | } else if (const auto *derived{type->AsDerived()}) { | |||
5682 | auto &typeSymbol{derived->typeSymbol()}; | |||
5683 | if (!typeSymbol.attrs().test(Attr::BIND_C) && | |||
5684 | !typeSymbol.get<DerivedTypeDetails>().sequence()) { | |||
5685 | Say(name, | |||
5686 | "Derived type '%s' in COMMON block must have the BIND or" | |||
5687 | " SEQUENCE attribute"_err_en_US); | |||
5688 | } | |||
5689 | CheckCommonBlockDerivedType(name, typeSymbol); | |||
5690 | } | |||
5691 | } | |||
5692 | } | |||
5693 | specPartState_.commonBlockObjects = {}; | |||
5694 | } | |||
5695 | ||||
5696 | Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { | |||
5697 | return Resolve(name, currScope().MakeCommonBlock(name.source)); | |||
5698 | } | |||
5699 | Symbol &DeclarationVisitor::MakeCommonBlockSymbol( | |||
5700 | const std::optional<parser::Name> &name) { | |||
5701 | if (name) { | |||
5702 | return MakeCommonBlockSymbol(*name); | |||
5703 | } else { | |||
5704 | return MakeCommonBlockSymbol(parser::Name{}); | |||
5705 | } | |||
5706 | } | |||
5707 | ||||
5708 | bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) { | |||
5709 | return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name); | |||
5710 | } | |||
5711 | ||||
5712 | // Check if this derived type can be in a COMMON block. | |||
5713 | void DeclarationVisitor::CheckCommonBlockDerivedType( | |||
5714 | const SourceName &name, const Symbol &typeSymbol) { | |||
5715 | if (const auto *scope{typeSymbol.scope()}) { | |||
5716 | for (const auto &pair : *scope) { | |||
5717 | const Symbol &component{*pair.second}; | |||
5718 | if (component.attrs().test(Attr::ALLOCATABLE)) { | |||
5719 | Say2(name, | |||
5720 | "Derived type variable '%s' may not appear in a COMMON block" | |||
5721 | " due to ALLOCATABLE component"_err_en_US, | |||
5722 | component.name(), "Component with ALLOCATABLE attribute"_en_US); | |||
5723 | return; | |||
5724 | } | |||
5725 | const auto *details{component.detailsIf<ObjectEntityDetails>()}; | |||
5726 | if (component.test(Symbol::Flag::InDataStmt) || | |||
5727 | (details && details->init())) { | |||
5728 | Say2(name, | |||
5729 | "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US, | |||
5730 | component.name(), "Component with default initialization"_en_US); | |||
5731 | return; | |||
5732 | } | |||
5733 | if (details) { | |||
5734 | if (const auto *type{details->type()}) { | |||
5735 | if (const auto *derived{type->AsDerived()}) { | |||
5736 | const Symbol &derivedTypeSymbol{derived->typeSymbol()}; | |||
5737 | // Don't call this member function recursively if the derived type | |||
5738 | // symbol is the same symbol that is already being processed. | |||
5739 | // This can happen when a component is a pointer of the same type | |||
5740 | // as its parent component, for instance. | |||
5741 | if (derivedTypeSymbol != typeSymbol) { | |||
5742 | CheckCommonBlockDerivedType(name, derivedTypeSymbol); | |||
5743 | } | |||
5744 | } | |||
5745 | } | |||
5746 | } | |||
5747 | } | |||
5748 | } | |||
5749 | } | |||
5750 | ||||
5751 | bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( | |||
5752 | const parser::Name &name) { | |||
5753 | if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction( | |||
5754 | name.source.ToString())}) { | |||
5755 | // Unrestricted specific intrinsic function names (e.g., "cos") | |||
5756 | // are acceptable as procedure interfaces. The presence of the | |||
5757 | // INTRINSIC flag will cause this symbol to have a complete interface | |||
5758 | // recreated for it later on demand, but capturing its result type here | |||
5759 | // will make GetType() return a correct result without having to | |||
5760 | // probe the intrinsics table again. | |||
5761 | Symbol &symbol{ | |||
5762 | MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})}; | |||
5763 | CHECK(interface->functionResult.has_value())((interface->functionResult.has_value()) || (Fortran::common ::die("CHECK(" "interface->functionResult.has_value()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 5763) , false)); | |||
5764 | evaluate::DynamicType dyType{ | |||
5765 | DEREF(interface->functionResult->GetTypeAndShape())Fortran::common::Deref(interface->functionResult->GetTypeAndShape (), "flang/lib/Semantics/resolve-names.cpp", 5765).type()}; | |||
5766 | CHECK(common::IsNumericTypeCategory(dyType.category()))((common::IsNumericTypeCategory(dyType.category())) || (Fortran ::common::die("CHECK(" "common::IsNumericTypeCategory(dyType.category())" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5766), false)); | |||
5767 | const DeclTypeSpec &typeSpec{ | |||
5768 | MakeNumericType(dyType.category(), dyType.kind())}; | |||
5769 | ProcEntityDetails details; | |||
5770 | details.set_type(typeSpec); | |||
5771 | symbol.set_details(std::move(details)); | |||
5772 | symbol.set(Symbol::Flag::Function); | |||
5773 | if (interface->IsElemental()) { | |||
5774 | SetExplicitAttr(symbol, Attr::ELEMENTAL); | |||
5775 | } | |||
5776 | if (interface->IsPure()) { | |||
5777 | SetExplicitAttr(symbol, Attr::PURE); | |||
5778 | } | |||
5779 | Resolve(name, symbol); | |||
5780 | return true; | |||
5781 | } else { | |||
5782 | return false; | |||
5783 | } | |||
5784 | } | |||
5785 | ||||
5786 | // Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED | |||
5787 | bool DeclarationVisitor::PassesSharedLocalityChecks( | |||
5788 | const parser::Name &name, Symbol &symbol) { | |||
5789 | if (!IsVariableName(symbol)) { | |||
5790 | SayLocalMustBeVariable(name, symbol); // C1124 | |||
5791 | return false; | |||
5792 | } | |||
5793 | if (symbol.owner() == currScope()) { // C1125 and C1126 | |||
5794 | SayAlreadyDeclared(name, symbol); | |||
5795 | return false; | |||
5796 | } | |||
5797 | return true; | |||
5798 | } | |||
5799 | ||||
5800 | // Checks for locality-specs LOCAL and LOCAL_INIT | |||
5801 | bool DeclarationVisitor::PassesLocalityChecks( | |||
5802 | const parser::Name &name, Symbol &symbol) { | |||
5803 | if (IsAllocatable(symbol)) { // C1128 | |||
5804 | SayWithDecl(name, symbol, | |||
5805 | "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US); | |||
5806 | return false; | |||
5807 | } | |||
5808 | if (IsOptional(symbol)) { // C1128 | |||
5809 | SayWithDecl(name, symbol, | |||
5810 | "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US); | |||
5811 | return false; | |||
5812 | } | |||
5813 | if (IsIntentIn(symbol)) { // C1128 | |||
5814 | SayWithDecl(name, symbol, | |||
5815 | "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US); | |||
5816 | return false; | |||
5817 | } | |||
5818 | if (IsFinalizable(symbol)) { // C1128 | |||
5819 | SayWithDecl(name, symbol, | |||
5820 | "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US); | |||
5821 | return false; | |||
5822 | } | |||
5823 | if (evaluate::IsCoarray(symbol)) { // C1128 | |||
5824 | SayWithDecl( | |||
5825 | name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US); | |||
5826 | return false; | |||
5827 | } | |||
5828 | if (const DeclTypeSpec * type{symbol.GetType()}) { | |||
5829 | if (type->IsPolymorphic() && IsDummy(symbol) && | |||
5830 | !IsPointer(symbol)) { // C1128 | |||
5831 | SayWithDecl(name, symbol, | |||
5832 | "Nonpointer polymorphic argument '%s' not allowed in a " | |||
5833 | "locality-spec"_err_en_US); | |||
5834 | return false; | |||
5835 | } | |||
5836 | } | |||
5837 | if (IsAssumedSizeArray(symbol)) { // C1128 | |||
5838 | SayWithDecl(name, symbol, | |||
5839 | "Assumed size array '%s' not allowed in a locality-spec"_err_en_US); | |||
5840 | return false; | |||
5841 | } | |||
5842 | if (std::optional<Message> whyNot{WhyNotDefinable( | |||
5843 | name.source, currScope(), DefinabilityFlags{}, symbol)}) { | |||
5844 | SayWithReason(name, symbol, | |||
5845 | "'%s' may not appear in a locality-spec because it is not " | |||
5846 | "definable"_err_en_US, | |||
5847 | std::move(*whyNot)); | |||
5848 | return false; | |||
5849 | } | |||
5850 | return PassesSharedLocalityChecks(name, symbol); | |||
5851 | } | |||
5852 | ||||
5853 | Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity( | |||
5854 | const parser::Name &name) { | |||
5855 | Symbol *prev{FindSymbol(name)}; | |||
5856 | if (!prev) { | |||
5857 | // Declare the name as an object in the enclosing scope so that | |||
5858 | // the name can't be repurposed there later as something else. | |||
5859 | prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{}); | |||
5860 | ConvertToObjectEntity(*prev); | |||
5861 | ApplyImplicitRules(*prev); | |||
5862 | } | |||
5863 | return *prev; | |||
5864 | } | |||
5865 | ||||
5866 | Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) { | |||
5867 | Symbol &prev{FindOrDeclareEnclosingEntity(name)}; | |||
5868 | if (!PassesLocalityChecks(name, prev)) { | |||
5869 | return nullptr; | |||
5870 | } | |||
5871 | return &MakeHostAssocSymbol(name, prev); | |||
5872 | } | |||
5873 | ||||
5874 | Symbol *DeclarationVisitor::DeclareStatementEntity( | |||
5875 | const parser::DoVariable &doVar, | |||
5876 | const std::optional<parser::IntegerTypeSpec> &type) { | |||
5877 | const parser::Name &name{doVar.thing.thing}; | |||
5878 | const DeclTypeSpec *declTypeSpec{nullptr}; | |||
5879 | if (auto *prev{FindSymbol(name)}) { | |||
5880 | if (prev->owner() == currScope()) { | |||
5881 | SayAlreadyDeclared(name, *prev); | |||
5882 | return nullptr; | |||
5883 | } | |||
5884 | name.symbol = nullptr; | |||
5885 | declTypeSpec = prev->GetType(); | |||
5886 | } | |||
5887 | Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})}; | |||
5888 | if (!symbol.has<ObjectEntityDetails>()) { | |||
5889 | return nullptr; // error was reported in DeclareEntity | |||
5890 | } | |||
5891 | if (type) { | |||
5892 | declTypeSpec = ProcessTypeSpec(*type); | |||
5893 | } | |||
5894 | if (declTypeSpec) { | |||
5895 | // Subtlety: Don't let a "*length" specifier (if any is pending) affect the | |||
5896 | // declaration of this implied DO loop control variable. | |||
5897 | auto restorer{ | |||
5898 | common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})}; | |||
5899 | SetType(name, *declTypeSpec); | |||
5900 | } else { | |||
5901 | ApplyImplicitRules(symbol); | |||
5902 | } | |||
5903 | Symbol *result{Resolve(name, &symbol)}; | |||
5904 | AnalyzeExpr(context(), doVar); // enforce INTEGER type | |||
5905 | return result; | |||
5906 | } | |||
5907 | ||||
5908 | // Set the type of an entity or report an error. | |||
5909 | void DeclarationVisitor::SetType( | |||
5910 | const parser::Name &name, const DeclTypeSpec &type) { | |||
5911 | CHECK(name.symbol)((name.symbol) || (Fortran::common::die("CHECK(" "name.symbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 5911), false)); | |||
5912 | auto &symbol{*name.symbol}; | |||
5913 | if (charInfo_.length) { // Declaration has "*length" (R723) | |||
5914 | auto length{std::move(*charInfo_.length)}; | |||
5915 | charInfo_.length.reset(); | |||
5916 | if (type.category() == DeclTypeSpec::Character) { | |||
5917 | auto kind{type.characterTypeSpec().kind()}; | |||
5918 | // Recurse with correct type. | |||
5919 | SetType(name, | |||
5920 | currScope().MakeCharacterType(std::move(length), std::move(kind))); | |||
5921 | return; | |||
5922 | } else { // C753 | |||
5923 | Say(name, | |||
5924 | "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US); | |||
5925 | } | |||
5926 | } | |||
5927 | if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}) { | |||
5928 | if (proc->procInterface()) { | |||
5929 | Say(name, | |||
5930 | "'%s' has an explicit interface and may not also have a type"_err_en_US); | |||
5931 | context().SetError(symbol); | |||
5932 | return; | |||
5933 | } | |||
5934 | } | |||
5935 | auto *prevType{symbol.GetType()}; | |||
5936 | if (!prevType) { | |||
5937 | symbol.SetType(type); | |||
5938 | } else if (symbol.has<UseDetails>()) { | |||
5939 | // error recovery case, redeclaration of use-associated name | |||
5940 | } else if (HadForwardRef(symbol)) { | |||
5941 | // error recovery after use of host-associated name | |||
5942 | } else if (!symbol.test(Symbol::Flag::Implicit)) { | |||
5943 | SayWithDecl( | |||
5944 | name, symbol, "The type of '%s' has already been declared"_err_en_US); | |||
5945 | context().SetError(symbol); | |||
5946 | } else if (type != *prevType) { | |||
5947 | SayWithDecl(name, symbol, | |||
5948 | "The type of '%s' has already been implicitly declared"_err_en_US); | |||
5949 | context().SetError(symbol); | |||
5950 | } else { | |||
5951 | symbol.set(Symbol::Flag::Implicit, false); | |||
5952 | } | |||
5953 | } | |||
5954 | ||||
5955 | std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType( | |||
5956 | const parser::Name &name) { | |||
5957 | Scope &outer{NonDerivedTypeScope()}; | |||
5958 | Symbol *symbol{FindSymbol(outer, name)}; | |||
5959 | Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr}; | |||
5960 | auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr}; | |||
5961 | if (generic) { | |||
5962 | if (Symbol * genDT{generic->derivedType()}) { | |||
5963 | symbol = genDT; | |||
5964 | generic = nullptr; | |||
5965 | } | |||
5966 | } | |||
5967 | if (!symbol || symbol->has<UnknownDetails>() || | |||
5968 | (generic && &ultimate->owner() == &outer)) { | |||
5969 | if (allowForwardReferenceToDerivedType()) { | |||
5970 | if (!symbol) { | |||
5971 | symbol = &MakeSymbol(outer, name.source, Attrs{}); | |||
5972 | Resolve(name, *symbol); | |||
5973 | } else if (generic) { | |||
5974 | // forward ref to type with later homonymous generic | |||
5975 | symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{}); | |||
5976 | generic->set_derivedType(*symbol); | |||
5977 | name.symbol = symbol; | |||
5978 | } | |||
5979 | DerivedTypeDetails details; | |||
5980 | details.set_isForwardReferenced(true); | |||
5981 | symbol->set_details(std::move(details)); | |||
5982 | } else { // C732 | |||
5983 | Say(name, "Derived type '%s' not found"_err_en_US); | |||
5984 | return std::nullopt; | |||
5985 | } | |||
5986 | } | |||
5987 | if (CheckUseError(name)) { | |||
5988 | return std::nullopt; | |||
5989 | } | |||
5990 | symbol = &symbol->GetUltimate(); | |||
5991 | if (symbol->has<DerivedTypeDetails>()) { | |||
5992 | return DerivedTypeSpec{name.source, *symbol}; | |||
5993 | } else { | |||
5994 | Say(name, "'%s' is not a derived type"_err_en_US); | |||
5995 | return std::nullopt; | |||
5996 | } | |||
5997 | } | |||
5998 | ||||
5999 | std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType( | |||
6000 | const parser::Name &typeName, const parser::Name *extendsName) { | |||
6001 | if (!extendsName) { | |||
6002 | return std::nullopt; | |||
6003 | } else if (typeName.source == extendsName->source) { | |||
6004 | Say(extendsName->source, | |||
6005 | "Derived type '%s' cannot extend itself"_err_en_US); | |||
6006 | return std::nullopt; | |||
6007 | } else { | |||
6008 | return ResolveDerivedType(*extendsName); | |||
6009 | } | |||
6010 | } | |||
6011 | ||||
6012 | Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) { | |||
6013 | // The symbol is checked later by CheckExplicitInterface() and | |||
6014 | // CheckBindings(). It can be a forward reference. | |||
6015 | if (!NameIsKnownOrIntrinsic(name)) { | |||
6016 | Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})}; | |||
6017 | Resolve(name, symbol); | |||
6018 | } | |||
6019 | return name.symbol; | |||
6020 | } | |||
6021 | ||||
6022 | void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) { | |||
6023 | if (const Symbol * symbol{name.symbol}) { | |||
6024 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
6025 | if (!context().HasError(*symbol) && !context().HasError(ultimate) && | |||
6026 | !ultimate.HasExplicitInterface()) { | |||
6027 | Say(name, | |||
6028 | "'%s' must be an abstract interface or a procedure with " | |||
6029 | "an explicit interface"_err_en_US, | |||
6030 | symbol->name()); | |||
6031 | } | |||
6032 | } | |||
6033 | } | |||
6034 | ||||
6035 | // Create a symbol for a type parameter, component, or procedure binding in | |||
6036 | // the current derived type scope. Return false on error. | |||
6037 | Symbol *DeclarationVisitor::MakeTypeSymbol( | |||
6038 | const parser::Name &name, Details &&details) { | |||
6039 | return Resolve(name, MakeTypeSymbol(name.source, std::move(details))); | |||
6040 | } | |||
6041 | Symbol *DeclarationVisitor::MakeTypeSymbol( | |||
6042 | const SourceName &name, Details &&details) { | |||
6043 | Scope &derivedType{currScope()}; | |||
6044 | CHECK(derivedType.IsDerivedType())((derivedType.IsDerivedType()) || (Fortran::common::die("CHECK(" "derivedType.IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6044), false)); | |||
6045 | if (auto *symbol{FindInScope(derivedType, name)}) { // C742 | |||
6046 | Say2(name, | |||
6047 | "Type parameter, component, or procedure binding '%s'" | |||
6048 | " already defined in this type"_err_en_US, | |||
6049 | *symbol, "Previous definition of '%s'"_en_US); | |||
6050 | return nullptr; | |||
6051 | } else { | |||
6052 | auto attrs{GetAttrs()}; | |||
6053 | // Apply binding-private-stmt if present and this is a procedure binding | |||
6054 | if (derivedTypeInfo_.privateBindings && | |||
6055 | !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) && | |||
6056 | std::holds_alternative<ProcBindingDetails>(details)) { | |||
6057 | attrs.set(Attr::PRIVATE); | |||
6058 | } | |||
6059 | Symbol &result{MakeSymbol(name, attrs, std::move(details))}; | |||
6060 | if (result.has<TypeParamDetails>()) { | |||
6061 | derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result); | |||
6062 | } | |||
6063 | return &result; | |||
6064 | } | |||
6065 | } | |||
6066 | ||||
6067 | // Return true if it is ok to declare this component in the current scope. | |||
6068 | // Otherwise, emit an error and return false. | |||
6069 | bool DeclarationVisitor::OkToAddComponent( | |||
6070 | const parser::Name &name, const Symbol *extends) { | |||
6071 | for (const Scope *scope{&currScope()}; scope;) { | |||
6072 | CHECK(scope->IsDerivedType())((scope->IsDerivedType()) || (Fortran::common::die("CHECK(" "scope->IsDerivedType()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6072), false)); | |||
6073 | if (auto *prev{FindInScope(*scope, name.source)}) { | |||
6074 | std::optional<parser::MessageFixedText> msg; | |||
6075 | if (context().HasError(*prev)) { // don't pile on | |||
6076 | } else if (extends) { | |||
6077 | msg = "Type cannot be extended as it has a component named" | |||
6078 | " '%s'"_err_en_US; | |||
6079 | } else if (CheckAccessibleSymbol(currScope(), *prev)) { | |||
6080 | // inaccessible component -- redeclaration is ok | |||
6081 | msg = "Component '%s' is inaccessibly declared in or as a " | |||
6082 | "parent of this derived type"_warn_en_US; | |||
6083 | } else if (prev->test(Symbol::Flag::ParentComp)) { | |||
6084 | msg = "'%s' is a parent type of this type and so cannot be" | |||
6085 | " a component"_err_en_US; | |||
6086 | } else if (scope == &currScope()) { | |||
6087 | msg = "Component '%s' is already declared in this" | |||
6088 | " derived type"_err_en_US; | |||
6089 | } else { | |||
6090 | msg = "Component '%s' is already declared in a parent of this" | |||
6091 | " derived type"_err_en_US; | |||
6092 | } | |||
6093 | if (msg) { | |||
6094 | Say2( | |||
6095 | name, std::move(*msg), *prev, "Previous declaration of '%s'"_en_US); | |||
6096 | if (msg->severity() == parser::Severity::Error) { | |||
6097 | Resolve(name, *prev); | |||
6098 | return false; | |||
6099 | } | |||
6100 | } | |||
6101 | } | |||
6102 | if (scope == &currScope() && extends) { | |||
6103 | // The parent component has not yet been added to the scope. | |||
6104 | scope = extends->scope(); | |||
6105 | } else { | |||
6106 | scope = scope->GetDerivedTypeParent(); | |||
6107 | } | |||
6108 | } | |||
6109 | return true; | |||
6110 | } | |||
6111 | ||||
6112 | ParamValue DeclarationVisitor::GetParamValue( | |||
6113 | const parser::TypeParamValue &x, common::TypeParamAttr attr) { | |||
6114 | return common::visit( | |||
6115 | common::visitors{ | |||
6116 | [=](const parser::ScalarIntExpr &x) { // C704 | |||
6117 | return ParamValue{EvaluateIntExpr(x), attr}; | |||
6118 | }, | |||
6119 | [=](const parser::Star &) { return ParamValue::Assumed(attr); }, | |||
6120 | [=](const parser::TypeParamValue::Deferred &) { | |||
6121 | return ParamValue::Deferred(attr); | |||
6122 | }, | |||
6123 | }, | |||
6124 | x.u); | |||
6125 | } | |||
6126 | ||||
6127 | // ConstructVisitor implementation | |||
6128 | ||||
6129 | void ConstructVisitor::ResolveIndexName( | |||
6130 | const parser::ConcurrentControl &control) { | |||
6131 | const parser::Name &name{std::get<parser::Name>(control.t)}; | |||
6132 | auto *prev{FindSymbol(name)}; | |||
6133 | if (prev) { | |||
6134 | if (prev->owner().kind() == Scope::Kind::Forall || | |||
6135 | prev->owner() == currScope()) { | |||
6136 | SayAlreadyDeclared(name, *prev); | |||
6137 | return; | |||
6138 | } | |||
6139 | name.symbol = nullptr; | |||
6140 | } | |||
6141 | auto &symbol{DeclareObjectEntity(name)}; | |||
6142 | if (symbol.GetType()) { | |||
6143 | // type came from explicit type-spec | |||
6144 | } else if (!prev) { | |||
6145 | ApplyImplicitRules(symbol); | |||
6146 | } else { | |||
6147 | const Symbol &prevRoot{prev->GetUltimate()}; | |||
6148 | // prev could be host- use- or construct-associated with another symbol | |||
6149 | if (!prevRoot.has<ObjectEntityDetails>() && | |||
6150 | !prevRoot.has<AssocEntityDetails>()) { | |||
6151 | Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US, | |||
6152 | *prev, "Previous declaration of '%s'"_en_US); | |||
6153 | context().SetError(symbol); | |||
6154 | return; | |||
6155 | } else { | |||
6156 | if (const auto *type{prevRoot.GetType()}) { | |||
6157 | symbol.SetType(*type); | |||
6158 | } | |||
6159 | if (prevRoot.IsObjectArray()) { | |||
6160 | SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US); | |||
6161 | return; | |||
6162 | } | |||
6163 | } | |||
6164 | } | |||
6165 | EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}}); | |||
6166 | } | |||
6167 | ||||
6168 | // We need to make sure that all of the index-names get declared before the | |||
6169 | // expressions in the loop control are evaluated so that references to the | |||
6170 | // index-names in the expressions are correctly detected. | |||
6171 | bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) { | |||
6172 | BeginDeclTypeSpec(); | |||
6173 | Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t)); | |||
6174 | const auto &controls{ | |||
6175 | std::get<std::list<parser::ConcurrentControl>>(header.t)}; | |||
6176 | for (const auto &control : controls) { | |||
6177 | ResolveIndexName(control); | |||
6178 | } | |||
6179 | Walk(controls); | |||
6180 | Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)); | |||
6181 | EndDeclTypeSpec(); | |||
6182 | return false; | |||
6183 | } | |||
6184 | ||||
6185 | bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) { | |||
6186 | for (auto &name : x.v) { | |||
6187 | if (auto *symbol{DeclareLocalEntity(name)}) { | |||
6188 | symbol->set(Symbol::Flag::LocalityLocal); | |||
6189 | } | |||
6190 | } | |||
6191 | return false; | |||
6192 | } | |||
6193 | ||||
6194 | bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) { | |||
6195 | for (auto &name : x.v) { | |||
6196 | if (auto *symbol{DeclareLocalEntity(name)}) { | |||
6197 | symbol->set(Symbol::Flag::LocalityLocalInit); | |||
6198 | } | |||
6199 | } | |||
6200 | return false; | |||
6201 | } | |||
6202 | ||||
6203 | bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) { | |||
6204 | for (const auto &name : x.v) { | |||
6205 | if (!FindSymbol(name)) { | |||
6206 | Say(name, | |||
6207 | "Variable '%s' with SHARED locality implicitly declared"_warn_en_US); | |||
6208 | } | |||
6209 | Symbol &prev{FindOrDeclareEnclosingEntity(name)}; | |||
6210 | if (PassesSharedLocalityChecks(name, prev)) { | |||
6211 | MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared); | |||
6212 | } | |||
6213 | } | |||
6214 | return false; | |||
6215 | } | |||
6216 | ||||
6217 | bool ConstructVisitor::Pre(const parser::AcSpec &x) { | |||
6218 | ProcessTypeSpec(x.type); | |||
6219 | Walk(x.values); | |||
6220 | return false; | |||
6221 | } | |||
6222 | ||||
6223 | // Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the | |||
6224 | // enclosing ac-implied-do | |||
6225 | bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) { | |||
6226 | auto &values{std::get<std::list<parser::AcValue>>(x.t)}; | |||
6227 | auto &control{std::get<parser::AcImpliedDoControl>(x.t)}; | |||
6228 | auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)}; | |||
6229 | auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)}; | |||
6230 | // F'2018 has the scope of the implied DO variable covering the entire | |||
6231 | // implied DO production (19.4(5)), which seems wrong in cases where the name | |||
6232 | // of the implied DO variable appears in one of the bound expressions. Thus | |||
6233 | // this extension, which shrinks the scope of the variable to exclude the | |||
6234 | // expressions in the bounds. | |||
6235 | auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)}; | |||
6236 | Walk(bounds.lower); | |||
6237 | Walk(bounds.upper); | |||
6238 | Walk(bounds.step); | |||
6239 | EndCheckOnIndexUseInOwnBounds(restore); | |||
6240 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6241 | DeclareStatementEntity(bounds.name, type); | |||
6242 | Walk(values); | |||
6243 | PopScope(); | |||
6244 | return false; | |||
6245 | } | |||
6246 | ||||
6247 | bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { | |||
6248 | auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)}; | |||
6249 | auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)}; | |||
6250 | auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)}; | |||
6251 | // See comment in Pre(AcImpliedDo) above. | |||
6252 | auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)}; | |||
6253 | Walk(bounds.lower); | |||
6254 | Walk(bounds.upper); | |||
6255 | Walk(bounds.step); | |||
6256 | EndCheckOnIndexUseInOwnBounds(restore); | |||
6257 | bool pushScope{currScope().kind() != Scope::Kind::ImpliedDos}; | |||
6258 | if (pushScope) { | |||
6259 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6260 | } | |||
6261 | DeclareStatementEntity(bounds.name, type); | |||
6262 | Walk(objects); | |||
6263 | if (pushScope) { | |||
6264 | PopScope(); | |||
6265 | } | |||
6266 | return false; | |||
6267 | } | |||
6268 | ||||
6269 | // Sets InDataStmt flag on a variable (or misidentified function) in a DATA | |||
6270 | // statement so that the predicate IsInitialized() will be true | |||
6271 | // during semantic analysis before the symbol's initializer is constructed. | |||
6272 | bool ConstructVisitor::Pre(const parser::DataIDoObject &x) { | |||
6273 | common::visit( | |||
6274 | common::visitors{ | |||
6275 | [&](const parser::Scalar<Indirection<parser::Designator>> &y) { | |||
6276 | Walk(y.thing.value()); | |||
6277 | const parser::Name &first{parser::GetFirstName(y.thing.value())}; | |||
6278 | if (first.symbol) { | |||
6279 | first.symbol->set(Symbol::Flag::InDataStmt); | |||
6280 | } | |||
6281 | }, | |||
6282 | [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); }, | |||
6283 | }, | |||
6284 | x.u); | |||
6285 | return false; | |||
6286 | } | |||
6287 | ||||
6288 | bool ConstructVisitor::Pre(const parser::DataStmtObject &x) { | |||
6289 | // Subtle: DATA statements may appear in both the specification and | |||
6290 | // execution parts, but should be treated as if in the execution part | |||
6291 | // for purposes of implicit variable declaration vs. host association. | |||
6292 | // When a name first appears as an object in a DATA statement, it should | |||
6293 | // be implicitly declared locally as if it had been assigned. | |||
6294 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)}; | |||
6295 | common::visit(common::visitors{ | |||
6296 | [&](const Indirection<parser::Variable> &y) { | |||
6297 | Walk(y.value()); | |||
6298 | const parser::Name &first{ | |||
6299 | parser::GetFirstName(y.value())}; | |||
6300 | if (first.symbol) { | |||
6301 | first.symbol->set(Symbol::Flag::InDataStmt); | |||
6302 | } | |||
6303 | }, | |||
6304 | [&](const parser::DataImpliedDo &y) { | |||
6305 | PushScope(Scope::Kind::ImpliedDos, nullptr); | |||
6306 | Walk(y); | |||
6307 | PopScope(); | |||
6308 | }, | |||
6309 | }, | |||
6310 | x.u); | |||
6311 | return false; | |||
6312 | } | |||
6313 | ||||
6314 | bool ConstructVisitor::Pre(const parser::DataStmtValue &x) { | |||
6315 | const auto &data{std::get<parser::DataStmtConstant>(x.t)}; | |||
6316 | auto &mutableData{const_cast<parser::DataStmtConstant &>(data)}; | |||
6317 | if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) { | |||
6318 | if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) { | |||
6319 | if (const Symbol * symbol{FindSymbol(*name)}) { | |||
6320 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
6321 | if (ultimate.has<DerivedTypeDetails>()) { | |||
6322 | mutableData.u = elem->ConvertToStructureConstructor( | |||
6323 | DerivedTypeSpec{name->source, ultimate}); | |||
6324 | } | |||
6325 | } | |||
6326 | } | |||
6327 | } | |||
6328 | return true; | |||
6329 | } | |||
6330 | ||||
6331 | bool ConstructVisitor::Pre(const parser::DoConstruct &x) { | |||
6332 | if (x.IsDoConcurrent()) { | |||
6333 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6334 | } | |||
6335 | return true; | |||
6336 | } | |||
6337 | void ConstructVisitor::Post(const parser::DoConstruct &x) { | |||
6338 | if (x.IsDoConcurrent()) { | |||
6339 | PopScope(); | |||
6340 | } | |||
6341 | } | |||
6342 | ||||
6343 | bool ConstructVisitor::Pre(const parser::ForallConstruct &) { | |||
6344 | PushScope(Scope::Kind::Forall, nullptr); | |||
6345 | return true; | |||
6346 | } | |||
6347 | void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); } | |||
6348 | bool ConstructVisitor::Pre(const parser::ForallStmt &) { | |||
6349 | PushScope(Scope::Kind::Forall, nullptr); | |||
6350 | return true; | |||
6351 | } | |||
6352 | void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); } | |||
6353 | ||||
6354 | bool ConstructVisitor::Pre(const parser::BlockStmt &x) { | |||
6355 | CheckDef(x.v); | |||
6356 | PushScope(Scope::Kind::BlockConstruct, nullptr); | |||
6357 | return false; | |||
6358 | } | |||
6359 | bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) { | |||
6360 | PopScope(); | |||
6361 | CheckRef(x.v); | |||
6362 | return false; | |||
6363 | } | |||
6364 | ||||
6365 | void ConstructVisitor::Post(const parser::Selector &x) { | |||
6366 | GetCurrentAssociation().selector = ResolveSelector(x); | |||
6367 | } | |||
6368 | ||||
6369 | void ConstructVisitor::Post(const parser::AssociateStmt &x) { | |||
6370 | CheckDef(x.t); | |||
6371 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6372 | const auto assocCount{std::get<std::list<parser::Association>>(x.t).size()}; | |||
6373 | for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) { | |||
6374 | SetCurrentAssociation(nthLastAssoc); | |||
6375 | if (auto *symbol{MakeAssocEntity()}) { | |||
6376 | if (ExtractCoarrayRef(GetCurrentAssociation().selector.expr)) { // C1103 | |||
6377 | Say("Selector must not be a coindexed object"_err_en_US); | |||
6378 | } | |||
6379 | SetTypeFromAssociation(*symbol); | |||
6380 | SetAttrsFromAssociation(*symbol); | |||
6381 | } | |||
6382 | } | |||
6383 | PopAssociation(assocCount); | |||
6384 | } | |||
6385 | ||||
6386 | void ConstructVisitor::Post(const parser::EndAssociateStmt &x) { | |||
6387 | PopScope(); | |||
6388 | CheckRef(x.v); | |||
6389 | } | |||
6390 | ||||
6391 | bool ConstructVisitor::Pre(const parser::Association &x) { | |||
6392 | PushAssociation(); | |||
6393 | const auto &name{std::get<parser::Name>(x.t)}; | |||
6394 | GetCurrentAssociation().name = &name; | |||
6395 | return true; | |||
6396 | } | |||
6397 | ||||
6398 | bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) { | |||
6399 | CheckDef(x.t); | |||
6400 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6401 | PushAssociation(); | |||
6402 | return true; | |||
6403 | } | |||
6404 | ||||
6405 | void ConstructVisitor::Post(const parser::CoarrayAssociation &x) { | |||
6406 | const auto &decl{std::get<parser::CodimensionDecl>(x.t)}; | |||
6407 | const auto &name{std::get<parser::Name>(decl.t)}; | |||
6408 | if (auto *symbol{FindInScope(name)}) { | |||
6409 | const auto &selector{std::get<parser::Selector>(x.t)}; | |||
6410 | if (auto sel{ResolveSelector(selector)}) { | |||
6411 | const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)}; | |||
6412 | if (!whole || whole->Corank() == 0) { | |||
6413 | Say(sel.source, // C1116 | |||
6414 | "Selector in coarray association must name a coarray"_err_en_US); | |||
6415 | } else if (auto dynType{sel.expr->GetType()}) { | |||
6416 | if (!symbol->GetType()) { | |||
6417 | symbol->SetType(ToDeclTypeSpec(std::move(*dynType))); | |||
6418 | } | |||
6419 | } | |||
6420 | } | |||
6421 | } | |||
6422 | } | |||
6423 | ||||
6424 | void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) { | |||
6425 | PopAssociation(); | |||
6426 | PopScope(); | |||
6427 | CheckRef(x.t); | |||
6428 | } | |||
6429 | ||||
6430 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) { | |||
6431 | PushAssociation(); | |||
6432 | return true; | |||
6433 | } | |||
6434 | ||||
6435 | void ConstructVisitor::Post(const parser::SelectTypeConstruct &) { | |||
6436 | PopAssociation(); | |||
6437 | } | |||
6438 | ||||
6439 | void ConstructVisitor::Post(const parser::SelectTypeStmt &x) { | |||
6440 | auto &association{GetCurrentAssociation()}; | |||
6441 | if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { | |||
6442 | // This isn't a name in the current scope, it is in each TypeGuardStmt | |||
6443 | MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName); | |||
6444 | association.name = &*name; | |||
6445 | if (ExtractCoarrayRef(association.selector.expr)) { // C1103 | |||
6446 | Say("Selector must not be a coindexed object"_err_en_US); | |||
6447 | } | |||
6448 | if (association.selector.expr) { | |||
6449 | auto exprType{association.selector.expr->GetType()}; | |||
6450 | if (exprType && !exprType->IsPolymorphic()) { // C1159 | |||
6451 | Say(association.selector.source, | |||
6452 | "Selector '%s' in SELECT TYPE statement must be " | |||
6453 | "polymorphic"_err_en_US); | |||
6454 | } | |||
6455 | } | |||
6456 | } else { | |||
6457 | if (const Symbol * | |||
6458 | whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { | |||
6459 | ConvertToObjectEntity(const_cast<Symbol &>(*whole)); | |||
6460 | if (!IsVariableName(*whole)) { | |||
6461 | Say(association.selector.source, // C901 | |||
6462 | "Selector is not a variable"_err_en_US); | |||
6463 | association = {}; | |||
6464 | } | |||
6465 | if (const DeclTypeSpec * type{whole->GetType()}) { | |||
6466 | if (!type->IsPolymorphic()) { // C1159 | |||
6467 | Say(association.selector.source, | |||
6468 | "Selector '%s' in SELECT TYPE statement must be " | |||
6469 | "polymorphic"_err_en_US); | |||
6470 | } | |||
6471 | } | |||
6472 | } else { | |||
6473 | Say(association.selector.source, // C1157 | |||
6474 | "Selector is not a named variable: 'associate-name =>' is required"_err_en_US); | |||
6475 | association = {}; | |||
6476 | } | |||
6477 | } | |||
6478 | } | |||
6479 | ||||
6480 | void ConstructVisitor::Post(const parser::SelectRankStmt &x) { | |||
6481 | auto &association{GetCurrentAssociation()}; | |||
6482 | if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { | |||
6483 | // This isn't a name in the current scope, it is in each SelectRankCaseStmt | |||
6484 | MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName); | |||
6485 | association.name = &*name; | |||
6486 | } | |||
6487 | } | |||
6488 | ||||
6489 | bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) { | |||
6490 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6491 | return true; | |||
6492 | } | |||
6493 | void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) { | |||
6494 | PopScope(); | |||
6495 | } | |||
6496 | ||||
6497 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) { | |||
6498 | PushScope(Scope::Kind::OtherConstruct, nullptr); | |||
6499 | return true; | |||
6500 | } | |||
6501 | void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) { | |||
6502 | PopScope(); | |||
6503 | } | |||
6504 | ||||
6505 | bool ConstructVisitor::Pre(const parser::TypeGuardStmt::Guard &x) { | |||
6506 | if (std::holds_alternative<parser::DerivedTypeSpec>(x.u)) { | |||
6507 | // CLASS IS (t) | |||
6508 | SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); | |||
6509 | } | |||
6510 | return true; | |||
6511 | } | |||
6512 | ||||
6513 | void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) { | |||
6514 | if (auto *symbol{MakeAssocEntity()}) { | |||
6515 | if (std::holds_alternative<parser::Default>(x.u)) { | |||
6516 | SetTypeFromAssociation(*symbol); | |||
6517 | } else if (const auto *type{GetDeclTypeSpec()}) { | |||
6518 | symbol->SetType(*type); | |||
6519 | } | |||
6520 | SetAttrsFromAssociation(*symbol); | |||
6521 | } | |||
6522 | } | |||
6523 | ||||
6524 | void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) { | |||
6525 | if (auto *symbol{MakeAssocEntity()}) { | |||
6526 | SetTypeFromAssociation(*symbol); | |||
6527 | SetAttrsFromAssociation(*symbol); | |||
6528 | if (const auto *init{std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) { | |||
6529 | if (auto val{EvaluateInt64(context(), *init)}) { | |||
6530 | auto &details{symbol->get<AssocEntityDetails>()}; | |||
6531 | details.set_rank(*val); | |||
6532 | } | |||
6533 | } | |||
6534 | } | |||
6535 | } | |||
6536 | ||||
6537 | bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) { | |||
6538 | PushAssociation(); | |||
6539 | return true; | |||
6540 | } | |||
6541 | ||||
6542 | void ConstructVisitor::Post(const parser::SelectRankConstruct &) { | |||
6543 | PopAssociation(); | |||
6544 | } | |||
6545 | ||||
6546 | bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) { | |||
6547 | if (x && !x->symbol) { | |||
6548 | // Construct names are not scoped by BLOCK in the standard, but many, | |||
6549 | // but not all, compilers do treat them as if they were so scoped. | |||
6550 | if (Symbol * inner{FindInScope(currScope(), *x)}) { | |||
6551 | SayAlreadyDeclared(*x, *inner); | |||
6552 | } else { | |||
6553 | if (Symbol * | |||
6554 | other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) { | |||
6555 | SayWithDecl(*x, *other, | |||
6556 | "The construct name '%s' should be distinct at the subprogram level"_port_en_US); | |||
6557 | } | |||
6558 | MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); | |||
6559 | } | |||
6560 | } | |||
6561 | return true; | |||
6562 | } | |||
6563 | ||||
6564 | void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) { | |||
6565 | if (x) { | |||
6566 | // Just add an occurrence of this name; checking is done in ValidateLabels | |||
6567 | FindSymbol(*x); | |||
6568 | } | |||
6569 | } | |||
6570 | ||||
6571 | // Make a symbol for the associating entity of the current association. | |||
6572 | Symbol *ConstructVisitor::MakeAssocEntity() { | |||
6573 | Symbol *symbol{nullptr}; | |||
6574 | auto &association{GetCurrentAssociation()}; | |||
6575 | if (association.name) { | |||
6576 | symbol = &MakeSymbol(*association.name, UnknownDetails{}); | |||
6577 | if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) { | |||
6578 | Say(*association.name, // C1102 | |||
6579 | "The associate name '%s' is already used in this associate statement"_err_en_US); | |||
6580 | return nullptr; | |||
6581 | } | |||
6582 | } else if (const Symbol * | |||
6583 | whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { | |||
6584 | symbol = &MakeSymbol(whole->name()); | |||
6585 | } else { | |||
6586 | return nullptr; | |||
6587 | } | |||
6588 | if (auto &expr{association.selector.expr}) { | |||
6589 | symbol->set_details(AssocEntityDetails{common::Clone(*expr)}); | |||
6590 | } else { | |||
6591 | symbol->set_details(AssocEntityDetails{}); | |||
6592 | } | |||
6593 | return symbol; | |||
6594 | } | |||
6595 | ||||
6596 | // Set the type of symbol based on the current association selector. | |||
6597 | void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) { | |||
6598 | auto &details{symbol.get<AssocEntityDetails>()}; | |||
6599 | const MaybeExpr *pexpr{&details.expr()}; | |||
6600 | if (!*pexpr) { | |||
6601 | pexpr = &GetCurrentAssociation().selector.expr; | |||
6602 | } | |||
6603 | if (*pexpr) { | |||
6604 | const SomeExpr &expr{**pexpr}; | |||
6605 | if (std::optional<evaluate::DynamicType> type{expr.GetType()}) { | |||
6606 | if (const auto *charExpr{ | |||
6607 | evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>( | |||
6608 | expr)}) { | |||
6609 | symbol.SetType(ToDeclTypeSpec(std::move(*type), | |||
6610 | FoldExpr(common::visit( | |||
6611 | [](const auto &kindChar) { return kindChar.LEN(); }, | |||
6612 | charExpr->u)))); | |||
6613 | } else { | |||
6614 | symbol.SetType(ToDeclTypeSpec(std::move(*type))); | |||
6615 | } | |||
6616 | } else { | |||
6617 | // BOZ literals, procedure designators, &c. are not acceptable | |||
6618 | Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US); | |||
6619 | } | |||
6620 | } | |||
6621 | } | |||
6622 | ||||
6623 | // If current selector is a variable, set some of its attributes on symbol. | |||
6624 | void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) { | |||
6625 | Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)}; | |||
6626 | symbol.attrs() |= | |||
6627 | attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE}; | |||
6628 | if (attrs.test(Attr::POINTER)) { | |||
6629 | SetImplicitAttr(symbol, Attr::TARGET); | |||
6630 | } | |||
6631 | } | |||
6632 | ||||
6633 | ConstructVisitor::Selector ConstructVisitor::ResolveSelector( | |||
6634 | const parser::Selector &x) { | |||
6635 | return common::visit(common::visitors{ | |||
6636 | [&](const parser::Expr &expr) { | |||
6637 | return Selector{expr.source, EvaluateExpr(x)}; | |||
6638 | }, | |||
6639 | [&](const parser::Variable &var) { | |||
6640 | return Selector{var.GetSource(), EvaluateExpr(x)}; | |||
6641 | }, | |||
6642 | }, | |||
6643 | x.u); | |||
6644 | } | |||
6645 | ||||
6646 | // Set the current association to the nth to the last association on the | |||
6647 | // association stack. The top of the stack is at n = 1. This allows access | |||
6648 | // to the interior of a list of associations at the top of the stack. | |||
6649 | void ConstructVisitor::SetCurrentAssociation(std::size_t n) { | |||
6650 | CHECK(n > 0 && n <= associationStack_.size())((n > 0 && n <= associationStack_.size()) || (Fortran ::common::die("CHECK(" "n > 0 && n <= associationStack_.size()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6650), false)); | |||
6651 | currentAssociation_ = &associationStack_[associationStack_.size() - n]; | |||
6652 | } | |||
6653 | ||||
6654 | ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() { | |||
6655 | CHECK(currentAssociation_)((currentAssociation_) || (Fortran::common::die("CHECK(" "currentAssociation_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6655), false)); | |||
6656 | return *currentAssociation_; | |||
6657 | } | |||
6658 | ||||
6659 | void ConstructVisitor::PushAssociation() { | |||
6660 | associationStack_.emplace_back(Association{}); | |||
6661 | currentAssociation_ = &associationStack_.back(); | |||
6662 | } | |||
6663 | ||||
6664 | void ConstructVisitor::PopAssociation(std::size_t count) { | |||
6665 | CHECK(count > 0 && count <= associationStack_.size())((count > 0 && count <= associationStack_.size( )) || (Fortran::common::die("CHECK(" "count > 0 && count <= associationStack_.size()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6665), false)); | |||
6666 | associationStack_.resize(associationStack_.size() - count); | |||
6667 | currentAssociation_ = | |||
6668 | associationStack_.empty() ? nullptr : &associationStack_.back(); | |||
6669 | } | |||
6670 | ||||
6671 | const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( | |||
6672 | evaluate::DynamicType &&type) { | |||
6673 | switch (type.category()) { | |||
6674 | SWITCH_COVERS_ALL_CASES | |||
6675 | case common::TypeCategory::Integer: | |||
6676 | case common::TypeCategory::Real: | |||
6677 | case common::TypeCategory::Complex: | |||
6678 | return context().MakeNumericType(type.category(), type.kind()); | |||
6679 | case common::TypeCategory::Logical: | |||
6680 | return context().MakeLogicalType(type.kind()); | |||
6681 | case common::TypeCategory::Derived: | |||
6682 | if (type.IsAssumedType()) { | |||
6683 | return currScope().MakeTypeStarType(); | |||
6684 | } else if (type.IsUnlimitedPolymorphic()) { | |||
6685 | return currScope().MakeClassStarType(); | |||
6686 | } else { | |||
6687 | return currScope().MakeDerivedType( | |||
6688 | type.IsPolymorphic() ? DeclTypeSpec::ClassDerived | |||
6689 | : DeclTypeSpec::TypeDerived, | |||
6690 | common::Clone(type.GetDerivedTypeSpec()) | |||
6691 | ||||
6692 | ); | |||
6693 | } | |||
6694 | case common::TypeCategory::Character: | |||
6695 | CRASH_NO_CASEFortran::common::die("no case" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 6695); | |||
6696 | } | |||
6697 | } | |||
6698 | ||||
6699 | const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( | |||
6700 | evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) { | |||
6701 | CHECK(type.category() == common::TypeCategory::Character)((type.category() == common::TypeCategory::Character) || (Fortran ::common::die("CHECK(" "type.category() == common::TypeCategory::Character" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 6701), false)); | |||
6702 | if (length) { | |||
6703 | return currScope().MakeCharacterType( | |||
6704 | ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len}, | |||
6705 | KindExpr{type.kind()}); | |||
6706 | } else { | |||
6707 | return currScope().MakeCharacterType( | |||
6708 | ParamValue::Deferred(common::TypeParamAttr::Len), | |||
6709 | KindExpr{type.kind()}); | |||
6710 | } | |||
6711 | } | |||
6712 | ||||
6713 | // ResolveNamesVisitor implementation | |||
6714 | ||||
6715 | bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) { | |||
6716 | HandleCall(Symbol::Flag::Function, x.v); | |||
6717 | return false; | |||
6718 | } | |||
6719 | bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) { | |||
6720 | HandleCall(Symbol::Flag::Subroutine, x.v); | |||
6721 | return false; | |||
6722 | } | |||
6723 | ||||
6724 | bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) { | |||
6725 | auto &scope{currScope()}; | |||
6726 | // Check C896 and C899: where IMPORT statements are allowed | |||
6727 | switch (scope.kind()) { | |||
6728 | case Scope::Kind::Module: | |||
6729 | if (scope.IsModule()) { | |||
6730 | Say("IMPORT is not allowed in a module scoping unit"_err_en_US); | |||
6731 | return false; | |||
6732 | } else if (x.kind == common::ImportKind::None) { | |||
6733 | Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US); | |||
6734 | return false; | |||
6735 | } | |||
6736 | break; | |||
6737 | case Scope::Kind::MainProgram: | |||
6738 | Say("IMPORT is not allowed in a main program scoping unit"_err_en_US); | |||
6739 | return false; | |||
6740 | case Scope::Kind::Subprogram: | |||
6741 | if (scope.parent().IsGlobal()) { | |||
6742 | Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US); | |||
6743 | return false; | |||
6744 | } | |||
6745 | break; | |||
6746 | case Scope::Kind::BlockData: // C1415 (in part) | |||
6747 | Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US); | |||
6748 | return false; | |||
6749 | default:; | |||
6750 | } | |||
6751 | if (auto error{scope.SetImportKind(x.kind)}) { | |||
6752 | Say(std::move(*error)); | |||
6753 | } | |||
6754 | for (auto &name : x.names) { | |||
6755 | if (Symbol * outer{FindSymbol(scope.parent(), name)}) { | |||
6756 | scope.add_importName(name.source); | |||
6757 | if (Symbol * symbol{FindInScope(name)}) { | |||
6758 | if (outer->GetUltimate() == symbol->GetUltimate()) { | |||
6759 | Say(name, | |||
6760 | "The same '%s' is already present in this scope"_port_en_US); | |||
6761 | } else { | |||
6762 | Say(name, | |||
6763 | "A distinct '%s' is already present in this scope"_err_en_US) | |||
6764 | .Attach(symbol->name(), "Previous declaration of '%s'"_en_US) | |||
6765 | .Attach(outer->name(), "Declaration of '%s' in host scope"_en_US); | |||
6766 | } | |||
6767 | } | |||
6768 | } else { | |||
6769 | Say(name, "'%s' not found in host scope"_err_en_US); | |||
6770 | } | |||
6771 | } | |||
6772 | prevImportStmt_ = currStmtSource(); | |||
6773 | return false; | |||
6774 | } | |||
6775 | ||||
6776 | const parser::Name *DeclarationVisitor::ResolveStructureComponent( | |||
6777 | const parser::StructureComponent &x) { | |||
6778 | return FindComponent(ResolveDataRef(x.base), x.component); | |||
6779 | } | |||
6780 | ||||
6781 | const parser::Name *DeclarationVisitor::ResolveDesignator( | |||
6782 | const parser::Designator &x) { | |||
6783 | return common::visit( | |||
6784 | common::visitors{ | |||
6785 | [&](const parser::DataRef &x) { return ResolveDataRef(x); }, | |||
6786 | [&](const parser::Substring &x) { | |||
6787 | Walk(std::get<parser::SubstringRange>(x.t).t); | |||
6788 | return ResolveDataRef(std::get<parser::DataRef>(x.t)); | |||
6789 | }, | |||
6790 | }, | |||
6791 | x.u); | |||
6792 | } | |||
6793 | ||||
6794 | const parser::Name *DeclarationVisitor::ResolveDataRef( | |||
6795 | const parser::DataRef &x) { | |||
6796 | return common::visit( | |||
6797 | common::visitors{ | |||
6798 | [=](const parser::Name &y) { return ResolveName(y); }, | |||
6799 | [=](const Indirection<parser::StructureComponent> &y) { | |||
6800 | return ResolveStructureComponent(y.value()); | |||
6801 | }, | |||
6802 | [&](const Indirection<parser::ArrayElement> &y) { | |||
6803 | Walk(y.value().subscripts); | |||
6804 | const parser::Name *name{ResolveDataRef(y.value().base)}; | |||
6805 | if (name && name->symbol) { | |||
6806 | if (!IsProcedure(*name->symbol)) { | |||
6807 | ConvertToObjectEntity(*name->symbol); | |||
6808 | } else if (!context().HasError(*name->symbol)) { | |||
6809 | SayWithDecl(*name, *name->symbol, | |||
6810 | "Cannot reference function '%s' as data"_err_en_US); | |||
6811 | } | |||
6812 | } | |||
6813 | return name; | |||
6814 | }, | |||
6815 | [&](const Indirection<parser::CoindexedNamedObject> &y) { | |||
6816 | Walk(y.value().imageSelector); | |||
6817 | return ResolveDataRef(y.value().base); | |||
6818 | }, | |||
6819 | }, | |||
6820 | x.u); | |||
6821 | } | |||
6822 | ||||
6823 | // If implicit types are allowed, ensure name is in the symbol table. | |||
6824 | // Otherwise, report an error if it hasn't been declared. | |||
6825 | const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) { | |||
6826 | FindSymbol(name); | |||
6827 | if (CheckForHostAssociatedImplicit(name)) { | |||
6828 | NotePossibleBadForwardRef(name); | |||
6829 | return &name; | |||
6830 | } | |||
6831 | if (Symbol * symbol{name.symbol}) { | |||
6832 | if (CheckUseError(name)) { | |||
6833 | return nullptr; // reported an error | |||
6834 | } | |||
6835 | NotePossibleBadForwardRef(name); | |||
6836 | symbol->set(Symbol::Flag::ImplicitOrError, false); | |||
6837 | if (IsUplevelReference(*symbol)) { | |||
6838 | MakeHostAssocSymbol(name, *symbol); | |||
6839 | } else if (IsDummy(*symbol) || | |||
6840 | (!symbol->GetType() && FindCommonBlockContaining(*symbol))) { | |||
6841 | CheckEntryDummyUse(name.source, symbol); | |||
6842 | ConvertToObjectEntity(*symbol); | |||
6843 | ApplyImplicitRules(*symbol); | |||
6844 | } | |||
6845 | if (checkIndexUseInOwnBounds_ && | |||
6846 | *checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) { | |||
6847 | Say(name, | |||
6848 | "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US, | |||
6849 | name.source); | |||
6850 | } | |||
6851 | return &name; | |||
6852 | } | |||
6853 | if (isImplicitNoneType()) { | |||
6854 | Say(name, "No explicit type declared for '%s'"_err_en_US); | |||
6855 | return nullptr; | |||
6856 | } | |||
6857 | // Create the symbol then ensure it is accessible | |||
6858 | if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) { | |||
6859 | Say(name, | |||
6860 | "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US, | |||
6861 | name.source); | |||
6862 | } | |||
6863 | MakeSymbol(InclusiveScope(), name.source, Attrs{}); | |||
6864 | auto *symbol{FindSymbol(name)}; | |||
6865 | if (!symbol) { | |||
6866 | Say(name, | |||
6867 | "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US); | |||
6868 | return nullptr; | |||
6869 | } | |||
6870 | ConvertToObjectEntity(*symbol); | |||
6871 | ApplyImplicitRules(*symbol); | |||
6872 | NotePossibleBadForwardRef(name); | |||
6873 | return &name; | |||
6874 | } | |||
6875 | ||||
6876 | // A specification expression may refer to a symbol in the host procedure that | |||
6877 | // is implicitly typed. Because specification parts are processed before | |||
6878 | // execution parts, this may be the first time we see the symbol. It can't be a | |||
6879 | // local in the current scope (because it's in a specification expression) so | |||
6880 | // either it is implicitly declared in the host procedure or it is an error. | |||
6881 | // We create a symbol in the host assuming it is the former; if that proves to | |||
6882 | // be wrong we report an error later in CheckDeclarations(). | |||
6883 | bool DeclarationVisitor::CheckForHostAssociatedImplicit( | |||
6884 | const parser::Name &name) { | |||
6885 | if (!inSpecificationPart_) { | |||
6886 | return false; | |||
6887 | } | |||
6888 | if (name.symbol) { | |||
6889 | ApplyImplicitRules(*name.symbol, true); | |||
6890 | } | |||
6891 | Symbol *hostSymbol; | |||
6892 | Scope *host{GetHostProcedure()}; | |||
6893 | if (!host || isImplicitNoneType(*host)) { | |||
6894 | return false; | |||
6895 | } | |||
6896 | if (!name.symbol) { | |||
6897 | hostSymbol = &MakeSymbol(*host, name.source, Attrs{}); | |||
6898 | ConvertToObjectEntity(*hostSymbol); | |||
6899 | ApplyImplicitRules(*hostSymbol); | |||
6900 | hostSymbol->set(Symbol::Flag::ImplicitOrError); | |||
6901 | } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) { | |||
6902 | hostSymbol = name.symbol; | |||
6903 | } else { | |||
6904 | return false; | |||
6905 | } | |||
6906 | Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)}; | |||
6907 | if (isImplicitNoneType()) { | |||
6908 | symbol.get<HostAssocDetails>().implicitOrExplicitTypeError = true; | |||
6909 | } else { | |||
6910 | symbol.get<HostAssocDetails>().implicitOrSpecExprError = true; | |||
6911 | } | |||
6912 | return true; | |||
6913 | } | |||
6914 | ||||
6915 | bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) { | |||
6916 | const Scope &symbolUnit{GetProgramUnitContaining(symbol)}; | |||
6917 | if (symbolUnit == GetProgramUnitContaining(currScope())) { | |||
6918 | return false; | |||
6919 | } else { | |||
6920 | Scope::Kind kind{symbolUnit.kind()}; | |||
6921 | return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram; | |||
6922 | } | |||
6923 | } | |||
6924 | ||||
6925 | // base is a part-ref of a derived type; find the named component in its type. | |||
6926 | // Also handles intrinsic type parameter inquiries (%kind, %len) and | |||
6927 | // COMPLEX component references (%re, %im). | |||
6928 | const parser::Name *DeclarationVisitor::FindComponent( | |||
6929 | const parser::Name *base, const parser::Name &component) { | |||
6930 | if (!base || !base->symbol) { | |||
6931 | return nullptr; | |||
6932 | } | |||
6933 | if (auto *misc{base->symbol->detailsIf<MiscDetails>()}) { | |||
6934 | if (component.source == "kind") { | |||
6935 | if (misc->kind() == MiscDetails::Kind::ComplexPartRe || | |||
6936 | misc->kind() == MiscDetails::Kind::ComplexPartIm || | |||
6937 | misc->kind() == MiscDetails::Kind::KindParamInquiry || | |||
6938 | misc->kind() == MiscDetails::Kind::LenParamInquiry) { | |||
6939 | // x%{re,im,kind,len}%kind | |||
6940 | MakePlaceholder(component, MiscDetails::Kind::KindParamInquiry); | |||
6941 | return &component; | |||
6942 | } | |||
6943 | } | |||
6944 | } | |||
6945 | CheckEntryDummyUse(base->source, base->symbol); | |||
6946 | auto &symbol{base->symbol->GetUltimate()}; | |||
6947 | if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) { | |||
6948 | SayWithDecl(*base, symbol, | |||
6949 | "'%s' is an invalid base for a component reference"_err_en_US); | |||
6950 | return nullptr; | |||
6951 | } | |||
6952 | auto *type{symbol.GetType()}; | |||
6953 | if (!type) { | |||
6954 | return nullptr; // should have already reported error | |||
6955 | } | |||
6956 | if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) { | |||
6957 | auto category{intrinsic->category()}; | |||
6958 | MiscDetails::Kind miscKind{MiscDetails::Kind::None}; | |||
6959 | if (component.source == "kind") { | |||
6960 | miscKind = MiscDetails::Kind::KindParamInquiry; | |||
6961 | } else if (category == TypeCategory::Character) { | |||
6962 | if (component.source == "len") { | |||
6963 | miscKind = MiscDetails::Kind::LenParamInquiry; | |||
6964 | } | |||
6965 | } else if (category == TypeCategory::Complex) { | |||
6966 | if (component.source == "re") { | |||
6967 | miscKind = MiscDetails::Kind::ComplexPartRe; | |||
6968 | } else if (component.source == "im") { | |||
6969 | miscKind = MiscDetails::Kind::ComplexPartIm; | |||
6970 | } | |||
6971 | } | |||
6972 | if (miscKind != MiscDetails::Kind::None) { | |||
6973 | MakePlaceholder(component, miscKind); | |||
6974 | return &component; | |||
6975 | } | |||
6976 | } else if (DerivedTypeSpec * derived{type->AsDerived()}) { | |||
6977 | derived->Instantiate(currScope()); // in case of forward referenced type | |||
6978 | if (const Scope * scope{derived->scope()}) { | |||
6979 | if (Resolve(component, scope->FindComponent(component.source))) { | |||
6980 | if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) { | |||
6981 | context().Say(component.source, *msg); | |||
6982 | } | |||
6983 | return &component; | |||
6984 | } else { | |||
6985 | SayDerivedType(component.source, | |||
6986 | "Component '%s' not found in derived type '%s'"_err_en_US, *scope); | |||
6987 | } | |||
6988 | } | |||
6989 | return nullptr; | |||
6990 | } | |||
6991 | if (symbol.test(Symbol::Flag::Implicit)) { | |||
6992 | Say(*base, | |||
6993 | "'%s' is not an object of derived type; it is implicitly typed"_err_en_US); | |||
6994 | } else { | |||
6995 | SayWithDecl( | |||
6996 | *base, symbol, "'%s' is not an object of derived type"_err_en_US); | |||
6997 | } | |||
6998 | return nullptr; | |||
6999 | } | |||
7000 | ||||
7001 | void DeclarationVisitor::Initialization(const parser::Name &name, | |||
7002 | const parser::Initialization &init, bool inComponentDecl) { | |||
7003 | // Traversal of the initializer was deferred to here so that the | |||
7004 | // symbol being declared can be available for use in the expression, e.g.: | |||
7005 | // real, parameter :: x = tiny(x) | |||
7006 | if (!name.symbol) { | |||
7007 | return; | |||
7008 | } | |||
7009 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7010 | // TODO: check C762 - all bounds and type parameters of component | |||
7011 | // are colons or constant expressions if component is initialized | |||
7012 | common::visit( | |||
7013 | common::visitors{ | |||
7014 | [&](const parser::ConstantExpr &expr) { | |||
7015 | NonPointerInitialization(name, expr); | |||
7016 | }, | |||
7017 | [&](const parser::NullInit &null) { // => NULL() | |||
7018 | Walk(null); | |||
7019 | if (auto nullInit{EvaluateExpr(null)}) { | |||
7020 | if (!evaluate::IsNullPointer(*nullInit)) { // C813 | |||
7021 | Say(null.v.value().source, | |||
7022 | "Pointer initializer must be intrinsic NULL()"_err_en_US); | |||
7023 | } else if (IsPointer(ultimate)) { | |||
7024 | if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
7025 | object->set_init(std::move(*nullInit)); | |||
7026 | } else if (auto *procPtr{ | |||
7027 | ultimate.detailsIf<ProcEntityDetails>()}) { | |||
7028 | procPtr->set_init(nullptr); | |||
7029 | } | |||
7030 | } else { | |||
7031 | Say(name, | |||
7032 | "Non-pointer component '%s' initialized with null pointer"_err_en_US); | |||
7033 | } | |||
7034 | } | |||
7035 | }, | |||
7036 | [&](const parser::InitialDataTarget &) { | |||
7037 | // Defer analysis to the end of the specification part | |||
7038 | // so that forward references and attribute checks like SAVE | |||
7039 | // work better. | |||
7040 | ultimate.set(Symbol::Flag::InDataStmt); | |||
7041 | }, | |||
7042 | [&](const std::list<Indirection<parser::DataStmtValue>> &values) { | |||
7043 | // Handled later in data-to-inits conversion | |||
7044 | ultimate.set(Symbol::Flag::InDataStmt); | |||
7045 | Walk(values); | |||
7046 | }, | |||
7047 | }, | |||
7048 | init.u); | |||
7049 | } | |||
7050 | ||||
7051 | void DeclarationVisitor::PointerInitialization( | |||
7052 | const parser::Name &name, const parser::InitialDataTarget &target) { | |||
7053 | if (name.symbol) { | |||
7054 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7055 | if (!context().HasError(ultimate)) { | |||
7056 | if (IsPointer(ultimate)) { | |||
7057 | if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
7058 | CHECK(!details->init())((!details->init()) || (Fortran::common::die("CHECK(" "!details->init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7058), false)); | |||
7059 | Walk(target); | |||
7060 | if (MaybeExpr expr{EvaluateExpr(target)}) { | |||
7061 | // Validation is done in declaration checking. | |||
7062 | details->set_init(std::move(*expr)); | |||
7063 | } | |||
7064 | } | |||
7065 | } else { | |||
7066 | Say(name, | |||
7067 | "'%s' is not a pointer but is initialized like one"_err_en_US); | |||
7068 | context().SetError(ultimate); | |||
7069 | } | |||
7070 | } | |||
7071 | } | |||
7072 | } | |||
7073 | void DeclarationVisitor::PointerInitialization( | |||
7074 | const parser::Name &name, const parser::ProcPointerInit &target) { | |||
7075 | if (name.symbol) { | |||
7076 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7077 | if (!context().HasError(ultimate)) { | |||
7078 | if (IsProcedurePointer(ultimate)) { | |||
7079 | auto &details{ultimate.get<ProcEntityDetails>()}; | |||
7080 | CHECK(!details.init())((!details.init()) || (Fortran::common::die("CHECK(" "!details.init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7080), false)); | |||
7081 | if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) { | |||
7082 | Walk(target); | |||
7083 | if (!CheckUseError(*targetName) && targetName->symbol) { | |||
7084 | // Validation is done in declaration checking. | |||
7085 | details.set_init(*targetName->symbol); | |||
7086 | } | |||
7087 | } else { // explicit NULL | |||
7088 | details.set_init(nullptr); | |||
7089 | } | |||
7090 | } else { | |||
7091 | Say(name, | |||
7092 | "'%s' is not a procedure pointer but is initialized " | |||
7093 | "like one"_err_en_US); | |||
7094 | context().SetError(ultimate); | |||
7095 | } | |||
7096 | } | |||
7097 | } | |||
7098 | } | |||
7099 | ||||
7100 | void DeclarationVisitor::NonPointerInitialization( | |||
7101 | const parser::Name &name, const parser::ConstantExpr &expr) { | |||
7102 | if (name.symbol) { | |||
7103 | Symbol &ultimate{name.symbol->GetUltimate()}; | |||
7104 | if (!context().HasError(ultimate) && !context().HasError(name.symbol)) { | |||
7105 | if (IsPointer(ultimate)) { | |||
7106 | Say(name, | |||
7107 | "'%s' is a pointer but is not initialized like one"_err_en_US); | |||
7108 | } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { | |||
7109 | CHECK(!details->init())((!details->init()) || (Fortran::common::die("CHECK(" "!details->init()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7109), false)); | |||
7110 | if (IsAllocatable(ultimate)) { | |||
7111 | Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US); | |||
7112 | return; | |||
7113 | } | |||
7114 | Walk(expr); | |||
7115 | if (ultimate.owner().IsParameterizedDerivedType()) { | |||
7116 | // Save the expression for per-instantiation analysis. | |||
7117 | details->set_unanalyzedPDTComponentInit(&expr.thing.value()); | |||
7118 | } else { | |||
7119 | if (MaybeExpr folded{EvaluateNonPointerInitializer( | |||
7120 | ultimate, expr, expr.thing.value().source)}) { | |||
7121 | details->set_init(std::move(*folded)); | |||
7122 | } | |||
7123 | } | |||
7124 | } else { | |||
7125 | Say(name, "'%s' is not an object that can be initialized"_err_en_US); | |||
7126 | } | |||
7127 | } | |||
7128 | } | |||
7129 | } | |||
7130 | ||||
7131 | void ResolveNamesVisitor::HandleCall( | |||
7132 | Symbol::Flag procFlag, const parser::Call &call) { | |||
7133 | common::visit( | |||
7134 | common::visitors{ | |||
7135 | [&](const parser::Name &x) { HandleProcedureName(procFlag, x); }, | |||
7136 | [&](const parser::ProcComponentRef &x) { | |||
7137 | Walk(x); | |||
7138 | const parser::Name &name{x.v.thing.component}; | |||
7139 | if (Symbol * symbol{name.symbol}) { | |||
7140 | if (IsProcedure(*symbol)) { | |||
7141 | SetProcFlag(name, *symbol, procFlag); | |||
7142 | } | |||
7143 | } | |||
7144 | }, | |||
7145 | }, | |||
7146 | std::get<parser::ProcedureDesignator>(call.t).u); | |||
7147 | Walk(std::get<std::list<parser::ActualArgSpec>>(call.t)); | |||
7148 | } | |||
7149 | ||||
7150 | void ResolveNamesVisitor::HandleProcedureName( | |||
7151 | Symbol::Flag flag, const parser::Name &name) { | |||
7152 | CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine)((flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine ) || (Fortran::common::die("CHECK(" "flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 7152), false)); | |||
7153 | auto *symbol{FindSymbol(NonDerivedTypeScope(), name)}; | |||
7154 | if (!symbol) { | |||
7155 | if (IsIntrinsic(name.source, flag)) { | |||
7156 | symbol = | |||
7157 | &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC}); | |||
7158 | } else if (const auto ppcBuiltinScope = | |||
7159 | currScope().context().GetPPCBuiltinsScope()) { | |||
7160 | // Check if it is a builtin from the predefined module | |||
7161 | symbol = FindSymbol(*ppcBuiltinScope, name); | |||
7162 | if (!symbol) | |||
7163 | symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); | |||
7164 | } else { | |||
7165 | symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); | |||
7166 | } | |||
7167 | Resolve(name, *symbol); | |||
7168 | if (!symbol->attrs().test(Attr::INTRINSIC)) { | |||
7169 | if (CheckImplicitNoneExternal(name.source, *symbol)) { | |||
7170 | MakeExternal(*symbol); | |||
7171 | } | |||
7172 | } | |||
7173 | CheckEntryDummyUse(name.source, symbol); | |||
7174 | ConvertToProcEntity(*symbol); | |||
7175 | SetProcFlag(name, *symbol, flag); | |||
7176 | } else if (CheckUseError(name)) { | |||
7177 | // error was reported | |||
7178 | } else { | |||
7179 | auto &nonUltimateSymbol{*symbol}; | |||
7180 | symbol = &Resolve(name, symbol)->GetUltimate(); | |||
7181 | CheckEntryDummyUse(name.source, symbol); | |||
7182 | bool convertedToProcEntity{ConvertToProcEntity(*symbol)}; | |||
7183 | if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) && | |||
7184 | IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) { | |||
7185 | AcquireIntrinsicProcedureFlags(*symbol); | |||
7186 | } | |||
7187 | if (!SetProcFlag(name, *symbol, flag)) { | |||
7188 | return; // reported error | |||
7189 | } | |||
7190 | if (!symbol->has<GenericDetails>()) { | |||
7191 | CheckImplicitNoneExternal(name.source, *symbol); | |||
7192 | } | |||
7193 | if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() || | |||
7194 | symbol->has<AssocEntityDetails>()) { | |||
7195 | // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted | |||
7196 | // here as procedure-designators because this means the related | |||
7197 | // FunctionReference are mis-parsed structure constructors or array | |||
7198 | // references that will be fixed later when analyzing expressions. | |||
7199 | } else if (symbol->has<ObjectEntityDetails>()) { | |||
7200 | // Symbols with ObjectEntityDetails are also accepted because this can be | |||
7201 | // a mis-parsed array references that will be fixed later. Ensure that if | |||
7202 | // this is a symbol from a host procedure, a symbol with HostAssocDetails | |||
7203 | // is created for the current scope. | |||
7204 | // Operate on non ultimate symbol so that HostAssocDetails are also | |||
7205 | // created for symbols used associated in the host procedure. | |||
7206 | if (IsUplevelReference(nonUltimateSymbol)) { | |||
7207 | MakeHostAssocSymbol(name, nonUltimateSymbol); | |||
7208 | } | |||
7209 | } else if (symbol->test(Symbol::Flag::Implicit)) { | |||
7210 | Say(name, | |||
7211 | "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US); | |||
7212 | } else { | |||
7213 | SayWithDecl(name, *symbol, | |||
7214 | "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); | |||
7215 | } | |||
7216 | } | |||
7217 | } | |||
7218 | ||||
7219 | bool ResolveNamesVisitor::CheckImplicitNoneExternal( | |||
7220 | const SourceName &name, const Symbol &symbol) { | |||
7221 | if (isImplicitNoneExternal() && !symbol.attrs().test(Attr::EXTERNAL) && | |||
7222 | !symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) { | |||
7223 | Say(name, | |||
7224 | "'%s' is an external procedure without the EXTERNAL" | |||
7225 | " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US); | |||
7226 | return false; | |||
7227 | } | |||
7228 | return true; | |||
7229 | } | |||
7230 | ||||
7231 | // Variant of HandleProcedureName() for use while skimming the executable | |||
7232 | // part of a subprogram to catch calls to dummy procedures that are part | |||
7233 | // of the subprogram's interface, and to mark as procedures any symbols | |||
7234 | // that might otherwise have been miscategorized as objects. | |||
7235 | void ResolveNamesVisitor::NoteExecutablePartCall( | |||
7236 | Symbol::Flag flag, const parser::Call &call) { | |||
7237 | auto &designator{std::get<parser::ProcedureDesignator>(call.t)}; | |||
7238 | if (const auto *name{std::get_if<parser::Name>(&designator.u)}) { | |||
7239 | // Subtlety: The symbol pointers in the parse tree are not set, because | |||
7240 | // they might end up resolving elsewhere (e.g., construct entities in | |||
7241 | // SELECT TYPE). | |||
7242 | if (Symbol * symbol{currScope().FindSymbol(name->source)}) { | |||
7243 | Symbol::Flag other{flag == Symbol::Flag::Subroutine | |||
7244 | ? Symbol::Flag::Function | |||
7245 | : Symbol::Flag::Subroutine}; | |||
7246 | if (!symbol->test(other)) { | |||
7247 | ConvertToProcEntity(*symbol); | |||
7248 | if (symbol->has<ProcEntityDetails>()) { | |||
7249 | symbol->set(flag); | |||
7250 | if (IsDummy(*symbol)) { | |||
7251 | SetImplicitAttr(*symbol, Attr::EXTERNAL); | |||
7252 | } | |||
7253 | ApplyImplicitRules(*symbol); | |||
7254 | } | |||
7255 | } | |||
7256 | } | |||
7257 | } | |||
7258 | } | |||
7259 | ||||
7260 | static bool IsLocallyImplicitGlobalSymbol( | |||
7261 | const Symbol &symbol, const parser::Name &localName) { | |||
7262 | return symbol.owner().IsGlobal() && | |||
7263 | (!symbol.scope() || | |||
7264 | !symbol.scope()->sourceRange().Contains(localName.source)); | |||
7265 | } | |||
7266 | ||||
7267 | static bool TypesMismatchIfNonNull( | |||
7268 | const DeclTypeSpec *type1, const DeclTypeSpec *type2) { | |||
7269 | return type1 && type2 && *type1 != *type2; | |||
7270 | } | |||
7271 | ||||
7272 | // Check and set the Function or Subroutine flag on symbol; false on error. | |||
7273 | bool ResolveNamesVisitor::SetProcFlag( | |||
7274 | const parser::Name &name, Symbol &symbol, Symbol::Flag flag) { | |||
7275 | if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) { | |||
7276 | SayWithDecl( | |||
7277 | name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); | |||
7278 | return false; | |||
7279 | } else if (symbol.test(Symbol::Flag::Subroutine) && | |||
7280 | flag == Symbol::Flag::Function) { | |||
7281 | SayWithDecl( | |||
7282 | name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US); | |||
7283 | return false; | |||
7284 | } else if (flag == Symbol::Flag::Function && | |||
7285 | IsLocallyImplicitGlobalSymbol(symbol, name) && | |||
7286 | TypesMismatchIfNonNull(symbol.GetType(), GetImplicitType(symbol))) { | |||
7287 | SayWithDecl(name, symbol, | |||
7288 | "Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US); | |||
7289 | return false; | |||
7290 | } else if (symbol.has<ProcEntityDetails>()) { | |||
7291 | symbol.set(flag); // in case it hasn't been set yet | |||
7292 | if (flag == Symbol::Flag::Function) { | |||
7293 | ApplyImplicitRules(symbol); | |||
7294 | } | |||
7295 | if (symbol.attrs().test(Attr::INTRINSIC)) { | |||
7296 | AcquireIntrinsicProcedureFlags(symbol); | |||
7297 | } | |||
7298 | } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) { | |||
7299 | SayWithDecl( | |||
7300 | name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); | |||
7301 | } else if (symbol.attrs().test(Attr::INTRINSIC)) { | |||
7302 | AcquireIntrinsicProcedureFlags(symbol); | |||
7303 | } | |||
7304 | return true; | |||
7305 | } | |||
7306 | ||||
7307 | bool ModuleVisitor::Pre(const parser::AccessStmt &x) { | |||
7308 | Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))}; | |||
7309 | if (!currScope().IsModule()) { // C869 | |||
7310 | Say(currStmtSource().value(), | |||
7311 | "%s statement may only appear in the specification part of a module"_err_en_US, | |||
7312 | EnumToString(accessAttr)); | |||
7313 | return false; | |||
7314 | } | |||
7315 | const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)}; | |||
7316 | if (accessIds.empty()) { | |||
7317 | if (prevAccessStmt_) { // C869 | |||
7318 | Say("The default accessibility of this module has already been declared"_err_en_US) | |||
7319 | .Attach(*prevAccessStmt_, "Previous declaration"_en_US); | |||
7320 | } | |||
7321 | prevAccessStmt_ = currStmtSource(); | |||
7322 | defaultAccess_ = accessAttr; | |||
7323 | } else { | |||
7324 | for (const auto &accessId : accessIds) { | |||
7325 | GenericSpecInfo info{accessId.v.value()}; | |||
7326 | auto *symbol{FindInScope(info.symbolName())}; | |||
7327 | if (!symbol && !info.kind().IsName()) { | |||
7328 | symbol = &MakeSymbol(info.symbolName(), Attrs{}, GenericDetails{}); | |||
7329 | } | |||
7330 | info.Resolve(&SetAccess(info.symbolName(), accessAttr, symbol)); | |||
7331 | } | |||
7332 | } | |||
7333 | return false; | |||
7334 | } | |||
7335 | ||||
7336 | // Set the access specification for this symbol. | |||
7337 | Symbol &ModuleVisitor::SetAccess( | |||
7338 | const SourceName &name, Attr attr, Symbol *symbol) { | |||
7339 | if (!symbol) { | |||
7340 | symbol = &MakeSymbol(name); | |||
7341 | } | |||
7342 | Attrs &attrs{symbol->attrs()}; | |||
7343 | if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { | |||
7344 | // PUBLIC/PRIVATE already set: make it a fatal error if it changed | |||
7345 | Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE; | |||
7346 | Say(name, | |||
7347 | WithSeverity( | |||
7348 | "The accessibility of '%s' has already been specified as %s"_warn_en_US, | |||
7349 | attr != prev ? parser::Severity::Error : parser::Severity::Warning), | |||
7350 | MakeOpName(name), EnumToString(prev)); | |||
7351 | } else { | |||
7352 | attrs.set(attr); | |||
7353 | } | |||
7354 | return *symbol; | |||
7355 | } | |||
7356 | ||||
7357 | static bool NeedsExplicitType(const Symbol &symbol) { | |||
7358 | if (symbol.has<UnknownDetails>()) { | |||
7359 | return true; | |||
7360 | } else if (const auto *details{symbol.detailsIf<EntityDetails>()}) { | |||
7361 | return !details->type(); | |||
7362 | } else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { | |||
7363 | return !details->type(); | |||
7364 | } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) { | |||
7365 | return !details->procInterface() && !details->type(); | |||
7366 | } else { | |||
7367 | return false; | |||
7368 | } | |||
7369 | } | |||
7370 | ||||
7371 | bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) { | |||
7372 | const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts, | |||
7373 | implicitPart, decls] = x.t; | |||
7374 | auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)}; | |||
7375 | auto stateRestorer{ | |||
7376 | common::ScopedSet(specPartState_, SpecificationPartState{})}; | |||
7377 | Walk(accDecls); | |||
7378 | Walk(ompDecls); | |||
7379 | Walk(compilerDirectives); | |||
7380 | Walk(useStmts); | |||
7381 | ClearUseRenames(); | |||
7382 | ClearUseOnly(); | |||
7383 | ClearModuleUses(); | |||
7384 | Walk(importStmts); | |||
7385 | Walk(implicitPart); | |||
7386 | for (const auto &decl : decls) { | |||
7387 | if (const auto *spec{ | |||
7388 | std::get_if<parser::SpecificationConstruct>(&decl.u)}) { | |||
7389 | PreSpecificationConstruct(*spec); | |||
7390 | } | |||
7391 | } | |||
7392 | Walk(decls); | |||
7393 | FinishSpecificationPart(decls); | |||
7394 | return false; | |||
7395 | } | |||
7396 | ||||
7397 | // Initial processing on specification constructs, before visiting them. | |||
7398 | void ResolveNamesVisitor::PreSpecificationConstruct( | |||
7399 | const parser::SpecificationConstruct &spec) { | |||
7400 | common::visit( | |||
7401 | common::visitors{ | |||
7402 | [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) { | |||
7403 | CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t)); | |||
7404 | }, | |||
7405 | [&](const Indirection<parser::InterfaceBlock> &y) { | |||
7406 | const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>( | |||
7407 | y.value().t)}; | |||
7408 | if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) { | |||
7409 | CreateGeneric(*spec); | |||
7410 | } | |||
7411 | }, | |||
7412 | [&](const parser::Statement<parser::OtherSpecificationStmt> &y) { | |||
7413 | if (const auto *commonStmt{parser::Unwrap<parser::CommonStmt>(y)}) { | |||
7414 | CreateCommonBlockSymbols(*commonStmt); | |||
7415 | } | |||
7416 | }, | |||
7417 | [&](const auto &) {}, | |||
7418 | }, | |||
7419 | spec.u); | |||
7420 | } | |||
7421 | ||||
7422 | void ResolveNamesVisitor::CreateCommonBlockSymbols( | |||
7423 | const parser::CommonStmt &commonStmt) { | |||
7424 | for (const parser::CommonStmt::Block &block : commonStmt.blocks) { | |||
7425 | const auto &[name, objects] = block.t; | |||
7426 | Symbol &commonBlock{MakeCommonBlockSymbol(name)}; | |||
7427 | for (const auto &object : objects) { | |||
7428 | Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))}; | |||
7429 | if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) { | |||
7430 | details->set_commonBlock(commonBlock); | |||
7431 | commonBlock.get<CommonBlockDetails>().add_object(obj); | |||
7432 | } | |||
7433 | } | |||
7434 | } | |||
7435 | } | |||
7436 | ||||
7437 | void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) { | |||
7438 | auto info{GenericSpecInfo{x}}; | |||
7439 | SourceName symbolName{info.symbolName()}; | |||
7440 | if (IsLogicalConstant(context(), symbolName)) { | |||
7441 | Say(symbolName, | |||
7442 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
7443 | return; | |||
7444 | } | |||
7445 | GenericDetails genericDetails; | |||
7446 | Symbol *existing{nullptr}; | |||
7447 | // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)" | |||
7448 | for (const std::string &n : GetAllNames(context(), symbolName)) { | |||
7449 | existing = currScope().FindSymbol(SourceName{n}); | |||
7450 | if (existing) { | |||
7451 | break; | |||
7452 | } | |||
7453 | } | |||
7454 | if (existing) { | |||
7455 | Symbol &ultimate{existing->GetUltimate()}; | |||
7456 | if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) { | |||
7457 | if (&existing->owner() == &currScope()) { | |||
7458 | if (const auto *existingUse{existing->detailsIf<UseDetails>()}) { | |||
7459 | // Create a local copy of a use associated generic so that | |||
7460 | // it can be locally extended without corrupting the original. | |||
7461 | genericDetails.CopyFrom(*existingGeneric); | |||
7462 | if (existingGeneric->specific()) { | |||
7463 | genericDetails.set_specific(*existingGeneric->specific()); | |||
7464 | } | |||
7465 | AddGenericUse( | |||
7466 | genericDetails, existing->name(), existingUse->symbol()); | |||
7467 | } else if (existing == &ultimate) { | |||
7468 | // Extending an extant generic in the same scope | |||
7469 | info.Resolve(existing); | |||
7470 | return; | |||
7471 | } else { | |||
7472 | // Host association of a generic is handled elsewhere | |||
7473 | CHECK(existing->has<HostAssocDetails>())((existing->has<HostAssocDetails>()) || (Fortran::common ::die("CHECK(" "existing->has<HostAssocDetails>()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 7473) , false)); | |||
7474 | } | |||
7475 | } else { | |||
7476 | // Create a new generic for this scope. | |||
7477 | } | |||
7478 | } else if (ultimate.has<SubprogramDetails>() || | |||
7479 | ultimate.has<SubprogramNameDetails>()) { | |||
7480 | genericDetails.set_specific(*existing); | |||
7481 | } else if (ultimate.has<DerivedTypeDetails>()) { | |||
7482 | genericDetails.set_derivedType(*existing); | |||
7483 | } else if (&existing->owner() == &currScope()) { | |||
7484 | SayAlreadyDeclared(symbolName, *existing); | |||
7485 | return; | |||
7486 | } | |||
7487 | if (&existing->owner() == &currScope()) { | |||
7488 | EraseSymbol(*existing); | |||
7489 | } | |||
7490 | } | |||
7491 | info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails))); | |||
7492 | } | |||
7493 | ||||
7494 | void ResolveNamesVisitor::FinishSpecificationPart( | |||
7495 | const std::list<parser::DeclarationConstruct> &decls) { | |||
7496 | badStmtFuncFound_ = false; | |||
7497 | funcResultStack().CompleteFunctionResultType(); | |||
7498 | CheckImports(); | |||
7499 | bool inModule{currScope().kind() == Scope::Kind::Module}; | |||
7500 | for (auto &pair : currScope()) { | |||
7501 | auto &symbol{*pair.second}; | |||
7502 | if (NeedsExplicitType(symbol)) { | |||
7503 | ApplyImplicitRules(symbol); | |||
7504 | } | |||
7505 | if (IsDummy(symbol) && isImplicitNoneType() && | |||
7506 | symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) { | |||
7507 | Say(symbol.name(), | |||
7508 | "No explicit type declared for dummy argument '%s'"_err_en_US); | |||
7509 | context().SetError(symbol); | |||
7510 | } | |||
7511 | if (symbol.has<GenericDetails>()) { | |||
7512 | CheckGenericProcedures(symbol); | |||
7513 | } | |||
7514 | if (inModule && symbol.attrs().test(Attr::EXTERNAL) && | |||
7515 | !symbol.test(Symbol::Flag::Function) && | |||
7516 | !symbol.test(Symbol::Flag::Subroutine)) { | |||
7517 | // in a module, external proc without return type is subroutine | |||
7518 | symbol.set( | |||
7519 | symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine); | |||
7520 | } | |||
7521 | if (!symbol.has<HostAssocDetails>()) { | |||
7522 | CheckPossibleBadForwardRef(symbol); | |||
7523 | } | |||
7524 | } | |||
7525 | currScope().InstantiateDerivedTypes(); | |||
7526 | for (const auto &decl : decls) { | |||
7527 | if (const auto *statement{std::get_if< | |||
7528 | parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>( | |||
7529 | &decl.u)}) { | |||
7530 | AnalyzeStmtFunctionStmt(statement->statement.value()); | |||
7531 | } | |||
7532 | } | |||
7533 | // TODO: what about instantiations in BLOCK? | |||
7534 | CheckSaveStmts(); | |||
7535 | CheckCommonBlocks(); | |||
7536 | if (!inInterfaceBlock()) { | |||
7537 | // TODO: warn for the case where the EQUIVALENCE statement is in a | |||
7538 | // procedure declaration in an interface block | |||
7539 | CheckEquivalenceSets(); | |||
7540 | } | |||
7541 | } | |||
7542 | ||||
7543 | // Analyze the bodies of statement functions now that the symbols in this | |||
7544 | // specification part have been fully declared and implicitly typed. | |||
7545 | // (Statement function references are not allowed in specification | |||
7546 | // expressions, so it's safe to defer processing their definitions.) | |||
7547 | void ResolveNamesVisitor::AnalyzeStmtFunctionStmt( | |||
7548 | const parser::StmtFunctionStmt &stmtFunc) { | |||
7549 | const auto &name{std::get<parser::Name>(stmtFunc.t)}; | |||
7550 | Symbol *symbol{name.symbol}; | |||
7551 | auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}; | |||
7552 | if (!details || !symbol->scope()) { | |||
7553 | return; | |||
7554 | } | |||
7555 | // Resolve the symbols on the RHS of the statement function. | |||
7556 | PushScope(*symbol->scope()); | |||
7557 | const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(stmtFunc.t)}; | |||
7558 | Walk(parsedExpr); | |||
7559 | PopScope(); | |||
7560 | if (auto expr{AnalyzeExpr(context(), stmtFunc)}) { | |||
7561 | if (auto type{evaluate::DynamicType::From(*symbol)}) { | |||
7562 | if (auto converted{evaluate::ConvertToType(*type, std::move(*expr))}) { | |||
7563 | details->set_stmtFunction(std::move(*converted)); | |||
7564 | } else { | |||
7565 | Say(name.source, | |||
7566 | "Defining expression of statement function '%s' cannot be converted to its result type %s"_err_en_US, | |||
7567 | name.source, type->AsFortran()); | |||
7568 | } | |||
7569 | } else { | |||
7570 | details->set_stmtFunction(std::move(*expr)); | |||
7571 | } | |||
7572 | } | |||
7573 | if (!details->stmtFunction()) { | |||
7574 | context().SetError(*symbol); | |||
7575 | } | |||
7576 | } | |||
7577 | ||||
7578 | void ResolveNamesVisitor::CheckImports() { | |||
7579 | auto &scope{currScope()}; | |||
7580 | switch (scope.GetImportKind()) { | |||
7581 | case common::ImportKind::None: | |||
7582 | break; | |||
7583 | case common::ImportKind::All: | |||
7584 | // C8102: all entities in host must not be hidden | |||
7585 | for (const auto &pair : scope.parent()) { | |||
7586 | auto &name{pair.first}; | |||
7587 | std::optional<SourceName> scopeName{scope.GetName()}; | |||
7588 | if (!scopeName || name != *scopeName) { | |||
7589 | CheckImport(prevImportStmt_.value(), name); | |||
7590 | } | |||
7591 | } | |||
7592 | break; | |||
7593 | case common::ImportKind::Default: | |||
7594 | case common::ImportKind::Only: | |||
7595 | // C8102: entities named in IMPORT must not be hidden | |||
7596 | for (auto &name : scope.importNames()) { | |||
7597 | CheckImport(name, name); | |||
7598 | } | |||
7599 | break; | |||
7600 | } | |||
7601 | } | |||
7602 | ||||
7603 | void ResolveNamesVisitor::CheckImport( | |||
7604 | const SourceName &location, const SourceName &name) { | |||
7605 | if (auto *symbol{FindInScope(name)}) { | |||
7606 | const Symbol &ultimate{symbol->GetUltimate()}; | |||
7607 | if (&ultimate.owner() == &currScope()) { | |||
7608 | Say(location, "'%s' from host is not accessible"_err_en_US, name) | |||
7609 | .Attach(symbol->name(), "'%s' is hidden by this entity"_en_US, | |||
7610 | symbol->name()); | |||
7611 | } | |||
7612 | } | |||
7613 | } | |||
7614 | ||||
7615 | bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { | |||
7616 | return CheckNotInBlock("IMPLICIT") && // C1107 | |||
7617 | ImplicitRulesVisitor::Pre(x); | |||
7618 | } | |||
7619 | ||||
7620 | void ResolveNamesVisitor::Post(const parser::PointerObject &x) { | |||
7621 | common::visit(common::visitors{ | |||
7622 | [&](const parser::Name &x) { ResolveName(x); }, | |||
7623 | [&](const parser::StructureComponent &x) { | |||
7624 | ResolveStructureComponent(x); | |||
7625 | }, | |||
7626 | }, | |||
7627 | x.u); | |||
7628 | } | |||
7629 | void ResolveNamesVisitor::Post(const parser::AllocateObject &x) { | |||
7630 | common::visit(common::visitors{ | |||
7631 | [&](const parser::Name &x) { ResolveName(x); }, | |||
7632 | [&](const parser::StructureComponent &x) { | |||
7633 | ResolveStructureComponent(x); | |||
7634 | }, | |||
7635 | }, | |||
7636 | x.u); | |||
7637 | } | |||
7638 | ||||
7639 | bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) { | |||
7640 | const auto &dataRef{std::get<parser::DataRef>(x.t)}; | |||
7641 | const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)}; | |||
7642 | const auto &expr{std::get<parser::Expr>(x.t)}; | |||
7643 | ResolveDataRef(dataRef); | |||
7644 | Walk(bounds); | |||
7645 | // Resolve unrestricted specific intrinsic procedures as in "p => cos". | |||
7646 | if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) { | |||
7647 | if (NameIsKnownOrIntrinsic(*name)) { | |||
7648 | // If the name is known because it is an object entity from a host | |||
7649 | // procedure, create a host associated symbol. | |||
7650 | if (Symbol * symbol{name->symbol}; symbol && | |||
7651 | symbol->GetUltimate().has<ObjectEntityDetails>() && | |||
7652 | IsUplevelReference(*symbol)) { | |||
7653 | MakeHostAssocSymbol(*name, *symbol); | |||
7654 | } | |||
7655 | return false; | |||
7656 | } | |||
7657 | } | |||
7658 | Walk(expr); | |||
7659 | return false; | |||
7660 | } | |||
7661 | void ResolveNamesVisitor::Post(const parser::Designator &x) { | |||
7662 | ResolveDesignator(x); | |||
7663 | } | |||
7664 | void ResolveNamesVisitor::Post(const parser::SubstringInquiry &x) { | |||
7665 | Walk(std::get<parser::SubstringRange>(x.v.t).t); | |||
7666 | ResolveDataRef(std::get<parser::DataRef>(x.v.t)); | |||
7667 | } | |||
7668 | ||||
7669 | void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) { | |||
7670 | ResolveStructureComponent(x.v.thing); | |||
7671 | } | |||
7672 | void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) { | |||
7673 | DeclTypeSpecVisitor::Post(x); | |||
7674 | ConstructVisitor::Post(x); | |||
7675 | } | |||
7676 | bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) { | |||
7677 | if (HandleStmtFunction(x)) { | |||
7678 | return false; | |||
7679 | } else { | |||
7680 | // This is an array element assignment: resolve names of indices | |||
7681 | const auto &names{std::get<std::list<parser::Name>>(x.t)}; | |||
7682 | for (auto &name : names) { | |||
7683 | ResolveName(name); | |||
7684 | } | |||
7685 | return true; | |||
7686 | } | |||
7687 | } | |||
7688 | ||||
7689 | bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) { | |||
7690 | const parser::Name &name{x.v}; | |||
7691 | if (FindSymbol(name)) { | |||
7692 | // OK | |||
7693 | } else if (IsLogicalConstant(context(), name.source)) { | |||
7694 | Say(name, | |||
7695 | "Logical constant '%s' may not be used as a defined operator"_err_en_US); | |||
7696 | } else { | |||
7697 | // Resolved later in expression semantics | |||
7698 | MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp); | |||
7699 | } | |||
7700 | return false; | |||
7701 | } | |||
7702 | ||||
7703 | void ResolveNamesVisitor::Post(const parser::AssignStmt &x) { | |||
7704 | if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { | |||
7705 | CheckEntryDummyUse(name->source, name->symbol); | |||
7706 | ConvertToObjectEntity(DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 7706)); | |||
7707 | } | |||
7708 | } | |||
7709 | void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) { | |||
7710 | if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { | |||
7711 | CheckEntryDummyUse(name->source, name->symbol); | |||
7712 | ConvertToObjectEntity(DEREF(name->symbol)Fortran::common::Deref(name->symbol, "flang/lib/Semantics/resolve-names.cpp" , 7712)); | |||
7713 | } | |||
7714 | } | |||
7715 | ||||
7716 | void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) { | |||
7717 | if (const auto *tkr{ | |||
7718 | std::get_if<std::list<parser::CompilerDirective::IgnoreTKR>>(&x.u)}) { | |||
7719 | if (currScope().IsTopLevel() || | |||
7720 | GetProgramUnitContaining(currScope()).kind() != | |||
7721 | Scope::Kind::Subprogram) { | |||
7722 | Say(x.source, | |||
7723 | "!DIR$ IGNORE_TKR directive must appear in a subroutine or function"_err_en_US); | |||
7724 | return; | |||
7725 | } | |||
7726 | if (!inSpecificationPart_) { | |||
7727 | Say(x.source, | |||
7728 | "!DIR$ IGNORE_TKR directive must appear in the specification part"_err_en_US); | |||
7729 | return; | |||
7730 | } | |||
7731 | if (tkr->empty()) { | |||
7732 | Symbol *symbol{currScope().symbol()}; | |||
7733 | if (SubprogramDetails * | |||
7734 | subp{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr}) { | |||
7735 | subp->set_defaultIgnoreTKR(true); | |||
7736 | } | |||
7737 | } else { | |||
7738 | for (const parser::CompilerDirective::IgnoreTKR &item : *tkr) { | |||
7739 | common::IgnoreTKRSet set; | |||
7740 | if (const auto &maybeList{ | |||
7741 | std::get<std::optional<std::list<const char *>>>(item.t)}) { | |||
7742 | for (const char *p : *maybeList) { | |||
7743 | if (p) { | |||
7744 | switch (*p) { | |||
7745 | case 't': | |||
7746 | set.set(common::IgnoreTKR::Type); | |||
7747 | break; | |||
7748 | case 'k': | |||
7749 | set.set(common::IgnoreTKR::Kind); | |||
7750 | break; | |||
7751 | case 'r': | |||
7752 | set.set(common::IgnoreTKR::Rank); | |||
7753 | break; | |||
7754 | case 'd': | |||
7755 | set.set(common::IgnoreTKR::Device); | |||
7756 | break; | |||
7757 | case 'm': | |||
7758 | set.set(common::IgnoreTKR::Managed); | |||
7759 | break; | |||
7760 | case 'c': | |||
7761 | set.set(common::IgnoreTKR::Contiguous); | |||
7762 | break; | |||
7763 | case 'a': | |||
7764 | set = common::ignoreTKRAll; | |||
7765 | break; | |||
7766 | default: | |||
7767 | Say(x.source, | |||
7768 | "'%c' is not a valid letter for !DIR$ IGNORE_TKR directive"_err_en_US, | |||
7769 | *p); | |||
7770 | set = common::ignoreTKRAll; | |||
7771 | break; | |||
7772 | } | |||
7773 | } | |||
7774 | } | |||
7775 | if (set.empty()) { | |||
7776 | Say(x.source, | |||
7777 | "!DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters"_err_en_US); | |||
7778 | } | |||
7779 | } else { // no (list) | |||
7780 | set = common::ignoreTKRAll; | |||
7781 | ; | |||
7782 | } | |||
7783 | const auto &name{std::get<parser::Name>(item.t)}; | |||
7784 | Symbol *symbol{FindSymbol(name)}; | |||
7785 | if (!symbol) { | |||
7786 | symbol = &MakeSymbol(name, Attrs{}, ObjectEntityDetails{}); | |||
7787 | } | |||
7788 | if (symbol->owner() != currScope()) { | |||
7789 | SayWithDecl( | |||
7790 | name, *symbol, "'%s' must be local to this subprogram"_err_en_US); | |||
7791 | } else { | |||
7792 | ConvertToObjectEntity(*symbol); | |||
7793 | if (auto *object{symbol->detailsIf<ObjectEntityDetails>()}) { | |||
7794 | object->set_ignoreTKR(set); | |||
7795 | } else { | |||
7796 | SayWithDecl(name, *symbol, "'%s' must be an object"_err_en_US); | |||
7797 | } | |||
7798 | } | |||
7799 | } | |||
7800 | } | |||
7801 | } else { | |||
7802 | Say(x.source, "Compiler directive was ignored"_warn_en_US); | |||
7803 | } | |||
7804 | } | |||
7805 | ||||
7806 | bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) { | |||
7807 | if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>( | |||
7808 | x.u)) { | |||
7809 | // TODO: global directives | |||
7810 | return true; | |||
7811 | } | |||
7812 | auto root{ProgramTree::Build(x)}; | |||
7813 | SetScope(topScope_); | |||
7814 | ResolveSpecificationParts(root); | |||
7815 | FinishSpecificationParts(root); | |||
7816 | ResolveExecutionParts(root); | |||
7817 | ResolveAccParts(context(), x); | |||
7818 | ResolveOmpParts(context(), x); | |||
7819 | return false; | |||
7820 | } | |||
7821 | ||||
7822 | template <typename A> std::set<SourceName> GetUses(const A &x) { | |||
7823 | std::set<SourceName> uses; | |||
7824 | if constexpr (!std::is_same_v<A, parser::CompilerDirective>) { | |||
7825 | const auto &spec{std::get<parser::SpecificationPart>(x.t)}; | |||
7826 | const auto &unitUses{std::get< | |||
7827 | std::list<parser::Statement<common::Indirection<parser::UseStmt>>>>( | |||
7828 | spec.t)}; | |||
7829 | for (const auto &u : unitUses) { | |||
7830 | uses.insert(u.statement.value().moduleName.source); | |||
7831 | } | |||
7832 | } | |||
7833 | return uses; | |||
7834 | } | |||
7835 | ||||
7836 | bool ResolveNamesVisitor::Pre(const parser::Program &x) { | |||
7837 | std::map<SourceName, const parser::ProgramUnit *> modules; | |||
7838 | std::set<SourceName> uses; | |||
7839 | bool disordered{false}; | |||
7840 | for (const auto &progUnit : x.v) { | |||
7841 | if (const auto *indMod{ | |||
7842 | std::get_if<common::Indirection<parser::Module>>(&progUnit.u)}) { | |||
7843 | const parser::Module &mod{indMod->value()}; | |||
7844 | const auto &moduleStmt{ | |||
7845 | std::get<parser::Statement<parser::ModuleStmt>>(mod.t)}; | |||
7846 | const SourceName &name{moduleStmt.statement.v.source}; | |||
7847 | if (auto iter{modules.find(name)}; iter != modules.end()) { | |||
7848 | Say(name, | |||
7849 | "Module '%s' appears multiple times in a compilation unit"_err_en_US) | |||
7850 | .Attach(iter->first, "First definition of module"_en_US); | |||
7851 | return true; | |||
7852 | } | |||
7853 | modules.emplace(name, &progUnit); | |||
7854 | if (auto iter{uses.find(name)}; iter != uses.end()) { | |||
7855 | Say(name, | |||
7856 | "A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US) | |||
7857 | .Attach(*iter, "First USE of module"_en_US); | |||
7858 | disordered = true; | |||
7859 | } | |||
7860 | } | |||
7861 | for (SourceName used : common::visit( | |||
7862 | [](const auto &indUnit) { return GetUses(indUnit.value()); }, | |||
7863 | progUnit.u)) { | |||
7864 | uses.insert(used); | |||
7865 | } | |||
7866 | } | |||
7867 | if (!disordered) { | |||
7868 | return true; | |||
7869 | } | |||
7870 | // Process modules in topological order | |||
7871 | std::vector<const parser::ProgramUnit *> moduleOrder; | |||
7872 | while (!modules.empty()) { | |||
7873 | bool ok; | |||
7874 | for (const auto &pair : modules) { | |||
7875 | const SourceName &name{pair.first}; | |||
7876 | const parser::ProgramUnit &progUnit{*pair.second}; | |||
7877 | const parser::Module &m{ | |||
7878 | std::get<common::Indirection<parser::Module>>(progUnit.u).value()}; | |||
7879 | ok = true; | |||
7880 | for (const SourceName &use : GetUses(m)) { | |||
7881 | if (modules.find(use) != modules.end()) { | |||
7882 | ok = false; | |||
7883 | break; | |||
7884 | } | |||
7885 | } | |||
7886 | if (ok) { | |||
7887 | moduleOrder.push_back(&progUnit); | |||
7888 | modules.erase(name); | |||
7889 | break; | |||
7890 | } | |||
7891 | } | |||
7892 | if (!ok) { | |||
7893 | parser::Message *msg{nullptr}; | |||
7894 | for (const auto &pair : modules) { | |||
7895 | if (msg) { | |||
7896 | msg->Attach(pair.first, "Module in a cycle"_en_US); | |||
7897 | } else { | |||
7898 | msg = &Say(pair.first, | |||
7899 | "Some modules in this compilation unit form one or more cycles of dependence"_err_en_US); | |||
7900 | } | |||
7901 | } | |||
7902 | return false; | |||
7903 | } | |||
7904 | } | |||
7905 | // Modules can be ordered. Process them first, and then all of the other | |||
7906 | // program units. | |||
7907 | for (const parser::ProgramUnit *progUnit : moduleOrder) { | |||
7908 | Walk(*progUnit); | |||
7909 | } | |||
7910 | for (const auto &progUnit : x.v) { | |||
7911 | if (!std::get_if<common::Indirection<parser::Module>>(&progUnit.u)) { | |||
7912 | Walk(progUnit); | |||
7913 | } | |||
7914 | } | |||
7915 | return false; | |||
7916 | } | |||
7917 | ||||
7918 | // References to procedures need to record that their symbols are known | |||
7919 | // to be procedures, so that they don't get converted to objects by default. | |||
7920 | class ExecutionPartSkimmer { | |||
7921 | public: | |||
7922 | explicit ExecutionPartSkimmer(ResolveNamesVisitor &resolver) | |||
7923 | : resolver_{resolver} {} | |||
7924 | ||||
7925 | void Walk(const parser::ExecutionPart *exec) { | |||
7926 | if (exec) { | |||
7927 | parser::Walk(*exec, *this); | |||
7928 | } | |||
7929 | } | |||
7930 | ||||
7931 | template <typename A> bool Pre(const A &) { return true; } | |||
7932 | template <typename A> void Post(const A &) {} | |||
7933 | void Post(const parser::FunctionReference &fr) { | |||
7934 | resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v); | |||
7935 | } | |||
7936 | void Post(const parser::CallStmt &cs) { | |||
7937 | resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.v); | |||
7938 | } | |||
7939 | ||||
7940 | private: | |||
7941 | ResolveNamesVisitor &resolver_; | |||
7942 | }; | |||
7943 | ||||
7944 | // Build the scope tree and resolve names in the specification parts of this | |||
7945 | // node and its children | |||
7946 | void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) { | |||
7947 | if (node.isSpecificationPartResolved()) { | |||
7948 | return; // been here already | |||
7949 | } | |||
7950 | node.set_isSpecificationPartResolved(); | |||
7951 | if (!BeginScopeForNode(node)) { | |||
7952 | return; // an error prevented scope from being created | |||
7953 | } | |||
7954 | Scope &scope{currScope()}; | |||
7955 | node.set_scope(scope); | |||
7956 | AddSubpNames(node); | |||
7957 | common::visit( | |||
7958 | [&](const auto *x) { | |||
7959 | if (x) { | |||
7960 | Walk(*x); | |||
7961 | } | |||
7962 | }, | |||
7963 | node.stmt()); | |||
7964 | Walk(node.spec()); | |||
7965 | // If this is a function, convert result to an object. This is to prevent the | |||
7966 | // result from being converted later to a function symbol if it is called | |||
7967 | // inside the function. | |||
7968 | // If the result is function pointer, then ConvertToObjectEntity will not | |||
7969 | // convert the result to an object, and calling the symbol inside the function | |||
7970 | // will result in calls to the result pointer. | |||
7971 | // A function cannot be called recursively if RESULT was not used to define a | |||
7972 | // distinct result name (15.6.2.2 point 4.). | |||
7973 | if (Symbol * symbol{scope.symbol()}) { | |||
7974 | if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { | |||
7975 | if (details->isFunction()) { | |||
7976 | ConvertToObjectEntity(const_cast<Symbol &>(details->result())); | |||
7977 | } | |||
7978 | } | |||
7979 | } | |||
7980 | if (node.IsModule()) { | |||
7981 | ApplyDefaultAccess(); | |||
7982 | } | |||
7983 | for (auto &child : node.children()) { | |||
7984 | ResolveSpecificationParts(child); | |||
7985 | } | |||
7986 | ExecutionPartSkimmer{*this}.Walk(node.exec()); | |||
7987 | EndScopeForNode(node); | |||
7988 | // Ensure that every object entity has a type. | |||
7989 | for (auto &pair : *node.scope()) { | |||
7990 | ApplyImplicitRules(*pair.second); | |||
7991 | } | |||
7992 | } | |||
7993 | ||||
7994 | // Add SubprogramNameDetails symbols for module and internal subprograms and | |||
7995 | // their ENTRY statements. | |||
7996 | void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) { | |||
7997 | auto kind{ | |||
7998 | node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal}; | |||
7999 | for (auto &child : node.children()) { | |||
8000 | auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})}; | |||
8001 | if (child.HasModulePrefix()) { | |||
8002 | SetExplicitAttr(symbol, Attr::MODULE); | |||
8003 | } | |||
8004 | auto childKind{child.GetKind()}; | |||
8005 | if (childKind == ProgramTree::Kind::Function) { | |||
8006 | symbol.set(Symbol::Flag::Function); | |||
8007 | } else if (childKind == ProgramTree::Kind::Subroutine) { | |||
8008 | symbol.set(Symbol::Flag::Subroutine); | |||
8009 | } else { | |||
8010 | continue; // make ENTRY symbols only where valid | |||
8011 | } | |||
8012 | for (const auto &entryStmt : child.entryStmts()) { | |||
8013 | SubprogramNameDetails details{kind, child}; | |||
8014 | auto &symbol{ | |||
8015 | MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))}; | |||
8016 | symbol.set(child.GetSubpFlag()); | |||
8017 | if (child.HasModulePrefix()) { | |||
8018 | SetExplicitAttr(symbol, Attr::MODULE); | |||
8019 | } | |||
8020 | } | |||
8021 | } | |||
8022 | for (const auto &generic : node.genericSpecs()) { | |||
8023 | if (const auto *name{std::get_if<parser::Name>(&generic->u)}) { | |||
8024 | if (currScope().find(name->source) != currScope().end()) { | |||
8025 | // If this scope has both a generic interface and a contained | |||
8026 | // subprogram with the same name, create the generic's symbol | |||
8027 | // now so that any other generics of the same name that are pulled | |||
8028 | // into scope later via USE association will properly merge instead | |||
8029 | // of raising a bogus error due a conflict with the subprogram. | |||
8030 | CreateGeneric(*generic); | |||
8031 | } | |||
8032 | } | |||
8033 | } | |||
8034 | } | |||
8035 | ||||
8036 | // Push a new scope for this node or return false on error. | |||
8037 | bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) { | |||
8038 | switch (node.GetKind()) { | |||
8039 | SWITCH_COVERS_ALL_CASES | |||
8040 | case ProgramTree::Kind::Program: | |||
8041 | PushScope(Scope::Kind::MainProgram, | |||
8042 | &MakeSymbol(node.name(), MainProgramDetails{})); | |||
8043 | return true; | |||
8044 | case ProgramTree::Kind::Function: | |||
8045 | case ProgramTree::Kind::Subroutine: | |||
8046 | return BeginSubprogram(node.name(), node.GetSubpFlag(), | |||
8047 | node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts()); | |||
8048 | case ProgramTree::Kind::MpSubprogram: | |||
8049 | return BeginMpSubprogram(node.name()); | |||
8050 | case ProgramTree::Kind::Module: | |||
8051 | BeginModule(node.name(), false); | |||
8052 | return true; | |||
8053 | case ProgramTree::Kind::Submodule: | |||
8054 | return BeginSubmodule(node.name(), node.GetParentId()); | |||
8055 | case ProgramTree::Kind::BlockData: | |||
8056 | PushBlockDataScope(node.name()); | |||
8057 | return true; | |||
8058 | } | |||
8059 | } | |||
8060 | ||||
8061 | void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) { | |||
8062 | std::optional<parser::CharBlock> stmtSource; | |||
8063 | const std::optional<parser::LanguageBindingSpec> *binding{nullptr}; | |||
8064 | common::visit( | |||
8065 | common::visitors{ | |||
8066 | [&](const parser::Statement<parser::FunctionStmt> *stmt) { | |||
8067 | if (stmt) { | |||
8068 | stmtSource = stmt->source; | |||
8069 | if (const auto &maybeSuffix{ | |||
8070 | std::get<std::optional<parser::Suffix>>( | |||
8071 | stmt->statement.t)}) { | |||
8072 | binding = &maybeSuffix->binding; | |||
8073 | } | |||
8074 | } | |||
8075 | }, | |||
8076 | [&](const parser::Statement<parser::SubroutineStmt> *stmt) { | |||
8077 | if (stmt) { | |||
8078 | stmtSource = stmt->source; | |||
8079 | binding = &std::get<std::optional<parser::LanguageBindingSpec>>( | |||
8080 | stmt->statement.t); | |||
8081 | } | |||
8082 | }, | |||
8083 | [](const auto *) {}, | |||
8084 | }, | |||
8085 | node.stmt()); | |||
8086 | EndSubprogram(stmtSource, binding, &node.entryStmts()); | |||
8087 | } | |||
8088 | ||||
8089 | // Some analyses and checks, such as the processing of initializers of | |||
8090 | // pointers, are deferred until all of the pertinent specification parts | |||
8091 | // have been visited. This deferred processing enables the use of forward | |||
8092 | // references in these circumstances. | |||
8093 | class DeferredCheckVisitor { | |||
8094 | public: | |||
8095 | explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver) | |||
8096 | : resolver_{resolver} {} | |||
8097 | ||||
8098 | template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } | |||
8099 | ||||
8100 | template <typename A> bool Pre(const A &) { return true; } | |||
8101 | template <typename A> void Post(const A &) {} | |||
8102 | ||||
8103 | void Post(const parser::DerivedTypeStmt &x) { | |||
8104 | const auto &name{std::get<parser::Name>(x.t)}; | |||
8105 | if (Symbol * symbol{name.symbol}) { | |||
8106 | if (Scope * scope{symbol->scope()}) { | |||
8107 | if (scope->IsDerivedType()) { | |||
8108 | resolver_.PushScope(*scope); | |||
8109 | pushedScope_ = true; | |||
8110 | } | |||
8111 | } | |||
8112 | } | |||
8113 | } | |||
8114 | void Post(const parser::EndTypeStmt &) { | |||
8115 | if (pushedScope_) { | |||
8116 | resolver_.PopScope(); | |||
8117 | pushedScope_ = false; | |||
8118 | } | |||
8119 | } | |||
8120 | ||||
8121 | void Post(const parser::ProcInterface &pi) { | |||
8122 | if (const auto *name{std::get_if<parser::Name>(&pi.u)}) { | |||
8123 | resolver_.CheckExplicitInterface(*name); | |||
8124 | } | |||
8125 | } | |||
8126 | bool Pre(const parser::EntityDecl &decl) { | |||
8127 | Init(std::get<parser::Name>(decl.t), | |||
8128 | std::get<std::optional<parser::Initialization>>(decl.t)); | |||
8129 | return false; | |||
8130 | } | |||
8131 | bool Pre(const parser::ComponentDecl &decl) { | |||
8132 | Init(std::get<parser::Name>(decl.t), | |||
8133 | std::get<std::optional<parser::Initialization>>(decl.t)); | |||
8134 | return false; | |||
8135 | } | |||
8136 | bool Pre(const parser::ProcDecl &decl) { | |||
8137 | if (const auto &init{ | |||
8138 | std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) { | |||
8139 | resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init); | |||
8140 | } | |||
8141 | return false; | |||
8142 | } | |||
8143 | void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) { | |||
8144 | resolver_.CheckExplicitInterface(tbps.interfaceName); | |||
8145 | } | |||
8146 | void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { | |||
8147 | if (pushedScope_) { | |||
8148 | resolver_.CheckBindings(tbps); | |||
8149 | } | |||
8150 | } | |||
8151 | bool Pre(const parser::StmtFunctionStmt &stmtFunc) { return false; } | |||
8152 | ||||
8153 | private: | |||
8154 | void Init(const parser::Name &name, | |||
8155 | const std::optional<parser::Initialization> &init) { | |||
8156 | if (init) { | |||
8157 | if (const auto *target{ | |||
8158 | std::get_if<parser::InitialDataTarget>(&init->u)}) { | |||
8159 | resolver_.PointerInitialization(name, *target); | |||
8160 | } | |||
8161 | } | |||
8162 | } | |||
8163 | ||||
8164 | ResolveNamesVisitor &resolver_; | |||
8165 | bool pushedScope_{false}; | |||
8166 | }; | |||
8167 | ||||
8168 | // Perform checks and completions that need to happen after all of | |||
8169 | // the specification parts but before any of the execution parts. | |||
8170 | void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) { | |||
8171 | if (!node.scope()) { | |||
8172 | return; // error occurred creating scope | |||
8173 | } | |||
8174 | SetScope(*node.scope()); | |||
8175 | // The initializers of pointers, the default initializers of pointer | |||
8176 | // components, non-deferred type-bound procedure bindings have not | |||
8177 | // yet been traversed. | |||
8178 | // We do that now, when any (formerly) forward references that appear | |||
8179 | // in those initializers will resolve to the right symbols without | |||
8180 | // incurring spurious errors with IMPLICIT NONE. | |||
8181 | DeferredCheckVisitor{*this}.Walk(node.spec()); | |||
8182 | DeferredCheckVisitor{*this}.Walk(node.exec()); // for BLOCK | |||
8183 | for (Scope &childScope : currScope().children()) { | |||
8184 | if (childScope.IsParameterizedDerivedTypeInstantiation()) { | |||
8185 | FinishDerivedTypeInstantiation(childScope); | |||
8186 | } | |||
8187 | } | |||
8188 | for (const auto &child : node.children()) { | |||
8189 | FinishSpecificationParts(child); | |||
8190 | } | |||
8191 | } | |||
8192 | ||||
8193 | // Duplicate and fold component object pointer default initializer designators | |||
8194 | // using the actual type parameter values of each particular instantiation. | |||
8195 | // Validation is done later in declaration checking. | |||
8196 | void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) { | |||
8197 | CHECK(scope.IsDerivedType() && !scope.symbol())((scope.IsDerivedType() && !scope.symbol()) || (Fortran ::common::die("CHECK(" "scope.IsDerivedType() && !scope.symbol()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 8197), false)); | |||
8198 | if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) { | |||
8199 | spec->Instantiate(currScope()); | |||
8200 | const Symbol &origTypeSymbol{spec->typeSymbol()}; | |||
8201 | if (const Scope * origTypeScope{origTypeSymbol.scope()}) { | |||
8202 | CHECK(origTypeScope->IsDerivedType() &&((origTypeScope->IsDerivedType() && origTypeScope-> symbol() == &origTypeSymbol) || (Fortran::common::die("CHECK(" "origTypeScope->IsDerivedType() && origTypeScope->symbol() == &origTypeSymbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 8203), false)) | |||
8203 | origTypeScope->symbol() == &origTypeSymbol)((origTypeScope->IsDerivedType() && origTypeScope-> symbol() == &origTypeSymbol) || (Fortran::common::die("CHECK(" "origTypeScope->IsDerivedType() && origTypeScope->symbol() == &origTypeSymbol" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 8203), false)); | |||
8204 | auto &foldingContext{GetFoldingContext()}; | |||
8205 | auto restorer{foldingContext.WithPDTInstance(*spec)}; | |||
8206 | for (auto &pair : scope) { | |||
8207 | Symbol &comp{*pair.second}; | |||
8208 | const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))Fortran::common::Deref(FindInScope(*origTypeScope, comp.name( )), "flang/lib/Semantics/resolve-names.cpp", 8208)}; | |||
8209 | if (IsPointer(comp)) { | |||
8210 | if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) { | |||
8211 | auto origDetails{origComp.get<ObjectEntityDetails>()}; | |||
8212 | if (const MaybeExpr & init{origDetails.init()}) { | |||
8213 | SomeExpr newInit{*init}; | |||
8214 | MaybeExpr folded{ | |||
8215 | evaluate::Fold(foldingContext, std::move(newInit))}; | |||
8216 | details->set_init(std::move(folded)); | |||
8217 | } | |||
8218 | } | |||
8219 | } | |||
8220 | } | |||
8221 | } | |||
8222 | } | |||
8223 | } | |||
8224 | ||||
8225 | // Resolve names in the execution part of this node and its children | |||
8226 | void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) { | |||
8227 | if (!node.scope()) { | |||
8228 | return; // error occurred creating scope | |||
8229 | } | |||
8230 | SetScope(*node.scope()); | |||
8231 | if (const auto *exec{node.exec()}) { | |||
8232 | Walk(*exec); | |||
8233 | } | |||
8234 | FinishNamelists(); | |||
8235 | PopScope(); // converts unclassified entities into objects | |||
8236 | for (const auto &child : node.children()) { | |||
8237 | ResolveExecutionParts(child); | |||
8238 | } | |||
8239 | } | |||
8240 | ||||
8241 | void ResolveNamesVisitor::Post(const parser::Program &) { | |||
8242 | // ensure that all temps were deallocated | |||
8243 | CHECK(!attrs_)((!attrs_) || (Fortran::common::die("CHECK(" "!attrs_" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)", 8243) , false)); | |||
8244 | CHECK(!GetDeclTypeSpec())((!GetDeclTypeSpec()) || (Fortran::common::die("CHECK(" "!GetDeclTypeSpec()" ") failed" " at " "flang/lib/Semantics/resolve-names.cpp" "(%d)" , 8244), false)); | |||
8245 | } | |||
8246 | ||||
8247 | // A singleton instance of the scope -> IMPLICIT rules mapping is | |||
8248 | // shared by all instances of ResolveNamesVisitor and accessed by this | |||
8249 | // pointer when the visitors (other than the top-level original) are | |||
8250 | // constructed. | |||
8251 | static ImplicitRulesMap *sharedImplicitRulesMap{nullptr}; | |||
8252 | ||||
8253 | bool ResolveNames( | |||
8254 | SemanticsContext &context, const parser::Program &program, Scope &top) { | |||
8255 | ImplicitRulesMap implicitRulesMap; | |||
8256 | auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)}; | |||
8257 | ResolveNamesVisitor{context, implicitRulesMap, top}.Walk(program); | |||
8258 | return !context.AnyFatalError(); | |||
8259 | } | |||
8260 | ||||
8261 | // Processes a module (but not internal) function when it is referenced | |||
8262 | // in a specification expression in a sibling procedure. | |||
8263 | void ResolveSpecificationParts( | |||
8264 | SemanticsContext &context, const Symbol &subprogram) { | |||
8265 | auto originalLocation{context.location()}; | |||
8266 | ImplicitRulesMap implicitRulesMap; | |||
8267 | bool localImplicitRulesMap{false}; | |||
8268 | if (!sharedImplicitRulesMap) { | |||
8269 | sharedImplicitRulesMap = &implicitRulesMap; | |||
8270 | localImplicitRulesMap = true; | |||
8271 | } | |||
8272 | ResolveNamesVisitor visitor{ | |||
8273 | context, *sharedImplicitRulesMap, context.globalScope()}; | |||
8274 | const auto &details{subprogram.get<SubprogramNameDetails>()}; | |||
8275 | ProgramTree &node{details.node()}; | |||
8276 | const Scope &moduleScope{subprogram.owner()}; | |||
8277 | if (localImplicitRulesMap) { | |||
8278 | visitor.BeginScope(const_cast<Scope &>(moduleScope)); | |||
8279 | } else { | |||
8280 | visitor.SetScope(const_cast<Scope &>(moduleScope)); | |||
8281 | } | |||
8282 | visitor.ResolveSpecificationParts(node); | |||
8283 | context.set_location(std::move(originalLocation)); | |||
8284 | if (localImplicitRulesMap) { | |||
8285 | sharedImplicitRulesMap = nullptr; | |||
8286 | } | |||
8287 | } | |||
8288 | ||||
8289 | } // namespace Fortran::semantics |