shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
llvm-project/flang/lib/Semantics/check-io.cpp
Peter Klausler 348002e111
[flang] Check definability for logical INQUIRE specifiers (#144797) 
check-io.cpp was missing checks for the definability of logical-valued
specifiers in INQUIRE statements (e.g. EXIST=), and therefore also not
noting the definitions of those variables. This could lead to bogus
warnings about undefined function result variables, and also to missed
errors about immutable objects appearing in those specifiers.

Fixes https://github.com/llvm/llvm-project/issues/144453.
2025-06-30 10:21:06 -07:00

1255 lines
45 KiB
C++
Raw Blame History

//===-- 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/Common/indirection.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/characters.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;
}
CheckForDefinableVariable(std::get<parser::ScalarLogicalVariable>(spec.t),
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
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 = common::Indirection<parser::Expr>{std::move(newExpr)};
SetSpecifier(IoSpecKind::Unit);
flags_.set(Flag::NumberUnit);
} 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);
} else if (const common::Indirection<parser::Expr> *pexpr{
std::get_if<common::Indirection<parser::Expr>>(&spec.u)}) {
const auto *expr{GetExpr(context_, *pexpr)};
std::optional<evaluate::DynamicType> dyType;
if (expr) {
dyType = expr->GetType();
}
if (!expr || !dyType) {
context_.Say(parser::FindSourceLocation(*pexpr),
"I/O unit must be a character variable or scalar integer expression"_err_en_US);
} else if (dyType->category() != TypeCategory::Integer) {
context_.Say(parser::FindSourceLocation(*pexpr),
"I/O unit must be a character variable or a scalar integer expression, but is an expression of type %s"_err_en_US,
parser::ToUpperCaseLetters(dyType->AsFortran()));
} else if (expr->Rank() != 0) {
context_.Say(parser::FindSourceLocation(*pexpr),
"I/O unit number must be scalar"_err_en_US);
}
SetSpecifier(IoSpecKind::Unit);
flags_.set(Flag::NumberUnit);
}
}
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
Reference in New Issue View Git Blame Copy Permalink