[flang-commits] [flang] c963757 - [flang] Implement nonstandard OPEN statement CARRIAGECONTROL specifier
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Sep 2 13:08:39 PDT 2020
Author: peter klausler
Date: 2020-09-02T13:07:45-07:00
New Revision: c963757783d7cd8596d7f9cd814f01338458c496
URL: https://github.com/llvm/llvm-project/commit/c963757783d7cd8596d7f9cd814f01338458c496
DIFF: https://github.com/llvm/llvm-project/commit/c963757783d7cd8596d7f9cd814f01338458c496.diff
LOG: [flang] Implement nonstandard OPEN statement CARRIAGECONTROL specifier
Differential Revision: https://reviews.llvm.org/D87052
Added:
Modified:
flang/docs/Extensions.md
flang/docs/f2018-grammar.txt
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Common/Fortran.h
flang/include/flang/Parser/parse-tree.h
flang/lib/Lower/IO.cpp
flang/lib/Parser/io-parsers.cpp
flang/lib/Semantics/check-io.cpp
flang/runtime/io-api.cpp
flang/runtime/io-api.h
flang/runtime/io-stmt.cpp
flang/test/Semantics/io01.f90
flang/test/Semantics/io05.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index a3260400a9bf..027927f67dfd 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -56,6 +56,7 @@ Extensions, deletions, and legacy features supported by default
* `NAME=` as synonym for `FILE=`
* Data edit descriptors without width or other details
* `D` lines in fixed form as comments or debug code
+* `CARRIAGECONTROL=` on the OPEN and INQUIRE statements
* `CONVERT=` on the OPEN and INQUIRE statements
* `DISPOSE=` on the OPEN and INQUIRE statements
* Leading semicolons are ignored before any statement that
diff --git a/flang/docs/f2018-grammar.txt b/flang/docs/f2018-grammar.txt
index 2de8cdfc1b8f..9b2819d69c72 100644
--- a/flang/docs/f2018-grammar.txt
+++ b/flang/docs/f2018-grammar.txt
@@ -577,7 +577,8 @@ R1205 connect-spec ->
POSITION = scalar-default-char-expr | RECL = scalar-int-expr |
ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
STATUS = scalar-default-char-expr
- @ | CONVERT = scalar-default-char-expr
+ @ | CARRIAGECONTROL = scalar-default-char-expr
+ | CONVERT = scalar-default-char-expr
| DISPOSE = scalar-default-char-expr
R1206 file-name-expr -> scalar-default-char-expr
R1207 iomsg-variable -> scalar-default-char-variable
@@ -657,7 +658,8 @@ R1231 inquire-spec ->
STREAM = scalar-default-char-variable |
STATUS = scalar-default-char-variable |
WRITE = scalar-default-char-variable
- @ | CONVERT = scalar-default-char-expr
+ @ | CARRIAGECONTROL = scalar-default-char-expr
+ | CONVERT = scalar-default-char-expr
| DISPOSE = scalar-default-char-expr
R1301 format-stmt -> FORMAT format-specification
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index ebf7a8d9d623..23c2e95fd564 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -22,14 +22,14 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
DoubleComplex, Byte, StarKind, QuadPrecision, SlashInitialization,
TripletInArrayConstructor, MissingColons, SignedComplexLiteral,
OldStyleParameter, ComplexConstructor, PercentLOC, SignedPrimary, FileName,
- Convert, Dispose, IOListLeadingComma, AbbreviatedEditDescriptor,
- ProgramParentheses, PercentRefAndVal, OmitFunctionDummies, CrayPointer,
- Hollerith, ArithmeticIF, Assign, AssignedGOTO, Pause, OpenACC, OpenMP,
- CruftAfterAmpersand, ClassicCComments, AdditionalFormats, BigIntLiterals,
- RealDoControls, EquivalenceNumericWithCharacter, AdditionalIntrinsics,
- AnonymousParents, OldLabelDoEndStatements, LogicalIntegerAssignment,
- EmptySourceFile, ProgramReturn, ImplicitNoneTypeNever,
- ImplicitNoneTypeAlways)
+ Carriagecontrol, Convert, Dispose, IOListLeadingComma,
+ AbbreviatedEditDescriptor, ProgramParentheses, PercentRefAndVal,
+ OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF, Assign,
+ AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand, ClassicCComments,
+ AdditionalFormats, BigIntLiterals, RealDoControls,
+ EquivalenceNumericWithCharacter, AdditionalIntrinsics, AnonymousParents,
+ OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
+ ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h
index df6b27c8ce3b..5d5ab324e826 100644
--- a/flang/include/flang/Common/Fortran.h
+++ b/flang/include/flang/Common/Fortran.h
@@ -52,6 +52,7 @@ ENUM_CLASS(IoSpecKind, Access, Action, Advance, Asynchronous, Blank, Decimal,
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,
+ Carriagecontrol, // nonstandard
Convert, // nonstandard
Dispose, // nonstandard
)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 7f9984bc5048..166e573b5cec 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -2549,7 +2549,8 @@ using FileNameExpr = ScalarDefaultCharExpr;
// POSITION = scalar-default-char-expr | RECL = scalar-int-expr |
// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
// STATUS = scalar-default-char-expr
-// @ | CONVERT = scalar-default-char-variable
+// @ | CARRIAGECONTROL = scalar-default-char-variable
+// | CONVERT = scalar-default-char-variable
// | DISPOSE = scalar-default-char-variable
WRAPPER_CLASS(StatusExpr, ScalarDefaultCharExpr);
WRAPPER_CLASS(ErrLabel, Label);
@@ -2559,7 +2560,7 @@ struct ConnectSpec {
struct CharExpr {
ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
Encoding, Form, Pad, Position, Round, Sign,
- /* extensions: */ Convert, Dispose)
+ /* extensions: */ Carriagecontrol, Convert, Dispose)
TUPLE_CLASS_BOILERPLATE(CharExpr);
std::tuple<Kind, ScalarDefaultCharExpr> t;
};
@@ -2767,7 +2768,8 @@ WRAPPER_CLASS(FlushStmt, std::list<PositionOrFlushSpec>);
// STATUS = scalar-default-char-variable |
// UNFORMATTED = scalar-default-char-variable |
// WRITE = scalar-default-char-variable
-// @ | CONVERT = scalar-default-char-variable
+// @ | CARRIAGECONTROL = scalar-default-char-variable
+// | CONVERT = scalar-default-char-variable
// | DISPOSE = scalar-default-char-variable
struct InquireSpec {
UNION_CLASS_BOILERPLATE(InquireSpec);
@@ -2775,7 +2777,7 @@ struct InquireSpec {
ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
Direct, Encoding, Form, Formatted, Iomsg, Name, Pad, Position, Read,
Readwrite, Round, Sequential, Sign, Stream, Status, Unformatted, Write,
- /* extensions: */ Convert, Dispose)
+ /* extensions: */ Carriagecontrol, Convert, Dispose)
TUPLE_CLASS_BOILERPLATE(CharVar);
std::tuple<Kind, ScalarDefaultCharVariable> t;
};
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 50dc5c80df6a..3f79b79e32ee 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -60,12 +60,12 @@ static constexpr std::tuple<
mkIOKey(OutputComplex64), mkIOKey(OutputComplex32), mkIOKey(OutputAscii),
mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical),
mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous),
- mkIOKey(SetEncoding), mkIOKey(SetForm), mkIOKey(SetPosition),
- mkIOKey(SetRecl), mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit),
- mkIOKey(GetSize), mkIOKey(GetIoLength), mkIOKey(GetIoMsg),
- mkIOKey(InquireCharacter), mkIOKey(InquireLogical),
- mkIOKey(InquirePendingId), mkIOKey(InquireInteger64),
- mkIOKey(EndIoStatement)>
+ mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm),
+ mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus),
+ mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
+ mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
+ mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
+ mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)>
newIOTable;
} // namespace Fortran::lower
@@ -599,6 +599,9 @@ mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>(
case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign:
ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder);
break;
+ case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol:
+ ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder);
+ break;
case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert:
llvm_unreachable("CONVERT not part of the runtime::io interface");
case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose:
diff --git a/flang/lib/Parser/io-parsers.cpp b/flang/lib/Parser/io-parsers.cpp
index 30f6db172c74..3615501a98ed 100644
--- a/flang/lib/Parser/io-parsers.cpp
+++ b/flang/lib/Parser/io-parsers.cpp
@@ -54,8 +54,9 @@ constexpr auto fileNameExpr{scalarDefaultCharExpr};
// POSITION = scalar-default-char-expr | RECL = scalar-int-expr |
// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
// STATUS = scalar-default-char-expr
-// @ | CONVERT = scalar-default-char-variable
-// @ | DISPOSE = scalar-default-char-variable
+// @ | CARRIAGECONTROL = scalar-default-char-variable
+// | CONVERT = scalar-default-char-variable
+// | DISPOSE = scalar-default-char-variable
constexpr auto statusExpr{construct<StatusExpr>(scalarDefaultCharExpr)};
constexpr auto errLabel{construct<ErrLabel>(label)};
@@ -107,6 +108,10 @@ TYPE_PARSER(first(construct<ConnectSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
"SIGN =" >> pure(ConnectSpec::CharExpr::Kind::Sign),
scalarDefaultCharExpr)),
construct<ConnectSpec>("STATUS =" >> statusExpr),
+ extension<LanguageFeature::Carriagecontrol>(construct<ConnectSpec>(
+ construct<ConnectSpec::CharExpr>("CARRIAGECONTROL =" >>
+ pure(ConnectSpec::CharExpr::Kind::Carriagecontrol),
+ scalarDefaultCharExpr))),
extension<LanguageFeature::Convert>(
construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
"CONVERT =" >> pure(ConnectSpec::CharExpr::Kind::Convert),
@@ -357,7 +362,8 @@ TYPE_CONTEXT_PARSER("FLUSH statement"_en_US,
// STREAM = scalar-default-char-variable |
// STATUS = scalar-default-char-variable |
// WRITE = scalar-default-char-variable
-// @ | CONVERT = scalar-default-char-variable
+// @ | CARRIAGECONTROL = scalar-default-char-variable
+// | CONVERT = scalar-default-char-variable
// | DISPOSE = scalar-default-char-variable
TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
construct<InquireSpec>("FILE =" >> fileNameExpr),
@@ -475,6 +481,11 @@ TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
construct<InquireSpec>("WRITE =" >>
construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Write),
scalarDefaultCharVariable)),
+ extension<LanguageFeature::Carriagecontrol>(
+ construct<InquireSpec>("CARRIAGECONTROL =" >>
+ construct<InquireSpec::CharVar>(
+ pure(InquireSpec::CharVar::Kind::Carriagecontrol),
+ scalarDefaultCharVariable))),
extension<LanguageFeature::Convert>(construct<InquireSpec>(
"CONVERT =" >> construct<InquireSpec::CharVar>(
pure(InquireSpec::CharVar::Kind::Convert),
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index d00f56c38042..26702f6c48bf 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -135,6 +135,9 @@ void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
case ParseKind::Sign:
specKind = IoSpecKind::Sign;
break;
+ case ParseKind::Carriagecontrol:
+ specKind = IoSpecKind::Carriagecontrol;
+ break;
case ParseKind::Convert:
specKind = IoSpecKind::Convert;
break;
@@ -152,6 +155,13 @@ void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
flags_.set(Flag::AccessStream, s == "STREAM");
}
CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
+ if (specKind == IoSpecKind::Carriagecontrol &&
+ (s == "FORTRAN" || s == "NONE")) {
+ context_.Say(parser::FindSourceLocation(spec),
+ "Unimplemented %s value '%s'"_err_en_US,
+ parser::ToUpperCaseLetters(common::EnumToString(specKind)),
+ *charConst);
+ }
}
}
@@ -378,6 +388,9 @@ void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
case ParseKind::Write:
specKind = IoSpecKind::Write;
break;
+ case ParseKind::Carriagecontrol:
+ specKind = IoSpecKind::Carriagecontrol;
+ break;
case ParseKind::Convert:
specKind = IoSpecKind::Convert;
break;
@@ -821,6 +834,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
{IoSpecKind::Status,
// Open values; Close values are {"DELETE", "KEEP"}.
{"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
+ {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
{IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
{IoSpecKind::Dispose, {"DELETE", "KEEP"}},
};
diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp
index 30f343773f90..18c3f8241f08 100644
--- a/flang/runtime/io-api.cpp
+++ b/flang/runtime/io-api.cpp
@@ -655,6 +655,31 @@ bool IONAME(SetAsynchronous)(
}
}
+bool IONAME(SetCarriagecontrol)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ auto *open{io.get_if<OpenStatementState>()};
+ if (!open) {
+ io.GetIoErrorHandler().Crash(
+ "SetCarriageControl() called when not in an OPEN statement");
+ }
+ static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0:
+ return true;
+ case 1:
+ case 2:
+ open->SignalError(IostatErrorInKeyword,
+ "Unimplemented CARRIAGECONTROL='%.*s'", static_cast<int>(length),
+ keyword);
+ return false;
+ default:
+ open->SignalError(IostatErrorInKeyword, "Invalid CARRIAGECONTROL='%.*s'",
+ static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
bool IONAME(SetConvert)(
Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
@@ -708,7 +733,7 @@ bool IONAME(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
io.GetIoErrorHandler().Crash(
- "SetEncoding() called when not in an OPEN statement");
+ "SetForm() called when not in an OPEN statement");
}
static const char *keywords[]{"FORMATTED", "UNFORMATTED", nullptr};
switch (IdentifyValue(keyword, length, keywords)) {
diff --git a/flang/runtime/io-api.h b/flang/runtime/io-api.h
index a38152d6ec1c..369013fee8bc 100644
--- a/flang/runtime/io-api.h
+++ b/flang/runtime/io-api.h
@@ -260,6 +260,8 @@ bool IONAME(SetAccess)(Cookie, const char *, std::size_t);
bool IONAME(SetAction)(Cookie, const char *, std::size_t);
// ASYNCHRONOUS=YES, NO
bool IONAME(SetAsynchronous)(Cookie, const char *, std::size_t);
+// CARRIAGECONTROL=LIST, FORTRAN, NONE
+bool IONAME(SetCarriagecontrol)(Cookie, const char *, std::size_t);
// CONVERT=NATIVE, LITTLE_ENDIAN, BIG_ENDIAN, or SWAP
bool IONAME(SetConvert)(Cookie, const char *, std::size_t);
// ENCODING=UTF-8, DEFAULT
diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp
index 8300b1ea3c27..9bf0284358b9 100644
--- a/flang/runtime/io-stmt.cpp
+++ b/flang/runtime/io-stmt.cpp
@@ -779,6 +779,9 @@ bool InquireUnitState::Inquire(
: unit().modes.editingFlags & blankZero ? "ZERO"
: "NULL";
break;
+ case HashInquiryKeyword("CARRIAGECONTROL"):
+ str = "LIST";
+ break;
case HashInquiryKeyword("CONVERT"):
str = unit().swapEndianness() ? "SWAP" : "NATIVE";
break;
@@ -976,6 +979,7 @@ bool InquireNoUnitState::Inquire(
case HashInquiryKeyword("ACTION"):
case HashInquiryKeyword("ASYNCHRONOUS"):
case HashInquiryKeyword("BLANK"):
+ case HashInquiryKeyword("CARRIAGECONTROL"):
case HashInquiryKeyword("CONVERT"):
case HashInquiryKeyword("DECIMAL"):
case HashInquiryKeyword("DELIM"):
@@ -1061,6 +1065,7 @@ bool InquireUnconnectedFileState::Inquire(
case HashInquiryKeyword("ACTION"):
case HashInquiryKeyword("ASYNCHRONOUS"):
case HashInquiryKeyword("BLANK"):
+ case HashInquiryKeyword("CARRIAGECONTROL"):
case HashInquiryKeyword("CONVERT"):
case HashInquiryKeyword("DECIMAL"):
case HashInquiryKeyword("DELIM"):
diff --git a/flang/test/Semantics/io01.f90 b/flang/test/Semantics/io01.f90
index 9828d4afe892..17b68e407407 100644
--- a/flang/test/Semantics/io01.f90
+++ b/flang/test/Semantics/io01.f90
@@ -62,6 +62,7 @@
open(81, convert=convert_(2), dispose=dispose_(2))
open(access='STREAM', 90) ! nonstandard
+ open (unit=91, file='xfile', carriagecontrol='list') ! nonstandard
!ERROR: OPEN statement must have a UNIT or NEWUNIT specifier
!ERROR: If ACCESS='DIRECT' appears, RECL must also appear
@@ -127,4 +128,10 @@
!ERROR: If NEWUNIT appears, FILE or STATUS='SCRATCH' must also appear
open(newunit=nn, status='old')
+
+ !ERROR: Unimplemented CARRIAGECONTROL value 'fortran'
+ open (unit=116, file='xfile', carriagecontrol='fortran') ! nonstandard
+
+ !ERROR: Invalid CARRIAGECONTROL value 'nonsense'
+ open (unit=116, file='xfile', carriagecontrol='nonsense') ! nonstandard
end
diff --git a/flang/test/Semantics/io05.f90 b/flang/test/Semantics/io05.f90
index ed6b77f7d4ad..666b200ad9a3 100644
--- a/flang/test/Semantics/io05.f90
+++ b/flang/test/Semantics/io05.f90
@@ -25,6 +25,7 @@
inquire(pending=v(5), file='abc')
inquire(10, id=id, pending=v(5))
inquire(10, id=const_id, pending=v(5))
+ inquire(10, carriagecontrol=c(1)) ! nonstandard
! using variable 'cv' multiple times seems to be allowed
inquire(file='abc', &
More information about the flang-commits
mailing list