[flang] Clause 13 (Input/output editing) syntax and semantic checking (flang-compiler/f18#498)
* Clause 13 (Input/output editing) syntax and semantic checking
Diagnose:
- all clause syntax errors (independent of normal parsing)
- all clause constraints
- use of non-standard extensions under -Mstandard
- obvious program requirement violations
The code:
- is invoked for both format statement and I/O statement constant formats
- should be useable by the runtime I/O library for runtime formats
- is able to recover from errors
- is able to diagnose multiple errors in a single format
- has accurate markers for errors
- can process (fixed character size) Hollerith strings
- generates reasonable error messages for known error scenarios
- should not require C++ run-time library support
The code is templatized for use with fixed size character kind={1,2,4} input,
but only the kind=1 variant is actually exercised.
* Review update.
* Review update.
* Review update.
* Improve error processing of unterminated formats.
Original-commit: flang-compiler/f18@c04b7518df
Reviewed-on: https://github.com/flang-compiler/f18/pull/498
This commit is contained in:
vdonaldson
GitHub
parent
a0b0bb43ed
commit
69f5f13738
|
|
@ -6,7 +6,7 @@ tags
|
|||
TAGS
|
||||
*.o
|
||||
.nfs*
|
||||
*.swp
|
||||
*.sw?
|
||||
*~
|
||||
*#
|
||||
CMakeCache.txt
|
||||
|
|
|
|||
|
|
@ -0,0 +1,785 @@
|
|||
// 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_COMMON_FORMAT_H_
|
||||
#define FORTRAN_COMMON_FORMAT_H_
|
||||
|
||||
#include "Fortran.h"
|
||||
#include <cstring>
|
||||
|
||||
// Define a FormatValidator class template to validate a format expression
|
||||
// of a given CHAR kind. To enable use in runtime library code as well as
|
||||
// compiler code, the implementation does its own parsing without recourse
|
||||
// to compiler parser machinery, and avoids features that require C++ runtime
|
||||
// library support. A format expression is a pointer to a fixed size
|
||||
// character string, with an explicit length. Class function Check analyzes
|
||||
// the expression for syntax and semantic errors and warnings. When an error
|
||||
// or warning is found, a caller-supplied reporter function is called, which
|
||||
// may request early termination of validation analysis when some threshold
|
||||
// number of errors have been reported. If the context is a READ, WRITE,
|
||||
// or PRINT statement, rather than a FORMAT statement, statement-specific
|
||||
// checks are also done.
|
||||
|
||||
namespace Fortran::common {
|
||||
|
||||
struct FormatMessage {
|
||||
const char *text; // message text; may have one %s argument
|
||||
const char *arg; // optional %s argument value
|
||||
int offset; // offset to message marker
|
||||
int length; // length of message marker
|
||||
bool isError; // vs. warning
|
||||
};
|
||||
|
||||
template<typename CHAR = char> class FormatValidator {
|
||||
public:
|
||||
using Reporter = std::function<bool(const FormatMessage &)>;
|
||||
FormatValidator(const CHAR *format, size_t length, Reporter reporter,
|
||||
IoStmtKind stmt = IoStmtKind::None)
|
||||
: format_{format}, end_{format + length}, reporter_{reporter}, stmt_{stmt},
|
||||
cursor_{format - 1} {
|
||||
CHECK(format);
|
||||
}
|
||||
|
||||
bool Check();
|
||||
|
||||
private:
|
||||
enum class TokenKind {
|
||||
None,
|
||||
A,
|
||||
B,
|
||||
BN,
|
||||
BZ,
|
||||
D,
|
||||
DC,
|
||||
DP,
|
||||
DT,
|
||||
E,
|
||||
EN,
|
||||
ES,
|
||||
EX,
|
||||
F,
|
||||
G,
|
||||
I,
|
||||
L,
|
||||
O,
|
||||
P,
|
||||
RC,
|
||||
RD,
|
||||
RN,
|
||||
RP,
|
||||
RU,
|
||||
RZ,
|
||||
S,
|
||||
SP,
|
||||
SS,
|
||||
T,
|
||||
TL,
|
||||
TR,
|
||||
X,
|
||||
Z,
|
||||
Colon,
|
||||
Slash,
|
||||
Backslash, // nonstandard: inhibit newline on output
|
||||
Dollar, // nonstandard: inhibit newline on output on terminals
|
||||
Star,
|
||||
LParen,
|
||||
RParen,
|
||||
Comma,
|
||||
Point,
|
||||
Sign,
|
||||
UnsignedInteger, // value in integerValue_
|
||||
String, // char-literal-constant or Hollerith constant
|
||||
};
|
||||
|
||||
struct Token {
|
||||
Token &set_kind(TokenKind kind) {
|
||||
kind_ = kind;
|
||||
return *this;
|
||||
}
|
||||
Token &set_offset(int offset) {
|
||||
offset_ = offset;
|
||||
return *this;
|
||||
}
|
||||
Token &set_length(int length) {
|
||||
length_ = length;
|
||||
return *this;
|
||||
}
|
||||
|
||||
TokenKind kind() const { return kind_; }
|
||||
int offset() const { return offset_; }
|
||||
int length() const { return length_; }
|
||||
|
||||
bool IsSet() { return kind_ != TokenKind::None; }
|
||||
|
||||
private:
|
||||
TokenKind kind_{TokenKind::None};
|
||||
int offset_{0};
|
||||
int length_{1};
|
||||
};
|
||||
|
||||
void ReportWarning(const char *text) { ReportWarning(text, token_); }
|
||||
void ReportWarning(
|
||||
const char *text, Token &token, const char *arg = nullptr) {
|
||||
FormatMessage msg{
|
||||
text, arg ? arg : argString_, token.offset(), token.length(), false};
|
||||
reporterExit_ |= reporter_(msg);
|
||||
}
|
||||
|
||||
void ReportError(const char *text) { ReportError(text, token_); }
|
||||
void ReportError(const char *text, Token &token, const char *arg = nullptr) {
|
||||
if (suppressMessageCascade_) {
|
||||
return;
|
||||
}
|
||||
formatHasErrors_ = true;
|
||||
suppressMessageCascade_ = true;
|
||||
FormatMessage msg{
|
||||
text, arg ? arg : argString_, token.offset(), token.length(), true};
|
||||
reporterExit_ |= reporter_(msg);
|
||||
}
|
||||
|
||||
void SetLength() { SetLength(token_); }
|
||||
void SetLength(Token &token) {
|
||||
token.set_length(cursor_ - format_ - token.offset() + (cursor_ < end_));
|
||||
}
|
||||
|
||||
CHAR NextChar();
|
||||
CHAR LookAheadChar();
|
||||
void Advance(TokenKind);
|
||||
void NextToken();
|
||||
|
||||
void check_r(bool allowed = true);
|
||||
bool check_w();
|
||||
void check_m();
|
||||
bool check_d();
|
||||
void check_e();
|
||||
|
||||
const CHAR *const format_; // format text
|
||||
const CHAR *const end_; // one-past-last of format_ text
|
||||
Reporter reporter_;
|
||||
IoStmtKind stmt_;
|
||||
|
||||
const CHAR *cursor_{}; // current location in format_
|
||||
const CHAR *laCursor_{}; // lookahead cursor
|
||||
Token token_{}; // current token
|
||||
int64_t integerValue_{-1}; // value of UnsignedInteger token
|
||||
Token knrToken_{}; // k, n, or r UnsignedInteger token
|
||||
int64_t knrValue_{-1}; // -1 ==> not present
|
||||
int64_t wValue_{-1};
|
||||
char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name
|
||||
bool formatHasErrors_{false};
|
||||
bool unterminatedFormatError_{false};
|
||||
bool suppressMessageCascade_{false};
|
||||
bool reporterExit_{false};
|
||||
};
|
||||
|
||||
template<typename CHAR> CHAR FormatValidator<CHAR>::NextChar() {
|
||||
for (++cursor_; cursor_ < end_; ++cursor_) {
|
||||
if (*cursor_ != ' ') {
|
||||
return toupper(*cursor_);
|
||||
}
|
||||
}
|
||||
cursor_ = end_; // don't allow cursor_ > end_
|
||||
return ' ';
|
||||
}
|
||||
|
||||
template<typename CHAR> CHAR FormatValidator<CHAR>::LookAheadChar() {
|
||||
for (laCursor_ = cursor_ + 1; laCursor_ < end_; ++laCursor_) {
|
||||
if (*laCursor_ != ' ') {
|
||||
return toupper(*laCursor_);
|
||||
}
|
||||
}
|
||||
laCursor_ = end_; // don't allow laCursor_ > end_
|
||||
return ' ';
|
||||
}
|
||||
|
||||
// After a call to LookAheadChar, set token kind and advance cursor to laCursor.
|
||||
template<typename CHAR> void FormatValidator<CHAR>::Advance(TokenKind tk) {
|
||||
cursor_ = laCursor_;
|
||||
token_.set_kind(tk);
|
||||
}
|
||||
|
||||
template<typename CHAR> void FormatValidator<CHAR>::NextToken() {
|
||||
// At entry, cursor_ points before the start of the next token.
|
||||
// At exit, cursor_ points to last CHAR of token_.
|
||||
|
||||
CHAR c{NextChar()};
|
||||
token_.set_kind(TokenKind::None);
|
||||
token_.set_offset(cursor_ - format_);
|
||||
token_.set_length(1);
|
||||
if (c == '_' && integerValue_ >= 0) { // C1305, C1309, C1310, C1312, C1313
|
||||
ReportError("Kind parameter '_' character in format expression");
|
||||
}
|
||||
integerValue_ = -1;
|
||||
|
||||
switch (c) {
|
||||
case '0':
|
||||
case '1':
|
||||
case '2':
|
||||
case '3':
|
||||
case '4':
|
||||
case '5':
|
||||
case '6':
|
||||
case '7':
|
||||
case '8':
|
||||
case '9': {
|
||||
int64_t lastValue;
|
||||
const CHAR *lastCursor;
|
||||
integerValue_ = 0;
|
||||
bool overflow{false};
|
||||
do {
|
||||
lastValue = integerValue_;
|
||||
lastCursor = cursor_;
|
||||
integerValue_ = 10 * integerValue_ + c - '0';
|
||||
if (lastValue > integerValue_) {
|
||||
overflow = true;
|
||||
}
|
||||
c = NextChar();
|
||||
} while (c >= '0' && c <= '9');
|
||||
cursor_ = lastCursor;
|
||||
token_.set_kind(TokenKind::UnsignedInteger);
|
||||
if (overflow) {
|
||||
SetLength();
|
||||
ReportError("Integer overflow in format expression");
|
||||
break;
|
||||
}
|
||||
if (LookAheadChar() != 'H') {
|
||||
break;
|
||||
}
|
||||
// Hollerith constant
|
||||
if (laCursor_ + integerValue_ < end_) {
|
||||
token_.set_kind(TokenKind::String);
|
||||
cursor_ = laCursor_ + integerValue_;
|
||||
} else {
|
||||
token_.set_kind(TokenKind::None);
|
||||
cursor_ = end_;
|
||||
}
|
||||
SetLength();
|
||||
if (stmt_ == IoStmtKind::Read) { // 13.3.2p6
|
||||
ReportError("'H' edit descriptor in READ format expression");
|
||||
} else if (token_.kind() == TokenKind::None) {
|
||||
ReportError("Unterminated 'H' edit descriptor");
|
||||
} else {
|
||||
ReportWarning("Legacy 'H' edit descriptor");
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'A': token_.set_kind(TokenKind::A); break;
|
||||
case 'B':
|
||||
switch (LookAheadChar()) {
|
||||
case 'N': Advance(TokenKind::BN); break;
|
||||
case 'Z': Advance(TokenKind::BZ); break;
|
||||
default: token_.set_kind(TokenKind::B); break;
|
||||
}
|
||||
break;
|
||||
case 'D':
|
||||
switch (LookAheadChar()) {
|
||||
case 'C': Advance(TokenKind::DC); break;
|
||||
case 'P': Advance(TokenKind::DP); break;
|
||||
case 'T': Advance(TokenKind::DT); break;
|
||||
default: token_.set_kind(TokenKind::D); break;
|
||||
}
|
||||
break;
|
||||
case 'E':
|
||||
switch (LookAheadChar()) {
|
||||
case 'N': Advance(TokenKind::EN); break;
|
||||
case 'S': Advance(TokenKind::ES); break;
|
||||
case 'X': Advance(TokenKind::EX); break;
|
||||
default: token_.set_kind(TokenKind::E); break;
|
||||
}
|
||||
break;
|
||||
case 'F': token_.set_kind(TokenKind::F); break;
|
||||
case 'G': token_.set_kind(TokenKind::G); break;
|
||||
case 'I': token_.set_kind(TokenKind::I); break;
|
||||
case 'L': token_.set_kind(TokenKind::L); break;
|
||||
case 'O': token_.set_kind(TokenKind::O); break;
|
||||
case 'P': token_.set_kind(TokenKind::P); break;
|
||||
case 'R':
|
||||
switch (LookAheadChar()) {
|
||||
case 'C': Advance(TokenKind::RC); break;
|
||||
case 'D': Advance(TokenKind::RD); break;
|
||||
case 'N': Advance(TokenKind::RN); break;
|
||||
case 'P': Advance(TokenKind::RP); break;
|
||||
case 'U': Advance(TokenKind::RU); break;
|
||||
case 'Z': Advance(TokenKind::RZ); break;
|
||||
default: token_.set_kind(TokenKind::None); break;
|
||||
}
|
||||
break;
|
||||
case 'S':
|
||||
switch (LookAheadChar()) {
|
||||
case 'P': Advance(TokenKind::SP); break;
|
||||
case 'S': Advance(TokenKind::SS); break;
|
||||
default: token_.set_kind(TokenKind::S); break;
|
||||
}
|
||||
break;
|
||||
case 'T':
|
||||
switch (LookAheadChar()) {
|
||||
case 'L': Advance(TokenKind::TL); break;
|
||||
case 'R': Advance(TokenKind::TR); break;
|
||||
default: token_.set_kind(TokenKind::T); break;
|
||||
}
|
||||
break;
|
||||
case 'X': token_.set_kind(TokenKind::X); break;
|
||||
case 'Z': token_.set_kind(TokenKind::Z); break;
|
||||
case '-':
|
||||
case '+': token_.set_kind(TokenKind::Sign); break;
|
||||
case '/': token_.set_kind(TokenKind::Slash); break;
|
||||
case '(': token_.set_kind(TokenKind::LParen); break;
|
||||
case ')': token_.set_kind(TokenKind::RParen); break;
|
||||
case '.': token_.set_kind(TokenKind::Point); break;
|
||||
case ':': token_.set_kind(TokenKind::Colon); break;
|
||||
case '\\': token_.set_kind(TokenKind::Backslash); break;
|
||||
case '$': token_.set_kind(TokenKind::Dollar); break;
|
||||
case '*':
|
||||
token_.set_kind(LookAheadChar() == '(' ? TokenKind::Star : TokenKind::None);
|
||||
break;
|
||||
case ',': {
|
||||
token_.set_kind(TokenKind::Comma);
|
||||
CHAR laChar = LookAheadChar();
|
||||
if (laChar == ',') {
|
||||
Advance(TokenKind::Comma);
|
||||
token_.set_offset(cursor_ - format_);
|
||||
ReportError("Unexpected ',' in format expression");
|
||||
} else if (laChar == ')') {
|
||||
ReportError("Unexpected ',' before ')' in format expression");
|
||||
}
|
||||
break;
|
||||
}
|
||||
case '\'':
|
||||
case '"':
|
||||
for (++cursor_; cursor_ < end_; ++cursor_) {
|
||||
if (*cursor_ == c) {
|
||||
if (auto nc{cursor_ + 1}; nc < end_ && *nc != c) {
|
||||
token_.set_kind(TokenKind::String);
|
||||
break;
|
||||
}
|
||||
++cursor_;
|
||||
}
|
||||
}
|
||||
SetLength();
|
||||
if (stmt_ == IoStmtKind::Read) { // 13.3.2p6
|
||||
ReportError("String edit descriptor in READ format expression");
|
||||
} else if (token_.kind() != TokenKind::String) {
|
||||
ReportError("Unterminated string");
|
||||
}
|
||||
break;
|
||||
default:
|
||||
if (cursor_ >= end_ && !unterminatedFormatError_) {
|
||||
suppressMessageCascade_ = false;
|
||||
ReportError("Unterminated format expression");
|
||||
unterminatedFormatError_ = true;
|
||||
}
|
||||
token_.set_kind(TokenKind::None);
|
||||
break;
|
||||
}
|
||||
|
||||
SetLength();
|
||||
}
|
||||
|
||||
template<typename CHAR> void FormatValidator<CHAR>::check_r(bool allowed) {
|
||||
if (!allowed && knrValue_ >= 0) {
|
||||
ReportError("Repeat specifier before '%s' edit descriptor", knrToken_);
|
||||
} else if (knrValue_ == 0) {
|
||||
ReportError("'%s' edit descriptor repeat specifier must be positive",
|
||||
knrToken_); // C1304
|
||||
}
|
||||
};
|
||||
|
||||
// Return the predicate "w value is present" to control further processing.
|
||||
template<typename CHAR> bool FormatValidator<CHAR>::check_w() {
|
||||
if (token_.kind() == TokenKind::UnsignedInteger) {
|
||||
wValue_ = integerValue_;
|
||||
if (wValue_ == 0 &&
|
||||
(*argString_ == 'A' || *argString_ == 'L' ||
|
||||
stmt_ == IoStmtKind::Read)) { // C1306, 13.7.2.1p6
|
||||
ReportError("'%s' edit descriptor 'w' value must be positive");
|
||||
}
|
||||
NextToken();
|
||||
return true;
|
||||
}
|
||||
if (*argString_ != 'A') {
|
||||
ReportWarning("Expected '%s' edit descriptor 'w' value"); // C1306
|
||||
}
|
||||
return false;
|
||||
};
|
||||
|
||||
template<typename CHAR> void FormatValidator<CHAR>::check_m() {
|
||||
if (token_.kind() != TokenKind::Point) {
|
||||
return;
|
||||
}
|
||||
NextToken();
|
||||
if (token_.kind() != TokenKind::UnsignedInteger) {
|
||||
ReportError("Expected '%s' edit descriptor 'm' value after '.'");
|
||||
return;
|
||||
}
|
||||
if ((stmt_ == IoStmtKind::Print || stmt_ == IoStmtKind::Write) &&
|
||||
wValue_ > 0 && integerValue_ > wValue_) { // 13.7.2.2p5, 13.7.2.4p6
|
||||
ReportError("'%s' edit descriptor 'm' value is greater than 'w' value");
|
||||
}
|
||||
NextToken();
|
||||
};
|
||||
|
||||
// Return the predicate "d value is present" to control further processing.
|
||||
template<typename CHAR> bool FormatValidator<CHAR>::check_d() {
|
||||
if (token_.kind() != TokenKind::Point) {
|
||||
ReportError("Expected '%s' edit descriptor '.d' value");
|
||||
return false;
|
||||
}
|
||||
NextToken();
|
||||
if (token_.kind() != TokenKind::UnsignedInteger) {
|
||||
ReportError("Expected '%s' edit descriptor 'd' value after '.'");
|
||||
return false;
|
||||
}
|
||||
NextToken();
|
||||
return true;
|
||||
};
|
||||
|
||||
template<typename CHAR> void FormatValidator<CHAR>::check_e() {
|
||||
if (token_.kind() != TokenKind::E) {
|
||||
return;
|
||||
}
|
||||
NextToken();
|
||||
if (token_.kind() != TokenKind::UnsignedInteger) {
|
||||
ReportError("Expected '%s' edit descriptor 'e' value after 'E'");
|
||||
return;
|
||||
}
|
||||
NextToken();
|
||||
};
|
||||
|
||||
template<typename CHAR> bool FormatValidator<CHAR>::Check() {
|
||||
if (!*format_) {
|
||||
ReportError("Empty format expression");
|
||||
return formatHasErrors_;
|
||||
}
|
||||
NextToken();
|
||||
if (token_.kind() != TokenKind::LParen) {
|
||||
ReportError("Format expression must have an initial '('");
|
||||
return formatHasErrors_;
|
||||
}
|
||||
NextToken();
|
||||
|
||||
int nestLevel{0}; // Outer level ()s are at level 0.
|
||||
Token starToken{}; // unlimited format token
|
||||
bool hasDataEditDesc{false};
|
||||
|
||||
// Subject to error recovery exceptions, a loop iteration processes an
|
||||
// edit descriptor or does list management. The loop terminates when
|
||||
// - a level-0 right paren is processed (format may be valid)
|
||||
// - the end of an incomplete format is reached
|
||||
// - the error reporter requests termination (error threshold reached)
|
||||
while (!reporterExit_) {
|
||||
Token signToken{};
|
||||
knrValue_ = -1; // -1 ==> not present
|
||||
wValue_ = -1;
|
||||
bool commaRequired{true};
|
||||
|
||||
if (token_.kind() == TokenKind::Sign) {
|
||||
signToken = token_;
|
||||
NextToken();
|
||||
}
|
||||
if (token_.kind() == TokenKind::UnsignedInteger) {
|
||||
knrToken_ = token_;
|
||||
knrValue_ = integerValue_;
|
||||
NextToken();
|
||||
}
|
||||
if (signToken.IsSet() && (knrValue_ < 0 || token_.kind() != TokenKind::P)) {
|
||||
argString_[0] = format_[signToken.offset()];
|
||||
argString_[1] = 0;
|
||||
ReportError("Unexpected '%s' in format expression", signToken);
|
||||
}
|
||||
// Default message argument.
|
||||
// Alphabetic edit descriptor names are one or two characters in length.
|
||||
argString_[0] = toupper(format_[token_.offset()]);
|
||||
argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0;
|
||||
// Process one format edit descriptor or do format list management.
|
||||
switch (token_.kind()) {
|
||||
case TokenKind::A:
|
||||
// R1307 data-edit-desc -> A [w]
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
check_w();
|
||||
break;
|
||||
case TokenKind::B:
|
||||
case TokenKind::I:
|
||||
case TokenKind::O:
|
||||
case TokenKind::Z:
|
||||
// R1307 data-edit-desc -> B w [. m] | I w [. m] | O w [. m] | Z w [. m]
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
if (check_w()) {
|
||||
check_m();
|
||||
}
|
||||
break;
|
||||
case TokenKind::D:
|
||||
case TokenKind::F:
|
||||
// R1307 data-edit-desc -> D w . d | F w . d
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
if (check_w()) {
|
||||
check_d();
|
||||
}
|
||||
break;
|
||||
case TokenKind::E:
|
||||
case TokenKind::EN:
|
||||
case TokenKind::ES:
|
||||
case TokenKind::EX:
|
||||
// R1307 data-edit-desc ->
|
||||
// E w . d [E e] | EN w . d [E e] | ES w . d [E e] | EX w . d [E e]
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
if (check_w() && check_d()) {
|
||||
check_e();
|
||||
}
|
||||
break;
|
||||
case TokenKind::G:
|
||||
// R1307 data-edit-desc -> G w [. d [E e]]
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
if (check_w()) {
|
||||
if (wValue_ > 0) {
|
||||
if (check_d()) { // C1307
|
||||
check_e();
|
||||
}
|
||||
} else if (token_.kind() == TokenKind::Point && check_d() &&
|
||||
token_.kind() == TokenKind::E) {
|
||||
ReportError("Unexpected 'e' in 'G0' edit descriptor"); // C1308
|
||||
NextToken();
|
||||
if (token_.kind() == TokenKind::UnsignedInteger) {
|
||||
NextToken();
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case TokenKind::L:
|
||||
// R1307 data-edit-desc -> L w
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
check_w();
|
||||
break;
|
||||
case TokenKind::DT:
|
||||
// R1307 data-edit-desc -> DT [char-literal-constant] [( v-list )]
|
||||
hasDataEditDesc = true;
|
||||
check_r();
|
||||
NextToken();
|
||||
if (token_.kind() == TokenKind::String) {
|
||||
NextToken();
|
||||
}
|
||||
if (token_.kind() == TokenKind::LParen) {
|
||||
do {
|
||||
NextToken();
|
||||
if (token_.kind() == TokenKind::Sign) {
|
||||
NextToken();
|
||||
}
|
||||
if (token_.kind() != TokenKind::UnsignedInteger) {
|
||||
ReportError(
|
||||
"Expected integer constant in 'DT' edit descriptor v-list");
|
||||
break;
|
||||
}
|
||||
NextToken();
|
||||
} while (token_.kind() == TokenKind::Comma);
|
||||
if (token_.kind() != TokenKind::RParen) {
|
||||
ReportError("Expected ',' or ')' in 'DT' edit descriptor v-list");
|
||||
while (cursor_ < end_ && token_.kind() != TokenKind::RParen) {
|
||||
NextToken();
|
||||
}
|
||||
}
|
||||
NextToken();
|
||||
}
|
||||
break;
|
||||
case TokenKind::String:
|
||||
// R1304 data-edit-desc -> char-string-edit-desc
|
||||
if (knrValue_ >= 0) {
|
||||
ReportError("Repeat specifier before character string edit descriptor",
|
||||
knrToken_);
|
||||
}
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::BN:
|
||||
case TokenKind::BZ:
|
||||
case TokenKind::DC:
|
||||
case TokenKind::DP:
|
||||
case TokenKind::RC:
|
||||
case TokenKind::RD:
|
||||
case TokenKind::RN:
|
||||
case TokenKind::RP:
|
||||
case TokenKind::RU:
|
||||
case TokenKind::RZ:
|
||||
case TokenKind::S:
|
||||
case TokenKind::SP:
|
||||
case TokenKind::SS:
|
||||
// R1317 sign-edit-desc -> SS | SP | S
|
||||
// R1318 blank-interp-edit-desc -> BN | BZ
|
||||
// R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP
|
||||
// R1320 decimal-edit-desc -> DC | DP
|
||||
check_r(false);
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::P: {
|
||||
// R1313 control-edit-desc -> k P
|
||||
if (knrValue_ < 0) {
|
||||
ReportError("'P' edit descriptor must have a scale factor");
|
||||
}
|
||||
// Diagnosing C1302 may require multiple token lookahead.
|
||||
// Save current cursor position to enable backup.
|
||||
const CHAR *saveCursor{cursor_};
|
||||
NextToken();
|
||||
if (token_.kind() == TokenKind::UnsignedInteger) {
|
||||
NextToken();
|
||||
}
|
||||
switch (token_.kind()) {
|
||||
case TokenKind::D:
|
||||
case TokenKind::E:
|
||||
case TokenKind::EN:
|
||||
case TokenKind::ES:
|
||||
case TokenKind::EX:
|
||||
case TokenKind::F:
|
||||
case TokenKind::G: commaRequired = false; break;
|
||||
default:;
|
||||
}
|
||||
cursor_ = saveCursor;
|
||||
NextToken();
|
||||
break;
|
||||
}
|
||||
case TokenKind::T:
|
||||
case TokenKind::TL:
|
||||
case TokenKind::TR:
|
||||
// R1315 position-edit-desc -> T n | TL n | TR n
|
||||
check_r(false);
|
||||
NextToken();
|
||||
if (integerValue_ <= 0) { // C1311
|
||||
ReportError("'%s' edit descriptor must have a positive position value");
|
||||
}
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::X:
|
||||
// R1315 position-edit-desc -> n X
|
||||
if (knrValue_ == 0) { // C1311
|
||||
ReportError("'X' edit descriptor must have a positive position value",
|
||||
knrToken_);
|
||||
} else if (knrValue_ < 0) {
|
||||
ReportWarning(
|
||||
"'X' edit descriptor must have a positive position value");
|
||||
}
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Colon:
|
||||
// R1313 control-edit-desc -> :
|
||||
check_r(false);
|
||||
commaRequired = false;
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Slash:
|
||||
// R1313 control-edit-desc -> [r] /
|
||||
commaRequired = false;
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Backslash:
|
||||
check_r(false);
|
||||
ReportWarning("Non-standard '\\' edit descriptor");
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Dollar:
|
||||
check_r(false);
|
||||
ReportWarning("Non-standard '$' edit descriptor");
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Star:
|
||||
// NextToken assigns a token kind of Star only if * is followed by (.
|
||||
// So the next token is guaranteed to be LParen.
|
||||
if (nestLevel > 0) {
|
||||
ReportError("Nested unlimited format item list");
|
||||
}
|
||||
starToken = token_;
|
||||
if (knrValue_ >= 0) {
|
||||
ReportError(
|
||||
"Repeat specifier before unlimited format item list", knrToken_);
|
||||
}
|
||||
hasDataEditDesc = false;
|
||||
NextToken();
|
||||
// fall through
|
||||
case TokenKind::LParen:
|
||||
if (knrValue_ == 0) {
|
||||
ReportError("List repeat specifier must be positive", knrToken_);
|
||||
}
|
||||
++nestLevel;
|
||||
break;
|
||||
case TokenKind::RParen:
|
||||
if (knrValue_ >= 0) {
|
||||
ReportError("Unexpected integer constant", knrToken_);
|
||||
}
|
||||
do {
|
||||
if (nestLevel == 0) {
|
||||
// Any characters after level-0 ) are ignored.
|
||||
return formatHasErrors_; // normal exit (may have messages)
|
||||
}
|
||||
if (nestLevel == 1 && starToken.IsSet() && !hasDataEditDesc) {
|
||||
SetLength(starToken);
|
||||
ReportError( // C1303
|
||||
"Unlimited format item list must contain a data edit descriptor",
|
||||
starToken);
|
||||
}
|
||||
--nestLevel;
|
||||
NextToken();
|
||||
} while (token_.kind() == TokenKind::RParen);
|
||||
if (nestLevel == 0 && starToken.IsSet()) {
|
||||
ReportError("Character in format after unlimited format item list");
|
||||
}
|
||||
break;
|
||||
case TokenKind::Comma:
|
||||
if (knrValue_ >= 0) {
|
||||
ReportError("Unexpected integer constant", knrToken_);
|
||||
}
|
||||
if (suppressMessageCascade_ || reporterExit_) {
|
||||
break;
|
||||
}
|
||||
// fall through
|
||||
default: ReportError("Unexpected '%s' in format expression"); NextToken();
|
||||
}
|
||||
|
||||
// Process comma separator and exit an incomplete format.
|
||||
switch (token_.kind()) {
|
||||
case TokenKind::Colon: // Comma not required; token not yet processed.
|
||||
case TokenKind::Slash: // Comma not required; token not yet processed.
|
||||
case TokenKind::RParen: // Comma not allowed; token not yet processed.
|
||||
suppressMessageCascade_ = false;
|
||||
break;
|
||||
case TokenKind::LParen: // Comma not allowed; token already processed.
|
||||
case TokenKind::Comma: // Normal comma case; move past token.
|
||||
suppressMessageCascade_ = false;
|
||||
NextToken();
|
||||
break;
|
||||
case TokenKind::Sign: // Error; main switch has a better message.
|
||||
case TokenKind::None: // Error; token not yet processed.
|
||||
if (cursor_ >= end_) {
|
||||
return formatHasErrors_; // incomplete format error exit
|
||||
}
|
||||
break;
|
||||
default:
|
||||
// Possible first token of the next format item; token not yet processed.
|
||||
if (commaRequired) {
|
||||
ReportError("Expected ',' or ')' in format expression"); // C1302
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return formatHasErrors_; // error reporter (message threshold) exit
|
||||
}
|
||||
|
||||
}
|
||||
#endif // FORTRAN_COMMON_FORMAT_H_
|
||||
|
|
@ -15,12 +15,83 @@
|
|||
#include "check-io.h"
|
||||
#include "expression.h"
|
||||
#include "tools.h"
|
||||
#include "../common/format.h"
|
||||
#include "../parser/tools.h"
|
||||
|
||||
namespace Fortran::semantics {
|
||||
|
||||
// TODO: C1234, C1235 -- defined I/O constraints
|
||||
|
||||
class FormatErrorReporter {
|
||||
public:
|
||||
FormatErrorReporter(SemanticsContext &context,
|
||||
const parser::CharBlock &formatCharBlock, int errorAllowance = 3)
|
||||
: context_{context}, formatCharBlock_{formatCharBlock},
|
||||
errorAllowance_{errorAllowance} {}
|
||||
|
||||
bool Say(const common::FormatMessage &);
|
||||
|
||||
private:
|
||||
SemanticsContext &context_;
|
||||
const parser::CharBlock &formatCharBlock_;
|
||||
int errorAllowance_; // initialized to maximum number of errors to report
|
||||
};
|
||||
|
||||
bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
|
||||
if (!msg.isError && !context_.warnOnNonstandardUsage()) {
|
||||
return false;
|
||||
}
|
||||
parser::MessageFormattedText text{
|
||||
parser::MessageFixedText(msg.text, strlen(msg.text), msg.isError),
|
||||
msg.arg};
|
||||
if (formatCharBlock_.size()) {
|
||||
// The input format is a folded expression. Error markers span the full
|
||||
// original unfolded expression in formatCharBlock_.
|
||||
context_.Say(formatCharBlock_, text);
|
||||
} else {
|
||||
// The input format is a source expression. Error markers have an offset
|
||||
// and length relative to the beginning of formatCharBlock_.
|
||||
parser::CharBlock messageCharBlock{
|
||||
parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};
|
||||
context_.Say(messageCharBlock, text);
|
||||
}
|
||||
return msg.isError && --errorAllowance_ <= 0;
|
||||
}
|
||||
|
||||
void IoChecker::Enter(
|
||||
const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {
|
||||
if (!stmt.label.has_value()) {
|
||||
context_.Say("Format statement must be labeled"_err_en_US); // C1301
|
||||
}
|
||||
const char *formatStart{static_cast<const char *>(
|
||||
std::memchr(stmt.source.begin(), '(', stmt.source.size()))};
|
||||
parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};
|
||||
FormatErrorReporter reporter{context_, reporterCharBlock};
|
||||
auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};
|
||||
switch (context_.GetDefaultKind(TypeCategory::Character)) {
|
||||
case 1: {
|
||||
common::FormatValidator<char> validator{formatStart,
|
||||
stmt.source.size() - (formatStart - stmt.source.begin()),
|
||||
reporterWrapper};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
case 2: { // TODO: Get this to work.
|
||||
common::FormatValidator<char16_t> validator{
|
||||
/*???*/ nullptr, /*???*/ 0, reporterWrapper};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
case 4: { // TODO: Get this to work.
|
||||
common::FormatValidator<char32_t> validator{
|
||||
/*???*/ nullptr, /*???*/ 0, reporterWrapper};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
default: CRASH_NO_CASE;
|
||||
}
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::ConnectSpec &spec) {
|
||||
// ConnectSpec context FileNameExpr
|
||||
if (std::get_if<parser::FileNameExpr>(&spec.u)) {
|
||||
|
|
@ -96,15 +167,53 @@ void IoChecker::Enter(const parser::FileUnitNumber &spec) {
|
|||
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
|
||||
}
|
||||
std::visit(
|
||||
common::visitors{
|
||||
[&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
|
||||
[&](const parser::Star &) { flags_.set(Flag::StarFmt); },
|
||||
[&](const parser::DefaultCharExpr &format) {
|
||||
flags_.set(Flag::CharFmt);
|
||||
const std::optional<std::string> constantFormat{
|
||||
GetConstExpr<std::string>(format)};
|
||||
if (!constantFormat) {
|
||||
return;
|
||||
}
|
||||
// validate constant format -- 12.6.2.2
|
||||
bool isFolded{constantFormat->size() !=
|
||||
format.thing.value().source.size() - 2};
|
||||
parser::CharBlock reporterCharBlock{isFolded
|
||||
? parser::CharBlock{format.thing.value().source}
|
||||
: parser::CharBlock{format.thing.value().source.begin() + 1,
|
||||
static_cast<std::size_t>(0)}};
|
||||
FormatErrorReporter reporter{context_, reporterCharBlock};
|
||||
auto reporterWrapper{
|
||||
[&](const auto &msg) { return reporter.Say(msg); }};
|
||||
switch (context_.GetDefaultKind(TypeCategory::Character)) {
|
||||
case 1: {
|
||||
common::FormatValidator<char> validator{constantFormat->c_str(),
|
||||
constantFormat->length(), reporterWrapper, stmt_};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
case 2: {
|
||||
// TODO: Get this to work. (Maybe combine with earlier instance?)
|
||||
common::FormatValidator<char16_t> validator{
|
||||
/*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
case 4: {
|
||||
// TODO: Get this to work. (Maybe combine with earlier instance?)
|
||||
common::FormatValidator<char32_t> validator{
|
||||
/*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
|
||||
validator.Check();
|
||||
break;
|
||||
}
|
||||
default: CRASH_NO_CASE;
|
||||
}
|
||||
},
|
||||
},
|
||||
spec.u);
|
||||
}
|
||||
|
||||
void IoChecker::Enter(const parser::IdExpr &spec) {
|
||||
|
|
@ -272,7 +381,7 @@ void IoChecker::Enter(const parser::IoUnit &spec) {
|
|||
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);
|
||||
"Invalid character kind for an internal file variable"_err_en_US);
|
||||
}
|
||||
}
|
||||
SetSpecifier(IoSpecKind::Unit);
|
||||
|
|
@ -311,7 +420,7 @@ void IoChecker::Enter(const parser::StatusExpr &spec) {
|
|||
CHECK(stmt_ == IoStmtKind::Close);
|
||||
if (s != "DELETE" && s != "KEEP") {
|
||||
context_.Say(parser::FindSourceLocation(spec),
|
||||
"invalid STATUS value '%s'"_err_en_US, *charConst);
|
||||
"Invalid STATUS value '%s'"_err_en_US, *charConst);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -474,7 +583,7 @@ void IoChecker::SetSpecifier(IoSpecKind specKind) {
|
|||
}
|
||||
// C1203, C1207, C1210, C1236, C1239, C1242, C1245
|
||||
if (specifierSet_.test(specKind)) {
|
||||
context_.Say("duplicate %s specifier"_err_en_US,
|
||||
context_.Say("Duplicate %s specifier"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
|
||||
}
|
||||
specifierSet_.set(specKind);
|
||||
|
|
@ -504,7 +613,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
|
|||
{IoSpecKind::Dispose, {"DELETE", "KEEP"}},
|
||||
};
|
||||
if (!specValues.at(specKind).count(parser::ToUpperCaseLetters(value))) {
|
||||
context_.Say(source, "invalid %s value '%s'"_err_en_US,
|
||||
context_.Say(source, "Invalid %s value '%s'"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
|
||||
}
|
||||
}
|
||||
|
|
@ -534,7 +643,7 @@ void IoChecker::CheckForRequiredSpecifier(
|
|||
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,
|
||||
context_.Say("If %s appears, %s must also appear"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
|
||||
}
|
||||
|
|
@ -543,7 +652,7 @@ void IoChecker::CheckForRequiredSpecifier(
|
|||
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,
|
||||
context_.Say("If %s appears, %s must also appear"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
|
||||
}
|
||||
}
|
||||
|
|
@ -551,7 +660,7 @@ void IoChecker::CheckForRequiredSpecifier(
|
|||
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,
|
||||
context_.Say("If %s appears, %s must also appear"_err_en_US, s,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
|
||||
}
|
||||
}
|
||||
|
|
@ -559,7 +668,7 @@ void IoChecker::CheckForRequiredSpecifier(
|
|||
void IoChecker::CheckForRequiredSpecifier(bool condition1,
|
||||
const std::string &s1, bool condition2, const std::string &s2) const {
|
||||
if (condition1 && !condition2) {
|
||||
context_.Say("if %s appears, %s must also appear"_err_en_US, s1, s2);
|
||||
context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -574,7 +683,7 @@ void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
|
|||
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,
|
||||
context_.Say("If %s appears, %s must not appear"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
|
||||
}
|
||||
|
|
@ -583,7 +692,7 @@ void IoChecker::CheckForProhibitedSpecifier(
|
|||
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,
|
||||
context_.Say("If %s appears, %s must not appear"_err_en_US,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
|
||||
}
|
||||
}
|
||||
|
|
@ -591,7 +700,7 @@ void IoChecker::CheckForProhibitedSpecifier(
|
|||
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,
|
||||
context_.Say("If %s appears, %s must not appear"_err_en_US, s,
|
||||
parser::ToUpperCaseLetters(common::EnumToString(specKind)));
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -40,6 +40,9 @@ public:
|
|||
void Enter(const parser::WaitStmt &) { Init(IoStmtKind::Wait); }
|
||||
void Enter(const parser::WriteStmt &) { Init(IoStmtKind::Write); }
|
||||
|
||||
void Enter(
|
||||
const parser::Statement<common::Indirection<parser::FormatStmt>> &);
|
||||
|
||||
void Enter(const parser::ConnectSpec &);
|
||||
void Enter(const parser::ConnectSpec::CharExpr &);
|
||||
void Enter(const parser::ConnectSpec::Newunit &);
|
||||
|
|
@ -84,7 +87,7 @@ private:
|
|||
ENUM_CLASS(Flag, IoControlList, InternalUnit, NumberUnit, StarUnit, CharFmt,
|
||||
LabelFmt, StarFmt, FmtOrNml, KnownAccess, AccessDirect, AccessStream,
|
||||
AdvanceYes, AsynchronousYes, KnownStatus, StatusNew, StatusReplace,
|
||||
StatusScratch, DataList);
|
||||
StatusScratch, DataList)
|
||||
|
||||
template<typename R, typename T> std::optional<R> GetConstExpr(const T &x) {
|
||||
using DefaultCharConstantType =
|
||||
|
|
|
|||
|
|
@ -32,6 +32,10 @@ set(ERROR_TESTS
|
|||
io04.f90
|
||||
io05.f90
|
||||
io06.f90
|
||||
io07.f90
|
||||
io08.f90
|
||||
io09.f90
|
||||
io10.f90
|
||||
kinds02.f90
|
||||
resolve01.f90
|
||||
resolve02.f90
|
||||
|
|
|
|||
|
|
@ -76,35 +76,35 @@
|
|||
open(access='STREAM', 90) ! nonstandard
|
||||
|
||||
!ERROR: OPEN statement must have a UNIT or NEWUNIT specifier
|
||||
!ERROR: if ACCESS='DIRECT' appears, RECL must also appear
|
||||
!ERROR: If ACCESS='DIRECT' appears, RECL must also appear
|
||||
open(access='direct')
|
||||
|
||||
!ERROR: if STATUS='STREAM' appears, RECL must not appear
|
||||
!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
|
||||
!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
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
open(unit=100, unit=100)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
open(101, delim=delim_(1), unit=102)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
open(unit=103, &
|
||||
unit=104, iostat=stat8)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: if ACCESS='DIRECT' appears, RECL must also appear
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
!ERROR: If ACCESS='DIRECT' appears, RECL must also appear
|
||||
open(access='dir'//'ect', 9, 9) ! nonstandard
|
||||
|
||||
!ERROR: duplicate ROUND specifier
|
||||
!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
|
||||
!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
|
||||
|
|
@ -113,27 +113,27 @@
|
|||
!ERROR: RECL value (-36) must be positive
|
||||
open(108, recl=- - (-36)) ! nonstandard
|
||||
|
||||
!ERROR: invalid ACTION value 'reedwrite'
|
||||
!ERROR: Invalid ACTION value 'reedwrite'
|
||||
open(109, access=Access, action='reedwrite', recl=77)
|
||||
|
||||
!ERROR: invalid ACTION value 'nonsense'
|
||||
!ERROR: Invalid ACTION value 'nonsense'
|
||||
open(110, action=''//'non'//'sense', recl=77)
|
||||
|
||||
!ERROR: invalid STATUS value 'cold'
|
||||
!ERROR: Invalid STATUS value 'cold'
|
||||
open(111, status='cold')
|
||||
|
||||
!ERROR: invalid STATUS value 'Keep'
|
||||
!ERROR: Invalid STATUS value 'Keep'
|
||||
open(112, status='Keep')
|
||||
|
||||
!ERROR: if STATUS='NEW' appears, FILE must also appear
|
||||
!ERROR: If STATUS='NEW' appears, FILE must also appear
|
||||
open(113, status='new')
|
||||
|
||||
!ERROR: if STATUS='REPLACE' appears, FILE must also appear
|
||||
!ERROR: If STATUS='REPLACE' appears, FILE must also appear
|
||||
open(114, status='replace')
|
||||
|
||||
!ERROR: if STATUS='SCRATCH' appears, FILE must not appear
|
||||
!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
|
||||
!ERROR: If NEWUNIT appears, FILE or STATUS='SCRATCH' must also appear
|
||||
open(newunit=nn, status='old')
|
||||
end
|
||||
|
|
|
|||
|
|
@ -29,16 +29,16 @@
|
|||
!ERROR: CLOSE statement must have a UNIT number specifier
|
||||
close(iostat=stat1)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
close(13, unit=14, err=9)
|
||||
|
||||
!ERROR: duplicate ERR specifier
|
||||
!ERROR: Duplicate ERR specifier
|
||||
close(err=9, unit=15, err=9, iostat=stat8)
|
||||
|
||||
!ERROR: invalid STATUS value 'kept'
|
||||
!ERROR: Invalid STATUS value 'kept'
|
||||
close(status='kept', unit=16)
|
||||
|
||||
!ERROR: invalid STATUS value 'old'
|
||||
!ERROR: Invalid STATUS value 'old'
|
||||
close(status='old', unit=17)
|
||||
|
||||
9 continue
|
||||
|
|
|
|||
|
|
@ -59,19 +59,19 @@
|
|||
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
|
||||
!ERROR: Invalid character kind for an internal file variable
|
||||
read(internal_file2, *) jj
|
||||
|
||||
!ERROR: invalid character kind for an internal file variable
|
||||
!ERROR: Invalid character kind for an internal file variable
|
||||
read(internal_file4, *) jj
|
||||
|
||||
!ERROR: duplicate IOSTAT specifier
|
||||
!ERROR: Duplicate IOSTAT specifier
|
||||
read(11, pos=ipos, iostat=stat1, iostat=stat2)
|
||||
|
||||
!ERROR: duplicate END specifier
|
||||
!ERROR: Duplicate END specifier
|
||||
read(11, end=9, pos=ipos, end=9)
|
||||
|
||||
!ERROR: duplicate NML specifier
|
||||
!ERROR: Duplicate NML specifier
|
||||
read(10, nml=mmm, nml=nnn)
|
||||
|
||||
!ERROR: READ statement must have a UNIT specifier
|
||||
|
|
@ -81,66 +81,66 @@
|
|||
!ERROR: READ statement must not have a SIGN specifier
|
||||
read(10, delim='quote', sign='plus') jj
|
||||
|
||||
!ERROR: if NML appears, REC must not appear
|
||||
!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
|
||||
!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
|
||||
!ERROR: If UNIT=* appears, REC must not appear
|
||||
read(*, rec=13)
|
||||
|
||||
!ERROR: if UNIT=* appears, POS must not appear
|
||||
!ERROR: If UNIT=* appears, POS must not appear
|
||||
read(*, pos=13)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, REC must not appear
|
||||
!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
|
||||
!ERROR: If UNIT=internal-file appears, POS must not appear
|
||||
read(internal_file, pos=13)
|
||||
|
||||
!ERROR: if REC appears, END must not appear
|
||||
!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
|
||||
!ERROR: If REC appears, FMT=* must not appear
|
||||
read(10, *, rec=13) jj
|
||||
|
||||
!ERROR: if ADVANCE appears, UNIT=internal-file must not appear
|
||||
!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
|
||||
!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
|
||||
!ERROR: If EOR appears, ADVANCE with value 'NO' must also appear
|
||||
read(10, eor=9)
|
||||
|
||||
!ERROR: invalid ASYNCHRONOUS value 'nay'
|
||||
!ERROR: Invalid ASYNCHRONOUS value 'nay'
|
||||
read(10, asynchronous='nay') ! prog req
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
!ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
read(*, asynchronous='yes')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
!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
|
||||
!ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
read(10, id=id)
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
!ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
read(10, asynchronous='n'//'o', id=id)
|
||||
|
||||
!ERROR: if POS appears, REC must not appear
|
||||
!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'
|
||||
!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
|
||||
!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)
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@
|
|||
print*
|
||||
print*, 'Ok'
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
write(internal_file, unit=*)
|
||||
|
||||
!ERROR: WRITE statement must have a UNIT specifier
|
||||
|
|
@ -70,63 +70,65 @@
|
|||
!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
|
||||
!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
|
||||
!ERROR: If UNIT=* appears, POS must not appear
|
||||
write(*, pos=n, nml=nnn)
|
||||
|
||||
!ERROR: if UNIT=* appears, REC must not appear
|
||||
!ERROR: If UNIT=* appears, REC must not appear
|
||||
write(*, rec=n)
|
||||
|
||||
!ERROR: if UNIT=internal-file appears, POS must not appear
|
||||
!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
|
||||
!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
|
||||
!ERROR: If UNIT=* appears, REC must not appear
|
||||
write(*, rec=13) 'Ok'
|
||||
|
||||
!ERROR: if ADVANCE appears, UNIT=internal-file must not appear
|
||||
!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
|
||||
!ERROR: If ADVANCE appears, an explicit format must also appear
|
||||
write(10, advance='yes') 'Ok'
|
||||
|
||||
!ERROR: invalid ASYNCHRONOUS value 'non'
|
||||
!ERROR: Invalid ASYNCHRONOUS value 'non'
|
||||
write(*, asynchronous='non')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
!ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
write(*, asynchronous='yes')
|
||||
|
||||
!ERROR: if ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
!ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
|
||||
write(internal_file, asynchronous='yes')
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
!ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
write(10, *, id=id) "Ok"
|
||||
|
||||
!ERROR: if ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
!ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
|
||||
write(10, *, id=id, asynchronous='no') "Ok"
|
||||
|
||||
!ERROR: if POS appears, REC must not appear
|
||||
!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'
|
||||
!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: If DELIM appears, FMT=* or NML must also appear
|
||||
!ERROR: Invalid DELIM value 'Nix'
|
||||
write(delim='Nix', fmt='(A)', unit=10) 'Ok'
|
||||
|
||||
!ERROR: ID kind (1) is smaller than default INTEGER kind (4)
|
||||
write(id=id1, unit=10, asynchronous='Yes') 'Ok'
|
||||
|
||||
write(*, '(X)')
|
||||
|
||||
1 format (A)
|
||||
9 continue
|
||||
end
|
||||
|
|
|
|||
|
|
@ -49,24 +49,24 @@
|
|||
!ERROR: INQUIRE statement must have a UNIT number or FILE specifier
|
||||
inquire(err=9)
|
||||
|
||||
!ERROR: if FILE appears, UNIT must not appear
|
||||
!ERROR: If FILE appears, UNIT must not appear
|
||||
inquire(10, file='abc', blank=c(22), iostat=stat8)
|
||||
|
||||
!ERROR: duplicate FILE specifier
|
||||
!ERROR: Duplicate FILE specifier
|
||||
inquire(file='abc', file='xyz')
|
||||
|
||||
!ERROR: duplicate FORM specifier
|
||||
!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
|
||||
!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
|
||||
!ERROR: Duplicate IOMSG specifier
|
||||
inquire(10, iomsg=msg, pos=ipos, iomsg=msg)
|
||||
|
||||
!ERROR: if ID appears, PENDING must also appear
|
||||
!ERROR: If ID appears, PENDING must also appear
|
||||
inquire(file='abc', id=id)
|
||||
|
||||
9 continue
|
||||
|
|
|
|||
|
|
@ -35,22 +35,22 @@
|
|||
wait(10)
|
||||
wait(99, id=id1, end=9, eor=9, err=9, iostat=stat1, iomsg=msg1)
|
||||
|
||||
!ERROR: duplicate UNIT specifier
|
||||
!ERROR: Duplicate UNIT specifier
|
||||
backspace(10, unit=11)
|
||||
|
||||
!ERROR: duplicate IOSTAT specifier
|
||||
!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
|
||||
!ERROR: Duplicate ERR specifier
|
||||
!ERROR: Duplicate ERR specifier
|
||||
flush(err=9, unit=10, &
|
||||
err=9, &
|
||||
err=9)
|
||||
|
||||
!ERROR: duplicate ID specifier
|
||||
!ERROR: Duplicate ID specifier
|
||||
!ERROR: WAIT statement must have a UNIT number specifier
|
||||
wait(id=id2, eor=9, id=id3)
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,96 @@
|
|||
! 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.
|
||||
|
||||
1001 format(A)
|
||||
|
||||
!ERROR: Format statement must be labeled
|
||||
format(A)
|
||||
|
||||
2001 format(3I8, 3Z8)
|
||||
2002 format(3I8, Z8)
|
||||
2003 format( 3 I 8 , 3 Z 8 )
|
||||
2004 format(20PF10.2)
|
||||
2005 format(20P,F10.2)
|
||||
2006 format(20P7F10.2)
|
||||
2007 format(1X/)
|
||||
2008 format(/02x)
|
||||
2009 format(1x/02x)
|
||||
2010 format(2L2:)
|
||||
2011 format(:2L2)
|
||||
2012 format(2L2 : 2L2)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2101 format(3I83Z8, 'abc')
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2102 format( 3 I 8 3 Z 8 )
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2103 format(3I8 3Z8)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2104 format(3I8 Z8)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2105 format(1X3/)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2106 format(1X003/)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2107 format(3P7I2)
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
2108 format(3PI2)
|
||||
|
||||
3001 format(*(I3))
|
||||
3002 format(5X,*(2(A)))
|
||||
|
||||
!ERROR: Unlimited format item list must contain a data edit descriptor
|
||||
3101 format(*(X))
|
||||
|
||||
!ERROR: Unlimited format item list must contain a data edit descriptor
|
||||
3102 format(5X,*(2(/)))
|
||||
|
||||
!ERROR: Unlimited format item list must contain a data edit descriptor
|
||||
3103 format(5X, 'abc', *((:)))
|
||||
|
||||
4001 format(2(X))
|
||||
|
||||
!ERROR: List repeat specifier must be positive
|
||||
!ERROR: 'DT' edit descriptor repeat specifier must be positive
|
||||
4101 format(0(X), 0dt)
|
||||
|
||||
6001 format(((I0, B0)))
|
||||
|
||||
!ERROR: 'A' edit descriptor 'w' value must be positive
|
||||
!ERROR: 'L' edit descriptor 'w' value must be positive
|
||||
6101 format((A0), ((L0)))
|
||||
|
||||
!ERROR: 'L' edit descriptor 'w' value must be positive
|
||||
6102 format((3(((L 0 0 0)))))
|
||||
|
||||
7001 format(17G8.1, 17G8.1e3)
|
||||
|
||||
!ERROR: Expected 'G' edit descriptor '.d' value
|
||||
7101 format(17G8)
|
||||
|
||||
8001 format(9G0.5)
|
||||
|
||||
!ERROR: Unexpected 'e' in 'G0' edit descriptor
|
||||
8101 format(9(G0.5e1))
|
||||
|
||||
!ERROR: Unexpected 'e' in 'G0' edit descriptor
|
||||
8102 format(9(G0.5 E 1))
|
||||
end
|
||||
|
|
@ -0,0 +1,327 @@
|
|||
! 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.
|
||||
|
||||
write(*,*)
|
||||
write(*,'()')
|
||||
write(*,'(A)')
|
||||
write(*,'(2X:2X)')
|
||||
write(*,'(2X/2X)')
|
||||
write(*,'(3/2X)')
|
||||
write(*,'(3PF5.2)')
|
||||
write(*,'(+3PF5.2)')
|
||||
write(*,'(-3PF5.2)')
|
||||
write(*,'(000p,10p,0p)')
|
||||
write(*,'(3P7D5.2)')
|
||||
write(*,'(3P,7F5.2)')
|
||||
write(*,'(2X,(i3))')
|
||||
write(*,'(5X,*(2X,I2))')
|
||||
write(*,'(5X,*(2X,DT))')
|
||||
write(*,'(*(DT))')
|
||||
write(*,'(*(DT"value"))')
|
||||
write(*,'(*(DT(+1,0,-1)))')
|
||||
write(*,'(*(DT"value"(+1,000,-1)))')
|
||||
write(*,'(*(DT(0)))')
|
||||
write(*,'(S,(RZ),2E10.3)')
|
||||
write(*,'(7I2)')
|
||||
write(*,'(07I02)')
|
||||
write(*,'(07I02.01)')
|
||||
write(*,'(07I02.02)')
|
||||
write(*,'(I0)')
|
||||
write(*,'(G4.2)')
|
||||
write(*,'(G0.8)')
|
||||
write(*,'(T3)')
|
||||
write(*,'("abc")')
|
||||
write(*,'("""abc""")')
|
||||
write(*,'("a""""bc", 2x)')
|
||||
write(*,'(3Habc)')
|
||||
write(*,'(3Habc, 2X, 3X)')
|
||||
write(*,'(987654321098765432X)')
|
||||
write(*,'($)')
|
||||
write(*,'(\)')
|
||||
write(*,'(RZ,RU,RP,RN,RD,RC,SS,SP,S,3G15.3e2)')
|
||||
|
||||
!ERROR: Empty format expression
|
||||
write(*,"")
|
||||
|
||||
!ERROR: Empty format expression
|
||||
write(*,"" // '' // "")
|
||||
|
||||
!ERROR: Format expression must have an initial '('
|
||||
write(*,'I3')
|
||||
|
||||
!ERROR: Unexpected '+' in format expression
|
||||
write(*,'(+7I2)')
|
||||
|
||||
!ERROR: Unexpected '-' in format expression
|
||||
write(*,'(-7I2)')
|
||||
|
||||
!ERROR: 'P' edit descriptor must have a scale factor
|
||||
write(*,'(P7F5.2)')
|
||||
|
||||
!ERROR: 'P' edit descriptor must have a scale factor
|
||||
write(*,'(P7F' // '5.2)')
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
write(*,'(3P7I2)')
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
write(*,'(5X i3)')
|
||||
|
||||
!ERROR: Unexpected integer constant
|
||||
write(*,'(X,3,3L4)')
|
||||
|
||||
!ERROR: Unexpected ',' before ')' in format expression
|
||||
write(*,'(X,i3,)')
|
||||
|
||||
!ERROR: Unexpected ',' in format expression
|
||||
write(*,'(X,i3,,)')
|
||||
|
||||
!ERROR: Unexpected ',' in format expression
|
||||
!ERROR: Unexpected ',' before ')' in format expression
|
||||
write(*,'(X,i3,,,)')
|
||||
|
||||
!ERROR: Unexpected ',' before ')' in format expression
|
||||
write(*,'(X,(i3,))')
|
||||
|
||||
!ERROR: Unexpected '*' in format expression
|
||||
write(*,'(*)')
|
||||
|
||||
!ERROR: Expected integer constant in 'DT' edit descriptor v-list
|
||||
write(*,'(*(DT(+1,0,=1)))')
|
||||
|
||||
!ERROR: Expected integer constant in 'DT' edit descriptor v-list
|
||||
write(*,'(DT(1,0,+))')
|
||||
|
||||
!ERROR: Expected integer constant in 'DT' edit descriptor v-list
|
||||
write(*,'(DT(1,0,*))')
|
||||
|
||||
!ERROR: Expected ',' or ')' in 'DT' edit descriptor v-list
|
||||
write(*,'(DT(1,0,2*))')
|
||||
|
||||
!ERROR: Expected ',' or ')' in 'DT' edit descriptor v-list
|
||||
write(*,'(DT(1,0,2*,+,?))')
|
||||
|
||||
!ERROR: Expected integer constant in 'DT' edit descriptor v-list
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(DT(1,0,*)')
|
||||
|
||||
!ERROR: Expected ',' or ')' in 'DT' edit descriptor v-list
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(DT(1,0,2*,+,?)')
|
||||
|
||||
!ERROR: Unexpected '?' in format expression
|
||||
!ERROR: Unexpected ',' in format expression
|
||||
write(*,'(?,*(DT(+1,,1)))')
|
||||
|
||||
!ERROR: Repeat specifier before unlimited format item list
|
||||
!ERROR: Unlimited format item list must contain a data edit descriptor
|
||||
write(*,'(5X,3*(2(X)))')
|
||||
|
||||
!ERROR: Nested unlimited format item list
|
||||
write(*,'(D12.2,(*(F10.2)))')
|
||||
|
||||
!ERROR: Unlimited format item list must contain a data edit descriptor
|
||||
write(*,'(5X,*(2(X)))')
|
||||
|
||||
!ERROR: Character in format after unlimited format item list
|
||||
write(*,'(*(Z5),*(2F20.3))')
|
||||
|
||||
!ERROR: Character in format after unlimited format item list
|
||||
write(*,'(*(B5),*(2(I5)))')
|
||||
|
||||
!ERROR: Character in format after unlimited format item list
|
||||
write(*,'(*(I5), D12.7)')
|
||||
|
||||
!ERROR: 'I' edit descriptor 'm' value is greater than 'w' value
|
||||
write(*,'(07I02.0 3)')
|
||||
|
||||
!ERROR: 'Z' edit descriptor 'm' value is greater than 'w' value
|
||||
write(*,'(07Z02.4)')
|
||||
|
||||
!ERROR: 'I' edit descriptor repeat specifier must be positive
|
||||
write(*,'(0I2)')
|
||||
|
||||
!ERROR: List repeat specifier must be positive
|
||||
write(*,'(0(I2))')
|
||||
|
||||
!ERROR: List repeat specifier must be positive
|
||||
write(*,'(000(I2))')
|
||||
|
||||
!ERROR: List repeat specifier must be positive
|
||||
!ERROR: 'I' edit descriptor repeat specifier must be positive
|
||||
write(*,'(0(0I2))')
|
||||
|
||||
!ERROR: Kind parameter '_' character in format expression
|
||||
write(*,'(5_4X)')
|
||||
|
||||
!ERROR: Unexpected '+' in format expression
|
||||
write(*,'(I+3)')
|
||||
|
||||
!ERROR: Unexpected '-' in format expression
|
||||
write(*,'(I-3)')
|
||||
|
||||
!ERROR: Unexpected '-' in format expression
|
||||
write(*,'(I-3, X)')
|
||||
|
||||
!ERROR: 'X' edit descriptor must have a positive position value
|
||||
write(*,'(0X)')
|
||||
|
||||
!ERROR: Unexpected 'Y' in format expression
|
||||
write(*,'(XY)')
|
||||
|
||||
!ERROR: Unexpected 'Y' in format expression
|
||||
write(*,'(XYM)')
|
||||
|
||||
!ERROR: Unexpected 'M' in format expression
|
||||
write(*,'(MXY)')
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
write(*,'(XEN)')
|
||||
|
||||
!ERROR: Unexpected 'R' in format expression
|
||||
!ERROR: Unexpected 'R' in format expression
|
||||
write(*,"(RR, RV)")
|
||||
|
||||
!ERROR: Unexpected '-' in format expression
|
||||
!ERROR: Unexpected 'Y' in format expression
|
||||
write(*,'(I-3, XY)')
|
||||
|
||||
!ERROR: 'A' edit descriptor 'w' value must be positive
|
||||
write(*,'(A0)')
|
||||
|
||||
!ERROR: 'L' edit descriptor 'w' value must be positive
|
||||
write(*,'(L0)')
|
||||
|
||||
!ERROR: Expected 'G' edit descriptor '.d' value
|
||||
write(*,'(G4)')
|
||||
|
||||
!ERROR: Unexpected 'e' in 'G0' edit descriptor
|
||||
write(*,'(G0.8e)')
|
||||
|
||||
!ERROR: Unexpected 'e' in 'G0' edit descriptor
|
||||
write(*,'(G0.8e2)')
|
||||
|
||||
!ERROR: Kind parameter '_' character in format expression
|
||||
write(*,'(I5_4)')
|
||||
|
||||
!ERROR: Kind parameter '_' character in format expression
|
||||
write(*,'(5_4P)')
|
||||
|
||||
!ERROR: 'T' edit descriptor must have a positive position value
|
||||
write(*,'(T0)')
|
||||
|
||||
!ERROR: 'T' edit descriptor must have a positive position value
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(T0')
|
||||
|
||||
!ERROR: 'TL' edit descriptor must have a positive position value
|
||||
!ERROR: 'T' edit descriptor must have a positive position value
|
||||
!ERROR: Expected 'EN' edit descriptor 'd' value after '.'
|
||||
write(*,'(TL0,T0,EN12.)')
|
||||
|
||||
!ERROR: Expected 'EX' edit descriptor 'e' value after 'E'
|
||||
write(*,'(EX12.3e2, EX12.3e)')
|
||||
|
||||
!ERROR: 'TL' edit descriptor must have a positive position value
|
||||
!ERROR: 'T' edit descriptor must have a positive position value
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(TL00,T000')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(-')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(I3+')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(I3,-')
|
||||
|
||||
!ERROR: Unexpected integer constant
|
||||
write(*,'(3)')
|
||||
|
||||
!ERROR: Unexpected ',' before ')' in format expression
|
||||
write(*,'(3,)')
|
||||
|
||||
!ERROR: Unexpected ',' in format expression
|
||||
write(*,'(,3)')
|
||||
|
||||
!ERROR: Unexpected ',' before ')' in format expression
|
||||
write(*,'(,)')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(X')
|
||||
|
||||
!ERROR: Expected ',' or ')' in format expression
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(XX')
|
||||
|
||||
!ERROR: Unexpected '@' in format expression
|
||||
!ERROR: Unexpected '#' in format expression
|
||||
!ERROR: Unexpected '&' in format expression
|
||||
write(*,'(@@, # ,&&& &&, ignore error 4)')
|
||||
|
||||
!ERROR: Repeat specifier before 'TR' edit descriptor
|
||||
write(*,'(3TR0)')
|
||||
|
||||
!ERROR: 'TR' edit descriptor must have a positive position value
|
||||
write(*,'(TR0)')
|
||||
|
||||
!ERROR: Kind parameter '_' character in format expression
|
||||
write(*,'(3_4X)')
|
||||
|
||||
!ERROR: Kind parameter '_' character in format expression
|
||||
write(*,'(1_"abc")')
|
||||
|
||||
!ERROR: Unterminated string
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'("abc)')
|
||||
|
||||
!ERROR: Unexpected '_' in format expression
|
||||
write(*,'("abc"_1)')
|
||||
|
||||
!ERROR: Unexpected '@' in format expression
|
||||
write(*,'(3Habc, 3@, X)')
|
||||
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(4Habc)')
|
||||
|
||||
!ERROR: Unterminated 'H' edit descriptor
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(5Habc)')
|
||||
|
||||
!ERROR: Unterminated 'H' edit descriptor
|
||||
!ERROR: Unterminated format expression
|
||||
write(*,'(50Habc)')
|
||||
|
||||
!ERROR: Integer overflow in format expression
|
||||
write(*,'(9876543210987654321X)')
|
||||
|
||||
!ERROR: Integer overflow in format expression
|
||||
write(*,'(98765432109876543210X)')
|
||||
|
||||
!ERROR: Integer overflow in format expression
|
||||
write(*,'(I98765432109876543210)')
|
||||
|
||||
!ERROR: Integer overflow in format expression
|
||||
write(*,'(45I20.98765432109876543210, 45I20)')
|
||||
|
||||
!ERROR: Integer overflow in format expression
|
||||
write(*,'(45' // ' I20.9876543' // '2109876543210, 45I20)')
|
||||
|
||||
!ERROR: Repeat specifier before '$' edit descriptor
|
||||
write(*,'(7$)')
|
||||
end
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
! 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.
|
||||
|
||||
!ERROR: String edit descriptor in READ format expression
|
||||
read(*,'("abc")')
|
||||
|
||||
!ERROR: String edit descriptor in READ format expression
|
||||
!ERROR: Unterminated format expression
|
||||
read(*,'("abc)')
|
||||
|
||||
!ERROR: 'H' edit descriptor in READ format expression
|
||||
read(*,'(3Habc)')
|
||||
|
||||
!ERROR: 'H' edit descriptor in READ format expression
|
||||
!ERROR: Unterminated format expression
|
||||
read(*,'(5Habc)')
|
||||
|
||||
!ERROR: 'I' edit descriptor 'w' value must be positive
|
||||
read(*,'(I0)')
|
||||
end
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! 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.
|
||||
|
||||
!OPTIONS: -Mstandard
|
||||
|
||||
write(*, '(B0)')
|
||||
write(*, '(B3)')
|
||||
|
||||
!WARNING: Expected 'B' edit descriptor 'w' value
|
||||
write(*, '(B)')
|
||||
|
||||
!WARNING: Expected 'EN' edit descriptor 'w' value
|
||||
!WARNING: Non-standard '$' edit descriptor
|
||||
write(*, '(EN,$)')
|
||||
|
||||
!WARNING: Expected 'G' edit descriptor 'w' value
|
||||
write(*, '(3G)')
|
||||
|
||||
!WARNING: Non-standard '\' edit descriptor
|
||||
write(*,'(A, \)') 'Hello'
|
||||
|
||||
!WARNING: 'X' edit descriptor must have a positive position value
|
||||
write(*, '(X)')
|
||||
|
||||
!WARNING: Legacy 'H' edit descriptor
|
||||
write(*, '(3Habc)')
|
||||
end
|
||||
Loading…
Reference in New Issue