1 //===-- lib/Semantics/resolve-names.cpp -----------------------------------===// 2 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 3 // See https://llvm.org/LICENSE.txt for license information. 4 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 5 // 6 //===----------------------------------------------------------------------===// 7 8 #include "resolve-names.h" 9 #include "assignment.h" 10 #include "mod-file.h" 11 #include "pointer-assignment.h" 12 #include "program-tree.h" 13 #include "resolve-directives.h" 14 #include "resolve-names-utils.h" 15 #include "rewrite-parse-tree.h" 16 #include "flang/Common/Fortran.h" 17 #include "flang/Common/default-kinds.h" 18 #include "flang/Common/indirection.h" 19 #include "flang/Common/restorer.h" 20 #include "flang/Evaluate/characteristics.h" 21 #include "flang/Evaluate/check-expression.h" 22 #include "flang/Evaluate/common.h" 23 #include "flang/Evaluate/fold-designator.h" 24 #include "flang/Evaluate/fold.h" 25 #include "flang/Evaluate/intrinsics.h" 26 #include "flang/Evaluate/tools.h" 27 #include "flang/Evaluate/type.h" 28 #include "flang/Parser/parse-tree-visitor.h" 29 #include "flang/Parser/parse-tree.h" 30 #include "flang/Parser/tools.h" 31 #include "flang/Semantics/attr.h" 32 #include "flang/Semantics/expression.h" 33 #include "flang/Semantics/scope.h" 34 #include "flang/Semantics/semantics.h" 35 #include "flang/Semantics/symbol.h" 36 #include "flang/Semantics/tools.h" 37 #include "flang/Semantics/type.h" 38 #include "llvm/Support/raw_ostream.h" 39 #include <list> 40 #include <map> 41 #include <set> 42 #include <stack> 43 44 namespace Fortran::semantics { 45 46 using namespace parser::literals; 47 48 template <typename T> using Indirection = common::Indirection<T>; 49 using Message = parser::Message; 50 using Messages = parser::Messages; 51 using MessageFixedText = parser::MessageFixedText; 52 using MessageFormattedText = parser::MessageFormattedText; 53 54 class ResolveNamesVisitor; 55 56 // ImplicitRules maps initial character of identifier to the DeclTypeSpec 57 // representing the implicit type; std::nullopt if none. 58 // It also records the presence of IMPLICIT NONE statements. 59 // When inheritFromParent is set, defaults come from the parent rules. 60 class ImplicitRules { 61 public: 62 ImplicitRules(SemanticsContext &context, ImplicitRules *parent) 63 : parent_{parent}, context_{context} { 64 inheritFromParent_ = parent != nullptr; 65 } 66 bool isImplicitNoneType() const; 67 bool isImplicitNoneExternal() const; 68 void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; } 69 void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; } 70 void set_inheritFromParent(bool x) { inheritFromParent_ = x; } 71 // Get the implicit type for this name. May be null. 72 const DeclTypeSpec *GetType(SourceName) const; 73 // Record the implicit type for the range of characters [fromLetter, 74 // toLetter]. 75 void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter, 76 parser::Location toLetter); 77 78 private: 79 static char Incr(char ch); 80 81 ImplicitRules *parent_; 82 SemanticsContext &context_; 83 bool inheritFromParent_{false}; // look in parent if not specified here 84 bool isImplicitNoneType_{ 85 context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)}; 86 bool isImplicitNoneExternal_{false}; 87 // map_ contains the mapping between letters and types that were defined 88 // by the IMPLICIT statements of the related scope. It does not contain 89 // the default Fortran mappings nor the mapping defined in parents. 90 std::map<char, common::Reference<const DeclTypeSpec>> map_; 91 92 friend llvm::raw_ostream &operator<<( 93 llvm::raw_ostream &, const ImplicitRules &); 94 friend void ShowImplicitRule( 95 llvm::raw_ostream &, const ImplicitRules &, char); 96 }; 97 98 // scope -> implicit rules for that scope 99 using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>; 100 101 // Track statement source locations and save messages. 102 class MessageHandler { 103 public: 104 MessageHandler() { DIE("MessageHandler: default-constructed"); } 105 explicit MessageHandler(SemanticsContext &c) : context_{&c} {} 106 Messages &messages() { return context_->messages(); }; 107 const std::optional<SourceName> &currStmtSource() { 108 return context_->location(); 109 } 110 void set_currStmtSource(const std::optional<SourceName> &source) { 111 context_->set_location(source); 112 } 113 114 // Emit a message associated with the current statement source. 115 Message &Say(MessageFixedText &&); 116 Message &Say(MessageFormattedText &&); 117 // Emit a message about a SourceName 118 Message &Say(const SourceName &, MessageFixedText &&); 119 // Emit a formatted message associated with a source location. 120 template <typename... A> 121 Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) { 122 return context_->Say(source, std::move(msg), std::forward<A>(args)...); 123 } 124 125 private: 126 SemanticsContext *context_; 127 }; 128 129 // Inheritance graph for the parse tree visitation classes that follow: 130 // BaseVisitor 131 // + AttrsVisitor 132 // | + DeclTypeSpecVisitor 133 // | + ImplicitRulesVisitor 134 // | + ScopeHandler -----------+--+ 135 // | + ModuleVisitor ========|==+ 136 // | + InterfaceVisitor | | 137 // | +-+ SubprogramVisitor ==|==+ 138 // + ArraySpecVisitor | | 139 // + DeclarationVisitor <--------+ | 140 // + ConstructVisitor | 141 // + ResolveNamesVisitor <------+ 142 143 class BaseVisitor { 144 public: 145 BaseVisitor() { DIE("BaseVisitor: default-constructed"); } 146 BaseVisitor( 147 SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules) 148 : implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} { 149 } 150 template <typename T> void Walk(const T &); 151 152 MessageHandler &messageHandler() { return messageHandler_; } 153 const std::optional<SourceName> &currStmtSource() { 154 return context_->location(); 155 } 156 SemanticsContext &context() const { return *context_; } 157 evaluate::FoldingContext &GetFoldingContext() const { 158 return context_->foldingContext(); 159 } 160 bool IsIntrinsic( 161 const SourceName &name, std::optional<Symbol::Flag> flag) const { 162 if (!flag) { 163 return context_->intrinsics().IsIntrinsic(name.ToString()); 164 } else if (flag == Symbol::Flag::Function) { 165 return context_->intrinsics().IsIntrinsicFunction(name.ToString()); 166 } else if (flag == Symbol::Flag::Subroutine) { 167 return context_->intrinsics().IsIntrinsicSubroutine(name.ToString()); 168 } else { 169 DIE("expected Subroutine or Function flag"); 170 } 171 } 172 173 // Make a placeholder symbol for a Name that otherwise wouldn't have one. 174 // It is not in any scope and always has MiscDetails. 175 void MakePlaceholder(const parser::Name &, MiscDetails::Kind); 176 177 template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) { 178 return evaluate::Fold(GetFoldingContext(), std::move(expr)); 179 } 180 181 template <typename T> MaybeExpr EvaluateExpr(const T &expr) { 182 return FoldExpr(AnalyzeExpr(*context_, expr)); 183 } 184 185 template <typename T> 186 MaybeExpr EvaluateConvertedExpr( 187 const Symbol &symbol, const T &expr, parser::CharBlock source) { 188 if (context().HasError(symbol)) { 189 return std::nullopt; 190 } 191 if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) { 192 if (auto converted{ 193 evaluate::ConvertToType(symbol, std::move(*maybeExpr))}) { 194 return FoldExpr(std::move(*converted)); 195 } 196 if (auto exprType{maybeExpr->GetType()}) { 197 Say(source, 198 "Initialization expression could not be converted to declared type of '%s' from %s"_err_en_US, 199 symbol.name(), exprType->AsFortran()); 200 } else { 201 Say(source, 202 "Initialization expression could not be converted to declared type of '%s'"_err_en_US, 203 symbol.name()); 204 } 205 } 206 return std::nullopt; 207 } 208 209 template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) { 210 return semantics::EvaluateIntExpr(*context_, expr); 211 } 212 213 template <typename T> 214 MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) { 215 if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) { 216 return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>( 217 std::move(*maybeIntExpr))); 218 } else { 219 return std::nullopt; 220 } 221 } 222 223 template <typename... A> Message &Say(A &&...args) { 224 return messageHandler_.Say(std::forward<A>(args)...); 225 } 226 template <typename... A> 227 Message &Say( 228 const parser::Name &name, MessageFixedText &&text, const A &...args) { 229 return messageHandler_.Say(name.source, std::move(text), args...); 230 } 231 232 protected: 233 ImplicitRulesMap *implicitRulesMap_{nullptr}; 234 235 private: 236 ResolveNamesVisitor *this_; 237 SemanticsContext *context_; 238 MessageHandler messageHandler_; 239 }; 240 241 // Provide Post methods to collect attributes into a member variable. 242 class AttrsVisitor : public virtual BaseVisitor { 243 public: 244 bool BeginAttrs(); // always returns true 245 Attrs GetAttrs(); 246 Attrs EndAttrs(); 247 bool SetPassNameOn(Symbol &); 248 bool SetBindNameOn(Symbol &); 249 void Post(const parser::LanguageBindingSpec &); 250 bool Pre(const parser::IntentSpec &); 251 bool Pre(const parser::Pass &); 252 253 bool CheckAndSet(Attr); 254 255 // Simple case: encountering CLASSNAME causes ATTRNAME to be set. 256 #define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \ 257 bool Pre(const parser::CLASSNAME &) { \ 258 CheckAndSet(Attr::ATTRNAME); \ 259 return false; \ 260 } 261 HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL) 262 HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE) 263 HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE) 264 HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE) 265 HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE) 266 HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE) 267 HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C) 268 HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED) 269 HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE) 270 HANDLE_ATTR_CLASS(Abstract, ABSTRACT) 271 HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE) 272 HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS) 273 HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS) 274 HANDLE_ATTR_CLASS(External, EXTERNAL) 275 HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC) 276 HANDLE_ATTR_CLASS(NoPass, NOPASS) 277 HANDLE_ATTR_CLASS(Optional, OPTIONAL) 278 HANDLE_ATTR_CLASS(Parameter, PARAMETER) 279 HANDLE_ATTR_CLASS(Pointer, POINTER) 280 HANDLE_ATTR_CLASS(Protected, PROTECTED) 281 HANDLE_ATTR_CLASS(Save, SAVE) 282 HANDLE_ATTR_CLASS(Target, TARGET) 283 HANDLE_ATTR_CLASS(Value, VALUE) 284 HANDLE_ATTR_CLASS(Volatile, VOLATILE) 285 #undef HANDLE_ATTR_CLASS 286 287 protected: 288 std::optional<Attrs> attrs_; 289 290 Attr AccessSpecToAttr(const parser::AccessSpec &x) { 291 switch (x.v) { 292 case parser::AccessSpec::Kind::Public: 293 return Attr::PUBLIC; 294 case parser::AccessSpec::Kind::Private: 295 return Attr::PRIVATE; 296 } 297 llvm_unreachable("Switch covers all cases"); // suppress g++ warning 298 } 299 Attr IntentSpecToAttr(const parser::IntentSpec &x) { 300 switch (x.v) { 301 case parser::IntentSpec::Intent::In: 302 return Attr::INTENT_IN; 303 case parser::IntentSpec::Intent::Out: 304 return Attr::INTENT_OUT; 305 case parser::IntentSpec::Intent::InOut: 306 return Attr::INTENT_INOUT; 307 } 308 llvm_unreachable("Switch covers all cases"); // suppress g++ warning 309 } 310 311 private: 312 bool IsDuplicateAttr(Attr); 313 bool HaveAttrConflict(Attr, Attr, Attr); 314 bool IsConflictingAttr(Attr); 315 316 MaybeExpr bindName_; // from BIND(C, NAME="...") 317 std::optional<SourceName> passName_; // from PASS(...) 318 }; 319 320 // Find and create types from declaration-type-spec nodes. 321 class DeclTypeSpecVisitor : public AttrsVisitor { 322 public: 323 using AttrsVisitor::Post; 324 using AttrsVisitor::Pre; 325 void Post(const parser::IntrinsicTypeSpec::DoublePrecision &); 326 void Post(const parser::IntrinsicTypeSpec::DoubleComplex &); 327 void Post(const parser::DeclarationTypeSpec::ClassStar &); 328 void Post(const parser::DeclarationTypeSpec::TypeStar &); 329 bool Pre(const parser::TypeGuardStmt &); 330 void Post(const parser::TypeGuardStmt &); 331 void Post(const parser::TypeSpec &); 332 333 protected: 334 struct State { 335 bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true 336 const DeclTypeSpec *declTypeSpec{nullptr}; 337 struct { 338 DerivedTypeSpec *type{nullptr}; 339 DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived}; 340 } derived; 341 bool allowForwardReferenceToDerivedType{false}; 342 }; 343 344 bool allowForwardReferenceToDerivedType() const { 345 return state_.allowForwardReferenceToDerivedType; 346 } 347 void set_allowForwardReferenceToDerivedType(bool yes) { 348 state_.allowForwardReferenceToDerivedType = yes; 349 } 350 351 // Walk the parse tree of a type spec and return the DeclTypeSpec for it. 352 template <typename T> 353 const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) { 354 auto restorer{common::ScopedSet(state_, State{})}; 355 set_allowForwardReferenceToDerivedType(allowForward); 356 BeginDeclTypeSpec(); 357 Walk(x); 358 const auto *type{GetDeclTypeSpec()}; 359 EndDeclTypeSpec(); 360 return type; 361 } 362 363 const DeclTypeSpec *GetDeclTypeSpec(); 364 void BeginDeclTypeSpec(); 365 void EndDeclTypeSpec(); 366 void SetDeclTypeSpec(const DeclTypeSpec &); 367 void SetDeclTypeSpecCategory(DeclTypeSpec::Category); 368 DeclTypeSpec::Category GetDeclTypeSpecCategory() const { 369 return state_.derived.category; 370 } 371 KindExpr GetKindParamExpr( 372 TypeCategory, const std::optional<parser::KindSelector> &); 373 void CheckForAbstractType(const Symbol &typeSymbol); 374 375 private: 376 State state_; 377 378 void MakeNumericType(TypeCategory, int kind); 379 }; 380 381 // Visit ImplicitStmt and related parse tree nodes and updates implicit rules. 382 class ImplicitRulesVisitor : public DeclTypeSpecVisitor { 383 public: 384 using DeclTypeSpecVisitor::Post; 385 using DeclTypeSpecVisitor::Pre; 386 using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec; 387 388 void Post(const parser::ParameterStmt &); 389 bool Pre(const parser::ImplicitStmt &); 390 bool Pre(const parser::LetterSpec &); 391 bool Pre(const parser::ImplicitSpec &); 392 void Post(const parser::ImplicitSpec &); 393 394 const DeclTypeSpec *GetType(SourceName name) { 395 return implicitRules_->GetType(name); 396 } 397 bool isImplicitNoneType() const { 398 return implicitRules_->isImplicitNoneType(); 399 } 400 bool isImplicitNoneType(const Scope &scope) const { 401 return implicitRulesMap_->at(&scope).isImplicitNoneType(); 402 } 403 bool isImplicitNoneExternal() const { 404 return implicitRules_->isImplicitNoneExternal(); 405 } 406 void set_inheritFromParent(bool x) { 407 implicitRules_->set_inheritFromParent(x); 408 } 409 410 protected: 411 void BeginScope(const Scope &); 412 void SetScope(const Scope &); 413 414 private: 415 // implicit rules in effect for current scope 416 ImplicitRules *implicitRules_{nullptr}; 417 std::optional<SourceName> prevImplicit_; 418 std::optional<SourceName> prevImplicitNone_; 419 std::optional<SourceName> prevImplicitNoneType_; 420 std::optional<SourceName> prevParameterStmt_; 421 422 bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs); 423 }; 424 425 // Track array specifications. They can occur in AttrSpec, EntityDecl, 426 // ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt. 427 // 1. INTEGER, DIMENSION(10) :: x 428 // 2. INTEGER :: x(10) 429 // 3. ALLOCATABLE :: x(:) 430 // 4. DIMENSION :: x(10) 431 // 5. COMMON x(10) 432 // 6. BasedPointerStmt 433 class ArraySpecVisitor : public virtual BaseVisitor { 434 public: 435 void Post(const parser::ArraySpec &); 436 void Post(const parser::ComponentArraySpec &); 437 void Post(const parser::CoarraySpec &); 438 void Post(const parser::AttrSpec &) { PostAttrSpec(); } 439 void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); } 440 441 protected: 442 const ArraySpec &arraySpec(); 443 const ArraySpec &coarraySpec(); 444 void BeginArraySpec(); 445 void EndArraySpec(); 446 void ClearArraySpec() { arraySpec_.clear(); } 447 void ClearCoarraySpec() { coarraySpec_.clear(); } 448 449 private: 450 // arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec 451 ArraySpec arraySpec_; 452 ArraySpec coarraySpec_; 453 // When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved 454 // into attrArraySpec_ 455 ArraySpec attrArraySpec_; 456 ArraySpec attrCoarraySpec_; 457 458 void PostAttrSpec(); 459 }; 460 461 // Manage a stack of Scopes 462 class ScopeHandler : public ImplicitRulesVisitor { 463 public: 464 using ImplicitRulesVisitor::Post; 465 using ImplicitRulesVisitor::Pre; 466 467 Scope &currScope() { return DEREF(currScope_); } 468 // The enclosing host procedure if current scope is in an internal procedure 469 Scope *GetHostProcedure(); 470 // The enclosing scope, skipping blocks and derived types. 471 // TODO: Will return the scope of a FORALL or implied DO loop; is this ok? 472 // If not, should call FindProgramUnitContaining() instead. 473 Scope &InclusiveScope(); 474 // The enclosing scope, skipping derived types. 475 Scope &NonDerivedTypeScope(); 476 477 // Create a new scope and push it on the scope stack. 478 void PushScope(Scope::Kind kind, Symbol *symbol); 479 void PushScope(Scope &scope); 480 void PopScope(); 481 void SetScope(Scope &); 482 483 template <typename T> bool Pre(const parser::Statement<T> &x) { 484 messageHandler().set_currStmtSource(x.source); 485 currScope_->AddSourceRange(x.source); 486 return true; 487 } 488 template <typename T> void Post(const parser::Statement<T> &) { 489 messageHandler().set_currStmtSource(std::nullopt); 490 } 491 492 // Special messages: already declared; referencing symbol's declaration; 493 // about a type; two names & locations 494 void SayAlreadyDeclared(const parser::Name &, Symbol &); 495 void SayAlreadyDeclared(const SourceName &, Symbol &); 496 void SayAlreadyDeclared(const SourceName &, const SourceName &); 497 void SayWithReason( 498 const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&); 499 void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&); 500 void SayLocalMustBeVariable(const parser::Name &, Symbol &); 501 void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &); 502 void Say2(const SourceName &, MessageFixedText &&, const SourceName &, 503 MessageFixedText &&); 504 void Say2( 505 const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&); 506 void Say2( 507 const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&); 508 509 // Search for symbol by name in current, parent derived type, and 510 // containing scopes 511 Symbol *FindSymbol(const parser::Name &); 512 Symbol *FindSymbol(const Scope &, const parser::Name &); 513 // Search for name only in scope, not in enclosing scopes. 514 Symbol *FindInScope(const Scope &, const parser::Name &); 515 Symbol *FindInScope(const Scope &, const SourceName &); 516 // Search for name in a derived type scope and its parents. 517 Symbol *FindInTypeOrParents(const Scope &, const parser::Name &); 518 Symbol *FindInTypeOrParents(const parser::Name &); 519 void EraseSymbol(const parser::Name &); 520 void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); } 521 // Make a new symbol with the name and attrs of an existing one 522 Symbol &CopySymbol(const SourceName &, const Symbol &); 523 524 // Make symbols in the current or named scope 525 Symbol &MakeSymbol(Scope &, const SourceName &, Attrs); 526 Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{}); 527 Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{}); 528 Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &); 529 530 template <typename D> 531 common::IfNoLvalue<Symbol &, D> MakeSymbol( 532 const parser::Name &name, D &&details) { 533 return MakeSymbol(name, Attrs{}, std::move(details)); 534 } 535 536 template <typename D> 537 common::IfNoLvalue<Symbol &, D> MakeSymbol( 538 const parser::Name &name, const Attrs &attrs, D &&details) { 539 return Resolve(name, MakeSymbol(name.source, attrs, std::move(details))); 540 } 541 542 template <typename D> 543 common::IfNoLvalue<Symbol &, D> MakeSymbol( 544 const SourceName &name, const Attrs &attrs, D &&details) { 545 // Note: don't use FindSymbol here. If this is a derived type scope, 546 // we want to detect whether the name is already declared as a component. 547 auto *symbol{FindInScope(currScope(), name)}; 548 if (!symbol) { 549 symbol = &MakeSymbol(name, attrs); 550 symbol->set_details(std::move(details)); 551 return *symbol; 552 } 553 if constexpr (std::is_same_v<DerivedTypeDetails, D>) { 554 if (auto *d{symbol->detailsIf<GenericDetails>()}) { 555 if (!d->specific()) { 556 // derived type with same name as a generic 557 auto *derivedType{d->derivedType()}; 558 if (!derivedType) { 559 derivedType = 560 &currScope().MakeSymbol(name, attrs, std::move(details)); 561 d->set_derivedType(*derivedType); 562 } else { 563 SayAlreadyDeclared(name, *derivedType); 564 } 565 return *derivedType; 566 } 567 } 568 } 569 if (symbol->CanReplaceDetails(details)) { 570 // update the existing symbol 571 symbol->attrs() |= attrs; 572 symbol->set_details(std::move(details)); 573 return *symbol; 574 } else if constexpr (std::is_same_v<UnknownDetails, D>) { 575 symbol->attrs() |= attrs; 576 return *symbol; 577 } else { 578 if (!CheckPossibleBadForwardRef(*symbol)) { 579 SayAlreadyDeclared(name, *symbol); 580 } 581 // replace the old symbol with a new one with correct details 582 EraseSymbol(*symbol); 583 auto &result{MakeSymbol(name, attrs, std::move(details))}; 584 context().SetError(result); 585 return result; 586 } 587 } 588 589 void MakeExternal(Symbol &); 590 591 protected: 592 // Apply the implicit type rules to this symbol. 593 void ApplyImplicitRules(Symbol &); 594 const DeclTypeSpec *GetImplicitType(Symbol &, const Scope &); 595 bool ConvertToObjectEntity(Symbol &); 596 bool ConvertToProcEntity(Symbol &); 597 598 const DeclTypeSpec &MakeNumericType( 599 TypeCategory, const std::optional<parser::KindSelector> &); 600 const DeclTypeSpec &MakeLogicalType( 601 const std::optional<parser::KindSelector> &); 602 void NotePossibleBadForwardRef(const parser::Name &); 603 std::optional<SourceName> HadForwardRef(const Symbol &) const; 604 bool CheckPossibleBadForwardRef(const Symbol &); 605 606 bool inExecutionPart_{false}; 607 bool inSpecificationPart_{false}; 608 std::set<SourceName> specPartForwardRefs_; 609 610 private: 611 Scope *currScope_{nullptr}; 612 }; 613 614 class ModuleVisitor : public virtual ScopeHandler { 615 public: 616 bool Pre(const parser::AccessStmt &); 617 bool Pre(const parser::Only &); 618 bool Pre(const parser::Rename::Names &); 619 bool Pre(const parser::Rename::Operators &); 620 bool Pre(const parser::UseStmt &); 621 void Post(const parser::UseStmt &); 622 623 void BeginModule(const parser::Name &, bool isSubmodule); 624 bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &); 625 void ApplyDefaultAccess(); 626 void AddGenericUse(GenericDetails &, const SourceName &, const Symbol &); 627 628 private: 629 // The default access spec for this module. 630 Attr defaultAccess_{Attr::PUBLIC}; 631 // The location of the last AccessStmt without access-ids, if any. 632 std::optional<SourceName> prevAccessStmt_; 633 // The scope of the module during a UseStmt 634 Scope *useModuleScope_{nullptr}; 635 636 Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr); 637 // A rename in a USE statement: local => use 638 struct SymbolRename { 639 Symbol *local{nullptr}; 640 Symbol *use{nullptr}; 641 }; 642 // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol 643 SymbolRename AddUse(const SourceName &localName, const SourceName &useName); 644 SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *); 645 void DoAddUse(const SourceName &, const SourceName &, Symbol &localSymbol, 646 const Symbol &useSymbol); 647 void AddUse(const GenericSpecInfo &); 648 Scope *FindModule(const parser::Name &, Scope *ancestor = nullptr); 649 }; 650 651 class InterfaceVisitor : public virtual ScopeHandler { 652 public: 653 bool Pre(const parser::InterfaceStmt &); 654 void Post(const parser::InterfaceStmt &); 655 void Post(const parser::EndInterfaceStmt &); 656 bool Pre(const parser::GenericSpec &); 657 bool Pre(const parser::ProcedureStmt &); 658 bool Pre(const parser::GenericStmt &); 659 void Post(const parser::GenericStmt &); 660 661 bool inInterfaceBlock() const; 662 bool isGeneric() const; 663 bool isAbstract() const; 664 665 protected: 666 GenericDetails &GetGenericDetails(); 667 // Add to generic the symbol for the subprogram with the same name 668 void CheckGenericProcedures(Symbol &); 669 670 private: 671 // A new GenericInfo is pushed for each interface block and generic stmt 672 struct GenericInfo { 673 GenericInfo(bool isInterface, bool isAbstract = false) 674 : isInterface{isInterface}, isAbstract{isAbstract} {} 675 bool isInterface; // in interface block 676 bool isAbstract; // in abstract interface block 677 Symbol *symbol{nullptr}; // the generic symbol being defined 678 }; 679 std::stack<GenericInfo> genericInfo_; 680 const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); } 681 void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; } 682 683 using ProcedureKind = parser::ProcedureStmt::Kind; 684 // mapping of generic to its specific proc names and kinds 685 std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>> 686 specificProcs_; 687 688 void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind); 689 void ResolveSpecificsInGeneric(Symbol &generic); 690 }; 691 692 class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor { 693 public: 694 bool HandleStmtFunction(const parser::StmtFunctionStmt &); 695 bool Pre(const parser::SubroutineStmt &); 696 void Post(const parser::SubroutineStmt &); 697 bool Pre(const parser::FunctionStmt &); 698 void Post(const parser::FunctionStmt &); 699 bool Pre(const parser::EntryStmt &); 700 void Post(const parser::EntryStmt &); 701 bool Pre(const parser::InterfaceBody::Subroutine &); 702 void Post(const parser::InterfaceBody::Subroutine &); 703 bool Pre(const parser::InterfaceBody::Function &); 704 void Post(const parser::InterfaceBody::Function &); 705 bool Pre(const parser::Suffix &); 706 bool Pre(const parser::PrefixSpec &); 707 void Post(const parser::ImplicitPart &); 708 709 bool BeginSubprogram( 710 const parser::Name &, Symbol::Flag, bool hasModulePrefix = false); 711 bool BeginMpSubprogram(const parser::Name &); 712 void PushBlockDataScope(const parser::Name &); 713 void EndSubprogram(); 714 715 protected: 716 // Set when we see a stmt function that is really an array element assignment 717 bool badStmtFuncFound_{false}; 718 719 private: 720 // Info about the current function: parse tree of the type in the PrefixSpec; 721 // name and symbol of the function result from the Suffix; source location. 722 struct { 723 const parser::DeclarationTypeSpec *parsedType{nullptr}; 724 const parser::Name *resultName{nullptr}; 725 Symbol *resultSymbol{nullptr}; 726 std::optional<SourceName> source; 727 } funcInfo_; 728 729 // Create a subprogram symbol in the current scope and push a new scope. 730 void CheckExtantExternal(const parser::Name &, Symbol::Flag); 731 Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag); 732 Symbol *GetSpecificFromGeneric(const parser::Name &); 733 SubprogramDetails &PostSubprogramStmt(const parser::Name &); 734 }; 735 736 class DeclarationVisitor : public ArraySpecVisitor, 737 public virtual ScopeHandler { 738 public: 739 using ArraySpecVisitor::Post; 740 using ScopeHandler::Post; 741 using ScopeHandler::Pre; 742 743 bool Pre(const parser::Initialization &); 744 void Post(const parser::EntityDecl &); 745 void Post(const parser::ObjectDecl &); 746 void Post(const parser::PointerDecl &); 747 bool Pre(const parser::BindStmt &) { return BeginAttrs(); } 748 void Post(const parser::BindStmt &) { EndAttrs(); } 749 bool Pre(const parser::BindEntity &); 750 bool Pre(const parser::NamedConstantDef &); 751 bool Pre(const parser::NamedConstant &); 752 void Post(const parser::EnumDef &); 753 bool Pre(const parser::Enumerator &); 754 bool Pre(const parser::AccessSpec &); 755 bool Pre(const parser::AsynchronousStmt &); 756 bool Pre(const parser::ContiguousStmt &); 757 bool Pre(const parser::ExternalStmt &); 758 bool Pre(const parser::IntentStmt &); 759 bool Pre(const parser::IntrinsicStmt &); 760 bool Pre(const parser::OptionalStmt &); 761 bool Pre(const parser::ProtectedStmt &); 762 bool Pre(const parser::ValueStmt &); 763 bool Pre(const parser::VolatileStmt &); 764 bool Pre(const parser::AllocatableStmt &) { 765 objectDeclAttr_ = Attr::ALLOCATABLE; 766 return true; 767 } 768 void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; } 769 bool Pre(const parser::TargetStmt &) { 770 objectDeclAttr_ = Attr::TARGET; 771 return true; 772 } 773 void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; } 774 void Post(const parser::DimensionStmt::Declaration &); 775 void Post(const parser::CodimensionDecl &); 776 bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); } 777 void Post(const parser::TypeDeclarationStmt &); 778 void Post(const parser::IntegerTypeSpec &); 779 void Post(const parser::IntrinsicTypeSpec::Real &); 780 void Post(const parser::IntrinsicTypeSpec::Complex &); 781 void Post(const parser::IntrinsicTypeSpec::Logical &); 782 void Post(const parser::IntrinsicTypeSpec::Character &); 783 void Post(const parser::CharSelector::LengthAndKind &); 784 void Post(const parser::CharLength &); 785 void Post(const parser::LengthSelector &); 786 bool Pre(const parser::KindParam &); 787 bool Pre(const parser::DeclarationTypeSpec::Type &); 788 void Post(const parser::DeclarationTypeSpec::Type &); 789 bool Pre(const parser::DeclarationTypeSpec::Class &); 790 void Post(const parser::DeclarationTypeSpec::Class &); 791 bool Pre(const parser::DeclarationTypeSpec::Record &); 792 void Post(const parser::DerivedTypeSpec &); 793 bool Pre(const parser::DerivedTypeDef &); 794 bool Pre(const parser::DerivedTypeStmt &); 795 void Post(const parser::DerivedTypeStmt &); 796 bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); } 797 void Post(const parser::TypeParamDefStmt &); 798 bool Pre(const parser::TypeAttrSpec::Extends &); 799 bool Pre(const parser::PrivateStmt &); 800 bool Pre(const parser::SequenceStmt &); 801 bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); } 802 void Post(const parser::ComponentDefStmt &) { EndDecl(); } 803 void Post(const parser::ComponentDecl &); 804 bool Pre(const parser::ProcedureDeclarationStmt &); 805 void Post(const parser::ProcedureDeclarationStmt &); 806 bool Pre(const parser::DataComponentDefStmt &); // returns false 807 bool Pre(const parser::ProcComponentDefStmt &); 808 void Post(const parser::ProcComponentDefStmt &); 809 bool Pre(const parser::ProcPointerInit &); 810 void Post(const parser::ProcInterface &); 811 void Post(const parser::ProcDecl &); 812 bool Pre(const parser::TypeBoundProcedurePart &); 813 void Post(const parser::TypeBoundProcedurePart &); 814 void Post(const parser::ContainsStmt &); 815 bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); } 816 void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); } 817 void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &); 818 void Post(const parser::TypeBoundProcedureStmt::WithInterface &); 819 void Post(const parser::FinalProcedureStmt &); 820 bool Pre(const parser::TypeBoundGenericStmt &); 821 bool Pre(const parser::AllocateStmt &); 822 void Post(const parser::AllocateStmt &); 823 bool Pre(const parser::StructureConstructor &); 824 bool Pre(const parser::NamelistStmt::Group &); 825 bool Pre(const parser::IoControlSpec &); 826 bool Pre(const parser::CommonStmt::Block &); 827 bool Pre(const parser::CommonBlockObject &); 828 void Post(const parser::CommonBlockObject &); 829 bool Pre(const parser::EquivalenceStmt &); 830 bool Pre(const parser::SaveStmt &); 831 bool Pre(const parser::BasedPointerStmt &); 832 833 void PointerInitialization( 834 const parser::Name &, const parser::InitialDataTarget &); 835 void PointerInitialization( 836 const parser::Name &, const parser::ProcPointerInit &); 837 void NonPointerInitialization( 838 const parser::Name &, const parser::ConstantExpr &, bool inComponentDecl); 839 void CheckExplicitInterface(const parser::Name &); 840 void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); 841 842 const parser::Name *ResolveDesignator(const parser::Designator &); 843 844 protected: 845 bool BeginDecl(); 846 void EndDecl(); 847 Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{}); 848 // Make sure that there's an entity in an enclosing scope called Name 849 Symbol &FindOrDeclareEnclosingEntity(const parser::Name &); 850 // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified 851 // it comes from the entity in the containing scope, or implicit rules. 852 // Return pointer to the new symbol, or nullptr on error. 853 Symbol *DeclareLocalEntity(const parser::Name &); 854 // Declare a statement entity (e.g., an implied DO loop index). 855 // If there isn't a type specified, implicit rules apply. 856 // Return pointer to the new symbol, or nullptr on error. 857 Symbol *DeclareStatementEntity( 858 const parser::Name &, const std::optional<parser::IntegerTypeSpec> &); 859 Symbol &MakeCommonBlockSymbol(const parser::Name &); 860 Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &); 861 bool CheckUseError(const parser::Name &); 862 void CheckAccessibility(const SourceName &, bool, Symbol &); 863 void CheckCommonBlocks(); 864 void CheckSaveStmts(); 865 void CheckEquivalenceSets(); 866 bool CheckNotInBlock(const char *); 867 bool NameIsKnownOrIntrinsic(const parser::Name &); 868 869 // Each of these returns a pointer to a resolved Name (i.e. with symbol) 870 // or nullptr in case of error. 871 const parser::Name *ResolveStructureComponent( 872 const parser::StructureComponent &); 873 const parser::Name *ResolveDataRef(const parser::DataRef &); 874 const parser::Name *ResolveName(const parser::Name &); 875 bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol); 876 Symbol *NoteInterfaceName(const parser::Name &); 877 878 private: 879 // The attribute corresponding to the statement containing an ObjectDecl 880 std::optional<Attr> objectDeclAttr_; 881 // Info about current character type while walking DeclTypeSpec. 882 // Also captures any "*length" specifier on an individual declaration. 883 struct { 884 std::optional<ParamValue> length; 885 std::optional<KindExpr> kind; 886 } charInfo_; 887 // Info about current derived type while walking DerivedTypeDef 888 struct { 889 const parser::Name *extends{nullptr}; // EXTENDS(name) 890 bool privateComps{false}; // components are private by default 891 bool privateBindings{false}; // bindings are private by default 892 bool sawContains{false}; // currently processing bindings 893 bool sequence{false}; // is a sequence type 894 const Symbol *type{nullptr}; // derived type being defined 895 } derivedTypeInfo_; 896 // Collect equivalence sets and process at end of specification part 897 std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets_; 898 // Names of all common block objects in the scope 899 std::set<SourceName> commonBlockObjects_; 900 // Info about about SAVE statements and attributes in current scope 901 struct { 902 std::optional<SourceName> saveAll; // "SAVE" without entity list 903 std::set<SourceName> entities; // names of entities with save attr 904 std::set<SourceName> commons; // names of common blocks with save attr 905 } saveInfo_; 906 // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is 907 // the interface name, if any. 908 const parser::Name *interfaceName_{nullptr}; 909 // Map type-bound generic to binding names of its specific bindings 910 std::multimap<Symbol *, const parser::Name *> genericBindings_; 911 // Info about current ENUM 912 struct EnumeratorState { 913 // Enum value must hold inside a C_INT (7.6.2). 914 std::optional<int> value{0}; 915 } enumerationState_; 916 917 bool HandleAttributeStmt(Attr, const std::list<parser::Name> &); 918 Symbol &HandleAttributeStmt(Attr, const parser::Name &); 919 Symbol &DeclareUnknownEntity(const parser::Name &, Attrs); 920 Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &); 921 void SetType(const parser::Name &, const DeclTypeSpec &); 922 std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &); 923 std::optional<DerivedTypeSpec> ResolveExtendsType( 924 const parser::Name &, const parser::Name *); 925 Symbol *MakeTypeSymbol(const SourceName &, Details &&); 926 Symbol *MakeTypeSymbol(const parser::Name &, Details &&); 927 bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr); 928 ParamValue GetParamValue( 929 const parser::TypeParamValue &, common::TypeParamAttr attr); 930 void CheckCommonBlockDerivedType(const SourceName &, const Symbol &); 931 std::optional<MessageFixedText> CheckSaveAttr(const Symbol &); 932 Attrs HandleSaveName(const SourceName &, Attrs); 933 void AddSaveName(std::set<SourceName> &, const SourceName &); 934 void SetSaveAttr(Symbol &); 935 bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &); 936 bool IsUplevelReference(const Symbol &); 937 const parser::Name *FindComponent(const parser::Name *, const parser::Name &); 938 bool CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName); 939 void CheckInitialProcTarget(const Symbol &, const parser::Name &, SourceName); 940 void Initialization(const parser::Name &, const parser::Initialization &, 941 bool inComponentDecl); 942 bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol); 943 bool CheckForHostAssociatedImplicit(const parser::Name &); 944 945 // Declare an object or procedure entity. 946 // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails 947 template <typename T> 948 Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) { 949 Symbol &symbol{MakeSymbol(name, attrs)}; 950 if (context().HasError(symbol) || symbol.has<T>()) { 951 return symbol; // OK or error already reported 952 } else if (symbol.has<UnknownDetails>()) { 953 symbol.set_details(T{}); 954 return symbol; 955 } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { 956 symbol.set_details(T{std::move(*details)}); 957 return symbol; 958 } else if (std::is_same_v<EntityDetails, T> && 959 (symbol.has<ObjectEntityDetails>() || 960 symbol.has<ProcEntityDetails>())) { 961 return symbol; // OK 962 } else if (auto *details{symbol.detailsIf<UseDetails>()}) { 963 Say(name.source, 964 "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US, 965 name.source, GetUsedModule(*details).name()); 966 } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) { 967 if (details->kind() == SubprogramKind::Module) { 968 Say2(name, 969 "Declaration of '%s' conflicts with its use as module procedure"_err_en_US, 970 symbol, "Module procedure definition"_en_US); 971 } else if (details->kind() == SubprogramKind::Internal) { 972 Say2(name, 973 "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US, 974 symbol, "Internal procedure definition"_en_US); 975 } else { 976 DIE("unexpected kind"); 977 } 978 } else if (std::is_same_v<ObjectEntityDetails, T> && 979 symbol.has<ProcEntityDetails>()) { 980 SayWithDecl( 981 name, symbol, "'%s' is already declared as a procedure"_err_en_US); 982 } else if (std::is_same_v<ProcEntityDetails, T> && 983 symbol.has<ObjectEntityDetails>()) { 984 if (InCommonBlock(symbol)) { 985 SayWithDecl(name, symbol, 986 "'%s' may not be a procedure as it is in a COMMON block"_err_en_US); 987 } else { 988 SayWithDecl( 989 name, symbol, "'%s' is already declared as an object"_err_en_US); 990 } 991 } else if (!CheckPossibleBadForwardRef(symbol)) { 992 SayAlreadyDeclared(name, symbol); 993 } 994 context().SetError(symbol); 995 return symbol; 996 } 997 }; 998 999 // Resolve construct entities and statement entities. 1000 // Check that construct names don't conflict with other names. 1001 class ConstructVisitor : public virtual DeclarationVisitor { 1002 public: 1003 bool Pre(const parser::ConcurrentHeader &); 1004 bool Pre(const parser::LocalitySpec::Local &); 1005 bool Pre(const parser::LocalitySpec::LocalInit &); 1006 bool Pre(const parser::LocalitySpec::Shared &); 1007 bool Pre(const parser::AcSpec &); 1008 bool Pre(const parser::AcImpliedDo &); 1009 bool Pre(const parser::DataImpliedDo &); 1010 bool Pre(const parser::DataIDoObject &); 1011 bool Pre(const parser::DataStmtObject &); 1012 bool Pre(const parser::DataStmtValue &); 1013 bool Pre(const parser::DoConstruct &); 1014 void Post(const parser::DoConstruct &); 1015 bool Pre(const parser::ForallConstruct &); 1016 void Post(const parser::ForallConstruct &); 1017 bool Pre(const parser::ForallStmt &); 1018 void Post(const parser::ForallStmt &); 1019 bool Pre(const parser::BlockStmt &); 1020 bool Pre(const parser::EndBlockStmt &); 1021 void Post(const parser::Selector &); 1022 bool Pre(const parser::AssociateStmt &); 1023 void Post(const parser::EndAssociateStmt &); 1024 void Post(const parser::Association &); 1025 void Post(const parser::SelectTypeStmt &); 1026 void Post(const parser::SelectRankStmt &); 1027 bool Pre(const parser::SelectTypeConstruct &); 1028 void Post(const parser::SelectTypeConstruct &); 1029 bool Pre(const parser::SelectTypeConstruct::TypeCase &); 1030 void Post(const parser::SelectTypeConstruct::TypeCase &); 1031 // Creates Block scopes with neither symbol name nor symbol details. 1032 bool Pre(const parser::SelectRankConstruct::RankCase &); 1033 void Post(const parser::SelectRankConstruct::RankCase &); 1034 void Post(const parser::TypeGuardStmt::Guard &); 1035 void Post(const parser::SelectRankCaseStmt::Rank &); 1036 bool Pre(const parser::ChangeTeamStmt &); 1037 void Post(const parser::EndChangeTeamStmt &); 1038 void Post(const parser::CoarrayAssociation &); 1039 1040 // Definitions of construct names 1041 bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); } 1042 bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); } 1043 bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); } 1044 bool Pre(const parser::LabelDoStmt &) { 1045 return false; // error recovery 1046 } 1047 bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); } 1048 bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); } 1049 bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); } 1050 bool Pre(const parser::SelectRankConstruct &); 1051 void Post(const parser::SelectRankConstruct &); 1052 bool Pre(const parser::SelectRankStmt &x) { 1053 return CheckDef(std::get<0>(x.t)); 1054 } 1055 bool Pre(const parser::SelectTypeStmt &x) { 1056 return CheckDef(std::get<0>(x.t)); 1057 } 1058 1059 // References to construct names 1060 void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); } 1061 void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); } 1062 void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); } 1063 void Post(const parser::EndForallStmt &x) { CheckRef(x.v); } 1064 void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); } 1065 void Post(const parser::EndDoStmt &x) { CheckRef(x.v); } 1066 void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); } 1067 void Post(const parser::ElseStmt &x) { CheckRef(x.v); } 1068 void Post(const parser::EndIfStmt &x) { CheckRef(x.v); } 1069 void Post(const parser::CaseStmt &x) { CheckRef(x.t); } 1070 void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); } 1071 void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); } 1072 void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); } 1073 void Post(const parser::CycleStmt &x) { CheckRef(x.v); } 1074 void Post(const parser::ExitStmt &x) { CheckRef(x.v); } 1075 1076 private: 1077 // R1105 selector -> expr | variable 1078 // expr is set in either case unless there were errors 1079 struct Selector { 1080 Selector() {} 1081 Selector(const SourceName &source, MaybeExpr &&expr) 1082 : source{source}, expr{std::move(expr)} {} 1083 operator bool() const { return expr.has_value(); } 1084 parser::CharBlock source; 1085 MaybeExpr expr; 1086 }; 1087 // association -> [associate-name =>] selector 1088 struct Association { 1089 const parser::Name *name{nullptr}; 1090 Selector selector; 1091 }; 1092 std::vector<Association> associationStack_; 1093 1094 template <typename T> bool CheckDef(const T &t) { 1095 return CheckDef(std::get<std::optional<parser::Name>>(t)); 1096 } 1097 template <typename T> void CheckRef(const T &t) { 1098 CheckRef(std::get<std::optional<parser::Name>>(t)); 1099 } 1100 bool CheckDef(const std::optional<parser::Name> &); 1101 void CheckRef(const std::optional<parser::Name> &); 1102 const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&); 1103 const DeclTypeSpec &ToDeclTypeSpec( 1104 evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length); 1105 Symbol *MakeAssocEntity(); 1106 void SetTypeFromAssociation(Symbol &); 1107 void SetAttrsFromAssociation(Symbol &); 1108 Selector ResolveSelector(const parser::Selector &); 1109 void ResolveIndexName(const parser::ConcurrentControl &control); 1110 Association &GetCurrentAssociation(); 1111 void PushAssociation(); 1112 void PopAssociation(); 1113 }; 1114 1115 // Create scopes for OpenACC constructs 1116 class AccVisitor : public virtual DeclarationVisitor { 1117 public: 1118 void AddAccSourceRange(const parser::CharBlock &); 1119 1120 static bool NeedsScope(const parser::OpenACCBlockConstruct &); 1121 1122 bool Pre(const parser::OpenACCBlockConstruct &); 1123 void Post(const parser::OpenACCBlockConstruct &); 1124 bool Pre(const parser::AccBeginBlockDirective &x) { 1125 AddAccSourceRange(x.source); 1126 return true; 1127 } 1128 void Post(const parser::AccBeginBlockDirective &) { 1129 messageHandler().set_currStmtSource(std::nullopt); 1130 } 1131 bool Pre(const parser::AccEndBlockDirective &x) { 1132 AddAccSourceRange(x.source); 1133 return true; 1134 } 1135 void Post(const parser::AccEndBlockDirective &) { 1136 messageHandler().set_currStmtSource(std::nullopt); 1137 } 1138 bool Pre(const parser::AccBeginLoopDirective &x) { 1139 AddAccSourceRange(x.source); 1140 return true; 1141 } 1142 void Post(const parser::AccBeginLoopDirective &x) { 1143 messageHandler().set_currStmtSource(std::nullopt); 1144 } 1145 }; 1146 1147 bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) { 1148 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 1149 const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 1150 switch (beginDir.v) { 1151 case llvm::acc::Directive::ACCD_data: 1152 case llvm::acc::Directive::ACCD_host_data: 1153 case llvm::acc::Directive::ACCD_kernels: 1154 case llvm::acc::Directive::ACCD_parallel: 1155 case llvm::acc::Directive::ACCD_serial: 1156 return true; 1157 default: 1158 return false; 1159 } 1160 } 1161 1162 void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) { 1163 messageHandler().set_currStmtSource(source); 1164 currScope().AddSourceRange(source); 1165 } 1166 1167 bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) { 1168 if (NeedsScope(x)) { 1169 PushScope(Scope::Kind::Block, nullptr); 1170 } 1171 return true; 1172 } 1173 1174 void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) { 1175 if (NeedsScope(x)) { 1176 PopScope(); 1177 } 1178 } 1179 1180 // Create scopes for OpenMP constructs 1181 class OmpVisitor : public virtual DeclarationVisitor { 1182 public: 1183 void AddOmpSourceRange(const parser::CharBlock &); 1184 1185 static bool NeedsScope(const parser::OpenMPBlockConstruct &); 1186 1187 bool Pre(const parser::OpenMPBlockConstruct &); 1188 void Post(const parser::OpenMPBlockConstruct &); 1189 bool Pre(const parser::OmpBeginBlockDirective &x) { 1190 AddOmpSourceRange(x.source); 1191 return true; 1192 } 1193 void Post(const parser::OmpBeginBlockDirective &) { 1194 messageHandler().set_currStmtSource(std::nullopt); 1195 } 1196 bool Pre(const parser::OmpEndBlockDirective &x) { 1197 AddOmpSourceRange(x.source); 1198 return true; 1199 } 1200 void Post(const parser::OmpEndBlockDirective &) { 1201 messageHandler().set_currStmtSource(std::nullopt); 1202 } 1203 1204 bool Pre(const parser::OpenMPLoopConstruct &) { 1205 PushScope(Scope::Kind::Block, nullptr); 1206 return true; 1207 } 1208 void Post(const parser::OpenMPLoopConstruct &) { PopScope(); } 1209 bool Pre(const parser::OmpBeginLoopDirective &x) { 1210 AddOmpSourceRange(x.source); 1211 return true; 1212 } 1213 void Post(const parser::OmpBeginLoopDirective &) { 1214 messageHandler().set_currStmtSource(std::nullopt); 1215 } 1216 bool Pre(const parser::OmpEndLoopDirective &x) { 1217 AddOmpSourceRange(x.source); 1218 return true; 1219 } 1220 void Post(const parser::OmpEndLoopDirective &) { 1221 messageHandler().set_currStmtSource(std::nullopt); 1222 } 1223 1224 bool Pre(const parser::OpenMPSectionsConstruct &) { 1225 PushScope(Scope::Kind::Block, nullptr); 1226 return true; 1227 } 1228 void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); } 1229 bool Pre(const parser::OmpBeginSectionsDirective &x) { 1230 AddOmpSourceRange(x.source); 1231 return true; 1232 } 1233 void Post(const parser::OmpBeginSectionsDirective &) { 1234 messageHandler().set_currStmtSource(std::nullopt); 1235 } 1236 bool Pre(const parser::OmpEndSectionsDirective &x) { 1237 AddOmpSourceRange(x.source); 1238 return true; 1239 } 1240 void Post(const parser::OmpEndSectionsDirective &) { 1241 messageHandler().set_currStmtSource(std::nullopt); 1242 } 1243 }; 1244 1245 bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) { 1246 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 1247 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1248 switch (beginDir.v) { 1249 case llvm::omp::Directive::OMPD_target_data: 1250 case llvm::omp::Directive::OMPD_master: 1251 case llvm::omp::Directive::OMPD_ordered: 1252 return false; 1253 default: 1254 return true; 1255 } 1256 } 1257 1258 void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) { 1259 messageHandler().set_currStmtSource(source); 1260 currScope().AddSourceRange(source); 1261 } 1262 1263 bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) { 1264 if (NeedsScope(x)) { 1265 PushScope(Scope::Kind::Block, nullptr); 1266 } 1267 return true; 1268 } 1269 1270 void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) { 1271 if (NeedsScope(x)) { 1272 PopScope(); 1273 } 1274 } 1275 1276 // Walk the parse tree and resolve names to symbols. 1277 class ResolveNamesVisitor : public virtual ScopeHandler, 1278 public ModuleVisitor, 1279 public SubprogramVisitor, 1280 public ConstructVisitor, 1281 public OmpVisitor, 1282 public AccVisitor { 1283 public: 1284 using AccVisitor::Post; 1285 using AccVisitor::Pre; 1286 using ArraySpecVisitor::Post; 1287 using ConstructVisitor::Post; 1288 using ConstructVisitor::Pre; 1289 using DeclarationVisitor::Post; 1290 using DeclarationVisitor::Pre; 1291 using ImplicitRulesVisitor::Post; 1292 using ImplicitRulesVisitor::Pre; 1293 using InterfaceVisitor::Post; 1294 using InterfaceVisitor::Pre; 1295 using ModuleVisitor::Post; 1296 using ModuleVisitor::Pre; 1297 using OmpVisitor::Post; 1298 using OmpVisitor::Pre; 1299 using ScopeHandler::Post; 1300 using ScopeHandler::Pre; 1301 using SubprogramVisitor::Post; 1302 using SubprogramVisitor::Pre; 1303 1304 ResolveNamesVisitor(SemanticsContext &context, ImplicitRulesMap &rules) 1305 : BaseVisitor{context, *this, rules} { 1306 PushScope(context.globalScope()); 1307 } 1308 1309 // Default action for a parse tree node is to visit children. 1310 template <typename T> bool Pre(const T &) { return true; } 1311 template <typename T> void Post(const T &) {} 1312 1313 bool Pre(const parser::SpecificationPart &); 1314 void Post(const parser::Program &); 1315 bool Pre(const parser::ImplicitStmt &); 1316 void Post(const parser::PointerObject &); 1317 void Post(const parser::AllocateObject &); 1318 bool Pre(const parser::PointerAssignmentStmt &); 1319 void Post(const parser::Designator &); 1320 template <typename A, typename B> 1321 void Post(const parser::LoopBounds<A, B> &x) { 1322 ResolveName(*parser::Unwrap<parser::Name>(x.name)); 1323 } 1324 void Post(const parser::ProcComponentRef &); 1325 bool Pre(const parser::FunctionReference &); 1326 bool Pre(const parser::CallStmt &); 1327 bool Pre(const parser::ImportStmt &); 1328 void Post(const parser::TypeGuardStmt &); 1329 bool Pre(const parser::StmtFunctionStmt &); 1330 bool Pre(const parser::DefinedOpName &); 1331 bool Pre(const parser::ProgramUnit &); 1332 void Post(const parser::AssignStmt &); 1333 void Post(const parser::AssignedGotoStmt &); 1334 1335 // These nodes should never be reached: they are handled in ProgramUnit 1336 bool Pre(const parser::MainProgram &) { 1337 llvm_unreachable("This node is handled in ProgramUnit"); 1338 } 1339 bool Pre(const parser::FunctionSubprogram &) { 1340 llvm_unreachable("This node is handled in ProgramUnit"); 1341 } 1342 bool Pre(const parser::SubroutineSubprogram &) { 1343 llvm_unreachable("This node is handled in ProgramUnit"); 1344 } 1345 bool Pre(const parser::SeparateModuleSubprogram &) { 1346 llvm_unreachable("This node is handled in ProgramUnit"); 1347 } 1348 bool Pre(const parser::Module &) { 1349 llvm_unreachable("This node is handled in ProgramUnit"); 1350 } 1351 bool Pre(const parser::Submodule &) { 1352 llvm_unreachable("This node is handled in ProgramUnit"); 1353 } 1354 bool Pre(const parser::BlockData &) { 1355 llvm_unreachable("This node is handled in ProgramUnit"); 1356 } 1357 1358 void NoteExecutablePartCall(Symbol::Flag, const parser::Call &); 1359 1360 friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &); 1361 1362 private: 1363 // Kind of procedure we are expecting to see in a ProcedureDesignator 1364 std::optional<Symbol::Flag> expectedProcFlag_; 1365 std::optional<SourceName> prevImportStmt_; 1366 1367 void PreSpecificationConstruct(const parser::SpecificationConstruct &); 1368 void CreateCommonBlockSymbols(const parser::CommonStmt &); 1369 void CreateGeneric(const parser::GenericSpec &); 1370 void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &); 1371 void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &); 1372 void CheckImports(); 1373 void CheckImport(const SourceName &, const SourceName &); 1374 void HandleCall(Symbol::Flag, const parser::Call &); 1375 void HandleProcedureName(Symbol::Flag, const parser::Name &); 1376 bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag); 1377 void ResolveSpecificationParts(ProgramTree &); 1378 void AddSubpNames(ProgramTree &); 1379 bool BeginScopeForNode(const ProgramTree &); 1380 void FinishSpecificationParts(const ProgramTree &); 1381 void FinishDerivedTypeInstantiation(Scope &); 1382 void ResolveExecutionParts(const ProgramTree &); 1383 }; 1384 1385 // ImplicitRules implementation 1386 1387 bool ImplicitRules::isImplicitNoneType() const { 1388 if (isImplicitNoneType_) { 1389 return true; 1390 } else if (map_.empty() && inheritFromParent_) { 1391 return parent_->isImplicitNoneType(); 1392 } else { 1393 return false; // default if not specified 1394 } 1395 } 1396 1397 bool ImplicitRules::isImplicitNoneExternal() const { 1398 if (isImplicitNoneExternal_) { 1399 return true; 1400 } else if (inheritFromParent_) { 1401 return parent_->isImplicitNoneExternal(); 1402 } else { 1403 return false; // default if not specified 1404 } 1405 } 1406 1407 const DeclTypeSpec *ImplicitRules::GetType(SourceName name) const { 1408 char ch{name.begin()[0]}; 1409 if (isImplicitNoneType_) { 1410 return nullptr; 1411 } else if (auto it{map_.find(ch)}; it != map_.end()) { 1412 return &*it->second; 1413 } else if (inheritFromParent_) { 1414 return parent_->GetType(name); 1415 } else if (ch >= 'i' && ch <= 'n') { 1416 return &context_.MakeNumericType(TypeCategory::Integer); 1417 } else if (ch >= 'a' && ch <= 'z') { 1418 return &context_.MakeNumericType(TypeCategory::Real); 1419 } else { 1420 return nullptr; 1421 } 1422 } 1423 1424 void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type, 1425 parser::Location fromLetter, parser::Location toLetter) { 1426 for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) { 1427 auto res{map_.emplace(ch, type)}; 1428 if (!res.second) { 1429 context_.Say(parser::CharBlock{fromLetter}, 1430 "More than one implicit type specified for '%c'"_err_en_US, ch); 1431 } 1432 if (ch == *toLetter) { 1433 break; 1434 } 1435 } 1436 } 1437 1438 // Return the next char after ch in a way that works for ASCII or EBCDIC. 1439 // Return '\0' for the char after 'z'. 1440 char ImplicitRules::Incr(char ch) { 1441 switch (ch) { 1442 case 'i': 1443 return 'j'; 1444 case 'r': 1445 return 's'; 1446 case 'z': 1447 return '\0'; 1448 default: 1449 return ch + 1; 1450 } 1451 } 1452 1453 llvm::raw_ostream &operator<<( 1454 llvm::raw_ostream &o, const ImplicitRules &implicitRules) { 1455 o << "ImplicitRules:\n"; 1456 for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) { 1457 ShowImplicitRule(o, implicitRules, ch); 1458 } 1459 ShowImplicitRule(o, implicitRules, '_'); 1460 ShowImplicitRule(o, implicitRules, '$'); 1461 ShowImplicitRule(o, implicitRules, '@'); 1462 return o; 1463 } 1464 void ShowImplicitRule( 1465 llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) { 1466 auto it{implicitRules.map_.find(ch)}; 1467 if (it != implicitRules.map_.end()) { 1468 o << " " << ch << ": " << *it->second << '\n'; 1469 } 1470 } 1471 1472 template <typename T> void BaseVisitor::Walk(const T &x) { 1473 parser::Walk(x, *this_); 1474 } 1475 1476 void BaseVisitor::MakePlaceholder( 1477 const parser::Name &name, MiscDetails::Kind kind) { 1478 if (!name.symbol) { 1479 name.symbol = &context_->globalScope().MakeSymbol( 1480 name.source, Attrs{}, MiscDetails{kind}); 1481 } 1482 } 1483 1484 // AttrsVisitor implementation 1485 1486 bool AttrsVisitor::BeginAttrs() { 1487 CHECK(!attrs_); 1488 attrs_ = std::make_optional<Attrs>(); 1489 return true; 1490 } 1491 Attrs AttrsVisitor::GetAttrs() { 1492 CHECK(attrs_); 1493 return *attrs_; 1494 } 1495 Attrs AttrsVisitor::EndAttrs() { 1496 Attrs result{GetAttrs()}; 1497 attrs_.reset(); 1498 passName_ = std::nullopt; 1499 bindName_.reset(); 1500 return result; 1501 } 1502 1503 bool AttrsVisitor::SetPassNameOn(Symbol &symbol) { 1504 if (!passName_) { 1505 return false; 1506 } 1507 std::visit(common::visitors{ 1508 [&](ProcEntityDetails &x) { x.set_passName(*passName_); }, 1509 [&](ProcBindingDetails &x) { x.set_passName(*passName_); }, 1510 [](auto &) { common::die("unexpected pass name"); }, 1511 }, 1512 symbol.details()); 1513 return true; 1514 } 1515 1516 bool AttrsVisitor::SetBindNameOn(Symbol &symbol) { 1517 if (!bindName_) { 1518 return false; 1519 } 1520 std::visit( 1521 common::visitors{ 1522 [&](EntityDetails &x) { x.set_bindName(std::move(bindName_)); }, 1523 [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, 1524 [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, 1525 [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); }, 1526 [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); }, 1527 [](auto &) { common::die("unexpected bind name"); }, 1528 }, 1529 symbol.details()); 1530 return true; 1531 } 1532 1533 void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) { 1534 CHECK(attrs_); 1535 if (CheckAndSet(Attr::BIND_C)) { 1536 if (x.v) { 1537 bindName_ = EvaluateExpr(*x.v); 1538 } 1539 } 1540 } 1541 bool AttrsVisitor::Pre(const parser::IntentSpec &x) { 1542 CHECK(attrs_); 1543 CheckAndSet(IntentSpecToAttr(x)); 1544 return false; 1545 } 1546 bool AttrsVisitor::Pre(const parser::Pass &x) { 1547 if (CheckAndSet(Attr::PASS)) { 1548 if (x.v) { 1549 passName_ = x.v->source; 1550 MakePlaceholder(*x.v, MiscDetails::Kind::PassName); 1551 } 1552 } 1553 return false; 1554 } 1555 1556 // C730, C743, C755, C778, C1543 say no attribute or prefix repetitions 1557 bool AttrsVisitor::IsDuplicateAttr(Attr attrName) { 1558 if (attrs_->test(attrName)) { 1559 Say(currStmtSource().value(), 1560 "Attribute '%s' cannot be used more than once"_en_US, 1561 AttrToString(attrName)); 1562 return true; 1563 } 1564 return false; 1565 } 1566 1567 // See if attrName violates a constraint cause by a conflict. attr1 and attr2 1568 // name attributes that cannot be used on the same declaration 1569 bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) { 1570 if ((attrName == attr1 && attrs_->test(attr2)) || 1571 (attrName == attr2 && attrs_->test(attr1))) { 1572 Say(currStmtSource().value(), 1573 "Attributes '%s' and '%s' conflict with each other"_err_en_US, 1574 AttrToString(attr1), AttrToString(attr2)); 1575 return true; 1576 } 1577 return false; 1578 } 1579 // C759, C1543 1580 bool AttrsVisitor::IsConflictingAttr(Attr attrName) { 1581 return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) || 1582 HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) || 1583 HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) || 1584 HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781 1585 HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) || 1586 HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) || 1587 HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE); 1588 } 1589 bool AttrsVisitor::CheckAndSet(Attr attrName) { 1590 CHECK(attrs_); 1591 if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) { 1592 return false; 1593 } 1594 attrs_->set(attrName); 1595 return true; 1596 } 1597 1598 // DeclTypeSpecVisitor implementation 1599 1600 const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { 1601 return state_.declTypeSpec; 1602 } 1603 1604 void DeclTypeSpecVisitor::BeginDeclTypeSpec() { 1605 CHECK(!state_.expectDeclTypeSpec); 1606 CHECK(!state_.declTypeSpec); 1607 state_.expectDeclTypeSpec = true; 1608 } 1609 void DeclTypeSpecVisitor::EndDeclTypeSpec() { 1610 CHECK(state_.expectDeclTypeSpec); 1611 state_ = {}; 1612 } 1613 1614 void DeclTypeSpecVisitor::SetDeclTypeSpecCategory( 1615 DeclTypeSpec::Category category) { 1616 CHECK(state_.expectDeclTypeSpec); 1617 state_.derived.category = category; 1618 } 1619 1620 bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) { 1621 BeginDeclTypeSpec(); 1622 return true; 1623 } 1624 void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { 1625 EndDeclTypeSpec(); 1626 } 1627 1628 void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) { 1629 // Record the resolved DeclTypeSpec in the parse tree for use by 1630 // expression semantics if the DeclTypeSpec is a valid TypeSpec. 1631 // The grammar ensures that it's an intrinsic or derived type spec, 1632 // not TYPE(*) or CLASS(*) or CLASS(T). 1633 if (const DeclTypeSpec * spec{state_.declTypeSpec}) { 1634 switch (spec->category()) { 1635 case DeclTypeSpec::Numeric: 1636 case DeclTypeSpec::Logical: 1637 case DeclTypeSpec::Character: 1638 typeSpec.declTypeSpec = spec; 1639 break; 1640 case DeclTypeSpec::TypeDerived: 1641 if (const DerivedTypeSpec * derived{spec->AsDerived()}) { 1642 CheckForAbstractType(derived->typeSymbol()); // C703 1643 typeSpec.declTypeSpec = spec; 1644 } 1645 break; 1646 default: 1647 CRASH_NO_CASE; 1648 } 1649 } 1650 } 1651 1652 void DeclTypeSpecVisitor::Post( 1653 const parser::IntrinsicTypeSpec::DoublePrecision &) { 1654 MakeNumericType(TypeCategory::Real, context().doublePrecisionKind()); 1655 } 1656 void DeclTypeSpecVisitor::Post( 1657 const parser::IntrinsicTypeSpec::DoubleComplex &) { 1658 MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind()); 1659 } 1660 void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { 1661 SetDeclTypeSpec(context().MakeNumericType(category, kind)); 1662 } 1663 1664 void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) { 1665 if (typeSymbol.attrs().test(Attr::ABSTRACT)) { 1666 Say("ABSTRACT derived type may not be used here"_err_en_US); 1667 } 1668 } 1669 1670 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { 1671 SetDeclTypeSpec(context().globalScope().MakeClassStarType()); 1672 } 1673 void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) { 1674 SetDeclTypeSpec(context().globalScope().MakeTypeStarType()); 1675 } 1676 1677 // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet) 1678 // and save it in state_.declTypeSpec. 1679 void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { 1680 CHECK(state_.expectDeclTypeSpec); 1681 CHECK(!state_.declTypeSpec); 1682 state_.declTypeSpec = &declTypeSpec; 1683 } 1684 1685 KindExpr DeclTypeSpecVisitor::GetKindParamExpr( 1686 TypeCategory category, const std::optional<parser::KindSelector> &kind) { 1687 return AnalyzeKindSelector(context(), category, kind); 1688 } 1689 1690 // MessageHandler implementation 1691 1692 Message &MessageHandler::Say(MessageFixedText &&msg) { 1693 return context_->Say(currStmtSource().value(), std::move(msg)); 1694 } 1695 Message &MessageHandler::Say(MessageFormattedText &&msg) { 1696 return context_->Say(currStmtSource().value(), std::move(msg)); 1697 } 1698 Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) { 1699 return Say(name, std::move(msg), name); 1700 } 1701 1702 // ImplicitRulesVisitor implementation 1703 1704 void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) { 1705 prevParameterStmt_ = currStmtSource(); 1706 } 1707 1708 bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) { 1709 bool result{ 1710 std::visit(common::visitors{ 1711 [&](const std::list<ImplicitNoneNameSpec> &y) { 1712 return HandleImplicitNone(y); 1713 }, 1714 [&](const std::list<parser::ImplicitSpec> &) { 1715 if (prevImplicitNoneType_) { 1716 Say("IMPLICIT statement after IMPLICIT NONE or " 1717 "IMPLICIT NONE(TYPE) statement"_err_en_US); 1718 return false; 1719 } 1720 implicitRules_->set_isImplicitNoneType(false); 1721 return true; 1722 }, 1723 }, 1724 x.u)}; 1725 prevImplicit_ = currStmtSource(); 1726 return result; 1727 } 1728 1729 bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) { 1730 auto loLoc{std::get<parser::Location>(x.t)}; 1731 auto hiLoc{loLoc}; 1732 if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) { 1733 hiLoc = *hiLocOpt; 1734 if (*hiLoc < *loLoc) { 1735 Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US, 1736 std::string(hiLoc, 1), std::string(loLoc, 1)); 1737 return false; 1738 } 1739 } 1740 implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc); 1741 return false; 1742 } 1743 1744 bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) { 1745 BeginDeclTypeSpec(); 1746 set_allowForwardReferenceToDerivedType(true); 1747 return true; 1748 } 1749 1750 void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) { 1751 EndDeclTypeSpec(); 1752 } 1753 1754 void ImplicitRulesVisitor::SetScope(const Scope &scope) { 1755 implicitRules_ = &DEREF(implicitRulesMap_).at(&scope); 1756 prevImplicit_ = std::nullopt; 1757 prevImplicitNone_ = std::nullopt; 1758 prevImplicitNoneType_ = std::nullopt; 1759 prevParameterStmt_ = std::nullopt; 1760 } 1761 void ImplicitRulesVisitor::BeginScope(const Scope &scope) { 1762 // find or create implicit rules for this scope 1763 DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_); 1764 SetScope(scope); 1765 } 1766 1767 // TODO: for all of these errors, reference previous statement too 1768 bool ImplicitRulesVisitor::HandleImplicitNone( 1769 const std::list<ImplicitNoneNameSpec> &nameSpecs) { 1770 if (prevImplicitNone_) { 1771 Say("More than one IMPLICIT NONE statement"_err_en_US); 1772 Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US); 1773 return false; 1774 } 1775 if (prevParameterStmt_) { 1776 Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US); 1777 return false; 1778 } 1779 prevImplicitNone_ = currStmtSource(); 1780 bool implicitNoneTypeNever{ 1781 context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)}; 1782 if (nameSpecs.empty()) { 1783 if (!implicitNoneTypeNever) { 1784 prevImplicitNoneType_ = currStmtSource(); 1785 implicitRules_->set_isImplicitNoneType(true); 1786 if (prevImplicit_) { 1787 Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US); 1788 return false; 1789 } 1790 } 1791 } else { 1792 int sawType{0}; 1793 int sawExternal{0}; 1794 for (const auto noneSpec : nameSpecs) { 1795 switch (noneSpec) { 1796 case ImplicitNoneNameSpec::External: 1797 implicitRules_->set_isImplicitNoneExternal(true); 1798 ++sawExternal; 1799 break; 1800 case ImplicitNoneNameSpec::Type: 1801 if (!implicitNoneTypeNever) { 1802 prevImplicitNoneType_ = currStmtSource(); 1803 implicitRules_->set_isImplicitNoneType(true); 1804 if (prevImplicit_) { 1805 Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US); 1806 return false; 1807 } 1808 ++sawType; 1809 } 1810 break; 1811 } 1812 } 1813 if (sawType > 1) { 1814 Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US); 1815 return false; 1816 } 1817 if (sawExternal > 1) { 1818 Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US); 1819 return false; 1820 } 1821 } 1822 return true; 1823 } 1824 1825 // ArraySpecVisitor implementation 1826 1827 void ArraySpecVisitor::Post(const parser::ArraySpec &x) { 1828 CHECK(arraySpec_.empty()); 1829 arraySpec_ = AnalyzeArraySpec(context(), x); 1830 } 1831 void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) { 1832 CHECK(arraySpec_.empty()); 1833 arraySpec_ = AnalyzeArraySpec(context(), x); 1834 } 1835 void ArraySpecVisitor::Post(const parser::CoarraySpec &x) { 1836 CHECK(coarraySpec_.empty()); 1837 coarraySpec_ = AnalyzeCoarraySpec(context(), x); 1838 } 1839 1840 const ArraySpec &ArraySpecVisitor::arraySpec() { 1841 return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_; 1842 } 1843 const ArraySpec &ArraySpecVisitor::coarraySpec() { 1844 return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_; 1845 } 1846 void ArraySpecVisitor::BeginArraySpec() { 1847 CHECK(arraySpec_.empty()); 1848 CHECK(coarraySpec_.empty()); 1849 CHECK(attrArraySpec_.empty()); 1850 CHECK(attrCoarraySpec_.empty()); 1851 } 1852 void ArraySpecVisitor::EndArraySpec() { 1853 CHECK(arraySpec_.empty()); 1854 CHECK(coarraySpec_.empty()); 1855 attrArraySpec_.clear(); 1856 attrCoarraySpec_.clear(); 1857 } 1858 void ArraySpecVisitor::PostAttrSpec() { 1859 // Save dimension/codimension from attrs so we can process array/coarray-spec 1860 // on the entity-decl 1861 if (!arraySpec_.empty()) { 1862 if (attrArraySpec_.empty()) { 1863 attrArraySpec_ = arraySpec_; 1864 arraySpec_.clear(); 1865 } else { 1866 Say(currStmtSource().value(), 1867 "Attribute 'DIMENSION' cannot be used more than once"_err_en_US); 1868 } 1869 } 1870 if (!coarraySpec_.empty()) { 1871 if (attrCoarraySpec_.empty()) { 1872 attrCoarraySpec_ = coarraySpec_; 1873 coarraySpec_.clear(); 1874 } else { 1875 Say(currStmtSource().value(), 1876 "Attribute 'CODIMENSION' cannot be used more than once"_err_en_US); 1877 } 1878 } 1879 } 1880 1881 // ScopeHandler implementation 1882 1883 void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) { 1884 SayAlreadyDeclared(name.source, prev); 1885 } 1886 void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) { 1887 if (context().HasError(prev)) { 1888 // don't report another error about prev 1889 } else { 1890 if (const auto *details{prev.detailsIf<UseDetails>()}) { 1891 Say(name, "'%s' is already declared in this scoping unit"_err_en_US) 1892 .Attach(details->location(), 1893 "It is use-associated with '%s' in module '%s'"_err_en_US, 1894 details->symbol().name(), GetUsedModule(*details).name()); 1895 } else { 1896 SayAlreadyDeclared(name, prev.name()); 1897 } 1898 context().SetError(prev); 1899 } 1900 } 1901 void ScopeHandler::SayAlreadyDeclared( 1902 const SourceName &name1, const SourceName &name2) { 1903 if (name1.begin() < name2.begin()) { 1904 SayAlreadyDeclared(name2, name1); 1905 } else { 1906 Say(name1, "'%s' is already declared in this scoping unit"_err_en_US) 1907 .Attach(name2, "Previous declaration of '%s'"_en_US, name2); 1908 } 1909 } 1910 1911 void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol, 1912 MessageFixedText &&msg1, MessageFixedText &&msg2) { 1913 Say2(name, std::move(msg1), symbol, std::move(msg2)); 1914 context().SetError(symbol, msg1.isFatal()); 1915 } 1916 1917 void ScopeHandler::SayWithDecl( 1918 const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) { 1919 SayWithReason(name, symbol, std::move(msg), 1920 symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US 1921 : "Declaration of '%s'"_en_US); 1922 } 1923 1924 void ScopeHandler::SayLocalMustBeVariable( 1925 const parser::Name &name, Symbol &symbol) { 1926 SayWithDecl(name, symbol, 1927 "The name '%s' must be a variable to appear" 1928 " in a locality-spec"_err_en_US); 1929 } 1930 1931 void ScopeHandler::SayDerivedType( 1932 const SourceName &name, MessageFixedText &&msg, const Scope &type) { 1933 const Symbol &typeSymbol{DEREF(type.GetSymbol())}; 1934 Say(name, std::move(msg), name, typeSymbol.name()) 1935 .Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US, 1936 typeSymbol.name()); 1937 } 1938 void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1, 1939 const SourceName &name2, MessageFixedText &&msg2) { 1940 Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2); 1941 } 1942 void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1, 1943 Symbol &symbol, MessageFixedText &&msg2) { 1944 Say2(name, std::move(msg1), symbol.name(), std::move(msg2)); 1945 context().SetError(symbol, msg1.isFatal()); 1946 } 1947 void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1, 1948 Symbol &symbol, MessageFixedText &&msg2) { 1949 Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2)); 1950 context().SetError(symbol, msg1.isFatal()); 1951 } 1952 1953 // T may be `Scope` or `const Scope` 1954 template <typename T> static T &GetInclusiveScope(T &scope) { 1955 for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) { 1956 if (s->kind() != Scope::Kind::Block && !s->IsDerivedType() && 1957 !s->IsStmtFunction()) { 1958 return *s; 1959 } 1960 } 1961 return scope; 1962 } 1963 1964 Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); } 1965 1966 Scope *ScopeHandler::GetHostProcedure() { 1967 Scope &parent{InclusiveScope().parent()}; 1968 return parent.kind() == Scope::Kind::Subprogram ? &parent : nullptr; 1969 } 1970 1971 Scope &ScopeHandler::NonDerivedTypeScope() { 1972 return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_; 1973 } 1974 1975 void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) { 1976 PushScope(currScope().MakeScope(kind, symbol)); 1977 } 1978 void ScopeHandler::PushScope(Scope &scope) { 1979 currScope_ = &scope; 1980 auto kind{currScope_->kind()}; 1981 if (kind != Scope::Kind::Block) { 1982 BeginScope(scope); 1983 } 1984 // The name of a module or submodule cannot be "used" in its scope, 1985 // as we read 19.3.1(2), so we allow the name to be used as a local 1986 // identifier in the module or submodule too. Same with programs 1987 // (14.1(3)) and BLOCK DATA. 1988 if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module && 1989 kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) { 1990 if (auto *symbol{scope.symbol()}) { 1991 // Create a dummy symbol so we can't create another one with the same 1992 // name. It might already be there if we previously pushed the scope. 1993 if (!FindInScope(scope, symbol->name())) { 1994 auto &newSymbol{MakeSymbol(symbol->name())}; 1995 if (kind == Scope::Kind::Subprogram) { 1996 // Allow for recursive references. If this symbol is a function 1997 // without an explicit RESULT(), this new symbol will be discarded 1998 // and replaced with an object of the same name. 1999 newSymbol.set_details(HostAssocDetails{*symbol}); 2000 } else { 2001 newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName}); 2002 } 2003 } 2004 } 2005 } 2006 } 2007 void ScopeHandler::PopScope() { 2008 // Entities that are not yet classified as objects or procedures are now 2009 // assumed to be objects. 2010 // TODO: Statement functions 2011 for (auto &pair : currScope()) { 2012 ConvertToObjectEntity(*pair.second); 2013 } 2014 SetScope(currScope_->parent()); 2015 } 2016 void ScopeHandler::SetScope(Scope &scope) { 2017 currScope_ = &scope; 2018 ImplicitRulesVisitor::SetScope(InclusiveScope()); 2019 } 2020 2021 Symbol *ScopeHandler::FindSymbol(const parser::Name &name) { 2022 return FindSymbol(currScope(), name); 2023 } 2024 Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) { 2025 if (scope.IsDerivedType()) { 2026 if (Symbol * symbol{scope.FindComponent(name.source)}) { 2027 if (!symbol->has<ProcBindingDetails>() && 2028 !symbol->test(Symbol::Flag::ParentComp)) { 2029 return Resolve(name, symbol); 2030 } 2031 } 2032 return FindSymbol(scope.parent(), name); 2033 } else { 2034 return Resolve(name, scope.FindSymbol(name.source)); 2035 } 2036 } 2037 2038 Symbol &ScopeHandler::MakeSymbol( 2039 Scope &scope, const SourceName &name, Attrs attrs) { 2040 if (Symbol * symbol{FindInScope(scope, name)}) { 2041 symbol->attrs() |= attrs; 2042 return *symbol; 2043 } else { 2044 const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})}; 2045 CHECK(pair.second); // name was not found, so must be able to add 2046 return *pair.first->second; 2047 } 2048 } 2049 Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) { 2050 return MakeSymbol(currScope(), name, attrs); 2051 } 2052 Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) { 2053 return Resolve(name, MakeSymbol(name.source, attrs)); 2054 } 2055 Symbol &ScopeHandler::MakeHostAssocSymbol( 2056 const parser::Name &name, const Symbol &hostSymbol) { 2057 Symbol &symbol{MakeSymbol(name, HostAssocDetails{hostSymbol})}; 2058 name.symbol = &symbol; 2059 symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC? 2060 symbol.flags() = hostSymbol.flags(); 2061 return symbol; 2062 } 2063 Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) { 2064 CHECK(!FindInScope(currScope(), name)); 2065 return MakeSymbol(currScope(), name, symbol.attrs()); 2066 } 2067 2068 // Look for name only in scope, not in enclosing scopes. 2069 Symbol *ScopeHandler::FindInScope( 2070 const Scope &scope, const parser::Name &name) { 2071 return Resolve(name, FindInScope(scope, name.source)); 2072 } 2073 Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) { 2074 if (auto it{scope.find(name)}; it != scope.end()) { 2075 return &*it->second; 2076 } else { 2077 return nullptr; 2078 } 2079 } 2080 2081 // Find a component or type parameter by name in a derived type or its parents. 2082 Symbol *ScopeHandler::FindInTypeOrParents( 2083 const Scope &scope, const parser::Name &name) { 2084 return Resolve(name, scope.FindComponent(name.source)); 2085 } 2086 Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) { 2087 return FindInTypeOrParents(currScope(), name); 2088 } 2089 2090 void ScopeHandler::EraseSymbol(const parser::Name &name) { 2091 currScope().erase(name.source); 2092 name.symbol = nullptr; 2093 } 2094 2095 static bool NeedsType(const Symbol &symbol) { 2096 return !symbol.GetType() && 2097 std::visit(common::visitors{ 2098 [](const EntityDetails &) { return true; }, 2099 [](const ObjectEntityDetails &) { return true; }, 2100 [](const AssocEntityDetails &) { return true; }, 2101 [&](const ProcEntityDetails &p) { 2102 return symbol.test(Symbol::Flag::Function) && 2103 !symbol.attrs().test(Attr::INTRINSIC) && 2104 !p.interface().type() && !p.interface().symbol(); 2105 }, 2106 [](const auto &) { return false; }, 2107 }, 2108 symbol.details()); 2109 } 2110 2111 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) { 2112 if (NeedsType(symbol)) { 2113 const Scope *scope{&symbol.owner()}; 2114 if (scope->IsGlobal()) { 2115 scope = &currScope(); 2116 } 2117 if (const DeclTypeSpec * 2118 type{GetImplicitType(symbol, GetInclusiveScope(*scope))}) { 2119 symbol.set(Symbol::Flag::Implicit); 2120 symbol.SetType(*type); 2121 return; 2122 } 2123 if (symbol.has<ProcEntityDetails>() && 2124 !symbol.attrs().test(Attr::EXTERNAL)) { 2125 std::optional<Symbol::Flag> functionOrSubroutineFlag; 2126 if (symbol.test(Symbol::Flag::Function)) { 2127 functionOrSubroutineFlag = Symbol::Flag::Function; 2128 } else if (symbol.test(Symbol::Flag::Subroutine)) { 2129 functionOrSubroutineFlag = Symbol::Flag::Subroutine; 2130 } 2131 if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) { 2132 // type will be determined in expression semantics 2133 symbol.attrs().set(Attr::INTRINSIC); 2134 return; 2135 } 2136 } 2137 if (!context().HasError(symbol)) { 2138 Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); 2139 context().SetError(symbol); 2140 } 2141 } 2142 } 2143 2144 const DeclTypeSpec *ScopeHandler::GetImplicitType( 2145 Symbol &symbol, const Scope &scope) { 2146 const auto *type{implicitRulesMap_->at(&scope).GetType(symbol.name())}; 2147 if (type) { 2148 if (const DerivedTypeSpec * derived{type->AsDerived()}) { 2149 // Resolve any forward-referenced derived type; a quick no-op else. 2150 auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)}; 2151 instantiatable.Instantiate(currScope(), context()); 2152 } 2153 } 2154 return type; 2155 } 2156 2157 // Convert symbol to be a ObjectEntity or return false if it can't be. 2158 bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) { 2159 if (symbol.has<ObjectEntityDetails>()) { 2160 // nothing to do 2161 } else if (symbol.has<UnknownDetails>()) { 2162 symbol.set_details(ObjectEntityDetails{}); 2163 } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { 2164 symbol.set_details(ObjectEntityDetails{std::move(*details)}); 2165 } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) { 2166 return useDetails->symbol().has<ObjectEntityDetails>(); 2167 } else { 2168 return false; 2169 } 2170 return true; 2171 } 2172 // Convert symbol to be a ProcEntity or return false if it can't be. 2173 bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) { 2174 if (symbol.has<ProcEntityDetails>()) { 2175 // nothing to do 2176 } else if (symbol.has<UnknownDetails>()) { 2177 symbol.set_details(ProcEntityDetails{}); 2178 } else if (auto *details{symbol.detailsIf<EntityDetails>()}) { 2179 symbol.set_details(ProcEntityDetails{std::move(*details)}); 2180 if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) { 2181 CHECK(!symbol.test(Symbol::Flag::Subroutine)); 2182 symbol.set(Symbol::Flag::Function); 2183 } 2184 } else { 2185 return false; 2186 } 2187 return true; 2188 } 2189 2190 const DeclTypeSpec &ScopeHandler::MakeNumericType( 2191 TypeCategory category, const std::optional<parser::KindSelector> &kind) { 2192 KindExpr value{GetKindParamExpr(category, kind)}; 2193 if (auto known{evaluate::ToInt64(value)}) { 2194 return context().MakeNumericType(category, static_cast<int>(*known)); 2195 } else { 2196 return currScope_->MakeNumericType(category, std::move(value)); 2197 } 2198 } 2199 2200 const DeclTypeSpec &ScopeHandler::MakeLogicalType( 2201 const std::optional<parser::KindSelector> &kind) { 2202 KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)}; 2203 if (auto known{evaluate::ToInt64(value)}) { 2204 return context().MakeLogicalType(static_cast<int>(*known)); 2205 } else { 2206 return currScope_->MakeLogicalType(std::move(value)); 2207 } 2208 } 2209 2210 void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) { 2211 if (inSpecificationPart_ && name.symbol) { 2212 auto kind{currScope().kind()}; 2213 if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) || 2214 kind == Scope::Kind::Block) { 2215 bool isHostAssociated{&name.symbol->owner() == &currScope() 2216 ? name.symbol->has<HostAssocDetails>() 2217 : name.symbol->owner().Contains(currScope())}; 2218 if (isHostAssociated) { 2219 specPartForwardRefs_.insert(name.source); 2220 } 2221 } 2222 } 2223 } 2224 2225 std::optional<SourceName> ScopeHandler::HadForwardRef( 2226 const Symbol &symbol) const { 2227 auto iter{specPartForwardRefs_.find(symbol.name())}; 2228 if (iter != specPartForwardRefs_.end()) { 2229 return *iter; 2230 } 2231 return std::nullopt; 2232 } 2233 2234 bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) { 2235 if (!context().HasError(symbol)) { 2236 if (auto fwdRef{HadForwardRef(symbol)}) { 2237 Say(*fwdRef, 2238 "Forward reference to '%s' is not allowed in the same specification part"_err_en_US, 2239 *fwdRef) 2240 .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef); 2241 context().SetError(symbol); 2242 return true; 2243 } 2244 } 2245 return false; 2246 } 2247 2248 void ScopeHandler::MakeExternal(Symbol &symbol) { 2249 if (!symbol.attrs().test(Attr::EXTERNAL)) { 2250 symbol.attrs().set(Attr::EXTERNAL); 2251 if (symbol.attrs().test(Attr::INTRINSIC)) { // C840 2252 Say(symbol.name(), 2253 "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, 2254 symbol.name()); 2255 } 2256 } 2257 } 2258 2259 // ModuleVisitor implementation 2260 2261 bool ModuleVisitor::Pre(const parser::Only &x) { 2262 std::visit(common::visitors{ 2263 [&](const Indirection<parser::GenericSpec> &generic) { 2264 AddUse(GenericSpecInfo{generic.value()}); 2265 }, 2266 [&](const parser::Name &name) { 2267 Resolve(name, AddUse(name.source, name.source).use); 2268 }, 2269 [&](const parser::Rename &rename) { Walk(rename); }, 2270 }, 2271 x.u); 2272 return false; 2273 } 2274 2275 bool ModuleVisitor::Pre(const parser::Rename::Names &x) { 2276 const auto &localName{std::get<0>(x.t)}; 2277 const auto &useName{std::get<1>(x.t)}; 2278 SymbolRename rename{AddUse(localName.source, useName.source)}; 2279 Resolve(useName, rename.use); 2280 Resolve(localName, rename.local); 2281 return false; 2282 } 2283 bool ModuleVisitor::Pre(const parser::Rename::Operators &x) { 2284 const parser::DefinedOpName &local{std::get<0>(x.t)}; 2285 const parser::DefinedOpName &use{std::get<1>(x.t)}; 2286 GenericSpecInfo localInfo{local}; 2287 GenericSpecInfo useInfo{use}; 2288 if (IsIntrinsicOperator(context(), local.v.source)) { 2289 Say(local.v, 2290 "Intrinsic operator '%s' may not be used as a defined operator"_err_en_US); 2291 } else if (IsLogicalConstant(context(), local.v.source)) { 2292 Say(local.v, 2293 "Logical constant '%s' may not be used as a defined operator"_err_en_US); 2294 } else { 2295 SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())}; 2296 useInfo.Resolve(rename.use); 2297 localInfo.Resolve(rename.local); 2298 } 2299 return false; 2300 } 2301 2302 // Set useModuleScope_ to the Scope of the module being used. 2303 bool ModuleVisitor::Pre(const parser::UseStmt &x) { 2304 useModuleScope_ = FindModule(x.moduleName); 2305 if (!useModuleScope_) { 2306 return false; 2307 } 2308 // use the name from this source file 2309 useModuleScope_->symbol()->ReplaceName(x.moduleName.source); 2310 return true; 2311 } 2312 2313 void ModuleVisitor::Post(const parser::UseStmt &x) { 2314 if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) { 2315 // Not a use-only: collect the names that were used in renames, 2316 // then add a use for each public name that was not renamed. 2317 std::set<SourceName> useNames; 2318 for (const auto &rename : *list) { 2319 std::visit(common::visitors{ 2320 [&](const parser::Rename::Names &names) { 2321 useNames.insert(std::get<1>(names.t).source); 2322 }, 2323 [&](const parser::Rename::Operators &ops) { 2324 useNames.insert(std::get<1>(ops.t).v.source); 2325 }, 2326 }, 2327 rename.u); 2328 } 2329 for (const auto &[name, symbol] : *useModuleScope_) { 2330 if (symbol->attrs().test(Attr::PUBLIC) && 2331 !symbol->attrs().test(Attr::INTRINSIC) && 2332 !symbol->has<MiscDetails>() && useNames.count(name) == 0) { 2333 SourceName location{x.moduleName.source}; 2334 if (auto *localSymbol{FindInScope(currScope(), name)}) { 2335 DoAddUse(location, localSymbol->name(), *localSymbol, *symbol); 2336 } else { 2337 DoAddUse(location, location, CopySymbol(name, *symbol), *symbol); 2338 } 2339 } 2340 } 2341 } 2342 useModuleScope_ = nullptr; 2343 } 2344 2345 ModuleVisitor::SymbolRename ModuleVisitor::AddUse( 2346 const SourceName &localName, const SourceName &useName) { 2347 return AddUse(localName, useName, FindInScope(*useModuleScope_, useName)); 2348 } 2349 2350 ModuleVisitor::SymbolRename ModuleVisitor::AddUse( 2351 const SourceName &localName, const SourceName &useName, Symbol *useSymbol) { 2352 if (!useModuleScope_) { 2353 return {}; // error occurred finding module 2354 } 2355 if (!useSymbol) { 2356 Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName), 2357 useModuleScope_->GetName().value()); 2358 return {}; 2359 } 2360 if (useSymbol->attrs().test(Attr::PRIVATE)) { 2361 Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName), 2362 useModuleScope_->GetName().value()); 2363 return {}; 2364 } 2365 auto &localSymbol{MakeSymbol(localName)}; 2366 DoAddUse(useName, localName, localSymbol, *useSymbol); 2367 return {&localSymbol, useSymbol}; 2368 } 2369 2370 // symbol must be either a Use or a Generic formed by merging two uses. 2371 // Convert it to a UseError with this additional location. 2372 static void ConvertToUseError( 2373 Symbol &symbol, const SourceName &location, const Scope &module) { 2374 const auto *useDetails{symbol.detailsIf<UseDetails>()}; 2375 if (!useDetails) { 2376 auto &genericDetails{symbol.get<GenericDetails>()}; 2377 useDetails = &genericDetails.uses().at(0)->get<UseDetails>(); 2378 } 2379 symbol.set_details( 2380 UseErrorDetails{*useDetails}.add_occurrence(location, module)); 2381 } 2382 2383 void ModuleVisitor::DoAddUse(const SourceName &location, 2384 const SourceName &localName, Symbol &localSymbol, const Symbol &useSymbol) { 2385 localSymbol.attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; 2386 localSymbol.flags() = useSymbol.flags(); 2387 if (auto *useDetails{localSymbol.detailsIf<UseDetails>()}) { 2388 const Symbol &ultimate{localSymbol.GetUltimate()}; 2389 if (ultimate == useSymbol.GetUltimate()) { 2390 // use-associating the same symbol again -- ok 2391 } else if (ultimate.has<GenericDetails>() && 2392 useSymbol.has<GenericDetails>()) { 2393 // use-associating generics with the same names: merge them into a 2394 // new generic in this scope 2395 auto generic1{ultimate.get<GenericDetails>()}; 2396 AddGenericUse(generic1, localName, useSymbol); 2397 generic1.AddUse(localSymbol); 2398 // useSymbol has specific g and so does generic1 2399 auto &generic2{useSymbol.get<GenericDetails>()}; 2400 if (generic1.derivedType() && generic2.derivedType() && 2401 generic1.derivedType() != generic2.derivedType()) { 2402 Say(location, 2403 "Generic interface '%s' has ambiguous derived types" 2404 " from modules '%s' and '%s'"_err_en_US, 2405 localSymbol.name(), GetUsedModule(*useDetails).name(), 2406 useSymbol.owner().GetName().value()); 2407 context().SetError(localSymbol); 2408 } else { 2409 generic1.CopyFrom(generic2); 2410 } 2411 EraseSymbol(localSymbol); 2412 MakeSymbol(localSymbol.name(), ultimate.attrs(), std::move(generic1)); 2413 } else { 2414 ConvertToUseError(localSymbol, location, *useModuleScope_); 2415 } 2416 } else if (auto *genericDetails{localSymbol.detailsIf<GenericDetails>()}) { 2417 if (const auto *useDetails{useSymbol.detailsIf<GenericDetails>()}) { 2418 AddGenericUse(*genericDetails, localName, useSymbol); 2419 if (genericDetails->derivedType() && useDetails->derivedType() && 2420 genericDetails->derivedType() != useDetails->derivedType()) { 2421 Say(location, 2422 "Generic interface '%s' has ambiguous derived types" 2423 " from modules '%s' and '%s'"_err_en_US, 2424 localSymbol.name(), 2425 genericDetails->derivedType()->owner().GetName().value(), 2426 useDetails->derivedType()->owner().GetName().value()); 2427 } else { 2428 genericDetails->CopyFrom(*useDetails); 2429 } 2430 } else { 2431 ConvertToUseError(localSymbol, location, *useModuleScope_); 2432 } 2433 } else if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) { 2434 details->add_occurrence(location, *useModuleScope_); 2435 } else if (!localSymbol.has<UnknownDetails>()) { 2436 Say(location, 2437 "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US, 2438 localName) 2439 .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US, 2440 localName); 2441 } else { 2442 localSymbol.set_details(UseDetails{localName, useSymbol}); 2443 } 2444 } 2445 2446 void ModuleVisitor::AddUse(const GenericSpecInfo &info) { 2447 if (useModuleScope_) { 2448 const auto &name{info.symbolName()}; 2449 auto rename{ 2450 AddUse(name, name, info.FindInScope(context(), *useModuleScope_))}; 2451 info.Resolve(rename.use); 2452 } 2453 } 2454 2455 // Create a UseDetails symbol for this USE and add it to generic 2456 void ModuleVisitor::AddGenericUse( 2457 GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) { 2458 generic.AddUse(currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})); 2459 } 2460 2461 bool ModuleVisitor::BeginSubmodule( 2462 const parser::Name &name, const parser::ParentIdentifier &parentId) { 2463 auto &ancestorName{std::get<parser::Name>(parentId.t)}; 2464 auto &parentName{std::get<std::optional<parser::Name>>(parentId.t)}; 2465 Scope *ancestor{FindModule(ancestorName)}; 2466 if (!ancestor) { 2467 return false; 2468 } 2469 Scope *parentScope{parentName ? FindModule(*parentName, ancestor) : ancestor}; 2470 if (!parentScope) { 2471 return false; 2472 } 2473 PushScope(*parentScope); // submodule is hosted in parent 2474 BeginModule(name, true); 2475 if (!ancestor->AddSubmodule(name.source, currScope())) { 2476 Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US, 2477 ancestorName.source, name.source); 2478 } 2479 return true; 2480 } 2481 2482 void ModuleVisitor::BeginModule(const parser::Name &name, bool isSubmodule) { 2483 auto &symbol{MakeSymbol(name, ModuleDetails{isSubmodule})}; 2484 auto &details{symbol.get<ModuleDetails>()}; 2485 PushScope(Scope::Kind::Module, &symbol); 2486 details.set_scope(&currScope()); 2487 defaultAccess_ = Attr::PUBLIC; 2488 prevAccessStmt_ = std::nullopt; 2489 } 2490 2491 // Find a module or submodule by name and return its scope. 2492 // If ancestor is present, look for a submodule of that ancestor module. 2493 // May have to read a .mod file to find it. 2494 // If an error occurs, report it and return nullptr. 2495 Scope *ModuleVisitor::FindModule(const parser::Name &name, Scope *ancestor) { 2496 ModFileReader reader{context()}; 2497 Scope *scope{reader.Read(name.source, ancestor)}; 2498 if (!scope) { 2499 return nullptr; 2500 } 2501 if (scope->kind() != Scope::Kind::Module) { 2502 Say(name, "'%s' is not a module"_err_en_US); 2503 return nullptr; 2504 } 2505 if (DoesScopeContain(scope, currScope())) { // 14.2.2(1) 2506 Say(name, "Module '%s' cannot USE itself"_err_en_US); 2507 } 2508 Resolve(name, scope->symbol()); 2509 return scope; 2510 } 2511 2512 void ModuleVisitor::ApplyDefaultAccess() { 2513 for (auto &pair : currScope()) { 2514 Symbol &symbol = *pair.second; 2515 if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) { 2516 symbol.attrs().set(defaultAccess_); 2517 } 2518 } 2519 } 2520 2521 // InterfaceVistor implementation 2522 2523 bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) { 2524 bool isAbstract{std::holds_alternative<parser::Abstract>(x.u)}; 2525 genericInfo_.emplace(/*isInterface*/ true, isAbstract); 2526 return BeginAttrs(); 2527 } 2528 2529 void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); } 2530 2531 void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) { 2532 genericInfo_.pop(); 2533 } 2534 2535 // Create a symbol in genericSymbol_ for this GenericSpec. 2536 bool InterfaceVisitor::Pre(const parser::GenericSpec &x) { 2537 if (auto *symbol{GenericSpecInfo{x}.FindInScope(context(), currScope())}) { 2538 SetGenericSymbol(*symbol); 2539 } 2540 return false; 2541 } 2542 2543 bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) { 2544 if (!isGeneric()) { 2545 Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US); 2546 return false; 2547 } 2548 auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)}; 2549 const auto &names{std::get<std::list<parser::Name>>(x.t)}; 2550 AddSpecificProcs(names, kind); 2551 return false; 2552 } 2553 2554 bool InterfaceVisitor::Pre(const parser::GenericStmt &) { 2555 genericInfo_.emplace(/*isInterface*/ false); 2556 return true; 2557 } 2558 void InterfaceVisitor::Post(const parser::GenericStmt &x) { 2559 if (auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}) { 2560 GetGenericInfo().symbol->attrs().set(AccessSpecToAttr(*accessSpec)); 2561 } 2562 const auto &names{std::get<std::list<parser::Name>>(x.t)}; 2563 AddSpecificProcs(names, ProcedureKind::Procedure); 2564 genericInfo_.pop(); 2565 } 2566 2567 bool InterfaceVisitor::inInterfaceBlock() const { 2568 return !genericInfo_.empty() && GetGenericInfo().isInterface; 2569 } 2570 bool InterfaceVisitor::isGeneric() const { 2571 return !genericInfo_.empty() && GetGenericInfo().symbol; 2572 } 2573 bool InterfaceVisitor::isAbstract() const { 2574 return !genericInfo_.empty() && GetGenericInfo().isAbstract; 2575 } 2576 GenericDetails &InterfaceVisitor::GetGenericDetails() { 2577 return GetGenericInfo().symbol->get<GenericDetails>(); 2578 } 2579 2580 void InterfaceVisitor::AddSpecificProcs( 2581 const std::list<parser::Name> &names, ProcedureKind kind) { 2582 for (const auto &name : names) { 2583 specificProcs_.emplace( 2584 GetGenericInfo().symbol, std::make_pair(&name, kind)); 2585 } 2586 } 2587 2588 // By now we should have seen all specific procedures referenced by name in 2589 // this generic interface. Resolve those names to symbols. 2590 void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) { 2591 auto &details{generic.get<GenericDetails>()}; 2592 SymbolSet symbolsSeen; 2593 for (const Symbol &symbol : details.specificProcs()) { 2594 symbolsSeen.insert(symbol); 2595 } 2596 auto range{specificProcs_.equal_range(&generic)}; 2597 for (auto it{range.first}; it != range.second; ++it) { 2598 auto *name{it->second.first}; 2599 auto kind{it->second.second}; 2600 const auto *symbol{FindSymbol(*name)}; 2601 if (!symbol) { 2602 Say(*name, "Procedure '%s' not found"_err_en_US); 2603 continue; 2604 } 2605 symbol = &symbol->GetUltimate(); 2606 if (symbol == &generic) { 2607 if (auto *specific{generic.get<GenericDetails>().specific()}) { 2608 symbol = specific; 2609 } 2610 } 2611 if (!symbol->has<SubprogramDetails>() && 2612 !symbol->has<SubprogramNameDetails>()) { 2613 Say(*name, "'%s' is not a subprogram"_err_en_US); 2614 continue; 2615 } 2616 if (kind == ProcedureKind::ModuleProcedure) { 2617 if (const auto *nd{symbol->detailsIf<SubprogramNameDetails>()}) { 2618 if (nd->kind() != SubprogramKind::Module) { 2619 Say(*name, "'%s' is not a module procedure"_err_en_US); 2620 } 2621 } else { 2622 // USE-associated procedure 2623 const auto *sd{symbol->detailsIf<SubprogramDetails>()}; 2624 CHECK(sd); 2625 if (symbol->owner().kind() != Scope::Kind::Module || 2626 sd->isInterface()) { 2627 Say(*name, "'%s' is not a module procedure"_err_en_US); 2628 } 2629 } 2630 } 2631 if (!symbolsSeen.insert(*symbol).second) { 2632 Say(name->source, 2633 "Procedure '%s' is already specified in generic '%s'"_err_en_US, 2634 name->source, MakeOpName(generic.name())); 2635 continue; 2636 } 2637 details.AddSpecificProc(*symbol, name->source); 2638 } 2639 specificProcs_.erase(range.first, range.second); 2640 } 2641 2642 // Check that the specific procedures are all functions or all subroutines. 2643 // If there is a derived type with the same name they must be functions. 2644 // Set the corresponding flag on generic. 2645 void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) { 2646 ResolveSpecificsInGeneric(generic); 2647 auto &details{generic.get<GenericDetails>()}; 2648 if (auto *proc{details.CheckSpecific()}) { 2649 auto msg{ 2650 "'%s' may not be the name of both a generic interface and a" 2651 " procedure unless it is a specific procedure of the generic"_err_en_US}; 2652 if (proc->name().begin() > generic.name().begin()) { 2653 Say(proc->name(), std::move(msg)); 2654 } else { 2655 Say(generic.name(), std::move(msg)); 2656 } 2657 } 2658 auto &specifics{details.specificProcs()}; 2659 if (specifics.empty()) { 2660 if (details.derivedType()) { 2661 generic.set(Symbol::Flag::Function); 2662 } 2663 return; 2664 } 2665 const Symbol &firstSpecific{specifics.front()}; 2666 bool isFunction{firstSpecific.test(Symbol::Flag::Function)}; 2667 for (const Symbol &specific : specifics) { 2668 if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514 2669 auto &msg{Say(generic.name(), 2670 "Generic interface '%s' has both a function and a subroutine"_err_en_US)}; 2671 if (isFunction) { 2672 msg.Attach(firstSpecific.name(), "Function declaration"_en_US); 2673 msg.Attach(specific.name(), "Subroutine declaration"_en_US); 2674 } else { 2675 msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US); 2676 msg.Attach(specific.name(), "Function declaration"_en_US); 2677 } 2678 } 2679 } 2680 if (!isFunction && details.derivedType()) { 2681 SayDerivedType(generic.name(), 2682 "Generic interface '%s' may only contain functions due to derived type" 2683 " with same name"_err_en_US, 2684 *details.derivedType()->scope()); 2685 } 2686 generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine); 2687 } 2688 2689 // SubprogramVisitor implementation 2690 2691 // Return false if it is actually an assignment statement. 2692 bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) { 2693 const auto &name{std::get<parser::Name>(x.t)}; 2694 const DeclTypeSpec *resultType{nullptr}; 2695 // Look up name: provides return type or tells us if it's an array 2696 if (auto *symbol{FindSymbol(name)}) { 2697 auto *details{symbol->detailsIf<EntityDetails>()}; 2698 if (!details) { 2699 badStmtFuncFound_ = true; 2700 return false; 2701 } 2702 // TODO: check that attrs are compatible with stmt func 2703 resultType = details->type(); 2704 symbol->details() = UnknownDetails{}; // will be replaced below 2705 } 2706 if (badStmtFuncFound_) { 2707 Say(name, "'%s' has not been declared as an array"_err_en_US); 2708 return true; 2709 } 2710 auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)}; 2711 symbol.set(Symbol::Flag::StmtFunction); 2712 EraseSymbol(symbol); // removes symbol added by PushSubprogramScope 2713 auto &details{symbol.get<SubprogramDetails>()}; 2714 for (const auto &dummyName : std::get<std::list<parser::Name>>(x.t)) { 2715 ObjectEntityDetails dummyDetails{true}; 2716 if (auto *dummySymbol{FindInScope(currScope().parent(), dummyName)}) { 2717 if (auto *d{dummySymbol->detailsIf<EntityDetails>()}) { 2718 if (d->type()) { 2719 dummyDetails.set_type(*d->type()); 2720 } 2721 } 2722 } 2723 Symbol &dummy{MakeSymbol(dummyName, std::move(dummyDetails))}; 2724 ApplyImplicitRules(dummy); 2725 details.add_dummyArg(dummy); 2726 } 2727 ObjectEntityDetails resultDetails; 2728 if (resultType) { 2729 resultDetails.set_type(*resultType); 2730 } 2731 resultDetails.set_funcResult(true); 2732 Symbol &result{MakeSymbol(name, std::move(resultDetails))}; 2733 ApplyImplicitRules(result); 2734 details.set_result(result); 2735 const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)}; 2736 Walk(parsedExpr); 2737 // The analysis of the expression that constitutes the body of the 2738 // statement function is deferred to FinishSpecificationPart() so that 2739 // all declarations and implicit typing are complete. 2740 PopScope(); 2741 return true; 2742 } 2743 2744 bool SubprogramVisitor::Pre(const parser::Suffix &suffix) { 2745 if (suffix.resultName) { 2746 funcInfo_.resultName = &suffix.resultName.value(); 2747 } 2748 return true; 2749 } 2750 2751 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) { 2752 // Save this to process after UseStmt and ImplicitPart 2753 if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) { 2754 if (funcInfo_.parsedType) { // C1543 2755 Say(currStmtSource().value(), 2756 "FUNCTION prefix cannot specify the type more than once"_err_en_US); 2757 return false; 2758 } else { 2759 funcInfo_.parsedType = parsedType; 2760 funcInfo_.source = currStmtSource(); 2761 return false; 2762 } 2763 } else { 2764 return true; 2765 } 2766 } 2767 2768 void SubprogramVisitor::Post(const parser::ImplicitPart &) { 2769 // If the function has a type in the prefix, process it now 2770 if (funcInfo_.parsedType) { 2771 messageHandler().set_currStmtSource(funcInfo_.source); 2772 if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) { 2773 funcInfo_.resultSymbol->SetType(*type); 2774 } 2775 } 2776 funcInfo_ = {}; 2777 } 2778 2779 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) { 2780 const auto &name{std::get<parser::Name>( 2781 std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)}; 2782 return BeginSubprogram(name, Symbol::Flag::Subroutine); 2783 } 2784 void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &) { 2785 EndSubprogram(); 2786 } 2787 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) { 2788 const auto &name{std::get<parser::Name>( 2789 std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)}; 2790 return BeginSubprogram(name, Symbol::Flag::Function); 2791 } 2792 void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) { 2793 EndSubprogram(); 2794 } 2795 2796 bool SubprogramVisitor::Pre(const parser::SubroutineStmt &) { 2797 return BeginAttrs(); 2798 } 2799 bool SubprogramVisitor::Pre(const parser::FunctionStmt &) { 2800 return BeginAttrs(); 2801 } 2802 bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); } 2803 2804 void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) { 2805 const auto &name{std::get<parser::Name>(stmt.t)}; 2806 auto &details{PostSubprogramStmt(name)}; 2807 for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { 2808 if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { 2809 Symbol &dummy{MakeSymbol(*dummyName, EntityDetails(true))}; 2810 details.add_dummyArg(dummy); 2811 } else { 2812 details.add_alternateReturn(); 2813 } 2814 } 2815 } 2816 2817 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { 2818 const auto &name{std::get<parser::Name>(stmt.t)}; 2819 auto &details{PostSubprogramStmt(name)}; 2820 for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) { 2821 Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))}; 2822 details.add_dummyArg(dummy); 2823 } 2824 const parser::Name *funcResultName; 2825 if (funcInfo_.resultName && funcInfo_.resultName->source != name.source) { 2826 // Note that RESULT is ignored if it has the same name as the function. 2827 funcResultName = funcInfo_.resultName; 2828 } else { 2829 EraseSymbol(name); // was added by PushSubprogramScope 2830 funcResultName = &name; 2831 } 2832 // add function result to function scope 2833 EntityDetails funcResultDetails; 2834 funcResultDetails.set_funcResult(true); 2835 funcInfo_.resultSymbol = 2836 &MakeSymbol(*funcResultName, std::move(funcResultDetails)); 2837 details.set_result(*funcInfo_.resultSymbol); 2838 2839 // C1560. 2840 if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) { 2841 Say(funcInfo_.resultName->source, 2842 "The function name should not appear in RESULT, references to '%s' " 2843 "inside" 2844 " the function will be considered as references to the result only"_en_US, 2845 name.source); 2846 // RESULT name was ignored above, the only side effect from doing so will be 2847 // the inability to make recursive calls. The related parser::Name is still 2848 // resolved to the created function result symbol because every parser::Name 2849 // should be resolved to avoid internal errors. 2850 Resolve(*funcInfo_.resultName, funcInfo_.resultSymbol); 2851 } 2852 name.symbol = currScope().symbol(); // must not be function result symbol 2853 // Clear the RESULT() name now in case an ENTRY statement in the implicit-part 2854 // has a RESULT() suffix. 2855 funcInfo_.resultName = nullptr; 2856 } 2857 2858 SubprogramDetails &SubprogramVisitor::PostSubprogramStmt( 2859 const parser::Name &name) { 2860 Symbol &symbol{*currScope().symbol()}; 2861 CHECK(name.source == symbol.name()); 2862 SetBindNameOn(symbol); 2863 symbol.attrs() |= EndAttrs(); 2864 if (symbol.attrs().test(Attr::MODULE)) { 2865 symbol.attrs().set(Attr::EXTERNAL, false); 2866 } 2867 return symbol.get<SubprogramDetails>(); 2868 } 2869 2870 void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { 2871 auto attrs{EndAttrs()}; // needs to be called even if early return 2872 Scope &inclusiveScope{InclusiveScope()}; 2873 const Symbol *subprogram{inclusiveScope.symbol()}; 2874 if (!subprogram) { 2875 CHECK(context().AnyFatalError()); 2876 return; 2877 } 2878 const auto &name{std::get<parser::Name>(stmt.t)}; 2879 const auto *parentDetails{subprogram->detailsIf<SubprogramDetails>()}; 2880 bool inFunction{parentDetails && parentDetails->isFunction()}; 2881 const parser::Name *resultName{funcInfo_.resultName}; 2882 if (resultName) { // RESULT(result) is present 2883 funcInfo_.resultName = nullptr; 2884 if (!inFunction) { 2885 Say2(resultName->source, 2886 "RESULT(%s) may appear only in a function"_err_en_US, 2887 subprogram->name(), "Containing subprogram"_en_US); 2888 } else if (resultName->source == subprogram->name()) { // C1574 2889 Say2(resultName->source, 2890 "RESULT(%s) may not have the same name as the function"_err_en_US, 2891 subprogram->name(), "Containing function"_en_US); 2892 } else if (const Symbol * 2893 symbol{FindSymbol(inclusiveScope.parent(), *resultName)}) { // C1574 2894 if (const auto *details{symbol->detailsIf<SubprogramDetails>()}) { 2895 if (details->entryScope() == &inclusiveScope) { 2896 Say2(resultName->source, 2897 "RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US, 2898 symbol->name(), "Conflicting ENTRY"_en_US); 2899 } 2900 } 2901 } 2902 if (Symbol * symbol{FindSymbol(name)}) { // C1570 2903 // When RESULT() appears, ENTRY name can't have been already declared 2904 if (inclusiveScope.Contains(symbol->owner())) { 2905 Say2(name, 2906 "ENTRY name '%s' may not be declared when RESULT() is present"_err_en_US, 2907 *symbol, "Previous declaration of '%s'"_en_US); 2908 } 2909 } 2910 if (resultName->source == name.source) { 2911 // ignore RESULT() hereafter when it's the same name as the ENTRY 2912 resultName = nullptr; 2913 } 2914 } 2915 SubprogramDetails entryDetails; 2916 entryDetails.set_entryScope(inclusiveScope); 2917 if (inFunction) { 2918 // Create the entity to hold the function result, if necessary. 2919 Symbol *resultSymbol{nullptr}; 2920 auto &effectiveResultName{*(resultName ? resultName : &name)}; 2921 resultSymbol = FindInScope(currScope(), effectiveResultName); 2922 if (resultSymbol) { // C1574 2923 std::visit( 2924 common::visitors{[](EntityDetails &x) { x.set_funcResult(true); }, 2925 [](ObjectEntityDetails &x) { x.set_funcResult(true); }, 2926 [](ProcEntityDetails &x) { x.set_funcResult(true); }, 2927 [&](const auto &) { 2928 Say2(effectiveResultName.source, 2929 "'%s' was previously declared as an item that may not be used as a function result"_err_en_US, 2930 resultSymbol->name(), "Previous declaration of '%s'"_en_US); 2931 }}, 2932 resultSymbol->details()); 2933 } else if (inExecutionPart_) { 2934 ObjectEntityDetails entity; 2935 entity.set_funcResult(true); 2936 resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity)); 2937 ApplyImplicitRules(*resultSymbol); 2938 } else { 2939 EntityDetails entity; 2940 entity.set_funcResult(true); 2941 resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity)); 2942 } 2943 if (!resultName) { 2944 name.symbol = nullptr; // symbol will be used for entry point below 2945 } 2946 entryDetails.set_result(*resultSymbol); 2947 } 2948 2949 for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) { 2950 if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) { 2951 Symbol *dummy{FindSymbol(*dummyName)}; 2952 if (dummy) { 2953 std::visit( 2954 common::visitors{[](EntityDetails &x) { x.set_isDummy(); }, 2955 [](ObjectEntityDetails &x) { x.set_isDummy(); }, 2956 [](ProcEntityDetails &x) { x.set_isDummy(); }, 2957 [&](const auto &) { 2958 Say2(dummyName->source, 2959 "ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US, 2960 dummy->name(), "Previous declaration of '%s'"_en_US); 2961 }}, 2962 dummy->details()); 2963 } else { 2964 dummy = &MakeSymbol(*dummyName, EntityDetails(true)); 2965 } 2966 entryDetails.add_dummyArg(*dummy); 2967 } else { 2968 if (inFunction) { // C1573 2969 Say(name, 2970 "ENTRY in a function may not have an alternate return dummy argument"_err_en_US); 2971 break; 2972 } 2973 entryDetails.add_alternateReturn(); 2974 } 2975 } 2976 2977 Symbol::Flag subpFlag{ 2978 inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine}; 2979 CheckExtantExternal(name, subpFlag); 2980 Scope &outer{inclusiveScope.parent()}; // global or module scope 2981 if (Symbol * extant{FindSymbol(outer, name)}) { 2982 if (extant->has<ProcEntityDetails>()) { 2983 if (!extant->test(subpFlag)) { 2984 Say2(name, 2985 subpFlag == Symbol::Flag::Function 2986 ? "'%s' was previously called as a subroutine"_err_en_US 2987 : "'%s' was previously called as a function"_err_en_US, 2988 *extant, "Previous call of '%s'"_en_US); 2989 } 2990 if (extant->attrs().test(Attr::PRIVATE)) { 2991 attrs.set(Attr::PRIVATE); 2992 } 2993 outer.erase(extant->name()); 2994 } else { 2995 if (outer.IsGlobal()) { 2996 Say2(name, "'%s' is already defined as a global identifier"_err_en_US, 2997 *extant, "Previous definition of '%s'"_en_US); 2998 } else { 2999 SayAlreadyDeclared(name, *extant); 3000 } 3001 return; 3002 } 3003 } 3004 if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) { 3005 attrs.set(Attr::PUBLIC); 3006 } 3007 Symbol &entrySymbol{MakeSymbol(outer, name.source, attrs)}; 3008 entrySymbol.set_details(std::move(entryDetails)); 3009 if (outer.IsGlobal()) { 3010 MakeExternal(entrySymbol); 3011 } 3012 SetBindNameOn(entrySymbol); 3013 entrySymbol.set(subpFlag); 3014 Resolve(name, entrySymbol); 3015 } 3016 3017 // A subprogram declared with MODULE PROCEDURE 3018 bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) { 3019 auto *symbol{FindSymbol(name)}; 3020 if (symbol && symbol->has<SubprogramNameDetails>()) { 3021 symbol = FindSymbol(currScope().parent(), name); 3022 } 3023 if (!IsSeparateModuleProcedureInterface(symbol)) { 3024 Say(name, "'%s' was not declared a separate module procedure"_err_en_US); 3025 return false; 3026 } 3027 if (symbol->owner() == currScope()) { 3028 PushScope(Scope::Kind::Subprogram, symbol); 3029 } else { 3030 Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})}; 3031 PushScope(Scope::Kind::Subprogram, &newSymbol); 3032 const auto &details{symbol->get<SubprogramDetails>()}; 3033 auto &newDetails{newSymbol.get<SubprogramDetails>()}; 3034 for (const Symbol *dummyArg : details.dummyArgs()) { 3035 if (!dummyArg) { 3036 newDetails.add_alternateReturn(); 3037 } else if (Symbol * copy{currScope().CopySymbol(*dummyArg)}) { 3038 newDetails.add_dummyArg(*copy); 3039 } 3040 } 3041 if (details.isFunction()) { 3042 currScope().erase(symbol->name()); 3043 newDetails.set_result(*currScope().CopySymbol(details.result())); 3044 } 3045 } 3046 return true; 3047 } 3048 3049 // A subprogram declared with SUBROUTINE or FUNCTION 3050 bool SubprogramVisitor::BeginSubprogram( 3051 const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) { 3052 if (hasModulePrefix && !inInterfaceBlock() && 3053 !IsSeparateModuleProcedureInterface( 3054 FindSymbol(currScope().parent(), name))) { 3055 Say(name, "'%s' was not declared a separate module procedure"_err_en_US); 3056 return false; 3057 } 3058 PushSubprogramScope(name, subpFlag); 3059 return true; 3060 } 3061 3062 void SubprogramVisitor::EndSubprogram() { PopScope(); } 3063 3064 void SubprogramVisitor::CheckExtantExternal( 3065 const parser::Name &name, Symbol::Flag subpFlag) { 3066 if (auto *prev{FindSymbol(name)}) { 3067 if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) { 3068 // this subprogram was previously called, now being declared 3069 if (!prev->test(subpFlag)) { 3070 Say2(name, 3071 subpFlag == Symbol::Flag::Function 3072 ? "'%s' was previously called as a subroutine"_err_en_US 3073 : "'%s' was previously called as a function"_err_en_US, 3074 *prev, "Previous call of '%s'"_en_US); 3075 } 3076 EraseSymbol(name); 3077 } 3078 } 3079 } 3080 3081 Symbol &SubprogramVisitor::PushSubprogramScope( 3082 const parser::Name &name, Symbol::Flag subpFlag) { 3083 auto *symbol{GetSpecificFromGeneric(name)}; 3084 if (!symbol) { 3085 CheckExtantExternal(name, subpFlag); 3086 symbol = &MakeSymbol(name, SubprogramDetails{}); 3087 } 3088 symbol->set(subpFlag); 3089 PushScope(Scope::Kind::Subprogram, symbol); 3090 auto &details{symbol->get<SubprogramDetails>()}; 3091 if (inInterfaceBlock()) { 3092 details.set_isInterface(); 3093 if (!isAbstract()) { 3094 MakeExternal(*symbol); 3095 } 3096 if (isGeneric()) { 3097 GetGenericDetails().AddSpecificProc(*symbol, name.source); 3098 } 3099 set_inheritFromParent(false); 3100 } 3101 FindSymbol(name)->set(subpFlag); // PushScope() created symbol 3102 return *symbol; 3103 } 3104 3105 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) { 3106 if (auto *prev{FindSymbol(name)}) { 3107 if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) { 3108 if (prev->test(Symbol::Flag::Subroutine) || 3109 prev->test(Symbol::Flag::Function)) { 3110 Say2(name, "BLOCK DATA '%s' has been called"_err_en_US, *prev, 3111 "Previous call of '%s'"_en_US); 3112 } 3113 EraseSymbol(name); 3114 } 3115 } 3116 if (name.source.empty()) { 3117 // Don't let unnamed BLOCK DATA conflict with unnamed PROGRAM 3118 PushScope(Scope::Kind::BlockData, nullptr); 3119 } else { 3120 PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{})); 3121 } 3122 } 3123 3124 // If name is a generic, return specific subprogram with the same name. 3125 Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) { 3126 if (auto *symbol{FindSymbol(name)}) { 3127 if (auto *details{symbol->detailsIf<GenericDetails>()}) { 3128 // found generic, want subprogram 3129 auto *specific{details->specific()}; 3130 if (!specific) { 3131 specific = 3132 &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{}); 3133 details->set_specific(Resolve(name, *specific)); 3134 } else if (isGeneric()) { 3135 SayAlreadyDeclared(name, *specific); 3136 } 3137 if (!specific->has<SubprogramDetails>()) { 3138 specific->set_details(SubprogramDetails{}); 3139 } 3140 return specific; 3141 } 3142 } 3143 return nullptr; 3144 } 3145 3146 // DeclarationVisitor implementation 3147 3148 bool DeclarationVisitor::BeginDecl() { 3149 BeginDeclTypeSpec(); 3150 BeginArraySpec(); 3151 return BeginAttrs(); 3152 } 3153 void DeclarationVisitor::EndDecl() { 3154 EndDeclTypeSpec(); 3155 EndArraySpec(); 3156 EndAttrs(); 3157 } 3158 3159 bool DeclarationVisitor::CheckUseError(const parser::Name &name) { 3160 const auto *details{name.symbol->detailsIf<UseErrorDetails>()}; 3161 if (!details) { 3162 return false; 3163 } 3164 Message &msg{Say(name, "Reference to '%s' is ambiguous"_err_en_US)}; 3165 for (const auto &[location, module] : details->occurrences()) { 3166 msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, 3167 name.source, module->GetName().value()); 3168 } 3169 return true; 3170 } 3171 3172 // Report error if accessibility of symbol doesn't match isPrivate. 3173 void DeclarationVisitor::CheckAccessibility( 3174 const SourceName &name, bool isPrivate, Symbol &symbol) { 3175 if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) { 3176 Say2(name, 3177 "'%s' does not have the same accessibility as its previous declaration"_err_en_US, 3178 symbol, "Previous declaration of '%s'"_en_US); 3179 } 3180 } 3181 3182 void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) { 3183 if (!GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { // C702 3184 if (const auto *typeSpec{GetDeclTypeSpec()}) { 3185 if (typeSpec->category() == DeclTypeSpec::Character) { 3186 if (typeSpec->characterTypeSpec().length().isDeferred()) { 3187 Say("The type parameter LEN cannot be deferred without" 3188 " the POINTER or ALLOCATABLE attribute"_err_en_US); 3189 } 3190 } else if (const DerivedTypeSpec * derivedSpec{typeSpec->AsDerived()}) { 3191 for (const auto &pair : derivedSpec->parameters()) { 3192 if (pair.second.isDeferred()) { 3193 Say(currStmtSource().value(), 3194 "The value of type parameter '%s' cannot be deferred" 3195 " without the POINTER or ALLOCATABLE attribute"_err_en_US, 3196 pair.first); 3197 } 3198 } 3199 } 3200 } 3201 } 3202 EndDecl(); 3203 } 3204 3205 void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) { 3206 DeclareObjectEntity(std::get<parser::Name>(x.t)); 3207 } 3208 void DeclarationVisitor::Post(const parser::CodimensionDecl &x) { 3209 DeclareObjectEntity(std::get<parser::Name>(x.t)); 3210 } 3211 3212 bool DeclarationVisitor::Pre(const parser::Initialization &) { 3213 // Defer inspection of initializers to Initialization() so that the 3214 // symbol being initialized will be available within the initialization 3215 // expression. 3216 return false; 3217 } 3218 3219 void DeclarationVisitor::Post(const parser::EntityDecl &x) { 3220 // TODO: may be under StructureStmt 3221 const auto &name{std::get<parser::ObjectName>(x.t)}; 3222 Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}}; 3223 Symbol &symbol{DeclareUnknownEntity(name, attrs)}; 3224 symbol.ReplaceName(name.source); 3225 if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { 3226 if (ConvertToObjectEntity(symbol)) { 3227 Initialization(name, *init, false); 3228 } 3229 } else if (attrs.test(Attr::PARAMETER)) { // C882, C883 3230 Say(name, "Missing initialization for parameter '%s'"_err_en_US); 3231 } 3232 } 3233 3234 void DeclarationVisitor::Post(const parser::PointerDecl &x) { 3235 const auto &name{std::get<parser::Name>(x.t)}; 3236 Symbol &symbol{DeclareUnknownEntity(name, Attrs{Attr::POINTER})}; 3237 symbol.ReplaceName(name.source); 3238 } 3239 3240 bool DeclarationVisitor::Pre(const parser::BindEntity &x) { 3241 auto kind{std::get<parser::BindEntity::Kind>(x.t)}; 3242 auto &name{std::get<parser::Name>(x.t)}; 3243 Symbol *symbol; 3244 if (kind == parser::BindEntity::Kind::Object) { 3245 symbol = &HandleAttributeStmt(Attr::BIND_C, name); 3246 } else { 3247 symbol = &MakeCommonBlockSymbol(name); 3248 symbol->attrs().set(Attr::BIND_C); 3249 } 3250 SetBindNameOn(*symbol); 3251 return false; 3252 } 3253 bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { 3254 auto &name{std::get<parser::NamedConstant>(x.t).v}; 3255 auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)}; 3256 if (!ConvertToObjectEntity(symbol) || 3257 symbol.test(Symbol::Flag::CrayPointer) || 3258 symbol.test(Symbol::Flag::CrayPointee)) { 3259 SayWithDecl( 3260 name, symbol, "PARAMETER attribute not allowed on '%s'"_err_en_US); 3261 return false; 3262 } 3263 const auto &expr{std::get<parser::ConstantExpr>(x.t)}; 3264 ApplyImplicitRules(symbol); 3265 Walk(expr); 3266 if (auto converted{ 3267 EvaluateConvertedExpr(symbol, expr, expr.thing.value().source)}) { 3268 symbol.get<ObjectEntityDetails>().set_init(std::move(*converted)); 3269 } 3270 return false; 3271 } 3272 bool DeclarationVisitor::Pre(const parser::NamedConstant &x) { 3273 const parser::Name &name{x.v}; 3274 if (!FindSymbol(name)) { 3275 Say(name, "Named constant '%s' not found"_err_en_US); 3276 } else { 3277 CheckUseError(name); 3278 } 3279 return false; 3280 } 3281 3282 bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) { 3283 const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v}; 3284 Symbol *symbol{FindSymbol(name)}; 3285 if (symbol) { 3286 // Contrary to named constants appearing in a PARAMETER statement, 3287 // enumerator names should not have their type, dimension or any other 3288 // attributes defined before they are declared in the enumerator statement. 3289 // This is not explicitly forbidden by the standard, but they are scalars 3290 // which type is left for the compiler to chose, so do not let users try to 3291 // tamper with that. 3292 SayAlreadyDeclared(name, *symbol); 3293 symbol = nullptr; 3294 } else { 3295 // Enumerators are treated as PARAMETER (section 7.6 paragraph (4)) 3296 symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{}); 3297 symbol->SetType(context().MakeNumericType( 3298 TypeCategory::Integer, evaluate::CInteger::kind)); 3299 } 3300 3301 if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>( 3302 enumerator.t)}) { 3303 Walk(*init); // Resolve names in expression before evaluation. 3304 if (auto value{EvaluateInt64(context(), *init)}) { 3305 // Cast all init expressions to C_INT so that they can then be 3306 // safely incremented (see 7.6 Note 2). 3307 enumerationState_.value = static_cast<int>(*value); 3308 } else { 3309 Say(name, 3310 "Enumerator value could not be computed " 3311 "from the given expression"_err_en_US); 3312 // Prevent resolution of next enumerators value 3313 enumerationState_.value = std::nullopt; 3314 } 3315 } 3316 3317 if (symbol) { 3318 if (enumerationState_.value) { 3319 symbol->get<ObjectEntityDetails>().set_init(SomeExpr{ 3320 evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}}); 3321 } else { 3322 context().SetError(*symbol); 3323 } 3324 } 3325 3326 if (enumerationState_.value) { 3327 (*enumerationState_.value)++; 3328 } 3329 return false; 3330 } 3331 3332 void DeclarationVisitor::Post(const parser::EnumDef &) { 3333 enumerationState_ = EnumeratorState{}; 3334 } 3335 3336 bool DeclarationVisitor::Pre(const parser::AccessSpec &x) { 3337 Attr attr{AccessSpecToAttr(x)}; 3338 if (!NonDerivedTypeScope().IsModule()) { // C817 3339 Say(currStmtSource().value(), 3340 "%s attribute may only appear in the specification part of a module"_err_en_US, 3341 EnumToString(attr)); 3342 } 3343 CheckAndSet(attr); 3344 return false; 3345 } 3346 3347 bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) { 3348 return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v); 3349 } 3350 bool DeclarationVisitor::Pre(const parser::ContiguousStmt &x) { 3351 return HandleAttributeStmt(Attr::CONTIGUOUS, x.v); 3352 } 3353 bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) { 3354 HandleAttributeStmt(Attr::EXTERNAL, x.v); 3355 for (const auto &name : x.v) { 3356 auto *symbol{FindSymbol(name)}; 3357 if (!ConvertToProcEntity(*symbol)) { 3358 SayWithDecl( 3359 name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US); 3360 } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840 3361 Say(symbol->name(), 3362 "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US, 3363 symbol->name()); 3364 } 3365 } 3366 return false; 3367 } 3368 bool DeclarationVisitor::Pre(const parser::IntentStmt &x) { 3369 auto &intentSpec{std::get<parser::IntentSpec>(x.t)}; 3370 auto &names{std::get<std::list<parser::Name>>(x.t)}; 3371 return CheckNotInBlock("INTENT") && // C1107 3372 HandleAttributeStmt(IntentSpecToAttr(intentSpec), names); 3373 } 3374 bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) { 3375 HandleAttributeStmt(Attr::INTRINSIC, x.v); 3376 for (const auto &name : x.v) { 3377 auto *symbol{FindSymbol(name)}; 3378 if (!ConvertToProcEntity(*symbol)) { 3379 SayWithDecl( 3380 name, *symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US); 3381 } else if (symbol->attrs().test(Attr::EXTERNAL)) { // C840 3382 Say(symbol->name(), 3383 "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, 3384 symbol->name()); 3385 } 3386 } 3387 return false; 3388 } 3389 bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) { 3390 return CheckNotInBlock("OPTIONAL") && // C1107 3391 HandleAttributeStmt(Attr::OPTIONAL, x.v); 3392 } 3393 bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) { 3394 return HandleAttributeStmt(Attr::PROTECTED, x.v); 3395 } 3396 bool DeclarationVisitor::Pre(const parser::ValueStmt &x) { 3397 return CheckNotInBlock("VALUE") && // C1107 3398 HandleAttributeStmt(Attr::VALUE, x.v); 3399 } 3400 bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) { 3401 return HandleAttributeStmt(Attr::VOLATILE, x.v); 3402 } 3403 // Handle a statement that sets an attribute on a list of names. 3404 bool DeclarationVisitor::HandleAttributeStmt( 3405 Attr attr, const std::list<parser::Name> &names) { 3406 for (const auto &name : names) { 3407 HandleAttributeStmt(attr, name); 3408 } 3409 return false; 3410 } 3411 Symbol &DeclarationVisitor::HandleAttributeStmt( 3412 Attr attr, const parser::Name &name) { 3413 if (attr == Attr::INTRINSIC && !IsIntrinsic(name.source, std::nullopt)) { 3414 Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US); 3415 } 3416 auto *symbol{FindInScope(currScope(), name)}; 3417 if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) { 3418 // these can be set on a symbol that is host-assoc or use-assoc 3419 if (!symbol && 3420 (currScope().kind() == Scope::Kind::Subprogram || 3421 currScope().kind() == Scope::Kind::Block)) { 3422 if (auto *hostSymbol{FindSymbol(name)}) { 3423 symbol = &MakeHostAssocSymbol(name, *hostSymbol); 3424 } 3425 } 3426 } else if (symbol && symbol->has<UseDetails>()) { 3427 Say(currStmtSource().value(), 3428 "Cannot change %s attribute on use-associated '%s'"_err_en_US, 3429 EnumToString(attr), name.source); 3430 return *symbol; 3431 } 3432 if (!symbol) { 3433 symbol = &MakeSymbol(name, EntityDetails{}); 3434 } 3435 symbol->attrs().set(attr); 3436 symbol->attrs() = HandleSaveName(name.source, symbol->attrs()); 3437 return *symbol; 3438 } 3439 // C1107 3440 bool DeclarationVisitor::CheckNotInBlock(const char *stmt) { 3441 if (currScope().kind() == Scope::Kind::Block) { 3442 Say(MessageFormattedText{ 3443 "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt}); 3444 return false; 3445 } else { 3446 return true; 3447 } 3448 } 3449 3450 void DeclarationVisitor::Post(const parser::ObjectDecl &x) { 3451 CHECK(objectDeclAttr_); 3452 const auto &name{std::get<parser::ObjectName>(x.t)}; 3453 DeclareObjectEntity(name, Attrs{*objectDeclAttr_}); 3454 } 3455 3456 // Declare an entity not yet known to be an object or proc. 3457 Symbol &DeclarationVisitor::DeclareUnknownEntity( 3458 const parser::Name &name, Attrs attrs) { 3459 if (!arraySpec().empty() || !coarraySpec().empty()) { 3460 return DeclareObjectEntity(name, attrs); 3461 } else { 3462 Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)}; 3463 if (auto *type{GetDeclTypeSpec()}) { 3464 SetType(name, *type); 3465 } 3466 charInfo_.length.reset(); 3467 SetBindNameOn(symbol); 3468 if (symbol.attrs().test(Attr::EXTERNAL)) { 3469 ConvertToProcEntity(symbol); 3470 } 3471 return symbol; 3472 } 3473 } 3474 3475 Symbol &DeclarationVisitor::DeclareProcEntity( 3476 const parser::Name &name, Attrs attrs, const ProcInterface &interface) { 3477 Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)}; 3478 if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) { 3479 if (details->IsInterfaceSet()) { 3480 SayWithDecl(name, symbol, 3481 "The interface for procedure '%s' has already been " 3482 "declared"_err_en_US); 3483 context().SetError(symbol); 3484 } else { 3485 if (interface.type()) { 3486 symbol.set(Symbol::Flag::Function); 3487 } else if (interface.symbol()) { 3488 if (interface.symbol()->test(Symbol::Flag::Function)) { 3489 symbol.set(Symbol::Flag::Function); 3490 } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) { 3491 symbol.set(Symbol::Flag::Subroutine); 3492 } 3493 } 3494 details->set_interface(interface); 3495 SetBindNameOn(symbol); 3496 SetPassNameOn(symbol); 3497 } 3498 } 3499 return symbol; 3500 } 3501 3502 Symbol &DeclarationVisitor::DeclareObjectEntity( 3503 const parser::Name &name, Attrs attrs) { 3504 Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)}; 3505 if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { 3506 if (auto *type{GetDeclTypeSpec()}) { 3507 SetType(name, *type); 3508 } 3509 if (!arraySpec().empty()) { 3510 if (details->IsArray()) { 3511 if (!context().HasError(symbol)) { 3512 Say(name, 3513 "The dimensions of '%s' have already been declared"_err_en_US); 3514 context().SetError(symbol); 3515 } 3516 } else { 3517 details->set_shape(arraySpec()); 3518 } 3519 } 3520 if (!coarraySpec().empty()) { 3521 if (details->IsCoarray()) { 3522 if (!context().HasError(symbol)) { 3523 Say(name, 3524 "The codimensions of '%s' have already been declared"_err_en_US); 3525 context().SetError(symbol); 3526 } 3527 } else { 3528 details->set_coshape(coarraySpec()); 3529 } 3530 } 3531 SetBindNameOn(symbol); 3532 } 3533 ClearArraySpec(); 3534 ClearCoarraySpec(); 3535 charInfo_.length.reset(); 3536 return symbol; 3537 } 3538 3539 void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { 3540 SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); 3541 } 3542 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) { 3543 SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); 3544 } 3545 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) { 3546 SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind)); 3547 } 3548 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) { 3549 SetDeclTypeSpec(MakeLogicalType(x.kind)); 3550 } 3551 void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) { 3552 if (!charInfo_.length) { 3553 charInfo_.length = ParamValue{1, common::TypeParamAttr::Len}; 3554 } 3555 if (!charInfo_.kind) { 3556 charInfo_.kind = 3557 KindExpr{context().GetDefaultKind(TypeCategory::Character)}; 3558 } 3559 SetDeclTypeSpec(currScope().MakeCharacterType( 3560 std::move(*charInfo_.length), std::move(*charInfo_.kind))); 3561 charInfo_ = {}; 3562 } 3563 void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) { 3564 charInfo_.kind = EvaluateSubscriptIntExpr(x.kind); 3565 std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)}; 3566 if (intKind && 3567 !evaluate::IsValidKindOfIntrinsicType( 3568 TypeCategory::Character, *intKind)) { // C715, C719 3569 Say(currStmtSource().value(), 3570 "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind); 3571 charInfo_.kind = std::nullopt; // prevent further errors 3572 } 3573 if (x.length) { 3574 charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len); 3575 } 3576 } 3577 void DeclarationVisitor::Post(const parser::CharLength &x) { 3578 if (const auto *length{std::get_if<std::uint64_t>(&x.u)}) { 3579 charInfo_.length = ParamValue{ 3580 static_cast<ConstantSubscript>(*length), common::TypeParamAttr::Len}; 3581 } else { 3582 charInfo_.length = GetParamValue( 3583 std::get<parser::TypeParamValue>(x.u), common::TypeParamAttr::Len); 3584 } 3585 } 3586 void DeclarationVisitor::Post(const parser::LengthSelector &x) { 3587 if (const auto *param{std::get_if<parser::TypeParamValue>(&x.u)}) { 3588 charInfo_.length = GetParamValue(*param, common::TypeParamAttr::Len); 3589 } 3590 } 3591 3592 bool DeclarationVisitor::Pre(const parser::KindParam &x) { 3593 if (const auto *kind{std::get_if< 3594 parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>( 3595 &x.u)}) { 3596 const parser::Name &name{kind->thing.thing.thing}; 3597 if (!FindSymbol(name)) { 3598 Say(name, "Parameter '%s' not found"_err_en_US); 3599 } 3600 } 3601 return false; 3602 } 3603 3604 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) { 3605 CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived); 3606 return true; 3607 } 3608 3609 void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) { 3610 const parser::Name &derivedName{std::get<parser::Name>(type.derived.t)}; 3611 if (const Symbol * derivedSymbol{derivedName.symbol}) { 3612 CheckForAbstractType(*derivedSymbol); // C706 3613 } 3614 } 3615 3616 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Class &) { 3617 SetDeclTypeSpecCategory(DeclTypeSpec::Category::ClassDerived); 3618 return true; 3619 } 3620 3621 void DeclarationVisitor::Post( 3622 const parser::DeclarationTypeSpec::Class &parsedClass) { 3623 const auto &typeName{std::get<parser::Name>(parsedClass.derived.t)}; 3624 if (auto spec{ResolveDerivedType(typeName)}; 3625 spec && !IsExtensibleType(&*spec)) { // C705 3626 SayWithDecl(typeName, *typeName.symbol, 3627 "Non-extensible derived type '%s' may not be used with CLASS" 3628 " keyword"_err_en_US); 3629 } 3630 } 3631 3632 bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) { 3633 // TODO 3634 return true; 3635 } 3636 3637 void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { 3638 const auto &typeName{std::get<parser::Name>(x.t)}; 3639 auto spec{ResolveDerivedType(typeName)}; 3640 if (!spec) { 3641 return; 3642 } 3643 bool seenAnyName{false}; 3644 for (const auto &typeParamSpec : 3645 std::get<std::list<parser::TypeParamSpec>>(x.t)) { 3646 const auto &optKeyword{ 3647 std::get<std::optional<parser::Keyword>>(typeParamSpec.t)}; 3648 std::optional<SourceName> name; 3649 if (optKeyword) { 3650 seenAnyName = true; 3651 name = optKeyword->v.source; 3652 } else if (seenAnyName) { 3653 Say(typeName.source, "Type parameter value must have a name"_err_en_US); 3654 continue; 3655 } 3656 const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)}; 3657 // The expressions in a derived type specifier whose values define 3658 // non-defaulted type parameters are evaluated (folded) in the enclosing 3659 // scope. The KIND/LEN distinction is resolved later in 3660 // DerivedTypeSpec::CookParameters(). 3661 ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)}; 3662 if (!param.isExplicit() || param.GetExplicit()) { 3663 spec->AddRawParamValue(optKeyword, std::move(param)); 3664 } 3665 } 3666 3667 // The DerivedTypeSpec *spec is used initially as a search key. 3668 // If it turns out to have the same name and actual parameter 3669 // value expressions as another DerivedTypeSpec in the current 3670 // scope does, then we'll use that extant spec; otherwise, when this 3671 // spec is distinct from all derived types previously instantiated 3672 // in the current scope, this spec will be moved into that collection. 3673 const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()}; 3674 auto category{GetDeclTypeSpecCategory()}; 3675 if (dtDetails.isForwardReferenced()) { 3676 DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; 3677 SetDeclTypeSpec(type); 3678 return; 3679 } 3680 // Normalize parameters to produce a better search key. 3681 spec->CookParameters(GetFoldingContext()); 3682 if (!spec->MightBeParameterized()) { 3683 spec->EvaluateParameters(context()); 3684 } 3685 if (const DeclTypeSpec * 3686 extant{currScope().FindInstantiatedDerivedType(*spec, category)}) { 3687 // This derived type and parameter expressions (if any) are already present 3688 // in this scope. 3689 SetDeclTypeSpec(*extant); 3690 } else { 3691 DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))}; 3692 DerivedTypeSpec &derived{type.derivedTypeSpec()}; 3693 if (derived.MightBeParameterized() && 3694 currScope().IsParameterizedDerivedType()) { 3695 // Defer instantiation; use the derived type's definition's scope. 3696 derived.set_scope(DEREF(spec->typeSymbol().scope())); 3697 } else { 3698 auto restorer{ 3699 GetFoldingContext().messages().SetLocation(currStmtSource().value())}; 3700 derived.Instantiate(currScope(), context()); 3701 } 3702 SetDeclTypeSpec(type); 3703 } 3704 // Capture the DerivedTypeSpec in the parse tree for use in building 3705 // structure constructor expressions. 3706 x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec(); 3707 } 3708 3709 // The descendents of DerivedTypeDef in the parse tree are visited directly 3710 // in this Pre() routine so that recursive use of the derived type can be 3711 // supported in the components. 3712 bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { 3713 auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)}; 3714 Walk(stmt); 3715 Walk(std::get<std::list<parser::Statement<parser::TypeParamDefStmt>>>(x.t)); 3716 auto &scope{currScope()}; 3717 CHECK(scope.symbol()); 3718 CHECK(scope.symbol()->scope() == &scope); 3719 auto &details{scope.symbol()->get<DerivedTypeDetails>()}; 3720 std::set<SourceName> paramNames; 3721 for (auto ¶mName : std::get<std::list<parser::Name>>(stmt.statement.t)) { 3722 details.add_paramName(paramName.source); 3723 auto *symbol{FindInScope(scope, paramName)}; 3724 if (!symbol) { 3725 Say(paramName, 3726 "No definition found for type parameter '%s'"_err_en_US); // C742 3727 // No symbol for a type param. Create one and mark it as containing an 3728 // error to improve subsequent semantic processing 3729 BeginAttrs(); 3730 Symbol *typeParam{MakeTypeSymbol( 3731 paramName, TypeParamDetails{common::TypeParamAttr::Len})}; 3732 context().SetError(*typeParam); 3733 EndAttrs(); 3734 } else if (!symbol->has<TypeParamDetails>()) { 3735 Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US, 3736 *symbol, "Definition of '%s'"_en_US); // C741 3737 } 3738 if (!paramNames.insert(paramName.source).second) { 3739 Say(paramName, 3740 "Duplicate type parameter name: '%s'"_err_en_US); // C731 3741 } 3742 } 3743 for (const auto &[name, symbol] : currScope()) { 3744 if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) { 3745 SayDerivedType(name, 3746 "'%s' is not a type parameter of this derived type"_err_en_US, 3747 currScope()); // C741 3748 } 3749 } 3750 Walk(std::get<std::list<parser::Statement<parser::PrivateOrSequence>>>(x.t)); 3751 const auto &componentDefs{ 3752 std::get<std::list<parser::Statement<parser::ComponentDefStmt>>>(x.t)}; 3753 Walk(componentDefs); 3754 if (derivedTypeInfo_.sequence) { 3755 details.set_sequence(true); 3756 if (componentDefs.empty()) { // C740 3757 Say(stmt.source, 3758 "A sequence type must have at least one component"_err_en_US); 3759 } 3760 if (!details.paramNames().empty()) { // C740 3761 Say(stmt.source, 3762 "A sequence type may not have type parameters"_err_en_US); 3763 } 3764 if (derivedTypeInfo_.extends) { // C735 3765 Say(stmt.source, 3766 "A sequence type may not have the EXTENDS attribute"_err_en_US); 3767 } else { 3768 for (const auto &componentName : details.componentNames()) { 3769 const Symbol *componentSymbol{scope.FindComponent(componentName)}; 3770 if (componentSymbol && componentSymbol->has<ObjectEntityDetails>()) { 3771 const auto &componentDetails{ 3772 componentSymbol->get<ObjectEntityDetails>()}; 3773 const DeclTypeSpec *componentType{componentDetails.type()}; 3774 if (componentType && // C740 3775 !componentType->AsIntrinsic() && 3776 !componentType->IsSequenceType()) { 3777 Say(componentSymbol->name(), 3778 "A sequence type data component must either be of an" 3779 " intrinsic type or a derived sequence type"_err_en_US); 3780 } 3781 } 3782 } 3783 } 3784 } 3785 Walk(std::get<std::optional<parser::TypeBoundProcedurePart>>(x.t)); 3786 Walk(std::get<parser::Statement<parser::EndTypeStmt>>(x.t)); 3787 derivedTypeInfo_ = {}; 3788 PopScope(); 3789 return false; 3790 } 3791 bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &) { 3792 return BeginAttrs(); 3793 } 3794 void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { 3795 auto &name{std::get<parser::Name>(x.t)}; 3796 // Resolve the EXTENDS() clause before creating the derived 3797 // type's symbol to foil attempts to recursively extend a type. 3798 auto *extendsName{derivedTypeInfo_.extends}; 3799 std::optional<DerivedTypeSpec> extendsType{ 3800 ResolveExtendsType(name, extendsName)}; 3801 auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})}; 3802 symbol.ReplaceName(name.source); 3803 derivedTypeInfo_.type = &symbol; 3804 PushScope(Scope::Kind::DerivedType, &symbol); 3805 if (extendsType) { 3806 // Declare the "parent component"; private if the type is. 3807 // Any symbol stored in the EXTENDS() clause is temporarily 3808 // hidden so that a new symbol can be created for the parent 3809 // component without producing spurious errors about already 3810 // existing. 3811 const Symbol &extendsSymbol{extendsType->typeSymbol()}; 3812 auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; 3813 if (OkToAddComponent(*extendsName, &extendsSymbol)) { 3814 auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})}; 3815 comp.attrs().set( 3816 Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE)); 3817 comp.set(Symbol::Flag::ParentComp); 3818 DeclTypeSpec &type{currScope().MakeDerivedType( 3819 DeclTypeSpec::TypeDerived, std::move(*extendsType))}; 3820 type.derivedTypeSpec().set_scope(*extendsSymbol.scope()); 3821 comp.SetType(type); 3822 DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()}; 3823 details.add_component(comp); 3824 } 3825 } 3826 EndAttrs(); 3827 } 3828 3829 void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) { 3830 auto *type{GetDeclTypeSpec()}; 3831 auto attr{std::get<common::TypeParamAttr>(x.t)}; 3832 for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) { 3833 auto &name{std::get<parser::Name>(decl.t)}; 3834 if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{attr})}) { 3835 SetType(name, *type); 3836 if (auto &init{ 3837 std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) { 3838 if (auto maybeExpr{EvaluateConvertedExpr( 3839 *symbol, *init, init->thing.thing.thing.value().source)}) { 3840 auto *intExpr{std::get_if<SomeIntExpr>(&maybeExpr->u)}; 3841 CHECK(intExpr); 3842 symbol->get<TypeParamDetails>().set_init(std::move(*intExpr)); 3843 } 3844 } 3845 } 3846 } 3847 EndDecl(); 3848 } 3849 bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) { 3850 if (derivedTypeInfo_.extends) { 3851 Say(currStmtSource().value(), 3852 "Attribute 'EXTENDS' cannot be used more than once"_err_en_US); 3853 } else { 3854 derivedTypeInfo_.extends = &x.v; 3855 } 3856 return false; 3857 } 3858 3859 bool DeclarationVisitor::Pre(const parser::PrivateStmt &) { 3860 if (!currScope().parent().IsModule()) { 3861 Say("PRIVATE is only allowed in a derived type that is" 3862 " in a module"_err_en_US); // C766 3863 } else if (derivedTypeInfo_.sawContains) { 3864 derivedTypeInfo_.privateBindings = true; 3865 } else if (!derivedTypeInfo_.privateComps) { 3866 derivedTypeInfo_.privateComps = true; 3867 } else { 3868 Say("PRIVATE may not appear more than once in" 3869 " derived type components"_en_US); // C738 3870 } 3871 return false; 3872 } 3873 bool DeclarationVisitor::Pre(const parser::SequenceStmt &) { 3874 if (derivedTypeInfo_.sequence) { 3875 Say("SEQUENCE may not appear more than once in" 3876 " derived type components"_en_US); // C738 3877 } 3878 derivedTypeInfo_.sequence = true; 3879 return false; 3880 } 3881 void DeclarationVisitor::Post(const parser::ComponentDecl &x) { 3882 const auto &name{std::get<parser::Name>(x.t)}; 3883 auto attrs{GetAttrs()}; 3884 if (derivedTypeInfo_.privateComps && 3885 !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { 3886 attrs.set(Attr::PRIVATE); 3887 } 3888 if (const auto *declType{GetDeclTypeSpec()}) { 3889 if (const auto *derived{declType->AsDerived()}) { 3890 if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { 3891 if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 3892 Say("Recursive use of the derived type requires " 3893 "POINTER or ALLOCATABLE"_err_en_US); 3894 } 3895 } 3896 if (!coarraySpec().empty()) { // C747 3897 if (IsTeamType(derived)) { 3898 Say("A coarray component may not be of type TEAM_TYPE from " 3899 "ISO_FORTRAN_ENV"_err_en_US); 3900 } else { 3901 if (IsIsoCType(derived)) { 3902 Say("A coarray component may not be of type C_PTR or C_FUNPTR from " 3903 "ISO_C_BINDING"_err_en_US); 3904 } 3905 } 3906 } 3907 if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748 3908 std::string ultimateName{it.BuildResultDesignatorName()}; 3909 // Strip off the leading "%" 3910 if (ultimateName.length() > 1) { 3911 ultimateName.erase(0, 1); 3912 if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { 3913 evaluate::AttachDeclaration( 3914 Say(name.source, 3915 "A component with a POINTER or ALLOCATABLE attribute may " 3916 "not " 3917 "be of a type with a coarray ultimate component (named " 3918 "'%s')"_err_en_US, 3919 ultimateName), 3920 derived->typeSymbol()); 3921 } 3922 if (!arraySpec().empty() || !coarraySpec().empty()) { 3923 evaluate::AttachDeclaration( 3924 Say(name.source, 3925 "An array or coarray component may not be of a type with a " 3926 "coarray ultimate component (named '%s')"_err_en_US, 3927 ultimateName), 3928 derived->typeSymbol()); 3929 } 3930 } 3931 } 3932 } 3933 } 3934 if (OkToAddComponent(name)) { 3935 auto &symbol{DeclareObjectEntity(name, attrs)}; 3936 if (symbol.has<ObjectEntityDetails>()) { 3937 if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) { 3938 Initialization(name, *init, true); 3939 } 3940 } 3941 currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); 3942 } 3943 ClearArraySpec(); 3944 ClearCoarraySpec(); 3945 } 3946 bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) { 3947 CHECK(!interfaceName_); 3948 return BeginDecl(); 3949 } 3950 void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) { 3951 interfaceName_ = nullptr; 3952 EndDecl(); 3953 } 3954 bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) { 3955 // Overrides parse tree traversal so as to handle attributes first, 3956 // so POINTER & ALLOCATABLE enable forward references to derived types. 3957 Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t)); 3958 set_allowForwardReferenceToDerivedType( 3959 GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})); 3960 Walk(std::get<parser::DeclarationTypeSpec>(x.t)); 3961 set_allowForwardReferenceToDerivedType(false); 3962 Walk(std::get<std::list<parser::ComponentDecl>>(x.t)); 3963 return false; 3964 } 3965 bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) { 3966 CHECK(!interfaceName_); 3967 return true; 3968 } 3969 void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) { 3970 interfaceName_ = nullptr; 3971 } 3972 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) { 3973 if (auto *name{std::get_if<parser::Name>(&x.u)}) { 3974 return !NameIsKnownOrIntrinsic(*name); 3975 } 3976 return true; 3977 } 3978 void DeclarationVisitor::Post(const parser::ProcInterface &x) { 3979 if (auto *name{std::get_if<parser::Name>(&x.u)}) { 3980 interfaceName_ = name; 3981 NoteInterfaceName(*name); 3982 } 3983 } 3984 3985 void DeclarationVisitor::Post(const parser::ProcDecl &x) { 3986 const auto &name{std::get<parser::Name>(x.t)}; 3987 ProcInterface interface; 3988 if (interfaceName_) { 3989 interface.set_symbol(*interfaceName_->symbol); 3990 } else if (auto *type{GetDeclTypeSpec()}) { 3991 interface.set_type(*type); 3992 } 3993 auto attrs{HandleSaveName(name.source, GetAttrs())}; 3994 DerivedTypeDetails *dtDetails{nullptr}; 3995 if (Symbol * symbol{currScope().symbol()}) { 3996 dtDetails = symbol->detailsIf<DerivedTypeDetails>(); 3997 } 3998 if (!dtDetails) { 3999 attrs.set(Attr::EXTERNAL); 4000 } 4001 Symbol &symbol{DeclareProcEntity(name, attrs, interface)}; 4002 symbol.ReplaceName(name.source); 4003 if (dtDetails) { 4004 dtDetails->add_component(symbol); 4005 } 4006 } 4007 4008 bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) { 4009 derivedTypeInfo_.sawContains = true; 4010 return true; 4011 } 4012 4013 // Resolve binding names from type-bound generics, saved in genericBindings_. 4014 void DeclarationVisitor::Post(const parser::TypeBoundProcedurePart &) { 4015 // track specifics seen for the current generic to detect duplicates: 4016 const Symbol *currGeneric{nullptr}; 4017 std::set<SourceName> specifics; 4018 for (const auto &[generic, bindingName] : genericBindings_) { 4019 if (generic != currGeneric) { 4020 currGeneric = generic; 4021 specifics.clear(); 4022 } 4023 auto [it, inserted]{specifics.insert(bindingName->source)}; 4024 if (!inserted) { 4025 Say(*bindingName, // C773 4026 "Binding name '%s' was already specified for generic '%s'"_err_en_US, 4027 bindingName->source, generic->name()) 4028 .Attach(*it, "Previous specification of '%s'"_en_US, *it); 4029 continue; 4030 } 4031 auto *symbol{FindInTypeOrParents(*bindingName)}; 4032 if (!symbol) { 4033 Say(*bindingName, // C772 4034 "Binding name '%s' not found in this derived type"_err_en_US); 4035 } else if (!symbol->has<ProcBindingDetails>()) { 4036 SayWithDecl(*bindingName, *symbol, // C772 4037 "'%s' is not the name of a specific binding of this type"_err_en_US); 4038 } else { 4039 generic->get<GenericDetails>().AddSpecificProc( 4040 *symbol, bindingName->source); 4041 } 4042 } 4043 genericBindings_.clear(); 4044 } 4045 4046 void DeclarationVisitor::Post(const parser::ContainsStmt &) { 4047 if (derivedTypeInfo_.sequence) { 4048 Say("A sequence type may not have a CONTAINS statement"_err_en_US); // C740 4049 } 4050 } 4051 4052 void DeclarationVisitor::Post( 4053 const parser::TypeBoundProcedureStmt::WithoutInterface &x) { 4054 if (GetAttrs().test(Attr::DEFERRED)) { // C783 4055 Say("DEFERRED is only allowed when an interface-name is provided"_err_en_US); 4056 } 4057 for (auto &declaration : x.declarations) { 4058 auto &bindingName{std::get<parser::Name>(declaration.t)}; 4059 auto &optName{std::get<std::optional<parser::Name>>(declaration.t)}; 4060 const parser::Name &procedureName{optName ? *optName : bindingName}; 4061 Symbol *procedure{FindSymbol(procedureName)}; 4062 if (!procedure) { 4063 procedure = NoteInterfaceName(procedureName); 4064 } 4065 if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) { 4066 SetPassNameOn(*s); 4067 if (GetAttrs().test(Attr::DEFERRED)) { 4068 context().SetError(*s); 4069 } 4070 } 4071 } 4072 } 4073 4074 void DeclarationVisitor::CheckBindings( 4075 const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { 4076 CHECK(currScope().IsDerivedType()); 4077 for (auto &declaration : tbps.declarations) { 4078 auto &bindingName{std::get<parser::Name>(declaration.t)}; 4079 if (Symbol * binding{FindInScope(currScope(), bindingName)}) { 4080 if (auto *details{binding->detailsIf<ProcBindingDetails>()}) { 4081 const Symbol *procedure{FindSubprogram(details->symbol())}; 4082 if (!CanBeTypeBoundProc(procedure)) { 4083 if (details->symbol().name() != binding->name()) { 4084 Say(binding->name(), 4085 "The binding of '%s' ('%s') must be either an accessible " 4086 "module procedure or an external procedure with " 4087 "an explicit interface"_err_en_US, 4088 binding->name(), details->symbol().name()); 4089 } else { 4090 Say(binding->name(), 4091 "'%s' must be either an accessible module procedure " 4092 "or an external procedure with an explicit interface"_err_en_US, 4093 binding->name()); 4094 } 4095 context().SetError(*binding); 4096 } 4097 } 4098 } 4099 } 4100 } 4101 4102 void DeclarationVisitor::Post( 4103 const parser::TypeBoundProcedureStmt::WithInterface &x) { 4104 if (!GetAttrs().test(Attr::DEFERRED)) { // C783 4105 Say("DEFERRED is required when an interface-name is provided"_err_en_US); 4106 } 4107 if (Symbol * interface{NoteInterfaceName(x.interfaceName)}) { 4108 for (auto &bindingName : x.bindingNames) { 4109 if (auto *s{ 4110 MakeTypeSymbol(bindingName, ProcBindingDetails{*interface})}) { 4111 SetPassNameOn(*s); 4112 if (!GetAttrs().test(Attr::DEFERRED)) { 4113 context().SetError(*s); 4114 } 4115 } 4116 } 4117 } 4118 } 4119 4120 void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) { 4121 if (currScope().IsDerivedType() && currScope().symbol()) { 4122 if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) { 4123 for (const auto &subrName : x.v) { 4124 if (const auto *name{ResolveName(subrName)}) { 4125 auto pair{ 4126 details->finals().emplace(name->source, DEREF(name->symbol))}; 4127 if (!pair.second) { // C787 4128 Say(name->source, 4129 "FINAL subroutine '%s' already appeared in this derived type"_err_en_US, 4130 name->source) 4131 .Attach(pair.first->first, 4132 "earlier appearance of this FINAL subroutine"_en_US); 4133 } 4134 } 4135 } 4136 } 4137 } 4138 } 4139 4140 bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { 4141 const auto &accessSpec{std::get<std::optional<parser::AccessSpec>>(x.t)}; 4142 const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)}; 4143 const auto &bindingNames{std::get<std::list<parser::Name>>(x.t)}; 4144 auto info{GenericSpecInfo{genericSpec.value()}}; 4145 SourceName symbolName{info.symbolName()}; 4146 bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private 4147 : derivedTypeInfo_.privateBindings}; 4148 auto *genericSymbol{info.FindInScope(context(), currScope())}; 4149 if (genericSymbol) { 4150 if (!genericSymbol->has<GenericDetails>()) { 4151 genericSymbol = nullptr; // MakeTypeSymbol will report the error below 4152 } 4153 } else { 4154 // look in parent types: 4155 Symbol *inheritedSymbol{nullptr}; 4156 for (const auto &name : info.GetAllNames(context())) { 4157 inheritedSymbol = currScope().FindComponent(SourceName{name}); 4158 if (inheritedSymbol) { 4159 break; 4160 } 4161 } 4162 if (inheritedSymbol && inheritedSymbol->has<GenericDetails>()) { 4163 CheckAccessibility(symbolName, isPrivate, *inheritedSymbol); // C771 4164 } 4165 } 4166 if (genericSymbol) { 4167 CheckAccessibility(symbolName, isPrivate, *genericSymbol); // C771 4168 } else { 4169 genericSymbol = MakeTypeSymbol(symbolName, GenericDetails{}); 4170 if (!genericSymbol) { 4171 return false; 4172 } 4173 if (isPrivate) { 4174 genericSymbol->attrs().set(Attr::PRIVATE); 4175 } 4176 } 4177 for (const parser::Name &bindingName : bindingNames) { 4178 genericBindings_.emplace(genericSymbol, &bindingName); 4179 } 4180 info.Resolve(genericSymbol); 4181 return false; 4182 } 4183 4184 bool DeclarationVisitor::Pre(const parser::AllocateStmt &) { 4185 BeginDeclTypeSpec(); 4186 return true; 4187 } 4188 void DeclarationVisitor::Post(const parser::AllocateStmt &) { 4189 EndDeclTypeSpec(); 4190 } 4191 4192 bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { 4193 auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)}; 4194 const DeclTypeSpec *type{ProcessTypeSpec(parsedType)}; 4195 if (!type) { 4196 return false; 4197 } 4198 const DerivedTypeSpec *spec{type->AsDerived()}; 4199 const Scope *typeScope{spec ? spec->scope() : nullptr}; 4200 if (!typeScope) { 4201 return false; 4202 } 4203 4204 // N.B C7102 is implicitly enforced by having inaccessible types not 4205 // being found in resolution. 4206 // More constraints are enforced in expression.cpp so that they 4207 // can apply to structure constructors that have been converted 4208 // from misparsed function references. 4209 for (const auto &component : 4210 std::get<std::list<parser::ComponentSpec>>(x.t)) { 4211 // Visit the component spec expression, but not the keyword, since 4212 // we need to resolve its symbol in the scope of the derived type. 4213 Walk(std::get<parser::ComponentDataSource>(component.t)); 4214 if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) { 4215 FindInTypeOrParents(*typeScope, kw->v); 4216 } 4217 } 4218 return false; 4219 } 4220 4221 bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) { 4222 for (const parser::BasedPointer &bp : x.v) { 4223 const parser::ObjectName &pointerName{std::get<0>(bp.t)}; 4224 const parser::ObjectName &pointeeName{std::get<1>(bp.t)}; 4225 auto *pointer{FindSymbol(pointerName)}; 4226 if (!pointer) { 4227 pointer = &MakeSymbol(pointerName, ObjectEntityDetails{}); 4228 } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) { 4229 SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US); 4230 } else if (pointer->Rank() > 0) { 4231 SayWithDecl(pointerName, *pointer, 4232 "Cray pointer '%s' must be a scalar"_err_en_US); 4233 } else if (pointer->test(Symbol::Flag::CrayPointee)) { 4234 Say(pointerName, 4235 "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US); 4236 } 4237 pointer->set(Symbol::Flag::CrayPointer); 4238 const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer, 4239 context().defaultKinds().subscriptIntegerKind())}; 4240 const auto *type{pointer->GetType()}; 4241 if (!type) { 4242 pointer->SetType(pointerType); 4243 } else if (*type != pointerType) { 4244 Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US, 4245 pointerName.source, pointerType.AsFortran()); 4246 } 4247 if (ResolveName(pointeeName)) { 4248 Symbol &pointee{*pointeeName.symbol}; 4249 if (pointee.has<UseDetails>()) { 4250 Say(pointeeName, 4251 "'%s' cannot be a Cray pointee as it is use-associated"_err_en_US); 4252 continue; 4253 } else if (!ConvertToObjectEntity(pointee) || IsNamedConstant(pointee)) { 4254 Say(pointeeName, "'%s' is not a variable"_err_en_US); 4255 continue; 4256 } else if (pointee.test(Symbol::Flag::CrayPointer)) { 4257 Say(pointeeName, 4258 "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US); 4259 } else if (pointee.test(Symbol::Flag::CrayPointee)) { 4260 Say(pointeeName, 4261 "'%s' was already declared as a Cray pointee"_err_en_US); 4262 } else { 4263 pointee.set(Symbol::Flag::CrayPointee); 4264 } 4265 if (const auto *pointeeType{pointee.GetType()}) { 4266 if (const auto *derived{pointeeType->AsDerived()}) { 4267 if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) { 4268 Say(pointeeName, 4269 "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US); 4270 } 4271 } 4272 } 4273 // process the pointee array-spec, if present 4274 BeginArraySpec(); 4275 Walk(std::get<std::optional<parser::ArraySpec>>(bp.t)); 4276 const auto &spec{arraySpec()}; 4277 if (!spec.empty()) { 4278 auto &details{pointee.get<ObjectEntityDetails>()}; 4279 if (details.shape().empty()) { 4280 details.set_shape(spec); 4281 } else { 4282 SayWithDecl(pointeeName, pointee, 4283 "Array spec was already declared for '%s'"_err_en_US); 4284 } 4285 } 4286 ClearArraySpec(); 4287 currScope().add_crayPointer(pointeeName.source, *pointer); 4288 } 4289 } 4290 return false; 4291 } 4292 4293 bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) { 4294 if (!CheckNotInBlock("NAMELIST")) { // C1107 4295 return false; 4296 } 4297 4298 NamelistDetails details; 4299 for (const auto &name : std::get<std::list<parser::Name>>(x.t)) { 4300 auto *symbol{FindSymbol(name)}; 4301 if (!symbol) { 4302 symbol = &MakeSymbol(name, ObjectEntityDetails{}); 4303 ApplyImplicitRules(*symbol); 4304 } else if (!ConvertToObjectEntity(*symbol)) { 4305 SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); 4306 } 4307 symbol->GetUltimate().set(Symbol::Flag::InNamelist); 4308 details.add_object(*symbol); 4309 } 4310 4311 const auto &groupName{std::get<parser::Name>(x.t)}; 4312 auto *groupSymbol{FindInScope(currScope(), groupName)}; 4313 if (!groupSymbol || !groupSymbol->has<NamelistDetails>()) { 4314 groupSymbol = &MakeSymbol(groupName, std::move(details)); 4315 groupSymbol->ReplaceName(groupName.source); 4316 } 4317 groupSymbol->get<NamelistDetails>().add_objects(details.objects()); 4318 return false; 4319 } 4320 4321 bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { 4322 if (const auto *name{std::get_if<parser::Name>(&x.u)}) { 4323 auto *symbol{FindSymbol(*name)}; 4324 if (!symbol) { 4325 Say(*name, "Namelist group '%s' not found"_err_en_US); 4326 } else if (!symbol->GetUltimate().has<NamelistDetails>()) { 4327 SayWithDecl( 4328 *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US); 4329 } 4330 } 4331 return true; 4332 } 4333 4334 bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { 4335 CheckNotInBlock("COMMON"); // C1107 4336 return true; 4337 } 4338 4339 bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) { 4340 BeginArraySpec(); 4341 return true; 4342 } 4343 4344 void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { 4345 const auto &name{std::get<parser::Name>(x.t)}; 4346 DeclareObjectEntity(name); 4347 auto pair{commonBlockObjects_.insert(name.source)}; 4348 if (!pair.second) { 4349 const SourceName &prev{*pair.first}; 4350 Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev, 4351 "Previous occurrence of '%s' in a COMMON block"_en_US); 4352 } 4353 } 4354 4355 bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) { 4356 // save equivalence sets to be processed after specification part 4357 CheckNotInBlock("EQUIVALENCE"); // C1107 4358 for (const std::list<parser::EquivalenceObject> &set : x.v) { 4359 equivalenceSets_.push_back(&set); 4360 } 4361 return false; // don't implicitly declare names yet 4362 } 4363 4364 void DeclarationVisitor::CheckEquivalenceSets() { 4365 EquivalenceSets equivSets{context()}; 4366 for (const auto *set : equivalenceSets_) { 4367 const auto &source{set->front().v.value().source}; 4368 if (set->size() <= 1) { // R871 4369 Say(source, "Equivalence set must have more than one object"_err_en_US); 4370 } 4371 for (const parser::EquivalenceObject &object : *set) { 4372 const auto &designator{object.v.value()}; 4373 // The designator was not resolved when it was encountered so do it now. 4374 // AnalyzeExpr causes array sections to be changed to substrings as needed 4375 Walk(designator); 4376 if (AnalyzeExpr(context(), designator)) { 4377 equivSets.AddToSet(designator); 4378 } 4379 } 4380 equivSets.FinishSet(source); 4381 } 4382 for (auto &set : equivSets.sets()) { 4383 if (!set.empty()) { 4384 currScope().add_equivalenceSet(std::move(set)); 4385 } 4386 } 4387 equivalenceSets_.clear(); 4388 } 4389 4390 bool DeclarationVisitor::Pre(const parser::SaveStmt &x) { 4391 if (x.v.empty()) { 4392 saveInfo_.saveAll = currStmtSource(); 4393 currScope().set_hasSAVE(); 4394 } else { 4395 for (const parser::SavedEntity &y : x.v) { 4396 auto kind{std::get<parser::SavedEntity::Kind>(y.t)}; 4397 const auto &name{std::get<parser::Name>(y.t)}; 4398 if (kind == parser::SavedEntity::Kind::Common) { 4399 MakeCommonBlockSymbol(name); 4400 AddSaveName(saveInfo_.commons, name.source); 4401 } else { 4402 HandleAttributeStmt(Attr::SAVE, name); 4403 } 4404 } 4405 } 4406 return false; 4407 } 4408 4409 void DeclarationVisitor::CheckSaveStmts() { 4410 for (const SourceName &name : saveInfo_.entities) { 4411 auto *symbol{FindInScope(currScope(), name)}; 4412 if (!symbol) { 4413 // error was reported 4414 } else if (saveInfo_.saveAll) { 4415 // C889 - note that pgi, ifort, xlf do not enforce this constraint 4416 Say2(name, 4417 "Explicit SAVE of '%s' is redundant due to global SAVE statement"_err_en_US, 4418 *saveInfo_.saveAll, "Global SAVE statement"_en_US); 4419 } else if (auto msg{CheckSaveAttr(*symbol)}) { 4420 Say(name, std::move(*msg)); 4421 context().SetError(*symbol); 4422 } else { 4423 SetSaveAttr(*symbol); 4424 } 4425 } 4426 for (const SourceName &name : saveInfo_.commons) { 4427 if (auto *symbol{currScope().FindCommonBlock(name)}) { 4428 auto &objects{symbol->get<CommonBlockDetails>().objects()}; 4429 if (objects.empty()) { 4430 if (currScope().kind() != Scope::Kind::Block) { 4431 Say(name, 4432 "'%s' appears as a COMMON block in a SAVE statement but not in" 4433 " a COMMON statement"_err_en_US); 4434 } else { // C1108 4435 Say(name, 4436 "SAVE statement in BLOCK construct may not contain a" 4437 " common block name '%s'"_err_en_US); 4438 } 4439 } else { 4440 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 4441 SetSaveAttr(*object); 4442 } 4443 } 4444 } 4445 } 4446 if (saveInfo_.saveAll) { 4447 // Apply SAVE attribute to applicable symbols 4448 for (auto pair : currScope()) { 4449 auto &symbol{*pair.second}; 4450 if (!CheckSaveAttr(symbol)) { 4451 SetSaveAttr(symbol); 4452 } 4453 } 4454 } 4455 saveInfo_ = {}; 4456 } 4457 4458 // If SAVE attribute can't be set on symbol, return error message. 4459 std::optional<MessageFixedText> DeclarationVisitor::CheckSaveAttr( 4460 const Symbol &symbol) { 4461 if (IsDummy(symbol)) { 4462 return "SAVE attribute may not be applied to dummy argument '%s'"_err_en_US; 4463 } else if (symbol.IsFuncResult()) { 4464 return "SAVE attribute may not be applied to function result '%s'"_err_en_US; 4465 } else if (symbol.has<ProcEntityDetails>() && 4466 !symbol.attrs().test(Attr::POINTER)) { 4467 return "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US; 4468 } else if (IsAutomatic(symbol)) { 4469 return "SAVE attribute may not be applied to automatic data object '%s'"_err_en_US; 4470 } else { 4471 return std::nullopt; 4472 } 4473 } 4474 4475 // Record SAVEd names in saveInfo_.entities. 4476 Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) { 4477 if (attrs.test(Attr::SAVE)) { 4478 AddSaveName(saveInfo_.entities, name); 4479 } 4480 return attrs; 4481 } 4482 4483 // Record a name in a set of those to be saved. 4484 void DeclarationVisitor::AddSaveName( 4485 std::set<SourceName> &set, const SourceName &name) { 4486 auto pair{set.insert(name)}; 4487 if (!pair.second) { 4488 Say2(name, "SAVE attribute was already specified on '%s'"_err_en_US, 4489 *pair.first, "Previous specification of SAVE attribute"_en_US); 4490 } 4491 } 4492 4493 // Set the SAVE attribute on symbol unless it is implicitly saved anyway. 4494 void DeclarationVisitor::SetSaveAttr(Symbol &symbol) { 4495 if (!IsSaved(symbol)) { 4496 symbol.attrs().set(Attr::SAVE); 4497 } 4498 } 4499 4500 // Check types of common block objects, now that they are known. 4501 void DeclarationVisitor::CheckCommonBlocks() { 4502 // check for empty common blocks 4503 for (const auto &pair : currScope().commonBlocks()) { 4504 const auto &symbol{*pair.second}; 4505 if (symbol.get<CommonBlockDetails>().objects().empty() && 4506 symbol.attrs().test(Attr::BIND_C)) { 4507 Say(symbol.name(), 4508 "'%s' appears as a COMMON block in a BIND statement but not in" 4509 " a COMMON statement"_err_en_US); 4510 } 4511 } 4512 // check objects in common blocks 4513 for (const auto &name : commonBlockObjects_) { 4514 const auto *symbol{currScope().FindSymbol(name)}; 4515 if (!symbol) { 4516 continue; 4517 } 4518 const auto &attrs{symbol->attrs()}; 4519 if (attrs.test(Attr::ALLOCATABLE)) { 4520 Say(name, 4521 "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US); 4522 } else if (attrs.test(Attr::BIND_C)) { 4523 Say(name, 4524 "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US); 4525 } else if (IsDummy(*symbol)) { 4526 Say(name, 4527 "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); 4528 } else if (symbol->IsFuncResult()) { 4529 Say(name, 4530 "Function result '%s' may not appear in a COMMON block"_err_en_US); 4531 } else if (const DeclTypeSpec * type{symbol->GetType()}) { 4532 if (type->category() == DeclTypeSpec::ClassStar) { 4533 Say(name, 4534 "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US); 4535 } else if (const auto *derived{type->AsDerived()}) { 4536 auto &typeSymbol{derived->typeSymbol()}; 4537 if (!typeSymbol.attrs().test(Attr::BIND_C) && 4538 !typeSymbol.get<DerivedTypeDetails>().sequence()) { 4539 Say(name, 4540 "Derived type '%s' in COMMON block must have the BIND or" 4541 " SEQUENCE attribute"_err_en_US); 4542 } 4543 CheckCommonBlockDerivedType(name, typeSymbol); 4544 } 4545 } 4546 } 4547 commonBlockObjects_ = {}; 4548 } 4549 4550 Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { 4551 return Resolve(name, currScope().MakeCommonBlock(name.source)); 4552 } 4553 Symbol &DeclarationVisitor::MakeCommonBlockSymbol( 4554 const std::optional<parser::Name> &name) { 4555 if (name) { 4556 return MakeCommonBlockSymbol(*name); 4557 } else { 4558 return MakeCommonBlockSymbol(parser::Name{}); 4559 } 4560 } 4561 4562 bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) { 4563 return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name); 4564 } 4565 4566 // Check if this derived type can be in a COMMON block. 4567 void DeclarationVisitor::CheckCommonBlockDerivedType( 4568 const SourceName &name, const Symbol &typeSymbol) { 4569 if (const auto *scope{typeSymbol.scope()}) { 4570 for (const auto &pair : *scope) { 4571 const Symbol &component{*pair.second}; 4572 if (component.attrs().test(Attr::ALLOCATABLE)) { 4573 Say2(name, 4574 "Derived type variable '%s' may not appear in a COMMON block" 4575 " due to ALLOCATABLE component"_err_en_US, 4576 component.name(), "Component with ALLOCATABLE attribute"_en_US); 4577 return; 4578 } 4579 if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) { 4580 if (details->init()) { 4581 Say2(name, 4582 "Derived type variable '%s' may not appear in a COMMON block" 4583 " due to component with default initialization"_err_en_US, 4584 component.name(), "Component with default initialization"_en_US); 4585 return; 4586 } 4587 if (const auto *type{details->type()}) { 4588 if (const auto *derived{type->AsDerived()}) { 4589 CheckCommonBlockDerivedType(name, derived->typeSymbol()); 4590 } 4591 } 4592 } 4593 } 4594 } 4595 } 4596 4597 bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( 4598 const parser::Name &name) { 4599 if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction( 4600 name.source.ToString())}) { 4601 // Unrestricted specific intrinsic function names (e.g., "cos") 4602 // are acceptable as procedure interfaces. 4603 Symbol &symbol{ 4604 MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})}; 4605 if (interface->IsElemental()) { 4606 symbol.attrs().set(Attr::ELEMENTAL); 4607 } 4608 symbol.set_details(ProcEntityDetails{}); 4609 Resolve(name, symbol); 4610 return true; 4611 } else { 4612 return false; 4613 } 4614 } 4615 4616 // Checks for all locality-specs: LOCAL, LOCAL_INIT, and SHARED 4617 bool DeclarationVisitor::PassesSharedLocalityChecks( 4618 const parser::Name &name, Symbol &symbol) { 4619 if (!IsVariableName(symbol)) { 4620 SayLocalMustBeVariable(name, symbol); // C1124 4621 return false; 4622 } 4623 if (symbol.owner() == currScope()) { // C1125 and C1126 4624 SayAlreadyDeclared(name, symbol); 4625 return false; 4626 } 4627 return true; 4628 } 4629 4630 // Checks for locality-specs LOCAL and LOCAL_INIT 4631 bool DeclarationVisitor::PassesLocalityChecks( 4632 const parser::Name &name, Symbol &symbol) { 4633 if (IsAllocatable(symbol)) { // C1128 4634 SayWithDecl(name, symbol, 4635 "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US); 4636 return false; 4637 } 4638 if (IsOptional(symbol)) { // C1128 4639 SayWithDecl(name, symbol, 4640 "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US); 4641 return false; 4642 } 4643 if (IsIntentIn(symbol)) { // C1128 4644 SayWithDecl(name, symbol, 4645 "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US); 4646 return false; 4647 } 4648 if (IsFinalizable(symbol)) { // C1128 4649 SayWithDecl(name, symbol, 4650 "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US); 4651 return false; 4652 } 4653 if (IsCoarray(symbol)) { // C1128 4654 SayWithDecl( 4655 name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US); 4656 return false; 4657 } 4658 if (const DeclTypeSpec * type{symbol.GetType()}) { 4659 if (type->IsPolymorphic() && IsDummy(symbol) && 4660 !IsPointer(symbol)) { // C1128 4661 SayWithDecl(name, symbol, 4662 "Nonpointer polymorphic argument '%s' not allowed in a " 4663 "locality-spec"_err_en_US); 4664 return false; 4665 } 4666 } 4667 if (IsAssumedSizeArray(symbol)) { // C1128 4668 SayWithDecl(name, symbol, 4669 "Assumed size array '%s' not allowed in a locality-spec"_err_en_US); 4670 return false; 4671 } 4672 if (std::optional<MessageFixedText> msg{ 4673 WhyNotModifiable(symbol, currScope())}) { 4674 SayWithReason(name, symbol, 4675 "'%s' may not appear in a locality-spec because it is not " 4676 "definable"_err_en_US, 4677 std::move(*msg)); 4678 return false; 4679 } 4680 return PassesSharedLocalityChecks(name, symbol); 4681 } 4682 4683 Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity( 4684 const parser::Name &name) { 4685 Symbol *prev{FindSymbol(name)}; 4686 if (!prev) { 4687 // Declare the name as an object in the enclosing scope so that 4688 // the name can't be repurposed there later as something else. 4689 prev = &MakeSymbol(InclusiveScope(), name.source, Attrs{}); 4690 ConvertToObjectEntity(*prev); 4691 ApplyImplicitRules(*prev); 4692 } 4693 return *prev; 4694 } 4695 4696 Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) { 4697 Symbol &prev{FindOrDeclareEnclosingEntity(name)}; 4698 if (!PassesLocalityChecks(name, prev)) { 4699 return nullptr; 4700 } 4701 return &MakeHostAssocSymbol(name, prev); 4702 } 4703 4704 Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name, 4705 const std::optional<parser::IntegerTypeSpec> &type) { 4706 const DeclTypeSpec *declTypeSpec{nullptr}; 4707 if (auto *prev{FindSymbol(name)}) { 4708 if (prev->owner() == currScope()) { 4709 SayAlreadyDeclared(name, *prev); 4710 return nullptr; 4711 } 4712 name.symbol = nullptr; 4713 declTypeSpec = prev->GetType(); 4714 } 4715 Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})}; 4716 if (!symbol.has<ObjectEntityDetails>()) { 4717 return nullptr; // error was reported in DeclareEntity 4718 } 4719 if (type) { 4720 declTypeSpec = ProcessTypeSpec(*type); 4721 } 4722 if (declTypeSpec) { 4723 // Subtlety: Don't let a "*length" specifier (if any is pending) affect the 4724 // declaration of this implied DO loop control variable. 4725 auto restorer{ 4726 common::ScopedSet(charInfo_.length, std::optional<ParamValue>{})}; 4727 SetType(name, *declTypeSpec); 4728 } else { 4729 ApplyImplicitRules(symbol); 4730 } 4731 return Resolve(name, &symbol); 4732 } 4733 4734 // Set the type of an entity or report an error. 4735 void DeclarationVisitor::SetType( 4736 const parser::Name &name, const DeclTypeSpec &type) { 4737 CHECK(name.symbol); 4738 auto &symbol{*name.symbol}; 4739 if (charInfo_.length) { // Declaration has "*length" (R723) 4740 auto length{std::move(*charInfo_.length)}; 4741 charInfo_.length.reset(); 4742 if (type.category() == DeclTypeSpec::Character) { 4743 auto kind{type.characterTypeSpec().kind()}; 4744 // Recurse with correct type. 4745 SetType(name, 4746 currScope().MakeCharacterType(std::move(length), std::move(kind))); 4747 return; 4748 } else { // C753 4749 Say(name, 4750 "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US); 4751 } 4752 } 4753 auto *prevType{symbol.GetType()}; 4754 if (!prevType) { 4755 symbol.SetType(type); 4756 } else if (symbol.has<UseDetails>()) { 4757 // error recovery case, redeclaration of use-associated name 4758 } else if (HadForwardRef(symbol)) { 4759 // error recovery after use of host-associated name 4760 } else if (!symbol.test(Symbol::Flag::Implicit)) { 4761 SayWithDecl( 4762 name, symbol, "The type of '%s' has already been declared"_err_en_US); 4763 context().SetError(symbol); 4764 } else if (type != *prevType) { 4765 SayWithDecl(name, symbol, 4766 "The type of '%s' has already been implicitly declared"_err_en_US); 4767 context().SetError(symbol); 4768 } else { 4769 symbol.set(Symbol::Flag::Implicit, false); 4770 } 4771 } 4772 4773 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType( 4774 const parser::Name &name) { 4775 Symbol *symbol{FindSymbol(NonDerivedTypeScope(), name)}; 4776 if (!symbol || symbol->has<UnknownDetails>()) { 4777 if (allowForwardReferenceToDerivedType()) { 4778 if (!symbol) { 4779 symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{}); 4780 Resolve(name, *symbol); 4781 }; 4782 DerivedTypeDetails details; 4783 details.set_isForwardReferenced(); 4784 symbol->set_details(std::move(details)); 4785 } else { // C732 4786 Say(name, "Derived type '%s' not found"_err_en_US); 4787 return std::nullopt; 4788 } 4789 } 4790 if (CheckUseError(name)) { 4791 return std::nullopt; 4792 } 4793 symbol = &symbol->GetUltimate(); 4794 if (auto *details{symbol->detailsIf<GenericDetails>()}) { 4795 if (details->derivedType()) { 4796 symbol = details->derivedType(); 4797 } 4798 } 4799 if (symbol->has<DerivedTypeDetails>()) { 4800 return DerivedTypeSpec{name.source, *symbol}; 4801 } else { 4802 Say(name, "'%s' is not a derived type"_err_en_US); 4803 return std::nullopt; 4804 } 4805 } 4806 4807 std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType( 4808 const parser::Name &typeName, const parser::Name *extendsName) { 4809 if (!extendsName) { 4810 return std::nullopt; 4811 } else if (typeName.source == extendsName->source) { 4812 Say(extendsName->source, 4813 "Derived type '%s' cannot extend itself"_err_en_US); 4814 return std::nullopt; 4815 } else { 4816 return ResolveDerivedType(*extendsName); 4817 } 4818 } 4819 4820 Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) { 4821 // The symbol is checked later by CheckExplicitInterface() and 4822 // CheckBindings(). It can be a forward reference. 4823 if (!NameIsKnownOrIntrinsic(name)) { 4824 Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})}; 4825 Resolve(name, symbol); 4826 } 4827 return name.symbol; 4828 } 4829 4830 void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) { 4831 if (const Symbol * symbol{name.symbol}) { 4832 if (!symbol->HasExplicitInterface()) { 4833 Say(name, 4834 "'%s' must be an abstract interface or a procedure with " 4835 "an explicit interface"_err_en_US, 4836 symbol->name()); 4837 } 4838 } 4839 } 4840 4841 // Create a symbol for a type parameter, component, or procedure binding in 4842 // the current derived type scope. Return false on error. 4843 Symbol *DeclarationVisitor::MakeTypeSymbol( 4844 const parser::Name &name, Details &&details) { 4845 return Resolve(name, MakeTypeSymbol(name.source, std::move(details))); 4846 } 4847 Symbol *DeclarationVisitor::MakeTypeSymbol( 4848 const SourceName &name, Details &&details) { 4849 Scope &derivedType{currScope()}; 4850 CHECK(derivedType.IsDerivedType()); 4851 if (auto *symbol{FindInScope(derivedType, name)}) { // C742 4852 Say2(name, 4853 "Type parameter, component, or procedure binding '%s'" 4854 " already defined in this type"_err_en_US, 4855 *symbol, "Previous definition of '%s'"_en_US); 4856 return nullptr; 4857 } else { 4858 auto attrs{GetAttrs()}; 4859 // Apply binding-private-stmt if present and this is a procedure binding 4860 if (derivedTypeInfo_.privateBindings && 4861 !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) && 4862 std::holds_alternative<ProcBindingDetails>(details)) { 4863 attrs.set(Attr::PRIVATE); 4864 } 4865 Symbol &result{MakeSymbol(name, attrs, std::move(details))}; 4866 if (result.has<TypeParamDetails>()) { 4867 derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result); 4868 } 4869 return &result; 4870 } 4871 } 4872 4873 // Return true if it is ok to declare this component in the current scope. 4874 // Otherwise, emit an error and return false. 4875 bool DeclarationVisitor::OkToAddComponent( 4876 const parser::Name &name, const Symbol *extends) { 4877 for (const Scope *scope{&currScope()}; scope;) { 4878 CHECK(scope->IsDerivedType()); 4879 if (auto *prev{FindInScope(*scope, name)}) { 4880 if (!context().HasError(*prev)) { 4881 auto msg{""_en_US}; 4882 if (extends) { 4883 msg = "Type cannot be extended as it has a component named" 4884 " '%s'"_err_en_US; 4885 } else if (prev->test(Symbol::Flag::ParentComp)) { 4886 msg = "'%s' is a parent type of this type and so cannot be" 4887 " a component"_err_en_US; 4888 } else if (scope != &currScope()) { 4889 msg = "Component '%s' is already declared in a parent of this" 4890 " derived type"_err_en_US; 4891 } else { 4892 msg = "Component '%s' is already declared in this" 4893 " derived type"_err_en_US; 4894 } 4895 Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US); 4896 } 4897 return false; 4898 } 4899 if (scope == &currScope() && extends) { 4900 // The parent component has not yet been added to the scope. 4901 scope = extends->scope(); 4902 } else { 4903 scope = scope->GetDerivedTypeParent(); 4904 } 4905 } 4906 return true; 4907 } 4908 4909 ParamValue DeclarationVisitor::GetParamValue( 4910 const parser::TypeParamValue &x, common::TypeParamAttr attr) { 4911 return std::visit( 4912 common::visitors{ 4913 [=](const parser::ScalarIntExpr &x) { // C704 4914 return ParamValue{EvaluateIntExpr(x), attr}; 4915 }, 4916 [=](const parser::Star &) { return ParamValue::Assumed(attr); }, 4917 [=](const parser::TypeParamValue::Deferred &) { 4918 return ParamValue::Deferred(attr); 4919 }, 4920 }, 4921 x.u); 4922 } 4923 4924 // ConstructVisitor implementation 4925 4926 void ConstructVisitor::ResolveIndexName( 4927 const parser::ConcurrentControl &control) { 4928 const parser::Name &name{std::get<parser::Name>(control.t)}; 4929 auto *prev{FindSymbol(name)}; 4930 if (prev) { 4931 if (prev->owner().kind() == Scope::Kind::Forall || 4932 prev->owner() == currScope()) { 4933 SayAlreadyDeclared(name, *prev); 4934 return; 4935 } 4936 name.symbol = nullptr; 4937 } 4938 auto &symbol{DeclareObjectEntity(name)}; 4939 if (symbol.GetType()) { 4940 // type came from explicit type-spec 4941 } else if (!prev) { 4942 ApplyImplicitRules(symbol); 4943 } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) { 4944 Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US, 4945 *prev, "Previous declaration of '%s'"_en_US); 4946 return; 4947 } else { 4948 if (const auto *type{prev->GetType()}) { 4949 symbol.SetType(*type); 4950 } 4951 if (prev->IsObjectArray()) { 4952 SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US); 4953 return; 4954 } 4955 } 4956 EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}}); 4957 } 4958 4959 // We need to make sure that all of the index-names get declared before the 4960 // expressions in the loop control are evaluated so that references to the 4961 // index-names in the expressions are correctly detected. 4962 bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) { 4963 BeginDeclTypeSpec(); 4964 Walk(std::get<std::optional<parser::IntegerTypeSpec>>(header.t)); 4965 const auto &controls{ 4966 std::get<std::list<parser::ConcurrentControl>>(header.t)}; 4967 for (const auto &control : controls) { 4968 ResolveIndexName(control); 4969 } 4970 Walk(controls); 4971 Walk(std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)); 4972 EndDeclTypeSpec(); 4973 return false; 4974 } 4975 4976 bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) { 4977 for (auto &name : x.v) { 4978 if (auto *symbol{DeclareLocalEntity(name)}) { 4979 symbol->set(Symbol::Flag::LocalityLocal); 4980 } 4981 } 4982 return false; 4983 } 4984 4985 bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) { 4986 for (auto &name : x.v) { 4987 if (auto *symbol{DeclareLocalEntity(name)}) { 4988 symbol->set(Symbol::Flag::LocalityLocalInit); 4989 } 4990 } 4991 return false; 4992 } 4993 4994 bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) { 4995 for (const auto &name : x.v) { 4996 if (!FindSymbol(name)) { 4997 Say(name, "Variable '%s' with SHARED locality implicitly declared"_en_US); 4998 } 4999 Symbol &prev{FindOrDeclareEnclosingEntity(name)}; 5000 if (PassesSharedLocalityChecks(name, prev)) { 5001 MakeHostAssocSymbol(name, prev).set(Symbol::Flag::LocalityShared); 5002 } 5003 } 5004 return false; 5005 } 5006 5007 bool ConstructVisitor::Pre(const parser::AcSpec &x) { 5008 ProcessTypeSpec(x.type); 5009 PushScope(Scope::Kind::ImpliedDos, nullptr); 5010 Walk(x.values); 5011 PopScope(); 5012 return false; 5013 } 5014 5015 // Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the 5016 // enclosing ac-implied-do 5017 bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) { 5018 auto &values{std::get<std::list<parser::AcValue>>(x.t)}; 5019 auto &control{std::get<parser::AcImpliedDoControl>(x.t)}; 5020 auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)}; 5021 auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)}; 5022 PushScope(Scope::Kind::ImpliedDos, nullptr); 5023 DeclareStatementEntity(bounds.name.thing.thing, type); 5024 Walk(bounds); 5025 Walk(values); 5026 PopScope(); 5027 return false; 5028 } 5029 5030 bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { 5031 auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)}; 5032 auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)}; 5033 auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)}; 5034 DeclareStatementEntity(bounds.name.thing.thing, type); 5035 Walk(bounds); 5036 Walk(objects); 5037 return false; 5038 } 5039 5040 // Sets InDataStmt flag on a variable (or misidentified function) in a DATA 5041 // statement so that the predicate IsInitialized(base symbol) will be true 5042 // during semantic analysis before the symbol's initializer is constructed. 5043 bool ConstructVisitor::Pre(const parser::DataIDoObject &x) { 5044 std::visit( 5045 common::visitors{ 5046 [&](const parser::Scalar<Indirection<parser::Designator>> &y) { 5047 Walk(y.thing.value()); 5048 const parser::Name &first{parser::GetFirstName(y.thing.value())}; 5049 if (first.symbol) { 5050 first.symbol->set(Symbol::Flag::InDataStmt); 5051 } 5052 }, 5053 [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); }, 5054 }, 5055 x.u); 5056 return false; 5057 } 5058 5059 bool ConstructVisitor::Pre(const parser::DataStmtObject &x) { 5060 std::visit(common::visitors{ 5061 [&](const Indirection<parser::Variable> &y) { 5062 Walk(y.value()); 5063 const parser::Name &first{parser::GetFirstName(y.value())}; 5064 if (first.symbol) { 5065 first.symbol->set(Symbol::Flag::InDataStmt); 5066 } 5067 }, 5068 [&](const parser::DataImpliedDo &y) { 5069 PushScope(Scope::Kind::ImpliedDos, nullptr); 5070 Walk(y); 5071 PopScope(); 5072 }, 5073 }, 5074 x.u); 5075 return false; 5076 } 5077 5078 bool ConstructVisitor::Pre(const parser::DataStmtValue &x) { 5079 const auto &data{std::get<parser::DataStmtConstant>(x.t)}; 5080 auto &mutableData{const_cast<parser::DataStmtConstant &>(data)}; 5081 if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) { 5082 if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) { 5083 if (const Symbol * symbol{FindSymbol(*name)}) { 5084 if (const Symbol * ultimate{GetAssociationRoot(*symbol)}) { 5085 if (ultimate->has<DerivedTypeDetails>()) { 5086 mutableData.u = elem->ConvertToStructureConstructor( 5087 DerivedTypeSpec{name->source, *ultimate}); 5088 } 5089 } 5090 } 5091 } 5092 } 5093 return true; 5094 } 5095 5096 bool ConstructVisitor::Pre(const parser::DoConstruct &x) { 5097 if (x.IsDoConcurrent()) { 5098 PushScope(Scope::Kind::Block, nullptr); 5099 } 5100 return true; 5101 } 5102 void ConstructVisitor::Post(const parser::DoConstruct &x) { 5103 if (x.IsDoConcurrent()) { 5104 PopScope(); 5105 } 5106 } 5107 5108 bool ConstructVisitor::Pre(const parser::ForallConstruct &) { 5109 PushScope(Scope::Kind::Forall, nullptr); 5110 return true; 5111 } 5112 void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); } 5113 bool ConstructVisitor::Pre(const parser::ForallStmt &) { 5114 PushScope(Scope::Kind::Forall, nullptr); 5115 return true; 5116 } 5117 void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); } 5118 5119 bool ConstructVisitor::Pre(const parser::BlockStmt &x) { 5120 CheckDef(x.v); 5121 PushScope(Scope::Kind::Block, nullptr); 5122 return false; 5123 } 5124 bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) { 5125 PopScope(); 5126 CheckRef(x.v); 5127 return false; 5128 } 5129 5130 void ConstructVisitor::Post(const parser::Selector &x) { 5131 GetCurrentAssociation().selector = ResolveSelector(x); 5132 } 5133 5134 bool ConstructVisitor::Pre(const parser::AssociateStmt &x) { 5135 CheckDef(x.t); 5136 PushScope(Scope::Kind::Block, nullptr); 5137 PushAssociation(); 5138 return true; 5139 } 5140 void ConstructVisitor::Post(const parser::EndAssociateStmt &x) { 5141 PopAssociation(); 5142 PopScope(); 5143 CheckRef(x.v); 5144 } 5145 5146 void ConstructVisitor::Post(const parser::Association &x) { 5147 const auto &name{std::get<parser::Name>(x.t)}; 5148 GetCurrentAssociation().name = &name; 5149 if (auto *symbol{MakeAssocEntity()}) { 5150 if (ExtractCoarrayRef(GetCurrentAssociation().selector.expr)) { // C1103 5151 Say("Selector must not be a coindexed object"_err_en_US); 5152 } 5153 SetTypeFromAssociation(*symbol); 5154 SetAttrsFromAssociation(*symbol); 5155 } 5156 GetCurrentAssociation() = {}; // clean for further parser::Association. 5157 } 5158 5159 bool ConstructVisitor::Pre(const parser::ChangeTeamStmt &x) { 5160 CheckDef(x.t); 5161 PushScope(Scope::Kind::Block, nullptr); 5162 PushAssociation(); 5163 return true; 5164 } 5165 5166 void ConstructVisitor::Post(const parser::CoarrayAssociation &x) { 5167 const auto &decl{std::get<parser::CodimensionDecl>(x.t)}; 5168 const auto &name{std::get<parser::Name>(decl.t)}; 5169 if (auto *symbol{FindInScope(currScope(), name)}) { 5170 const auto &selector{std::get<parser::Selector>(x.t)}; 5171 if (auto sel{ResolveSelector(selector)}) { 5172 const Symbol *whole{UnwrapWholeSymbolDataRef(sel.expr)}; 5173 if (!whole || whole->Corank() == 0) { 5174 Say(sel.source, // C1116 5175 "Selector in coarray association must name a coarray"_err_en_US); 5176 } else if (auto dynType{sel.expr->GetType()}) { 5177 if (!symbol->GetType()) { 5178 symbol->SetType(ToDeclTypeSpec(std::move(*dynType))); 5179 } 5180 } 5181 } 5182 } 5183 } 5184 5185 void ConstructVisitor::Post(const parser::EndChangeTeamStmt &x) { 5186 PopAssociation(); 5187 PopScope(); 5188 CheckRef(x.t); 5189 } 5190 5191 bool ConstructVisitor::Pre(const parser::SelectTypeConstruct &) { 5192 PushAssociation(); 5193 return true; 5194 } 5195 5196 void ConstructVisitor::Post(const parser::SelectTypeConstruct &) { 5197 PopAssociation(); 5198 } 5199 5200 void ConstructVisitor::Post(const parser::SelectTypeStmt &x) { 5201 auto &association{GetCurrentAssociation()}; 5202 if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { 5203 // This isn't a name in the current scope, it is in each TypeGuardStmt 5204 MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName); 5205 association.name = &*name; 5206 auto exprType{association.selector.expr->GetType()}; 5207 if (ExtractCoarrayRef(association.selector.expr)) { // C1103 5208 Say("Selector must not be a coindexed object"_err_en_US); 5209 } 5210 if (exprType && !exprType->IsPolymorphic()) { // C1159 5211 Say(association.selector.source, 5212 "Selector '%s' in SELECT TYPE statement must be " 5213 "polymorphic"_err_en_US); 5214 } 5215 } else { 5216 if (const Symbol * 5217 whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { 5218 ConvertToObjectEntity(const_cast<Symbol &>(*whole)); 5219 if (!IsVariableName(*whole)) { 5220 Say(association.selector.source, // C901 5221 "Selector is not a variable"_err_en_US); 5222 association = {}; 5223 } 5224 if (const DeclTypeSpec * type{whole->GetType()}) { 5225 if (!type->IsPolymorphic()) { // C1159 5226 Say(association.selector.source, 5227 "Selector '%s' in SELECT TYPE statement must be " 5228 "polymorphic"_err_en_US); 5229 } 5230 } 5231 } else { 5232 Say(association.selector.source, // C1157 5233 "Selector is not a named variable: 'associate-name =>' is required"_err_en_US); 5234 association = {}; 5235 } 5236 } 5237 } 5238 5239 void ConstructVisitor::Post(const parser::SelectRankStmt &x) { 5240 auto &association{GetCurrentAssociation()}; 5241 if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) { 5242 // This isn't a name in the current scope, it is in each SelectRankCaseStmt 5243 MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName); 5244 association.name = &*name; 5245 } 5246 } 5247 5248 bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) { 5249 PushScope(Scope::Kind::Block, nullptr); 5250 return true; 5251 } 5252 void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) { 5253 PopScope(); 5254 } 5255 5256 bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) { 5257 PushScope(Scope::Kind::Block, nullptr); 5258 return true; 5259 } 5260 void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) { 5261 PopScope(); 5262 } 5263 5264 void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) { 5265 if (auto *symbol{MakeAssocEntity()}) { 5266 if (std::holds_alternative<parser::Default>(x.u)) { 5267 SetTypeFromAssociation(*symbol); 5268 } else if (const auto *type{GetDeclTypeSpec()}) { 5269 symbol->SetType(*type); 5270 } 5271 SetAttrsFromAssociation(*symbol); 5272 } 5273 } 5274 5275 void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) { 5276 if (auto *symbol{MakeAssocEntity()}) { 5277 SetTypeFromAssociation(*symbol); 5278 SetAttrsFromAssociation(*symbol); 5279 if (const auto *init{std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) { 5280 if (auto val{EvaluateInt64(context(), *init)}) { 5281 auto &details{symbol->get<AssocEntityDetails>()}; 5282 details.set_rank(*val); 5283 } 5284 } 5285 } 5286 } 5287 5288 bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) { 5289 PushAssociation(); 5290 return true; 5291 } 5292 5293 void ConstructVisitor::Post(const parser::SelectRankConstruct &) { 5294 PopAssociation(); 5295 } 5296 5297 bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) { 5298 if (x) { 5299 MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); 5300 } 5301 return true; 5302 } 5303 5304 void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) { 5305 if (x) { 5306 // Just add an occurrence of this name; checking is done in ValidateLabels 5307 FindSymbol(*x); 5308 } 5309 } 5310 5311 // Make a symbol representing an associating entity from current association. 5312 Symbol *ConstructVisitor::MakeAssocEntity() { 5313 Symbol *symbol{nullptr}; 5314 auto &association{GetCurrentAssociation()}; 5315 if (association.name) { 5316 symbol = &MakeSymbol(*association.name, UnknownDetails{}); 5317 if (symbol->has<AssocEntityDetails>() && symbol->owner() == currScope()) { 5318 Say(*association.name, // C1104 5319 "The associate name '%s' is already used in this associate statement"_err_en_US); 5320 return nullptr; 5321 } 5322 } else if (const Symbol * 5323 whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) { 5324 symbol = &MakeSymbol(whole->name()); 5325 } else { 5326 return nullptr; 5327 } 5328 if (auto &expr{association.selector.expr}) { 5329 symbol->set_details(AssocEntityDetails{common::Clone(*expr)}); 5330 } else { 5331 symbol->set_details(AssocEntityDetails{}); 5332 } 5333 return symbol; 5334 } 5335 5336 // Set the type of symbol based on the current association selector. 5337 void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) { 5338 auto &details{symbol.get<AssocEntityDetails>()}; 5339 const MaybeExpr *pexpr{&details.expr()}; 5340 if (!*pexpr) { 5341 pexpr = &GetCurrentAssociation().selector.expr; 5342 } 5343 if (*pexpr) { 5344 const SomeExpr &expr{**pexpr}; 5345 if (std::optional<evaluate::DynamicType> type{expr.GetType()}) { 5346 if (const auto *charExpr{ 5347 evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeCharacter>>( 5348 expr)}) { 5349 symbol.SetType(ToDeclTypeSpec(std::move(*type), 5350 FoldExpr( 5351 std::visit([](const auto &kindChar) { return kindChar.LEN(); }, 5352 charExpr->u)))); 5353 } else { 5354 symbol.SetType(ToDeclTypeSpec(std::move(*type))); 5355 } 5356 } else { 5357 // BOZ literals, procedure designators, &c. are not acceptable 5358 Say(symbol.name(), "Associate name '%s' must have a type"_err_en_US); 5359 } 5360 } 5361 } 5362 5363 // If current selector is a variable, set some of its attributes on symbol. 5364 void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) { 5365 Attrs attrs{evaluate::GetAttrs(GetCurrentAssociation().selector.expr)}; 5366 symbol.attrs() |= attrs & 5367 Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::CONTIGUOUS}; 5368 if (attrs.test(Attr::POINTER)) { 5369 symbol.attrs().set(Attr::TARGET); 5370 } 5371 } 5372 5373 ConstructVisitor::Selector ConstructVisitor::ResolveSelector( 5374 const parser::Selector &x) { 5375 return std::visit(common::visitors{ 5376 [&](const parser::Expr &expr) { 5377 return Selector{expr.source, EvaluateExpr(expr)}; 5378 }, 5379 [&](const parser::Variable &var) { 5380 return Selector{var.GetSource(), EvaluateExpr(var)}; 5381 }, 5382 }, 5383 x.u); 5384 } 5385 5386 ConstructVisitor::Association &ConstructVisitor::GetCurrentAssociation() { 5387 CHECK(!associationStack_.empty()); 5388 return associationStack_.back(); 5389 } 5390 5391 void ConstructVisitor::PushAssociation() { 5392 associationStack_.emplace_back(Association{}); 5393 } 5394 5395 void ConstructVisitor::PopAssociation() { 5396 CHECK(!associationStack_.empty()); 5397 associationStack_.pop_back(); 5398 } 5399 5400 const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( 5401 evaluate::DynamicType &&type) { 5402 switch (type.category()) { 5403 SWITCH_COVERS_ALL_CASES 5404 case common::TypeCategory::Integer: 5405 case common::TypeCategory::Real: 5406 case common::TypeCategory::Complex: 5407 return context().MakeNumericType(type.category(), type.kind()); 5408 case common::TypeCategory::Logical: 5409 return context().MakeLogicalType(type.kind()); 5410 case common::TypeCategory::Derived: 5411 if (type.IsAssumedType()) { 5412 return currScope().MakeTypeStarType(); 5413 } else if (type.IsUnlimitedPolymorphic()) { 5414 return currScope().MakeClassStarType(); 5415 } else { 5416 return currScope().MakeDerivedType( 5417 type.IsPolymorphic() ? DeclTypeSpec::ClassDerived 5418 : DeclTypeSpec::TypeDerived, 5419 common::Clone(type.GetDerivedTypeSpec()) 5420 5421 ); 5422 } 5423 case common::TypeCategory::Character: 5424 CRASH_NO_CASE; 5425 } 5426 } 5427 5428 const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( 5429 evaluate::DynamicType &&type, MaybeSubscriptIntExpr &&length) { 5430 CHECK(type.category() == common::TypeCategory::Character); 5431 if (length) { 5432 return currScope().MakeCharacterType( 5433 ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len}, 5434 KindExpr{type.kind()}); 5435 } else { 5436 return currScope().MakeCharacterType( 5437 ParamValue::Deferred(common::TypeParamAttr::Len), 5438 KindExpr{type.kind()}); 5439 } 5440 } 5441 5442 // ResolveNamesVisitor implementation 5443 5444 bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) { 5445 HandleCall(Symbol::Flag::Function, x.v); 5446 return false; 5447 } 5448 bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) { 5449 HandleCall(Symbol::Flag::Subroutine, x.v); 5450 return false; 5451 } 5452 5453 bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) { 5454 auto &scope{currScope()}; 5455 // Check C896 and C899: where IMPORT statements are allowed 5456 switch (scope.kind()) { 5457 case Scope::Kind::Module: 5458 if (scope.IsModule()) { 5459 Say("IMPORT is not allowed in a module scoping unit"_err_en_US); 5460 return false; 5461 } else if (x.kind == common::ImportKind::None) { 5462 Say("IMPORT,NONE is not allowed in a submodule scoping unit"_err_en_US); 5463 return false; 5464 } 5465 break; 5466 case Scope::Kind::MainProgram: 5467 Say("IMPORT is not allowed in a main program scoping unit"_err_en_US); 5468 return false; 5469 case Scope::Kind::Subprogram: 5470 if (scope.parent().IsGlobal()) { 5471 Say("IMPORT is not allowed in an external subprogram scoping unit"_err_en_US); 5472 return false; 5473 } 5474 break; 5475 case Scope::Kind::BlockData: // C1415 (in part) 5476 Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US); 5477 return false; 5478 default:; 5479 } 5480 if (auto error{scope.SetImportKind(x.kind)}) { 5481 Say(std::move(*error)); 5482 } 5483 for (auto &name : x.names) { 5484 if (FindSymbol(scope.parent(), name)) { 5485 scope.add_importName(name.source); 5486 } else { 5487 Say(name, "'%s' not found in host scope"_err_en_US); 5488 } 5489 } 5490 prevImportStmt_ = currStmtSource(); 5491 return false; 5492 } 5493 5494 const parser::Name *DeclarationVisitor::ResolveStructureComponent( 5495 const parser::StructureComponent &x) { 5496 return FindComponent(ResolveDataRef(x.base), x.component); 5497 } 5498 5499 const parser::Name *DeclarationVisitor::ResolveDesignator( 5500 const parser::Designator &x) { 5501 return std::visit( 5502 common::visitors{ 5503 [&](const parser::DataRef &x) { return ResolveDataRef(x); }, 5504 [&](const parser::Substring &x) { 5505 return ResolveDataRef(std::get<parser::DataRef>(x.t)); 5506 }, 5507 }, 5508 x.u); 5509 } 5510 5511 const parser::Name *DeclarationVisitor::ResolveDataRef( 5512 const parser::DataRef &x) { 5513 return std::visit( 5514 common::visitors{ 5515 [=](const parser::Name &y) { return ResolveName(y); }, 5516 [=](const Indirection<parser::StructureComponent> &y) { 5517 return ResolveStructureComponent(y.value()); 5518 }, 5519 [&](const Indirection<parser::ArrayElement> &y) { 5520 Walk(y.value().subscripts); 5521 const parser::Name *name{ResolveDataRef(y.value().base)}; 5522 if (!name) { 5523 } else if (!name->symbol->has<ProcEntityDetails>()) { 5524 ConvertToObjectEntity(*name->symbol); 5525 } else if (!context().HasError(*name->symbol)) { 5526 SayWithDecl(*name, *name->symbol, 5527 "Cannot reference function '%s' as data"_err_en_US); 5528 } 5529 return name; 5530 }, 5531 [&](const Indirection<parser::CoindexedNamedObject> &y) { 5532 Walk(y.value().imageSelector); 5533 return ResolveDataRef(y.value().base); 5534 }, 5535 }, 5536 x.u); 5537 } 5538 5539 // If implicit types are allowed, ensure name is in the symbol table. 5540 // Otherwise, report an error if it hasn't been declared. 5541 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) { 5542 FindSymbol(name); 5543 if (CheckForHostAssociatedImplicit(name)) { 5544 NotePossibleBadForwardRef(name); 5545 return &name; 5546 } 5547 if (Symbol * symbol{name.symbol}) { 5548 if (CheckUseError(name)) { 5549 return nullptr; // reported an error 5550 } 5551 NotePossibleBadForwardRef(name); 5552 symbol->set(Symbol::Flag::ImplicitOrError, false); 5553 if (IsUplevelReference(*symbol)) { 5554 MakeHostAssocSymbol(name, *symbol); 5555 } else if (IsDummy(*symbol) || 5556 (!symbol->GetType() && FindCommonBlockContaining(*symbol))) { 5557 ConvertToObjectEntity(*symbol); 5558 ApplyImplicitRules(*symbol); 5559 } 5560 return &name; 5561 } 5562 if (isImplicitNoneType()) { 5563 Say(name, "No explicit type declared for '%s'"_err_en_US); 5564 return nullptr; 5565 } 5566 // Create the symbol then ensure it is accessible 5567 MakeSymbol(InclusiveScope(), name.source, Attrs{}); 5568 auto *symbol{FindSymbol(name)}; 5569 if (!symbol) { 5570 Say(name, 5571 "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US); 5572 return nullptr; 5573 } 5574 ConvertToObjectEntity(*symbol); 5575 ApplyImplicitRules(*symbol); 5576 NotePossibleBadForwardRef(name); 5577 return &name; 5578 } 5579 5580 // A specification expression may refer to a symbol in the host procedure that 5581 // is implicitly typed. Because specification parts are processed before 5582 // execution parts, this may be the first time we see the symbol. It can't be a 5583 // local in the current scope (because it's in a specification expression) so 5584 // either it is implicitly declared in the host procedure or it is an error. 5585 // We create a symbol in the host assuming it is the former; if that proves to 5586 // be wrong we report an error later in CheckDeclarations(). 5587 bool DeclarationVisitor::CheckForHostAssociatedImplicit( 5588 const parser::Name &name) { 5589 if (inExecutionPart_) { 5590 return false; 5591 } 5592 if (name.symbol) { 5593 ApplyImplicitRules(*name.symbol); 5594 } 5595 Symbol *hostSymbol; 5596 Scope *host{GetHostProcedure()}; 5597 if (!host || isImplicitNoneType(*host)) { 5598 return false; 5599 } 5600 if (!name.symbol) { 5601 hostSymbol = &MakeSymbol(*host, name.source, Attrs{}); 5602 ConvertToObjectEntity(*hostSymbol); 5603 ApplyImplicitRules(*hostSymbol); 5604 hostSymbol->set(Symbol::Flag::ImplicitOrError); 5605 } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) { 5606 hostSymbol = name.symbol; 5607 } else { 5608 return false; 5609 } 5610 Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)}; 5611 if (isImplicitNoneType()) { 5612 symbol.get<HostAssocDetails>().implicitOrExplicitTypeError = true; 5613 } else { 5614 symbol.get<HostAssocDetails>().implicitOrSpecExprError = true; 5615 } 5616 return true; 5617 } 5618 5619 bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) { 5620 const Scope &symbolUnit{GetProgramUnitContaining(symbol)}; 5621 if (symbolUnit == GetProgramUnitContaining(currScope())) { 5622 return false; 5623 } else { 5624 Scope::Kind kind{symbolUnit.kind()}; 5625 return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram; 5626 } 5627 } 5628 5629 // base is a part-ref of a derived type; find the named component in its type. 5630 // Also handles intrinsic type parameter inquiries (%kind, %len) and 5631 // COMPLEX component references (%re, %im). 5632 const parser::Name *DeclarationVisitor::FindComponent( 5633 const parser::Name *base, const parser::Name &component) { 5634 if (!base || !base->symbol) { 5635 return nullptr; 5636 } 5637 auto &symbol{base->symbol->GetUltimate()}; 5638 if (!symbol.has<AssocEntityDetails>() && !ConvertToObjectEntity(symbol)) { 5639 SayWithDecl(*base, symbol, 5640 "'%s' is an invalid base for a component reference"_err_en_US); 5641 return nullptr; 5642 } 5643 auto *type{symbol.GetType()}; 5644 if (!type) { 5645 return nullptr; // should have already reported error 5646 } 5647 if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) { 5648 auto name{component.ToString()}; 5649 auto category{intrinsic->category()}; 5650 MiscDetails::Kind miscKind{MiscDetails::Kind::None}; 5651 if (name == "kind") { 5652 miscKind = MiscDetails::Kind::KindParamInquiry; 5653 } else if (category == TypeCategory::Character) { 5654 if (name == "len") { 5655 miscKind = MiscDetails::Kind::LenParamInquiry; 5656 } 5657 } else if (category == TypeCategory::Complex) { 5658 if (name == "re") { 5659 miscKind = MiscDetails::Kind::ComplexPartRe; 5660 } else if (name == "im") { 5661 miscKind = MiscDetails::Kind::ComplexPartIm; 5662 } 5663 } 5664 if (miscKind != MiscDetails::Kind::None) { 5665 MakePlaceholder(component, miscKind); 5666 return nullptr; 5667 } 5668 } else if (const DerivedTypeSpec * derived{type->AsDerived()}) { 5669 if (const Scope * scope{derived->scope()}) { 5670 if (Resolve(component, scope->FindComponent(component.source))) { 5671 if (auto msg{ 5672 CheckAccessibleComponent(currScope(), *component.symbol)}) { 5673 context().Say(component.source, *msg); 5674 } 5675 return &component; 5676 } else { 5677 SayDerivedType(component.source, 5678 "Component '%s' not found in derived type '%s'"_err_en_US, *scope); 5679 } 5680 } 5681 return nullptr; 5682 } 5683 if (symbol.test(Symbol::Flag::Implicit)) { 5684 Say(*base, 5685 "'%s' is not an object of derived type; it is implicitly typed"_err_en_US); 5686 } else { 5687 SayWithDecl( 5688 *base, symbol, "'%s' is not an object of derived type"_err_en_US); 5689 } 5690 return nullptr; 5691 } 5692 5693 // C764, C765 5694 bool DeclarationVisitor::CheckInitialDataTarget( 5695 const Symbol &pointer, const SomeExpr &expr, SourceName source) { 5696 auto &context{GetFoldingContext()}; 5697 auto restorer{context.messages().SetLocation(source)}; 5698 auto dyType{evaluate::DynamicType::From(pointer)}; 5699 CHECK(dyType); 5700 auto designator{evaluate::TypedWrapper<evaluate::Designator>( 5701 *dyType, evaluate::DataRef{pointer})}; 5702 CHECK(designator); 5703 return CheckInitialTarget(context, *designator, expr); 5704 } 5705 5706 void DeclarationVisitor::CheckInitialProcTarget( 5707 const Symbol &pointer, const parser::Name &target, SourceName source) { 5708 // C1519 - must be nonelemental external or module procedure, 5709 // or an unrestricted specific intrinsic function. 5710 if (const Symbol * targetSym{target.symbol}) { 5711 const Symbol &ultimate{targetSym->GetUltimate()}; 5712 if (ultimate.attrs().test(Attr::INTRINSIC)) { 5713 } else if (!ultimate.attrs().test(Attr::EXTERNAL) && 5714 ultimate.owner().kind() != Scope::Kind::Module) { 5715 Say(source, 5716 "Procedure pointer '%s' initializer '%s' is neither " 5717 "an external nor a module procedure"_err_en_US, 5718 pointer.name(), ultimate.name()); 5719 } else if (ultimate.attrs().test(Attr::ELEMENTAL)) { 5720 Say(source, 5721 "Procedure pointer '%s' cannot be initialized with the " 5722 "elemental procedure '%s"_err_en_US, 5723 pointer.name(), ultimate.name()); 5724 } else { 5725 // TODO: Check the "shalls" in the 15.4.3.6 paragraphs 7-10. 5726 } 5727 } 5728 } 5729 5730 void DeclarationVisitor::Initialization(const parser::Name &name, 5731 const parser::Initialization &init, bool inComponentDecl) { 5732 // Traversal of the initializer was deferred to here so that the 5733 // symbol being declared can be available for use in the expression, e.g.: 5734 // real, parameter :: x = tiny(x) 5735 if (!name.symbol) { 5736 return; 5737 } 5738 Symbol &ultimate{name.symbol->GetUltimate()}; 5739 if (IsAllocatable(ultimate)) { 5740 Say(name, "Allocatable component '%s' cannot be initialized"_err_en_US); 5741 return; 5742 } 5743 if (std::holds_alternative<parser::InitialDataTarget>(init.u)) { 5744 // Defer analysis further to the end of the specification parts so that 5745 // forward references and attribute checks (e.g., SAVE) work better. 5746 // TODO: But pointer initializers of components in named constants of 5747 // derived types may still need more attention. 5748 return; 5749 } 5750 if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) { 5751 // TODO: check C762 - all bounds and type parameters of component 5752 // are colons or constant expressions if component is initialized 5753 std::visit( 5754 common::visitors{ 5755 [&](const parser::ConstantExpr &expr) { 5756 NonPointerInitialization(name, expr, inComponentDecl); 5757 }, 5758 [&](const parser::NullInit &null) { 5759 Walk(null); 5760 if (auto nullInit{EvaluateExpr(null)}) { 5761 if (!evaluate::IsNullPointer(*nullInit)) { 5762 Say(name, 5763 "Pointer initializer must be intrinsic NULL()"_err_en_US); // C813 5764 } else if (IsPointer(ultimate)) { 5765 object->set_init(std::move(*nullInit)); 5766 } else { 5767 Say(name, 5768 "Non-pointer component '%s' initialized with null pointer"_err_en_US); 5769 } 5770 } 5771 }, 5772 [&](const parser::InitialDataTarget &) { 5773 DIE("InitialDataTarget can't appear here"); 5774 }, 5775 [&](const std::list<Indirection<parser::DataStmtValue>> &) { 5776 // TODO: Need to Walk(init.u); when implementing this case 5777 if (inComponentDecl) { 5778 Say(name, 5779 "Component '%s' initialized with DATA statement values"_err_en_US); 5780 } else { 5781 // TODO - DATA statements and DATA-like initialization extension 5782 } 5783 }, 5784 }, 5785 init.u); 5786 } 5787 } 5788 5789 void DeclarationVisitor::PointerInitialization( 5790 const parser::Name &name, const parser::InitialDataTarget &target) { 5791 if (name.symbol) { 5792 Symbol &ultimate{name.symbol->GetUltimate()}; 5793 if (!context().HasError(ultimate)) { 5794 if (IsPointer(ultimate)) { 5795 if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { 5796 CHECK(!details->init()); 5797 Walk(target); 5798 if (MaybeExpr expr{EvaluateExpr(target)}) { 5799 CheckInitialDataTarget(ultimate, *expr, target.value().source); 5800 details->set_init(std::move(*expr)); 5801 } 5802 } 5803 } else { 5804 Say(name, 5805 "'%s' is not a pointer but is initialized like one"_err_en_US); 5806 context().SetError(ultimate); 5807 } 5808 } 5809 } 5810 } 5811 void DeclarationVisitor::PointerInitialization( 5812 const parser::Name &name, const parser::ProcPointerInit &target) { 5813 if (name.symbol) { 5814 Symbol &ultimate{name.symbol->GetUltimate()}; 5815 if (!context().HasError(ultimate)) { 5816 if (IsProcedurePointer(ultimate)) { 5817 auto &details{ultimate.get<ProcEntityDetails>()}; 5818 CHECK(!details.init()); 5819 Walk(target); 5820 if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) { 5821 CheckInitialProcTarget(ultimate, *targetName, name.source); 5822 if (targetName->symbol) { 5823 details.set_init(*targetName->symbol); 5824 } 5825 } else { 5826 details.set_init(nullptr); // explicit NULL() 5827 } 5828 } else { 5829 Say(name, 5830 "'%s' is not a procedure pointer but is initialized " 5831 "like one"_err_en_US); 5832 context().SetError(ultimate); 5833 } 5834 } 5835 } 5836 } 5837 5838 void DeclarationVisitor::NonPointerInitialization(const parser::Name &name, 5839 const parser::ConstantExpr &expr, bool inComponentDecl) { 5840 if (name.symbol) { 5841 Symbol &ultimate{name.symbol->GetUltimate()}; 5842 if (!context().HasError(ultimate)) { 5843 if (IsPointer(ultimate)) { 5844 Say(name, 5845 "'%s' is a pointer but is not initialized like one"_err_en_US); 5846 } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) { 5847 CHECK(!details->init()); 5848 Walk(expr); 5849 if (inComponentDecl) { 5850 // TODO: check C762 - all bounds and type parameters of component 5851 // are colons or constant expressions if component is initialized 5852 // Can't convert to type of component, which might not yet 5853 // be known; that's done later during instantiation. 5854 if (MaybeExpr value{EvaluateExpr(expr)}) { 5855 details->set_init(std::move(*value)); 5856 } 5857 } else if (MaybeExpr folded{EvaluateConvertedExpr( 5858 ultimate, expr, expr.thing.value().source)}) { 5859 details->set_init(std::move(*folded)); 5860 } 5861 } 5862 } 5863 } 5864 } 5865 5866 void ResolveNamesVisitor::HandleCall( 5867 Symbol::Flag procFlag, const parser::Call &call) { 5868 std::visit( 5869 common::visitors{ 5870 [&](const parser::Name &x) { HandleProcedureName(procFlag, x); }, 5871 [&](const parser::ProcComponentRef &x) { Walk(x); }, 5872 }, 5873 std::get<parser::ProcedureDesignator>(call.t).u); 5874 Walk(std::get<std::list<parser::ActualArgSpec>>(call.t)); 5875 } 5876 5877 void ResolveNamesVisitor::HandleProcedureName( 5878 Symbol::Flag flag, const parser::Name &name) { 5879 CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine); 5880 auto *symbol{FindSymbol(NonDerivedTypeScope(), name)}; 5881 if (!symbol) { 5882 if (IsIntrinsic(name.source, flag)) { 5883 symbol = 5884 &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC}); 5885 } else { 5886 symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); 5887 } 5888 Resolve(name, *symbol); 5889 if (symbol->has<ModuleDetails>()) { 5890 SayWithDecl(name, *symbol, 5891 "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); 5892 return; 5893 } 5894 if (!symbol->attrs().test(Attr::INTRINSIC)) { 5895 if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) { 5896 Say(name, 5897 "'%s' is an external procedure without the EXTERNAL" 5898 " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US); 5899 return; 5900 } 5901 MakeExternal(*symbol); 5902 } 5903 ConvertToProcEntity(*symbol); 5904 SetProcFlag(name, *symbol, flag); 5905 } else if (CheckUseError(name)) { 5906 // error was reported 5907 } else { 5908 symbol = &Resolve(name, symbol)->GetUltimate(); 5909 bool convertedToProcEntity{ConvertToProcEntity(*symbol)}; 5910 if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) && 5911 IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) { 5912 symbol->attrs().set(Attr::INTRINSIC); 5913 // 8.2(3): ignore type from intrinsic in type-declaration-stmt 5914 symbol->get<ProcEntityDetails>().set_interface(ProcInterface{}); 5915 } 5916 if (!SetProcFlag(name, *symbol, flag)) { 5917 return; // reported error 5918 } 5919 if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() || 5920 symbol->has<ObjectEntityDetails>() || 5921 symbol->has<AssocEntityDetails>()) { 5922 // Symbols with DerivedTypeDetails, ObjectEntityDetails and 5923 // AssocEntityDetails are accepted here as procedure-designators because 5924 // this means the related FunctionReference are mis-parsed structure 5925 // constructors or array references that will be fixed later when 5926 // analyzing expressions. 5927 } else if (symbol->test(Symbol::Flag::Implicit)) { 5928 Say(name, 5929 "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US); 5930 } else { 5931 SayWithDecl(name, *symbol, 5932 "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); 5933 } 5934 } 5935 } 5936 5937 // Variant of HandleProcedureName() for use while skimming the executable 5938 // part of a subprogram to catch calls to dummy procedures that are part 5939 // of the subprogram's interface, and to mark as procedures any symbols 5940 // that might otherwise have been miscategorized as objects. 5941 void ResolveNamesVisitor::NoteExecutablePartCall( 5942 Symbol::Flag flag, const parser::Call &call) { 5943 auto &designator{std::get<parser::ProcedureDesignator>(call.t)}; 5944 if (const auto *name{std::get_if<parser::Name>(&designator.u)}) { 5945 // Subtlety: The symbol pointers in the parse tree are not set, because 5946 // they might end up resolving elsewhere (e.g., construct entities in 5947 // SELECT TYPE). 5948 if (Symbol * symbol{currScope().FindSymbol(name->source)}) { 5949 Symbol::Flag other{flag == Symbol::Flag::Subroutine 5950 ? Symbol::Flag::Function 5951 : Symbol::Flag::Subroutine}; 5952 if (!symbol->test(other)) { 5953 ConvertToProcEntity(*symbol); 5954 if (symbol->has<ProcEntityDetails>()) { 5955 symbol->set(flag); 5956 if (IsDummy(*symbol)) { 5957 symbol->attrs().set(Attr::EXTERNAL); 5958 } 5959 ApplyImplicitRules(*symbol); 5960 } 5961 } 5962 } 5963 } 5964 } 5965 5966 // Check and set the Function or Subroutine flag on symbol; false on error. 5967 bool ResolveNamesVisitor::SetProcFlag( 5968 const parser::Name &name, Symbol &symbol, Symbol::Flag flag) { 5969 if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) { 5970 SayWithDecl( 5971 name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); 5972 return false; 5973 } else if (symbol.test(Symbol::Flag::Subroutine) && 5974 flag == Symbol::Flag::Function) { 5975 SayWithDecl( 5976 name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US); 5977 return false; 5978 } else if (symbol.has<ProcEntityDetails>()) { 5979 symbol.set(flag); // in case it hasn't been set yet 5980 if (flag == Symbol::Flag::Function) { 5981 ApplyImplicitRules(symbol); 5982 } 5983 } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) { 5984 SayWithDecl( 5985 name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US); 5986 } 5987 return true; 5988 } 5989 5990 bool ModuleVisitor::Pre(const parser::AccessStmt &x) { 5991 Attr accessAttr{AccessSpecToAttr(std::get<parser::AccessSpec>(x.t))}; 5992 if (!currScope().IsModule()) { // C869 5993 Say(currStmtSource().value(), 5994 "%s statement may only appear in the specification part of a module"_err_en_US, 5995 EnumToString(accessAttr)); 5996 return false; 5997 } 5998 const auto &accessIds{std::get<std::list<parser::AccessId>>(x.t)}; 5999 if (accessIds.empty()) { 6000 if (prevAccessStmt_) { // C869 6001 Say("The default accessibility of this module has already been declared"_err_en_US) 6002 .Attach(*prevAccessStmt_, "Previous declaration"_en_US); 6003 } 6004 prevAccessStmt_ = currStmtSource(); 6005 defaultAccess_ = accessAttr; 6006 } else { 6007 for (const auto &accessId : accessIds) { 6008 std::visit( 6009 common::visitors{ 6010 [=](const parser::Name &y) { 6011 Resolve(y, SetAccess(y.source, accessAttr)); 6012 }, 6013 [=](const Indirection<parser::GenericSpec> &y) { 6014 auto info{GenericSpecInfo{y.value()}}; 6015 const auto &symbolName{info.symbolName()}; 6016 if (auto *symbol{info.FindInScope(context(), currScope())}) { 6017 info.Resolve(&SetAccess(symbolName, accessAttr, symbol)); 6018 } else if (info.kind().IsName()) { 6019 info.Resolve(&SetAccess(symbolName, accessAttr)); 6020 } else { 6021 Say(symbolName, "Generic spec '%s' not found"_err_en_US); 6022 } 6023 }, 6024 }, 6025 accessId.u); 6026 } 6027 } 6028 return false; 6029 } 6030 6031 // Set the access specification for this symbol. 6032 Symbol &ModuleVisitor::SetAccess( 6033 const SourceName &name, Attr attr, Symbol *symbol) { 6034 if (!symbol) { 6035 symbol = &MakeSymbol(name); 6036 } 6037 Attrs &attrs{symbol->attrs()}; 6038 if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { 6039 // PUBLIC/PRIVATE already set: make it a fatal error if it changed 6040 Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE; 6041 Say(name, 6042 WithIsFatal( 6043 "The accessibility of '%s' has already been specified as %s"_en_US, 6044 attr != prev), 6045 MakeOpName(name), EnumToString(prev)); 6046 } else { 6047 attrs.set(attr); 6048 } 6049 return *symbol; 6050 } 6051 6052 static bool NeedsExplicitType(const Symbol &symbol) { 6053 if (symbol.has<UnknownDetails>()) { 6054 return true; 6055 } else if (const auto *details{symbol.detailsIf<EntityDetails>()}) { 6056 return !details->type(); 6057 } else if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { 6058 return !details->type(); 6059 } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) { 6060 return !details->interface().symbol() && !details->interface().type(); 6061 } else { 6062 return false; 6063 } 6064 } 6065 6066 bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) { 6067 const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts, 6068 implicitPart, decls] = x.t; 6069 auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)}; 6070 Walk(accDecls); 6071 Walk(ompDecls); 6072 Walk(compilerDirectives); 6073 Walk(useStmts); 6074 Walk(importStmts); 6075 Walk(implicitPart); 6076 auto setRestorer{ 6077 common::ScopedSet(specPartForwardRefs_, std::set<SourceName>{})}; 6078 for (const auto &decl : decls) { 6079 if (const auto *spec{ 6080 std::get_if<parser::SpecificationConstruct>(&decl.u)}) { 6081 PreSpecificationConstruct(*spec); 6082 } 6083 } 6084 Walk(decls); 6085 FinishSpecificationPart(decls); 6086 return false; 6087 } 6088 6089 // Initial processing on specification constructs, before visiting them. 6090 void ResolveNamesVisitor::PreSpecificationConstruct( 6091 const parser::SpecificationConstruct &spec) { 6092 std::visit( 6093 common::visitors{ 6094 [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) { 6095 CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t)); 6096 }, 6097 [&](const Indirection<parser::InterfaceBlock> &y) { 6098 const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>( 6099 y.value().t)}; 6100 if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) { 6101 CreateGeneric(*spec); 6102 } 6103 }, 6104 [&](const parser::Statement<parser::OtherSpecificationStmt> &y) { 6105 if (const auto *commonStmt{parser::Unwrap<parser::CommonStmt>(y)}) { 6106 CreateCommonBlockSymbols(*commonStmt); 6107 } 6108 }, 6109 [&](const auto &) {}, 6110 }, 6111 spec.u); 6112 } 6113 6114 void ResolveNamesVisitor::CreateCommonBlockSymbols( 6115 const parser::CommonStmt &commonStmt) { 6116 for (const parser::CommonStmt::Block &block : commonStmt.blocks) { 6117 const auto &[name, objects] = block.t; 6118 Symbol &commonBlock{MakeCommonBlockSymbol(name)}; 6119 for (const auto &object : objects) { 6120 Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))}; 6121 if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) { 6122 details->set_commonBlock(commonBlock); 6123 commonBlock.get<CommonBlockDetails>().add_object(obj); 6124 } 6125 } 6126 } 6127 } 6128 6129 void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) { 6130 auto info{GenericSpecInfo{x}}; 6131 const SourceName &symbolName{info.symbolName()}; 6132 if (IsLogicalConstant(context(), symbolName)) { 6133 Say(symbolName, 6134 "Logical constant '%s' may not be used as a defined operator"_err_en_US); 6135 return; 6136 } 6137 GenericDetails genericDetails; 6138 if (Symbol * existing{info.FindInScope(context(), currScope())}) { 6139 if (existing->has<GenericDetails>()) { 6140 info.Resolve(existing); 6141 return; // already have generic, add to it 6142 } 6143 Symbol &ultimate{existing->GetUltimate()}; 6144 if (auto *ultimateDetails{ultimate.detailsIf<GenericDetails>()}) { 6145 // convert a use-associated generic into a local generic 6146 genericDetails.CopyFrom(*ultimateDetails); 6147 AddGenericUse(genericDetails, existing->name(), 6148 existing->get<UseDetails>().symbol()); 6149 } else if (ultimate.has<SubprogramDetails>() || 6150 ultimate.has<SubprogramNameDetails>()) { 6151 genericDetails.set_specific(ultimate); 6152 } else if (ultimate.has<DerivedTypeDetails>()) { 6153 genericDetails.set_derivedType(ultimate); 6154 } else { 6155 SayAlreadyDeclared(symbolName, *existing); 6156 } 6157 EraseSymbol(*existing); 6158 } 6159 info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails))); 6160 } 6161 6162 void ResolveNamesVisitor::FinishSpecificationPart( 6163 const std::list<parser::DeclarationConstruct> &decls) { 6164 badStmtFuncFound_ = false; 6165 CheckImports(); 6166 bool inModule{currScope().kind() == Scope::Kind::Module}; 6167 for (auto &pair : currScope()) { 6168 auto &symbol{*pair.second}; 6169 if (NeedsExplicitType(symbol)) { 6170 ApplyImplicitRules(symbol); 6171 } 6172 if (symbol.has<GenericDetails>()) { 6173 CheckGenericProcedures(symbol); 6174 } 6175 if (inModule && symbol.attrs().test(Attr::EXTERNAL) && 6176 !symbol.test(Symbol::Flag::Function) && 6177 !symbol.test(Symbol::Flag::Subroutine)) { 6178 // in a module, external proc without return type is subroutine 6179 symbol.set( 6180 symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine); 6181 } 6182 if (!symbol.has<HostAssocDetails>()) { 6183 CheckPossibleBadForwardRef(symbol); 6184 } 6185 } 6186 currScope().InstantiateDerivedTypes(context()); 6187 for (const auto &decl : decls) { 6188 if (const auto *statement{std::get_if< 6189 parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>( 6190 &decl.u)}) { 6191 AnalyzeStmtFunctionStmt(statement->statement.value()); 6192 } 6193 } 6194 // TODO: what about instantiations in BLOCK? 6195 CheckSaveStmts(); 6196 CheckCommonBlocks(); 6197 if (!inInterfaceBlock()) { 6198 // TODO: warn for the case where the EQUIVALENCE statement is in a 6199 // procedure declaration in an interface block 6200 CheckEquivalenceSets(); 6201 } 6202 } 6203 6204 // Analyze the bodies of statement functions now that the symbols in this 6205 // specification part have been fully declared and implicitly typed. 6206 void ResolveNamesVisitor::AnalyzeStmtFunctionStmt( 6207 const parser::StmtFunctionStmt &stmtFunc) { 6208 Symbol *symbol{std::get<parser::Name>(stmtFunc.t).symbol}; 6209 if (!symbol || !symbol->has<SubprogramDetails>()) { 6210 return; 6211 } 6212 auto &details{symbol->get<SubprogramDetails>()}; 6213 auto expr{AnalyzeExpr( 6214 context(), std::get<parser::Scalar<parser::Expr>>(stmtFunc.t))}; 6215 if (!expr) { 6216 context().SetError(*symbol); 6217 return; 6218 } 6219 if (auto type{evaluate::DynamicType::From(*symbol)}) { 6220 auto converted{ConvertToType(*type, std::move(*expr))}; 6221 if (!converted) { 6222 context().SetError(*symbol); 6223 return; 6224 } 6225 details.set_stmtFunction(std::move(*converted)); 6226 } else { 6227 details.set_stmtFunction(std::move(*expr)); 6228 } 6229 } 6230 6231 void ResolveNamesVisitor::CheckImports() { 6232 auto &scope{currScope()}; 6233 switch (scope.GetImportKind()) { 6234 case common::ImportKind::None: 6235 break; 6236 case common::ImportKind::All: 6237 // C8102: all entities in host must not be hidden 6238 for (const auto &pair : scope.parent()) { 6239 auto &name{pair.first}; 6240 std::optional<SourceName> scopeName{scope.GetName()}; 6241 if (!scopeName || name != *scopeName) { 6242 CheckImport(prevImportStmt_.value(), name); 6243 } 6244 } 6245 break; 6246 case common::ImportKind::Default: 6247 case common::ImportKind::Only: 6248 // C8102: entities named in IMPORT must not be hidden 6249 for (auto &name : scope.importNames()) { 6250 CheckImport(name, name); 6251 } 6252 break; 6253 } 6254 } 6255 6256 void ResolveNamesVisitor::CheckImport( 6257 const SourceName &location, const SourceName &name) { 6258 if (auto *symbol{FindInScope(currScope(), name)}) { 6259 Say(location, "'%s' from host is not accessible"_err_en_US, name) 6260 .Attach(symbol->name(), "'%s' is hidden by this entity"_en_US, 6261 symbol->name()); 6262 } 6263 } 6264 6265 bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { 6266 return CheckNotInBlock("IMPLICIT") && // C1107 6267 ImplicitRulesVisitor::Pre(x); 6268 } 6269 6270 void ResolveNamesVisitor::Post(const parser::PointerObject &x) { 6271 std::visit(common::visitors{ 6272 [&](const parser::Name &x) { ResolveName(x); }, 6273 [&](const parser::StructureComponent &x) { 6274 ResolveStructureComponent(x); 6275 }, 6276 }, 6277 x.u); 6278 } 6279 void ResolveNamesVisitor::Post(const parser::AllocateObject &x) { 6280 std::visit(common::visitors{ 6281 [&](const parser::Name &x) { ResolveName(x); }, 6282 [&](const parser::StructureComponent &x) { 6283 ResolveStructureComponent(x); 6284 }, 6285 }, 6286 x.u); 6287 } 6288 6289 bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) { 6290 const auto &dataRef{std::get<parser::DataRef>(x.t)}; 6291 const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)}; 6292 const auto &expr{std::get<parser::Expr>(x.t)}; 6293 ResolveDataRef(dataRef); 6294 Walk(bounds); 6295 // Resolve unrestricted specific intrinsic procedures as in "p => cos". 6296 if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) { 6297 if (NameIsKnownOrIntrinsic(*name)) { 6298 return false; 6299 } 6300 } 6301 Walk(expr); 6302 return false; 6303 } 6304 void ResolveNamesVisitor::Post(const parser::Designator &x) { 6305 ResolveDesignator(x); 6306 } 6307 6308 void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) { 6309 ResolveStructureComponent(x.v.thing); 6310 } 6311 void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) { 6312 DeclTypeSpecVisitor::Post(x); 6313 ConstructVisitor::Post(x); 6314 } 6315 bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) { 6316 CheckNotInBlock("STATEMENT FUNCTION"); // C1107 6317 if (HandleStmtFunction(x)) { 6318 return false; 6319 } else { 6320 // This is an array element assignment: resolve names of indices 6321 const auto &names{std::get<std::list<parser::Name>>(x.t)}; 6322 for (auto &name : names) { 6323 ResolveName(name); 6324 } 6325 return true; 6326 } 6327 } 6328 6329 bool ResolveNamesVisitor::Pre(const parser::DefinedOpName &x) { 6330 const parser::Name &name{x.v}; 6331 if (FindSymbol(name)) { 6332 // OK 6333 } else if (IsLogicalConstant(context(), name.source)) { 6334 Say(name, 6335 "Logical constant '%s' may not be used as a defined operator"_err_en_US); 6336 } else { 6337 // Resolved later in expression semantics 6338 MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp); 6339 } 6340 return false; 6341 } 6342 6343 void ResolveNamesVisitor::Post(const parser::AssignStmt &x) { 6344 if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { 6345 ConvertToObjectEntity(DEREF(name->symbol)); 6346 } 6347 } 6348 void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) { 6349 if (auto *name{ResolveName(std::get<parser::Name>(x.t))}) { 6350 ConvertToObjectEntity(DEREF(name->symbol)); 6351 } 6352 } 6353 6354 bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) { 6355 if (std::holds_alternative<common::Indirection<parser::CompilerDirective>>( 6356 x.u)) { 6357 // TODO: global directives 6358 return true; 6359 } 6360 auto root{ProgramTree::Build(x)}; 6361 SetScope(context().globalScope()); 6362 ResolveSpecificationParts(root); 6363 FinishSpecificationParts(root); 6364 inExecutionPart_ = true; 6365 ResolveExecutionParts(root); 6366 inExecutionPart_ = false; 6367 ResolveAccParts(context(), x); 6368 ResolveOmpParts(context(), x); 6369 return false; 6370 } 6371 6372 // References to procedures need to record that their symbols are known 6373 // to be procedures, so that they don't get converted to objects by default. 6374 class ExecutionPartSkimmer { 6375 public: 6376 explicit ExecutionPartSkimmer(ResolveNamesVisitor &resolver) 6377 : resolver_{resolver} {} 6378 6379 void Walk(const parser::ExecutionPart *exec) { 6380 if (exec) { 6381 parser::Walk(*exec, *this); 6382 } 6383 } 6384 6385 template <typename A> bool Pre(const A &) { return true; } 6386 template <typename A> void Post(const A &) {} 6387 void Post(const parser::FunctionReference &fr) { 6388 resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v); 6389 } 6390 void Post(const parser::CallStmt &cs) { 6391 resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.v); 6392 } 6393 6394 private: 6395 ResolveNamesVisitor &resolver_; 6396 }; 6397 6398 // Build the scope tree and resolve names in the specification parts of this 6399 // node and its children 6400 void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) { 6401 if (node.isSpecificationPartResolved()) { 6402 return; // been here already 6403 } 6404 node.set_isSpecificationPartResolved(); 6405 if (!BeginScopeForNode(node)) { 6406 return; // an error prevented scope from being created 6407 } 6408 Scope &scope{currScope()}; 6409 node.set_scope(scope); 6410 AddSubpNames(node); 6411 std::visit( 6412 [&](const auto *x) { 6413 if (x) { 6414 Walk(*x); 6415 } 6416 }, 6417 node.stmt()); 6418 Walk(node.spec()); 6419 // If this is a function, convert result to an object. This is to prevent the 6420 // result from being converted later to a function symbol if it is called 6421 // inside the function. 6422 // If the result is function pointer, then ConvertToObjectEntity will not 6423 // convert the result to an object, and calling the symbol inside the function 6424 // will result in calls to the result pointer. 6425 // A function cannot be called recursively if RESULT was not used to define a 6426 // distinct result name (15.6.2.2 point 4.). 6427 if (Symbol * symbol{scope.symbol()}) { 6428 if (auto *details{symbol->detailsIf<SubprogramDetails>()}) { 6429 if (details->isFunction()) { 6430 ConvertToObjectEntity(const_cast<Symbol &>(details->result())); 6431 } 6432 } 6433 } 6434 if (node.IsModule()) { 6435 ApplyDefaultAccess(); 6436 } 6437 for (auto &child : node.children()) { 6438 ResolveSpecificationParts(child); 6439 } 6440 ExecutionPartSkimmer{*this}.Walk(node.exec()); 6441 PopScope(); 6442 // Ensure that every object entity has a type. 6443 for (auto &pair : *node.scope()) { 6444 ApplyImplicitRules(*pair.second); 6445 } 6446 } 6447 6448 // Add SubprogramNameDetails symbols for module and internal subprograms 6449 void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) { 6450 auto kind{ 6451 node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal}; 6452 for (auto &child : node.children()) { 6453 auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})}; 6454 symbol.set(child.GetSubpFlag()); 6455 } 6456 } 6457 6458 // Push a new scope for this node or return false on error. 6459 bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) { 6460 switch (node.GetKind()) { 6461 SWITCH_COVERS_ALL_CASES 6462 case ProgramTree::Kind::Program: 6463 PushScope(Scope::Kind::MainProgram, 6464 &MakeSymbol(node.name(), MainProgramDetails{})); 6465 return true; 6466 case ProgramTree::Kind::Function: 6467 case ProgramTree::Kind::Subroutine: 6468 return BeginSubprogram( 6469 node.name(), node.GetSubpFlag(), node.HasModulePrefix()); 6470 case ProgramTree::Kind::MpSubprogram: 6471 return BeginMpSubprogram(node.name()); 6472 case ProgramTree::Kind::Module: 6473 BeginModule(node.name(), false); 6474 return true; 6475 case ProgramTree::Kind::Submodule: 6476 return BeginSubmodule(node.name(), node.GetParentId()); 6477 case ProgramTree::Kind::BlockData: 6478 PushBlockDataScope(node.name()); 6479 return true; 6480 } 6481 } 6482 6483 // Some analyses and checks, such as the processing of initializers of 6484 // pointers, are deferred until all of the pertinent specification parts 6485 // have been visited. This deferred processing enables the use of forward 6486 // references in these circumstances. 6487 class DeferredCheckVisitor { 6488 public: 6489 explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver) 6490 : resolver_{resolver} {} 6491 6492 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 6493 6494 template <typename A> bool Pre(const A &) { return true; } 6495 template <typename A> void Post(const A &) {} 6496 6497 void Post(const parser::DerivedTypeStmt &x) { 6498 const auto &name{std::get<parser::Name>(x.t)}; 6499 if (Symbol * symbol{name.symbol}) { 6500 if (Scope * scope{symbol->scope()}) { 6501 if (scope->IsDerivedType()) { 6502 resolver_.PushScope(*scope); 6503 pushedScope_ = true; 6504 } 6505 } 6506 } 6507 } 6508 void Post(const parser::EndTypeStmt &) { 6509 if (pushedScope_) { 6510 resolver_.PopScope(); 6511 pushedScope_ = false; 6512 } 6513 } 6514 6515 void Post(const parser::ProcInterface &pi) { 6516 if (const auto *name{std::get_if<parser::Name>(&pi.u)}) { 6517 resolver_.CheckExplicitInterface(*name); 6518 } 6519 } 6520 bool Pre(const parser::EntityDecl &decl) { 6521 Init(std::get<parser::Name>(decl.t), 6522 std::get<std::optional<parser::Initialization>>(decl.t)); 6523 return false; 6524 } 6525 bool Pre(const parser::ComponentDecl &decl) { 6526 Init(std::get<parser::Name>(decl.t), 6527 std::get<std::optional<parser::Initialization>>(decl.t)); 6528 return false; 6529 } 6530 bool Pre(const parser::ProcDecl &decl) { 6531 if (const auto &init{ 6532 std::get<std::optional<parser::ProcPointerInit>>(decl.t)}) { 6533 resolver_.PointerInitialization(std::get<parser::Name>(decl.t), *init); 6534 } 6535 return false; 6536 } 6537 void Post(const parser::TypeBoundProcedureStmt::WithInterface &tbps) { 6538 resolver_.CheckExplicitInterface(tbps.interfaceName); 6539 } 6540 void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &tbps) { 6541 if (pushedScope_) { 6542 resolver_.CheckBindings(tbps); 6543 } 6544 } 6545 6546 private: 6547 void Init(const parser::Name &name, 6548 const std::optional<parser::Initialization> &init) { 6549 if (init) { 6550 if (const auto *target{ 6551 std::get_if<parser::InitialDataTarget>(&init->u)}) { 6552 resolver_.PointerInitialization(name, *target); 6553 } 6554 } 6555 } 6556 6557 ResolveNamesVisitor &resolver_; 6558 bool pushedScope_{false}; 6559 }; 6560 6561 // Perform checks and completions that need to happen after all of 6562 // the specification parts but before any of the execution parts. 6563 void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) { 6564 if (!node.scope()) { 6565 return; // error occurred creating scope 6566 } 6567 SetScope(*node.scope()); 6568 // The initializers of pointers, pointer components, and non-deferred 6569 // type-bound procedure bindings have not yet been traversed. 6570 // We do that now, when any (formerly) forward references that appear 6571 // in those initializers will resolve to the right symbols. 6572 DeferredCheckVisitor{*this}.Walk(node.spec()); 6573 DeferredCheckVisitor{*this}.Walk(node.exec()); // for BLOCK 6574 for (Scope &childScope : currScope().children()) { 6575 if (childScope.IsDerivedType() && !childScope.symbol()) { 6576 FinishDerivedTypeInstantiation(childScope); 6577 } 6578 } 6579 for (const auto &child : node.children()) { 6580 FinishSpecificationParts(child); 6581 } 6582 } 6583 6584 // Fold object pointer initializer designators with the actual 6585 // type parameter values of a particular instantiation. 6586 void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) { 6587 CHECK(scope.IsDerivedType() && !scope.symbol()); 6588 if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) { 6589 spec->Instantiate(currScope(), context()); 6590 const Symbol &origTypeSymbol{spec->typeSymbol()}; 6591 if (const Scope * origTypeScope{origTypeSymbol.scope()}) { 6592 CHECK(origTypeScope->IsDerivedType() && 6593 origTypeScope->symbol() == &origTypeSymbol); 6594 auto &foldingContext{GetFoldingContext()}; 6595 auto restorer{foldingContext.WithPDTInstance(*spec)}; 6596 for (auto &pair : scope) { 6597 Symbol &comp{*pair.second}; 6598 const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))}; 6599 if (IsPointer(comp)) { 6600 if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) { 6601 auto origDetails{origComp.get<ObjectEntityDetails>()}; 6602 if (const MaybeExpr & init{origDetails.init()}) { 6603 SomeExpr newInit{*init}; 6604 MaybeExpr folded{ 6605 evaluate::Fold(foldingContext, std::move(newInit))}; 6606 details->set_init(std::move(folded)); 6607 } 6608 } 6609 } 6610 } 6611 } 6612 } 6613 } 6614 6615 // Resolve names in the execution part of this node and its children 6616 void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) { 6617 if (!node.scope()) { 6618 return; // error occurred creating scope 6619 } 6620 SetScope(*node.scope()); 6621 if (const auto *exec{node.exec()}) { 6622 Walk(*exec); 6623 } 6624 PopScope(); // converts unclassified entities into objects 6625 for (const auto &child : node.children()) { 6626 ResolveExecutionParts(child); 6627 } 6628 } 6629 6630 void ResolveNamesVisitor::Post(const parser::Program &) { 6631 // ensure that all temps were deallocated 6632 CHECK(!attrs_); 6633 CHECK(!GetDeclTypeSpec()); 6634 } 6635 6636 // A singleton instance of the scope -> IMPLICIT rules mapping is 6637 // shared by all instances of ResolveNamesVisitor and accessed by this 6638 // pointer when the visitors (other than the top-level original) are 6639 // constructed. 6640 static ImplicitRulesMap *sharedImplicitRulesMap{nullptr}; 6641 6642 bool ResolveNames(SemanticsContext &context, const parser::Program &program) { 6643 ImplicitRulesMap implicitRulesMap; 6644 auto restorer{common::ScopedSet(sharedImplicitRulesMap, &implicitRulesMap)}; 6645 ResolveNamesVisitor{context, implicitRulesMap}.Walk(program); 6646 return !context.AnyFatalError(); 6647 } 6648 6649 // Processes a module (but not internal) function when it is referenced 6650 // in a specification expression in a sibling procedure. 6651 void ResolveSpecificationParts( 6652 SemanticsContext &context, const Symbol &subprogram) { 6653 auto originalLocation{context.location()}; 6654 ResolveNamesVisitor visitor{context, DEREF(sharedImplicitRulesMap)}; 6655 ProgramTree &node{subprogram.get<SubprogramNameDetails>().node()}; 6656 const Scope &moduleScope{subprogram.owner()}; 6657 visitor.SetScope(const_cast<Scope &>(moduleScope)); 6658 visitor.ResolveSpecificationParts(node); 6659 context.set_location(std::move(originalLocation)); 6660 } 6661 6662 } // namespace Fortran::semantics 6663