diff --git a/flang-rt/include/flang-rt/runtime/io-error.h b/flang-rt/include/flang-rt/runtime/io-error.h index 1cef6a208f374..3e8401036f289 100644 --- a/flang-rt/include/flang-rt/runtime/io-error.h +++ b/flang-rt/include/flang-rt/runtime/io-error.h @@ -38,6 +38,9 @@ class IoErrorHandler : public Terminator { RT_API_ATTRS bool InError() const { return ioStat_ != IostatOk || pendingError_ != IostatOk; } + RT_API_ATTRS bool HasErrorRecovery() const { + return (flags_ & (hasIoStat | hasErr)) != 0; + } // For I/O statements that detect fatal errors in their // Begin...() API routines before it is known whether they diff --git a/flang-rt/include/flang-rt/runtime/io-stmt.h b/flang-rt/include/flang-rt/runtime/io-stmt.h index 9f71d515cb615..7693b60cccfc9 100644 --- a/flang-rt/include/flang-rt/runtime/io-stmt.h +++ b/flang-rt/include/flang-rt/runtime/io-stmt.h @@ -729,6 +729,9 @@ class OpenStatementState : public ExternalIoStatementBase { RT_API_ATTRS void set_isUnformatted(bool yes = true) { isUnformatted_ = yes; } // FORM= + RT_API_ATTRS void set_mustBeFormatted(bool yes = true) { + mustBeFormatted_ = yes; + } RT_API_ATTRS void CompleteOperation(); RT_API_ATTRS int EndIoStatement(); @@ -743,6 +746,7 @@ class OpenStatementState : public ExternalIoStatementBase { OwningPtr path_; std::size_t pathLength_{}; Fortran::common::optional isUnformatted_; + Fortran::common::optional mustBeFormatted_; Fortran::common::optional access_; }; diff --git a/flang-rt/lib/runtime/io-api.cpp b/flang-rt/lib/runtime/io-api.cpp index 6af0121437cd5..c7c15e77c0770 100644 --- a/flang-rt/lib/runtime/io-api.cpp +++ b/flang-rt/lib/runtime/io-api.cpp @@ -528,6 +528,9 @@ bool IODEF(SetAdvance)(Cookie cookie, const char *keyword, std::size_t length) { bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } static const char *keywords[]{"NULL", "ZERO", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { case 0: @@ -545,6 +548,9 @@ bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) { bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } static const char *keywords[]{"COMMA", "POINT", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { case 0: @@ -562,6 +568,9 @@ bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) { bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } static const char *keywords[]{"APOSTROPHE", "QUOTE", "NONE", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { case 0: @@ -583,6 +592,9 @@ bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) { bool IODEF(SetPad)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; IoErrorHandler &handler{io.GetIoErrorHandler()}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } io.mutableModes().pad = YesOrNo(keyword, length, "PAD", handler); return !handler.InError(); } @@ -617,6 +629,9 @@ bool IODEF(SetRec)(Cookie cookie, std::int64_t rec) { bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE", "PROCESSOR_DEFINED", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { @@ -647,6 +662,9 @@ bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) { bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; + if (auto *open{io.get_if()}) { + open->set_mustBeFormatted(); + } static const char *keywords[]{ "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { @@ -784,6 +802,7 @@ bool IODEF(SetCarriagecontrol)( io.GetIoErrorHandler().Crash( "SetCarriageControl() called after GetNewUnit() for an OPEN statement"); } + open->set_mustBeFormatted(); static const char *keywords[]{"LIST", "FORTRAN", "NONE", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { case 0: @@ -840,6 +859,7 @@ bool IODEF(SetEncoding)( io.GetIoErrorHandler().Crash( "SetEncoding() called after GetNewUnit() for an OPEN statement"); } + open->set_mustBeFormatted(); // Allow the encoding to be changed on an open unit -- it's // useful and safe. static const char *keywords[]{"UTF-8", "DEFAULT", nullptr}; @@ -872,10 +892,10 @@ bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) { } static const char *keywords[]{"FORMATTED", "UNFORMATTED", "BINARY", nullptr}; switch (IdentifyValue(keyword, length, keywords)) { - case 0: + case 0: // FORM='FORMATTED' open->set_isUnformatted(false); break; - case 1: + case 1: // FORM='UNFORMATTED' open->set_isUnformatted(true); break; case 2: // legacy FORM='BINARY' means an unformatted stream diff --git a/flang-rt/lib/runtime/io-stmt.cpp b/flang-rt/lib/runtime/io-stmt.cpp index e08088fab4311..c462f60b6b019 100644 --- a/flang-rt/lib/runtime/io-stmt.cpp +++ b/flang-rt/lib/runtime/io-stmt.cpp @@ -352,6 +352,17 @@ void OpenStatementState::CompleteOperation() { // Set default format (C.7.4 point 2). unit().isUnformatted = unit().access != Access::Sequential; } + if (unit().isUnformatted.value_or(false) && mustBeFormatted_) { + // This is an unformatted unit, but the OPEN statement contained at least + // one specifier that is not permitted unless the unit is formatted + // (e.g., BLANK=). Programs that want to detect this error (i.e., tests) + // should be informed about it, but don't crash the program otherwise + // since most other compilers let it slide. + if (HasErrorRecovery()) { + SignalError("FORM='UNFORMATTED' is not allowed with OPEN specifiers that " + "apply only to formatted units"); + } + } if (!wasExtant_ && InError()) { // Release the new unit on failure set_destroy();