1//===-- lib/Semantics/tools.cpp -------------------------------------------===//
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#include "flang/Parser/tools.h"
10#include "flang/Common/indirection.h"
11#include "flang/Parser/dump-parse-tree.h"
12#include "flang/Parser/message.h"
13#include "flang/Parser/parse-tree.h"
14#include "flang/Semantics/scope.h"
15#include "flang/Semantics/semantics.h"
16#include "flang/Semantics/symbol.h"
17#include "flang/Semantics/tools.h"
18#include "flang/Semantics/type.h"
19#include "flang/Support/Fortran.h"
20#include "llvm/Support/raw_ostream.h"
21#include <algorithm>
22#include <set>
23#include <variant>
24
25namespace Fortran::semantics {
26
27// Find this or containing scope that matches predicate
28static const Scope *FindScopeContaining(
29 const Scope &start, std::function<bool(const Scope &)> predicate) {
30 for (const Scope *scope{&start};; scope = &scope->parent()) {
31 if (predicate(*scope)) {
32 return scope;
33 }
34 if (scope->IsTopLevel()) {
35 return nullptr;
36 }
37 }
38}
39
40const Scope &GetTopLevelUnitContaining(const Scope &start) {
41 CHECK(!start.IsTopLevel());
42 return DEREF(FindScopeContaining(
43 start, [](const Scope &scope) { return scope.parent().IsTopLevel(); }));
44}
45
46const Scope &GetTopLevelUnitContaining(const Symbol &symbol) {
47 return GetTopLevelUnitContaining(symbol.owner());
48}
49
50const Scope *FindModuleContaining(const Scope &start) {
51 return FindScopeContaining(
52 start, [](const Scope &scope) { return scope.IsModule(); });
53}
54
55const Scope *FindModuleOrSubmoduleContaining(const Scope &start) {
56 return FindScopeContaining(start, [](const Scope &scope) {
57 return scope.IsModule() || scope.IsSubmodule();
58 });
59}
60
61const Scope *FindModuleFileContaining(const Scope &start) {
62 return FindScopeContaining(
63 start, [](const Scope &scope) { return scope.IsModuleFile(); });
64}
65
66const Scope &GetProgramUnitContaining(const Scope &start) {
67 CHECK(!start.IsTopLevel());
68 return DEREF(FindScopeContaining(start, [](const Scope &scope) {
69 switch (scope.kind()) {
70 case Scope::Kind::Module:
71 case Scope::Kind::MainProgram:
72 case Scope::Kind::Subprogram:
73 case Scope::Kind::BlockData:
74 return true;
75 default:
76 return false;
77 }
78 }));
79}
80
81const Scope &GetProgramUnitContaining(const Symbol &symbol) {
82 return GetProgramUnitContaining(symbol.owner());
83}
84
85const Scope &GetProgramUnitOrBlockConstructContaining(const Scope &start) {
86 CHECK(!start.IsTopLevel());
87 return DEREF(FindScopeContaining(start, [](const Scope &scope) {
88 switch (scope.kind()) {
89 case Scope::Kind::Module:
90 case Scope::Kind::MainProgram:
91 case Scope::Kind::Subprogram:
92 case Scope::Kind::BlockData:
93 case Scope::Kind::BlockConstruct:
94 return true;
95 default:
96 return false;
97 }
98 }));
99}
100
101const Scope &GetProgramUnitOrBlockConstructContaining(const Symbol &symbol) {
102 return GetProgramUnitOrBlockConstructContaining(symbol.owner());
103}
104
105const Scope *FindPureProcedureContaining(const Scope &start) {
106 // N.B. We only need to examine the innermost containing program unit
107 // because an internal subprogram of a pure subprogram must also
108 // be pure (C1592).
109 if (start.IsTopLevel()) {
110 return nullptr;
111 } else {
112 const Scope &scope{GetProgramUnitContaining(start)};
113 return IsPureProcedure(scope) ? &scope : nullptr;
114 }
115}
116
117const Scope *FindOpenACCConstructContaining(const Scope *scope) {
118 return scope ? FindScopeContaining(*scope,
119 [](const Scope &s) {
120 return s.kind() == Scope::Kind::OpenACCConstruct;
121 })
122 : nullptr;
123}
124
125// 7.5.2.4 "same derived type" test -- rely on IsTkCompatibleWith() and its
126// infrastructure to detect and handle comparisons on distinct (but "same")
127// sequence/bind(C) derived types
128static bool MightBeSameDerivedType(
129 const std::optional<evaluate::DynamicType> &lhsType,
130 const std::optional<evaluate::DynamicType> &rhsType) {
131 return lhsType && rhsType && lhsType->IsTkCompatibleWith(*rhsType);
132}
133
134Tristate IsDefinedAssignment(
135 const std::optional<evaluate::DynamicType> &lhsType, int lhsRank,
136 const std::optional<evaluate::DynamicType> &rhsType, int rhsRank) {
137 if (!lhsType || !rhsType) {
138 return Tristate::No; // error or rhs is untyped
139 }
140 TypeCategory lhsCat{lhsType->category()};
141 TypeCategory rhsCat{rhsType->category()};
142 if (rhsRank > 0 && lhsRank != rhsRank) {
143 return Tristate::Yes;
144 } else if (lhsCat != TypeCategory::Derived) {
145 return ToTristate(lhsCat != rhsCat &&
146 (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat) ||
147 lhsCat == TypeCategory::Unsigned ||
148 rhsCat == TypeCategory::Unsigned));
149 } else if (MightBeSameDerivedType(lhsType, rhsType)) {
150 return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
151 } else {
152 return Tristate::Yes;
153 }
154}
155
156bool IsIntrinsicRelational(common::RelationalOperator opr,
157 const evaluate::DynamicType &type0, int rank0,
158 const evaluate::DynamicType &type1, int rank1) {
159 if (!evaluate::AreConformable(rank0, rank1)) {
160 return false;
161 } else {
162 auto cat0{type0.category()};
163 auto cat1{type1.category()};
164 if (cat0 == TypeCategory::Unsigned || cat1 == TypeCategory::Unsigned) {
165 return cat0 == cat1;
166 } else if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
167 // numeric types: EQ/NE always ok, others ok for non-complex
168 return opr == common::RelationalOperator::EQ ||
169 opr == common::RelationalOperator::NE ||
170 (cat0 != TypeCategory::Complex && cat1 != TypeCategory::Complex);
171 } else {
172 // not both numeric: only Character is ok
173 return cat0 == TypeCategory::Character && cat1 == TypeCategory::Character;
174 }
175 }
176}
177
178bool IsIntrinsicNumeric(const evaluate::DynamicType &type0) {
179 return IsNumericTypeCategory(type0.category());
180}
181bool IsIntrinsicNumeric(const evaluate::DynamicType &type0, int rank0,
182 const evaluate::DynamicType &type1, int rank1) {
183 return evaluate::AreConformable(rank0, rank1) &&
184 IsNumericTypeCategory(type0.category()) &&
185 IsNumericTypeCategory(type1.category());
186}
187
188bool IsIntrinsicLogical(const evaluate::DynamicType &type0) {
189 return type0.category() == TypeCategory::Logical;
190}
191bool IsIntrinsicLogical(const evaluate::DynamicType &type0, int rank0,
192 const evaluate::DynamicType &type1, int rank1) {
193 return evaluate::AreConformable(rank0, rank1) &&
194 type0.category() == TypeCategory::Logical &&
195 type1.category() == TypeCategory::Logical;
196}
197
198bool IsIntrinsicConcat(const evaluate::DynamicType &type0, int rank0,
199 const evaluate::DynamicType &type1, int rank1) {
200 return evaluate::AreConformable(rank0, rank1) &&
201 type0.category() == TypeCategory::Character &&
202 type1.category() == TypeCategory::Character &&
203 type0.kind() == type1.kind();
204}
205
206bool IsGenericDefinedOp(const Symbol &symbol) {
207 const Symbol &ultimate{symbol.GetUltimate()};
208 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
209 return generic->kind().IsDefinedOperator();
210 } else if (const auto *misc{ultimate.detailsIf<MiscDetails>()}) {
211 return misc->kind() == MiscDetails::Kind::TypeBoundDefinedOp;
212 } else {
213 return false;
214 }
215}
216
217bool IsDefinedOperator(SourceName name) {
218 const char *begin{name.begin()};
219 const char *end{name.end()};
220 return begin != end && begin[0] == '.' && end[-1] == '.';
221}
222
223std::string MakeOpName(SourceName name) {
224 std::string result{name.ToString()};
225 return IsDefinedOperator(name) ? "OPERATOR(" + result + ")"
226 : result.find("operator(", 0) == 0 ? parser::ToUpperCaseLetters(result)
227 : result;
228}
229
230bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
231 const auto &objects{block.get<CommonBlockDetails>().objects()};
232 return llvm::is_contained(objects, object);
233}
234
235bool IsUseAssociated(const Symbol &symbol, const Scope &scope) {
236 const Scope &owner{GetTopLevelUnitContaining(symbol.GetUltimate().owner())};
237 return owner.kind() == Scope::Kind::Module &&
238 owner != GetTopLevelUnitContaining(scope);
239}
240
241bool DoesScopeContain(
242 const Scope *maybeAncestor, const Scope &maybeDescendent) {
243 return maybeAncestor && !maybeDescendent.IsTopLevel() &&
244 FindScopeContaining(maybeDescendent.parent(),
245 [&](const Scope &scope) { return &scope == maybeAncestor; });
246}
247
248bool DoesScopeContain(const Scope *maybeAncestor, const Symbol &symbol) {
249 return DoesScopeContain(maybeAncestor, symbol.owner());
250}
251
252static const Symbol &FollowHostAssoc(const Symbol &symbol) {
253 for (const Symbol *s{&symbol};;) {
254 const auto *details{s->detailsIf<HostAssocDetails>()};
255 if (!details) {
256 return *s;
257 }
258 s = &details->symbol();
259 }
260}
261
262bool IsHostAssociated(const Symbol &symbol, const Scope &scope) {
263 const Symbol &base{FollowHostAssoc(symbol)};
264 return base.owner().IsTopLevel() ||
265 DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
266 GetProgramUnitOrBlockConstructContaining(scope));
267}
268
269bool IsHostAssociatedIntoSubprogram(const Symbol &symbol, const Scope &scope) {
270 const Symbol &base{FollowHostAssoc(symbol)};
271 return base.owner().IsTopLevel() ||
272 DoesScopeContain(&GetProgramUnitOrBlockConstructContaining(base),
273 GetProgramUnitContaining(scope));
274}
275
276bool IsInStmtFunction(const Symbol &symbol) {
277 if (const Symbol * function{symbol.owner().symbol()}) {
278 return IsStmtFunction(*function);
279 }
280 return false;
281}
282
283bool IsStmtFunctionDummy(const Symbol &symbol) {
284 return IsDummy(symbol) && IsInStmtFunction(symbol);
285}
286
287bool IsStmtFunctionResult(const Symbol &symbol) {
288 return IsFunctionResult(symbol) && IsInStmtFunction(symbol);
289}
290
291bool IsPointerDummy(const Symbol &symbol) {
292 return IsPointer(symbol) && IsDummy(symbol);
293}
294
295bool IsBindCProcedure(const Symbol &original) {
296 const Symbol &symbol{original.GetUltimate()};
297 if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
298 if (procDetails->procInterface()) {
299 // procedure component with a BIND(C) interface
300 return IsBindCProcedure(*procDetails->procInterface());
301 }
302 }
303 return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol);
304}
305
306bool IsBindCProcedure(const Scope &scope) {
307 if (const Symbol * symbol{scope.GetSymbol()}) {
308 return IsBindCProcedure(*symbol);
309 } else {
310 return false;
311 }
312}
313
314// C1594 specifies several ways by which an object might be globally visible.
315const Symbol *FindExternallyVisibleObject(
316 const Symbol &object, const Scope &scope, bool isPointerDefinition) {
317 // TODO: Storage association with any object for which this predicate holds,
318 // once EQUIVALENCE is supported.
319 const Symbol &ultimate{GetAssociationRoot(object)};
320 if (IsDummy(ultimate)) {
321 if (IsIntentIn(ultimate)) {
322 return &ultimate;
323 }
324 if (!isPointerDefinition && IsPointer(ultimate) &&
325 IsPureProcedure(ultimate.owner()) && IsFunction(ultimate.owner())) {
326 return &ultimate;
327 }
328 } else if (ultimate.owner().IsDerivedType()) {
329 return nullptr;
330 } else if (&GetProgramUnitContaining(ultimate) !=
331 &GetProgramUnitContaining(scope)) {
332 return &object;
333 } else if (const Symbol * block{FindCommonBlockContaining(ultimate)}) {
334 return block;
335 }
336 return nullptr;
337}
338
339const Symbol &BypassGeneric(const Symbol &symbol) {
340 const Symbol &ultimate{symbol.GetUltimate()};
341 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
342 if (const Symbol * specific{generic->specific()}) {
343 return *specific;
344 }
345 }
346 return symbol;
347}
348
349const Symbol &GetCrayPointer(const Symbol &crayPointee) {
350 const Symbol *found{nullptr};
351 for (const auto &[pointee, pointer] :
352 crayPointee.GetUltimate().owner().crayPointers()) {
353 if (pointee == crayPointee.name()) {
354 found = &pointer.get();
355 break;
356 }
357 }
358 return DEREF(found);
359}
360
361bool ExprHasTypeCategory(
362 const SomeExpr &expr, const common::TypeCategory &type) {
363 auto dynamicType{expr.GetType()};
364 return dynamicType && dynamicType->category() == type;
365}
366
367bool ExprTypeKindIsDefault(
368 const SomeExpr &expr, const SemanticsContext &context) {
369 auto dynamicType{expr.GetType()};
370 return dynamicType &&
371 dynamicType->category() != common::TypeCategory::Derived &&
372 dynamicType->kind() == context.GetDefaultKind(dynamicType->category());
373}
374
375// If an analyzed expr or assignment is missing, dump the node and die.
376template <typename T>
377static void CheckMissingAnalysis(
378 bool crash, SemanticsContext *context, const T &x) {
379 if (crash && !(context && context->AnyFatalError())) {
380 std::string buf;
381 llvm::raw_string_ostream ss{buf};
382 ss << "node has not been analyzed:\n";
383 parser::DumpTree(ss, x);
384 common::die(buf.c_str());
385 }
386}
387
388const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
389 CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
390 return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
391}
392const SomeExpr *GetExprHelper::Get(const parser::Variable &x) {
393 CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
394 return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
395}
396const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) {
397 CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
398 return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
399}
400const SomeExpr *GetExprHelper::Get(const parser::AllocateObject &x) {
401 CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
402 return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
403}
404const SomeExpr *GetExprHelper::Get(const parser::PointerObject &x) {
405 CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
406 return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
407}
408
409const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {
410 return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
411 : nullptr;
412}
413const evaluate::Assignment *GetAssignment(
414 const parser::PointerAssignmentStmt &x) {
415 return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
416 : nullptr;
417}
418
419const Symbol *FindInterface(const Symbol &symbol) {
420 return common::visit(
421 common::visitors{
422 [](const ProcEntityDetails &details) {
423 const Symbol *interface{details.procInterface()};
424 return interface ? FindInterface(*interface) : nullptr;
425 },
426 [](const ProcBindingDetails &details) {
427 return FindInterface(details.symbol());
428 },
429 [&](const SubprogramDetails &) { return &symbol; },
430 [](const UseDetails &details) {
431 return FindInterface(details.symbol());
432 },
433 [](const HostAssocDetails &details) {
434 return FindInterface(details.symbol());
435 },
436 [](const GenericDetails &details) {
437 return details.specific() ? FindInterface(*details.specific())
438 : nullptr;
439 },
440 [](const auto &) -> const Symbol * { return nullptr; },
441 },
442 symbol.details());
443}
444
445const Symbol *FindSubprogram(const Symbol &symbol) {
446 return common::visit(
447 common::visitors{
448 [&](const ProcEntityDetails &details) -> const Symbol * {
449 if (details.procInterface()) {
450 return FindSubprogram(*details.procInterface());
451 } else {
452 return &symbol;
453 }
454 },
455 [](const ProcBindingDetails &details) {
456 return FindSubprogram(details.symbol());
457 },
458 [&](const SubprogramDetails &) { return &symbol; },
459 [](const UseDetails &details) {
460 return FindSubprogram(details.symbol());
461 },
462 [](const HostAssocDetails &details) {
463 return FindSubprogram(details.symbol());
464 },
465 [](const GenericDetails &details) {
466 return details.specific() ? FindSubprogram(*details.specific())
467 : nullptr;
468 },
469 [](const auto &) -> const Symbol * { return nullptr; },
470 },
471 symbol.details());
472}
473
474const Symbol *FindOverriddenBinding(
475 const Symbol &symbol, bool &isInaccessibleDeferred) {
476 isInaccessibleDeferred = false;
477 if (symbol.has<ProcBindingDetails>()) {
478 if (const DeclTypeSpec * parentType{FindParentTypeSpec(symbol.owner())}) {
479 if (const DerivedTypeSpec * parentDerived{parentType->AsDerived()}) {
480 if (const Scope * parentScope{parentDerived->typeSymbol().scope()}) {
481 if (const Symbol *
482 overridden{parentScope->FindComponent(symbol.name())}) {
483 // 7.5.7.3 p1: only accessible bindings are overridden
484 if (IsAccessible(*overridden, symbol.owner())) {
485 return overridden;
486 } else if (overridden->attrs().test(Attr::DEFERRED)) {
487 isInaccessibleDeferred = true;
488 return overridden;
489 }
490 }
491 }
492 }
493 }
494 }
495 return nullptr;
496}
497
498const Symbol *FindGlobal(const Symbol &original) {
499 const Symbol &ultimate{original.GetUltimate()};
500 if (ultimate.owner().IsGlobal()) {
501 return &ultimate;
502 }
503 bool isLocal{false};
504 if (IsDummy(ultimate)) {
505 } else if (IsPointer(ultimate)) {
506 } else if (ultimate.has<ProcEntityDetails>()) {
507 isLocal = IsExternal(ultimate);
508 } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
509 isLocal = subp->isInterface();
510 }
511 if (isLocal) {
512 const std::string *bind{ultimate.GetBindName()};
513 if (!bind || ultimate.name() == *bind) {
514 const Scope &globalScope{ultimate.owner().context().globalScope()};
515 if (auto iter{globalScope.find(ultimate.name())};
516 iter != globalScope.end()) {
517 const Symbol &global{*iter->second};
518 const std::string *globalBind{global.GetBindName()};
519 if (!globalBind || global.name() == *globalBind) {
520 return &global;
521 }
522 }
523 }
524 }
525 return nullptr;
526}
527
528const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &derived) {
529 return FindParentTypeSpec(derived.typeSymbol());
530}
531
532const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &decl) {
533 if (const DerivedTypeSpec * derived{decl.AsDerived()}) {
534 return FindParentTypeSpec(*derived);
535 } else {
536 return nullptr;
537 }
538}
539
540const DeclTypeSpec *FindParentTypeSpec(const Scope &scope) {
541 if (scope.kind() == Scope::Kind::DerivedType) {
542 if (const auto *symbol{scope.symbol()}) {
543 return FindParentTypeSpec(*symbol);
544 }
545 }
546 return nullptr;
547}
548
549const DeclTypeSpec *FindParentTypeSpec(const Symbol &symbol) {
550 if (const Scope * scope{symbol.scope()}) {
551 if (const auto *details{symbol.detailsIf<DerivedTypeDetails>()}) {
552 if (const Symbol * parent{details->GetParentComponent(*scope)}) {
553 return parent->GetType();
554 }
555 }
556 }
557 return nullptr;
558}
559
560const EquivalenceSet *FindEquivalenceSet(const Symbol &symbol) {
561 const Symbol &ultimate{symbol.GetUltimate()};
562 for (const EquivalenceSet &set : ultimate.owner().equivalenceSets()) {
563 for (const EquivalenceObject &object : set) {
564 if (object.symbol == ultimate) {
565 return &set;
566 }
567 }
568 }
569 return nullptr;
570}
571
572bool IsOrContainsEventOrLockComponent(const Symbol &original) {
573 const Symbol &symbol{ResolveAssociations(original, /*stopAtTypeGuard=*/true)};
574 if (evaluate::IsVariable(symbol)) {
575 if (const DeclTypeSpec * type{symbol.GetType()}) {
576 if (const DerivedTypeSpec * derived{type->AsDerived()}) {
577 return IsEventTypeOrLockType(derived) ||
578 FindEventOrLockPotentialComponent(*derived);
579 }
580 }
581 }
582 return false;
583}
584
585// Check this symbol suitable as a type-bound procedure - C769
586bool CanBeTypeBoundProc(const Symbol &symbol) {
587 if (IsDummy(symbol) || IsProcedurePointer(symbol)) {
588 return false;
589 } else if (symbol.has<SubprogramNameDetails>()) {
590 return symbol.owner().kind() == Scope::Kind::Module;
591 } else if (auto *details{symbol.detailsIf<SubprogramDetails>()}) {
592 if (details->isInterface()) {
593 return !symbol.attrs().test(Attr::ABSTRACT);
594 } else {
595 return symbol.owner().kind() == Scope::Kind::Module;
596 }
597 } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
598 return !symbol.attrs().test(Attr::INTRINSIC) &&
599 proc->HasExplicitInterface();
600 } else {
601 return false;
602 }
603}
604
605bool HasDeclarationInitializer(const Symbol &symbol) {
606 if (IsNamedConstant(symbol)) {
607 return false;
608 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
609 return object->init().has_value();
610 } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
611 return proc->init().has_value();
612 } else {
613 return false;
614 }
615}
616
617bool IsInitialized(const Symbol &symbol, bool ignoreDataStatements,
618 bool ignoreAllocatable, bool ignorePointer) {
619 if (!ignoreAllocatable && IsAllocatable(symbol)) {
620 return true;
621 } else if (!ignoreDataStatements && symbol.test(Symbol::Flag::InDataStmt)) {
622 return true;
623 } else if (HasDeclarationInitializer(symbol)) {
624 return true;
625 } else if (IsPointer(symbol)) {
626 return !ignorePointer;
627 } else if (IsNamedConstant(symbol)) {
628 return false;
629 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
630 if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
631 if (const auto *derived{object->type()->AsDerived()}) {
632 return derived->HasDefaultInitialization(
633 ignoreAllocatable, ignorePointer);
634 }
635 }
636 }
637 return false;
638}
639
640bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
641 if (IsAllocatable(symbol) || IsAutomatic(symbol)) {
642 return true;
643 } else if (IsNamedConstant(symbol) || IsFunctionResult(symbol) ||
644 IsPointer(symbol)) {
645 return false;
646 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
647 if ((!object->isDummy() || IsIntentOut(symbol)) && object->type()) {
648 if (const auto *derived{object->type()->AsDerived()}) {
649 return &derived->typeSymbol() != derivedTypeSymbol &&
650 derived->HasDestruction();
651 }
652 }
653 }
654 return false;
655}
656
657bool HasIntrinsicTypeName(const Symbol &symbol) {
658 std::string name{symbol.name().ToString()};
659 if (name == "doubleprecision") {
660 return true;
661 } else if (name == "derived") {
662 return false;
663 } else {
664 for (int i{0}; i != common::TypeCategory_enumSize; ++i) {
665 if (name == parser::ToLowerCaseLetters(EnumToString(TypeCategory{i}))) {
666 return true;
667 }
668 }
669 return false;
670 }
671}
672
673bool IsSeparateModuleProcedureInterface(const Symbol *symbol) {
674 if (symbol && symbol->attrs().test(Attr::MODULE)) {
675 if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
676 return details->isInterface();
677 }
678 }
679 return false;
680}
681
682SymbolVector FinalsForDerivedTypeInstantiation(const DerivedTypeSpec &spec) {
683 SymbolVector result;
684 const Symbol &typeSymbol{spec.typeSymbol()};
685 if (const auto *derived{typeSymbol.detailsIf<DerivedTypeDetails>()}) {
686 for (const auto &pair : derived->finals()) {
687 const Symbol &subr{*pair.second};
688 // Errors in FINAL subroutines are caught in CheckFinal
689 // in check-declarations.cpp.
690 if (const auto *subprog{subr.detailsIf<SubprogramDetails>()};
691 subprog && subprog->dummyArgs().size() == 1) {
692 if (const Symbol * arg{subprog->dummyArgs()[0]}) {
693 if (const DeclTypeSpec * type{arg->GetType()}) {
694 if (type->category() == DeclTypeSpec::TypeDerived &&
695 evaluate::AreSameDerivedType(spec, type->derivedTypeSpec())) {
696 result.emplace_back(subr);
697 }
698 }
699 }
700 }
701 }
702 }
703 return result;
704}
705
706const Symbol *IsFinalizable(const Symbol &symbol,
707 std::set<const DerivedTypeSpec *> *inProgress, bool withImpureFinalizer) {
708 if (IsPointer(symbol) || evaluate::IsAssumedRank(symbol)) {
709 return nullptr;
710 }
711 if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
712 if (object->isDummy() && !IsIntentOut(symbol)) {
713 return nullptr;
714 }
715 const DeclTypeSpec *type{object->type()};
716 if (const DerivedTypeSpec * typeSpec{type ? type->AsDerived() : nullptr}) {
717 return IsFinalizable(
718 *typeSpec, inProgress, withImpureFinalizer, symbol.Rank());
719 }
720 }
721 return nullptr;
722}
723
724const Symbol *IsFinalizable(const DerivedTypeSpec &derived,
725 std::set<const DerivedTypeSpec *> *inProgress, bool withImpureFinalizer,
726 std::optional<int> rank) {
727 const Symbol *elemental{nullptr};
728 for (auto ref : FinalsForDerivedTypeInstantiation(derived)) {
729 const Symbol *symbol{&ref->GetUltimate()};
730 if (const auto *binding{symbol->detailsIf<ProcBindingDetails>()}) {
731 symbol = &binding->symbol();
732 }
733 if (const auto *proc{symbol->detailsIf<ProcEntityDetails>()}) {
734 symbol = proc->procInterface();
735 }
736 if (!symbol) {
737 } else if (IsElementalProcedure(*symbol)) {
738 elemental = symbol;
739 } else {
740 if (rank) {
741 if (const SubprogramDetails *
742 subp{symbol->detailsIf<SubprogramDetails>()}) {
743 if (const auto &args{subp->dummyArgs()}; !args.empty() &&
744 args.at(0) && !evaluate::IsAssumedRank(*args.at(0)) &&
745 args.at(0)->Rank() != *rank) {
746 continue; // not a finalizer for this rank
747 }
748 }
749 }
750 if (!withImpureFinalizer || !IsPureProcedure(*symbol)) {
751 return symbol;
752 }
753 // Found non-elemental pure finalizer of matching rank, but still
754 // need to check components for an impure finalizer.
755 elemental = nullptr;
756 break;
757 }
758 }
759 if (elemental && (!withImpureFinalizer || !IsPureProcedure(*elemental))) {
760 return elemental;
761 }
762 // Check components (including ancestors)
763 std::set<const DerivedTypeSpec *> basis;
764 if (inProgress) {
765 if (inProgress->find(&derived) != inProgress->end()) {
766 return nullptr; // don't loop on recursive type
767 }
768 } else {
769 inProgress = &basis;
770 }
771 auto iterator{inProgress->insert(&derived).first};
772 const Symbol *result{nullptr};
773 for (const Symbol &component : PotentialComponentIterator{derived}) {
774 result = IsFinalizable(component, inProgress, withImpureFinalizer);
775 if (result) {
776 break;
777 }
778 }
779 inProgress->erase(iterator);
780 return result;
781}
782
783static const Symbol *HasImpureFinal(
784 const DerivedTypeSpec &derived, std::optional<int> rank) {
785 return IsFinalizable(derived, nullptr, /*withImpureFinalizer=*/true, rank);
786}
787
788const Symbol *HasImpureFinal(const Symbol &original, std::optional<int> rank) {
789 const Symbol &symbol{ResolveAssociations(original, /*stopAtTypeGuard=*/true)};
790 if (symbol.has<ObjectEntityDetails>()) {
791 if (const DeclTypeSpec * symType{symbol.GetType()}) {
792 if (const DerivedTypeSpec * derived{symType->AsDerived()}) {
793 if (evaluate::IsAssumedRank(symbol)) {
794 // finalizable assumed-rank not allowed (C839)
795 return nullptr;
796 } else {
797 int actualRank{rank.value_or(symbol.Rank())};
798 return HasImpureFinal(*derived, actualRank);
799 }
800 }
801 }
802 }
803 return nullptr;
804}
805
806bool MayRequireFinalization(const DerivedTypeSpec &derived) {
807 return IsFinalizable(derived) ||
808 FindPolymorphicAllocatablePotentialComponent(derived);
809}
810
811bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
812 DirectComponentIterator directs{derived};
813 return std::any_of(directs.begin(), directs.end(), IsAllocatable);
814}
815
816static bool MayHaveDefinedAssignment(
817 const DerivedTypeSpec &derived, std::set<const Scope *> &checked) {
818 if (const Scope *scope{derived.GetScope()};
819 scope && checked.find(scope) == checked.end()) {
820 checked.insert(scope);
821 for (const auto &[_, symbolRef] : *scope) {
822 if (const auto *generic{symbolRef->detailsIf<GenericDetails>()}) {
823 if (generic->kind().IsAssignment()) {
824 return true;
825 }
826 } else if (symbolRef->has<ObjectEntityDetails>() &&
827 !IsPointer(*symbolRef)) {
828 if (const DeclTypeSpec *type{symbolRef->GetType()}) {
829 if (type->IsPolymorphic()) {
830 return true;
831 } else if (const DerivedTypeSpec *derived{type->AsDerived()}) {
832 if (MayHaveDefinedAssignment(*derived, checked)) {
833 return true;
834 }
835 }
836 }
837 }
838 }
839 }
840 return false;
841}
842
843bool MayHaveDefinedAssignment(const DerivedTypeSpec &derived) {
844 std::set<const Scope *> checked;
845 return MayHaveDefinedAssignment(derived, checked);
846}
847
848bool IsAssumedLengthCharacter(const Symbol &symbol) {
849 if (const DeclTypeSpec * type{symbol.GetType()}) {
850 return type->category() == DeclTypeSpec::Character &&
851 type->characterTypeSpec().length().isAssumed();
852 } else {
853 return false;
854 }
855}
856
857bool IsInBlankCommon(const Symbol &symbol) {
858 const Symbol *block{FindCommonBlockContaining(symbol)};
859 return block && block->name().empty();
860}
861
862// C722 and C723: For a function to be assumed length, it must be external and
863// of CHARACTER type
864bool IsExternal(const Symbol &symbol) {
865 return ClassifyProcedure(symbol) == ProcedureDefinitionClass::External;
866}
867
868// Most scopes have no EQUIVALENCE, and this function is a fast no-op for them.
869std::list<std::list<SymbolRef>> GetStorageAssociations(const Scope &scope) {
870 UnorderedSymbolSet distinct;
871 for (const EquivalenceSet &set : scope.equivalenceSets()) {
872 for (const EquivalenceObject &object : set) {
873 distinct.emplace(object.symbol);
874 }
875 }
876 // This set is ordered by ascending offsets, with ties broken by greatest
877 // size. A multiset is used here because multiple symbols may have the
878 // same offset and size; the symbols in the set, however, are distinct.
879 std::multiset<SymbolRef, SymbolOffsetCompare> associated;
880 for (SymbolRef ref : distinct) {
881 associated.emplace(*ref);
882 }
883 std::list<std::list<SymbolRef>> result;
884 std::size_t limit{0};
885 const Symbol *currentCommon{nullptr};
886 for (const Symbol &symbol : associated) {
887 const Symbol *thisCommon{FindCommonBlockContaining(symbol)};
888 if (result.empty() || symbol.offset() >= limit ||
889 thisCommon != currentCommon) {
890 // Start a new group
891 result.emplace_back(std::list<SymbolRef>{});
892 limit = 0;
893 currentCommon = thisCommon;
894 }
895 result.back().emplace_back(symbol);
896 limit = std::max(limit, symbol.offset() + symbol.size());
897 }
898 return result;
899}
900
901bool IsModuleProcedure(const Symbol &symbol) {
902 return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module;
903}
904
905class ImageControlStmtHelper {
906 using ImageControlStmts =
907 std::variant<parser::ChangeTeamConstruct, parser::CriticalConstruct,
908 parser::EventPostStmt, parser::EventWaitStmt, parser::FormTeamStmt,
909 parser::LockStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
910 parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt>;
911
912public:
913 template <typename T> bool operator()(const T &) {
914 return common::HasMember<T, ImageControlStmts>;
915 }
916 template <typename T> bool operator()(const common::Indirection<T> &x) {
917 return (*this)(x.value());
918 }
919 template <typename A> bool operator()(const parser::Statement<A> &x) {
920 return (*this)(x.statement);
921 }
922 bool operator()(const parser::AllocateStmt &stmt) {
923 const auto &allocationList{std::get<std::list<parser::Allocation>>(stmt.t)};
924 for (const auto &allocation : allocationList) {
925 const auto &allocateObject{
926 std::get<parser::AllocateObject>(allocation.t)};
927 if (IsCoarrayObject(allocateObject)) {
928 return true;
929 }
930 }
931 return false;
932 }
933 bool operator()(const parser::DeallocateStmt &stmt) {
934 const auto &allocateObjectList{
935 std::get<std::list<parser::AllocateObject>>(stmt.t)};
936 for (const auto &allocateObject : allocateObjectList) {
937 if (IsCoarrayObject(allocateObject)) {
938 return true;
939 }
940 }
941 return false;
942 }
943 bool operator()(const parser::CallStmt &stmt) {
944 const auto &procedureDesignator{
945 std::get<parser::ProcedureDesignator>(stmt.call.t)};
946 if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
947 // TODO: also ensure that the procedure is, in fact, an intrinsic
948 if (name->source == "move_alloc") {
949 const auto &args{
950 std::get<std::list<parser::ActualArgSpec>>(stmt.call.t)};
951 if (!args.empty()) {
952 const parser::ActualArg &actualArg{
953 std::get<parser::ActualArg>(args.front().t)};
954 if (const auto *argExpr{
955 std::get_if<common::Indirection<parser::Expr>>(
956 &actualArg.u)}) {
957 return HasCoarray(argExpr->value());
958 }
959 }
960 }
961 }
962 return false;
963 }
964 bool operator()(const parser::StopStmt &stmt) {
965 // STOP is an image control statement; ERROR STOP is not
966 return std::get<parser::StopStmt::Kind>(stmt.t) ==
967 parser::StopStmt::Kind::Stop;
968 }
969 bool operator()(const parser::IfStmt &stmt) {
970 return (*this)(
971 std::get<parser::UnlabeledStatement<parser::ActionStmt>>(stmt.t)
972 .statement);
973 }
974 bool operator()(const parser::ActionStmt &stmt) {
975 return common::visit(*this, stmt.u);
976 }
977
978private:
979 bool IsCoarrayObject(const parser::AllocateObject &allocateObject) {
980 const parser::Name &name{GetLastName(allocateObject)};
981 return name.symbol && evaluate::IsCoarray(*name.symbol);
982 }
983};
984
985bool IsImageControlStmt(const parser::ExecutableConstruct &construct) {
986 return common::visit(ImageControlStmtHelper{}, construct.u);
987}
988
989std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg(
990 const parser::ExecutableConstruct &construct) {
991 if (const auto *actionStmt{
992 std::get_if<parser::Statement<parser::ActionStmt>>(&construct.u)}) {
993 return common::visit(
994 common::visitors{
995 [](const common::Indirection<parser::AllocateStmt> &)
996 -> std::optional<parser::MessageFixedText> {
997 return "ALLOCATE of a coarray is an image control"
998 " statement"_en_US;
999 },
1000 [](const common::Indirection<parser::DeallocateStmt> &)
1001 -> std::optional<parser::MessageFixedText> {
1002 return "DEALLOCATE of a coarray is an image control"
1003 " statement"_en_US;
1004 },
1005 [](const common::Indirection<parser::CallStmt> &)
1006 -> std::optional<parser::MessageFixedText> {
1007 return "MOVE_ALLOC of a coarray is an image control"
1008 " statement "_en_US;
1009 },
1010 [](const auto &) -> std::optional<parser::MessageFixedText> {
1011 return std::nullopt;
1012 },
1013 },
1014 actionStmt->statement.u);
1015 }
1016 return std::nullopt;
1017}
1018
1019parser::CharBlock GetImageControlStmtLocation(
1020 const parser::ExecutableConstruct &executableConstruct) {
1021 return common::visit(
1022 common::visitors{
1023 [](const common::Indirection<parser::ChangeTeamConstruct>
1024 &construct) {
1025 return std::get<parser::Statement<parser::ChangeTeamStmt>>(
1026 construct.value().t)
1027 .source;
1028 },
1029 [](const common::Indirection<parser::CriticalConstruct> &construct) {
1030 return std::get<parser::Statement<parser::CriticalStmt>>(
1031 construct.value().t)
1032 .source;
1033 },
1034 [](const parser::Statement<parser::ActionStmt> &actionStmt) {
1035 return actionStmt.source;
1036 },
1037 [](const auto &) { return parser::CharBlock{}; },
1038 },
1039 executableConstruct.u);
1040}
1041
1042bool HasCoarray(const parser::Expr &expression) {
1043 if (const auto *expr{GetExpr(nullptr, expression)}) {
1044 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
1045 if (evaluate::IsCoarray(symbol)) {
1046 return true;
1047 }
1048 }
1049 }
1050 return false;
1051}
1052
1053bool IsAssumedType(const Symbol &symbol) {
1054 if (const DeclTypeSpec * type{symbol.GetType()}) {
1055 return type->IsAssumedType();
1056 }
1057 return false;
1058}
1059
1060bool IsPolymorphic(const Symbol &symbol) {
1061 if (const DeclTypeSpec * type{symbol.GetType()}) {
1062 return type->IsPolymorphic();
1063 }
1064 return false;
1065}
1066
1067bool IsUnlimitedPolymorphic(const Symbol &symbol) {
1068 if (const DeclTypeSpec * type{symbol.GetType()}) {
1069 return type->IsUnlimitedPolymorphic();
1070 }
1071 return false;
1072}
1073
1074bool IsPolymorphicAllocatable(const Symbol &symbol) {
1075 return IsAllocatable(symbol) && IsPolymorphic(symbol);
1076}
1077
1078const Scope *FindCUDADeviceContext(const Scope *scope) {
1079 return !scope ? nullptr : FindScopeContaining(*scope, [](const Scope &s) {
1080 return IsCUDADeviceContext(&s);
1081 });
1082}
1083
1084bool IsDeviceAllocatable(const Symbol &symbol) {
1085 if (IsAllocatable(symbol)) {
1086 if (const auto *details{
1087 symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
1088 if (details->cudaDataAttr() &&
1089 *details->cudaDataAttr() != common::CUDADataAttr::Pinned) {
1090 return true;
1091 }
1092 }
1093 }
1094 return false;
1095}
1096
1097UltimateComponentIterator::const_iterator
1098FindCUDADeviceAllocatableUltimateComponent(const DerivedTypeSpec &derived) {
1099 UltimateComponentIterator ultimates{derived};
1100 return std::find_if(ultimates.begin(), ultimates.end(), IsDeviceAllocatable);
1101}
1102
1103bool CanCUDASymbolBeGlobal(const Symbol &sym) {
1104 const Symbol &symbol{GetAssociationRoot(sym)};
1105 const Scope &scope{symbol.owner()};
1106 auto scopeKind{scope.kind()};
1107 const common::LanguageFeatureControl &features{
1108 scope.context().languageFeatures()};
1109 if (features.IsEnabled(common::LanguageFeature::CUDA) &&
1110 scopeKind == Scope::Kind::MainProgram) {
1111 if (const auto *details{
1112 sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
1113 const Fortran::semantics::DeclTypeSpec *type{details->type()};
1114 const Fortran::semantics::DerivedTypeSpec *derived{
1115 type ? type->AsDerived() : nullptr};
1116 if (derived) {
1117 if (FindCUDADeviceAllocatableUltimateComponent(*derived)) {
1118 return false;
1119 }
1120 }
1121 if (details->cudaDataAttr() &&
1122 *details->cudaDataAttr() != common::CUDADataAttr::Unified) {
1123 return false;
1124 }
1125 }
1126 }
1127 return true;
1128}
1129
1130std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *symbol) {
1131 const auto *details{
1132 symbol ? symbol->detailsIf<ObjectEntityDetails>() : nullptr};
1133 if (details) {
1134 const Fortran::semantics::DeclTypeSpec *type{details->type()};
1135 const Fortran::semantics::DerivedTypeSpec *derived{
1136 type ? type->AsDerived() : nullptr};
1137 if (derived) {
1138 if (FindCUDADeviceAllocatableUltimateComponent(*derived)) {
1139 return common::CUDADataAttr::Managed;
1140 }
1141 }
1142 return details->cudaDataAttr();
1143 }
1144 return std::nullopt;
1145}
1146
1147bool IsAccessible(const Symbol &original, const Scope &scope) {
1148 const Symbol &ultimate{original.GetUltimate()};
1149 if (ultimate.attrs().test(Attr::PRIVATE)) {
1150 const Scope *module{FindModuleContaining(ultimate.owner())};
1151 return !module || module->Contains(scope);
1152 } else {
1153 return true;
1154 }
1155}
1156
1157std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
1158 const Scope &scope, const Symbol &symbol) {
1159 if (IsAccessible(symbol, scope)) {
1160 return std::nullopt;
1161 } else if (FindModuleFileContaining(scope)) {
1162 // Don't enforce component accessibility checks in module files;
1163 // there may be forward-substituted named constants of derived type
1164 // whose structure constructors reference private components.
1165 return std::nullopt;
1166 } else {
1167 return parser::MessageFormattedText{
1168 "PRIVATE name '%s' is accessible only within module '%s'"_err_en_US,
1169 symbol.name(),
1170 DEREF(FindModuleContaining(symbol.owner())).GetName().value()};
1171 }
1172}
1173
1174SymbolVector OrderParameterNames(const Symbol &typeSymbol) {
1175 SymbolVector result;
1176 if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
1177 result = OrderParameterNames(spec->typeSymbol());
1178 }
1179 const auto &paramNames{typeSymbol.get<DerivedTypeDetails>().paramNameOrder()};
1180 result.insert(result.end(), paramNames.begin(), paramNames.end());
1181 return result;
1182}
1183
1184SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) {
1185 SymbolVector result;
1186 if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
1187 result = OrderParameterDeclarations(spec->typeSymbol());
1188 }
1189 const auto &paramDecls{typeSymbol.get<DerivedTypeDetails>().paramDeclOrder()};
1190 result.insert(result.end(), paramDecls.begin(), paramDecls.end());
1191 return result;
1192}
1193
1194const DeclTypeSpec &FindOrInstantiateDerivedType(
1195 Scope &scope, DerivedTypeSpec &&spec, DeclTypeSpec::Category category) {
1196 spec.EvaluateParameters(scope.context());
1197 if (const DeclTypeSpec *
1198 type{scope.FindInstantiatedDerivedType(spec, category)}) {
1199 return *type;
1200 }
1201 // Create a new instantiation of this parameterized derived type
1202 // for this particular distinct set of actual parameter values.
1203 DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))};
1204 type.derivedTypeSpec().Instantiate(scope);
1205 return type;
1206}
1207
1208const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) {
1209 if (proc) {
1210 if (const auto *subprogram{proc->detailsIf<SubprogramDetails>()}) {
1211 if (const Symbol * iface{subprogram->moduleInterface()}) {
1212 return iface;
1213 }
1214 }
1215 }
1216 return nullptr;
1217}
1218
1219ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
1220 const Symbol &ultimate{symbol.GetUltimate()};
1221 if (!IsProcedure(ultimate)) {
1222 return ProcedureDefinitionClass::None;
1223 } else if (ultimate.attrs().test(Attr::INTRINSIC)) {
1224 return ProcedureDefinitionClass::Intrinsic;
1225 } else if (IsDummy(ultimate)) {
1226 return ProcedureDefinitionClass::Dummy;
1227 } else if (IsProcedurePointer(symbol)) {
1228 return ProcedureDefinitionClass::Pointer;
1229 } else if (ultimate.attrs().test(Attr::EXTERNAL)) {
1230 return ProcedureDefinitionClass::External;
1231 } else if (const auto *nameDetails{
1232 ultimate.detailsIf<SubprogramNameDetails>()}) {
1233 switch (nameDetails->kind()) {
1234 case SubprogramKind::Module:
1235 return ProcedureDefinitionClass::Module;
1236 case SubprogramKind::Internal:
1237 return ProcedureDefinitionClass::Internal;
1238 }
1239 } else if (const Symbol * subp{FindSubprogram(symbol)}) {
1240 if (const auto *subpDetails{subp->detailsIf<SubprogramDetails>()}) {
1241 if (subpDetails->stmtFunction()) {
1242 return ProcedureDefinitionClass::StatementFunction;
1243 }
1244 }
1245 switch (ultimate.owner().kind()) {
1246 case Scope::Kind::Global:
1247 case Scope::Kind::IntrinsicModules:
1248 return ProcedureDefinitionClass::External;
1249 case Scope::Kind::Module:
1250 return ProcedureDefinitionClass::Module;
1251 case Scope::Kind::MainProgram:
1252 case Scope::Kind::Subprogram:
1253 return ProcedureDefinitionClass::Internal;
1254 default:
1255 break;
1256 }
1257 }
1258 return ProcedureDefinitionClass::None;
1259}
1260
1261// ComponentIterator implementation
1262
1263template <ComponentKind componentKind>
1264typename ComponentIterator<componentKind>::const_iterator
1265ComponentIterator<componentKind>::const_iterator::Create(
1266 const DerivedTypeSpec &derived) {
1267 const_iterator it{};
1268 it.componentPath_.emplace_back(derived);
1269 it.Increment(); // cue up first relevant component, if any
1270 return it;
1271}
1272
1273template <ComponentKind componentKind>
1274const DerivedTypeSpec *
1275ComponentIterator<componentKind>::const_iterator::PlanComponentTraversal(
1276 const Symbol &component) const {
1277 if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
1278 if (const DeclTypeSpec * type{details->type()}) {
1279 if (const auto *derived{type->AsDerived()}) {
1280 bool traverse{false};
1281 if constexpr (componentKind == ComponentKind::Ordered) {
1282 // Order Component (only visit parents)
1283 traverse = component.test(Symbol::Flag::ParentComp);
1284 } else if constexpr (componentKind == ComponentKind::Direct) {
1285 traverse = !IsAllocatableOrObjectPointer(&component);
1286 } else if constexpr (componentKind == ComponentKind::Ultimate) {
1287 traverse = !IsAllocatableOrObjectPointer(&component);
1288 } else if constexpr (componentKind == ComponentKind::Potential) {
1289 traverse = !IsPointer(component);
1290 } else if constexpr (componentKind == ComponentKind::Scope) {
1291 traverse = !IsAllocatableOrObjectPointer(&component);
1292 } else if constexpr (componentKind ==
1293 ComponentKind::PotentialAndPointer) {
1294 traverse = !IsPointer(component);
1295 }
1296 if (traverse) {
1297 const Symbol &newTypeSymbol{derived->typeSymbol()};
1298 // Avoid infinite loop if the type is already part of the types
1299 // being visited. It is possible to have "loops in type" because
1300 // C744 does not forbid to use not yet declared type for
1301 // ALLOCATABLE or POINTER components.
1302 for (const auto &node : componentPath_) {
1303 if (&newTypeSymbol == &node.GetTypeSymbol()) {
1304 return nullptr;
1305 }
1306 }
1307 return derived;
1308 }
1309 }
1310 } // intrinsic & unlimited polymorphic not traversable
1311 }
1312 return nullptr;
1313}
1314
1315template <ComponentKind componentKind>
1316static bool StopAtComponentPre(const Symbol &component) {
1317 if constexpr (componentKind == ComponentKind::Ordered) {
1318 // Parent components need to be iterated upon after their
1319 // sub-components in structure constructor analysis.
1320 return !component.test(Symbol::Flag::ParentComp);
1321 } else if constexpr (componentKind == ComponentKind::Direct) {
1322 return true;
1323 } else if constexpr (componentKind == ComponentKind::Ultimate) {
1324 return component.has<ProcEntityDetails>() ||
1325 IsAllocatableOrObjectPointer(&component) ||
1326 (component.has<ObjectEntityDetails>() &&
1327 component.get<ObjectEntityDetails>().type() &&
1328 component.get<ObjectEntityDetails>().type()->AsIntrinsic());
1329 } else if constexpr (componentKind == ComponentKind::Potential) {
1330 return !IsPointer(component);
1331 } else if constexpr (componentKind == ComponentKind::PotentialAndPointer) {
1332 return true;
1333 } else {
1334 DIE("unexpected ComponentKind");
1335 }
1336}
1337
1338template <ComponentKind componentKind>
1339static bool StopAtComponentPost(const Symbol &component) {
1340 return componentKind == ComponentKind::Ordered &&
1341 component.test(Symbol::Flag::ParentComp);
1342}
1343
1344template <ComponentKind componentKind>
1345void ComponentIterator<componentKind>::const_iterator::Increment() {
1346 while (!componentPath_.empty()) {
1347 ComponentPathNode &deepest{componentPath_.back()};
1348 if (deepest.component()) {
1349 if (!deepest.descended()) {
1350 deepest.set_descended(true);
1351 if (const DerivedTypeSpec *
1352 derived{PlanComponentTraversal(*deepest.component())}) {
1353 componentPath_.emplace_back(*derived);
1354 continue;
1355 }
1356 } else if (!deepest.visited()) {
1357 deepest.set_visited(true);
1358 return; // this is the next component to visit, after descending
1359 }
1360 }
1361 auto &nameIterator{deepest.nameIterator()};
1362 if (nameIterator == deepest.nameEnd()) {
1363 componentPath_.pop_back();
1364 } else if constexpr (componentKind == ComponentKind::Scope) {
1365 deepest.set_component(*nameIterator++->second);
1366 deepest.set_descended(false);
1367 deepest.set_visited(true);
1368 return; // this is the next component to visit, before descending
1369 } else {
1370 const Scope &scope{deepest.GetScope()};
1371 auto scopeIter{scope.find(*nameIterator++)};
1372 if (scopeIter != scope.cend()) {
1373 const Symbol &component{*scopeIter->second};
1374 deepest.set_component(component);
1375 deepest.set_descended(false);
1376 if (StopAtComponentPre<componentKind>(component)) {
1377 deepest.set_visited(true);
1378 return; // this is the next component to visit, before descending
1379 } else {
1380 deepest.set_visited(!StopAtComponentPost<componentKind>(component));
1381 }
1382 }
1383 }
1384 }
1385}
1386
1387template <ComponentKind componentKind>
1388SymbolVector
1389ComponentIterator<componentKind>::const_iterator::GetComponentPath() const {
1390 SymbolVector result;
1391 for (const auto &node : componentPath_) {
1392 result.push_back(DEREF(node.component()));
1393 }
1394 return result;
1395}
1396
1397template <ComponentKind componentKind>
1398std::string
1399ComponentIterator<componentKind>::const_iterator::BuildResultDesignatorName()
1400 const {
1401 std::string designator;
1402 for (const Symbol &component : GetComponentPath()) {
1403 designator += "%"s + component.name().ToString();
1404 }
1405 return designator;
1406}
1407
1408template class ComponentIterator<ComponentKind::Ordered>;
1409template class ComponentIterator<ComponentKind::Direct>;
1410template class ComponentIterator<ComponentKind::Ultimate>;
1411template class ComponentIterator<ComponentKind::Potential>;
1412template class ComponentIterator<ComponentKind::Scope>;
1413template class ComponentIterator<ComponentKind::PotentialAndPointer>;
1414
1415PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent(
1416 const DerivedTypeSpec &derived) {
1417 PotentialComponentIterator potentials{derived};
1418 return std::find_if(potentials.begin(), potentials.end(),
1419 [](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
1420}
1421
1422PotentialAndPointerComponentIterator::const_iterator
1423FindPointerPotentialComponent(const DerivedTypeSpec &derived) {
1424 PotentialAndPointerComponentIterator potentials{derived};
1425 return std::find_if(potentials.begin(), potentials.end(), IsPointer);
1426}
1427
1428UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
1429 const DerivedTypeSpec &derived) {
1430 UltimateComponentIterator ultimates{derived};
1431 return std::find_if(ultimates.begin(), ultimates.end(),
1432 [](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
1433}
1434
1435UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
1436 const DerivedTypeSpec &derived) {
1437 UltimateComponentIterator ultimates{derived};
1438 return std::find_if(ultimates.begin(), ultimates.end(), IsPointer);
1439}
1440
1441PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
1442 const DerivedTypeSpec &derived, bool ignoreCoarrays) {
1443 PotentialComponentIterator potentials{derived};
1444 auto iter{potentials.begin()};
1445 for (auto end{potentials.end()}; iter != end; ++iter) {
1446 const Symbol &component{*iter};
1447 if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
1448 if (const DeclTypeSpec * type{object->type()}) {
1449 if (IsEventTypeOrLockType(type->AsDerived())) {
1450 if (!ignoreCoarrays) {
1451 break; // found one
1452 }
1453 auto path{iter.GetComponentPath()};
1454 path.pop_back();
1455 if (std::find_if(path.begin(), path.end(), [](const Symbol &sym) {
1456 return evaluate::IsCoarray(sym);
1457 }) == path.end()) {
1458 break; // found one not in a coarray
1459 }
1460 }
1461 }
1462 }
1463 }
1464 return iter;
1465}
1466
1467UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
1468 const DerivedTypeSpec &derived) {
1469 UltimateComponentIterator ultimates{derived};
1470 return std::find_if(ultimates.begin(), ultimates.end(), IsAllocatable);
1471}
1472
1473DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
1474 const DerivedTypeSpec &derived) {
1475 DirectComponentIterator directs{derived};
1476 return std::find_if(directs.begin(), directs.end(), IsAllocatableOrPointer);
1477}
1478
1479PotentialComponentIterator::const_iterator
1480FindPolymorphicAllocatablePotentialComponent(const DerivedTypeSpec &derived) {
1481 PotentialComponentIterator potentials{derived};
1482 return std::find_if(
1483 potentials.begin(), potentials.end(), IsPolymorphicAllocatable);
1484}
1485
1486const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
1487 const std::function<bool(const Symbol &)> &predicate) {
1488 UltimateComponentIterator ultimates{derived};
1489 if (auto it{std::find_if(ultimates.begin(), ultimates.end(),
1490 [&predicate](const Symbol &component) -> bool {
1491 return predicate(component);
1492 })}) {
1493 return &*it;
1494 }
1495 return nullptr;
1496}
1497
1498const Symbol *FindUltimateComponent(const Symbol &symbol,
1499 const std::function<bool(const Symbol &)> &predicate) {
1500 if (predicate(symbol)) {
1501 return &symbol;
1502 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
1503 if (const auto *type{object->type()}) {
1504 if (const auto *derived{type->AsDerived()}) {
1505 return FindUltimateComponent(*derived, predicate);
1506 }
1507 }
1508 }
1509 return nullptr;
1510}
1511
1512const Symbol *FindImmediateComponent(const DerivedTypeSpec &type,
1513 const std::function<bool(const Symbol &)> &predicate) {
1514 if (const Scope * scope{type.scope()}) {
1515 const Symbol *parent{nullptr};
1516 for (const auto &pair : *scope) {
1517 const Symbol *symbol{&*pair.second};
1518 if (predicate(*symbol)) {
1519 return symbol;
1520 }
1521 if (symbol->test(Symbol::Flag::ParentComp)) {
1522 parent = symbol;
1523 }
1524 }
1525 if (parent) {
1526 if (const auto *object{parent->detailsIf<ObjectEntityDetails>()}) {
1527 if (const auto *type{object->type()}) {
1528 if (const auto *derived{type->AsDerived()}) {
1529 return FindImmediateComponent(*derived, predicate);
1530 }
1531 }
1532 }
1533 }
1534 }
1535 return nullptr;
1536}
1537
1538const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
1539 if (IsFunctionResult(symbol)) {
1540 if (const Symbol * function{symbol.owner().symbol()}) {
1541 if (symbol.name() == function->name()) {
1542 return function;
1543 }
1544 }
1545 // Check ENTRY result symbols too
1546 const Scope &outer{symbol.owner().parent()};
1547 auto iter{outer.find(symbol.name())};
1548 if (iter != outer.end()) {
1549 const Symbol &outerSym{*iter->second};
1550 if (const auto *subp{outerSym.detailsIf<SubprogramDetails>()}) {
1551 if (subp->entryScope() == &symbol.owner() &&
1552 symbol.name() == outerSym.name()) {
1553 return &outerSym;
1554 }
1555 }
1556 }
1557 }
1558 return nullptr;
1559}
1560
1561void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) {
1562 CheckLabelUse(gotoStmt.v);
1563}
1564void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) {
1565 for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
1566 CheckLabelUse(i);
1567 }
1568}
1569
1570void LabelEnforce::Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
1571 CheckLabelUse(std::get<1>(arithmeticIfStmt.t));
1572 CheckLabelUse(std::get<2>(arithmeticIfStmt.t));
1573 CheckLabelUse(std::get<3>(arithmeticIfStmt.t));
1574}
1575
1576void LabelEnforce::Post(const parser::AssignStmt &assignStmt) {
1577 CheckLabelUse(std::get<parser::Label>(assignStmt.t));
1578}
1579
1580void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
1581 for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
1582 CheckLabelUse(i);
1583 }
1584}
1585
1586void LabelEnforce::Post(const parser::AltReturnSpec &altReturnSpec) {
1587 CheckLabelUse(altReturnSpec.v);
1588}
1589
1590void LabelEnforce::Post(const parser::ErrLabel &errLabel) {
1591 CheckLabelUse(errLabel.v);
1592}
1593void LabelEnforce::Post(const parser::EndLabel &endLabel) {
1594 CheckLabelUse(endLabel.v);
1595}
1596void LabelEnforce::Post(const parser::EorLabel &eorLabel) {
1597 CheckLabelUse(eorLabel.v);
1598}
1599
1600void LabelEnforce::CheckLabelUse(const parser::Label &labelUsed) {
1601 if (labels_.find(labelUsed) == labels_.end()) {
1602 SayWithConstruct(context_, currentStatementSourcePosition_,
1603 parser::MessageFormattedText{
1604 "Control flow escapes from %s"_err_en_US, construct_},
1605 constructSourcePosition_);
1606 }
1607}
1608
1609parser::MessageFormattedText LabelEnforce::GetEnclosingConstructMsg() {
1610 return {"Enclosing %s statement"_en_US, construct_};
1611}
1612
1613void LabelEnforce::SayWithConstruct(SemanticsContext &context,
1614 parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
1615 parser::CharBlock constructLocation) {
1616 context.Say(stmtLocation, message)
1617 .Attach(constructLocation, GetEnclosingConstructMsg());
1618}
1619
1620bool HasAlternateReturns(const Symbol &subprogram) {
1621 for (const auto *dummyArg : subprogram.get<SubprogramDetails>().dummyArgs()) {
1622 if (!dummyArg) {
1623 return true;
1624 }
1625 }
1626 return false;
1627}
1628
1629bool IsAutomaticallyDestroyed(const Symbol &symbol) {
1630 return symbol.has<ObjectEntityDetails>() &&
1631 (symbol.owner().kind() == Scope::Kind::Subprogram ||
1632 symbol.owner().kind() == Scope::Kind::BlockConstruct) &&
1633 !IsNamedConstant(symbol) && (!IsDummy(symbol) || IsIntentOut(symbol)) &&
1634 !IsPointer(symbol) && !IsSaved(symbol) &&
1635 !FindCommonBlockContaining(symbol);
1636}
1637
1638const std::optional<parser::Name> &MaybeGetNodeName(
1639 const ConstructNode &construct) {
1640 return common::visit(
1641 common::visitors{
1642 [&](const parser::BlockConstruct *blockConstruct)
1643 -> const std::optional<parser::Name> & {
1644 return std::get<0>(blockConstruct->t).statement.v;
1645 },
1646 [&](const auto *a) -> const std::optional<parser::Name> & {
1647 return std::get<0>(std::get<0>(a->t).statement.t);
1648 },
1649 },
1650 construct);
1651}
1652
1653std::optional<ArraySpec> ToArraySpec(
1654 evaluate::FoldingContext &context, const evaluate::Shape &shape) {
1655 if (auto extents{evaluate::AsConstantExtents(context, shape)};
1656 extents && !evaluate::HasNegativeExtent(*extents)) {
1657 ArraySpec result;
1658 for (const auto &extent : *extents) {
1659 result.emplace_back(ShapeSpec::MakeExplicit(Bound{extent}));
1660 }
1661 return {std::move(result)};
1662 } else {
1663 return std::nullopt;
1664 }
1665}
1666
1667std::optional<ArraySpec> ToArraySpec(evaluate::FoldingContext &context,
1668 const std::optional<evaluate::Shape> &shape) {
1669 return shape ? ToArraySpec(context, *shape) : std::nullopt;
1670}
1671
1672static const DeclTypeSpec *GetDtvArgTypeSpec(const Symbol &proc) {
1673 if (const auto *subp{proc.detailsIf<SubprogramDetails>()};
1674 subp && !subp->dummyArgs().empty()) {
1675 if (const auto *arg{subp->dummyArgs()[0]}) {
1676 return arg->GetType();
1677 }
1678 }
1679 return nullptr;
1680}
1681
1682const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &proc) {
1683 if (const auto *type{GetDtvArgTypeSpec(proc)}) {
1684 return type->AsDerived();
1685 } else {
1686 return nullptr;
1687 }
1688}
1689
1690bool HasDefinedIo(common::DefinedIo which, const DerivedTypeSpec &derived,
1691 const Scope *scope) {
1692 if (const Scope * dtScope{derived.scope()}) {
1693 for (const auto &pair : *dtScope) {
1694 const Symbol &symbol{*pair.second};
1695 if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
1696 GenericKind kind{generic->kind()};
1697 if (const auto *io{std::get_if<common::DefinedIo>(&kind.u)}) {
1698 if (*io == which) {
1699 return true; // type-bound GENERIC exists
1700 }
1701 }
1702 }
1703 }
1704 }
1705 if (scope) {
1706 SourceName name{GenericKind::AsFortran(which)};
1707 evaluate::DynamicType dyDerived{derived};
1708 for (; scope && !scope->IsGlobal(); scope = &scope->parent()) {
1709 auto iter{scope->find(name)};
1710 if (iter != scope->end()) {
1711 const auto &generic{iter->second->GetUltimate().get<GenericDetails>()};
1712 for (auto ref : generic.specificProcs()) {
1713 const Symbol &procSym{ref->GetUltimate()};
1714 if (const DeclTypeSpec * dtSpec{GetDtvArgTypeSpec(procSym)}) {
1715 if (auto dyDummy{evaluate::DynamicType::From(*dtSpec)}) {
1716 if (dyDummy->IsTkCompatibleWith(dyDerived)) {
1717 return true; // GENERIC or INTERFACE not in type
1718 }
1719 }
1720 }
1721 }
1722 }
1723 }
1724 }
1725 // Check for inherited defined I/O
1726 const auto *parentType{derived.typeSymbol().GetParentTypeSpec()};
1727 return parentType && HasDefinedIo(which, *parentType, scope);
1728}
1729
1730template <typename E>
1731std::forward_list<std::string> GetOperatorNames(
1732 const SemanticsContext &context, E opr) {
1733 std::forward_list<std::string> result;
1734 for (const char *name : context.languageFeatures().GetNames(opr)) {
1735 result.emplace_front("operator("s + name + ')');
1736 }
1737 return result;
1738}
1739
1740std::forward_list<std::string> GetAllNames(
1741 const SemanticsContext &context, const SourceName &name) {
1742 std::string str{name.ToString()};
1743 if (!name.empty() && name.back() == ')' &&
1744 name.ToString().rfind("operator(", 0) == 0) {
1745 for (int i{0}; i != common::LogicalOperator_enumSize; ++i) {
1746 auto names{GetOperatorNames(context, common::LogicalOperator{i})};
1747 if (llvm::is_contained(names, str)) {
1748 return names;
1749 }
1750 }
1751 for (int i{0}; i != common::RelationalOperator_enumSize; ++i) {
1752 auto names{GetOperatorNames(context, common::RelationalOperator{i})};
1753 if (llvm::is_contained(names, str)) {
1754 return names;
1755 }
1756 }
1757 }
1758 return {str};
1759}
1760
1761void WarnOnDeferredLengthCharacterScalar(SemanticsContext &context,
1762 const SomeExpr *expr, parser::CharBlock at, const char *what) {
1763 if (context.languageFeatures().ShouldWarn(
1764 common::UsageWarning::F202XAllocatableBreakingChange)) {
1765 if (const Symbol *
1766 symbol{evaluate::UnwrapWholeSymbolOrComponentDataRef(expr)}) {
1767 const Symbol &ultimate{ResolveAssociations(*symbol)};
1768 if (const DeclTypeSpec * type{ultimate.GetType()}; type &&
1769 type->category() == DeclTypeSpec::Category::Character &&
1770 type->characterTypeSpec().length().isDeferred() &&
1771 IsAllocatable(ultimate) && ultimate.Rank() == 0) {
1772 context.Say(at,
1773 "The deferred length allocatable character scalar variable '%s' may be reallocated to a different length under the new Fortran 202X standard semantics for %s"_port_en_US,
1774 symbol->name(), what);
1775 }
1776 }
1777 }
1778}
1779
1780bool CouldBeDataPointerValuedFunction(const Symbol *original) {
1781 if (original) {
1782 const Symbol &ultimate{original->GetUltimate()};
1783 if (const Symbol * result{FindFunctionResult(ultimate)}) {
1784 return IsPointer(*result) && !IsProcedure(*result);
1785 }
1786 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
1787 for (const SymbolRef &ref : generic->specificProcs()) {
1788 if (CouldBeDataPointerValuedFunction(&*ref)) {
1789 return true;
1790 }
1791 }
1792 }
1793 }
1794 return false;
1795}
1796
1797std::string GetModuleOrSubmoduleName(const Symbol &symbol) {
1798 const auto &details{symbol.get<ModuleDetails>()};
1799 std::string result{symbol.name().ToString()};
1800 if (details.ancestor() && details.ancestor()->symbol()) {
1801 result = details.ancestor()->symbol()->name().ToString() + ':' + result;
1802 }
1803 return result;
1804}
1805
1806std::string GetCommonBlockObjectName(const Symbol &common, bool underscoring) {
1807 if (const std::string * bind{common.GetBindName()}) {
1808 return *bind;
1809 }
1810 if (common.name().empty()) {
1811 return Fortran::common::blankCommonObjectName;
1812 }
1813 return underscoring ? common.name().ToString() + "_"s
1814 : common.name().ToString();
1815}
1816
1817bool HadUseError(
1818 SemanticsContext &context, SourceName at, const Symbol *symbol) {
1819 if (const auto *details{
1820 symbol ? symbol->detailsIf<UseErrorDetails>() : nullptr}) {
1821 auto &msg{context.Say(
1822 at, "Reference to '%s' is ambiguous"_err_en_US, symbol->name())};
1823 for (const auto &[location, sym] : details->occurrences()) {
1824 const Symbol &ultimate{sym->GetUltimate()};
1825 if (sym->owner().IsModule()) {
1826 auto &attachment{msg.Attach(location,
1827 "'%s' was use-associated from module '%s'"_en_US, at,
1828 sym->owner().GetName().value())};
1829 if (&*sym != &ultimate) {
1830 // For incompatible definitions where one comes from a hermetic
1831 // module file's incorporated dependences and the other from another
1832 // module of the same name.
1833 attachment.Attach(ultimate.name(),
1834 "ultimately from '%s' in module '%s'"_en_US, ultimate.name(),
1835 ultimate.owner().GetName().value());
1836 }
1837 } else {
1838 msg.Attach(sym->name(), "declared here"_en_US);
1839 }
1840 }
1841 context.SetError(*symbol);
1842 return true;
1843 } else {
1844 return false;
1845 }
1846}
1847
1848} // namespace Fortran::semantics
1849

source code of flang/lib/Semantics/tools.cpp