[flang][runtime] Catch bad OPEN specifiers for unformatted files

When an OPEN statement has specifiers that are allowed only for
formatted files, detect an error when the file turns out to be
unformatted.

Fixes #153480.

Author: klausler

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

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<char> path_;
   std::size_t pathLength_{};
   Fortran::common::optional<bool> isUnformatted_;
+  Fortran::common::optional<bool> mustBeFormatted_;
   Fortran::common::optional<Access> access_;
 };
 

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<OpenStatementState>()}) {
+    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<OpenStatementState>()}) {
+    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<OpenStatementState>()}) {
+    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<OpenStatementState>()}) {
+    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<OpenStatementState>()}) {
+    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<OpenStatementState>()}) {
+    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

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();