[flang] Clause 12 semantics -- Check all constraints not otherwise checked (flang...
authorvdonaldson <37090318+vdonaldson@users.noreply.github.com>
Tue, 30 Apr 2019 18:28:16 +0000 (11:28 -0700)
committerGitHub <noreply@github.com>
Tue, 30 Apr 2019 18:28:16 +0000 (11:28 -0700)
* 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@e4ec3436184935c0c09f0b61c01f3cb86d84d0b3
Reviewed-on: https://github.com/flang-compiler/f18/pull/427

13 files changed:
flang/.gitignore
flang/lib/common/Fortran.h
flang/lib/semantics/CMakeLists.txt
flang/lib/semantics/check-io.cc [new file with mode: 0644]
flang/lib/semantics/check-io.h [new file with mode: 0644]
flang/lib/semantics/semantics.cc
flang/test/semantics/CMakeLists.txt
flang/test/semantics/io01.f90 [new file with mode: 0644]
flang/test/semantics/io02.f90 [new file with mode: 0644]
flang/test/semantics/io03.f90 [new file with mode: 0644]
flang/test/semantics/io04.f90 [new file with mode: 0644]
flang/test/semantics/io05.f90 [new file with mode: 0644]
flang/test/semantics/io06.f90 [new file with mode: 0644]

index bf387e8..ac00a9d 100644 (file)
@@ -6,6 +6,7 @@ tags
 TAGS
 *.o
 .nfs*
+*.swp
 *~
 *#
 CMakeCache.txt
index 2482ed7..a77de78 100644 (file)
@@ -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_
index 121adaa..b59cec7 100644 (file)
@@ -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
diff --git a/flang/lib/semantics/check-io.cc b/flang/lib/semantics/check-io.cc
new file mode 100644 (file)
index 0000000..b68427c
--- /dev/null
@@ -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
diff --git a/flang/lib/semantics/check-io.h b/flang/lib/semantics/check-io.h
new file mode 100644 (file)
index 0000000..ac5a694
--- /dev/null
@@ -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_
index c388d5d..933e814 100644 (file)
@@ -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) {
index 26fb95a..185ec4d 100644 (file)
@@ -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
diff --git a/flang/test/semantics/io01.f90 b/flang/test/semantics/io01.f90
new file mode 100644 (file)
index 0000000..99c4682
--- /dev/null
@@ -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
diff --git a/flang/test/semantics/io02.f90 b/flang/test/semantics/io02.f90
new file mode 100644 (file)
index 0000000..cd09199
--- /dev/null
@@ -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
diff --git a/flang/test/semantics/io03.f90 b/flang/test/semantics/io03.f90
new file mode 100644 (file)
index 0000000..306bfe9
--- /dev/null
@@ -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
diff --git a/flang/test/semantics/io04.f90 b/flang/test/semantics/io04.f90
new file mode 100644 (file)
index 0000000..8912dc8
--- /dev/null
@@ -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
diff --git a/flang/test/semantics/io05.f90 b/flang/test/semantics/io05.f90
new file mode 100644 (file)
index 0000000..5ff6c74
--- /dev/null
@@ -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
diff --git a/flang/test/semantics/io06.f90 b/flang/test/semantics/io06.f90
new file mode 100644 (file)
index 0000000..e99049d
--- /dev/null
@@ -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