xref: /llvm-project/flang/lib/Semantics/check-io.cpp (revision 300370c27b31ced572b957b6efdbb2bcee277392)
164ab3302SCarolineConcatto //===-- lib/Semantics/check-io.cpp ----------------------------------------===//
264ab3302SCarolineConcatto //
364ab3302SCarolineConcatto // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
464ab3302SCarolineConcatto // See https://llvm.org/LICENSE.txt for license information.
564ab3302SCarolineConcatto // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
664ab3302SCarolineConcatto //
764ab3302SCarolineConcatto //===----------------------------------------------------------------------===//
864ab3302SCarolineConcatto 
964ab3302SCarolineConcatto #include "check-io.h"
10573fc618SPeter Klausler #include "definable.h"
1164ab3302SCarolineConcatto #include "flang/Common/format.h"
12571673ceSPeter Steinfeld #include "flang/Evaluate/tools.h"
1364ab3302SCarolineConcatto #include "flang/Parser/tools.h"
1464ab3302SCarolineConcatto #include "flang/Semantics/expression.h"
1564ab3302SCarolineConcatto #include "flang/Semantics/tools.h"
1664ab3302SCarolineConcatto #include <unordered_map>
1764ab3302SCarolineConcatto 
1864ab3302SCarolineConcatto namespace Fortran::semantics {
1964ab3302SCarolineConcatto 
2064ab3302SCarolineConcatto // TODO: C1234, C1235 -- defined I/O constraints
2164ab3302SCarolineConcatto 
2264ab3302SCarolineConcatto class FormatErrorReporter {
2364ab3302SCarolineConcatto public:
2464ab3302SCarolineConcatto   FormatErrorReporter(SemanticsContext &context,
2564ab3302SCarolineConcatto       const parser::CharBlock &formatCharBlock, int errorAllowance = 3)
2664ab3302SCarolineConcatto       : context_{context}, formatCharBlock_{formatCharBlock},
2764ab3302SCarolineConcatto         errorAllowance_{errorAllowance} {}
2864ab3302SCarolineConcatto 
2964ab3302SCarolineConcatto   bool Say(const common::FormatMessage &);
3064ab3302SCarolineConcatto 
3164ab3302SCarolineConcatto private:
3264ab3302SCarolineConcatto   SemanticsContext &context_;
3364ab3302SCarolineConcatto   const parser::CharBlock &formatCharBlock_;
3464ab3302SCarolineConcatto   int errorAllowance_; // initialized to maximum number of errors to report
3564ab3302SCarolineConcatto };
3664ab3302SCarolineConcatto 
3764ab3302SCarolineConcatto bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
38191d4872SPeter Klausler   if (!msg.isError &&
39191d4872SPeter Klausler       !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) {
4064ab3302SCarolineConcatto     return false;
4164ab3302SCarolineConcatto   }
4264ab3302SCarolineConcatto   parser::MessageFormattedText text{
432895771fSPeter Klausler       parser::MessageFixedText{msg.text, strlen(msg.text),
442895771fSPeter Klausler           msg.isError ? parser::Severity::Error : parser::Severity::Warning},
4564ab3302SCarolineConcatto       msg.arg};
4664ab3302SCarolineConcatto   if (formatCharBlock_.size()) {
4764ab3302SCarolineConcatto     // The input format is a folded expression.  Error markers span the full
4864ab3302SCarolineConcatto     // original unfolded expression in formatCharBlock_.
4964ab3302SCarolineConcatto     context_.Say(formatCharBlock_, text);
5064ab3302SCarolineConcatto   } else {
5164ab3302SCarolineConcatto     // The input format is a source expression.  Error markers have an offset
5264ab3302SCarolineConcatto     // and length relative to the beginning of formatCharBlock_.
5364ab3302SCarolineConcatto     parser::CharBlock messageCharBlock{
5464ab3302SCarolineConcatto         parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};
5564ab3302SCarolineConcatto     context_.Say(messageCharBlock, text);
5664ab3302SCarolineConcatto   }
5764ab3302SCarolineConcatto   return msg.isError && --errorAllowance_ <= 0;
5864ab3302SCarolineConcatto }
5964ab3302SCarolineConcatto 
6064ab3302SCarolineConcatto void IoChecker::Enter(
6164ab3302SCarolineConcatto     const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {
6264ab3302SCarolineConcatto   if (!stmt.label) {
6364ab3302SCarolineConcatto     context_.Say("Format statement must be labeled"_err_en_US); // C1301
6464ab3302SCarolineConcatto   }
6564ab3302SCarolineConcatto   const char *formatStart{static_cast<const char *>(
6664ab3302SCarolineConcatto       std::memchr(stmt.source.begin(), '(', stmt.source.size()))};
6764ab3302SCarolineConcatto   parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};
6864ab3302SCarolineConcatto   FormatErrorReporter reporter{context_, reporterCharBlock};
6964ab3302SCarolineConcatto   auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};
7064ab3302SCarolineConcatto   switch (context_.GetDefaultKind(TypeCategory::Character)) {
7164ab3302SCarolineConcatto   case 1: {
7264ab3302SCarolineConcatto     common::FormatValidator<char> validator{formatStart,
7364ab3302SCarolineConcatto         stmt.source.size() - (formatStart - stmt.source.begin()),
7464ab3302SCarolineConcatto         reporterWrapper};
7564ab3302SCarolineConcatto     validator.Check();
7664ab3302SCarolineConcatto     break;
7764ab3302SCarolineConcatto   }
7864ab3302SCarolineConcatto   case 2: { // TODO: Get this to work.
7964ab3302SCarolineConcatto     common::FormatValidator<char16_t> validator{
8064ab3302SCarolineConcatto         /*???*/ nullptr, /*???*/ 0, reporterWrapper};
8164ab3302SCarolineConcatto     validator.Check();
8264ab3302SCarolineConcatto     break;
8364ab3302SCarolineConcatto   }
8464ab3302SCarolineConcatto   case 4: { // TODO: Get this to work.
8564ab3302SCarolineConcatto     common::FormatValidator<char32_t> validator{
8664ab3302SCarolineConcatto         /*???*/ nullptr, /*???*/ 0, reporterWrapper};
8764ab3302SCarolineConcatto     validator.Check();
8864ab3302SCarolineConcatto     break;
8964ab3302SCarolineConcatto   }
901f879005STim Keith   default:
911f879005STim Keith     CRASH_NO_CASE;
9264ab3302SCarolineConcatto   }
9364ab3302SCarolineConcatto }
9464ab3302SCarolineConcatto 
9564ab3302SCarolineConcatto void IoChecker::Enter(const parser::ConnectSpec &spec) {
9664ab3302SCarolineConcatto   // ConnectSpec context FileNameExpr
9764ab3302SCarolineConcatto   if (std::get_if<parser::FileNameExpr>(&spec.u)) {
9864ab3302SCarolineConcatto     SetSpecifier(IoSpecKind::File);
9964ab3302SCarolineConcatto   }
10064ab3302SCarolineConcatto }
10164ab3302SCarolineConcatto 
102c105d9b3SPeter Klausler // Ignore trailing spaces (12.5.6.2 p1) and convert to upper case
103c105d9b3SPeter Klausler static std::string Normalize(const std::string &value) {
104c105d9b3SPeter Klausler   auto upper{parser::ToUpperCaseLetters(value)};
1054bac5f83SKazu Hirata   std::size_t lastNonBlank{upper.find_last_not_of(' ')};
106c105d9b3SPeter Klausler   upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1);
107c105d9b3SPeter Klausler   return upper;
108c105d9b3SPeter Klausler }
109c105d9b3SPeter Klausler 
11064ab3302SCarolineConcatto void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
11164ab3302SCarolineConcatto   IoSpecKind specKind{};
11264ab3302SCarolineConcatto   using ParseKind = parser::ConnectSpec::CharExpr::Kind;
11364ab3302SCarolineConcatto   switch (std::get<ParseKind>(spec.t)) {
1141f879005STim Keith   case ParseKind::Access:
1151f879005STim Keith     specKind = IoSpecKind::Access;
1161f879005STim Keith     break;
1171f879005STim Keith   case ParseKind::Action:
1181f879005STim Keith     specKind = IoSpecKind::Action;
1191f879005STim Keith     break;
1201f879005STim Keith   case ParseKind::Asynchronous:
1211f879005STim Keith     specKind = IoSpecKind::Asynchronous;
1221f879005STim Keith     break;
1231f879005STim Keith   case ParseKind::Blank:
1241f879005STim Keith     specKind = IoSpecKind::Blank;
1251f879005STim Keith     break;
1261f879005STim Keith   case ParseKind::Decimal:
1271f879005STim Keith     specKind = IoSpecKind::Decimal;
1281f879005STim Keith     break;
1291f879005STim Keith   case ParseKind::Delim:
1301f879005STim Keith     specKind = IoSpecKind::Delim;
1311f879005STim Keith     break;
1321f879005STim Keith   case ParseKind::Encoding:
1331f879005STim Keith     specKind = IoSpecKind::Encoding;
1341f879005STim Keith     break;
1351f879005STim Keith   case ParseKind::Form:
1361f879005STim Keith     specKind = IoSpecKind::Form;
1371f879005STim Keith     break;
1381f879005STim Keith   case ParseKind::Pad:
1391f879005STim Keith     specKind = IoSpecKind::Pad;
1401f879005STim Keith     break;
1411f879005STim Keith   case ParseKind::Position:
1421f879005STim Keith     specKind = IoSpecKind::Position;
1431f879005STim Keith     break;
1441f879005STim Keith   case ParseKind::Round:
1451f879005STim Keith     specKind = IoSpecKind::Round;
1461f879005STim Keith     break;
1471f879005STim Keith   case ParseKind::Sign:
1481f879005STim Keith     specKind = IoSpecKind::Sign;
1491f879005STim Keith     break;
150c9637577Speter klausler   case ParseKind::Carriagecontrol:
151c9637577Speter klausler     specKind = IoSpecKind::Carriagecontrol;
152c9637577Speter klausler     break;
1531f879005STim Keith   case ParseKind::Convert:
1541f879005STim Keith     specKind = IoSpecKind::Convert;
1551f879005STim Keith     break;
1561f879005STim Keith   case ParseKind::Dispose:
1571f879005STim Keith     specKind = IoSpecKind::Dispose;
1581f879005STim Keith     break;
15964ab3302SCarolineConcatto   }
16064ab3302SCarolineConcatto   SetSpecifier(specKind);
16164ab3302SCarolineConcatto   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
16264ab3302SCarolineConcatto           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
163c105d9b3SPeter Klausler     std::string s{Normalize(*charConst)};
16464ab3302SCarolineConcatto     if (specKind == IoSpecKind::Access) {
16564ab3302SCarolineConcatto       flags_.set(Flag::KnownAccess);
16664ab3302SCarolineConcatto       flags_.set(Flag::AccessDirect, s == "DIRECT");
16764ab3302SCarolineConcatto       flags_.set(Flag::AccessStream, s == "STREAM");
16864ab3302SCarolineConcatto     }
16964ab3302SCarolineConcatto     CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
170c9637577Speter klausler     if (specKind == IoSpecKind::Carriagecontrol &&
171c9637577Speter klausler         (s == "FORTRAN" || s == "NONE")) {
172c9637577Speter klausler       context_.Say(parser::FindSourceLocation(spec),
173c9637577Speter klausler           "Unimplemented %s value '%s'"_err_en_US,
174c9637577Speter klausler           parser::ToUpperCaseLetters(common::EnumToString(specKind)),
175c9637577Speter klausler           *charConst);
176c9637577Speter klausler     }
17764ab3302SCarolineConcatto   }
17864ab3302SCarolineConcatto }
17964ab3302SCarolineConcatto 
180bce7a7edSpeter klausler void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
181bce7a7edSpeter klausler   CheckForDefinableVariable(var, "NEWUNIT");
18264ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Newunit);
18364ab3302SCarolineConcatto }
18464ab3302SCarolineConcatto 
18564ab3302SCarolineConcatto void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) {
18664ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Recl);
18764ab3302SCarolineConcatto   if (const std::optional<std::int64_t> recl{
18864ab3302SCarolineConcatto           GetConstExpr<std::int64_t>(spec)}) {
18964ab3302SCarolineConcatto     if (*recl <= 0) {
19064ab3302SCarolineConcatto       context_.Say(parser::FindSourceLocation(spec),
19164ab3302SCarolineConcatto           "RECL value (%jd) must be positive"_err_en_US,
19276d71354STim Keith           *recl); // 12.5.6.15
19364ab3302SCarolineConcatto     }
19464ab3302SCarolineConcatto   }
19564ab3302SCarolineConcatto }
19664ab3302SCarolineConcatto 
19764ab3302SCarolineConcatto void IoChecker::Enter(const parser::EndLabel &) {
19864ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::End);
19964ab3302SCarolineConcatto }
20064ab3302SCarolineConcatto 
20164ab3302SCarolineConcatto void IoChecker::Enter(const parser::EorLabel &) {
20264ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Eor);
20364ab3302SCarolineConcatto }
20464ab3302SCarolineConcatto 
20564ab3302SCarolineConcatto void IoChecker::Enter(const parser::ErrLabel &) {
20664ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Err);
20764ab3302SCarolineConcatto }
20864ab3302SCarolineConcatto 
20964ab3302SCarolineConcatto void IoChecker::Enter(const parser::FileUnitNumber &) {
21064ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Unit);
21164ab3302SCarolineConcatto   flags_.set(Flag::NumberUnit);
21264ab3302SCarolineConcatto }
21364ab3302SCarolineConcatto 
21464ab3302SCarolineConcatto void IoChecker::Enter(const parser::Format &spec) {
21564ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Fmt);
21664ab3302SCarolineConcatto   flags_.set(Flag::FmtOrNml);
217cd03e96fSPeter Klausler   common::visit(
21864ab3302SCarolineConcatto       common::visitors{
21964ab3302SCarolineConcatto           [&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
22064ab3302SCarolineConcatto           [&](const parser::Star &) { flags_.set(Flag::StarFmt); },
221455ed8deSpeter klausler           [&](const parser::Expr &format) {
2227e225423SPeter Klausler             const SomeExpr *expr{GetExpr(context_, format)};
223455ed8deSpeter klausler             if (!expr) {
224455ed8deSpeter klausler               return;
225455ed8deSpeter klausler             }
226455ed8deSpeter klausler             auto type{expr->GetType()};
227cadc07f0SPeter Klausler             if (type && type->category() == TypeCategory::Integer &&
228cadc07f0SPeter Klausler                 type->kind() ==
229cadc07f0SPeter Klausler                     context_.defaultKinds().GetDefaultKind(type->category()) &&
230cadc07f0SPeter Klausler                 expr->Rank() == 0) {
231455ed8deSpeter klausler               flags_.set(Flag::AssignFmt);
232cadc07f0SPeter Klausler               if (!IsVariable(*expr)) {
233455ed8deSpeter klausler                 context_.Say(format.source,
234455ed8deSpeter klausler                     "Assigned format label must be a scalar variable"_err_en_US);
2350f973ac7SPeter Klausler               } else {
2360f973ac7SPeter Klausler                 context_.Warn(common::LanguageFeature::Assign, format.source,
2379c1ad89dSPeter Klausler                     "Assigned format labels are deprecated"_port_en_US);
238455ed8deSpeter klausler               }
239455ed8deSpeter klausler               return;
240455ed8deSpeter klausler             }
241cadc07f0SPeter Klausler             if (type && type->category() != TypeCategory::Character &&
242cadc07f0SPeter Klausler                 (type->category() != TypeCategory::Integer ||
243cadc07f0SPeter Klausler                     expr->Rank() > 0) &&
244cadc07f0SPeter Klausler                 context_.IsEnabled(
245cadc07f0SPeter Klausler                     common::LanguageFeature::NonCharacterFormat)) {
246cadc07f0SPeter Klausler               // Legacy extension: using non-character variables, typically
247cadc07f0SPeter Klausler               // DATA-initialized with Hollerith, as format expressions.
2480f973ac7SPeter Klausler               context_.Warn(common::LanguageFeature::NonCharacterFormat,
2490f973ac7SPeter Klausler                   format.source,
250a53967cdSPeter Klausler                   "Non-character format expression is not standard"_port_en_US);
251cadc07f0SPeter Klausler             } else if (!type ||
252cadc07f0SPeter Klausler                 type->kind() !=
253cadc07f0SPeter Klausler                     context_.defaultKinds().GetDefaultKind(type->category())) {
254cadc07f0SPeter Klausler               context_.Say(format.source,
255cadc07f0SPeter Klausler                   "Format expression must be default character or default scalar integer"_err_en_US);
256cadc07f0SPeter Klausler               return;
257cadc07f0SPeter Klausler             }
25864ab3302SCarolineConcatto             flags_.set(Flag::CharFmt);
25964ab3302SCarolineConcatto             const std::optional<std::string> constantFormat{
26064ab3302SCarolineConcatto                 GetConstExpr<std::string>(format)};
26164ab3302SCarolineConcatto             if (!constantFormat) {
26264ab3302SCarolineConcatto               return;
26364ab3302SCarolineConcatto             }
26464ab3302SCarolineConcatto             // validate constant format -- 12.6.2.2
265455ed8deSpeter klausler             bool isFolded{constantFormat->size() != format.source.size() - 2};
26664ab3302SCarolineConcatto             parser::CharBlock reporterCharBlock{isFolded
267455ed8deSpeter klausler                     ? parser::CharBlock{format.source}
268455ed8deSpeter klausler                     : parser::CharBlock{format.source.begin() + 1,
26964ab3302SCarolineConcatto                           static_cast<std::size_t>(0)}};
27064ab3302SCarolineConcatto             FormatErrorReporter reporter{context_, reporterCharBlock};
27164ab3302SCarolineConcatto             auto reporterWrapper{
27264ab3302SCarolineConcatto                 [&](const auto &msg) { return reporter.Say(msg); }};
27364ab3302SCarolineConcatto             switch (context_.GetDefaultKind(TypeCategory::Character)) {
27464ab3302SCarolineConcatto             case 1: {
27564ab3302SCarolineConcatto               common::FormatValidator<char> validator{constantFormat->c_str(),
27664ab3302SCarolineConcatto                   constantFormat->length(), reporterWrapper, stmt_};
27764ab3302SCarolineConcatto               validator.Check();
27864ab3302SCarolineConcatto               break;
27964ab3302SCarolineConcatto             }
28064ab3302SCarolineConcatto             case 2: {
28164ab3302SCarolineConcatto               // TODO: Get this to work.  (Maybe combine with earlier instance?)
28264ab3302SCarolineConcatto               common::FormatValidator<char16_t> validator{
28364ab3302SCarolineConcatto                   /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
28464ab3302SCarolineConcatto               validator.Check();
28564ab3302SCarolineConcatto               break;
28664ab3302SCarolineConcatto             }
28764ab3302SCarolineConcatto             case 4: {
28864ab3302SCarolineConcatto               // TODO: Get this to work.  (Maybe combine with earlier instance?)
28964ab3302SCarolineConcatto               common::FormatValidator<char32_t> validator{
29064ab3302SCarolineConcatto                   /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
29164ab3302SCarolineConcatto               validator.Check();
29264ab3302SCarolineConcatto               break;
29364ab3302SCarolineConcatto             }
2941f879005STim Keith             default:
2951f879005STim Keith               CRASH_NO_CASE;
29664ab3302SCarolineConcatto             }
29764ab3302SCarolineConcatto           },
29864ab3302SCarolineConcatto       },
29964ab3302SCarolineConcatto       spec.u);
30064ab3302SCarolineConcatto }
30164ab3302SCarolineConcatto 
30264ab3302SCarolineConcatto void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
30364ab3302SCarolineConcatto 
30464ab3302SCarolineConcatto void IoChecker::Enter(const parser::IdVariable &spec) {
30564ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Id);
3067e225423SPeter Klausler   const auto *expr{GetExpr(context_, spec)};
30764ab3302SCarolineConcatto   if (!expr || !expr->GetType()) {
30864ab3302SCarolineConcatto     return;
30964ab3302SCarolineConcatto   }
310bce7a7edSpeter klausler   CheckForDefinableVariable(spec, "ID");
31164ab3302SCarolineConcatto   int kind{expr->GetType()->kind()};
31264ab3302SCarolineConcatto   int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)};
31364ab3302SCarolineConcatto   if (kind < defaultKind) {
31464ab3302SCarolineConcatto     context_.Say(
31564ab3302SCarolineConcatto         "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US,
31664ab3302SCarolineConcatto         std::move(kind), std::move(defaultKind)); // C1229
31764ab3302SCarolineConcatto   }
31864ab3302SCarolineConcatto }
31964ab3302SCarolineConcatto 
32064ab3302SCarolineConcatto void IoChecker::Enter(const parser::InputItem &spec) {
32164ab3302SCarolineConcatto   flags_.set(Flag::DataList);
322bce7a7edSpeter klausler   const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)};
323bce7a7edSpeter klausler   if (!var) {
324bce7a7edSpeter klausler     return;
325bce7a7edSpeter klausler   }
326bce7a7edSpeter klausler   CheckForDefinableVariable(*var, "Input");
32719d86426SPeter Klausler   if (auto expr{AnalyzeExpr(context_, *var)}) {
3285ea0ba2cSPeter Klausler     CheckForBadIoType(*expr,
3297cf1608bSPeter Klausler         flags_.test(Flag::FmtOrNml) ? common::DefinedIo::ReadFormatted
3307cf1608bSPeter Klausler                                     : common::DefinedIo::ReadUnformatted,
33119d86426SPeter Klausler         var->GetSource());
33219d86426SPeter Klausler   }
33364ab3302SCarolineConcatto }
33464ab3302SCarolineConcatto 
33564ab3302SCarolineConcatto void IoChecker::Enter(const parser::InquireSpec &spec) {
33664ab3302SCarolineConcatto   // InquireSpec context FileNameExpr
33764ab3302SCarolineConcatto   if (std::get_if<parser::FileNameExpr>(&spec.u)) {
33864ab3302SCarolineConcatto     SetSpecifier(IoSpecKind::File);
33964ab3302SCarolineConcatto   }
34064ab3302SCarolineConcatto }
34164ab3302SCarolineConcatto 
34264ab3302SCarolineConcatto void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
34364ab3302SCarolineConcatto   IoSpecKind specKind{};
34464ab3302SCarolineConcatto   using ParseKind = parser::InquireSpec::CharVar::Kind;
34564ab3302SCarolineConcatto   switch (std::get<ParseKind>(spec.t)) {
3461f879005STim Keith   case ParseKind::Access:
3471f879005STim Keith     specKind = IoSpecKind::Access;
3481f879005STim Keith     break;
3491f879005STim Keith   case ParseKind::Action:
3501f879005STim Keith     specKind = IoSpecKind::Action;
3511f879005STim Keith     break;
3521f879005STim Keith   case ParseKind::Asynchronous:
3531f879005STim Keith     specKind = IoSpecKind::Asynchronous;
3541f879005STim Keith     break;
3551f879005STim Keith   case ParseKind::Blank:
3561f879005STim Keith     specKind = IoSpecKind::Blank;
3571f879005STim Keith     break;
3581f879005STim Keith   case ParseKind::Decimal:
3591f879005STim Keith     specKind = IoSpecKind::Decimal;
3601f879005STim Keith     break;
3611f879005STim Keith   case ParseKind::Delim:
3621f879005STim Keith     specKind = IoSpecKind::Delim;
3631f879005STim Keith     break;
3641f879005STim Keith   case ParseKind::Direct:
3651f879005STim Keith     specKind = IoSpecKind::Direct;
3661f879005STim Keith     break;
3671f879005STim Keith   case ParseKind::Encoding:
3681f879005STim Keith     specKind = IoSpecKind::Encoding;
3691f879005STim Keith     break;
3701f879005STim Keith   case ParseKind::Form:
3711f879005STim Keith     specKind = IoSpecKind::Form;
3721f879005STim Keith     break;
3731f879005STim Keith   case ParseKind::Formatted:
3741f879005STim Keith     specKind = IoSpecKind::Formatted;
3751f879005STim Keith     break;
3761f879005STim Keith   case ParseKind::Iomsg:
3771f879005STim Keith     specKind = IoSpecKind::Iomsg;
3781f879005STim Keith     break;
3791f879005STim Keith   case ParseKind::Name:
3801f879005STim Keith     specKind = IoSpecKind::Name;
3811f879005STim Keith     break;
3821f879005STim Keith   case ParseKind::Pad:
3831f879005STim Keith     specKind = IoSpecKind::Pad;
3841f879005STim Keith     break;
3851f879005STim Keith   case ParseKind::Position:
3861f879005STim Keith     specKind = IoSpecKind::Position;
3871f879005STim Keith     break;
3881f879005STim Keith   case ParseKind::Read:
3891f879005STim Keith     specKind = IoSpecKind::Read;
3901f879005STim Keith     break;
3911f879005STim Keith   case ParseKind::Readwrite:
3921f879005STim Keith     specKind = IoSpecKind::Readwrite;
3931f879005STim Keith     break;
3941f879005STim Keith   case ParseKind::Round:
3951f879005STim Keith     specKind = IoSpecKind::Round;
3961f879005STim Keith     break;
3971f879005STim Keith   case ParseKind::Sequential:
3981f879005STim Keith     specKind = IoSpecKind::Sequential;
3991f879005STim Keith     break;
4001f879005STim Keith   case ParseKind::Sign:
4011f879005STim Keith     specKind = IoSpecKind::Sign;
4021f879005STim Keith     break;
4031f879005STim Keith   case ParseKind::Status:
4041f879005STim Keith     specKind = IoSpecKind::Status;
4051f879005STim Keith     break;
4061f879005STim Keith   case ParseKind::Stream:
4071f879005STim Keith     specKind = IoSpecKind::Stream;
4081f879005STim Keith     break;
4091f879005STim Keith   case ParseKind::Unformatted:
4101f879005STim Keith     specKind = IoSpecKind::Unformatted;
4111f879005STim Keith     break;
4121f879005STim Keith   case ParseKind::Write:
4131f879005STim Keith     specKind = IoSpecKind::Write;
4141f879005STim Keith     break;
415c9637577Speter klausler   case ParseKind::Carriagecontrol:
416c9637577Speter klausler     specKind = IoSpecKind::Carriagecontrol;
417c9637577Speter klausler     break;
4181f879005STim Keith   case ParseKind::Convert:
4191f879005STim Keith     specKind = IoSpecKind::Convert;
4201f879005STim Keith     break;
4211f879005STim Keith   case ParseKind::Dispose:
4221f879005STim Keith     specKind = IoSpecKind::Dispose;
4231f879005STim Keith     break;
42464ab3302SCarolineConcatto   }
4257871deb8SPeter Klausler   const parser::Variable &var{
4267871deb8SPeter Klausler       std::get<parser::ScalarDefaultCharVariable>(spec.t).thing.thing};
4277871deb8SPeter Klausler   std::string what{parser::ToUpperCaseLetters(common::EnumToString(specKind))};
4287871deb8SPeter Klausler   CheckForDefinableVariable(var, what);
4297871deb8SPeter Klausler   WarnOnDeferredLengthCharacterScalar(
4307871deb8SPeter Klausler       context_, GetExpr(context_, var), var.GetSource(), what.c_str());
43164ab3302SCarolineConcatto   SetSpecifier(specKind);
43264ab3302SCarolineConcatto }
43364ab3302SCarolineConcatto 
43464ab3302SCarolineConcatto void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
43564ab3302SCarolineConcatto   IoSpecKind specKind{};
43664ab3302SCarolineConcatto   using ParseKind = parser::InquireSpec::IntVar::Kind;
43764ab3302SCarolineConcatto   switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) {
4381f879005STim Keith   case ParseKind::Iostat:
4391f879005STim Keith     specKind = IoSpecKind::Iostat;
4401f879005STim Keith     break;
4411f879005STim Keith   case ParseKind::Nextrec:
4421f879005STim Keith     specKind = IoSpecKind::Nextrec;
4431f879005STim Keith     break;
4441f879005STim Keith   case ParseKind::Number:
4451f879005STim Keith     specKind = IoSpecKind::Number;
4461f879005STim Keith     break;
4471f879005STim Keith   case ParseKind::Pos:
4481f879005STim Keith     specKind = IoSpecKind::Pos;
4491f879005STim Keith     break;
4501f879005STim Keith   case ParseKind::Recl:
4511f879005STim Keith     specKind = IoSpecKind::Recl;
4521f879005STim Keith     break;
4531f879005STim Keith   case ParseKind::Size:
4541f879005STim Keith     specKind = IoSpecKind::Size;
4551f879005STim Keith     break;
45664ab3302SCarolineConcatto   }
457bce7a7edSpeter klausler   CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t),
458bce7a7edSpeter klausler       parser::ToUpperCaseLetters(common::EnumToString(specKind)));
45964ab3302SCarolineConcatto   SetSpecifier(specKind);
46064ab3302SCarolineConcatto }
46164ab3302SCarolineConcatto 
46264ab3302SCarolineConcatto void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) {
46364ab3302SCarolineConcatto   IoSpecKind specKind{};
46464ab3302SCarolineConcatto   using ParseKind = parser::InquireSpec::LogVar::Kind;
46564ab3302SCarolineConcatto   switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) {
4661f879005STim Keith   case ParseKind::Exist:
4671f879005STim Keith     specKind = IoSpecKind::Exist;
4681f879005STim Keith     break;
4691f879005STim Keith   case ParseKind::Named:
4701f879005STim Keith     specKind = IoSpecKind::Named;
4711f879005STim Keith     break;
4721f879005STim Keith   case ParseKind::Opened:
4731f879005STim Keith     specKind = IoSpecKind::Opened;
4741f879005STim Keith     break;
4751f879005STim Keith   case ParseKind::Pending:
4761f879005STim Keith     specKind = IoSpecKind::Pending;
4771f879005STim Keith     break;
47864ab3302SCarolineConcatto   }
47964ab3302SCarolineConcatto   SetSpecifier(specKind);
48064ab3302SCarolineConcatto }
48164ab3302SCarolineConcatto 
48264ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoControlSpec &spec) {
48364ab3302SCarolineConcatto   // IoControlSpec context Name
48464ab3302SCarolineConcatto   flags_.set(Flag::IoControlList);
48564ab3302SCarolineConcatto   if (std::holds_alternative<parser::Name>(spec.u)) {
48664ab3302SCarolineConcatto     SetSpecifier(IoSpecKind::Nml);
48764ab3302SCarolineConcatto     flags_.set(Flag::FmtOrNml);
48864ab3302SCarolineConcatto   }
48964ab3302SCarolineConcatto }
49064ab3302SCarolineConcatto 
49164ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {
49264ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Asynchronous);
49364ab3302SCarolineConcatto   if (const std::optional<std::string> charConst{
49464ab3302SCarolineConcatto           GetConstExpr<std::string>(spec)}) {
495c105d9b3SPeter Klausler     flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES");
49664ab3302SCarolineConcatto     CheckStringValue(IoSpecKind::Asynchronous, *charConst,
49764ab3302SCarolineConcatto         parser::FindSourceLocation(spec)); // C1223
49864ab3302SCarolineConcatto   }
49964ab3302SCarolineConcatto }
50064ab3302SCarolineConcatto 
50164ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
50264ab3302SCarolineConcatto   IoSpecKind specKind{};
50364ab3302SCarolineConcatto   using ParseKind = parser::IoControlSpec::CharExpr::Kind;
50464ab3302SCarolineConcatto   switch (std::get<ParseKind>(spec.t)) {
5051f879005STim Keith   case ParseKind::Advance:
5061f879005STim Keith     specKind = IoSpecKind::Advance;
5071f879005STim Keith     break;
5081f879005STim Keith   case ParseKind::Blank:
5091f879005STim Keith     specKind = IoSpecKind::Blank;
5101f879005STim Keith     break;
5111f879005STim Keith   case ParseKind::Decimal:
5121f879005STim Keith     specKind = IoSpecKind::Decimal;
5131f879005STim Keith     break;
5141f879005STim Keith   case ParseKind::Delim:
5151f879005STim Keith     specKind = IoSpecKind::Delim;
5161f879005STim Keith     break;
5171f879005STim Keith   case ParseKind::Pad:
5181f879005STim Keith     specKind = IoSpecKind::Pad;
5191f879005STim Keith     break;
5201f879005STim Keith   case ParseKind::Round:
5211f879005STim Keith     specKind = IoSpecKind::Round;
5221f879005STim Keith     break;
5231f879005STim Keith   case ParseKind::Sign:
5241f879005STim Keith     specKind = IoSpecKind::Sign;
5251f879005STim Keith     break;
52664ab3302SCarolineConcatto   }
52764ab3302SCarolineConcatto   SetSpecifier(specKind);
52864ab3302SCarolineConcatto   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
52964ab3302SCarolineConcatto           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
53064ab3302SCarolineConcatto     if (specKind == IoSpecKind::Advance) {
531c105d9b3SPeter Klausler       flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES");
53264ab3302SCarolineConcatto     }
53364ab3302SCarolineConcatto     CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
53464ab3302SCarolineConcatto   }
53564ab3302SCarolineConcatto }
53664ab3302SCarolineConcatto 
53764ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoControlSpec::Pos &) {
53864ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Pos);
53964ab3302SCarolineConcatto }
54064ab3302SCarolineConcatto 
54164ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
54264ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Rec);
54364ab3302SCarolineConcatto }
54464ab3302SCarolineConcatto 
545bce7a7edSpeter klausler void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
546bce7a7edSpeter klausler   CheckForDefinableVariable(var, "SIZE");
54764ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Size);
54864ab3302SCarolineConcatto }
54964ab3302SCarolineConcatto 
55064ab3302SCarolineConcatto void IoChecker::Enter(const parser::IoUnit &spec) {
55164ab3302SCarolineConcatto   if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
5527ff9064bSPeter Klausler     // Only now after generic resolution can it be known whether a function
5537ff9064bSPeter Klausler     // call appearing as UNIT=f() is an integer scalar external unit number
5547ff9064bSPeter Klausler     // or a character pointer for internal I/O.
5557ff9064bSPeter Klausler     const auto *expr{GetExpr(context_, *var)};
5567ff9064bSPeter Klausler     std::optional<evaluate::DynamicType> dyType;
5577ff9064bSPeter Klausler     if (expr) {
5587ff9064bSPeter Klausler       dyType = expr->GetType();
5597ff9064bSPeter Klausler     }
5607ff9064bSPeter Klausler     if (dyType && dyType->category() == TypeCategory::Integer) {
5617ff9064bSPeter Klausler       if (expr->Rank() != 0) {
5627ff9064bSPeter Klausler         context_.Say(parser::FindSourceLocation(*var),
5637ff9064bSPeter Klausler             "I/O unit number must be scalar"_err_en_US);
5647ff9064bSPeter Klausler       }
5657ff9064bSPeter Klausler       // In the case of an integer unit number variable, rewrite the parse
5667ff9064bSPeter Klausler       // tree as if the unit had been parsed as a FileUnitNumber in order
5677ff9064bSPeter Klausler       // to ease lowering.
5687ff9064bSPeter Klausler       auto &mutableSpec{const_cast<parser::IoUnit &>(spec)};
5697ff9064bSPeter Klausler       auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)};
5707ff9064bSPeter Klausler       auto source{mutableVar.GetSource()};
5717ff9064bSPeter Klausler       auto typedExpr{std::move(mutableVar.typedExpr)};
5727ff9064bSPeter Klausler       auto newExpr{common::visit(
5737ff9064bSPeter Klausler           [](auto &&indirection) {
5747ff9064bSPeter Klausler             return parser::Expr{std::move(indirection)};
5757ff9064bSPeter Klausler           },
5767ff9064bSPeter Klausler           std::move(mutableVar.u))};
5777ff9064bSPeter Klausler       newExpr.source = source;
5787ff9064bSPeter Klausler       newExpr.typedExpr = std::move(typedExpr);
5797ff9064bSPeter Klausler       mutableSpec.u = parser::FileUnitNumber{
5807ff9064bSPeter Klausler           parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}};
5817ff9064bSPeter Klausler     } else if (!dyType || dyType->category() != TypeCategory::Character) {
5827ff9064bSPeter Klausler       SetSpecifier(IoSpecKind::Unit);
5837ff9064bSPeter Klausler       context_.Say(parser::FindSourceLocation(*var),
5847ff9064bSPeter Klausler           "I/O unit must be a character variable or a scalar integer expression"_err_en_US);
5857ff9064bSPeter Klausler     } else { // CHARACTER variable (internal I/O)
586bce7a7edSpeter klausler       if (stmt_ == IoStmtKind::Write) {
587bce7a7edSpeter klausler         CheckForDefinableVariable(*var, "Internal file");
5887871deb8SPeter Klausler         WarnOnDeferredLengthCharacterScalar(
5897871deb8SPeter Klausler             context_, expr, var->GetSource(), "Internal file");
590bce7a7edSpeter klausler       }
591bce7a7edSpeter klausler       if (HasVectorSubscript(*expr)) {
592bce7a7edSpeter klausler         context_.Say(parser::FindSourceLocation(*var), // C1201
593bce7a7edSpeter klausler             "Internal file must not have a vector subscript"_err_en_US);
59464ab3302SCarolineConcatto       }
59564ab3302SCarolineConcatto       SetSpecifier(IoSpecKind::Unit);
59664ab3302SCarolineConcatto       flags_.set(Flag::InternalUnit);
5977ff9064bSPeter Klausler     }
59864ab3302SCarolineConcatto   } else if (std::get_if<parser::Star>(&spec.u)) {
59964ab3302SCarolineConcatto     SetSpecifier(IoSpecKind::Unit);
60064ab3302SCarolineConcatto     flags_.set(Flag::StarUnit);
60164ab3302SCarolineConcatto   }
60264ab3302SCarolineConcatto }
60364ab3302SCarolineConcatto 
6047871deb8SPeter Klausler void IoChecker::Enter(const parser::MsgVariable &msgVar) {
6057871deb8SPeter Klausler   const parser::Variable &var{msgVar.v.thing.thing};
606bce7a7edSpeter klausler   if (stmt_ == IoStmtKind::None) {
607bce7a7edSpeter klausler     // allocate, deallocate, image control
608bce7a7edSpeter klausler     CheckForDefinableVariable(var, "ERRMSG");
6097871deb8SPeter Klausler     WarnOnDeferredLengthCharacterScalar(
6107871deb8SPeter Klausler         context_, GetExpr(context_, var), var.GetSource(), "ERRMSG=");
6117871deb8SPeter Klausler   } else {
612bce7a7edSpeter klausler     CheckForDefinableVariable(var, "IOMSG");
6137871deb8SPeter Klausler     WarnOnDeferredLengthCharacterScalar(
6147871deb8SPeter Klausler         context_, GetExpr(context_, var), var.GetSource(), "IOMSG=");
61564ab3302SCarolineConcatto     SetSpecifier(IoSpecKind::Iomsg);
61664ab3302SCarolineConcatto   }
6177871deb8SPeter Klausler }
61864ab3302SCarolineConcatto 
619bce7a7edSpeter klausler void IoChecker::Enter(const parser::OutputItem &item) {
62064ab3302SCarolineConcatto   flags_.set(Flag::DataList);
621bce7a7edSpeter klausler   if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
6227e225423SPeter Klausler     if (const auto *expr{GetExpr(context_, *x)}) {
623571673ceSPeter Steinfeld       if (evaluate::IsBOZLiteral(*expr)) {
624571673ceSPeter Steinfeld         context_.Say(parser::FindSourceLocation(*x), // C7109
625571673ceSPeter Steinfeld             "Output item must not be a BOZ literal constant"_err_en_US);
626aa128bb2SPeter Klausler       } else if (IsProcedure(*expr)) {
627bce7a7edSpeter klausler         context_.Say(parser::FindSourceLocation(*x),
628aa128bb2SPeter Klausler             "Output item must not be a procedure"_err_en_US); // C1233
629bce7a7edSpeter klausler       }
6305ea0ba2cSPeter Klausler       CheckForBadIoType(*expr,
6317cf1608bSPeter Klausler           flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted
6327cf1608bSPeter Klausler                                       : common::DefinedIo::WriteUnformatted,
63319d86426SPeter Klausler           parser::FindSourceLocation(item));
634bce7a7edSpeter klausler     }
635bce7a7edSpeter klausler   }
63664ab3302SCarolineConcatto }
63764ab3302SCarolineConcatto 
63864ab3302SCarolineConcatto void IoChecker::Enter(const parser::StatusExpr &spec) {
63964ab3302SCarolineConcatto   SetSpecifier(IoSpecKind::Status);
64064ab3302SCarolineConcatto   if (const std::optional<std::string> charConst{
64164ab3302SCarolineConcatto           GetConstExpr<std::string>(spec)}) {
64264ab3302SCarolineConcatto     // Status values for Open and Close are different.
643c105d9b3SPeter Klausler     std::string s{Normalize(*charConst)};
64464ab3302SCarolineConcatto     if (stmt_ == IoStmtKind::Open) {
64564ab3302SCarolineConcatto       flags_.set(Flag::KnownStatus);
64664ab3302SCarolineConcatto       flags_.set(Flag::StatusNew, s == "NEW");
64764ab3302SCarolineConcatto       flags_.set(Flag::StatusReplace, s == "REPLACE");
64864ab3302SCarolineConcatto       flags_.set(Flag::StatusScratch, s == "SCRATCH");
64964ab3302SCarolineConcatto       // CheckStringValue compares for OPEN Status string values.
65064ab3302SCarolineConcatto       CheckStringValue(
65164ab3302SCarolineConcatto           IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));
65264ab3302SCarolineConcatto       return;
65364ab3302SCarolineConcatto     }
65464ab3302SCarolineConcatto     CHECK(stmt_ == IoStmtKind::Close);
65564ab3302SCarolineConcatto     if (s != "DELETE" && s != "KEEP") {
65664ab3302SCarolineConcatto       context_.Say(parser::FindSourceLocation(spec),
65764ab3302SCarolineConcatto           "Invalid STATUS value '%s'"_err_en_US, *charConst);
65864ab3302SCarolineConcatto     }
65964ab3302SCarolineConcatto   }
66064ab3302SCarolineConcatto }
66164ab3302SCarolineConcatto 
662bce7a7edSpeter klausler void IoChecker::Enter(const parser::StatVariable &var) {
66364ab3302SCarolineConcatto   if (stmt_ == IoStmtKind::None) {
664bce7a7edSpeter klausler     // allocate, deallocate, image control
665bce7a7edSpeter klausler     CheckForDefinableVariable(var, "STAT");
6667871deb8SPeter Klausler   } else {
667bce7a7edSpeter klausler     CheckForDefinableVariable(var, "IOSTAT");
668bce7a7edSpeter klausler     SetSpecifier(IoSpecKind::Iostat);
66964ab3302SCarolineConcatto   }
6707871deb8SPeter Klausler }
67164ab3302SCarolineConcatto 
67264ab3302SCarolineConcatto void IoChecker::Leave(const parser::BackspaceStmt &) {
67364ab3302SCarolineConcatto   CheckForPureSubprogram();
67464ab3302SCarolineConcatto   CheckForRequiredSpecifier(
67564ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
676b949a6f5SPeter Klausler   CheckForUselessIomsg();
67764ab3302SCarolineConcatto   Done();
67864ab3302SCarolineConcatto }
67964ab3302SCarolineConcatto 
68064ab3302SCarolineConcatto void IoChecker::Leave(const parser::CloseStmt &) {
68164ab3302SCarolineConcatto   CheckForPureSubprogram();
68264ab3302SCarolineConcatto   CheckForRequiredSpecifier(
68364ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
684b949a6f5SPeter Klausler   CheckForUselessIomsg();
68564ab3302SCarolineConcatto   Done();
68664ab3302SCarolineConcatto }
68764ab3302SCarolineConcatto 
68864ab3302SCarolineConcatto void IoChecker::Leave(const parser::EndfileStmt &) {
68964ab3302SCarolineConcatto   CheckForPureSubprogram();
69064ab3302SCarolineConcatto   CheckForRequiredSpecifier(
69164ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
692b949a6f5SPeter Klausler   CheckForUselessIomsg();
69364ab3302SCarolineConcatto   Done();
69464ab3302SCarolineConcatto }
69564ab3302SCarolineConcatto 
69664ab3302SCarolineConcatto void IoChecker::Leave(const parser::FlushStmt &) {
69764ab3302SCarolineConcatto   CheckForPureSubprogram();
69864ab3302SCarolineConcatto   CheckForRequiredSpecifier(
69964ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
700b949a6f5SPeter Klausler   CheckForUselessIomsg();
70164ab3302SCarolineConcatto   Done();
70264ab3302SCarolineConcatto }
70364ab3302SCarolineConcatto 
70464ab3302SCarolineConcatto void IoChecker::Leave(const parser::InquireStmt &stmt) {
70564ab3302SCarolineConcatto   if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
70664ab3302SCarolineConcatto     CheckForPureSubprogram();
70764ab3302SCarolineConcatto     // Inquire by unit or by file (vs. by output list).
70864ab3302SCarolineConcatto     CheckForRequiredSpecifier(
70964ab3302SCarolineConcatto         flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),
71064ab3302SCarolineConcatto         "UNIT number or FILE"); // C1246
71164ab3302SCarolineConcatto     CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
71264ab3302SCarolineConcatto     CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
713b949a6f5SPeter Klausler     CheckForUselessIomsg();
71464ab3302SCarolineConcatto   }
71564ab3302SCarolineConcatto   Done();
71664ab3302SCarolineConcatto }
71764ab3302SCarolineConcatto 
71864ab3302SCarolineConcatto void IoChecker::Leave(const parser::OpenStmt &) {
71964ab3302SCarolineConcatto   CheckForPureSubprogram();
72064ab3302SCarolineConcatto   CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||
72164ab3302SCarolineConcatto           specifierSet_.test(IoSpecKind::Newunit),
72264ab3302SCarolineConcatto       "UNIT or NEWUNIT"); // C1204, C1205
72364ab3302SCarolineConcatto   CheckForProhibitedSpecifier(
72464ab3302SCarolineConcatto       IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205
72564ab3302SCarolineConcatto   CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",
72664ab3302SCarolineConcatto       IoSpecKind::File); // 12.5.6.10
72764ab3302SCarolineConcatto   CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),
72864ab3302SCarolineConcatto       "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10
72964ab3302SCarolineConcatto   CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),
73064ab3302SCarolineConcatto       "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10
73164ab3302SCarolineConcatto   if (flags_.test(Flag::KnownStatus)) {
73264ab3302SCarolineConcatto     CheckForRequiredSpecifier(IoSpecKind::Newunit,
73364ab3302SCarolineConcatto         specifierSet_.test(IoSpecKind::File) ||
73464ab3302SCarolineConcatto             flags_.test(Flag::StatusScratch),
73564ab3302SCarolineConcatto         "FILE or STATUS='SCRATCH'"); // 12.5.6.12
73664ab3302SCarolineConcatto   } else {
73764ab3302SCarolineConcatto     CheckForRequiredSpecifier(IoSpecKind::Newunit,
73864ab3302SCarolineConcatto         specifierSet_.test(IoSpecKind::File) ||
73964ab3302SCarolineConcatto             specifierSet_.test(IoSpecKind::Status),
74064ab3302SCarolineConcatto         "FILE or STATUS"); // 12.5.6.12
74164ab3302SCarolineConcatto   }
74264ab3302SCarolineConcatto   if (flags_.test(Flag::KnownAccess)) {
74364ab3302SCarolineConcatto     CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),
74464ab3302SCarolineConcatto         "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15
74564ab3302SCarolineConcatto     CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
74664ab3302SCarolineConcatto         "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
74764ab3302SCarolineConcatto   }
748b949a6f5SPeter Klausler   CheckForUselessIomsg();
74964ab3302SCarolineConcatto   Done();
75064ab3302SCarolineConcatto }
75164ab3302SCarolineConcatto 
75264ab3302SCarolineConcatto void IoChecker::Leave(const parser::PrintStmt &) {
75364ab3302SCarolineConcatto   CheckForPureSubprogram();
754b949a6f5SPeter Klausler   CheckForUselessIomsg();
75564ab3302SCarolineConcatto   Done();
75664ab3302SCarolineConcatto }
75764ab3302SCarolineConcatto 
7585ea0ba2cSPeter Klausler static const parser::Name *FindNamelist(
7595ea0ba2cSPeter Klausler     const std::list<parser::IoControlSpec> &controls) {
76064ab3302SCarolineConcatto   for (const auto &control : controls) {
7615ea0ba2cSPeter Klausler     if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) {
7625ea0ba2cSPeter Klausler       if (namelist->symbol &&
7635ea0ba2cSPeter Klausler           namelist->symbol->GetUltimate().has<NamelistDetails>()) {
7645ea0ba2cSPeter Klausler         return namelist;
76564ab3302SCarolineConcatto       }
76664ab3302SCarolineConcatto     }
76764ab3302SCarolineConcatto   }
7685ea0ba2cSPeter Klausler   return nullptr;
76964ab3302SCarolineConcatto }
77064ab3302SCarolineConcatto 
77164ab3302SCarolineConcatto static void CheckForDoVariable(
77264ab3302SCarolineConcatto     const parser::ReadStmt &readStmt, SemanticsContext &context) {
77364ab3302SCarolineConcatto   const std::list<parser::InputItem> &items{readStmt.items};
77464ab3302SCarolineConcatto   for (const auto &item : items) {
77564ab3302SCarolineConcatto     if (const parser::Variable *
77664ab3302SCarolineConcatto         variable{std::get_if<parser::Variable>(&item.u)}) {
77764ab3302SCarolineConcatto       context.CheckIndexVarRedefine(*variable);
77864ab3302SCarolineConcatto     }
77964ab3302SCarolineConcatto   }
78064ab3302SCarolineConcatto }
78164ab3302SCarolineConcatto 
78264ab3302SCarolineConcatto void IoChecker::Leave(const parser::ReadStmt &readStmt) {
78364ab3302SCarolineConcatto   if (!flags_.test(Flag::InternalUnit)) {
78464ab3302SCarolineConcatto     CheckForPureSubprogram();
78564ab3302SCarolineConcatto   }
7865ea0ba2cSPeter Klausler   if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) {
7875ea0ba2cSPeter Klausler     if (namelist->symbol) {
7887cf1608bSPeter Klausler       CheckNamelist(*namelist->symbol, common::DefinedIo::ReadFormatted,
7895ea0ba2cSPeter Klausler           namelist->source);
7905ea0ba2cSPeter Klausler     }
7915ea0ba2cSPeter Klausler   }
79264ab3302SCarolineConcatto   CheckForDoVariable(readStmt, context_);
79364ab3302SCarolineConcatto   if (!flags_.test(Flag::IoControlList)) {
79464ab3302SCarolineConcatto     Done();
79564ab3302SCarolineConcatto     return;
79664ab3302SCarolineConcatto   }
79764ab3302SCarolineConcatto   LeaveReadWrite();
79864ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
79964ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
80064ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
8013de9aa6bSPeter Klausler   if (specifierSet_.test(IoSpecKind::Size)) {
8023de9aa6bSPeter Klausler     // F'2023 C1214 - allow with a warning
803505f6da1SPeter Klausler     if (context_.ShouldWarn(common::LanguageFeature::ListDirectedSize)) {
8043de9aa6bSPeter Klausler       if (specifierSet_.test(IoSpecKind::Nml)) {
8053de9aa6bSPeter Klausler         context_.Say("If NML appears, SIZE should not appear"_port_en_US);
8063de9aa6bSPeter Klausler       } else if (flags_.test(Flag::StarFmt)) {
8073de9aa6bSPeter Klausler         context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US);
8083de9aa6bSPeter Klausler       }
8093de9aa6bSPeter Klausler     }
810505f6da1SPeter Klausler   }
81164ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Eor,
81264ab3302SCarolineConcatto       specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),
81364ab3302SCarolineConcatto       "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2
81464ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),
81564ab3302SCarolineConcatto       "FMT or NML"); // C1227
81664ab3302SCarolineConcatto   CheckForRequiredSpecifier(
81764ab3302SCarolineConcatto       IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
81864ab3302SCarolineConcatto   Done();
81964ab3302SCarolineConcatto }
82064ab3302SCarolineConcatto 
82164ab3302SCarolineConcatto void IoChecker::Leave(const parser::RewindStmt &) {
82264ab3302SCarolineConcatto   CheckForRequiredSpecifier(
82364ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
82464ab3302SCarolineConcatto   CheckForPureSubprogram();
825b949a6f5SPeter Klausler   CheckForUselessIomsg();
82664ab3302SCarolineConcatto   Done();
82764ab3302SCarolineConcatto }
82864ab3302SCarolineConcatto 
82964ab3302SCarolineConcatto void IoChecker::Leave(const parser::WaitStmt &) {
83064ab3302SCarolineConcatto   CheckForRequiredSpecifier(
83164ab3302SCarolineConcatto       flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
83264ab3302SCarolineConcatto   CheckForPureSubprogram();
833b949a6f5SPeter Klausler   CheckForUselessIomsg();
83464ab3302SCarolineConcatto   Done();
83564ab3302SCarolineConcatto }
83664ab3302SCarolineConcatto 
8375ea0ba2cSPeter Klausler void IoChecker::Leave(const parser::WriteStmt &writeStmt) {
83864ab3302SCarolineConcatto   if (!flags_.test(Flag::InternalUnit)) {
83964ab3302SCarolineConcatto     CheckForPureSubprogram();
84064ab3302SCarolineConcatto   }
8415ea0ba2cSPeter Klausler   if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) {
8425ea0ba2cSPeter Klausler     if (namelist->symbol) {
8437cf1608bSPeter Klausler       CheckNamelist(*namelist->symbol, common::DefinedIo::WriteFormatted,
8445ea0ba2cSPeter Klausler           namelist->source);
8455ea0ba2cSPeter Klausler     }
8465ea0ba2cSPeter Klausler   }
84764ab3302SCarolineConcatto   LeaveReadWrite();
84864ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
84964ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
85064ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
85164ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
85264ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
85364ab3302SCarolineConcatto   CheckForRequiredSpecifier(
85464ab3302SCarolineConcatto       IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
85564ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Delim,
85664ab3302SCarolineConcatto       flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
85764ab3302SCarolineConcatto       "FMT=* or NML"); // C1228
85864ab3302SCarolineConcatto   Done();
85964ab3302SCarolineConcatto }
86064ab3302SCarolineConcatto 
86164ab3302SCarolineConcatto void IoChecker::LeaveReadWrite() const {
86264ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
863*300370c2SPeter Klausler   CheckForRequiredSpecifier(flags_.test(Flag::InternalUnit),
864*300370c2SPeter Klausler       "UNIT=internal-file", flags_.test(Flag::FmtOrNml), "FMT or NML");
86564ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216
86664ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216
86764ab3302SCarolineConcatto   CheckForProhibitedSpecifier(
86864ab3302SCarolineConcatto       IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216
86964ab3302SCarolineConcatto   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
87064ab3302SCarolineConcatto       "UNIT=internal-file", IoSpecKind::Pos); // C1219
87164ab3302SCarolineConcatto   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
87264ab3302SCarolineConcatto       "UNIT=internal-file", IoSpecKind::Rec); // C1219
87364ab3302SCarolineConcatto   CheckForProhibitedSpecifier(
87464ab3302SCarolineConcatto       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219
87564ab3302SCarolineConcatto   CheckForProhibitedSpecifier(
87664ab3302SCarolineConcatto       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219
87764ab3302SCarolineConcatto   CheckForProhibitedSpecifier(
87864ab3302SCarolineConcatto       IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
87964ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Advance,
880455ed8deSpeter klausler       flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||
881455ed8deSpeter klausler           flags_.test(Flag::AssignFmt),
88264ab3302SCarolineConcatto       "an explicit format"); // C1221
88364ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Advance,
88464ab3302SCarolineConcatto       flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221
88564ab3302SCarolineConcatto   CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),
88664ab3302SCarolineConcatto       "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),
88764ab3302SCarolineConcatto       "UNIT=number"); // C1224
88864ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),
88964ab3302SCarolineConcatto       "ASYNCHRONOUS='YES'"); // C1225
89064ab3302SCarolineConcatto   CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226
89164ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),
89264ab3302SCarolineConcatto       "FMT or NML"); // C1227
89364ab3302SCarolineConcatto   CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),
89464ab3302SCarolineConcatto       "FMT or NML"); // C1227
895b949a6f5SPeter Klausler   CheckForUselessIomsg();
89664ab3302SCarolineConcatto }
89764ab3302SCarolineConcatto 
89864ab3302SCarolineConcatto void IoChecker::SetSpecifier(IoSpecKind specKind) {
89964ab3302SCarolineConcatto   if (stmt_ == IoStmtKind::None) {
90064ab3302SCarolineConcatto     // FMT may appear on PRINT statements, which don't have any checks.
90164ab3302SCarolineConcatto     // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.
90264ab3302SCarolineConcatto     return;
90364ab3302SCarolineConcatto   }
90464ab3302SCarolineConcatto   // C1203, C1207, C1210, C1236, C1239, C1242, C1245
90564ab3302SCarolineConcatto   if (specifierSet_.test(specKind)) {
90664ab3302SCarolineConcatto     context_.Say("Duplicate %s specifier"_err_en_US,
90764ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
90864ab3302SCarolineConcatto   }
90964ab3302SCarolineConcatto   specifierSet_.set(specKind);
91064ab3302SCarolineConcatto }
91164ab3302SCarolineConcatto 
91264ab3302SCarolineConcatto void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
91364ab3302SCarolineConcatto     const parser::CharBlock &source) const {
91464ab3302SCarolineConcatto   static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
91564ab3302SCarolineConcatto       {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},
91664ab3302SCarolineConcatto       {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},
91764ab3302SCarolineConcatto       {IoSpecKind::Advance, {"NO", "YES"}},
91864ab3302SCarolineConcatto       {IoSpecKind::Asynchronous, {"NO", "YES"}},
91964ab3302SCarolineConcatto       {IoSpecKind::Blank, {"NULL", "ZERO"}},
92064ab3302SCarolineConcatto       {IoSpecKind::Decimal, {"COMMA", "POINT"}},
92164ab3302SCarolineConcatto       {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},
92264ab3302SCarolineConcatto       {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},
92364ab3302SCarolineConcatto       {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}},
92464ab3302SCarolineConcatto       {IoSpecKind::Pad, {"NO", "YES"}},
92564ab3302SCarolineConcatto       {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},
92664ab3302SCarolineConcatto       {IoSpecKind::Round,
92764ab3302SCarolineConcatto           {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
92864ab3302SCarolineConcatto       {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
92964ab3302SCarolineConcatto       {IoSpecKind::Status,
93064ab3302SCarolineConcatto           // Open values; Close values are {"DELETE", "KEEP"}.
93164ab3302SCarolineConcatto           {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
932c9637577Speter klausler       {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
933320a5197SPeter Klausler       {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE", "SWAP"}},
93464ab3302SCarolineConcatto       {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
93564ab3302SCarolineConcatto   };
936c105d9b3SPeter Klausler   auto upper{Normalize(value)};
93772abc199Speter klausler   if (specValues.at(specKind).count(upper) == 0) {
9388cd199b8Speter klausler     if (specKind == IoSpecKind::Access && upper == "APPEND") {
9390f973ac7SPeter Klausler       context_.Warn(common::LanguageFeature::OpenAccessAppend, source,
9400f973ac7SPeter Klausler           "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper);
94172abc199Speter klausler     } else {
94264ab3302SCarolineConcatto       context_.Say(source, "Invalid %s value '%s'"_err_en_US,
94364ab3302SCarolineConcatto           parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
94464ab3302SCarolineConcatto     }
94564ab3302SCarolineConcatto   }
94672abc199Speter klausler }
94764ab3302SCarolineConcatto 
94864ab3302SCarolineConcatto // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
94964ab3302SCarolineConcatto // need conditions to check, and string arguments to insert into a message.
950bce7a7edSpeter klausler // An IoSpecKind provides both an absence/presence condition and a string
95164ab3302SCarolineConcatto // argument (its name).  A (condition, string) pair provides an arbitrary
95264ab3302SCarolineConcatto // condition and an arbitrary string.
95364ab3302SCarolineConcatto 
95464ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
95564ab3302SCarolineConcatto   if (!specifierSet_.test(specKind)) {
95664ab3302SCarolineConcatto     context_.Say("%s statement must have a %s specifier"_err_en_US,
95764ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
95864ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
95964ab3302SCarolineConcatto   }
96064ab3302SCarolineConcatto }
96164ab3302SCarolineConcatto 
96264ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(
96364ab3302SCarolineConcatto     bool condition, const std::string &s) const {
96464ab3302SCarolineConcatto   if (!condition) {
96564ab3302SCarolineConcatto     context_.Say("%s statement must have a %s specifier"_err_en_US,
96664ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
96764ab3302SCarolineConcatto   }
96864ab3302SCarolineConcatto }
96964ab3302SCarolineConcatto 
97064ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(
97164ab3302SCarolineConcatto     IoSpecKind specKind1, IoSpecKind specKind2) const {
97264ab3302SCarolineConcatto   if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
97364ab3302SCarolineConcatto     context_.Say("If %s appears, %s must also appear"_err_en_US,
97464ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
97564ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
97664ab3302SCarolineConcatto   }
97764ab3302SCarolineConcatto }
97864ab3302SCarolineConcatto 
97964ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(
98064ab3302SCarolineConcatto     IoSpecKind specKind, bool condition, const std::string &s) const {
98164ab3302SCarolineConcatto   if (specifierSet_.test(specKind) && !condition) {
98264ab3302SCarolineConcatto     context_.Say("If %s appears, %s must also appear"_err_en_US,
98364ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
98464ab3302SCarolineConcatto   }
98564ab3302SCarolineConcatto }
98664ab3302SCarolineConcatto 
98764ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(
98864ab3302SCarolineConcatto     bool condition, const std::string &s, IoSpecKind specKind) const {
98964ab3302SCarolineConcatto   if (condition && !specifierSet_.test(specKind)) {
99064ab3302SCarolineConcatto     context_.Say("If %s appears, %s must also appear"_err_en_US, s,
99164ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
99264ab3302SCarolineConcatto   }
99364ab3302SCarolineConcatto }
99464ab3302SCarolineConcatto 
99564ab3302SCarolineConcatto void IoChecker::CheckForRequiredSpecifier(bool condition1,
99664ab3302SCarolineConcatto     const std::string &s1, bool condition2, const std::string &s2) const {
99764ab3302SCarolineConcatto   if (condition1 && !condition2) {
99864ab3302SCarolineConcatto     context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
99964ab3302SCarolineConcatto   }
100064ab3302SCarolineConcatto }
100164ab3302SCarolineConcatto 
100264ab3302SCarolineConcatto void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
100364ab3302SCarolineConcatto   if (specifierSet_.test(specKind)) {
100464ab3302SCarolineConcatto     context_.Say("%s statement must not have a %s specifier"_err_en_US,
100564ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
100664ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
100764ab3302SCarolineConcatto   }
100864ab3302SCarolineConcatto }
100964ab3302SCarolineConcatto 
101064ab3302SCarolineConcatto void IoChecker::CheckForProhibitedSpecifier(
101164ab3302SCarolineConcatto     IoSpecKind specKind1, IoSpecKind specKind2) const {
101264ab3302SCarolineConcatto   if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
101364ab3302SCarolineConcatto     context_.Say("If %s appears, %s must not appear"_err_en_US,
101464ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
101564ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
101664ab3302SCarolineConcatto   }
101764ab3302SCarolineConcatto }
101864ab3302SCarolineConcatto 
101964ab3302SCarolineConcatto void IoChecker::CheckForProhibitedSpecifier(
102064ab3302SCarolineConcatto     IoSpecKind specKind, bool condition, const std::string &s) const {
102164ab3302SCarolineConcatto   if (specifierSet_.test(specKind) && condition) {
102264ab3302SCarolineConcatto     context_.Say("If %s appears, %s must not appear"_err_en_US,
102364ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
102464ab3302SCarolineConcatto   }
102564ab3302SCarolineConcatto }
102664ab3302SCarolineConcatto 
102764ab3302SCarolineConcatto void IoChecker::CheckForProhibitedSpecifier(
102864ab3302SCarolineConcatto     bool condition, const std::string &s, IoSpecKind specKind) const {
102964ab3302SCarolineConcatto   if (condition && specifierSet_.test(specKind)) {
103064ab3302SCarolineConcatto     context_.Say("If %s appears, %s must not appear"_err_en_US, s,
103164ab3302SCarolineConcatto         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
103264ab3302SCarolineConcatto   }
103364ab3302SCarolineConcatto }
103464ab3302SCarolineConcatto 
1035bce7a7edSpeter klausler template <typename A>
1036bce7a7edSpeter klausler void IoChecker::CheckForDefinableVariable(
1037bbd0dc3dSpeter klausler     const A &variable, const std::string &s) const {
1038bbd0dc3dSpeter klausler   if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
1039bbd0dc3dSpeter klausler     if (auto expr{AnalyzeExpr(context_, *var)}) {
1040bbd0dc3dSpeter klausler       auto at{var->GetSource()};
1041573fc618SPeter Klausler       if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
1042573fc618SPeter Klausler               DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
1043573fc618SPeter Klausler               *expr)}) {
1044d5285fefSPeter Klausler         if (whyNot->IsFatal()) {
1045bbd0dc3dSpeter klausler           const Symbol *base{GetFirstSymbol(*expr)};
104624e8e21fSpeter klausler           context_
1047573fc618SPeter Klausler               .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
1048bbd0dc3dSpeter klausler                   (base ? base->name() : at).ToString())
1049d5285fefSPeter Klausler               .Attach(
1050d5285fefSPeter Klausler                   std::move(whyNot->set_severity(parser::Severity::Because)));
1051d5285fefSPeter Klausler         } else {
1052d5285fefSPeter Klausler           context_.Say(std::move(*whyNot));
1053d5285fefSPeter Klausler         }
1054bbd0dc3dSpeter klausler       }
1055bbd0dc3dSpeter klausler     }
1056bce7a7edSpeter klausler   }
1057bce7a7edSpeter klausler }
1058bce7a7edSpeter klausler 
105964ab3302SCarolineConcatto void IoChecker::CheckForPureSubprogram() const { // C1597
106064ab3302SCarolineConcatto   CHECK(context_.location());
1061e727bda1SPeter Klausler   const Scope &scope{context_.FindScope(*context_.location())};
1062e727bda1SPeter Klausler   if (FindPureProcedureContaining(scope)) {
1063e727bda1SPeter Klausler     context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US);
106464ab3302SCarolineConcatto   }
106564ab3302SCarolineConcatto }
106664ab3302SCarolineConcatto 
1067b949a6f5SPeter Klausler void IoChecker::CheckForUselessIomsg() const {
1068b949a6f5SPeter Klausler   if (specifierSet_.test(IoSpecKind::Iomsg) &&
1069b949a6f5SPeter Klausler       !specifierSet_.test(IoSpecKind::Err) &&
1070b949a6f5SPeter Klausler       !specifierSet_.test(IoSpecKind::Iostat) &&
1071b949a6f5SPeter Klausler       context_.ShouldWarn(common::UsageWarning::UselessIomsg)) {
1072b949a6f5SPeter Klausler     context_.Say("IOMSG= is useless without either ERR= or IOSTAT="_warn_en_US);
1073b949a6f5SPeter Klausler   }
1074b949a6f5SPeter Klausler }
1075b949a6f5SPeter Klausler 
10765ea0ba2cSPeter Klausler // Seeks out an allocatable or pointer ultimate component that is not
10775ea0ba2cSPeter Klausler // nested in a nonallocatable/nonpointer component with a specific
10785ea0ba2cSPeter Klausler // defined I/O procedure.
10797cf1608bSPeter Klausler static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which,
10805ea0ba2cSPeter Klausler     const DerivedTypeSpec &derived, const Scope &scope) {
10815ea0ba2cSPeter Klausler   if (HasDefinedIo(which, derived, &scope)) {
10825ea0ba2cSPeter Klausler     return nullptr;
10835ea0ba2cSPeter Klausler   }
10845ea0ba2cSPeter Klausler   if (const Scope * dtScope{derived.scope()}) {
10855ea0ba2cSPeter Klausler     for (const auto &pair : *dtScope) {
10865ea0ba2cSPeter Klausler       const Symbol &symbol{*pair.second};
10875ea0ba2cSPeter Klausler       if (IsAllocatableOrPointer(symbol)) {
10885ea0ba2cSPeter Klausler         return &symbol;
10895ea0ba2cSPeter Klausler       }
10905ea0ba2cSPeter Klausler       if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
10915ea0ba2cSPeter Klausler         if (const DeclTypeSpec * type{details->type()}) {
10925ea0ba2cSPeter Klausler           if (type->category() == DeclTypeSpec::Category::TypeDerived) {
10935ea0ba2cSPeter Klausler             const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()};
109419d86426SPeter Klausler             if (const Symbol *
109519d86426SPeter Klausler                 bad{FindUnsafeIoDirectComponent(
10965ea0ba2cSPeter Klausler                     which, componentDerived, scope)}) {
10975ea0ba2cSPeter Klausler               return bad;
109819d86426SPeter Klausler             }
109919d86426SPeter Klausler           }
110019d86426SPeter Klausler         }
110119d86426SPeter Klausler       }
11025ea0ba2cSPeter Klausler     }
11035ea0ba2cSPeter Klausler   }
11045ea0ba2cSPeter Klausler   return nullptr;
11055ea0ba2cSPeter Klausler }
11065ea0ba2cSPeter Klausler 
11075ea0ba2cSPeter Klausler // For a type that does not have a defined I/O subroutine, finds a direct
11085ea0ba2cSPeter Klausler // component that is a witness to an accessibility violation outside the module
11095ea0ba2cSPeter Klausler // in which the type was defined.
11107cf1608bSPeter Klausler static const Symbol *FindInaccessibleComponent(common::DefinedIo which,
11115ea0ba2cSPeter Klausler     const DerivedTypeSpec &derived, const Scope &scope) {
11125ea0ba2cSPeter Klausler   if (const Scope * dtScope{derived.scope()}) {
11135ea0ba2cSPeter Klausler     if (const Scope * module{FindModuleContaining(*dtScope)}) {
11145ea0ba2cSPeter Klausler       for (const auto &pair : *dtScope) {
11155ea0ba2cSPeter Klausler         const Symbol &symbol{*pair.second};
11165ea0ba2cSPeter Klausler         if (IsAllocatableOrPointer(symbol)) {
11175ea0ba2cSPeter Klausler           continue; // already an error
11185ea0ba2cSPeter Klausler         }
11195ea0ba2cSPeter Klausler         if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
11205ea0ba2cSPeter Klausler           const DerivedTypeSpec *componentDerived{nullptr};
11215ea0ba2cSPeter Klausler           if (const DeclTypeSpec * type{details->type()}) {
11225ea0ba2cSPeter Klausler             if (type->category() == DeclTypeSpec::Category::TypeDerived) {
11235ea0ba2cSPeter Klausler               componentDerived = &type->derivedTypeSpec();
11245ea0ba2cSPeter Klausler             }
11255ea0ba2cSPeter Klausler           }
11265ea0ba2cSPeter Klausler           if (componentDerived &&
11275ea0ba2cSPeter Klausler               HasDefinedIo(which, *componentDerived, &scope)) {
11285ea0ba2cSPeter Klausler             continue; // this component and its descendents are fine
11295ea0ba2cSPeter Klausler           }
11305ea0ba2cSPeter Klausler           if (symbol.attrs().test(Attr::PRIVATE) &&
11315ea0ba2cSPeter Klausler               !symbol.test(Symbol::Flag::ParentComp)) {
11325ea0ba2cSPeter Klausler             if (!DoesScopeContain(module, scope)) {
11335ea0ba2cSPeter Klausler               return &symbol;
11345ea0ba2cSPeter Klausler             }
11355ea0ba2cSPeter Klausler           }
11365ea0ba2cSPeter Klausler           if (componentDerived) {
11375ea0ba2cSPeter Klausler             if (const Symbol *
11385ea0ba2cSPeter Klausler                 bad{FindInaccessibleComponent(
11395ea0ba2cSPeter Klausler                     which, *componentDerived, scope)}) {
11405ea0ba2cSPeter Klausler               return bad;
11415ea0ba2cSPeter Klausler             }
11425ea0ba2cSPeter Klausler           }
11435ea0ba2cSPeter Klausler         }
11445ea0ba2cSPeter Klausler       }
11455ea0ba2cSPeter Klausler     }
11465ea0ba2cSPeter Klausler   }
11475ea0ba2cSPeter Klausler   return nullptr;
11485ea0ba2cSPeter Klausler }
11495ea0ba2cSPeter Klausler 
11505ea0ba2cSPeter Klausler // Fortran 2018, 12.6.3 paragraphs 5 & 7
11515ea0ba2cSPeter Klausler parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type,
11527cf1608bSPeter Klausler     common::DefinedIo which, parser::CharBlock where) const {
11535ea0ba2cSPeter Klausler   if (type.IsUnlimitedPolymorphic()) {
11545ea0ba2cSPeter Klausler     return &context_.Say(
11555ea0ba2cSPeter Klausler         where, "I/O list item may not be unlimited polymorphic"_err_en_US);
11565ea0ba2cSPeter Klausler   } else if (type.category() == TypeCategory::Derived) {
11575ea0ba2cSPeter Klausler     const auto &derived{type.GetDerivedTypeSpec()};
11585ea0ba2cSPeter Klausler     const Scope &scope{context_.FindScope(where)};
11595ea0ba2cSPeter Klausler     if (const Symbol *
11605ea0ba2cSPeter Klausler         bad{FindUnsafeIoDirectComponent(which, derived, scope)}) {
11615ea0ba2cSPeter Klausler       return &context_.SayWithDecl(*bad, where,
11625ea0ba2cSPeter Klausler           "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US,
11635ea0ba2cSPeter Klausler           derived.name(), bad->name());
11645ea0ba2cSPeter Klausler     }
11655ea0ba2cSPeter Klausler     if (!HasDefinedIo(which, derived, &scope)) {
11665ea0ba2cSPeter Klausler       if (type.IsPolymorphic()) {
11675ea0ba2cSPeter Klausler         return &context_.Say(where,
11685ea0ba2cSPeter Klausler             "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US,
11695ea0ba2cSPeter Klausler             derived.name());
11705ea0ba2cSPeter Klausler       }
117192e75c09SValentin Clement (バレンタイン クレメン)       if ((IsBuiltinDerivedType(&derived, "c_ptr") ||
117292e75c09SValentin Clement (バレンタイン クレメン)               IsBuiltinDerivedType(&derived, "c_devptr")) &&
117392e75c09SValentin Clement (バレンタイン クレメン)           !context_.ShouldWarn(common::LanguageFeature::PrintCptr)) {
117492e75c09SValentin Clement (バレンタイン クレメン)         // Bypass the check below for c_ptr and c_devptr.
117592e75c09SValentin Clement (バレンタイン クレメン)         return nullptr;
117692e75c09SValentin Clement (バレンタイン クレメン)       }
11775ea0ba2cSPeter Klausler       if (const Symbol *
11785ea0ba2cSPeter Klausler           bad{FindInaccessibleComponent(which, derived, scope)}) {
11795ea0ba2cSPeter Klausler         return &context_.Say(where,
11805ea0ba2cSPeter Klausler             "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,
11815ea0ba2cSPeter Klausler             derived.name(), bad->name());
11825ea0ba2cSPeter Klausler       }
11835ea0ba2cSPeter Klausler     }
11845ea0ba2cSPeter Klausler   }
11855ea0ba2cSPeter Klausler   return nullptr;
11865ea0ba2cSPeter Klausler }
11875ea0ba2cSPeter Klausler 
11887cf1608bSPeter Klausler void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which,
11897cf1608bSPeter Klausler     parser::CharBlock where) const {
11905ea0ba2cSPeter Klausler   if (auto type{expr.GetType()}) {
11915ea0ba2cSPeter Klausler     CheckForBadIoType(*type, which, where);
11925ea0ba2cSPeter Klausler   }
11935ea0ba2cSPeter Klausler }
11945ea0ba2cSPeter Klausler 
11955ea0ba2cSPeter Klausler parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,
11967cf1608bSPeter Klausler     common::DefinedIo which, parser::CharBlock where) const {
11975ea0ba2cSPeter Klausler   if (auto type{evaluate::DynamicType::From(symbol)}) {
11985ea0ba2cSPeter Klausler     if (auto *msg{CheckForBadIoType(*type, which, where)}) {
11995ea0ba2cSPeter Klausler       evaluate::AttachDeclaration(*msg, symbol);
12005ea0ba2cSPeter Klausler       return msg;
12015ea0ba2cSPeter Klausler     }
12025ea0ba2cSPeter Klausler   }
12035ea0ba2cSPeter Klausler   return nullptr;
12045ea0ba2cSPeter Klausler }
12055ea0ba2cSPeter Klausler 
12067cf1608bSPeter Klausler void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
12077cf1608bSPeter Klausler     parser::CharBlock namelistLocation) const {
12086b8e3382SPeter Klausler   if (!context_.HasError(namelist)) {
12095ea0ba2cSPeter Klausler     const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
12105ea0ba2cSPeter Klausler     for (const Symbol &object : details.objects()) {
12115ea0ba2cSPeter Klausler       context_.CheckIndexVarRedefine(namelistLocation, object);
12125ea0ba2cSPeter Klausler       if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
12135ea0ba2cSPeter Klausler         evaluate::AttachDeclaration(*msg, namelist);
12146b8e3382SPeter Klausler       } else if (which == common::DefinedIo::ReadFormatted) {
12156b8e3382SPeter Klausler         if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(),
12166b8e3382SPeter Klausler                 DefinabilityFlags{}, object)}) {
12176b8e3382SPeter Klausler           context_
12186b8e3382SPeter Klausler               .Say(namelistLocation,
12196b8e3382SPeter Klausler                   "NAMELIST input group must not contain undefinable item '%s'"_err_en_US,
12206b8e3382SPeter Klausler                   object.name())
1221d5285fefSPeter Klausler               .Attach(std::move(why->set_severity(parser::Severity::Because)));
12226b8e3382SPeter Klausler           context_.SetError(namelist);
12236b8e3382SPeter Klausler         }
12246b8e3382SPeter Klausler       }
12255ea0ba2cSPeter Klausler     }
12265ea0ba2cSPeter Klausler   }
12275ea0ba2cSPeter Klausler }
122819d86426SPeter Klausler 
122964ab3302SCarolineConcatto } // namespace Fortran::semantics
1230