forked from OSchip/llvm-project
[flang] Clause 12 semantics -- Check all constraints not otherwise checked (flang-compiler/f18#427)
* Clause 12 semantics Check all constraints not otherwise checked during parsing or label scope validation, except for C1201, C1231, and C1233-5. Obvious program requirements are also checked, except for 12.6.2.2 constant format string validation. Original-commit: flang-compiler/f18@e4ec343618 Reviewed-on: https://github.com/flang-compiler/f18/pull/427
This commit is contained in:
vdonaldson
GitHub
parent
13caf04846
commit
2741d016c6
|
|
@ -6,6 +6,7 @@ tags
|
|||
TAGS
|
||||
*.o
|
||||
.nfs*
|
||||
*.swp
|
||||
*~
|
||||
*#
|
||||
CMakeCache.txt
|
||||
|
|
|
|||
|
|
@ -40,5 +40,18 @@ ENUM_CLASS(TypeParamAttr, Kind, Len)
|
|||
ENUM_CLASS(RelationalOperator, LT, LE, EQ, NE, GE, GT)
|
||||
|
||||
ENUM_CLASS(Intent, Default, In, Out, InOut)
|
||||
|
||||
ENUM_CLASS(IoStmtKind, None, Backspace, Close, Endfile, Flush, Inquire, Open,
|
||||
Print, Read, Rewind, Wait, Write);
|
||||
|
||||
// Union of specifiers for all I/O statements.
|
||||
ENUM_CLASS(IoSpecKind, Access, Action, Advance, Asynchronous, Blank,
|
||||
Decimal, Delim, Direct, Encoding, End, Eor, Err, Exist, File, Fmt, Form,
|
||||
Formatted, Id, Iomsg, Iostat, Name, Named, Newunit, Nextrec, Nml, Number,
|
||||
Opened, Pad, Pending, Pos, Position, Read, Readwrite, Rec, Recl, Round,
|
||||
Sequential, Sign, Size, Status, Stream, Unformatted, Unit, Write,
|
||||
Convert, // nonstandard
|
||||
Dispose, // nonstandard
|
||||
)
|
||||
}
|
||||
#endif // FORTRAN_COMMON_FORTRAN_H_
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@ add_library(FortranSemantics
|
|||
check-deallocate.cc
|
||||
check-do-concurrent.cc
|
||||
check-if-stmt.cc
|
||||
check-io.cc
|
||||
check-nullify.cc
|
||||
check-return.cc
|
||||
check-stop.cc
|
||||
|
|
|
|||
|
|
@ -0,0 +1,605 @@
|
|||
// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
|
||||
#include "check-io.h"
|
||||
#include "expression.h"
|
||||
#include "tools.h"
|
||||
#include "../parser/tools.h"
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
// TODO: C1234, C1235 -- defined I/O constraints
|
||||
|
||||
void IoChecker::Enter(const parser::ConnectSpec &spec) {
|
||||
// ConnectSpec context FileNameExpr
|
||||
if (std::get_if<parser::FileNameExpr>(&spec.u)) {
|
||||
SetSpecifier(IoSpecKind::File);
|
||||
}
|
||||
}
|
||||
|
||||
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::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{parser::ToUpperCaseLetters(*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));
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::ConnectSpec::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,
|
||||
std::move(static_cast<std::intmax_t>(*recl))); // 12.5.6.15
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::EndLabel &spec) {
|
||||
SetSpecifier(IoSpecKind::End);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::EorLabel &spec) {
|
||||
SetSpecifier(IoSpecKind::Eor);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::ErrLabel &spec) {
|
||||
SetSpecifier(IoSpecKind::Err);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::FileUnitNumber &spec) {
|
||||
SetSpecifier(IoSpecKind::Unit);
|
||||
flags_.set(Flag::NumberUnit);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::Format &spec) {
|
||||
SetSpecifier(IoSpecKind::Fmt);
|
||||
flags_.set(Flag::FmtOrNml);
|
||||
if (std::get_if<parser::Star>(&spec.u)) {
|
||||
flags_.set(Flag::StarFmt);
|
||||
} else if (std::get_if<parser::Label>(&spec.u)) {
|
||||
// Format statement format should be validated elsewhere.
|
||||
flags_.set(Flag::LabelFmt);
|
||||
} else {
|
||||
flags_.set(Flag::CharFmt);
|
||||
// TODO: validate compile-time constant format -- 12.6.2.2
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IdExpr &spec) {
|
||||
SetSpecifier(IoSpecKind::Id);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IdVariable &spec) {
|
||||
SetSpecifier(IoSpecKind::Id);
|
||||
auto expr{GetExpr(spec)};
|
||||
if (expr == nullptr || !expr->GetType()) {
|
||||
return;
|
||||
}
|
||||
int kind{expr->GetType()->kind};
|
||||
int defaultKind{
|
||||
context_.defaultKinds().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);
|
||||
if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
|
||||
const parser::Name &name{GetLastName(*var)};
|
||||
if (auto *details{name.symbol->detailsIf<ObjectEntityDetails>()}) {
|
||||
// TODO: Determine if this check is needed at all, and if so, replace
|
||||
// the false subcondition with a check for a whole array. Otherwise,
|
||||
// the check incorrectly flags array element and section references.
|
||||
if (details->IsAssumedSize() && false) {
|
||||
// This check may be superseded by C928 or C1002.
|
||||
context_.Say(name.source,
|
||||
"'%s' must not be a whole assumed size array"_err_en_US,
|
||||
name.ToString().c_str()); // C1231
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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::Convert: specKind = IoSpecKind::Convert; break;
|
||||
case ParseKind::Dispose: specKind = IoSpecKind::Dispose; break;
|
||||
}
|
||||
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;
|
||||
}
|
||||
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, parser::ToUpperCaseLetters(*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, parser::ToUpperCaseLetters(*charConst) == "YES");
|
||||
}
|
||||
CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoControlSpec::Pos &spec) {
|
||||
SetSpecifier(IoSpecKind::Pos);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoControlSpec::Rec &spec) {
|
||||
SetSpecifier(IoSpecKind::Rec);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoControlSpec::Size &spec) {
|
||||
SetSpecifier(IoSpecKind::Size);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IoUnit &spec) {
|
||||
if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
|
||||
// TODO: C1201 - internal file variable must not be an array section ...
|
||||
if (auto expr{GetExpr(*var)}) {
|
||||
if (!ExprTypeKindIsDefault(*expr, context_)) {
|
||||
// This may be too restrictive; other kinds may be valid.
|
||||
context_.Say( // C1202
|
||||
"invalid character kind for an internal file variable"_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 &spec) {
|
||||
SetSpecifier(IoSpecKind::Iomsg);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::OutputItem &spec) {
|
||||
flags_.set(Flag::DataList);
|
||||
// TODO: C1233 - output item must not be a procedure pointer
|
||||
}
|
||||
|
||||
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{parser::ToUpperCaseLetters(*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).c_str());
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::StatVariable &spec) {
|
||||
SetSpecifier(IoSpecKind::Iostat);
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::BackspaceStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::CloseStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::EndfileStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::FlushStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::InquireStmt &stmt) {
|
||||
if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
|
||||
// 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
|
||||
}
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::OpenStmt &stmt) {
|
||||
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
|
||||
}
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::ReadStmt &stmt) {
|
||||
if (!flags_.test(Flag::IoControlList)) {
|
||||
return;
|
||||
}
|
||||
LeaveReadWrite();
|
||||
CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
|
||||
CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
|
||||
CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
|
||||
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
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::RewindStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::WaitStmt &stmt) {
|
||||
CheckForRequiredSpecifier(
|
||||
flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::Leave(const parser::WriteStmt &stmt) {
|
||||
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
|
||||
stmt_ = IoStmtKind::None;
|
||||
}
|
||||
|
||||
void IoChecker::LeaveReadWrite() const {
|
||||
CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
|
||||
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),
|
||||
"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
|
||||
}
|
||||
|
||||
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)).c_str());
|
||||
}
|
||||
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"}},
|
||||
{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::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
|
||||
{IoSpecKind::Dispose, {"DELETE", "KEEP"}},
|
||||
};
|
||||
if (!specValues.at(specKind).count(parser::ToUpperCaseLetters(value))) {
|
||||
context_.Say(source, "invalid %s value '%s'"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)).c_str(),
|
||||
value.c_str());
|
||||
}
|
||||
}
|
||||
|
||||
// CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
|
||||
// need conditions to check, and string arguments to insert into a message.
|
||||
// A 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_)).c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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_)).c_str(),
|
||||
s.c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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)).c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind2)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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)).c_str(),
|
||||
s.c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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.c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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.c_str(), s2.c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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_)).c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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)).c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind2)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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)).c_str(),
|
||||
s.c_str());
|
||||
}
|
||||
}
|
||||
|
||||
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.c_str(),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)).c_str());
|
||||
}
|
||||
}
|
||||
|
||||
} // namespace Fortran::semantics
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
|
||||
#ifndef FORTRAN_SEMANTICS_IO_H_
|
||||
#define FORTRAN_SEMANTICS_IO_H_
|
||||
|
||||
#include "semantics.h"
|
||||
#include "tools.h"
|
||||
#include "../common/enum-set.h"
|
||||
#include "../parser/parse-tree.h"
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
using common::IoSpecKind;
|
||||
using common::IoStmtKind;
|
||||
|
||||
class IoChecker : public virtual BaseChecker {
|
||||
public:
|
||||
explicit IoChecker(SemanticsContext &context) : context_{context} {}
|
||||
|
||||
void Enter(const parser::BackspaceStmt &) { Init(IoStmtKind::Backspace); }
|
||||
void Enter(const parser::CloseStmt &) { Init(IoStmtKind::Close); }
|
||||
void Enter(const parser::EndfileStmt &) { Init(IoStmtKind::Endfile); }
|
||||
void Enter(const parser::FlushStmt &) { Init(IoStmtKind::Flush); }
|
||||
void Enter(const parser::InquireStmt &) { Init(IoStmtKind::Inquire); }
|
||||
void Enter(const parser::OpenStmt &) { Init(IoStmtKind::Open); }
|
||||
void Enter(const parser::ReadStmt &) { Init(IoStmtKind::Read); }
|
||||
void Enter(const parser::RewindStmt &) { Init(IoStmtKind::Rewind); }
|
||||
void Enter(const parser::WaitStmt &) { Init(IoStmtKind::Wait); }
|
||||
void Enter(const parser::WriteStmt &) { Init(IoStmtKind::Write); }
|
||||
|
||||
void Enter(const parser::ConnectSpec &);
|
||||
void Enter(const parser::ConnectSpec::CharExpr &);
|
||||
void Enter(const parser::ConnectSpec::Newunit &);
|
||||
void Enter(const parser::ConnectSpec::Recl &);
|
||||
void Enter(const parser::EndLabel &);
|
||||
void Enter(const parser::EorLabel &);
|
||||
void Enter(const parser::ErrLabel &);
|
||||
void Enter(const parser::FileUnitNumber &);
|
||||
void Enter(const parser::Format &);
|
||||
void Enter(const parser::IdExpr &);
|
||||
void Enter(const parser::IdVariable &);
|
||||
void Enter(const parser::InputItem &);
|
||||
void Enter(const parser::InquireSpec &);
|
||||
void Enter(const parser::InquireSpec::CharVar &);
|
||||
void Enter(const parser::InquireSpec::IntVar &);
|
||||
void Enter(const parser::InquireSpec::LogVar &);
|
||||
void Enter(const parser::IoControlSpec &);
|
||||
void Enter(const parser::IoControlSpec::Asynchronous &);
|
||||
void Enter(const parser::IoControlSpec::CharExpr &);
|
||||
void Enter(const parser::IoControlSpec::Pos &);
|
||||
void Enter(const parser::IoControlSpec::Rec &);
|
||||
void Enter(const parser::IoControlSpec::Size &);
|
||||
void Enter(const parser::IoUnit &);
|
||||
void Enter(const parser::MsgVariable &);
|
||||
void Enter(const parser::OutputItem &);
|
||||
void Enter(const parser::StatusExpr &);
|
||||
void Enter(const parser::StatVariable &);
|
||||
|
||||
void Leave(const parser::BackspaceStmt &);
|
||||
void Leave(const parser::CloseStmt &);
|
||||
void Leave(const parser::EndfileStmt &);
|
||||
void Leave(const parser::FlushStmt &);
|
||||
void Leave(const parser::InquireStmt &);
|
||||
void Leave(const parser::OpenStmt &);
|
||||
void Leave(const parser::ReadStmt &);
|
||||
void Leave(const parser::RewindStmt &);
|
||||
void Leave(const parser::WaitStmt &);
|
||||
void Leave(const parser::WriteStmt &);
|
||||
|
||||
private:
|
||||
// Presence flag values.
|
||||
ENUM_CLASS(Flag, IoControlList, InternalUnit, NumberUnit, StarUnit, CharFmt,
|
||||
LabelFmt, StarFmt, FmtOrNml, KnownAccess, AccessDirect, AccessStream,
|
||||
AdvanceYes, AsynchronousYes, KnownStatus, StatusNew, StatusReplace,
|
||||
StatusScratch, DataList);
|
||||
|
||||
template<typename R, typename T> std::optional<R> GetConstExpr(const T &x) {
|
||||
using DefaultCharConstantType =
|
||||
evaluate::Constant<evaluate::Type<common::TypeCategory::Character, 1>>;
|
||||
if (const SomeExpr * expr{GetExpr(x)}) {
|
||||
const auto foldExpr{
|
||||
evaluate::Fold(context_.foldingContext(), common::Clone(*expr))};
|
||||
if constexpr (std::is_same_v<R, std::string>) {
|
||||
if (const auto *charConst{
|
||||
evaluate::UnwrapExpr<DefaultCharConstantType>(foldExpr)}) {
|
||||
return {**charConst};
|
||||
}
|
||||
} else {
|
||||
static_assert(std::is_same_v<R, std::int64_t>, "unexpected type");
|
||||
return evaluate::ToInt64(foldExpr);
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
void LeaveReadWrite() const;
|
||||
|
||||
void SetSpecifier(IoSpecKind);
|
||||
|
||||
void CheckStringValue(
|
||||
IoSpecKind, const std::string &, const parser::CharBlock &) const;
|
||||
|
||||
void CheckForRequiredSpecifier(IoSpecKind) const;
|
||||
void CheckForRequiredSpecifier(bool, const std::string &) const;
|
||||
void CheckForRequiredSpecifier(IoSpecKind, IoSpecKind) const;
|
||||
void CheckForRequiredSpecifier(IoSpecKind, bool, const std::string &) const;
|
||||
void CheckForRequiredSpecifier(bool, const std::string &, IoSpecKind) const;
|
||||
void CheckForRequiredSpecifier(
|
||||
bool, const std::string &, bool, const std::string &) const;
|
||||
|
||||
void CheckForProhibitedSpecifier(IoSpecKind) const;
|
||||
void CheckForProhibitedSpecifier(IoSpecKind, IoSpecKind) const;
|
||||
void CheckForProhibitedSpecifier(IoSpecKind, bool, const std::string &) const;
|
||||
void CheckForProhibitedSpecifier(bool, const std::string &, IoSpecKind) const;
|
||||
|
||||
void Init(IoStmtKind s) {
|
||||
stmt_ = s;
|
||||
specifierSet_.reset();
|
||||
flags_.reset();
|
||||
}
|
||||
|
||||
SemanticsContext &context_;
|
||||
IoStmtKind stmt_ = IoStmtKind::None;
|
||||
common::EnumSet<IoSpecKind, common::IoSpecKind_enumSize> specifierSet_;
|
||||
common::EnumSet<Flag, Flag_enumSize> flags_;
|
||||
};
|
||||
|
||||
}
|
||||
#endif // FORTRAN_SEMANTICS_IO_H_
|
||||
|
|
@ -21,6 +21,7 @@
|
|||
#include "check-deallocate.h"
|
||||
#include "check-do-concurrent.h"
|
||||
#include "check-if-stmt.h"
|
||||
#include "check-io.h"
|
||||
#include "check-nullify.h"
|
||||
#include "check-return.h"
|
||||
#include "check-stop.h"
|
||||
|
|
@ -82,8 +83,8 @@ private:
|
|||
using StatementSemanticsPass1 = ExprChecker;
|
||||
using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
|
||||
ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
|
||||
DeallocateChecker, DoConcurrentChecker, IfStmtChecker, NullifyChecker,
|
||||
ReturnStmtChecker, StopChecker>;
|
||||
DeallocateChecker, DoConcurrentChecker, IfStmtChecker, IoChecker,
|
||||
NullifyChecker, ReturnStmtChecker, StopChecker>;
|
||||
|
||||
static bool PerformStatementSemantics(
|
||||
SemanticsContext &context, parser::Program &program) {
|
||||
|
|
|
|||
|
|
@ -26,6 +26,12 @@ set(ERROR_TESTS
|
|||
implicit07.f90
|
||||
implicit08.f90
|
||||
int-literals.f90
|
||||
io01.f90
|
||||
io02.f90
|
||||
io03.f90
|
||||
io04.f90
|
||||
io05.f90
|
||||
io06.f90
|
||||
kinds02.f90
|
||||
resolve01.f90
|
||||
resolve02.f90
|
||||
|
|
|
|||
|
|
@ -0,0 +1,139 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
character(len=20) :: access = "direcT"
|
||||
character(len=20) :: access_(2) = (/"direcT", "streaM"/)
|
||||
character(len=20) :: action_(2) = (/"reaD ", "writE"/)
|
||||
character(len=20) :: asynchronous_(2) = (/"nO ", "yeS"/)
|
||||
character(len=20) :: blank_(2) = (/"nulL", "zerO"/)
|
||||
character(len=20) :: decimal_(2) = (/'commA', 'poinT'/)
|
||||
character(len=20) :: delim_(2) = (/"nonE ", "quotE"/)
|
||||
character(len=20) :: encoding_(2) = (/"defaulT", "utF-8 "/)
|
||||
character(len=20) :: form_(2) = (/"formatteD ", "unformatteD"/)
|
||||
character(len=20) :: pad_(2) = (/"nO ", "yeS"/)
|
||||
character(len=20) :: position_(3) = (/"appenD", "asiS ", "rewinD"/)
|
||||
character(len=20) :: round_(2) = (/"dowN", "zerO"/)
|
||||
character(len=20) :: sign_(2) = (/"pluS ", "suppresS"/)
|
||||
character(len=20) :: status_(2) = (/"neW", "olD"/)
|
||||
character(len=20) :: convert_(2) = (/"big_endiaN", "nativE "/)
|
||||
character(len=20) :: dispose_(2) = (/ "deletE", "keeP "/)
|
||||
character(len=66) :: cc, msg
|
||||
|
||||
integer :: new_unit
|
||||
integer :: unit10 = 10
|
||||
integer :: unit11 = 11
|
||||
integer :: n = 40
|
||||
|
||||
integer(kind=1) :: stat1
|
||||
integer(kind=2) :: stat2
|
||||
integer(kind=4) :: stat4
|
||||
integer(kind=8) :: stat8
|
||||
|
||||
cc = 'scratch'
|
||||
|
||||
open(unit10)
|
||||
open(blank='null', unit=unit10, pad='no')
|
||||
open(unit=unit11, err=3)
|
||||
3 continue
|
||||
|
||||
open(20, access='sequential')
|
||||
open(21, access=access, recl=n)
|
||||
open(22, access=access_(2), iostat=stat1, iomsg=msg)
|
||||
|
||||
open(30, action='readwrite', asynchronous='n'//'o', blank='zero')
|
||||
open(31, action=action_(2), asynchronous=asynchronous_(2), blank=blank_(2))
|
||||
|
||||
open(unit=40, decimal="comma", delim="apostrophe", encoding="utf-8")
|
||||
open(unit=41, decimal=decimal_(2), delim=delim_(2), encoding=encoding_(2))
|
||||
|
||||
open(50, file='abc', status='unknown', form='formatted')
|
||||
open(51, file=access, status=status_(2), form=form_(2))
|
||||
|
||||
open(newunit=new_unit, pad=pad_(2), status='scr'//'atch'//'')
|
||||
open(newunit=new_unit, pad=pad_(2), status=cc)
|
||||
|
||||
open(unit=60, position='rewind', recl=(30+20/2), round='zero')
|
||||
open(position=position_(1), recl=n, round=round_(2), unit=61)
|
||||
|
||||
open(unit=70, sign='suppress', &
|
||||
status='unknown', iostat=stat2)
|
||||
open(unit=70, sign=sign_(2), status=status_(2))
|
||||
|
||||
open(80, convert='big_endian', dispose='delete')
|
||||
open(81, convert=convert_(2), dispose=dispose_(2))
|
||||
|
||||
open(access='STREAM', 90) ! nonstandard
|
||||
|
||||
!ERROR: OPEN statement must have a UNIT or NEWUNIT specifier
|
||||
!ERROR: if ACCESS='DIRECT' appears, RECL must also appear
|
||||
open(access='direct')
|
||||
|
||||
!ERROR: if STATUS='STREAM' appears, RECL must not appear
|
||||
open(10, access='st'//'ream', recl=13)
|
||||
|
||||
!ERROR: duplicate NEWUNIT specifier
|
||||
!ERROR: if NEWUNIT appears, FILE or STATUS must also appear
|
||||
open(newunit=n, newunit=nn, iostat=stat4)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
open(unit=100, unit=100)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
open(101, delim=delim_(1), unit=102)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
open(unit=103, &
|
||||
unit=104, iostat=stat8)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: if ACCESS='DIRECT' appears, RECL must also appear
|
||||
open(access='dir'//'ect', 9, 9) ! nonstandard
|
||||
|
||||
!ERROR: duplicate ROUND specifier
|
||||
open(105, round=round_(1), pad='no', round='nearest')
|
||||
|
||||
!ERROR: if NEWUNIT appears, UNIT must not appear
|
||||
!ERROR: if NEWUNIT appears, FILE or STATUS must also appear
|
||||
open(106, newunit=n)
|
||||
|
||||
!ERROR: RECL value (-30) must be positive
|
||||
open(107, recl=40-70)
|
||||
|
||||
!ERROR: RECL value (-36) must be positive
|
||||
open(108, recl=- - (-36)) ! nonstandard
|
||||
|
||||
!ERROR: invalid ACTION value 'reedwrite'
|
||||
open(109, access=Access, action='reedwrite', recl=77)
|
||||
|
||||
!ERROR: invalid ACTION value 'nonsense'
|
||||
open(110, action=''//'non'//'sense', recl=77)
|
||||
|
||||
!ERROR: invalid STATUS value 'cold'
|
||||
open(111, status='cold')
|
||||
|
||||
!ERROR: invalid STATUS value 'Keep'
|
||||
open(112, status='Keep')
|
||||
|
||||
!ERROR: if STATUS='NEW' appears, FILE must also appear
|
||||
open(113, status='new')
|
||||
|
||||
!ERROR: if STATUS='REPLACE' appears, FILE must also appear
|
||||
open(114, status='replace')
|
||||
|
||||
!ERROR: if STATUS='SCRATCH' appears, FILE must not appear
|
||||
open(115, file='abc', status='scratch')
|
||||
|
||||
!ERROR: if NEWUNIT appears, FILE or STATUS='SCRATCH' must also appear
|
||||
open(newunit=nn, status='old')
|
||||
end
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
integer :: unit10 = 10
|
||||
integer :: unit11 = 11
|
||||
|
||||
integer(kind=1) :: stat1
|
||||
integer(kind=8) :: stat8
|
||||
|
||||
character(len=55) :: msg
|
||||
|
||||
close(unit10)
|
||||
close(unit=unit11, err=9, iomsg=msg, iostat=stat1)
|
||||
close(12, status='Keep')
|
||||
|
||||
close(iostat=stat8, 11) ! nonstandard
|
||||
|
||||
!ERROR: CLOSE statement must have a UNIT number specifier
|
||||
close(iostat=stat1)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
close(13, unit=14, err=9)
|
||||
|
||||
!ERROR: duplicate ERR specifier
|
||||
close(err=9, unit=15, err=9, iostat=stat8)
|
||||
|
||||
!ERROR: invalid STATUS value 'kept'
|
||||
close(status='kept', unit=16)
|
||||
|
||||
!ERROR: invalid STATUS value 'old'
|
||||
close(status='old', unit=17)
|
||||
|
||||
9 continue
|
||||
end
|
||||
|
|
@ -0,0 +1,150 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
character(kind=1,len=50) internal_file
|
||||
character(kind=2,len=50) internal_file2
|
||||
character(kind=4,len=50) internal_file4
|
||||
character(kind=1,len=111) msg
|
||||
character(20) advance
|
||||
integer*1 stat1
|
||||
integer*2 stat2, id2
|
||||
integer*8 stat8
|
||||
integer :: iunit = 10
|
||||
integer, parameter :: junit = 11
|
||||
|
||||
namelist /mmm/ mm1, mm2
|
||||
namelist /nnn/ nn1, nn2
|
||||
|
||||
advance='no'
|
||||
|
||||
open(10)
|
||||
|
||||
read*
|
||||
read(*)
|
||||
read*, jj
|
||||
read(*, *) jj
|
||||
read(unit=*, *) jj
|
||||
read(*, fmt=*) jj
|
||||
read(*, '(I4)') jj
|
||||
read(*, fmt='(I4)') jj
|
||||
read(fmt='(I4)', unit=*) jj
|
||||
read(iunit, *) jj
|
||||
read(junit, *) jj
|
||||
read(10, *) jj
|
||||
read(internal_file, *) jj
|
||||
read(10, nnn)
|
||||
read(internal_file, nnn)
|
||||
read(internal_file, nml=nnn)
|
||||
read(fmt=*, unit=internal_file)
|
||||
read(nml=nnn, unit=internal_file)
|
||||
read(iunit, nnn)
|
||||
read(10, nml=nnn)
|
||||
read(10, asynchronous='no') jj
|
||||
read(10, asynchronous='yes') jj
|
||||
read(10, eor=9, advance='no', fmt='(I4)') jj
|
||||
read(10, eor=9, advance='no', fmt='(I4)') jj
|
||||
read(10, asynchronous='yes', id=id) jj
|
||||
read(10, '(I4)', advance='no', asynchronous='yes', blank='null', &
|
||||
decimal='comma', end=9, eor=9, err=9, id=id, iomsg=msg, iostat=stat2, &
|
||||
pad='no', round='processor_defined', size=kk) jj
|
||||
|
||||
!ERROR: invalid character kind for an internal file variable
|
||||
read(internal_file2, *) jj
|
||||
|
||||
!ERROR: invalid character kind for an internal file variable
|
||||
read(internal_file4, *) jj
|
||||
|
||||
!ERROR: duplicate IOSTAT specifier
|
||||
read(11, pos=ipos, iostat=stat1, iostat=stat2)
|
||||
|
||||
!ERROR: duplicate END specifier
|
||||
read(11, end=9, pos=ipos, end=9)
|
||||
|
||||
!ERROR: duplicate NML specifier
|
||||
read(10, nml=mmm, nml=nnn)
|
||||
|
||||
!ERROR: READ statement must have a UNIT specifier
|
||||
read(err=9, iostat=stat8) jj
|
||||
|
||||
!ERROR: READ statement must not have a DELIM specifier
|
||||
!ERROR: READ statement must not have a SIGN specifier
|
||||
read(10, delim='quote', sign='plus') jj
|
||||
|
||||
!ERROR: if NML appears, REC must not appear
|
||||
read(10, nnn, rec=nn)
|
||||
|
||||
!ERROR: if NML appears, FMT must not appear
|
||||
!ERROR: if NML appears, a data list must not appear
|
||||
read(10, fmt=*, nml=nnn) jj
|
||||
|
||||
!ERROR: if UNIT=* appears, REC must not appear
|
||||
read(*, rec=13)
|
||||
|
||||
!ERROR: if UNIT=* appears, POS must not appear
|
||||
read(*, pos=13)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, REC must not appear
|
||||
read(internal_file, rec=13)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, POS must not appear
|
||||
read(internal_file, pos=13)
|
||||
|
||||
!ERROR: if REC appears, END must not appear
|
||||
read(10, fmt='(I4)', end=9, rec=13) jj
|
||||
|
||||
!ERROR: if REC appears, FMT=* must not appear
|
||||
read(10, *, rec=13) jj
|
||||
|
||||
!ERROR: if ADVANCE appears, UNIT=internal-file must not appear
|
||||
read(internal_file, '(I4)', eor=9, advance='no') jj
|
||||
|
||||
!ERROR: if ADVANCE appears, an explicit format must also appear
|
||||
!ERROR: if EOR appears, ADVANCE with value 'NO' must also appear
|
||||
read(10, eor=9, advance='yes')
|
||||
|
||||
!ERROR: if EOR appears, ADVANCE with value 'NO' must also appear
|
||||
read(10, eor=9)
|
||||
|
||||
!ERROR: invalid ASYNCHRONOUS value 'nay'
|
||||
read(10, asynchronous='nay') ! prog req
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
read(*, asynchronous='yes')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
read(internal_file, asynchronous='y'//'es')
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
read(10, id=id)
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
read(10, asynchronous='n'//'o', id=id)
|
||||
|
||||
!ERROR: if POS appears, REC must not appear
|
||||
read(10, pos=13, rec=13) jj
|
||||
|
||||
!ERROR: if DECIMAL appears, FMT or NML must also appear
|
||||
!ERROR: if BLANK appears, FMT or NML must also appear
|
||||
!ERROR: invalid DECIMAL value 'Punkt'
|
||||
read(10, decimal='Punkt', blank='null') jj
|
||||
|
||||
!ERROR: if ROUND appears, FMT or NML must also appear
|
||||
!ERROR: if PAD appears, FMT or NML must also appear
|
||||
read(10, pad='no', round='nearest') jj
|
||||
|
||||
!ERROR: ID kind (2) is smaller than default INTEGER kind (4)
|
||||
read(10, id=id2, asynchronous='yes') jj
|
||||
|
||||
9 continue
|
||||
end
|
||||
|
|
@ -0,0 +1,132 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
character(kind=1,len=50) internal_file
|
||||
character(kind=1,len=100) msg
|
||||
character(20) sign
|
||||
integer*1 stat1, id1
|
||||
integer*2 stat2
|
||||
integer*4 stat4
|
||||
integer*8 stat8
|
||||
integer :: iunit = 10
|
||||
integer, parameter :: junit = 11
|
||||
|
||||
namelist /nnn/ nn1, nn2
|
||||
|
||||
sign = 'suppress'
|
||||
|
||||
open(10)
|
||||
|
||||
write(*)
|
||||
write(*, *)
|
||||
write(*)
|
||||
write(*, *)
|
||||
write(unit=*) 'Ok'
|
||||
write(unit=iunit)
|
||||
write(unit=junit)
|
||||
write(unit=iunit, *)
|
||||
write(unit=junit, *)
|
||||
write(10)
|
||||
write(unit=10) 'Ok'
|
||||
write(*, nnn)
|
||||
write(10, nnn)
|
||||
write(internal_file)
|
||||
write(internal_file, *)
|
||||
write(internal_file, fmt=*)
|
||||
write(internal_file, fmt=1) 'Ok'
|
||||
write(internal_file, nnn)
|
||||
write(internal_file, nml=nnn)
|
||||
write(unit=internal_file, *)
|
||||
write(fmt=*, unit=internal_file)
|
||||
write(10, advance='yes', fmt=1) 'Ok'
|
||||
write(10, *, delim='quote', sign='plus') jj
|
||||
write(10, '(A)', advance='no', asynchronous='yes', decimal='comma', &
|
||||
err=9, id=id, iomsg=msg, iostat=stat2, round='processor_defined', &
|
||||
sign=sign) 'Ok'
|
||||
|
||||
print*
|
||||
print*, 'Ok'
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
write(internal_file, unit=*)
|
||||
|
||||
!ERROR: WRITE statement must have a UNIT specifier
|
||||
write(nml=nnn)
|
||||
|
||||
!ERROR: WRITE statement must not have a BLANK specifier
|
||||
!ERROR: WRITE statement must not have a END specifier
|
||||
!ERROR: WRITE statement must not have a EOR specifier
|
||||
!ERROR: WRITE statement must not have a PAD specifier
|
||||
write(*, eor=9, blank='zero', end=9, pad='no')
|
||||
|
||||
!ERROR: if NML appears, REC must not appear
|
||||
!ERROR: if NML appears, FMT must not appear
|
||||
!ERROR: if NML appears, a data list must not appear
|
||||
write(10, nnn, rec=40, fmt=1) 'Ok'
|
||||
|
||||
!ERROR: if UNIT=* appears, POS must not appear
|
||||
write(*, pos=n, nml=nnn)
|
||||
|
||||
!ERROR: if UNIT=* appears, REC must not appear
|
||||
write(*, rec=n)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, POS must not appear
|
||||
write(internal_file, err=9, pos=n, nml=nnn)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, REC must not appear
|
||||
write(internal_file, rec=n, err=9)
|
||||
|
||||
!ERROR: if UNIT=* appears, REC must not appear
|
||||
write(*, rec=13) 'Ok'
|
||||
|
||||
!ERROR: if ADVANCE appears, UNIT=internal-file must not appear
|
||||
write(internal_file, advance='yes', fmt=1) 'Ok'
|
||||
|
||||
!ERROR: if ADVANCE appears, an explicit format must also appear
|
||||
write(10, advance='yes') 'Ok'
|
||||
|
||||
!ERROR: invalid ASYNCHRONOUS value 'non'
|
||||
write(*, asynchronous='non')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
write(*, asynchronous='yes')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
write(internal_file, asynchronous='yes')
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
write(10, *, id=id) "Ok"
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
write(10, *, id=id, asynchronous='no') "Ok"
|
||||
|
||||
!ERROR: if POS appears, REC must not appear
|
||||
write(10, pos=13, rec=13) 'Ok'
|
||||
|
||||
!ERROR: if DECIMAL appears, FMT or NML must also appear
|
||||
!ERROR: if ROUND appears, FMT or NML must also appear
|
||||
!ERROR: if SIGN appears, FMT or NML must also appear
|
||||
!ERROR: invalid DECIMAL value 'Komma'
|
||||
write(10, decimal='Komma', sign='plus', round='down') jj
|
||||
|
||||
!ERROR: if DELIM appears, FMT=* or NML must also appear
|
||||
!ERROR: invalid DELIM value 'Nix'
|
||||
write(delim='Nix', fmt='(A)', unit=10) 'Ok' !C1228
|
||||
|
||||
!ERROR: ID kind (1) is smaller than default INTEGER kind (4)
|
||||
write(id=id1, unit=10, asynchronous='Yes') 'Ok'
|
||||
|
||||
1 format (A)
|
||||
9 continue
|
||||
end
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
character*20 c(25), cv
|
||||
character(kind=1,len=59) msg
|
||||
logical*2 v(5), lv
|
||||
integer*1 stat1
|
||||
integer*2 stat4
|
||||
integer*8 stat8, iv
|
||||
|
||||
inquire(10)
|
||||
inquire(file='abc')
|
||||
inquire(10, pos=ipos, iomsg=msg, iostat=stat1)
|
||||
inquire(file='abc', &
|
||||
access=c(1), action=c(2), asynchronous=c(3), blank=c(4), decimal=c(5), &
|
||||
delim=c(6), direct=c(7), encoding=c(8), form=c(9), formatted=c(10), &
|
||||
name=c(11), pad=c(12), position=c(13), read=c(14), readwrite=c(15), &
|
||||
round=c(16), sequential=c(17), sign=c(18), stream=c(19), &
|
||||
unformatted=c(20), write=c(21), &
|
||||
err=9, &
|
||||
nextrec=nextrec, number=number, pos=jpos, recl=jrecl, size=jsize, &
|
||||
iomsg=msg, &
|
||||
iostat=stat4, &
|
||||
exist=v(1), named=v(2), opened=v(3), pending=v(4))
|
||||
inquire(pending=v(5), file='abc')
|
||||
inquire(10, id=id, pending=v(5))
|
||||
|
||||
! using variable 'cv' multiple times seems to be allowed
|
||||
inquire(file='abc', &
|
||||
access=cv, action=cv, asynchronous=cv, blank=cv, decimal=cv, &
|
||||
delim=cv, direct=cv, encoding=cv, form=cv, formatted=cv, &
|
||||
name=cv, pad=cv, position=cv, read=cv, readwrite=cv, &
|
||||
round=cv, sequential=cv, sign=cv, stream=cv, &
|
||||
unformatted=cv, write=cv, &
|
||||
nextrec=iv, number=iv, pos=iv, recl=iv, size=iv, &
|
||||
exist=lv, named=lv, opened=lv, pending=lv)
|
||||
|
||||
!ERROR: INQUIRE statement must have a UNIT number or FILE specifier
|
||||
inquire(err=9)
|
||||
|
||||
!ERROR: if FILE appears, UNIT must not appear
|
||||
inquire(10, file='abc', blank=c(22), iostat=stat8)
|
||||
|
||||
!ERROR: duplicate FILE specifier
|
||||
inquire(file='abc', file='xyz')
|
||||
|
||||
!ERROR: duplicate FORM specifier
|
||||
inquire(form=c(1), iostat=stat1, form=c(2), file='abc')
|
||||
|
||||
!ERROR: duplicate SIGN specifier
|
||||
!ERROR: duplicate READ specifier
|
||||
!ERROR: duplicate WRITE specifier
|
||||
inquire(1, read=c(1), write=c(2), sign=c(3), sign=c(4), read=c(5), write=c(1))
|
||||
|
||||
!ERROR: duplicate IOMSG specifier
|
||||
inquire(10, iomsg=msg, pos=ipos, iomsg=msg)
|
||||
|
||||
!ERROR: if ID appears, PENDING must also appear
|
||||
inquire(file='abc', id=id)
|
||||
|
||||
9 continue
|
||||
end
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
|
||||
!
|
||||
! Licensed under the Apache License, Version 2.0 (the "License");
|
||||
! you may not use this file except in compliance with the License.
|
||||
! You may obtain a copy of the License at
|
||||
!
|
||||
! http://www.apache.org/licenses/LICENSE-2.0
|
||||
!
|
||||
! Unless required by applicable law or agreed to in writing, software
|
||||
! distributed under the License is distributed on an "AS IS" BASIS,
|
||||
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
! See the License for the specific language governing permissions and
|
||||
! limitations under the License.
|
||||
|
||||
character(kind=1,len=100) msg1
|
||||
character(kind=2,len=200) msg2
|
||||
integer(1) stat1
|
||||
integer(2) stat2
|
||||
integer(8) stat8
|
||||
|
||||
open(10)
|
||||
|
||||
backspace(10)
|
||||
backspace(10, iomsg=msg1, iostat=stat1, err=9)
|
||||
|
||||
endfile(unit=10)
|
||||
endfile(iostat=stat2, err=9, unit=10, iomsg=msg1)
|
||||
|
||||
rewind(10)
|
||||
rewind(iomsg=msg1, iostat=stat2, err=9, unit=10)
|
||||
|
||||
flush(10)
|
||||
flush(iomsg=msg1, unit=10, iostat=stat8, err=9)
|
||||
|
||||
wait(10)
|
||||
wait(99, id=id1, end=9, eor=9, err=9, iostat=stat1, iomsg=msg1)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
backspace(10, unit=11)
|
||||
|
||||
!ERROR: duplicate IOSTAT specifier
|
||||
endfile(iostat=stat2, err=9, unit=10, iostat=stat8, iomsg=msg1)
|
||||
|
||||
!ERROR: REWIND statement must have a UNIT number specifier
|
||||
rewind(iostat=stat2)
|
||||
|
||||
!ERROR: duplicate ERR specifier
|
||||
!ERROR: duplicate ERR specifier
|
||||
flush(err=9, unit=10, &
|
||||
err=9, &
|
||||
err=9)
|
||||
|
||||
!ERROR: duplicate ID specifier
|
||||
!ERROR: WAIT statement must have a UNIT number specifier
|
||||
wait(id=id2, eor=9, id=id3)
|
||||
|
||||
9 continue
|
||||
end
|
||||
Loading…
Reference in New Issue