Warning: This file is not a C or C++ file. It does not have highlighting.

1//===-- include/flang/Semantics/tools.h -------------------------*- C++ -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8
9#ifndef FORTRAN_SEMANTICS_TOOLS_H_
10#define FORTRAN_SEMANTICS_TOOLS_H_
11
12// Simple predicates and look-up functions that are best defined
13// canonically for use in semantic checking.
14
15#include "flang/Common/Fortran.h"
16#include "flang/Common/visit.h"
17#include "flang/Evaluate/expression.h"
18#include "flang/Evaluate/shape.h"
19#include "flang/Evaluate/type.h"
20#include "flang/Evaluate/variable.h"
21#include "flang/Parser/message.h"
22#include "flang/Parser/parse-tree.h"
23#include "flang/Semantics/attr.h"
24#include "flang/Semantics/expression.h"
25#include "flang/Semantics/semantics.h"
26#include <functional>
27
28namespace Fortran::semantics {
29
30class DeclTypeSpec;
31class DerivedTypeSpec;
32class Scope;
33class Symbol;
34
35// Note: Here ProgramUnit includes internal subprograms while TopLevelUnit
36// does not. "program-unit" in the Fortran standard matches TopLevelUnit.
37const Scope &GetTopLevelUnitContaining(const Scope &);
38const Scope &GetTopLevelUnitContaining(const Symbol &);
39const Scope &GetProgramUnitContaining(const Scope &);
40const Scope &GetProgramUnitContaining(const Symbol &);
41const Scope &GetProgramUnitOrBlockConstructContaining(const Scope &);
42const Scope &GetProgramUnitOrBlockConstructContaining(const Symbol &);
43
44const Scope *FindModuleContaining(const Scope &);
45const Scope *FindModuleFileContaining(const Scope &);
46const Scope *FindPureProcedureContaining(const Scope &);
47const Scope *FindOpenACCConstructContaining(const Scope *);
48
49const Symbol *FindPointerComponent(const Scope &);
50const Symbol *FindPointerComponent(const DerivedTypeSpec &);
51const Symbol *FindPointerComponent(const DeclTypeSpec &);
52const Symbol *FindPointerComponent(const Symbol &);
53const Symbol *FindInterface(const Symbol &);
54const Symbol *FindSubprogram(const Symbol &);
55const Symbol *FindFunctionResult(const Symbol &);
56const Symbol *FindOverriddenBinding(
57 const Symbol &, bool &isInaccessibleDeferred);
58const Symbol *FindGlobal(const Symbol &);
59
60const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &);
61const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
62const DeclTypeSpec *FindParentTypeSpec(const Scope &);
63const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
64
65const EquivalenceSet *FindEquivalenceSet(const Symbol &);
66
67enum class Tristate { No, Yes, Maybe };
68inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; }
69
70// Is this a user-defined assignment? If both sides are the same derived type
71// (and the ranks are okay) the answer is Maybe.
72Tristate IsDefinedAssignment(
73 const std::optional<evaluate::DynamicType> &lhsType, int lhsRank,
74 const std::optional<evaluate::DynamicType> &rhsType, int rhsRank);
75// Test for intrinsic unary and binary operators based on types and ranks
76bool IsIntrinsicRelational(common::RelationalOperator,
77 const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
78bool IsIntrinsicNumeric(const evaluate::DynamicType &);
79bool IsIntrinsicNumeric(
80 const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
81bool IsIntrinsicLogical(const evaluate::DynamicType &);
82bool IsIntrinsicLogical(
83 const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
84bool IsIntrinsicConcat(
85 const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
86
87bool IsGenericDefinedOp(const Symbol &);
88bool IsDefinedOperator(SourceName);
89std::string MakeOpName(SourceName);
90
91// Returns true if maybeAncestor exists and is a proper ancestor of a
92// descendent scope (or symbol owner). Will be false, unlike Scope::Contains(),
93// if maybeAncestor *is* the descendent.
94bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent);
95bool DoesScopeContain(const Scope *, const Symbol &);
96
97bool IsUseAssociated(const Symbol &, const Scope &);
98bool IsHostAssociated(const Symbol &, const Scope &);
99bool IsHostAssociatedIntoSubprogram(const Symbol &, const Scope &);
100inline bool IsStmtFunction(const Symbol &symbol) {
101 const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
102 return subprogram && subprogram->stmtFunction();
103}
104bool IsInStmtFunction(const Symbol &);
105bool IsStmtFunctionDummy(const Symbol &);
106bool IsStmtFunctionResult(const Symbol &);
107bool IsPointerDummy(const Symbol &);
108bool IsBindCProcedure(const Symbol &);
109bool IsBindCProcedure(const Scope &);
110// Returns a pointer to the function's symbol when true, else null
111const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &);
112bool IsOrContainsEventOrLockComponent(const Symbol &);
113bool CanBeTypeBoundProc(const Symbol &);
114// Does a non-PARAMETER symbol have explicit initialization with =value or
115// =>target in its declaration (but not in a DATA statement)? (Being
116// ALLOCATABLE or having a derived type with default component initialization
117// doesn't count; it must be a variable initialization that implies the SAVE
118// attribute, or a derived type component default value.)
119bool HasDeclarationInitializer(const Symbol &);
120// Is the symbol explicitly or implicitly initialized in any way?
121bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
122 bool ignoreAllocatable = false, bool ignorePointer = true);
123// Is the symbol a component subject to deallocation or finalization?
124bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
125bool HasIntrinsicTypeName(const Symbol &);
126bool IsSeparateModuleProcedureInterface(const Symbol *);
127bool HasAlternateReturns(const Symbol &);
128bool IsAutomaticallyDestroyed(const Symbol &);
129
130// Return an ultimate component of type that matches predicate, or nullptr.
131const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
132 const std::function<bool(const Symbol &)> &predicate);
133const Symbol *FindUltimateComponent(
134 const Symbol &symbol, const std::function<bool(const Symbol &)> &predicate);
135
136// Returns an immediate component of type that matches predicate, or nullptr.
137// An immediate component of a type is one declared for that type or is an
138// immediate component of the type that it extends.
139const Symbol *FindImmediateComponent(
140 const DerivedTypeSpec &, const std::function<bool(const Symbol &)> &);
141
142inline bool IsPointer(const Symbol &symbol) {
143 return symbol.attrs().test(Attr::POINTER);
144}
145inline bool IsAllocatable(const Symbol &symbol) {
146 return symbol.attrs().test(Attr::ALLOCATABLE);
147}
148inline bool IsValue(const Symbol &symbol) {
149 return symbol.attrs().test(Attr::VALUE);
150}
151// IsAllocatableOrObjectPointer() may be the better choice
152inline bool IsAllocatableOrPointer(const Symbol &symbol) {
153 return IsPointer(symbol) || IsAllocatable(symbol);
154}
155inline bool IsNamedConstant(const Symbol &symbol) {
156 return symbol.attrs().test(Attr::PARAMETER);
157}
158inline bool IsOptional(const Symbol &symbol) {
159 return symbol.attrs().test(Attr::OPTIONAL);
160}
161inline bool IsIntentIn(const Symbol &symbol) {
162 return symbol.attrs().test(Attr::INTENT_IN);
163}
164inline bool IsIntentInOut(const Symbol &symbol) {
165 return symbol.attrs().test(Attr::INTENT_INOUT);
166}
167inline bool IsIntentOut(const Symbol &symbol) {
168 return symbol.attrs().test(Attr::INTENT_OUT);
169}
170inline bool IsProtected(const Symbol &symbol) {
171 return symbol.attrs().test(Attr::PROTECTED);
172}
173inline bool IsImpliedDoIndex(const Symbol &symbol) {
174 return symbol.owner().kind() == Scope::Kind::ImpliedDos;
175}
176SymbolVector FinalsForDerivedTypeInstantiation(const DerivedTypeSpec &);
177// Returns a non-null pointer to a FINAL procedure, if any.
178const Symbol *IsFinalizable(const Symbol &,
179 std::set<const DerivedTypeSpec *> * = nullptr,
180 bool withImpureFinalizer = false);
181const Symbol *IsFinalizable(const DerivedTypeSpec &,
182 std::set<const DerivedTypeSpec *> * = nullptr,
183 bool withImpureFinalizer = false, std::optional<int> rank = std::nullopt);
184const Symbol *HasImpureFinal(
185 const Symbol &, std::optional<int> rank = std::nullopt);
186// Is this type finalizable or does it contain any polymorphic allocatable
187// ultimate components?
188bool MayRequireFinalization(const DerivedTypeSpec &derived);
189// Does this type have an allocatable direct component?
190bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);
191
192bool IsInBlankCommon(const Symbol &);
193bool IsAssumedLengthCharacter(const Symbol &);
194bool IsExternal(const Symbol &);
195bool IsModuleProcedure(const Symbol &);
196bool HasCoarray(const parser::Expr &);
197bool IsAssumedType(const Symbol &);
198bool IsPolymorphic(const Symbol &);
199bool IsUnlimitedPolymorphic(const Symbol &);
200bool IsPolymorphicAllocatable(const Symbol &);
201
202inline bool IsCUDADeviceContext(const Scope *scope) {
203 if (scope) {
204 if (const Symbol * symbol{scope->symbol()}) {
205 if (const auto *subp{symbol->detailsIf<SubprogramDetails>()}) {
206 if (auto attrs{subp->cudaSubprogramAttrs()}) {
207 return *attrs != common::CUDASubprogramAttrs::Host;
208 }
209 }
210 }
211 }
212 return false;
213}
214
215inline bool HasCUDAAttr(const Symbol &sym) {
216 if (const auto *details{
217 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
218 if (details->cudaDataAttr()) {
219 return true;
220 }
221 }
222 return false;
223}
224
225const Scope *FindCUDADeviceContext(const Scope *);
226std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *);
227
228// Return an error if a symbol is not accessible from a scope
229std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
230 const semantics::Scope &, const Symbol &);
231
232// Analysis of image control statements
233bool IsImageControlStmt(const parser::ExecutableConstruct &);
234// Get the location of the image control statement in this ExecutableConstruct
235parser::CharBlock GetImageControlStmtLocation(
236 const parser::ExecutableConstruct &);
237// Image control statements that reference coarrays need an extra message
238// to clarify why they're image control statements. This function returns
239// std::nullopt for ExecutableConstructs that do not require an extra message.
240std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
241 const parser::ExecutableConstruct &);
242
243// Returns the complete list of derived type parameter symbols in
244// the order in which their declarations appear in the derived type
245// definitions (parents first).
246SymbolVector OrderParameterDeclarations(const Symbol &);
247// Returns the complete list of derived type parameter names in the
248// order defined by 7.5.3.2.
249std::list<SourceName> OrderParameterNames(const Symbol &);
250
251// Return an existing or new derived type instance
252const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
253 DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
254
255// When a subprogram defined in a submodule defines a separate module
256// procedure whose interface is defined in an ancestor (sub)module,
257// returns a pointer to that interface, else null.
258const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
259
260// Determines whether an object might be visible outside a
261// pure function (C1594); returns a non-null Symbol pointer for
262// diagnostic purposes if so.
263const Symbol *FindExternallyVisibleObject(
264 const Symbol &, const Scope &, bool isPointerDefinition);
265
266template <typename A>
267const Symbol *FindExternallyVisibleObject(const A &, const Scope &) {
268 return nullptr; // default base case
269}
270
271template <typename T>
272const Symbol *FindExternallyVisibleObject(
273 const evaluate::Designator<T> &designator, const Scope &scope) {
274 if (const Symbol * symbol{designator.GetBaseObject().symbol()}) {
275 return FindExternallyVisibleObject(*symbol, scope, false);
276 } else if (std::holds_alternative<evaluate::CoarrayRef>(designator.u)) {
277 // Coindexed values are visible even if their image-local objects are not.
278 return designator.GetBaseObject().symbol();
279 } else {
280 return nullptr;
281 }
282}
283
284template <typename T>
285const Symbol *FindExternallyVisibleObject(
286 const evaluate::Expr<T> &expr, const Scope &scope) {
287 return common::visit(
288 [&](const auto &x) { return FindExternallyVisibleObject(x, scope); },
289 expr.u);
290}
291
292// Applies GetUltimate(), then if the symbol is a generic procedure shadowing a
293// specific procedure of the same name, return it instead.
294const Symbol &BypassGeneric(const Symbol &);
295
296// Given a cray pointee symbol, returns the related cray pointer symbol.
297const Symbol &GetCrayPointer(const Symbol &crayPointee);
298
299using SomeExpr = evaluate::Expr<evaluate::SomeType>;
300
301bool ExprHasTypeCategory(
302 const SomeExpr &expr, const common::TypeCategory &type);
303bool ExprTypeKindIsDefault(
304 const SomeExpr &expr, const SemanticsContext &context);
305
306class GetExprHelper {
307public:
308 explicit GetExprHelper(SemanticsContext *context) : context_{context} {}
309 GetExprHelper() : crashIfNoExpr_{true} {}
310
311 // Specializations for parse tree nodes that have a typedExpr member.
312 const SomeExpr *Get(const parser::Expr &);
313 const SomeExpr *Get(const parser::Variable &);
314 const SomeExpr *Get(const parser::DataStmtConstant &);
315 const SomeExpr *Get(const parser::AllocateObject &);
316 const SomeExpr *Get(const parser::PointerObject &);
317
318 template <typename T> const SomeExpr *Get(const common::Indirection<T> &x) {
319 return Get(x.value());
320 }
321 template <typename T> const SomeExpr *Get(const std::optional<T> &x) {
322 return x ? Get(*x) : nullptr;
323 }
324 template <typename T> const SomeExpr *Get(const T &x) {
325 static_assert(
326 !parser::HasTypedExpr<T>::value, "explicit Get overload must be added");
327 if constexpr (ConstraintTrait<T>) {
328 return Get(x.thing);
329 } else if constexpr (WrapperTrait<T>) {
330 return Get(x.v);
331 } else {
332 return nullptr;
333 }
334 }
335
336private:
337 SemanticsContext *context_{nullptr};
338 const bool crashIfNoExpr_{false};
339};
340
341// If a SemanticsContext is passed, even if null, it is possible for a null
342// pointer to be returned in the event of an expression that had fatal errors.
343// Use these first two forms in semantics checks for best error recovery.
344// If a SemanticsContext is not passed, a missing expression will
345// cause a crash.
346template <typename T>
347const SomeExpr *GetExpr(SemanticsContext *context, const T &x) {
348 return GetExprHelper{context}.Get(x);
349}
350template <typename T>
351const SomeExpr *GetExpr(SemanticsContext &context, const T &x) {
352 return GetExprHelper{&context}.Get(x);
353}
354template <typename T> const SomeExpr *GetExpr(const T &x) {
355 return GetExprHelper{}.Get(x);
356}
357
358const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &);
359const evaluate::Assignment *GetAssignment(
360 const parser::PointerAssignmentStmt &);
361
362template <typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
363 if (const auto *expr{GetExpr(nullptr, x)}) {
364 return evaluate::ToInt64(*expr);
365 } else {
366 return std::nullopt;
367 }
368}
369
370template <typename T> bool IsZero(const T &expr) {
371 auto value{GetIntValue(expr)};
372 return value && *value == 0;
373}
374
375// 15.2.2
376enum class ProcedureDefinitionClass {
377 None,
378 Intrinsic,
379 External,
380 Internal,
381 Module,
382 Dummy,
383 Pointer,
384 StatementFunction
385};
386
387ProcedureDefinitionClass ClassifyProcedure(const Symbol &);
388
389// Returns a list of storage associations due to EQUIVALENCE in a
390// scope; each storage association is a list of symbol references
391// in ascending order of scope offset. Note that the scope may have
392// more EquivalenceSets than this function's result has storage
393// associations; these are closures over equivalences.
394std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &);
395
396// Derived type component iterator that provides a C++ LegacyForwardIterator
397// iterator over the Ordered, Direct, Ultimate or Potential components of a
398// DerivedTypeSpec. These iterators can be used with STL algorithms
399// accepting LegacyForwardIterator.
400// The kind of component is a template argument of the iterator factory
401// ComponentIterator.
402//
403// - Ordered components are the components from the component order defined
404// in 7.5.4.7, except that the parent component IS added between the parent
405// component order and the components in order of declaration.
406// This "deviation" is important for structure-constructor analysis.
407// For this kind of iterator, the component tree is recursively visited in the
408// following order:
409// - first, the Ordered components of the parent type (if relevant)
410// - then, the parent component (if relevant, different from 7.5.4.7!)
411// - then, the components in declaration order (without visiting subcomponents)
412//
413// - Ultimate, Direct and Potential components are as defined in 7.5.1.
414// - Ultimate components of a derived type are the closure of its components
415// of intrinsic type, its ALLOCATABLE or POINTER components, and the
416// ultimate components of its non-ALLOCATABLE non-POINTER derived type
417// components. (No ultimate component has a derived type unless it is
418// ALLOCATABLE or POINTER.)
419// - Direct components of a derived type are all of its components, and all
420// of the direct components of its non-ALLOCATABLE non-POINTER derived type
421// components. (Direct components are always present.)
422// - Potential subobject components of a derived type are the closure of
423// its non-POINTER components and the potential subobject components of
424// its non-POINTER derived type components. (The lifetime of each
425// potential subobject component is that of the entire instance.)
426// - PotentialAndPointer subobject components of a derived type are the
427// closure of its components (including POINTERs) and the
428// PotentialAndPointer subobject components of its non-POINTER derived type
429// components.
430// Parent and procedure components are considered against these definitions.
431// For this kind of iterator, the component tree is recursively visited in the
432// following order:
433// - the parent component first (if relevant)
434// - then, the components of the parent type (if relevant)
435// + visiting the component and then, if it is derived type data component,
436// visiting the subcomponents before visiting the next
437// component in declaration order.
438// - then, components in declaration order, similarly to components of parent
439// type.
440// Here, the parent component is visited first so that search for a component
441// verifying a property will never descend into a component that already
442// verifies the property (this helps giving clearer feedback).
443//
444// ComponentIterator::const_iterator remain valid during the whole lifetime of
445// the DerivedTypeSpec passed by reference to the ComponentIterator factory.
446// Their validity is independent of the ComponentIterator factory lifetime.
447//
448// For safety and simplicity, the iterators are read only and can only be
449// incremented. This could be changed if desired.
450//
451// Note that iterators are made in such a way that one can easily test and build
452// info message in the following way:
453// ComponentIterator<ComponentKind::...> comp{derived}
454// if (auto it{std::find_if(comp.begin(), comp.end(), predicate)}) {
455// msg = it.BuildResultDesignatorName() + " verifies predicates";
456// const Symbol *component{*it};
457// ....
458// }
459
460ENUM_CLASS(ComponentKind, Ordered, Direct, Ultimate, Potential, Scope,
461 PotentialAndPointer)
462
463template <ComponentKind componentKind> class ComponentIterator {
464public:
465 ComponentIterator(const DerivedTypeSpec &derived) : derived_{derived} {}
466 class const_iterator {
467 public:
468 using iterator_category = std::forward_iterator_tag;
469 using value_type = SymbolRef;
470 using difference_type = void;
471 using pointer = const Symbol *;
472 using reference = const Symbol &;
473
474 static const_iterator Create(const DerivedTypeSpec &);
475
476 const_iterator &operator++() {
477 Increment();
478 return *this;
479 }
480 const_iterator operator++(int) {
481 const_iterator tmp(*this);
482 Increment();
483 return tmp;
484 }
485 reference operator*() const {
486 CHECK(!componentPath_.empty());
487 return DEREF(componentPath_.back().component());
488 }
489 pointer operator->() const { return &**this; }
490
491 bool operator==(const const_iterator &other) const {
492 return componentPath_ == other.componentPath_;
493 }
494 bool operator!=(const const_iterator &other) const {
495 return !(*this == other);
496 }
497
498 // bool() operator indicates if the iterator can be dereferenced without
499 // having to check against an end() iterator.
500 explicit operator bool() const { return !componentPath_.empty(); }
501
502 // Builds a designator name of the referenced component for messages.
503 // The designator helps when the component referred to by the iterator
504 // may be "buried" into other components. This gives the full
505 // path inside the iterated derived type: e.g "%a%b%c%ultimate"
506 // when it->name() only gives "ultimate". Parent components are
507 // part of the path for clarity, even though they could be
508 // skipped.
509 std::string BuildResultDesignatorName() const;
510
511 private:
512 using name_iterator =
513 std::conditional_t<componentKind == ComponentKind::Scope,
514 typename Scope::const_iterator,
515 typename std::list<SourceName>::const_iterator>;
516
517 class ComponentPathNode {
518 public:
519 explicit ComponentPathNode(const DerivedTypeSpec &derived)
520 : derived_{derived} {
521 if constexpr (componentKind == ComponentKind::Scope) {
522 const Scope &scope{DEREF(derived.GetScope())};
523 nameIterator_ = scope.cbegin();
524 nameEnd_ = scope.cend();
525 } else {
526 const std::list<SourceName> &nameList{
527 derived.typeSymbol().get<DerivedTypeDetails>().componentNames()};
528 nameIterator_ = nameList.cbegin();
529 nameEnd_ = nameList.cend();
530 }
531 }
532 const Symbol *component() const { return component_; }
533 void set_component(const Symbol &component) { component_ = &component; }
534 bool visited() const { return visited_; }
535 void set_visited(bool yes) { visited_ = yes; }
536 bool descended() const { return descended_; }
537 void set_descended(bool yes) { descended_ = yes; }
538 name_iterator &nameIterator() { return nameIterator_; }
539 name_iterator nameEnd() { return nameEnd_; }
540 const Symbol &GetTypeSymbol() const { return derived_->typeSymbol(); }
541 const Scope &GetScope() const {
542 return derived_->scope() ? *derived_->scope()
543 : DEREF(GetTypeSymbol().scope());
544 }
545 bool operator==(const ComponentPathNode &that) const {
546 return &*derived_ == &*that.derived_ &&
547 nameIterator_ == that.nameIterator_ &&
548 component_ == that.component_;
549 }
550
551 private:
552 common::Reference<const DerivedTypeSpec> derived_;
553 name_iterator nameEnd_;
554 name_iterator nameIterator_;
555 const Symbol *component_{nullptr}; // until Increment()
556 bool visited_{false};
557 bool descended_{false};
558 };
559
560 const DerivedTypeSpec *PlanComponentTraversal(
561 const Symbol &component) const;
562 // Advances to the next relevant symbol, if any. Afterwards, the
563 // iterator will either be at its end or contain no null component().
564 void Increment();
565
566 std::vector<ComponentPathNode> componentPath_;
567 };
568
569 const_iterator begin() { return cbegin(); }
570 const_iterator end() { return cend(); }
571 const_iterator cbegin() { return const_iterator::Create(derived_); }
572 const_iterator cend() { return const_iterator{}; }
573
574private:
575 const DerivedTypeSpec &derived_;
576};
577
578extern template class ComponentIterator<ComponentKind::Ordered>;
579extern template class ComponentIterator<ComponentKind::Direct>;
580extern template class ComponentIterator<ComponentKind::Ultimate>;
581extern template class ComponentIterator<ComponentKind::Potential>;
582extern template class ComponentIterator<ComponentKind::Scope>;
583extern template class ComponentIterator<ComponentKind::PotentialAndPointer>;
584using OrderedComponentIterator = ComponentIterator<ComponentKind::Ordered>;
585using DirectComponentIterator = ComponentIterator<ComponentKind::Direct>;
586using UltimateComponentIterator = ComponentIterator<ComponentKind::Ultimate>;
587using PotentialComponentIterator = ComponentIterator<ComponentKind::Potential>;
588using ScopeComponentIterator = ComponentIterator<ComponentKind::Scope>;
589using PotentialAndPointerComponentIterator =
590 ComponentIterator<ComponentKind::PotentialAndPointer>;
591
592// Common component searches, the iterator returned is referring to the first
593// component, according to the order defined for the related ComponentIterator,
594// that verifies the property from the name.
595// If no component verifies the property, an end iterator (casting to false)
596// is returned. Otherwise, the returned iterator casts to true and can be
597// dereferenced.
598PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
599 const DerivedTypeSpec &);
600UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
601 const DerivedTypeSpec &);
602UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
603 const DerivedTypeSpec &);
604UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
605 const DerivedTypeSpec &);
606DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
607 const DerivedTypeSpec &);
608UltimateComponentIterator::const_iterator
609FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &);
610
611// The LabelEnforce class (given a set of labels) provides an error message if
612// there is a branch to a label which is not in the given set.
613class LabelEnforce {
614public:
615 LabelEnforce(SemanticsContext &context, std::set<parser::Label> &&labels,
616 parser::CharBlock constructSourcePosition, const char *construct)
617 : context_{context}, labels_{labels},
618 constructSourcePosition_{constructSourcePosition}, construct_{
619 construct} {}
620 template <typename T> bool Pre(const T &) { return true; }
621 template <typename T> bool Pre(const parser::Statement<T> &statement) {
622 currentStatementSourcePosition_ = statement.source;
623 return true;
624 }
625
626 template <typename T> void Post(const T &) {}
627
628 void Post(const parser::GotoStmt &gotoStmt);
629 void Post(const parser::ComputedGotoStmt &computedGotoStmt);
630 void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt);
631 void Post(const parser::AssignStmt &assignStmt);
632 void Post(const parser::AssignedGotoStmt &assignedGotoStmt);
633 void Post(const parser::AltReturnSpec &altReturnSpec);
634 void Post(const parser::ErrLabel &errLabel);
635 void Post(const parser::EndLabel &endLabel);
636 void Post(const parser::EorLabel &eorLabel);
637 void checkLabelUse(const parser::Label &labelUsed);
638
639private:
640 SemanticsContext &context_;
641 std::set<parser::Label> labels_;
642 parser::CharBlock currentStatementSourcePosition_{nullptr};
643 parser::CharBlock constructSourcePosition_{nullptr};
644 const char *construct_{nullptr};
645
646 parser::MessageFormattedText GetEnclosingConstructMsg();
647 void SayWithConstruct(SemanticsContext &context,
648 parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
649 parser::CharBlock constructLocation);
650};
651// Return the (possibly null) name of the ConstructNode
652const std::optional<parser::Name> &MaybeGetNodeName(
653 const ConstructNode &construct);
654
655// Convert evaluate::GetShape() result into an ArraySpec
656std::optional<ArraySpec> ToArraySpec(
657 evaluate::FoldingContext &, const evaluate::Shape &);
658std::optional<ArraySpec> ToArraySpec(
659 evaluate::FoldingContext &, const std::optional<evaluate::Shape> &);
660
661// Searches a derived type and a scope for a particular defined I/O procedure.
662bool HasDefinedIo(
663 common::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
664
665// Some intrinsic operators have more than one name (e.g. `operator(.eq.)` and
666// `operator(==)`). GetAllNames() returns them all, including symbolName.
667std::forward_list<std::string> GetAllNames(
668 const SemanticsContext &, const SourceName &);
669
670// Determines the derived type of a procedure's initial "dtv" dummy argument,
671// assuming that the procedure is a specific procedure of a defined I/O
672// generic interface,
673const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &);
674
675// If "expr" exists and is a designator for a deferred length
676// character allocatable whose semantics might change under Fortran 202X,
677// emit a portability warning.
678void WarnOnDeferredLengthCharacterScalar(SemanticsContext &, const SomeExpr *,
679 parser::CharBlock at, const char *what);
680
681inline const parser::Name *getDesignatorNameIfDataRef(
682 const parser::Designator &designator) {
683 const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
684 return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
685}
686
687bool CouldBeDataPointerValuedFunction(const Symbol *);
688
689template <typename R, typename T>
690std::optional<R> GetConstExpr(
691 Fortran::semantics::SemanticsContext &semanticsContext, const T &x) {
692 using DefaultCharConstantType = Fortran::evaluate::Ascii;
693 if (const auto *expr{Fortran::semantics::GetExpr(semanticsContext, x)}) {
694 const auto foldExpr{Fortran::evaluate::Fold(
695 semanticsContext.foldingContext(), Fortran::common::Clone(*expr))};
696 if constexpr (std::is_same_v<R, std::string>) {
697 return Fortran::evaluate::GetScalarConstantValue<DefaultCharConstantType>(
698 foldExpr);
699 }
700 }
701 return std::nullopt;
702}
703
704// Returns "m" for a module, "m:sm" for a submodule.
705std::string GetModuleOrSubmoduleName(const Symbol &);
706
707// Return the assembly name emitted for a common block.
708std::string GetCommonBlockObjectName(const Symbol &, bool underscoring);
709
710// Check for ambiguous USE associations
711bool HadUseError(SemanticsContext &, SourceName at, const Symbol *);
712
713} // namespace Fortran::semantics
714#endif // FORTRAN_SEMANTICS_TOOLS_H_
715

Warning: This file is not a C or C++ file. It does not have highlighting.

source code of flang/include/flang/Semantics/tools.h