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/Fortran.h" 11 #include "flang/Common/indirection.h" 12 #include "flang/Parser/dump-parse-tree.h" 13 #include "flang/Parser/message.h" 14 #include "flang/Parser/parse-tree.h" 15 #include "flang/Semantics/scope.h" 16 #include "flang/Semantics/semantics.h" 17 #include "flang/Semantics/symbol.h" 18 #include "flang/Semantics/tools.h" 19 #include "flang/Semantics/type.h" 20 #include "llvm/Support/raw_ostream.h" 21 #include <algorithm> 22 #include <set> 23 #include <variant> 24 25 namespace Fortran::semantics { 26 27 // Find this or containing scope that matches predicate 28 static 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->IsGlobal()) { 35 return nullptr; 36 } 37 } 38 } 39 40 const Scope &GetTopLevelUnitContaining(const Scope &start) { 41 CHECK(!start.IsGlobal()); 42 return DEREF(FindScopeContaining( 43 start, [](const Scope &scope) { return scope.parent().IsGlobal(); })); 44 } 45 46 const Scope &GetTopLevelUnitContaining(const Symbol &symbol) { 47 return GetTopLevelUnitContaining(symbol.owner()); 48 } 49 50 const Scope *FindModuleContaining(const Scope &start) { 51 return FindScopeContaining( 52 start, [](const Scope &scope) { return scope.IsModule(); }); 53 } 54 55 const Scope &GetProgramUnitContaining(const Scope &start) { 56 CHECK(!start.IsGlobal()); 57 return DEREF(FindScopeContaining(start, [](const Scope &scope) { 58 switch (scope.kind()) { 59 case Scope::Kind::Module: 60 case Scope::Kind::MainProgram: 61 case Scope::Kind::Subprogram: 62 case Scope::Kind::BlockData: 63 return true; 64 default: 65 return false; 66 } 67 })); 68 } 69 70 const Scope &GetProgramUnitContaining(const Symbol &symbol) { 71 return GetProgramUnitContaining(symbol.owner()); 72 } 73 74 const Scope *FindPureProcedureContaining(const Scope &start) { 75 // N.B. We only need to examine the innermost containing program unit 76 // because an internal subprogram of a pure subprogram must also 77 // be pure (C1592). 78 const Scope &scope{GetProgramUnitContaining(start)}; 79 return IsPureProcedure(scope) ? &scope : nullptr; 80 } 81 82 Tristate IsDefinedAssignment( 83 const std::optional<evaluate::DynamicType> &lhsType, int lhsRank, 84 const std::optional<evaluate::DynamicType> &rhsType, int rhsRank) { 85 if (!lhsType || !rhsType) { 86 return Tristate::No; // error or rhs is untyped 87 } 88 TypeCategory lhsCat{lhsType->category()}; 89 TypeCategory rhsCat{rhsType->category()}; 90 if (rhsRank > 0 && lhsRank != rhsRank) { 91 return Tristate::Yes; 92 } else if (lhsCat != TypeCategory::Derived) { 93 return ToTristate(lhsCat != rhsCat && 94 (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat))); 95 } else { 96 const auto *lhsDerived{evaluate::GetDerivedTypeSpec(lhsType)}; 97 const auto *rhsDerived{evaluate::GetDerivedTypeSpec(rhsType)}; 98 if (lhsDerived && rhsDerived && *lhsDerived == *rhsDerived) { 99 return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or 100 // intrinsic 101 } else { 102 return Tristate::Yes; 103 } 104 } 105 } 106 107 bool IsIntrinsicRelational(common::RelationalOperator opr, 108 const evaluate::DynamicType &type0, int rank0, 109 const evaluate::DynamicType &type1, int rank1) { 110 if (!evaluate::AreConformable(rank0, rank1)) { 111 return false; 112 } else { 113 auto cat0{type0.category()}; 114 auto cat1{type1.category()}; 115 if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) { 116 // numeric types: EQ/NE always ok, others ok for non-complex 117 return opr == common::RelationalOperator::EQ || 118 opr == common::RelationalOperator::NE || 119 (cat0 != TypeCategory::Complex && cat1 != TypeCategory::Complex); 120 } else { 121 // not both numeric: only Character is ok 122 return cat0 == TypeCategory::Character && cat1 == TypeCategory::Character; 123 } 124 } 125 } 126 127 bool IsIntrinsicNumeric(const evaluate::DynamicType &type0) { 128 return IsNumericTypeCategory(type0.category()); 129 } 130 bool IsIntrinsicNumeric(const evaluate::DynamicType &type0, int rank0, 131 const evaluate::DynamicType &type1, int rank1) { 132 return evaluate::AreConformable(rank0, rank1) && 133 IsNumericTypeCategory(type0.category()) && 134 IsNumericTypeCategory(type1.category()); 135 } 136 137 bool IsIntrinsicLogical(const evaluate::DynamicType &type0) { 138 return type0.category() == TypeCategory::Logical; 139 } 140 bool IsIntrinsicLogical(const evaluate::DynamicType &type0, int rank0, 141 const evaluate::DynamicType &type1, int rank1) { 142 return evaluate::AreConformable(rank0, rank1) && 143 type0.category() == TypeCategory::Logical && 144 type1.category() == TypeCategory::Logical; 145 } 146 147 bool IsIntrinsicConcat(const evaluate::DynamicType &type0, int rank0, 148 const evaluate::DynamicType &type1, int rank1) { 149 return evaluate::AreConformable(rank0, rank1) && 150 type0.category() == TypeCategory::Character && 151 type1.category() == TypeCategory::Character && 152 type0.kind() == type1.kind(); 153 } 154 155 bool IsGenericDefinedOp(const Symbol &symbol) { 156 const Symbol &ultimate{symbol.GetUltimate()}; 157 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) { 158 return generic->kind().IsDefinedOperator(); 159 } else if (const auto *misc{ultimate.detailsIf<MiscDetails>()}) { 160 return misc->kind() == MiscDetails::Kind::TypeBoundDefinedOp; 161 } else { 162 return false; 163 } 164 } 165 166 bool IsDefinedOperator(SourceName name) { 167 const char *begin{name.begin()}; 168 const char *end{name.end()}; 169 return begin != end && begin[0] == '.' && end[-1] == '.'; 170 } 171 172 std::string MakeOpName(SourceName name) { 173 std::string result{name.ToString()}; 174 return IsDefinedOperator(name) ? "OPERATOR(" + result + ")" 175 : result.find("operator(", 0) == 0 ? parser::ToUpperCaseLetters(result) 176 : result; 177 } 178 179 bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) { 180 const auto &objects{block.get<CommonBlockDetails>().objects()}; 181 auto found{std::find(objects.begin(), objects.end(), object)}; 182 return found != objects.end(); 183 } 184 185 bool IsUseAssociated(const Symbol &symbol, const Scope &scope) { 186 const Scope &owner{GetProgramUnitContaining(symbol.GetUltimate().owner())}; 187 return owner.kind() == Scope::Kind::Module && 188 owner != GetProgramUnitContaining(scope); 189 } 190 191 bool DoesScopeContain( 192 const Scope *maybeAncestor, const Scope &maybeDescendent) { 193 return maybeAncestor && !maybeDescendent.IsGlobal() && 194 FindScopeContaining(maybeDescendent.parent(), 195 [&](const Scope &scope) { return &scope == maybeAncestor; }); 196 } 197 198 bool DoesScopeContain(const Scope *maybeAncestor, const Symbol &symbol) { 199 return DoesScopeContain(maybeAncestor, symbol.owner()); 200 } 201 202 static const Symbol &FollowHostAssoc(const Symbol &symbol) { 203 for (const Symbol *s{&symbol};;) { 204 const auto *details{s->detailsIf<HostAssocDetails>()}; 205 if (!details) { 206 return *s; 207 } 208 s = &details->symbol(); 209 } 210 } 211 212 bool IsHostAssociated(const Symbol &symbol, const Scope &scope) { 213 const Scope &subprogram{GetProgramUnitContaining(scope)}; 214 return DoesScopeContain( 215 &GetProgramUnitContaining(FollowHostAssoc(symbol)), subprogram); 216 } 217 218 bool IsInStmtFunction(const Symbol &symbol) { 219 if (const Symbol * function{symbol.owner().symbol()}) { 220 return IsStmtFunction(*function); 221 } 222 return false; 223 } 224 225 bool IsStmtFunctionDummy(const Symbol &symbol) { 226 return IsDummy(symbol) && IsInStmtFunction(symbol); 227 } 228 229 bool IsStmtFunctionResult(const Symbol &symbol) { 230 return IsFunctionResult(symbol) && IsInStmtFunction(symbol); 231 } 232 233 bool IsPointerDummy(const Symbol &symbol) { 234 return IsPointer(symbol) && IsDummy(symbol); 235 } 236 237 // proc-name 238 bool IsProcName(const Symbol &symbol) { 239 return symbol.GetUltimate().has<ProcEntityDetails>(); 240 } 241 242 bool IsBindCProcedure(const Symbol &symbol) { 243 if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) { 244 if (const Symbol * procInterface{procDetails->interface().symbol()}) { 245 // procedure component with a BIND(C) interface 246 return IsBindCProcedure(*procInterface); 247 } 248 } 249 return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol); 250 } 251 252 bool IsBindCProcedure(const Scope &scope) { 253 if (const Symbol * symbol{scope.GetSymbol()}) { 254 return IsBindCProcedure(*symbol); 255 } else { 256 return false; 257 } 258 } 259 260 static const Symbol *FindPointerComponent( 261 const Scope &scope, std::set<const Scope *> &visited) { 262 if (!scope.IsDerivedType()) { 263 return nullptr; 264 } 265 if (!visited.insert(&scope).second) { 266 return nullptr; 267 } 268 // If there's a top-level pointer component, return it for clearer error 269 // messaging. 270 for (const auto &pair : scope) { 271 const Symbol &symbol{*pair.second}; 272 if (IsPointer(symbol)) { 273 return &symbol; 274 } 275 } 276 for (const auto &pair : scope) { 277 const Symbol &symbol{*pair.second}; 278 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { 279 if (const DeclTypeSpec * type{details->type()}) { 280 if (const DerivedTypeSpec * derived{type->AsDerived()}) { 281 if (const Scope * nested{derived->scope()}) { 282 if (const Symbol * 283 pointer{FindPointerComponent(*nested, visited)}) { 284 return pointer; 285 } 286 } 287 } 288 } 289 } 290 } 291 return nullptr; 292 } 293 294 const Symbol *FindPointerComponent(const Scope &scope) { 295 std::set<const Scope *> visited; 296 return FindPointerComponent(scope, visited); 297 } 298 299 const Symbol *FindPointerComponent(const DerivedTypeSpec &derived) { 300 if (const Scope * scope{derived.scope()}) { 301 return FindPointerComponent(*scope); 302 } else { 303 return nullptr; 304 } 305 } 306 307 const Symbol *FindPointerComponent(const DeclTypeSpec &type) { 308 if (const DerivedTypeSpec * derived{type.AsDerived()}) { 309 return FindPointerComponent(*derived); 310 } else { 311 return nullptr; 312 } 313 } 314 315 const Symbol *FindPointerComponent(const DeclTypeSpec *type) { 316 return type ? FindPointerComponent(*type) : nullptr; 317 } 318 319 const Symbol *FindPointerComponent(const Symbol &symbol) { 320 return IsPointer(symbol) ? &symbol : FindPointerComponent(symbol.GetType()); 321 } 322 323 // C1594 specifies several ways by which an object might be globally visible. 324 const Symbol *FindExternallyVisibleObject( 325 const Symbol &object, const Scope &scope) { 326 // TODO: Storage association with any object for which this predicate holds, 327 // once EQUIVALENCE is supported. 328 if (IsUseAssociated(object, scope) || IsHostAssociated(object, scope) || 329 (IsPureProcedure(scope) && IsPointerDummy(object)) || 330 (IsIntentIn(object) && IsDummy(object))) { 331 return &object; 332 } else if (const Symbol * block{FindCommonBlockContaining(object)}) { 333 return block; 334 } else { 335 return nullptr; 336 } 337 } 338 339 bool ExprHasTypeCategory( 340 const SomeExpr &expr, const common::TypeCategory &type) { 341 auto dynamicType{expr.GetType()}; 342 return dynamicType && dynamicType->category() == type; 343 } 344 345 bool ExprTypeKindIsDefault( 346 const SomeExpr &expr, const SemanticsContext &context) { 347 auto dynamicType{expr.GetType()}; 348 return dynamicType && 349 dynamicType->category() != common::TypeCategory::Derived && 350 dynamicType->kind() == context.GetDefaultKind(dynamicType->category()); 351 } 352 353 // If an analyzed expr or assignment is missing, dump the node and die. 354 template <typename T> 355 static void CheckMissingAnalysis(bool absent, const T &x) { 356 if (absent) { 357 std::string buf; 358 llvm::raw_string_ostream ss{buf}; 359 ss << "node has not been analyzed:\n"; 360 parser::DumpTree(ss, x); 361 common::die(ss.str().c_str()); 362 } 363 } 364 365 const SomeExpr *GetExprHelper::Get(const parser::Expr &x) { 366 CheckMissingAnalysis(!x.typedExpr, x); 367 return common::GetPtrFromOptional(x.typedExpr->v); 368 } 369 const SomeExpr *GetExprHelper::Get(const parser::Variable &x) { 370 CheckMissingAnalysis(!x.typedExpr, x); 371 return common::GetPtrFromOptional(x.typedExpr->v); 372 } 373 const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) { 374 CheckMissingAnalysis(!x.typedExpr, x); 375 return common::GetPtrFromOptional(x.typedExpr->v); 376 } 377 378 const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) { 379 CheckMissingAnalysis(!x.typedAssignment, x); 380 return common::GetPtrFromOptional(x.typedAssignment->v); 381 } 382 const evaluate::Assignment *GetAssignment( 383 const parser::PointerAssignmentStmt &x) { 384 CheckMissingAnalysis(!x.typedAssignment, x); 385 return common::GetPtrFromOptional(x.typedAssignment->v); 386 } 387 388 const Symbol *FindInterface(const Symbol &symbol) { 389 return std::visit( 390 common::visitors{ 391 [](const ProcEntityDetails &details) { 392 return details.interface().symbol(); 393 }, 394 [](const ProcBindingDetails &details) { return &details.symbol(); }, 395 [](const auto &) -> const Symbol * { return nullptr; }, 396 }, 397 symbol.details()); 398 } 399 400 const Symbol *FindSubprogram(const Symbol &symbol) { 401 return std::visit( 402 common::visitors{ 403 [&](const ProcEntityDetails &details) -> const Symbol * { 404 if (const Symbol * interface{details.interface().symbol()}) { 405 return FindSubprogram(*interface); 406 } else { 407 return &symbol; 408 } 409 }, 410 [](const ProcBindingDetails &details) { 411 return FindSubprogram(details.symbol()); 412 }, 413 [&](const SubprogramDetails &) { return &symbol; }, 414 [](const UseDetails &details) { 415 return FindSubprogram(details.symbol()); 416 }, 417 [](const HostAssocDetails &details) { 418 return FindSubprogram(details.symbol()); 419 }, 420 [](const auto &) -> const Symbol * { return nullptr; }, 421 }, 422 symbol.details()); 423 } 424 425 const Symbol *FindFunctionResult(const Symbol &symbol) { 426 if (const Symbol * subp{FindSubprogram(symbol)}) { 427 if (const auto &subpDetails{subp->detailsIf<SubprogramDetails>()}) { 428 if (subpDetails->isFunction()) { 429 return &subpDetails->result(); 430 } 431 } 432 } 433 return nullptr; 434 } 435 436 const Symbol *FindOverriddenBinding(const Symbol &symbol) { 437 if (symbol.has<ProcBindingDetails>()) { 438 if (const DeclTypeSpec * parentType{FindParentTypeSpec(symbol.owner())}) { 439 if (const DerivedTypeSpec * parentDerived{parentType->AsDerived()}) { 440 if (const Scope * parentScope{parentDerived->typeSymbol().scope()}) { 441 return parentScope->FindComponent(symbol.name()); 442 } 443 } 444 } 445 } 446 return nullptr; 447 } 448 449 const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &derived) { 450 return FindParentTypeSpec(derived.typeSymbol()); 451 } 452 453 const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &decl) { 454 if (const DerivedTypeSpec * derived{decl.AsDerived()}) { 455 return FindParentTypeSpec(*derived); 456 } else { 457 return nullptr; 458 } 459 } 460 461 const DeclTypeSpec *FindParentTypeSpec(const Scope &scope) { 462 if (scope.kind() == Scope::Kind::DerivedType) { 463 if (const auto *symbol{scope.symbol()}) { 464 return FindParentTypeSpec(*symbol); 465 } 466 } 467 return nullptr; 468 } 469 470 const DeclTypeSpec *FindParentTypeSpec(const Symbol &symbol) { 471 if (const Scope * scope{symbol.scope()}) { 472 if (const auto *details{symbol.detailsIf<DerivedTypeDetails>()}) { 473 if (const Symbol * parent{details->GetParentComponent(*scope)}) { 474 return parent->GetType(); 475 } 476 } 477 } 478 return nullptr; 479 } 480 481 bool IsExtensibleType(const DerivedTypeSpec *derived) { 482 return derived && !IsIsoCType(derived) && 483 !derived->typeSymbol().attrs().test(Attr::BIND_C) && 484 !derived->typeSymbol().get<DerivedTypeDetails>().sequence(); 485 } 486 487 bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) { 488 if (!derived) { 489 return false; 490 } else { 491 const auto &symbol{derived->typeSymbol()}; 492 return symbol.owner().IsModule() && 493 symbol.owner().GetName().value() == "__fortran_builtins" && 494 symbol.name() == "__builtin_"s + name; 495 } 496 } 497 498 bool IsIsoCType(const DerivedTypeSpec *derived) { 499 return IsBuiltinDerivedType(derived, "c_ptr") || 500 IsBuiltinDerivedType(derived, "c_funptr"); 501 } 502 503 bool IsTeamType(const DerivedTypeSpec *derived) { 504 return IsBuiltinDerivedType(derived, "team_type"); 505 } 506 507 bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) { 508 return IsBuiltinDerivedType(derivedTypeSpec, "event_type") || 509 IsBuiltinDerivedType(derivedTypeSpec, "lock_type"); 510 } 511 512 bool IsOrContainsEventOrLockComponent(const Symbol &symbol) { 513 if (const Symbol * root{GetAssociationRoot(symbol)}) { 514 if (const auto *details{root->detailsIf<ObjectEntityDetails>()}) { 515 if (const DeclTypeSpec * type{details->type()}) { 516 if (const DerivedTypeSpec * derived{type->AsDerived()}) { 517 return IsEventTypeOrLockType(derived) || 518 FindEventOrLockPotentialComponent(*derived); 519 } 520 } 521 } 522 } 523 return false; 524 } 525 526 // Check this symbol suitable as a type-bound procedure - C769 527 bool CanBeTypeBoundProc(const Symbol *symbol) { 528 if (!symbol || IsDummy(*symbol) || IsProcedurePointer(*symbol)) { 529 return false; 530 } else if (symbol->has<SubprogramNameDetails>()) { 531 return symbol->owner().kind() == Scope::Kind::Module; 532 } else if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { 533 return symbol->owner().kind() == Scope::Kind::Module || 534 details->isInterface(); 535 } else if (const auto *proc{symbol->detailsIf<ProcEntityDetails>()}) { 536 return !symbol->attrs().test(Attr::INTRINSIC) && 537 proc->HasExplicitInterface(); 538 } else { 539 return false; 540 } 541 } 542 543 bool IsInitialized(const Symbol &symbol, bool ignoreDATAstatements) { 544 if (!ignoreDATAstatements && symbol.test(Symbol::Flag::InDataStmt)) { 545 return true; 546 } else if (IsNamedConstant(symbol)) { 547 return false; 548 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { 549 if (object->init()) { 550 return true; 551 } else if (object->isDummy() || IsFunctionResult(symbol)) { 552 return false; 553 } else if (IsAllocatable(symbol)) { 554 return true; 555 } else if (!IsPointer(symbol) && object->type()) { 556 if (const auto *derived{object->type()->AsDerived()}) { 557 if (derived->HasDefaultInitialization()) { 558 return true; 559 } 560 } 561 } 562 } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) { 563 return proc->init().has_value(); 564 } 565 return false; 566 } 567 568 bool HasIntrinsicTypeName(const Symbol &symbol) { 569 std::string name{symbol.name().ToString()}; 570 if (name == "doubleprecision") { 571 return true; 572 } else if (name == "derived") { 573 return false; 574 } else { 575 for (int i{0}; i != common::TypeCategory_enumSize; ++i) { 576 if (name == parser::ToLowerCaseLetters(EnumToString(TypeCategory{i}))) { 577 return true; 578 } 579 } 580 return false; 581 } 582 } 583 584 bool IsSeparateModuleProcedureInterface(const Symbol *symbol) { 585 if (symbol && symbol->attrs().test(Attr::MODULE)) { 586 if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { 587 return details->isInterface(); 588 } 589 } 590 return false; 591 } 592 593 // 3.11 automatic data object 594 bool IsAutomatic(const Symbol &symbol) { 595 if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { 596 if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) { 597 if (const DeclTypeSpec * type{symbol.GetType()}) { 598 // If a type parameter value is not a constant expression, the 599 // object is automatic. 600 if (type->category() == DeclTypeSpec::Character) { 601 if (const auto &length{ 602 type->characterTypeSpec().length().GetExplicit()}) { 603 if (!evaluate::IsConstantExpr(*length)) { 604 return true; 605 } 606 } 607 } else if (const DerivedTypeSpec * derived{type->AsDerived()}) { 608 for (const auto &pair : derived->parameters()) { 609 if (const auto &value{pair.second.GetExplicit()}) { 610 if (!evaluate::IsConstantExpr(*value)) { 611 return true; 612 } 613 } 614 } 615 } 616 } 617 // If an array bound is not a constant expression, the object is 618 // automatic. 619 for (const ShapeSpec &dim : object->shape()) { 620 if (const auto &lb{dim.lbound().GetExplicit()}) { 621 if (!evaluate::IsConstantExpr(*lb)) { 622 return true; 623 } 624 } 625 if (const auto &ub{dim.ubound().GetExplicit()}) { 626 if (!evaluate::IsConstantExpr(*ub)) { 627 return true; 628 } 629 } 630 } 631 } 632 } 633 return false; 634 } 635 636 bool IsFinalizable(const Symbol &symbol) { 637 if (const DeclTypeSpec * type{symbol.GetType()}) { 638 if (const DerivedTypeSpec * derived{type->AsDerived()}) { 639 return IsFinalizable(*derived); 640 } 641 } 642 return false; 643 } 644 645 bool IsFinalizable(const DerivedTypeSpec &derived) { 646 if (!derived.typeSymbol().get<DerivedTypeDetails>().finals().empty()) { 647 return true; 648 } 649 DirectComponentIterator components{derived}; 650 return bool{std::find_if(components.begin(), components.end(), 651 [](const Symbol &component) { return IsFinalizable(component); })}; 652 } 653 654 bool HasImpureFinal(const DerivedTypeSpec &derived) { 655 if (const auto *details{ 656 derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) { 657 const auto &finals{details->finals()}; 658 return std::any_of(finals.begin(), finals.end(), 659 [](const auto &x) { return !x.second->attrs().test(Attr::PURE); }); 660 } else { 661 return false; 662 } 663 } 664 665 bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; } 666 667 bool IsAutomaticObject(const Symbol &symbol) { 668 if (IsDummy(symbol) || IsPointer(symbol) || IsAllocatable(symbol)) { 669 return false; 670 } 671 if (const DeclTypeSpec * type{symbol.GetType()}) { 672 if (type->category() == DeclTypeSpec::Character) { 673 ParamValue length{type->characterTypeSpec().length()}; 674 if (length.isExplicit()) { 675 if (MaybeIntExpr lengthExpr{length.GetExplicit()}) { 676 if (!ToInt64(lengthExpr)) { 677 return true; 678 } 679 } 680 } 681 } 682 } 683 if (symbol.IsObjectArray()) { 684 for (const ShapeSpec &spec : symbol.get<ObjectEntityDetails>().shape()) { 685 auto &lbound{spec.lbound().GetExplicit()}; 686 auto &ubound{spec.ubound().GetExplicit()}; 687 if ((lbound && !evaluate::ToInt64(*lbound)) || 688 (ubound && !evaluate::ToInt64(*ubound))) { 689 return true; 690 } 691 } 692 } 693 return false; 694 } 695 696 bool IsAssumedLengthCharacter(const Symbol &symbol) { 697 if (const DeclTypeSpec * type{symbol.GetType()}) { 698 return type->category() == DeclTypeSpec::Character && 699 type->characterTypeSpec().length().isAssumed(); 700 } else { 701 return false; 702 } 703 } 704 705 bool IsInBlankCommon(const Symbol &symbol) { 706 const Symbol *block{FindCommonBlockContaining(symbol)}; 707 return block && block->name().empty(); 708 } 709 710 // C722 and C723: For a function to be assumed length, it must be external and 711 // of CHARACTER type 712 bool IsExternal(const Symbol &symbol) { 713 return ClassifyProcedure(symbol) == ProcedureDefinitionClass::External; 714 } 715 716 bool IsModuleProcedure(const Symbol &symbol) { 717 return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module; 718 } 719 const Symbol *IsExternalInPureContext( 720 const Symbol &symbol, const Scope &scope) { 721 if (const auto *pureProc{FindPureProcedureContaining(scope)}) { 722 if (const Symbol * root{GetAssociationRoot(symbol)}) { 723 if (const Symbol * 724 visible{FindExternallyVisibleObject(*root, *pureProc)}) { 725 return visible; 726 } 727 } 728 } 729 return nullptr; 730 } 731 732 PotentialComponentIterator::const_iterator FindPolymorphicPotentialComponent( 733 const DerivedTypeSpec &derived) { 734 PotentialComponentIterator potentials{derived}; 735 return std::find_if( 736 potentials.begin(), potentials.end(), [](const Symbol &component) { 737 if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) { 738 const DeclTypeSpec *type{details->type()}; 739 return type && type->IsPolymorphic(); 740 } 741 return false; 742 }); 743 } 744 745 bool IsOrContainsPolymorphicComponent(const Symbol &symbol) { 746 if (const Symbol * root{GetAssociationRoot(symbol)}) { 747 if (const auto *details{root->detailsIf<ObjectEntityDetails>()}) { 748 if (const DeclTypeSpec * type{details->type()}) { 749 if (type->IsPolymorphic()) { 750 return true; 751 } 752 if (const DerivedTypeSpec * derived{type->AsDerived()}) { 753 return (bool)FindPolymorphicPotentialComponent(*derived); 754 } 755 } 756 } 757 } 758 return false; 759 } 760 761 bool InProtectedContext(const Symbol &symbol, const Scope ¤tScope) { 762 return IsProtected(symbol) && !IsHostAssociated(symbol, currentScope); 763 } 764 765 // C1101 and C1158 766 std::optional<parser::MessageFixedText> WhyNotModifiable( 767 const Symbol &symbol, const Scope &scope) { 768 const Symbol *root{GetAssociationRoot(symbol)}; 769 if (!root) { 770 return "'%s' is construct associated with an expression"_en_US; 771 } else if (InProtectedContext(*root, scope)) { 772 return "'%s' is protected in this scope"_en_US; 773 } else if (IsExternalInPureContext(*root, scope)) { 774 return "'%s' is externally visible and referenced in a pure" 775 " procedure"_en_US; 776 } else if (IsOrContainsEventOrLockComponent(*root)) { 777 return "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US; 778 } else if (IsIntentIn(*root)) { 779 return "'%s' is an INTENT(IN) dummy argument"_en_US; 780 } else if (!IsVariableName(*root)) { 781 return "'%s' is not a variable"_en_US; 782 } else { 783 return std::nullopt; 784 } 785 } 786 787 std::optional<parser::Message> WhyNotModifiable(parser::CharBlock at, 788 const SomeExpr &expr, const Scope &scope, bool vectorSubscriptIsOk) { 789 if (!evaluate::IsVariable(expr)) { 790 return parser::Message{at, "Expression is not a variable"_en_US}; 791 } else if (auto dataRef{evaluate::ExtractDataRef(expr, true)}) { 792 if (!vectorSubscriptIsOk && evaluate::HasVectorSubscript(expr)) { 793 return parser::Message{at, "Variable has a vector subscript"_en_US}; 794 } 795 const Symbol &symbol{dataRef->GetFirstSymbol()}; 796 if (auto maybeWhy{WhyNotModifiable(symbol, scope)}) { 797 return parser::Message{symbol.name(), 798 parser::MessageFormattedText{std::move(*maybeWhy), symbol.name()}}; 799 } 800 } else { 801 // reference to function returning POINTER 802 } 803 return std::nullopt; 804 } 805 806 class ImageControlStmtHelper { 807 using ImageControlStmts = std::variant<parser::ChangeTeamConstruct, 808 parser::CriticalConstruct, parser::EventPostStmt, parser::EventWaitStmt, 809 parser::FormTeamStmt, parser::LockStmt, parser::StopStmt, 810 parser::SyncAllStmt, parser::SyncImagesStmt, parser::SyncMemoryStmt, 811 parser::SyncTeamStmt, parser::UnlockStmt>; 812 813 public: 814 template <typename T> bool operator()(const T &) { 815 return common::HasMember<T, ImageControlStmts>; 816 } 817 template <typename T> bool operator()(const common::Indirection<T> &x) { 818 return (*this)(x.value()); 819 } 820 bool operator()(const parser::AllocateStmt &stmt) { 821 const auto &allocationList{std::get<std::list<parser::Allocation>>(stmt.t)}; 822 for (const auto &allocation : allocationList) { 823 const auto &allocateObject{ 824 std::get<parser::AllocateObject>(allocation.t)}; 825 if (IsCoarrayObject(allocateObject)) { 826 return true; 827 } 828 } 829 return false; 830 } 831 bool operator()(const parser::DeallocateStmt &stmt) { 832 const auto &allocateObjectList{ 833 std::get<std::list<parser::AllocateObject>>(stmt.t)}; 834 for (const auto &allocateObject : allocateObjectList) { 835 if (IsCoarrayObject(allocateObject)) { 836 return true; 837 } 838 } 839 return false; 840 } 841 bool operator()(const parser::CallStmt &stmt) { 842 const auto &procedureDesignator{ 843 std::get<parser::ProcedureDesignator>(stmt.v.t)}; 844 if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) { 845 // TODO: also ensure that the procedure is, in fact, an intrinsic 846 if (name->source == "move_alloc") { 847 const auto &args{std::get<std::list<parser::ActualArgSpec>>(stmt.v.t)}; 848 if (!args.empty()) { 849 const parser::ActualArg &actualArg{ 850 std::get<parser::ActualArg>(args.front().t)}; 851 if (const auto *argExpr{ 852 std::get_if<common::Indirection<parser::Expr>>( 853 &actualArg.u)}) { 854 return HasCoarray(argExpr->value()); 855 } 856 } 857 } 858 } 859 return false; 860 } 861 bool operator()(const parser::Statement<parser::ActionStmt> &stmt) { 862 return std::visit(*this, stmt.statement.u); 863 } 864 865 private: 866 bool IsCoarrayObject(const parser::AllocateObject &allocateObject) { 867 const parser::Name &name{GetLastName(allocateObject)}; 868 return name.symbol && IsCoarray(*name.symbol); 869 } 870 }; 871 872 bool IsImageControlStmt(const parser::ExecutableConstruct &construct) { 873 return std::visit(ImageControlStmtHelper{}, construct.u); 874 } 875 876 std::optional<parser::MessageFixedText> GetImageControlStmtCoarrayMsg( 877 const parser::ExecutableConstruct &construct) { 878 if (const auto *actionStmt{ 879 std::get_if<parser::Statement<parser::ActionStmt>>(&construct.u)}) { 880 return std::visit( 881 common::visitors{ 882 [](const common::Indirection<parser::AllocateStmt> &) 883 -> std::optional<parser::MessageFixedText> { 884 return "ALLOCATE of a coarray is an image control" 885 " statement"_en_US; 886 }, 887 [](const common::Indirection<parser::DeallocateStmt> &) 888 -> std::optional<parser::MessageFixedText> { 889 return "DEALLOCATE of a coarray is an image control" 890 " statement"_en_US; 891 }, 892 [](const common::Indirection<parser::CallStmt> &) 893 -> std::optional<parser::MessageFixedText> { 894 return "MOVE_ALLOC of a coarray is an image control" 895 " statement "_en_US; 896 }, 897 [](const auto &) -> std::optional<parser::MessageFixedText> { 898 return std::nullopt; 899 }, 900 }, 901 actionStmt->statement.u); 902 } 903 return std::nullopt; 904 } 905 906 parser::CharBlock GetImageControlStmtLocation( 907 const parser::ExecutableConstruct &executableConstruct) { 908 return std::visit( 909 common::visitors{ 910 [](const common::Indirection<parser::ChangeTeamConstruct> 911 &construct) { 912 return std::get<parser::Statement<parser::ChangeTeamStmt>>( 913 construct.value().t) 914 .source; 915 }, 916 [](const common::Indirection<parser::CriticalConstruct> &construct) { 917 return std::get<parser::Statement<parser::CriticalStmt>>( 918 construct.value().t) 919 .source; 920 }, 921 [](const parser::Statement<parser::ActionStmt> &actionStmt) { 922 return actionStmt.source; 923 }, 924 [](const auto &) { return parser::CharBlock{}; }, 925 }, 926 executableConstruct.u); 927 } 928 929 bool HasCoarray(const parser::Expr &expression) { 930 if (const auto *expr{GetExpr(expression)}) { 931 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) { 932 if (const Symbol * root{GetAssociationRoot(symbol)}) { 933 if (IsCoarray(*root)) { 934 return true; 935 } 936 } 937 } 938 } 939 return false; 940 } 941 942 bool IsPolymorphic(const Symbol &symbol) { 943 if (const DeclTypeSpec * type{symbol.GetType()}) { 944 return type->IsPolymorphic(); 945 } 946 return false; 947 } 948 949 bool IsPolymorphicAllocatable(const Symbol &symbol) { 950 return IsAllocatable(symbol) && IsPolymorphic(symbol); 951 } 952 953 std::optional<parser::MessageFormattedText> CheckAccessibleComponent( 954 const Scope &scope, const Symbol &symbol) { 955 CHECK(symbol.owner().IsDerivedType()); // symbol must be a component 956 if (symbol.attrs().test(Attr::PRIVATE)) { 957 if (const Scope * moduleScope{FindModuleContaining(symbol.owner())}) { 958 if (!moduleScope->Contains(scope)) { 959 return parser::MessageFormattedText{ 960 "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US, 961 symbol.name(), moduleScope->GetName().value()}; 962 } 963 } 964 } 965 return std::nullopt; 966 } 967 968 std::list<SourceName> OrderParameterNames(const Symbol &typeSymbol) { 969 std::list<SourceName> result; 970 if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) { 971 result = OrderParameterNames(spec->typeSymbol()); 972 } 973 const auto ¶mNames{typeSymbol.get<DerivedTypeDetails>().paramNames()}; 974 result.insert(result.end(), paramNames.begin(), paramNames.end()); 975 return result; 976 } 977 978 SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) { 979 SymbolVector result; 980 if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) { 981 result = OrderParameterDeclarations(spec->typeSymbol()); 982 } 983 const auto ¶mDecls{typeSymbol.get<DerivedTypeDetails>().paramDecls()}; 984 result.insert(result.end(), paramDecls.begin(), paramDecls.end()); 985 return result; 986 } 987 988 const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope, 989 DerivedTypeSpec &&spec, SemanticsContext &semanticsContext, 990 DeclTypeSpec::Category category) { 991 spec.EvaluateParameters(semanticsContext); 992 if (const DeclTypeSpec * 993 type{scope.FindInstantiatedDerivedType(spec, category)}) { 994 return *type; 995 } 996 // Create a new instantiation of this parameterized derived type 997 // for this particular distinct set of actual parameter values. 998 DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))}; 999 type.derivedTypeSpec().Instantiate(scope, semanticsContext); 1000 return type; 1001 } 1002 1003 const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) { 1004 if (proc) { 1005 if (const Symbol * submodule{proc->owner().symbol()}) { 1006 if (const auto *details{submodule->detailsIf<ModuleDetails>()}) { 1007 if (const Scope * ancestor{details->ancestor()}) { 1008 const Symbol *iface{ancestor->FindSymbol(proc->name())}; 1009 if (IsSeparateModuleProcedureInterface(iface)) { 1010 return iface; 1011 } 1012 } 1013 } 1014 } 1015 } 1016 return nullptr; 1017 } 1018 1019 ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2 1020 const Symbol &ultimate{symbol.GetUltimate()}; 1021 if (ultimate.attrs().test(Attr::INTRINSIC)) { 1022 return ProcedureDefinitionClass::Intrinsic; 1023 } else if (ultimate.attrs().test(Attr::EXTERNAL)) { 1024 return ProcedureDefinitionClass::External; 1025 } else if (const auto *procDetails{ultimate.detailsIf<ProcEntityDetails>()}) { 1026 if (procDetails->isDummy()) { 1027 return ProcedureDefinitionClass::Dummy; 1028 } else if (IsPointer(ultimate)) { 1029 return ProcedureDefinitionClass::Pointer; 1030 } 1031 } else if (const Symbol * subp{FindSubprogram(symbol)}) { 1032 if (const auto *subpDetails{subp->detailsIf<SubprogramDetails>()}) { 1033 if (subpDetails->stmtFunction()) { 1034 return ProcedureDefinitionClass::StatementFunction; 1035 } 1036 } 1037 switch (ultimate.owner().kind()) { 1038 case Scope::Kind::Global: 1039 return ProcedureDefinitionClass::External; 1040 case Scope::Kind::Module: 1041 return ProcedureDefinitionClass::Module; 1042 case Scope::Kind::MainProgram: 1043 case Scope::Kind::Subprogram: 1044 return ProcedureDefinitionClass::Internal; 1045 default: 1046 break; 1047 } 1048 } 1049 return ProcedureDefinitionClass::None; 1050 } 1051 1052 // ComponentIterator implementation 1053 1054 template <ComponentKind componentKind> 1055 typename ComponentIterator<componentKind>::const_iterator 1056 ComponentIterator<componentKind>::const_iterator::Create( 1057 const DerivedTypeSpec &derived) { 1058 const_iterator it{}; 1059 it.componentPath_.emplace_back(derived); 1060 it.Increment(); // cue up first relevant component, if any 1061 return it; 1062 } 1063 1064 template <ComponentKind componentKind> 1065 const DerivedTypeSpec * 1066 ComponentIterator<componentKind>::const_iterator::PlanComponentTraversal( 1067 const Symbol &component) const { 1068 if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) { 1069 if (const DeclTypeSpec * type{details->type()}) { 1070 if (const auto *derived{type->AsDerived()}) { 1071 bool traverse{false}; 1072 if constexpr (componentKind == ComponentKind::Ordered) { 1073 // Order Component (only visit parents) 1074 traverse = component.test(Symbol::Flag::ParentComp); 1075 } else if constexpr (componentKind == ComponentKind::Direct) { 1076 traverse = !IsAllocatableOrPointer(component); 1077 } else if constexpr (componentKind == ComponentKind::Ultimate) { 1078 traverse = !IsAllocatableOrPointer(component); 1079 } else if constexpr (componentKind == ComponentKind::Potential) { 1080 traverse = !IsPointer(component); 1081 } else if constexpr (componentKind == ComponentKind::Scope) { 1082 traverse = !IsAllocatableOrPointer(component); 1083 } 1084 if (traverse) { 1085 const Symbol &newTypeSymbol{derived->typeSymbol()}; 1086 // Avoid infinite loop if the type is already part of the types 1087 // being visited. It is possible to have "loops in type" because 1088 // C744 does not forbid to use not yet declared type for 1089 // ALLOCATABLE or POINTER components. 1090 for (const auto &node : componentPath_) { 1091 if (&newTypeSymbol == &node.GetTypeSymbol()) { 1092 return nullptr; 1093 } 1094 } 1095 return derived; 1096 } 1097 } 1098 } // intrinsic & unlimited polymorphic not traversable 1099 } 1100 return nullptr; 1101 } 1102 1103 template <ComponentKind componentKind> 1104 static bool StopAtComponentPre(const Symbol &component) { 1105 if constexpr (componentKind == ComponentKind::Ordered) { 1106 // Parent components need to be iterated upon after their 1107 // sub-components in structure constructor analysis. 1108 return !component.test(Symbol::Flag::ParentComp); 1109 } else if constexpr (componentKind == ComponentKind::Direct) { 1110 return true; 1111 } else if constexpr (componentKind == ComponentKind::Ultimate) { 1112 return component.has<ProcEntityDetails>() || 1113 IsAllocatableOrPointer(component) || 1114 (component.get<ObjectEntityDetails>().type() && 1115 component.get<ObjectEntityDetails>().type()->AsIntrinsic()); 1116 } else if constexpr (componentKind == ComponentKind::Potential) { 1117 return !IsPointer(component); 1118 } 1119 } 1120 1121 template <ComponentKind componentKind> 1122 static bool StopAtComponentPost(const Symbol &component) { 1123 return componentKind == ComponentKind::Ordered && 1124 component.test(Symbol::Flag::ParentComp); 1125 } 1126 1127 template <ComponentKind componentKind> 1128 void ComponentIterator<componentKind>::const_iterator::Increment() { 1129 while (!componentPath_.empty()) { 1130 ComponentPathNode &deepest{componentPath_.back()}; 1131 if (deepest.component()) { 1132 if (!deepest.descended()) { 1133 deepest.set_descended(true); 1134 if (const DerivedTypeSpec * 1135 derived{PlanComponentTraversal(*deepest.component())}) { 1136 componentPath_.emplace_back(*derived); 1137 continue; 1138 } 1139 } else if (!deepest.visited()) { 1140 deepest.set_visited(true); 1141 return; // this is the next component to visit, after descending 1142 } 1143 } 1144 auto &nameIterator{deepest.nameIterator()}; 1145 if (nameIterator == deepest.nameEnd()) { 1146 componentPath_.pop_back(); 1147 } else if constexpr (componentKind == ComponentKind::Scope) { 1148 deepest.set_component(*nameIterator++->second); 1149 deepest.set_descended(false); 1150 deepest.set_visited(true); 1151 return; // this is the next component to visit, before descending 1152 } else { 1153 const Scope &scope{deepest.GetScope()}; 1154 auto scopeIter{scope.find(*nameIterator++)}; 1155 if (scopeIter != scope.cend()) { 1156 const Symbol &component{*scopeIter->second}; 1157 deepest.set_component(component); 1158 deepest.set_descended(false); 1159 if (StopAtComponentPre<componentKind>(component)) { 1160 deepest.set_visited(true); 1161 return; // this is the next component to visit, before descending 1162 } else { 1163 deepest.set_visited(!StopAtComponentPost<componentKind>(component)); 1164 } 1165 } 1166 } 1167 } 1168 } 1169 1170 template <ComponentKind componentKind> 1171 std::string 1172 ComponentIterator<componentKind>::const_iterator::BuildResultDesignatorName() 1173 const { 1174 std::string designator{""}; 1175 for (const auto &node : componentPath_) { 1176 designator += "%" + DEREF(node.component()).name().ToString(); 1177 } 1178 return designator; 1179 } 1180 1181 template class ComponentIterator<ComponentKind::Ordered>; 1182 template class ComponentIterator<ComponentKind::Direct>; 1183 template class ComponentIterator<ComponentKind::Ultimate>; 1184 template class ComponentIterator<ComponentKind::Potential>; 1185 template class ComponentIterator<ComponentKind::Scope>; 1186 1187 UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent( 1188 const DerivedTypeSpec &derived) { 1189 UltimateComponentIterator ultimates{derived}; 1190 return std::find_if(ultimates.begin(), ultimates.end(), IsCoarray); 1191 } 1192 1193 UltimateComponentIterator::const_iterator FindPointerUltimateComponent( 1194 const DerivedTypeSpec &derived) { 1195 UltimateComponentIterator ultimates{derived}; 1196 return std::find_if(ultimates.begin(), ultimates.end(), IsPointer); 1197 } 1198 1199 PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent( 1200 const DerivedTypeSpec &derived) { 1201 PotentialComponentIterator potentials{derived}; 1202 return std::find_if( 1203 potentials.begin(), potentials.end(), [](const Symbol &component) { 1204 if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) { 1205 const DeclTypeSpec *type{details->type()}; 1206 return type && IsEventTypeOrLockType(type->AsDerived()); 1207 } 1208 return false; 1209 }); 1210 } 1211 1212 UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent( 1213 const DerivedTypeSpec &derived) { 1214 UltimateComponentIterator ultimates{derived}; 1215 return std::find_if(ultimates.begin(), ultimates.end(), IsAllocatable); 1216 } 1217 1218 UltimateComponentIterator::const_iterator 1219 FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &derived) { 1220 UltimateComponentIterator ultimates{derived}; 1221 return std::find_if( 1222 ultimates.begin(), ultimates.end(), IsPolymorphicAllocatable); 1223 } 1224 1225 UltimateComponentIterator::const_iterator 1226 FindPolymorphicAllocatableNonCoarrayUltimateComponent( 1227 const DerivedTypeSpec &derived) { 1228 UltimateComponentIterator ultimates{derived}; 1229 return std::find_if(ultimates.begin(), ultimates.end(), [](const Symbol &x) { 1230 return IsPolymorphicAllocatable(x) && !IsCoarray(x); 1231 }); 1232 } 1233 1234 const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived, 1235 const std::function<bool(const Symbol &)> &predicate) { 1236 UltimateComponentIterator ultimates{derived}; 1237 if (auto it{std::find_if(ultimates.begin(), ultimates.end(), 1238 [&predicate](const Symbol &component) -> bool { 1239 return predicate(component); 1240 })}) { 1241 return &*it; 1242 } 1243 return nullptr; 1244 } 1245 1246 const Symbol *FindUltimateComponent(const Symbol &symbol, 1247 const std::function<bool(const Symbol &)> &predicate) { 1248 if (predicate(symbol)) { 1249 return &symbol; 1250 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { 1251 if (const auto *type{object->type()}) { 1252 if (const auto *derived{type->AsDerived()}) { 1253 return FindUltimateComponent(*derived, predicate); 1254 } 1255 } 1256 } 1257 return nullptr; 1258 } 1259 1260 const Symbol *FindImmediateComponent(const DerivedTypeSpec &type, 1261 const std::function<bool(const Symbol &)> &predicate) { 1262 if (const Scope * scope{type.scope()}) { 1263 const Symbol *parent{nullptr}; 1264 for (const auto &pair : *scope) { 1265 const Symbol *symbol{&*pair.second}; 1266 if (predicate(*symbol)) { 1267 return symbol; 1268 } 1269 if (symbol->test(Symbol::Flag::ParentComp)) { 1270 parent = symbol; 1271 } 1272 } 1273 if (parent) { 1274 if (const auto *object{parent->detailsIf<ObjectEntityDetails>()}) { 1275 if (const auto *type{object->type()}) { 1276 if (const auto *derived{type->AsDerived()}) { 1277 return FindImmediateComponent(*derived, predicate); 1278 } 1279 } 1280 } 1281 } 1282 } 1283 return nullptr; 1284 } 1285 1286 bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) { 1287 if (IsFunctionResult(symbol)) { 1288 if (const Symbol * function{symbol.owner().symbol()}) { 1289 return symbol.name() == function->name(); 1290 } 1291 } 1292 return false; 1293 } 1294 1295 void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) { 1296 checkLabelUse(gotoStmt.v); 1297 } 1298 void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) { 1299 for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) { 1300 checkLabelUse(i); 1301 } 1302 } 1303 1304 void LabelEnforce::Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) { 1305 checkLabelUse(std::get<1>(arithmeticIfStmt.t)); 1306 checkLabelUse(std::get<2>(arithmeticIfStmt.t)); 1307 checkLabelUse(std::get<3>(arithmeticIfStmt.t)); 1308 } 1309 1310 void LabelEnforce::Post(const parser::AssignStmt &assignStmt) { 1311 checkLabelUse(std::get<parser::Label>(assignStmt.t)); 1312 } 1313 1314 void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) { 1315 for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) { 1316 checkLabelUse(i); 1317 } 1318 } 1319 1320 void LabelEnforce::Post(const parser::AltReturnSpec &altReturnSpec) { 1321 checkLabelUse(altReturnSpec.v); 1322 } 1323 1324 void LabelEnforce::Post(const parser::ErrLabel &errLabel) { 1325 checkLabelUse(errLabel.v); 1326 } 1327 void LabelEnforce::Post(const parser::EndLabel &endLabel) { 1328 checkLabelUse(endLabel.v); 1329 } 1330 void LabelEnforce::Post(const parser::EorLabel &eorLabel) { 1331 checkLabelUse(eorLabel.v); 1332 } 1333 1334 void LabelEnforce::checkLabelUse(const parser::Label &labelUsed) { 1335 if (labels_.find(labelUsed) == labels_.end()) { 1336 SayWithConstruct(context_, currentStatementSourcePosition_, 1337 parser::MessageFormattedText{ 1338 "Control flow escapes from %s"_err_en_US, construct_}, 1339 constructSourcePosition_); 1340 } 1341 } 1342 1343 parser::MessageFormattedText LabelEnforce::GetEnclosingConstructMsg() { 1344 return {"Enclosing %s statement"_en_US, construct_}; 1345 } 1346 1347 void LabelEnforce::SayWithConstruct(SemanticsContext &context, 1348 parser::CharBlock stmtLocation, parser::MessageFormattedText &&message, 1349 parser::CharBlock constructLocation) { 1350 context.Say(stmtLocation, message) 1351 .Attach(constructLocation, GetEnclosingConstructMsg()); 1352 } 1353 1354 bool HasAlternateReturns(const Symbol &subprogram) { 1355 for (const auto *dummyArg : subprogram.get<SubprogramDetails>().dummyArgs()) { 1356 if (!dummyArg) { 1357 return true; 1358 } 1359 } 1360 return false; 1361 } 1362 1363 bool InCommonBlock(const Symbol &symbol) { 1364 const auto *details{symbol.detailsIf<ObjectEntityDetails>()}; 1365 return details && details->commonBlock(); 1366 } 1367 1368 const std::optional<parser::Name> &MaybeGetNodeName( 1369 const ConstructNode &construct) { 1370 return std::visit( 1371 common::visitors{ 1372 [&](const parser::BlockConstruct *blockConstruct) 1373 -> const std::optional<parser::Name> & { 1374 return std::get<0>(blockConstruct->t).statement.v; 1375 }, 1376 [&](const auto *a) -> const std::optional<parser::Name> & { 1377 return std::get<0>(std::get<0>(a->t).statement.t); 1378 }, 1379 }, 1380 construct); 1381 } 1382 1383 } // namespace Fortran::semantics 1384