| //===-- lib/Semantics/check-io.cpp ----------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| |
| #include "check-io.h" |
| #include "definable.h" |
| #include "flang/Common/format.h" |
| #include "flang/Evaluate/tools.h" |
| #include "flang/Parser/tools.h" |
| #include "flang/Semantics/expression.h" |
| #include "flang/Semantics/tools.h" |
| #include <unordered_map> |
| |
| namespace Fortran::semantics { |
| |
| // TODO: C1234, C1235 -- defined I/O constraints |
| |
| class FormatErrorReporter { |
| public: |
| FormatErrorReporter(SemanticsContext &context, |
| const parser::CharBlock &formatCharBlock, int errorAllowance = 3) |
| : context_{context}, formatCharBlock_{formatCharBlock}, |
| errorAllowance_{errorAllowance} {} |
| |
| bool Say(const common::FormatMessage &); |
| |
| private: |
| SemanticsContext &context_; |
| const parser::CharBlock &formatCharBlock_; |
| int errorAllowance_; // initialized to maximum number of errors to report |
| }; |
| |
| bool FormatErrorReporter::Say(const common::FormatMessage &msg) { |
| if (!msg.isError && |
| !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) { |
| return false; |
| } |
| parser::MessageFormattedText text{ |
| parser::MessageFixedText{msg.text, strlen(msg.text), |
| msg.isError ? parser::Severity::Error : parser::Severity::Warning}, |
| msg.arg}; |
| if (formatCharBlock_.size()) { |
| // The input format is a folded expression. Error markers span the full |
| // original unfolded expression in formatCharBlock_. |
| context_.Say(formatCharBlock_, text); |
| } else { |
| // The input format is a source expression. Error markers have an offset |
| // and length relative to the beginning of formatCharBlock_. |
| parser::CharBlock messageCharBlock{ |
| parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)}; |
| context_.Say(messageCharBlock, text); |
| } |
| return msg.isError && --errorAllowance_ <= 0; |
| } |
| |
| void IoChecker::Enter( |
| const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) { |
| if (!stmt.label) { |
| context_.Say("Format statement must be labeled"_err_en_US); // C1301 |
| } |
| const char *formatStart{static_cast<const char *>( |
| std::memchr(stmt.source.begin(), '(', stmt.source.size()))}; |
| parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)}; |
| FormatErrorReporter reporter{context_, reporterCharBlock}; |
| auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }}; |
| switch (context_.GetDefaultKind(TypeCategory::Character)) { |
| case 1: { |
| common::FormatValidator<char> validator{formatStart, |
| stmt.source.size() - (formatStart - stmt.source.begin()), |
| reporterWrapper}; |
| validator.Check(); |
| break; |
| } |
| case 2: { // TODO: Get this to work. |
| common::FormatValidator<char16_t> validator{ |
| /*???*/ nullptr, /*???*/ 0, reporterWrapper}; |
| validator.Check(); |
| break; |
| } |
| case 4: { // TODO: Get this to work. |
| common::FormatValidator<char32_t> validator{ |
| /*???*/ nullptr, /*???*/ 0, reporterWrapper}; |
| validator.Check(); |
| break; |
| } |
| default: |
| CRASH_NO_CASE; |
| } |
| } |
| |
| void IoChecker::Enter(const parser::ConnectSpec &spec) { |
| // ConnectSpec context FileNameExpr |
| if (std::get_if<parser::FileNameExpr>(&spec.u)) { |
| SetSpecifier(IoSpecKind::File); |
| } |
| } |
| |
| // Ignore trailing spaces (12.5.6.2 p1) and convert to upper case |
| static std::string Normalize(const std::string &value) { |
| auto upper{parser::ToUpperCaseLetters(value)}; |
| std::size_t lastNonBlank{upper.find_last_not_of(' ')}; |
| upper.resize(lastNonBlank == std::string::npos ? 0 : lastNonBlank + 1); |
| return upper; |
| } |
| |
| void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) { |
| IoSpecKind specKind{}; |
| using ParseKind = parser::ConnectSpec::CharExpr::Kind; |
| switch (std::get<ParseKind>(spec.t)) { |
| case ParseKind::Access: |
| specKind = IoSpecKind::Access; |
| break; |
| case ParseKind::Action: |
| specKind = IoSpecKind::Action; |
| break; |
| case ParseKind::Asynchronous: |
| specKind = IoSpecKind::Asynchronous; |
| break; |
| case ParseKind::Blank: |
| specKind = IoSpecKind::Blank; |
| break; |
| case ParseKind::Decimal: |
| specKind = IoSpecKind::Decimal; |
| break; |
| case ParseKind::Delim: |
| specKind = IoSpecKind::Delim; |
| break; |
| case ParseKind::Encoding: |
| specKind = IoSpecKind::Encoding; |
| break; |
| case ParseKind::Form: |
| specKind = IoSpecKind::Form; |
| break; |
| case ParseKind::Pad: |
| specKind = IoSpecKind::Pad; |
| break; |
| case ParseKind::Position: |
| specKind = IoSpecKind::Position; |
| break; |
| case ParseKind::Round: |
| specKind = IoSpecKind::Round; |
| break; |
| case ParseKind::Sign: |
| specKind = IoSpecKind::Sign; |
| break; |
| case ParseKind::Carriagecontrol: |
| specKind = IoSpecKind::Carriagecontrol; |
| break; |
| case ParseKind::Convert: |
| specKind = IoSpecKind::Convert; |
| break; |
| case ParseKind::Dispose: |
| specKind = IoSpecKind::Dispose; |
| break; |
| } |
| SetSpecifier(specKind); |
| if (const std::optional<std::string> charConst{GetConstExpr<std::string>( |
| std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { |
| std::string s{Normalize(*charConst)}; |
| if (specKind == IoSpecKind::Access) { |
| flags_.set(Flag::KnownAccess); |
| flags_.set(Flag::AccessDirect, s == "DIRECT"); |
| flags_.set(Flag::AccessStream, s == "STREAM"); |
| } |
| CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); |
| if (specKind == IoSpecKind::Carriagecontrol && |
| (s == "FORTRAN" || s == "NONE")) { |
| context_.Say(parser::FindSourceLocation(spec), |
| "Unimplemented %s value '%s'"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind)), |
| *charConst); |
| } |
| } |
| } |
| |
| void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) { |
| CheckForDefinableVariable(var, "NEWUNIT"); |
| SetSpecifier(IoSpecKind::Newunit); |
| } |
| |
| void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) { |
| SetSpecifier(IoSpecKind::Recl); |
| if (const std::optional<std::int64_t> recl{ |
| GetConstExpr<std::int64_t>(spec)}) { |
| if (*recl <= 0) { |
| context_.Say(parser::FindSourceLocation(spec), |
| "RECL value (%jd) must be positive"_err_en_US, |
| *recl); // 12.5.6.15 |
| } |
| } |
| } |
| |
| void IoChecker::Enter(const parser::EndLabel &) { |
| SetSpecifier(IoSpecKind::End); |
| } |
| |
| void IoChecker::Enter(const parser::EorLabel &) { |
| SetSpecifier(IoSpecKind::Eor); |
| } |
| |
| void IoChecker::Enter(const parser::ErrLabel &) { |
| SetSpecifier(IoSpecKind::Err); |
| } |
| |
| void IoChecker::Enter(const parser::FileUnitNumber &) { |
| SetSpecifier(IoSpecKind::Unit); |
| flags_.set(Flag::NumberUnit); |
| } |
| |
| void IoChecker::Enter(const parser::Format &spec) { |
| SetSpecifier(IoSpecKind::Fmt); |
| flags_.set(Flag::FmtOrNml); |
| common::visit( |
| common::visitors{ |
| [&](const parser::Label &) { flags_.set(Flag::LabelFmt); }, |
| [&](const parser::Star &) { flags_.set(Flag::StarFmt); }, |
| [&](const parser::Expr &format) { |
| const SomeExpr *expr{GetExpr(context_, format)}; |
| if (!expr) { |
| return; |
| } |
| auto type{expr->GetType()}; |
| if (type && type->category() == TypeCategory::Integer && |
| type->kind() == |
| context_.defaultKinds().GetDefaultKind(type->category()) && |
| expr->Rank() == 0) { |
| flags_.set(Flag::AssignFmt); |
| if (!IsVariable(*expr)) { |
| context_.Say(format.source, |
| "Assigned format label must be a scalar variable"_err_en_US); |
| } else { |
| context_.Warn(common::LanguageFeature::Assign, format.source, |
| "Assigned format labels are deprecated"_port_en_US); |
| } |
| return; |
| } |
| if (type && type->category() != TypeCategory::Character && |
| (type->category() != TypeCategory::Integer || |
| expr->Rank() > 0) && |
| context_.IsEnabled( |
| common::LanguageFeature::NonCharacterFormat)) { |
| // Legacy extension: using non-character variables, typically |
| // DATA-initialized with Hollerith, as format expressions. |
| context_.Warn(common::LanguageFeature::NonCharacterFormat, |
| format.source, |
| "Non-character format expression is not standard"_port_en_US); |
| } else if (!type || |
| type->kind() != |
| context_.defaultKinds().GetDefaultKind(type->category())) { |
| context_.Say(format.source, |
| "Format expression must be default character or default scalar integer"_err_en_US); |
| return; |
| } |
| flags_.set(Flag::CharFmt); |
| const std::optional<std::string> constantFormat{ |
| GetConstExpr<std::string>(format)}; |
| if (!constantFormat) { |
| return; |
| } |
| // validate constant format -- 12.6.2.2 |
| bool isFolded{constantFormat->size() != format.source.size() - 2}; |
| parser::CharBlock reporterCharBlock{isFolded |
| ? parser::CharBlock{format.source} |
| : parser::CharBlock{format.source.begin() + 1, |
| static_cast<std::size_t>(0)}}; |
| FormatErrorReporter reporter{context_, reporterCharBlock}; |
| auto reporterWrapper{ |
| [&](const auto &msg) { return reporter.Say(msg); }}; |
| switch (context_.GetDefaultKind(TypeCategory::Character)) { |
| case 1: { |
| common::FormatValidator<char> validator{constantFormat->c_str(), |
| constantFormat->length(), reporterWrapper, stmt_}; |
| validator.Check(); |
| break; |
| } |
| case 2: { |
| // TODO: Get this to work. (Maybe combine with earlier instance?) |
| common::FormatValidator<char16_t> validator{ |
| /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; |
| validator.Check(); |
| break; |
| } |
| case 4: { |
| // TODO: Get this to work. (Maybe combine with earlier instance?) |
| common::FormatValidator<char32_t> validator{ |
| /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_}; |
| validator.Check(); |
| break; |
| } |
| default: |
| CRASH_NO_CASE; |
| } |
| }, |
| }, |
| spec.u); |
| } |
| |
| void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); } |
| |
| void IoChecker::Enter(const parser::IdVariable &spec) { |
| SetSpecifier(IoSpecKind::Id); |
| const auto *expr{GetExpr(context_, spec)}; |
| if (!expr || !expr->GetType()) { |
| return; |
| } |
| CheckForDefinableVariable(spec, "ID"); |
| int kind{expr->GetType()->kind()}; |
| int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)}; |
| if (kind < defaultKind) { |
| context_.Say( |
| "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US, |
| std::move(kind), std::move(defaultKind)); // C1229 |
| } |
| } |
| |
| void IoChecker::Enter(const parser::InputItem &spec) { |
| flags_.set(Flag::DataList); |
| const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)}; |
| if (!var) { |
| return; |
| } |
| CheckForDefinableVariable(*var, "Input"); |
| if (auto expr{AnalyzeExpr(context_, *var)}) { |
| CheckForBadIoType(*expr, |
| flags_.test(Flag::FmtOrNml) ? common::DefinedIo::ReadFormatted |
| : common::DefinedIo::ReadUnformatted, |
| var->GetSource()); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::InquireSpec &spec) { |
| // InquireSpec context FileNameExpr |
| if (std::get_if<parser::FileNameExpr>(&spec.u)) { |
| SetSpecifier(IoSpecKind::File); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) { |
| IoSpecKind specKind{}; |
| using ParseKind = parser::InquireSpec::CharVar::Kind; |
| switch (std::get<ParseKind>(spec.t)) { |
| case ParseKind::Access: |
| specKind = IoSpecKind::Access; |
| break; |
| case ParseKind::Action: |
| specKind = IoSpecKind::Action; |
| break; |
| case ParseKind::Asynchronous: |
| specKind = IoSpecKind::Asynchronous; |
| break; |
| case ParseKind::Blank: |
| specKind = IoSpecKind::Blank; |
| break; |
| case ParseKind::Decimal: |
| specKind = IoSpecKind::Decimal; |
| break; |
| case ParseKind::Delim: |
| specKind = IoSpecKind::Delim; |
| break; |
| case ParseKind::Direct: |
| specKind = IoSpecKind::Direct; |
| break; |
| case ParseKind::Encoding: |
| specKind = IoSpecKind::Encoding; |
| break; |
| case ParseKind::Form: |
| specKind = IoSpecKind::Form; |
| break; |
| case ParseKind::Formatted: |
| specKind = IoSpecKind::Formatted; |
| break; |
| case ParseKind::Iomsg: |
| specKind = IoSpecKind::Iomsg; |
| break; |
| case ParseKind::Name: |
| specKind = IoSpecKind::Name; |
| break; |
| case ParseKind::Pad: |
| specKind = IoSpecKind::Pad; |
| break; |
| case ParseKind::Position: |
| specKind = IoSpecKind::Position; |
| break; |
| case ParseKind::Read: |
| specKind = IoSpecKind::Read; |
| break; |
| case ParseKind::Readwrite: |
| specKind = IoSpecKind::Readwrite; |
| break; |
| case ParseKind::Round: |
| specKind = IoSpecKind::Round; |
| break; |
| case ParseKind::Sequential: |
| specKind = IoSpecKind::Sequential; |
| break; |
| case ParseKind::Sign: |
| specKind = IoSpecKind::Sign; |
| break; |
| case ParseKind::Status: |
| specKind = IoSpecKind::Status; |
| break; |
| case ParseKind::Stream: |
| specKind = IoSpecKind::Stream; |
| break; |
| case ParseKind::Unformatted: |
| specKind = IoSpecKind::Unformatted; |
| break; |
| case ParseKind::Write: |
| specKind = IoSpecKind::Write; |
| break; |
| case ParseKind::Carriagecontrol: |
| specKind = IoSpecKind::Carriagecontrol; |
| break; |
| case ParseKind::Convert: |
| specKind = IoSpecKind::Convert; |
| break; |
| case ParseKind::Dispose: |
| specKind = IoSpecKind::Dispose; |
| break; |
| } |
| const parser::Variable &var{ |
| std::get<parser::ScalarDefaultCharVariable>(spec.t).thing.thing}; |
| std::string what{parser::ToUpperCaseLetters(common::EnumToString(specKind))}; |
| CheckForDefinableVariable(var, what); |
| WarnOnDeferredLengthCharacterScalar( |
| context_, GetExpr(context_, var), var.GetSource(), what.c_str()); |
| SetSpecifier(specKind); |
| } |
| |
| void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) { |
| IoSpecKind specKind{}; |
| using ParseKind = parser::InquireSpec::IntVar::Kind; |
| switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) { |
| case ParseKind::Iostat: |
| specKind = IoSpecKind::Iostat; |
| break; |
| case ParseKind::Nextrec: |
| specKind = IoSpecKind::Nextrec; |
| break; |
| case ParseKind::Number: |
| specKind = IoSpecKind::Number; |
| break; |
| case ParseKind::Pos: |
| specKind = IoSpecKind::Pos; |
| break; |
| case ParseKind::Recl: |
| specKind = IoSpecKind::Recl; |
| break; |
| case ParseKind::Size: |
| specKind = IoSpecKind::Size; |
| break; |
| } |
| CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t), |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| SetSpecifier(specKind); |
| } |
| |
| void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) { |
| IoSpecKind specKind{}; |
| using ParseKind = parser::InquireSpec::LogVar::Kind; |
| switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) { |
| case ParseKind::Exist: |
| specKind = IoSpecKind::Exist; |
| break; |
| case ParseKind::Named: |
| specKind = IoSpecKind::Named; |
| break; |
| case ParseKind::Opened: |
| specKind = IoSpecKind::Opened; |
| break; |
| case ParseKind::Pending: |
| specKind = IoSpecKind::Pending; |
| break; |
| } |
| SetSpecifier(specKind); |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec &spec) { |
| // IoControlSpec context Name |
| flags_.set(Flag::IoControlList); |
| if (std::holds_alternative<parser::Name>(spec.u)) { |
| SetSpecifier(IoSpecKind::Nml); |
| flags_.set(Flag::FmtOrNml); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) { |
| SetSpecifier(IoSpecKind::Asynchronous); |
| if (const std::optional<std::string> charConst{ |
| GetConstExpr<std::string>(spec)}) { |
| flags_.set(Flag::AsynchronousYes, Normalize(*charConst) == "YES"); |
| CheckStringValue(IoSpecKind::Asynchronous, *charConst, |
| parser::FindSourceLocation(spec)); // C1223 |
| } |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) { |
| IoSpecKind specKind{}; |
| using ParseKind = parser::IoControlSpec::CharExpr::Kind; |
| switch (std::get<ParseKind>(spec.t)) { |
| case ParseKind::Advance: |
| specKind = IoSpecKind::Advance; |
| break; |
| case ParseKind::Blank: |
| specKind = IoSpecKind::Blank; |
| break; |
| case ParseKind::Decimal: |
| specKind = IoSpecKind::Decimal; |
| break; |
| case ParseKind::Delim: |
| specKind = IoSpecKind::Delim; |
| break; |
| case ParseKind::Pad: |
| specKind = IoSpecKind::Pad; |
| break; |
| case ParseKind::Round: |
| specKind = IoSpecKind::Round; |
| break; |
| case ParseKind::Sign: |
| specKind = IoSpecKind::Sign; |
| break; |
| } |
| SetSpecifier(specKind); |
| if (const std::optional<std::string> charConst{GetConstExpr<std::string>( |
| std::get<parser::ScalarDefaultCharExpr>(spec.t))}) { |
| if (specKind == IoSpecKind::Advance) { |
| flags_.set(Flag::AdvanceYes, Normalize(*charConst) == "YES"); |
| } |
| CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec)); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec::Pos &) { |
| SetSpecifier(IoSpecKind::Pos); |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec::Rec &) { |
| SetSpecifier(IoSpecKind::Rec); |
| } |
| |
| void IoChecker::Enter(const parser::IoControlSpec::Size &var) { |
| CheckForDefinableVariable(var, "SIZE"); |
| SetSpecifier(IoSpecKind::Size); |
| } |
| |
| void IoChecker::Enter(const parser::IoUnit &spec) { |
| if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) { |
| // Only now after generic resolution can it be known whether a function |
| // call appearing as UNIT=f() is an integer scalar external unit number |
| // or a character pointer for internal I/O. |
| const auto *expr{GetExpr(context_, *var)}; |
| std::optional<evaluate::DynamicType> dyType; |
| if (expr) { |
| dyType = expr->GetType(); |
| } |
| if (dyType && dyType->category() == TypeCategory::Integer) { |
| if (expr->Rank() != 0) { |
| context_.Say(parser::FindSourceLocation(*var), |
| "I/O unit number must be scalar"_err_en_US); |
| } |
| // In the case of an integer unit number variable, rewrite the parse |
| // tree as if the unit had been parsed as a FileUnitNumber in order |
| // to ease lowering. |
| auto &mutableSpec{const_cast<parser::IoUnit &>(spec)}; |
| auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)}; |
| auto source{mutableVar.GetSource()}; |
| auto typedExpr{std::move(mutableVar.typedExpr)}; |
| auto newExpr{common::visit( |
| [](auto &&indirection) { |
| return parser::Expr{std::move(indirection)}; |
| }, |
| std::move(mutableVar.u))}; |
| newExpr.source = source; |
| newExpr.typedExpr = std::move(typedExpr); |
| mutableSpec.u = parser::FileUnitNumber{ |
| parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}}; |
| } else if (!dyType || dyType->category() != TypeCategory::Character) { |
| SetSpecifier(IoSpecKind::Unit); |
| context_.Say(parser::FindSourceLocation(*var), |
| "I/O unit must be a character variable or a scalar integer expression"_err_en_US); |
| } else { // CHARACTER variable (internal I/O) |
| if (stmt_ == IoStmtKind::Write) { |
| CheckForDefinableVariable(*var, "Internal file"); |
| WarnOnDeferredLengthCharacterScalar( |
| context_, expr, var->GetSource(), "Internal file"); |
| } |
| if (HasVectorSubscript(*expr)) { |
| context_.Say(parser::FindSourceLocation(*var), // C1201 |
| "Internal file must not have a vector subscript"_err_en_US); |
| } |
| SetSpecifier(IoSpecKind::Unit); |
| flags_.set(Flag::InternalUnit); |
| } |
| } else if (std::get_if<parser::Star>(&spec.u)) { |
| SetSpecifier(IoSpecKind::Unit); |
| flags_.set(Flag::StarUnit); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::MsgVariable &msgVar) { |
| const parser::Variable &var{msgVar.v.thing.thing}; |
| if (stmt_ == IoStmtKind::None) { |
| // allocate, deallocate, image control |
| CheckForDefinableVariable(var, "ERRMSG"); |
| WarnOnDeferredLengthCharacterScalar( |
| context_, GetExpr(context_, var), var.GetSource(), "ERRMSG="); |
| } else { |
| CheckForDefinableVariable(var, "IOMSG"); |
| WarnOnDeferredLengthCharacterScalar( |
| context_, GetExpr(context_, var), var.GetSource(), "IOMSG="); |
| SetSpecifier(IoSpecKind::Iomsg); |
| } |
| } |
| |
| void IoChecker::Enter(const parser::OutputItem &item) { |
| flags_.set(Flag::DataList); |
| if (const auto *x{std::get_if<parser::Expr>(&item.u)}) { |
| if (const auto *expr{GetExpr(context_, *x)}) { |
| if (evaluate::IsBOZLiteral(*expr)) { |
| context_.Say(parser::FindSourceLocation(*x), // C7109 |
| "Output item must not be a BOZ literal constant"_err_en_US); |
| } else if (IsProcedure(*expr)) { |
| context_.Say(parser::FindSourceLocation(*x), |
| "Output item must not be a procedure"_err_en_US); // C1233 |
| } |
| CheckForBadIoType(*expr, |
| flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted |
| : common::DefinedIo::WriteUnformatted, |
| parser::FindSourceLocation(item)); |
| } |
| } |
| } |
| |
| void IoChecker::Enter(const parser::StatusExpr &spec) { |
| SetSpecifier(IoSpecKind::Status); |
| if (const std::optional<std::string> charConst{ |
| GetConstExpr<std::string>(spec)}) { |
| // Status values for Open and Close are different. |
| std::string s{Normalize(*charConst)}; |
| if (stmt_ == IoStmtKind::Open) { |
| flags_.set(Flag::KnownStatus); |
| flags_.set(Flag::StatusNew, s == "NEW"); |
| flags_.set(Flag::StatusReplace, s == "REPLACE"); |
| flags_.set(Flag::StatusScratch, s == "SCRATCH"); |
| // CheckStringValue compares for OPEN Status string values. |
| CheckStringValue( |
| IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec)); |
| return; |
| } |
| CHECK(stmt_ == IoStmtKind::Close); |
| if (s != "DELETE" && s != "KEEP") { |
| context_.Say(parser::FindSourceLocation(spec), |
| "Invalid STATUS value '%s'"_err_en_US, *charConst); |
| } |
| } |
| } |
| |
| void IoChecker::Enter(const parser::StatVariable &var) { |
| if (stmt_ == IoStmtKind::None) { |
| // allocate, deallocate, image control |
| CheckForDefinableVariable(var, "STAT"); |
| } else { |
| CheckForDefinableVariable(var, "IOSTAT"); |
| SetSpecifier(IoSpecKind::Iostat); |
| } |
| } |
| |
| void IoChecker::Leave(const parser::BackspaceStmt &) { |
| CheckForPureSubprogram(); |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::CloseStmt &) { |
| CheckForPureSubprogram(); |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1208 |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::EndfileStmt &) { |
| CheckForPureSubprogram(); |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::FlushStmt &) { |
| CheckForPureSubprogram(); |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1243 |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::InquireStmt &stmt) { |
| if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) { |
| CheckForPureSubprogram(); |
| // Inquire by unit or by file (vs. by output list). |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File), |
| "UNIT number or FILE"); // C1246 |
| CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246 |
| CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248 |
| CheckForUselessIomsg(); |
| } |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::OpenStmt &) { |
| CheckForPureSubprogram(); |
| CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) || |
| specifierSet_.test(IoSpecKind::Newunit), |
| "UNIT or NEWUNIT"); // C1204, C1205 |
| CheckForProhibitedSpecifier( |
| IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205 |
| CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'", |
| IoSpecKind::File); // 12.5.6.10 |
| CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace), |
| "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10 |
| CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch), |
| "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10 |
| if (flags_.test(Flag::KnownStatus)) { |
| CheckForRequiredSpecifier(IoSpecKind::Newunit, |
| specifierSet_.test(IoSpecKind::File) || |
| flags_.test(Flag::StatusScratch), |
| "FILE or STATUS='SCRATCH'"); // 12.5.6.12 |
| } else { |
| CheckForRequiredSpecifier(IoSpecKind::Newunit, |
| specifierSet_.test(IoSpecKind::File) || |
| specifierSet_.test(IoSpecKind::Status), |
| "FILE or STATUS"); // 12.5.6.12 |
| } |
| if (flags_.test(Flag::KnownAccess)) { |
| CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect), |
| "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15 |
| CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream), |
| "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15 |
| } |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::PrintStmt &) { |
| CheckForPureSubprogram(); |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| static const parser::Name *FindNamelist( |
| const std::list<parser::IoControlSpec> &controls) { |
| for (const auto &control : controls) { |
| if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) { |
| if (namelist->symbol && |
| namelist->symbol->GetUltimate().has<NamelistDetails>()) { |
| return namelist; |
| } |
| } |
| } |
| return nullptr; |
| } |
| |
| static void CheckForDoVariable( |
| const parser::ReadStmt &readStmt, SemanticsContext &context) { |
| const std::list<parser::InputItem> &items{readStmt.items}; |
| for (const auto &item : items) { |
| if (const parser::Variable * |
| variable{std::get_if<parser::Variable>(&item.u)}) { |
| context.CheckIndexVarRedefine(*variable); |
| } |
| } |
| } |
| |
| void IoChecker::Leave(const parser::ReadStmt &readStmt) { |
| if (!flags_.test(Flag::InternalUnit)) { |
| CheckForPureSubprogram(); |
| } |
| if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) { |
| if (namelist->symbol) { |
| CheckNamelist(*namelist->symbol, common::DefinedIo::ReadFormatted, |
| namelist->source); |
| } |
| } |
| CheckForDoVariable(readStmt, context_); |
| if (!flags_.test(Flag::IoControlList)) { |
| Done(); |
| return; |
| } |
| LeaveReadWrite(); |
| CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212 |
| CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212 |
| CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220 |
| if (specifierSet_.test(IoSpecKind::Size)) { |
| // F'2023 C1214 - allow with a warning |
| if (context_.ShouldWarn(common::LanguageFeature::ListDirectedSize)) { |
| if (specifierSet_.test(IoSpecKind::Nml)) { |
| context_.Say("If NML appears, SIZE should not appear"_port_en_US); |
| } else if (flags_.test(Flag::StarFmt)) { |
| context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US); |
| } |
| } |
| } |
| CheckForRequiredSpecifier(IoSpecKind::Eor, |
| specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes), |
| "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2 |
| CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml), |
| "FMT or NML"); // C1227 |
| CheckForRequiredSpecifier( |
| IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::RewindStmt &) { |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1240 |
| CheckForPureSubprogram(); |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::WaitStmt &) { |
| CheckForRequiredSpecifier( |
| flags_.test(Flag::NumberUnit), "UNIT number"); // C1237 |
| CheckForPureSubprogram(); |
| CheckForUselessIomsg(); |
| Done(); |
| } |
| |
| void IoChecker::Leave(const parser::WriteStmt &writeStmt) { |
| if (!flags_.test(Flag::InternalUnit)) { |
| CheckForPureSubprogram(); |
| } |
| if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) { |
| if (namelist->symbol) { |
| CheckNamelist(*namelist->symbol, common::DefinedIo::WriteFormatted, |
| namelist->source); |
| } |
| } |
| LeaveReadWrite(); |
| CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213 |
| CheckForProhibitedSpecifier(IoSpecKind::End); // C1213 |
| CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213 |
| CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213 |
| CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213 |
| CheckForRequiredSpecifier( |
| IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227 |
| CheckForRequiredSpecifier(IoSpecKind::Delim, |
| flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml), |
| "FMT=* or NML"); // C1228 |
| Done(); |
| } |
| |
| void IoChecker::LeaveReadWrite() const { |
| CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211 |
| CheckForRequiredSpecifier(flags_.test(Flag::InternalUnit), |
| "UNIT=internal-file", flags_.test(Flag::FmtOrNml), "FMT or NML"); |
| CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216 |
| CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216 |
| CheckForProhibitedSpecifier( |
| IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216 |
| CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), |
| "UNIT=internal-file", IoSpecKind::Pos); // C1219 |
| CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit), |
| "UNIT=internal-file", IoSpecKind::Rec); // C1219 |
| CheckForProhibitedSpecifier( |
| flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219 |
| CheckForProhibitedSpecifier( |
| flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219 |
| CheckForProhibitedSpecifier( |
| IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220 |
| CheckForRequiredSpecifier(IoSpecKind::Advance, |
| flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) || |
| flags_.test(Flag::AssignFmt), |
| "an explicit format"); // C1221 |
| CheckForProhibitedSpecifier(IoSpecKind::Advance, |
| flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221 |
| CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes), |
| "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit), |
| "UNIT=number"); // C1224 |
| CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes), |
| "ASYNCHRONOUS='YES'"); // C1225 |
| CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226 |
| CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml), |
| "FMT or NML"); // C1227 |
| CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml), |
| "FMT or NML"); // C1227 |
| CheckForUselessIomsg(); |
| } |
| |
| void IoChecker::SetSpecifier(IoSpecKind specKind) { |
| if (stmt_ == IoStmtKind::None) { |
| // FMT may appear on PRINT statements, which don't have any checks. |
| // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements. |
| return; |
| } |
| // C1203, C1207, C1210, C1236, C1239, C1242, C1245 |
| if (specifierSet_.test(specKind)) { |
| context_.Say("Duplicate %s specifier"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| } |
| specifierSet_.set(specKind); |
| } |
| |
| void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value, |
| const parser::CharBlock &source) const { |
| static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{ |
| {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}}, |
| {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}}, |
| {IoSpecKind::Advance, {"NO", "YES"}}, |
| {IoSpecKind::Asynchronous, {"NO", "YES"}}, |
| {IoSpecKind::Blank, {"NULL", "ZERO"}}, |
| {IoSpecKind::Decimal, {"COMMA", "POINT"}}, |
| {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}}, |
| {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}}, |
| {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED", "BINARY"}}, |
| {IoSpecKind::Pad, {"NO", "YES"}}, |
| {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}}, |
| {IoSpecKind::Round, |
| {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}}, |
| {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}}, |
| {IoSpecKind::Status, |
| // Open values; Close values are {"DELETE", "KEEP"}. |
| {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}}, |
| {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}}, |
| {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE", "SWAP"}}, |
| {IoSpecKind::Dispose, {"DELETE", "KEEP"}}, |
| }; |
| auto upper{Normalize(value)}; |
| if (specValues.at(specKind).count(upper) == 0) { |
| if (specKind == IoSpecKind::Access && upper == "APPEND") { |
| context_.Warn(common::LanguageFeature::OpenAccessAppend, source, |
| "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper); |
| } else { |
| context_.Say(source, "Invalid %s value '%s'"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind)), value); |
| } |
| } |
| } |
| |
| // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions |
| // need conditions to check, and string arguments to insert into a message. |
| // An IoSpecKind provides both an absence/presence condition and a string |
| // argument (its name). A (condition, string) pair provides an arbitrary |
| // condition and an arbitrary string. |
| |
| void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const { |
| if (!specifierSet_.test(specKind)) { |
| context_.Say("%s statement must have a %s specifier"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(stmt_)), |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| } |
| } |
| |
| void IoChecker::CheckForRequiredSpecifier( |
| bool condition, const std::string &s) const { |
| if (!condition) { |
| context_.Say("%s statement must have a %s specifier"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s); |
| } |
| } |
| |
| void IoChecker::CheckForRequiredSpecifier( |
| IoSpecKind specKind1, IoSpecKind specKind2) const { |
| if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) { |
| context_.Say("If %s appears, %s must also appear"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind1)), |
| parser::ToUpperCaseLetters(common::EnumToString(specKind2))); |
| } |
| } |
| |
| void IoChecker::CheckForRequiredSpecifier( |
| IoSpecKind specKind, bool condition, const std::string &s) const { |
| if (specifierSet_.test(specKind) && !condition) { |
| context_.Say("If %s appears, %s must also appear"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); |
| } |
| } |
| |
| void IoChecker::CheckForRequiredSpecifier( |
| bool condition, const std::string &s, IoSpecKind specKind) const { |
| if (condition && !specifierSet_.test(specKind)) { |
| context_.Say("If %s appears, %s must also appear"_err_en_US, s, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| } |
| } |
| |
| void IoChecker::CheckForRequiredSpecifier(bool condition1, |
| const std::string &s1, bool condition2, const std::string &s2) const { |
| if (condition1 && !condition2) { |
| context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2); |
| } |
| } |
| |
| void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const { |
| if (specifierSet_.test(specKind)) { |
| context_.Say("%s statement must not have a %s specifier"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(stmt_)), |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| } |
| } |
| |
| void IoChecker::CheckForProhibitedSpecifier( |
| IoSpecKind specKind1, IoSpecKind specKind2) const { |
| if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) { |
| context_.Say("If %s appears, %s must not appear"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind1)), |
| parser::ToUpperCaseLetters(common::EnumToString(specKind2))); |
| } |
| } |
| |
| void IoChecker::CheckForProhibitedSpecifier( |
| IoSpecKind specKind, bool condition, const std::string &s) const { |
| if (specifierSet_.test(specKind) && condition) { |
| context_.Say("If %s appears, %s must not appear"_err_en_US, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind)), s); |
| } |
| } |
| |
| void IoChecker::CheckForProhibitedSpecifier( |
| bool condition, const std::string &s, IoSpecKind specKind) const { |
| if (condition && specifierSet_.test(specKind)) { |
| context_.Say("If %s appears, %s must not appear"_err_en_US, s, |
| parser::ToUpperCaseLetters(common::EnumToString(specKind))); |
| } |
| } |
| |
| template <typename A> |
| void IoChecker::CheckForDefinableVariable( |
| const A &variable, const std::string &s) const { |
| if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) { |
| if (auto expr{AnalyzeExpr(context_, *var)}) { |
| auto at{var->GetSource()}; |
| if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at), |
| DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, |
| *expr)}) { |
| if (whyNot->IsFatal()) { |
| const Symbol *base{GetFirstSymbol(*expr)}; |
| context_ |
| .Say(at, "%s variable '%s' is not definable"_err_en_US, s, |
| (base ? base->name() : at).ToString()) |
| .Attach( |
| std::move(whyNot->set_severity(parser::Severity::Because))); |
| } else { |
| context_.Say(std::move(*whyNot)); |
| } |
| } |
| } |
| } |
| } |
| |
| void IoChecker::CheckForPureSubprogram() const { // C1597 |
| CHECK(context_.location()); |
| const Scope &scope{context_.FindScope(*context_.location())}; |
| if (FindPureProcedureContaining(scope)) { |
| context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US); |
| } |
| } |
| |
| void IoChecker::CheckForUselessIomsg() const { |
| if (specifierSet_.test(IoSpecKind::Iomsg) && |
| !specifierSet_.test(IoSpecKind::Err) && |
| !specifierSet_.test(IoSpecKind::Iostat) && |
| context_.ShouldWarn(common::UsageWarning::UselessIomsg)) { |
| context_.Say("IOMSG= is useless without either ERR= or IOSTAT="_warn_en_US); |
| } |
| } |
| |
| // Seeks out an allocatable or pointer ultimate component that is not |
| // nested in a nonallocatable/nonpointer component with a specific |
| // defined I/O procedure. |
| static const Symbol *FindUnsafeIoDirectComponent(common::DefinedIo which, |
| const DerivedTypeSpec &derived, const Scope &scope) { |
| if (HasDefinedIo(which, derived, &scope)) { |
| return nullptr; |
| } |
| if (const Scope * dtScope{derived.scope()}) { |
| for (const auto &pair : *dtScope) { |
| const Symbol &symbol{*pair.second}; |
| if (IsAllocatableOrPointer(symbol)) { |
| return &symbol; |
| } |
| if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { |
| if (const DeclTypeSpec * type{details->type()}) { |
| if (type->category() == DeclTypeSpec::Category::TypeDerived) { |
| const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()}; |
| if (const Symbol * |
| bad{FindUnsafeIoDirectComponent( |
| which, componentDerived, scope)}) { |
| return bad; |
| } |
| } |
| } |
| } |
| } |
| } |
| return nullptr; |
| } |
| |
| // For a type that does not have a defined I/O subroutine, finds a direct |
| // component that is a witness to an accessibility violation outside the module |
| // in which the type was defined. |
| static const Symbol *FindInaccessibleComponent(common::DefinedIo which, |
| const DerivedTypeSpec &derived, const Scope &scope) { |
| if (const Scope * dtScope{derived.scope()}) { |
| if (const Scope * module{FindModuleContaining(*dtScope)}) { |
| for (const auto &pair : *dtScope) { |
| const Symbol &symbol{*pair.second}; |
| if (IsAllocatableOrPointer(symbol)) { |
| continue; // already an error |
| } |
| if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) { |
| const DerivedTypeSpec *componentDerived{nullptr}; |
| if (const DeclTypeSpec * type{details->type()}) { |
| if (type->category() == DeclTypeSpec::Category::TypeDerived) { |
| componentDerived = &type->derivedTypeSpec(); |
| } |
| } |
| if (componentDerived && |
| HasDefinedIo(which, *componentDerived, &scope)) { |
| continue; // this component and its descendents are fine |
| } |
| if (symbol.attrs().test(Attr::PRIVATE) && |
| !symbol.test(Symbol::Flag::ParentComp)) { |
| if (!DoesScopeContain(module, scope)) { |
| return &symbol; |
| } |
| } |
| if (componentDerived) { |
| if (const Symbol * |
| bad{FindInaccessibleComponent( |
| which, *componentDerived, scope)}) { |
| return bad; |
| } |
| } |
| } |
| } |
| } |
| } |
| return nullptr; |
| } |
| |
| // Fortran 2018, 12.6.3 paragraphs 5 & 7 |
| parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type, |
| common::DefinedIo which, parser::CharBlock where) const { |
| if (type.IsUnlimitedPolymorphic()) { |
| return &context_.Say( |
| where, "I/O list item may not be unlimited polymorphic"_err_en_US); |
| } else if (type.category() == TypeCategory::Derived) { |
| const auto &derived{type.GetDerivedTypeSpec()}; |
| const Scope &scope{context_.FindScope(where)}; |
| if (const Symbol * |
| bad{FindUnsafeIoDirectComponent(which, derived, scope)}) { |
| return &context_.SayWithDecl(*bad, where, |
| "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US, |
| derived.name(), bad->name()); |
| } |
| if (!HasDefinedIo(which, derived, &scope)) { |
| if (type.IsPolymorphic()) { |
| return &context_.Say(where, |
| "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US, |
| derived.name()); |
| } |
| if ((IsBuiltinDerivedType(&derived, "c_ptr") || |
| IsBuiltinDerivedType(&derived, "c_devptr")) && |
| !context_.ShouldWarn(common::LanguageFeature::PrintCptr)) { |
| // Bypass the check below for c_ptr and c_devptr. |
| return nullptr; |
| } |
| if (const Symbol * |
| bad{FindInaccessibleComponent(which, derived, scope)}) { |
| return &context_.Say(where, |
| "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, |
| derived.name(), bad->name()); |
| } |
| } |
| } |
| return nullptr; |
| } |
| |
| void IoChecker::CheckForBadIoType(const SomeExpr &expr, common::DefinedIo which, |
| parser::CharBlock where) const { |
| if (auto type{expr.GetType()}) { |
| CheckForBadIoType(*type, which, where); |
| } |
| } |
| |
| parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol, |
| common::DefinedIo which, parser::CharBlock where) const { |
| if (auto type{evaluate::DynamicType::From(symbol)}) { |
| if (auto *msg{CheckForBadIoType(*type, which, where)}) { |
| evaluate::AttachDeclaration(*msg, symbol); |
| return msg; |
| } |
| } |
| return nullptr; |
| } |
| |
| void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which, |
| parser::CharBlock namelistLocation) const { |
| if (!context_.HasError(namelist)) { |
| const auto &details{namelist.GetUltimate().get<NamelistDetails>()}; |
| for (const Symbol &object : details.objects()) { |
| context_.CheckIndexVarRedefine(namelistLocation, object); |
| if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) { |
| evaluate::AttachDeclaration(*msg, namelist); |
| } else if (which == common::DefinedIo::ReadFormatted) { |
| if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(), |
| DefinabilityFlags{}, object)}) { |
| context_ |
| .Say(namelistLocation, |
| "NAMELIST input group must not contain undefinable item '%s'"_err_en_US, |
| object.name()) |
| .Attach(std::move(why->set_severity(parser::Severity::Because))); |
| context_.SetError(namelist); |
| } |
| } |
| } |
| } |
| } |
| |
| } // namespace Fortran::semantics |
