[flang] Implement nonstandard OPEN statement CARRIAGECONTROL specifier

Differential Revision: https://reviews.llvm.org/D87052
This commit is contained in:
peter klausler 2020-09-02 10:37:48 -07:00
parent 5b4744b2c5
commit c963757783
13 changed files with 98 additions and 24 deletions

View file

@ -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

View file

@ -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

View file

@ -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>;

View file

@ -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
)

View file

@ -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;
};

View file

@ -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:

View file

@ -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),

View file

@ -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"}},
};

View file

@ -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)) {

View file

@ -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

View file

@ -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"):

View file

@ -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

View file

@ -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', &