1 //===-- lib/Semantics/check-io.cpp ----------------------------------------===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "check-io.h" 10 #include "definable.h" 11 #include "flang/Common/format.h" 12 #include "flang/Evaluate/tools.h" 13 #include "flang/Parser/tools.h" 14 #include "flang/Semantics/expression.h" 15 #include "flang/Semantics/tools.h" 16 #include <unordered_map> 17 18 namespace Fortran::semantics { 19 20 // TODO: C1234, C1235 -- defined I/O constraints 21 22 class FormatErrorReporter { 23 public: 24 FormatErrorReporter(SemanticsContext &context, 25 const parser::CharBlock &formatCharBlock, int errorAllowance = 3) 26 : context_{context}, formatCharBlock_{formatCharBlock}, 27 errorAllowance_{errorAllowance} {} 28 29 bool Say(const common::FormatMessage &); 30 31 private: 32 SemanticsContext &context_; 33 const parser::CharBlock &formatCharBlock_; 34 int errorAllowance_; // initialized to maximum number of errors to report 35 }; 36 37 bool FormatErrorReporter::Say(const common::FormatMessage &msg) { 38 if (!msg.isError && !context_.warnOnNonstandardUsage()) { 39 return false; 40 } 41 parser::MessageFormattedText text{ 42 parser::MessageFixedText{msg.text, strlen(msg.text), 43 msg.isError ? parser::Severity::Error : parser::Severity::Warning}, 44 msg.arg}; 45 if (formatCharBlock_.size()) { 46 // The input format is a folded expression. Error markers span the full 47 // original unfolded expression in formatCharBlock_. 48 context_.Say(formatCharBlock_, text); 49 } else { 50 // The input format is a source expression. Error markers have an offset 51 // and length relative to the beginning of formatCharBlock_. 52 parser::CharBlock messageCharBlock{ 53 parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)}; 54 context_.Say(messageCharBlock, text); 55 } 56 return msg.isError && --errorAllowance_ <= 0; 57 } 58 59 void IoChecker::Enter( 60 const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) { 61 if (!stmt.label) { 62 context_.Say("Format statement must be labeled"_err_en_US); // C1301 63 } 64 const char *formatStart{static_cast<const char *>( 65 std::memchr(stmt.source.begin(), '(', stmt.source.size()))}; 66 parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)}; 67 FormatErrorReporter reporter{context_, reporterCharBlock}; 68 auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }}; 69 switch (context_.GetDefaultKind(TypeCategory::Character)) { 70 case 1: { 71 common::FormatValidator<char> validator{formatStart, 72 stmt.source.size() - (formatStart - stmt.source.begin()), 73 reporterWrapper}; 74 validator.Check(); 75 break; 76 } 77 case 2: { // TODO: Get this to work. 78 common::FormatValidator<char16_t> validator{ 79 /*???*/ nullptr, /*???*/ 0, reporterWrapper}; 80 validator.Check(); 81 break; 82 } 83 case 4: { // TODO: Get this to work. 84 common::FormatValidator<char32_t> validator{ 85 /*???*/ nullptr, /*???*/ 0, reporterWrapper}; 86 validator.Check(); 87 break; 88 } 89 default: 90 CRASH_NO_CASE; 91 } 92 } 93 94 void IoChecker::Enter(const parser::ConnectSpec &spec) { 95 // ConnectSpec context FileNameExpr 96 if (std::get_if<parser::FileNameExpr>(&spec.u)) { 97 SetSpecifier(IoSpecKind::File); 98 } 99 } 100 101 // Ignore trailing spaces (12.5.6.2 p1) and convert to upper case 102 static std::string Normalize(const std::string &value) { 103 auto upper{parser::ToUpperCaseLetters(value)}; 104 std::size_t lastNonBlank{upper.find_last_not_of(" ")}; 105 upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1); 106 return upper; 107 } 108 109 void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) { 110 IoSpecKind specKind{}; 111 using ParseKind = parser::ConnectSpec::CharExpr::Kind; 112 switch (std::get<ParseKind>(spec.t)) { 113 case ParseKind::Access: 114 specKind = IoSpecKind::Access; 115 break; 116 case ParseKind::Action: 117 specKind = IoSpecKind::Action; 118 break; 119 case ParseKind::Asynchronous: 120 specKind = IoSpecKind::Asynchronous; 121 break; 122 case ParseKind::Blank: 123 specKind = IoSpecKind::Blank; 124 break; 125 case ParseKind::Decimal: 126 specKind = IoSpecKind::Decimal; 127 break; 128 case ParseKind::Delim: 129 specKind = IoSpecKind::Delim; 130 break; 131 case ParseKind::Encoding: 132 specKind = IoSpecKind::Encoding; 133 break; 134 case ParseKind::Form: 135 specKind = IoSpecKind::Form; 136 break; 137 case ParseKind::Pad: 138 specKind = IoSpecKind::Pad; 139 break; 140 case ParseKind::Position: 141 specKind = IoSpecKind::Position; 142 break; 143 case ParseKind::Round: 144 specKind = IoSpecKind::Round; 145 break; 146 case ParseKind::Sign: 147 specKind = IoSpecKind::Sign; 148 break; 149 case ParseKind::Carriagecontrol: 150 specKind = IoSpecKind::Carriagecontrol; 151 break; 152 case ParseKind::Convert: 153 specKind = IoSpecKind::Convert; 154 break; 155 case ParseKind::Dispose: 156 specKind = IoSpecKind::Dispose; 157 break; 158 } 159 SetSpecifier(specKind); 160 if (const std::optional<std::string> charConst{GetConstExpr<std::string>( 161 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { 162 std::string s{Normalize(*charConst)}; 163 if (specKind == IoSpecKind::Access) { 164 flags_.set(Flag::KnownAccess); 165 flags_.set(Flag::AccessDirect, s == "DIRECT"); 166 flags_.set(Flag::AccessStream, s == "STREAM"); 167 } 168 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); 169 if (specKind == IoSpecKind::Carriagecontrol && 170 (s == "FORTRAN" || s == "NONE")) { 171 context_.Say(parser::FindSourceLocation(spec), 172 "Unimplemented %s value '%s'"_err_en_US, 173 parser::ToUpperCaseLetters(common::EnumToString(specKind)), 174 *charConst); 175 } 176 } 177 } 178 179 void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) { 180 CheckForDefinableVariable(var, "NEWUNIT"); 181 SetSpecifier(IoSpecKind::Newunit); 182 } 183 184 void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) { 185 SetSpecifier(IoSpecKind::Recl); 186 if (const std::optional<std::int64_t> recl{ 187 GetConstExpr<std::int64_t>(spec)}) { 188 if (*recl <= 0) { 189 context_.Say(parser::FindSourceLocation(spec), 190 "RECL value (%jd) must be positive"_err_en_US, 191 *recl); // 12.5.6.15 192 } 193 } 194 } 195 196 void IoChecker::Enter(const parser::EndLabel &) { 197 SetSpecifier(IoSpecKind::End); 198 } 199 200 void IoChecker::Enter(const parser::EorLabel &) { 201 SetSpecifier(IoSpecKind::Eor); 202 } 203 204 void IoChecker::Enter(const parser::ErrLabel &) { 205 SetSpecifier(IoSpecKind::Err); 206 } 207 208 void IoChecker::Enter(const parser::FileUnitNumber &) { 209 SetSpecifier(IoSpecKind::Unit); 210 flags_.set(Flag::NumberUnit); 211 } 212 213 void IoChecker::Enter(const parser::Format &spec) { 214 SetSpecifier(IoSpecKind::Fmt); 215 flags_.set(Flag::FmtOrNml); 216 common::visit( 217 common::visitors{ 218 [&](const parser::Label &) { flags_.set(Flag::LabelFmt); }, 219 [&](const parser::Star &) { flags_.set(Flag::StarFmt); }, 220 [&](const parser::Expr &format) { 221 const SomeExpr *expr{GetExpr(context_, format)}; 222 if (!expr) { 223 return; 224 } 225 auto type{expr->GetType()}; 226 if (type && type->category() == TypeCategory::Integer && 227 type->kind() == 228 context_.defaultKinds().GetDefaultKind(type->category()) && 229 expr->Rank() == 0) { 230 flags_.set(Flag::AssignFmt); 231 if (!IsVariable(*expr)) { 232 context_.Say(format.source, 233 "Assigned format label must be a scalar variable"_err_en_US); 234 } 235 return; 236 } 237 if (type && type->category() != TypeCategory::Character && 238 (type->category() != TypeCategory::Integer || 239 expr->Rank() > 0) && 240 context_.IsEnabled( 241 common::LanguageFeature::NonCharacterFormat)) { 242 // Legacy extension: using non-character variables, typically 243 // DATA-initialized with Hollerith, as format expressions. 244 if (context_.ShouldWarn( 245 common::LanguageFeature::NonCharacterFormat)) { 246 context_.Say(format.source, 247 "Non-character format expression is not standard"_port_en_US); 248 } 249 } else if (!type || 250 type->kind() != 251 context_.defaultKinds().GetDefaultKind(type->category())) { 252 context_.Say(format.source, 253 "Format expression must be default character or default scalar integer"_err_en_US); 254 return; 255 } 256 flags_.set(Flag::CharFmt); 257 const std::optional<std::string> constantFormat{ 258 GetConstExpr<std::string>(format)}; 259 if (!constantFormat) { 260 return; 261 } 262 // validate constant format -- 12.6.2.2 263 bool isFolded{constantFormat->size() != format.source.size() - 2}; 264 parser::CharBlock reporterCharBlock{isFolded 265 ? parser::CharBlock{format.source} 266 : parser::CharBlock{format.source.begin() + 1, 267 static_cast<std::size_t>(0)}}; 268 FormatErrorReporter reporter{context_, reporterCharBlock}; 269 auto reporterWrapper{ 270 [&](const auto &msg) { return reporter.Say(msg); }}; 271 switch (context_.GetDefaultKind(TypeCategory::Character)) { 272 case 1: { 273 common::FormatValidator<char> validator{constantFormat->c_str(), 274 constantFormat->length(), reporterWrapper, stmt_}; 275 validator.Check(); 276 break; 277 } 278 case 2: { 279 // TODO: Get this to work. (Maybe combine with earlier instance?) 280 common::FormatValidator<char16_t> validator{ 281 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; 282 validator.Check(); 283 break; 284 } 285 case 4: { 286 // TODO: Get this to work. (Maybe combine with earlier instance?) 287 common::FormatValidator<char32_t> validator{ 288 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; 289 validator.Check(); 290 break; 291 } 292 default: 293 CRASH_NO_CASE; 294 } 295 }, 296 }, 297 spec.u); 298 } 299 300 void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); } 301 302 void IoChecker::Enter(const parser::IdVariable &spec) { 303 SetSpecifier(IoSpecKind::Id); 304 const auto *expr{GetExpr(context_, spec)}; 305 if (!expr || !expr->GetType()) { 306 return; 307 } 308 CheckForDefinableVariable(spec, "ID"); 309 int kind{expr->GetType()->kind()}; 310 int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)}; 311 if (kind < defaultKind) { 312 context_.Say( 313 "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US, 314 std::move(kind), std::move(defaultKind)); // C1229 315 } 316 } 317 318 void IoChecker::Enter(const parser::InputItem &spec) { 319 flags_.set(Flag::DataList); 320 const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)}; 321 if (!var) { 322 return; 323 } 324 CheckForDefinableVariable(*var, "Input"); 325 if (auto expr{AnalyzeExpr(context_, *var)}) { 326 CheckForBadIoType(*expr, 327 flags_.test(Flag::FmtOrNml) ? GenericKind::DefinedIo::ReadFormatted 328 : GenericKind::DefinedIo::ReadUnformatted, 329 var->GetSource()); 330 } 331 } 332 333 void IoChecker::Enter(const parser::InquireSpec &spec) { 334 // InquireSpec context FileNameExpr 335 if (std::get_if<parser::FileNameExpr>(&spec.u)) { 336 SetSpecifier(IoSpecKind::File); 337 } 338 } 339 340 void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) { 341 IoSpecKind specKind{}; 342 using ParseKind = parser::InquireSpec::CharVar::Kind; 343 switch (std::get<ParseKind>(spec.t)) { 344 case ParseKind::Access: 345 specKind = IoSpecKind::Access; 346 break; 347 case ParseKind::Action: 348 specKind = IoSpecKind::Action; 349 break; 350 case ParseKind::Asynchronous: 351 specKind = IoSpecKind::Asynchronous; 352 break; 353 case ParseKind::Blank: 354 specKind = IoSpecKind::Blank; 355 break; 356 case ParseKind::Decimal: 357 specKind = IoSpecKind::Decimal; 358 break; 359 case ParseKind::Delim: 360 specKind = IoSpecKind::Delim; 361 break; 362 case ParseKind::Direct: 363 specKind = IoSpecKind::Direct; 364 break; 365 case ParseKind::Encoding: 366 specKind = IoSpecKind::Encoding; 367 break; 368 case ParseKind::Form: 369 specKind = IoSpecKind::Form; 370 break; 371 case ParseKind::Formatted: 372 specKind = IoSpecKind::Formatted; 373 break; 374 case ParseKind::Iomsg: 375 specKind = IoSpecKind::Iomsg; 376 break; 377 case ParseKind::Name: 378 specKind = IoSpecKind::Name; 379 break; 380 case ParseKind::Pad: 381 specKind = IoSpecKind::Pad; 382 break; 383 case ParseKind::Position: 384 specKind = IoSpecKind::Position; 385 break; 386 case ParseKind::Read: 387 specKind = IoSpecKind::Read; 388 break; 389 case ParseKind::Readwrite: 390 specKind = IoSpecKind::Readwrite; 391 break; 392 case ParseKind::Round: 393 specKind = IoSpecKind::Round; 394 break; 395 case ParseKind::Sequential: 396 specKind = IoSpecKind::Sequential; 397 break; 398 case ParseKind::Sign: 399 specKind = IoSpecKind::Sign; 400 break; 401 case ParseKind::Status: 402 specKind = IoSpecKind::Status; 403 break; 404 case ParseKind::Stream: 405 specKind = IoSpecKind::Stream; 406 break; 407 case ParseKind::Unformatted: 408 specKind = IoSpecKind::Unformatted; 409 break; 410 case ParseKind::Write: 411 specKind = IoSpecKind::Write; 412 break; 413 case ParseKind::Carriagecontrol: 414 specKind = IoSpecKind::Carriagecontrol; 415 break; 416 case ParseKind::Convert: 417 specKind = IoSpecKind::Convert; 418 break; 419 case ParseKind::Dispose: 420 specKind = IoSpecKind::Dispose; 421 break; 422 } 423 CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t), 424 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 425 SetSpecifier(specKind); 426 } 427 428 void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) { 429 IoSpecKind specKind{}; 430 using ParseKind = parser::InquireSpec::IntVar::Kind; 431 switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) { 432 case ParseKind::Iostat: 433 specKind = IoSpecKind::Iostat; 434 break; 435 case ParseKind::Nextrec: 436 specKind = IoSpecKind::Nextrec; 437 break; 438 case ParseKind::Number: 439 specKind = IoSpecKind::Number; 440 break; 441 case ParseKind::Pos: 442 specKind = IoSpecKind::Pos; 443 break; 444 case ParseKind::Recl: 445 specKind = IoSpecKind::Recl; 446 break; 447 case ParseKind::Size: 448 specKind = IoSpecKind::Size; 449 break; 450 } 451 CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t), 452 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 453 SetSpecifier(specKind); 454 } 455 456 void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) { 457 IoSpecKind specKind{}; 458 using ParseKind = parser::InquireSpec::LogVar::Kind; 459 switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) { 460 case ParseKind::Exist: 461 specKind = IoSpecKind::Exist; 462 break; 463 case ParseKind::Named: 464 specKind = IoSpecKind::Named; 465 break; 466 case ParseKind::Opened: 467 specKind = IoSpecKind::Opened; 468 break; 469 case ParseKind::Pending: 470 specKind = IoSpecKind::Pending; 471 break; 472 } 473 SetSpecifier(specKind); 474 } 475 476 void IoChecker::Enter(const parser::IoControlSpec &spec) { 477 // IoControlSpec context Name 478 flags_.set(Flag::IoControlList); 479 if (std::holds_alternative<parser::Name>(spec.u)) { 480 SetSpecifier(IoSpecKind::Nml); 481 flags_.set(Flag::FmtOrNml); 482 } 483 } 484 485 void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) { 486 SetSpecifier(IoSpecKind::Asynchronous); 487 if (const std::optional<std::string> charConst{ 488 GetConstExpr<std::string>(spec)}) { 489 flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES"); 490 CheckStringValue(IoSpecKind::Asynchronous, *charConst, 491 parser::FindSourceLocation(spec)); // C1223 492 } 493 } 494 495 void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) { 496 IoSpecKind specKind{}; 497 using ParseKind = parser::IoControlSpec::CharExpr::Kind; 498 switch (std::get<ParseKind>(spec.t)) { 499 case ParseKind::Advance: 500 specKind = IoSpecKind::Advance; 501 break; 502 case ParseKind::Blank: 503 specKind = IoSpecKind::Blank; 504 break; 505 case ParseKind::Decimal: 506 specKind = IoSpecKind::Decimal; 507 break; 508 case ParseKind::Delim: 509 specKind = IoSpecKind::Delim; 510 break; 511 case ParseKind::Pad: 512 specKind = IoSpecKind::Pad; 513 break; 514 case ParseKind::Round: 515 specKind = IoSpecKind::Round; 516 break; 517 case ParseKind::Sign: 518 specKind = IoSpecKind::Sign; 519 break; 520 } 521 SetSpecifier(specKind); 522 if (const std::optional<std::string> charConst{GetConstExpr<std::string>( 523 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { 524 if (specKind == IoSpecKind::Advance) { 525 flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES"); 526 } 527 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); 528 } 529 } 530 531 void IoChecker::Enter(const parser::IoControlSpec::Pos &) { 532 SetSpecifier(IoSpecKind::Pos); 533 } 534 535 void IoChecker::Enter(const parser::IoControlSpec::Rec &) { 536 SetSpecifier(IoSpecKind::Rec); 537 } 538 539 void IoChecker::Enter(const parser::IoControlSpec::Size &var) { 540 CheckForDefinableVariable(var, "SIZE"); 541 SetSpecifier(IoSpecKind::Size); 542 } 543 544 void IoChecker::Enter(const parser::IoUnit &spec) { 545 if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) { 546 // Only now after generic resolution can it be known whether a function 547 // call appearing as UNIT=f() is an integer scalar external unit number 548 // or a character pointer for internal I/O. 549 const auto *expr{GetExpr(context_, *var)}; 550 std::optional<evaluate::DynamicType> dyType; 551 if (expr) { 552 dyType = expr->GetType(); 553 } 554 if (dyType && dyType->category() == TypeCategory::Integer) { 555 if (expr->Rank() != 0) { 556 context_.Say(parser::FindSourceLocation(*var), 557 "I/O unit number must be scalar"_err_en_US); 558 } 559 // In the case of an integer unit number variable, rewrite the parse 560 // tree as if the unit had been parsed as a FileUnitNumber in order 561 // to ease lowering. 562 auto &mutableSpec{const_cast<parser::IoUnit &>(spec)}; 563 auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)}; 564 auto source{mutableVar.GetSource()}; 565 auto typedExpr{std::move(mutableVar.typedExpr)}; 566 auto newExpr{common::visit( 567 [](auto &&indirection) { 568 return parser::Expr{std::move(indirection)}; 569 }, 570 std::move(mutableVar.u))}; 571 newExpr.source = source; 572 newExpr.typedExpr = std::move(typedExpr); 573 mutableSpec.u = parser::FileUnitNumber{ 574 parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}}; 575 } else if (!dyType || dyType->category() != TypeCategory::Character) { 576 SetSpecifier(IoSpecKind::Unit); 577 context_.Say(parser::FindSourceLocation(*var), 578 "I/O unit must be a character variable or a scalar integer expression"_err_en_US); 579 } else { // CHARACTER variable (internal I/O) 580 if (stmt_ == IoStmtKind::Write) { 581 CheckForDefinableVariable(*var, "Internal file"); 582 } 583 if (HasVectorSubscript(*expr)) { 584 context_.Say(parser::FindSourceLocation(*var), // C1201 585 "Internal file must not have a vector subscript"_err_en_US); 586 } 587 SetSpecifier(IoSpecKind::Unit); 588 flags_.set(Flag::InternalUnit); 589 } 590 } else if (std::get_if<parser::Star>(&spec.u)) { 591 SetSpecifier(IoSpecKind::Unit); 592 flags_.set(Flag::StarUnit); 593 } 594 } 595 596 void IoChecker::Enter(const parser::MsgVariable &var) { 597 if (stmt_ == IoStmtKind::None) { 598 // allocate, deallocate, image control 599 CheckForDefinableVariable(var, "ERRMSG"); 600 return; 601 } 602 CheckForDefinableVariable(var, "IOMSG"); 603 SetSpecifier(IoSpecKind::Iomsg); 604 } 605 606 void IoChecker::Enter(const parser::OutputItem &item) { 607 flags_.set(Flag::DataList); 608 if (const auto *x{std::get_if<parser::Expr>(&item.u)}) { 609 if (const auto *expr{GetExpr(context_, *x)}) { 610 if (evaluate::IsBOZLiteral(*expr)) { 611 context_.Say(parser::FindSourceLocation(*x), // C7109 612 "Output item must not be a BOZ literal constant"_err_en_US); 613 } 614 const Symbol *last{GetLastSymbol(*expr)}; 615 if (last && IsProcedurePointer(*last)) { 616 context_.Say(parser::FindSourceLocation(*x), 617 "Output item must not be a procedure pointer"_err_en_US); // C1233 618 } 619 CheckForBadIoType(*expr, 620 flags_.test(Flag::FmtOrNml) 621 ? GenericKind::DefinedIo::WriteFormatted 622 : GenericKind::DefinedIo::WriteUnformatted, 623 parser::FindSourceLocation(item)); 624 } 625 } 626 } 627 628 void IoChecker::Enter(const parser::StatusExpr &spec) { 629 SetSpecifier(IoSpecKind::Status); 630 if (const std::optional<std::string> charConst{ 631 GetConstExpr<std::string>(spec)}) { 632 // Status values for Open and Close are different. 633 std::string s{Normalize(*charConst)}; 634 if (stmt_ == IoStmtKind::Open) { 635 flags_.set(Flag::KnownStatus); 636 flags_.set(Flag::StatusNew, s == "NEW"); 637 flags_.set(Flag::StatusReplace, s == "REPLACE"); 638 flags_.set(Flag::StatusScratch, s == "SCRATCH"); 639 // CheckStringValue compares for OPEN Status string values. 640 CheckStringValue( 641 IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec)); 642 return; 643 } 644 CHECK(stmt_ == IoStmtKind::Close); 645 if (s != "DELETE" && s != "KEEP") { 646 context_.Say(parser::FindSourceLocation(spec), 647 "Invalid STATUS value '%s'"_err_en_US, *charConst); 648 } 649 } 650 } 651 652 void IoChecker::Enter(const parser::StatVariable &var) { 653 if (stmt_ == IoStmtKind::None) { 654 // allocate, deallocate, image control 655 CheckForDefinableVariable(var, "STAT"); 656 return; 657 } 658 CheckForDefinableVariable(var, "IOSTAT"); 659 SetSpecifier(IoSpecKind::Iostat); 660 } 661 662 void IoChecker::Leave(const parser::BackspaceStmt &) { 663 CheckForPureSubprogram(); 664 CheckForRequiredSpecifier( 665 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 666 Done(); 667 } 668 669 void IoChecker::Leave(const parser::CloseStmt &) { 670 CheckForPureSubprogram(); 671 CheckForRequiredSpecifier( 672 flags_.test(Flag::NumberUnit), "UNIT number"); // C1208 673 Done(); 674 } 675 676 void IoChecker::Leave(const parser::EndfileStmt &) { 677 CheckForPureSubprogram(); 678 CheckForRequiredSpecifier( 679 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 680 Done(); 681 } 682 683 void IoChecker::Leave(const parser::FlushStmt &) { 684 CheckForPureSubprogram(); 685 CheckForRequiredSpecifier( 686 flags_.test(Flag::NumberUnit), "UNIT number"); // C1243 687 Done(); 688 } 689 690 void IoChecker::Leave(const parser::InquireStmt &stmt) { 691 if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) { 692 CheckForPureSubprogram(); 693 // Inquire by unit or by file (vs. by output list). 694 CheckForRequiredSpecifier( 695 flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File), 696 "UNIT number or FILE"); // C1246 697 CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246 698 CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248 699 } 700 Done(); 701 } 702 703 void IoChecker::Leave(const parser::OpenStmt &) { 704 CheckForPureSubprogram(); 705 CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) || 706 specifierSet_.test(IoSpecKind::Newunit), 707 "UNIT or NEWUNIT"); // C1204, C1205 708 CheckForProhibitedSpecifier( 709 IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205 710 CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'", 711 IoSpecKind::File); // 12.5.6.10 712 CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace), 713 "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10 714 CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch), 715 "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10 716 if (flags_.test(Flag::KnownStatus)) { 717 CheckForRequiredSpecifier(IoSpecKind::Newunit, 718 specifierSet_.test(IoSpecKind::File) || 719 flags_.test(Flag::StatusScratch), 720 "FILE or STATUS='SCRATCH'"); // 12.5.6.12 721 } else { 722 CheckForRequiredSpecifier(IoSpecKind::Newunit, 723 specifierSet_.test(IoSpecKind::File) || 724 specifierSet_.test(IoSpecKind::Status), 725 "FILE or STATUS"); // 12.5.6.12 726 } 727 if (flags_.test(Flag::KnownAccess)) { 728 CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect), 729 "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15 730 CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream), 731 "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15 732 } 733 Done(); 734 } 735 736 void IoChecker::Leave(const parser::PrintStmt &) { 737 CheckForPureSubprogram(); 738 Done(); 739 } 740 741 static const parser::Name *FindNamelist( 742 const std::list<parser::IoControlSpec> &controls) { 743 for (const auto &control : controls) { 744 if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) { 745 if (namelist->symbol && 746 namelist->symbol->GetUltimate().has<NamelistDetails>()) { 747 return namelist; 748 } 749 } 750 } 751 return nullptr; 752 } 753 754 static void CheckForDoVariable( 755 const parser::ReadStmt &readStmt, SemanticsContext &context) { 756 const std::list<parser::InputItem> &items{readStmt.items}; 757 for (const auto &item : items) { 758 if (const parser::Variable * 759 variable{std::get_if<parser::Variable>(&item.u)}) { 760 context.CheckIndexVarRedefine(*variable); 761 } 762 } 763 } 764 765 void IoChecker::Leave(const parser::ReadStmt &readStmt) { 766 if (!flags_.test(Flag::InternalUnit)) { 767 CheckForPureSubprogram(); 768 } 769 if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) { 770 if (namelist->symbol) { 771 CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::ReadFormatted, 772 namelist->source); 773 } 774 } 775 CheckForDoVariable(readStmt, context_); 776 if (!flags_.test(Flag::IoControlList)) { 777 Done(); 778 return; 779 } 780 LeaveReadWrite(); 781 CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212 782 CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212 783 CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220 784 CheckForRequiredSpecifier(IoSpecKind::Eor, 785 specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes), 786 "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2 787 CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml), 788 "FMT or NML"); // C1227 789 CheckForRequiredSpecifier( 790 IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 791 Done(); 792 } 793 794 void IoChecker::Leave(const parser::RewindStmt &) { 795 CheckForRequiredSpecifier( 796 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 797 CheckForPureSubprogram(); 798 Done(); 799 } 800 801 void IoChecker::Leave(const parser::WaitStmt &) { 802 CheckForRequiredSpecifier( 803 flags_.test(Flag::NumberUnit), "UNIT number"); // C1237 804 CheckForPureSubprogram(); 805 Done(); 806 } 807 808 void IoChecker::Leave(const parser::WriteStmt &writeStmt) { 809 if (!flags_.test(Flag::InternalUnit)) { 810 CheckForPureSubprogram(); 811 } 812 if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) { 813 if (namelist->symbol) { 814 CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::WriteFormatted, 815 namelist->source); 816 } 817 } 818 LeaveReadWrite(); 819 CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213 820 CheckForProhibitedSpecifier(IoSpecKind::End); // C1213 821 CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213 822 CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213 823 CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213 824 CheckForRequiredSpecifier( 825 IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 826 CheckForRequiredSpecifier(IoSpecKind::Delim, 827 flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml), 828 "FMT=* or NML"); // C1228 829 Done(); 830 } 831 832 void IoChecker::LeaveReadWrite() const { 833 CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211 834 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216 835 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216 836 CheckForProhibitedSpecifier( 837 IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216 838 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), 839 "UNIT=internal-file", IoSpecKind::Pos); // C1219 840 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), 841 "UNIT=internal-file", IoSpecKind::Rec); // C1219 842 CheckForProhibitedSpecifier( 843 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219 844 CheckForProhibitedSpecifier( 845 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219 846 CheckForProhibitedSpecifier( 847 IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220 848 CheckForRequiredSpecifier(IoSpecKind::Advance, 849 flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) || 850 flags_.test(Flag::AssignFmt), 851 "an explicit format"); // C1221 852 CheckForProhibitedSpecifier(IoSpecKind::Advance, 853 flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221 854 CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes), 855 "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit), 856 "UNIT=number"); // C1224 857 CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes), 858 "ASYNCHRONOUS='YES'"); // C1225 859 CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226 860 CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml), 861 "FMT or NML"); // C1227 862 CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml), 863 "FMT or NML"); // C1227 864 } 865 866 void IoChecker::SetSpecifier(IoSpecKind specKind) { 867 if (stmt_ == IoStmtKind::None) { 868 // FMT may appear on PRINT statements, which don't have any checks. 869 // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements. 870 return; 871 } 872 // C1203, C1207, C1210, C1236, C1239, C1242, C1245 873 if (specifierSet_.test(specKind)) { 874 context_.Say("Duplicate %s specifier"_err_en_US, 875 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 876 } 877 specifierSet_.set(specKind); 878 } 879 880 void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value, 881 const parser::CharBlock &source) const { 882 static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{ 883 {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}}, 884 {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}}, 885 {IoSpecKind::Advance, {"NO", "YES"}}, 886 {IoSpecKind::Asynchronous, {"NO", "YES"}}, 887 {IoSpecKind::Blank, {"NULL", "ZERO"}}, 888 {IoSpecKind::Decimal, {"COMMA", "POINT"}}, 889 {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}}, 890 {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}}, 891 {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}}, 892 {IoSpecKind::Pad, {"NO", "YES"}}, 893 {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}}, 894 {IoSpecKind::Round, 895 {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}}, 896 {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}}, 897 {IoSpecKind::Status, 898 // Open values; Close values are {"DELETE", "KEEP"}. 899 {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}}, 900 {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}}, 901 {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}}, 902 {IoSpecKind::Dispose, {"DELETE", "KEEP"}}, 903 }; 904 auto upper{Normalize(value)}; 905 if (specValues.at(specKind).count(upper) == 0) { 906 if (specKind == IoSpecKind::Access && upper == "APPEND") { 907 if (context_.languageFeatures().ShouldWarn( 908 common::LanguageFeature::OpenAccessAppend)) { 909 context_.Say(source, 910 "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, 911 upper); 912 } 913 } else { 914 context_.Say(source, "Invalid %s value '%s'"_err_en_US, 915 parser::ToUpperCaseLetters(common::EnumToString(specKind)), value); 916 } 917 } 918 } 919 920 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions 921 // need conditions to check, and string arguments to insert into a message. 922 // An IoSpecKind provides both an absence/presence condition and a string 923 // argument (its name). A (condition, string) pair provides an arbitrary 924 // condition and an arbitrary string. 925 926 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const { 927 if (!specifierSet_.test(specKind)) { 928 context_.Say("%s statement must have a %s specifier"_err_en_US, 929 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), 930 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 931 } 932 } 933 934 void IoChecker::CheckForRequiredSpecifier( 935 bool condition, const std::string &s) const { 936 if (!condition) { 937 context_.Say("%s statement must have a %s specifier"_err_en_US, 938 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s); 939 } 940 } 941 942 void IoChecker::CheckForRequiredSpecifier( 943 IoSpecKind specKind1, IoSpecKind specKind2) const { 944 if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) { 945 context_.Say("If %s appears, %s must also appear"_err_en_US, 946 parser::ToUpperCaseLetters(common::EnumToString(specKind1)), 947 parser::ToUpperCaseLetters(common::EnumToString(specKind2))); 948 } 949 } 950 951 void IoChecker::CheckForRequiredSpecifier( 952 IoSpecKind specKind, bool condition, const std::string &s) const { 953 if (specifierSet_.test(specKind) && !condition) { 954 context_.Say("If %s appears, %s must also appear"_err_en_US, 955 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); 956 } 957 } 958 959 void IoChecker::CheckForRequiredSpecifier( 960 bool condition, const std::string &s, IoSpecKind specKind) const { 961 if (condition && !specifierSet_.test(specKind)) { 962 context_.Say("If %s appears, %s must also appear"_err_en_US, s, 963 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 964 } 965 } 966 967 void IoChecker::CheckForRequiredSpecifier(bool condition1, 968 const std::string &s1, bool condition2, const std::string &s2) const { 969 if (condition1 && !condition2) { 970 context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2); 971 } 972 } 973 974 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const { 975 if (specifierSet_.test(specKind)) { 976 context_.Say("%s statement must not have a %s specifier"_err_en_US, 977 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), 978 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 979 } 980 } 981 982 void IoChecker::CheckForProhibitedSpecifier( 983 IoSpecKind specKind1, IoSpecKind specKind2) const { 984 if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) { 985 context_.Say("If %s appears, %s must not appear"_err_en_US, 986 parser::ToUpperCaseLetters(common::EnumToString(specKind1)), 987 parser::ToUpperCaseLetters(common::EnumToString(specKind2))); 988 } 989 } 990 991 void IoChecker::CheckForProhibitedSpecifier( 992 IoSpecKind specKind, bool condition, const std::string &s) const { 993 if (specifierSet_.test(specKind) && condition) { 994 context_.Say("If %s appears, %s must not appear"_err_en_US, 995 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); 996 } 997 } 998 999 void IoChecker::CheckForProhibitedSpecifier( 1000 bool condition, const std::string &s, IoSpecKind specKind) const { 1001 if (condition && specifierSet_.test(specKind)) { 1002 context_.Say("If %s appears, %s must not appear"_err_en_US, s, 1003 parser::ToUpperCaseLetters(common::EnumToString(specKind))); 1004 } 1005 } 1006 1007 template <typename A> 1008 void IoChecker::CheckForDefinableVariable( 1009 const A &variable, const std::string &s) const { 1010 if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) { 1011 if (auto expr{AnalyzeExpr(context_, *var)}) { 1012 auto at{var->GetSource()}; 1013 if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at), 1014 DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, 1015 *expr)}) { 1016 const Symbol *base{GetFirstSymbol(*expr)}; 1017 context_ 1018 .Say(at, "%s variable '%s' is not definable"_err_en_US, s, 1019 (base ? base->name() : at).ToString()) 1020 .Attach(std::move(*whyNot)); 1021 } 1022 } 1023 } 1024 } 1025 1026 void IoChecker::CheckForPureSubprogram() const { // C1597 1027 CHECK(context_.location()); 1028 if (const Scope * 1029 scope{context_.globalScope().FindScope(*context_.location())}) { 1030 if (FindPureProcedureContaining(*scope)) { 1031 context_.Say( 1032 "External I/O is not allowed in a pure subprogram"_err_en_US); 1033 } 1034 } 1035 } 1036 1037 // Seeks out an allocatable or pointer ultimate component that is not 1038 // nested in a nonallocatable/nonpointer component with a specific 1039 // defined I/O procedure. 1040 static const Symbol *FindUnsafeIoDirectComponent(GenericKind::DefinedIo which, 1041 const DerivedTypeSpec &derived, const Scope &scope) { 1042 if (HasDefinedIo(which, derived, &scope)) { 1043 return nullptr; 1044 } 1045 if (const Scope * dtScope{derived.scope()}) { 1046 for (const auto &pair : *dtScope) { 1047 const Symbol &symbol{*pair.second}; 1048 if (IsAllocatableOrPointer(symbol)) { 1049 return &symbol; 1050 } 1051 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { 1052 if (const DeclTypeSpec * type{details->type()}) { 1053 if (type->category() == DeclTypeSpec::Category::TypeDerived) { 1054 const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()}; 1055 if (const Symbol * 1056 bad{FindUnsafeIoDirectComponent( 1057 which, componentDerived, scope)}) { 1058 return bad; 1059 } 1060 } 1061 } 1062 } 1063 } 1064 } 1065 return nullptr; 1066 } 1067 1068 // For a type that does not have a defined I/O subroutine, finds a direct 1069 // component that is a witness to an accessibility violation outside the module 1070 // in which the type was defined. 1071 static const Symbol *FindInaccessibleComponent(GenericKind::DefinedIo which, 1072 const DerivedTypeSpec &derived, const Scope &scope) { 1073 if (const Scope * dtScope{derived.scope()}) { 1074 if (const Scope * module{FindModuleContaining(*dtScope)}) { 1075 for (const auto &pair : *dtScope) { 1076 const Symbol &symbol{*pair.second}; 1077 if (IsAllocatableOrPointer(symbol)) { 1078 continue; // already an error 1079 } 1080 if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { 1081 const DerivedTypeSpec *componentDerived{nullptr}; 1082 if (const DeclTypeSpec * type{details->type()}) { 1083 if (type->category() == DeclTypeSpec::Category::TypeDerived) { 1084 componentDerived = &type->derivedTypeSpec(); 1085 } 1086 } 1087 if (componentDerived && 1088 HasDefinedIo(which, *componentDerived, &scope)) { 1089 continue; // this component and its descendents are fine 1090 } 1091 if (symbol.attrs().test(Attr::PRIVATE) && 1092 !symbol.test(Symbol::Flag::ParentComp)) { 1093 if (!DoesScopeContain(module, scope)) { 1094 return &symbol; 1095 } 1096 } 1097 if (componentDerived) { 1098 if (const Symbol * 1099 bad{FindInaccessibleComponent( 1100 which, *componentDerived, scope)}) { 1101 return bad; 1102 } 1103 } 1104 } 1105 } 1106 } 1107 } 1108 return nullptr; 1109 } 1110 1111 // Fortran 2018, 12.6.3 paragraphs 5 & 7 1112 parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type, 1113 GenericKind::DefinedIo which, parser::CharBlock where) const { 1114 if (type.IsUnlimitedPolymorphic()) { 1115 return &context_.Say( 1116 where, "I/O list item may not be unlimited polymorphic"_err_en_US); 1117 } else if (type.category() == TypeCategory::Derived) { 1118 const auto &derived{type.GetDerivedTypeSpec()}; 1119 const Scope &scope{context_.FindScope(where)}; 1120 if (const Symbol * 1121 bad{FindUnsafeIoDirectComponent(which, derived, scope)}) { 1122 return &context_.SayWithDecl(*bad, where, 1123 "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US, 1124 derived.name(), bad->name()); 1125 } 1126 if (!HasDefinedIo(which, derived, &scope)) { 1127 if (type.IsPolymorphic()) { 1128 return &context_.Say(where, 1129 "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US, 1130 derived.name()); 1131 } 1132 if (const Symbol * 1133 bad{FindInaccessibleComponent(which, derived, scope)}) { 1134 return &context_.Say(where, 1135 "I/O of the derived type '%s' may not be performed without defined I/O in a scope in which a direct component like '%s' is inaccessible"_err_en_US, 1136 derived.name(), bad->name()); 1137 } 1138 } 1139 } 1140 return nullptr; 1141 } 1142 1143 void IoChecker::CheckForBadIoType(const SomeExpr &expr, 1144 GenericKind::DefinedIo which, parser::CharBlock where) const { 1145 if (auto type{expr.GetType()}) { 1146 CheckForBadIoType(*type, which, where); 1147 } 1148 } 1149 1150 parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol, 1151 GenericKind::DefinedIo which, parser::CharBlock where) const { 1152 if (auto type{evaluate::DynamicType::From(symbol)}) { 1153 if (auto *msg{CheckForBadIoType(*type, which, where)}) { 1154 evaluate::AttachDeclaration(*msg, symbol); 1155 return msg; 1156 } 1157 } 1158 return nullptr; 1159 } 1160 1161 void IoChecker::CheckNamelist(const Symbol &namelist, 1162 GenericKind::DefinedIo which, parser::CharBlock namelistLocation) const { 1163 const auto &details{namelist.GetUltimate().get<NamelistDetails>()}; 1164 for (const Symbol &object : details.objects()) { 1165 context_.CheckIndexVarRedefine(namelistLocation, object); 1166 if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) { 1167 evaluate::AttachDeclaration(*msg, namelist); 1168 } 1169 } 1170 } 1171 1172 } // namespace Fortran::semantics 1173