flang/lib/Semantics/check-io.cpp

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