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