[flang][runtime] Control stream truncation via runtime environment (#168415)

The ISO Fortran standards don't say whether a WRITE to a formatted
stream unit should truncate the unit if there has been any repositioning
(via POS= control list specifiers) to an earlier point in the stream.
But units with sequential records do truncate on writes after BACKSPACE
and REWIND statements, and many compilers (including this one) truncate
stream units too. Since some compilers don't truncate streams, this
patch adds an environment variable FORT_TRUNCATE_STREAM that can be set
to 0 to disable truncation and ease porting to flang-new of codes that
depend on that behavior.

Fixes https://github.com/llvm/llvm-project/issues/167569.

3 files changed, 17 insertions, 2 deletions

diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h
index b91cf629509a..72157fe4418e 100644
--- a/flang-rt/include/flang-rt/runtime/environment.h
+++ b/flang-rt/include/flang-rt/runtime/environment.h
@@ -73,6 +73,7 @@ struct ExecutionEnvironment {
   bool noStopMessage{false}; // NO_STOP_MESSAGE=1 inhibits "Fortran STOP"
   bool defaultUTF8{false}; // DEFAULT_UTF8
   bool checkPointerDeallocation{true}; // FORT_CHECK_POINTER_DEALLOCATION
+  bool truncateStream{true}; // FORT_TRUNCATE_STREAM
 
   enum InternalDebugging { WorkQueue = 1 };
   int internalDebugging{0}; // FLANG_RT_DEBUG
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index 2a2e19f9f17e..be4f7308ab02 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -141,6 +141,17 @@ void ExecutionEnvironment::Configure(int ac, const char *av[],
     }
   }
 
+  if (auto *x{std::getenv("FORT_TRUNCATE_STREAM")}) {
+    char *end;
+    auto n{std::strtol(x, &end, 10)};
+    if (n >= 0 && n <= 1 && *end == '\0') {
+      truncateStream = n != 0;
+    } else {
+      std::fprintf(stderr,
+          "Fortran runtime: FORT_TRUNCATE_STREAM=%s is invalid; ignored\n", x);
+    }
+  }
+
   if (auto *x{std::getenv("NO_STOP_MESSAGE")}) {
     char *end;
     auto n{std::strtol(x, &end, 10)};
diff --git a/flang-rt/lib/runtime/unit.cpp b/flang-rt/lib/runtime/unit.cpp
index 549fbeaca05b..bc98cfdcbe5d 100644
--- a/flang-rt/lib/runtime/unit.cpp
+++ b/flang-rt/lib/runtime/unit.cpp
@@ -783,8 +783,11 @@ void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) {
   frameOffsetInFile_ += recordOffsetInFrame_ + furthestPositionInRecord;
   recordOffsetInFrame_ = 0;
   FlushOutput(handler);
-  Truncate(frameOffsetInFile_, handler);
-  TruncateFrame(frameOffsetInFile_, handler);
+  if (access != Access::Stream || executionEnvironment.truncateStream) {
+    // Stream output after positioning truncates with some compilers.
+    Truncate(frameOffsetInFile_, handler);
+    TruncateFrame(frameOffsetInFile_, handler);
+  }
   BeginRecord();
   impliedEndfile_ = false;
   anyWriteSinceLastPositioning_ = false;