[flang] Drill down to a working implementation of the APIs for an
authorpeter klausler <pklausler@nvidia.com>
Thu, 16 Jan 2020 21:51:25 +0000 (13:51 -0800)
committerpeter klausler <pklausler@nvidia.com>
Fri, 24 Jan 2020 20:33:47 +0000 (12:33 -0800)
internal formatted WRITE with no data list items.

Improve argument names in io-api.h

Bump up error number to not conflict with errno values

Use Fortran::runtime::io namespace

Add wrapper around malloc/free, allow use of unique_ptr with wrapper

IoErrorHandler

Revamp FormatContext, use virtual member functions

Update comment syntax, allow for old C

12HHELLO, WORLD

Remove files not yet ready for review

Use std::forward

Fix gcc build warnings

Fix redundant filename in license boilerplate

Reduce runtime dependence on compiler binary libraries, fixing shared lib builds

Original-commit: flang-compiler/f18@839a91f1d699cd839767407bcdb1e384f2d2b730
Reviewed-on: https://github.com/flang-compiler/f18/pull/946

22 files changed:
flang/include/flang/ISO_Fortran_binding.h
flang/runtime/CMakeLists.txt
flang/runtime/entry-names.h
flang/runtime/format.cc
flang/runtime/format.h
flang/runtime/io-api.cc [new file with mode: 0644]
flang/runtime/io-api.h
flang/runtime/io-error.cc [new file with mode: 0644]
flang/runtime/io-error.h [new file with mode: 0644]
flang/runtime/io-stmt.cc [new file with mode: 0644]
flang/runtime/io-stmt.h [new file with mode: 0644]
flang/runtime/magic-numbers.h
flang/runtime/main.cc
flang/runtime/main.h
flang/runtime/memory.cc [new file with mode: 0644]
flang/runtime/memory.h [new file with mode: 0644]
flang/runtime/terminator.cc
flang/runtime/terminator.h
flang/runtime/transformational.cc
flang/test/runtime/CMakeLists.txt
flang/test/runtime/format.cc
flang/test/runtime/hello.cc [new file with mode: 0644]

index 0a01481..b54f778 100644 (file)
@@ -30,8 +30,9 @@ inline namespace Fortran_2018 {
 #define CFI_MAX_RANK 15
 typedef unsigned char CFI_rank_t;
 
-// This type is probably larger than a default Fortran INTEGER
-// and should be used for all array indexing and loop bound calculations.
+/* This type is probably larger than a default Fortran INTEGER
+ * and should be used for all array indexing and loop bound calculations.
+ */
 typedef ptrdiff_t CFI_index_t;
 
 typedef unsigned char CFI_attribute_t;
index 523c7aa..3253f4b 100644 (file)
@@ -11,7 +11,11 @@ add_library(FortranRuntime
   derived-type.cc
   descriptor.cc
   format.cc
+  io-api.cc
+  io-error.cc
+  io-stmt.cc
   main.cc
+  memory.cc
   stop.cc
   terminator.cc
   transformational.cc
@@ -19,5 +23,6 @@ add_library(FortranRuntime
 )
 
 target_link_libraries(FortranRuntime
-  FortranEvaluate
+  FortranCommon
+  FortranDecimal
 )
index db80fee..e2581ca 100644 (file)
@@ -16,7 +16,7 @@
 // runtime library must change in some way that breaks backward compatibility.
 
 #ifndef RTNAME
-#define PREFIX _Fortran
-#define REVISION A
-#define RTNAME(name) PREFIX##REVISION##name
+#define NAME_WITH_PREFIX_AND_REVISION(prefix, revision, name) \
+  prefix##revision##name
+#define RTNAME(name) NAME_WITH_PREFIX_AND_REVISION(_Fortran, A, name)
 #endif
index b7a175d..9324d15 100644 (file)
@@ -7,23 +7,43 @@
 //===----------------------------------------------------------------------===//
 
 #include "format.h"
+#include "io-stmt.h"
 #include "../lib/common/format.h"
 #include "../lib/decimal/decimal.h"
 #include <limits>
 
-namespace Fortran::runtime {
+namespace Fortran::runtime::io {
+
+// Default FormatContext virtual member functions
+void FormatContext::Emit(const char *, std::size_t) {
+  Crash("Cannot emit data from this FORMAT string");
+}
+void FormatContext::Emit(const char16_t *, std::size_t) {
+  Crash("Cannot emit data from this FORMAT string");
+}
+void FormatContext::Emit(const char32_t *, std::size_t) {
+  Crash("Cannot emit data from this FORMAT string");
+}
+void FormatContext::HandleSlash(int) {
+  Crash("A / control edit descriptor may not appear in this FORMAT string");
+}
+void FormatContext::HandleAbsolutePosition(int) {
+  Crash("A Tn control edit descriptor may not appear in this FORMAT string");
+}
+void FormatContext::HandleRelativePosition(int) {
+  Crash("An nX, TLn, or TRn control edit descriptor may not appear in this "
+        "FORMAT string");
+}
 
 template<typename CHAR>
-FormatControl<CHAR>::FormatControl(FormatContext &context, const CHAR *format,
-    std::size_t formatLength, const MutableModes &modes, int maxHeight)
-  : context_{context}, modes_{modes}, maxHeight_{static_cast<std::uint8_t>(
-                                          maxHeight)},
-    format_{format}, formatLength_{static_cast<int>(formatLength)} {
+FormatControl<CHAR>::FormatControl(Terminator &terminator, const CHAR *format,
+    std::size_t formatLength, int maxHeight)
+  : maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
+    formatLength_{static_cast<int>(formatLength)} {
   // The additional two items are for the whole string and a
   // repeated non-parenthesized edit descriptor.
   if (maxHeight > std::numeric_limits<std::int8_t>::max()) {
-    context_.terminator.Crash(
-        "internal Fortran runtime error: maxHeight %d", maxHeight);
+    terminator.Crash("internal Fortran runtime error: maxHeight %d", maxHeight);
   }
   stack_[0].start = offset_;
   stack_[0].remaining = Iteration::unlimited;  // 13.4(8)
@@ -43,38 +63,23 @@ int FormatControl<CHAR>::GetMaxParenthesisNesting(
   return validator.maxNesting();
 }
 
-static void HandleCharacterLiteral(
-    FormatContext &context, const char *str, std::size_t chars) {
-  if (context.handleCharacterLiteral1) {
-    context.handleCharacterLiteral1(str, chars);
-  }
-}
-
-static void HandleCharacterLiteral(
-    FormatContext &context, const char16_t *str, std::size_t chars) {
-  if (context.handleCharacterLiteral2) {
-    context.handleCharacterLiteral2(str, chars);
-  }
-}
-
-static void HandleCharacterLiteral(
-    FormatContext &context, const char32_t *str, std::size_t chars) {
-  if (context.handleCharacterLiteral4) {
-    context.handleCharacterLiteral4(str, chars);
-  }
-}
-
-template<typename CHAR> int FormatControl<CHAR>::GetIntField(CHAR firstCh) {
+template<typename CHAR>
+int FormatControl<CHAR>::GetIntField(Terminator &terminator, CHAR firstCh) {
   CHAR ch{firstCh ? firstCh : PeekNext()};
-  if (ch < '0' || ch > '9') {
-    context_.terminator.Crash(
+  if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
+    terminator.Crash(
         "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
   }
   int result{0};
+  bool negate{ch == '-'};
+  if (negate) {
+    firstCh = '\0';
+    ch = PeekNext();
+  }
   while (ch >= '0' && ch <= '9') {
     if (result >
         std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
-      context_.terminator.Crash("FORMAT integer field out of range");
+      terminator.Crash("FORMAT integer field out of range");
     }
     result = 10 * result + ch - '0';
     if (firstCh) {
@@ -84,11 +89,15 @@ template<typename CHAR> int FormatControl<CHAR>::GetIntField(CHAR firstCh) {
     }
     ch = PeekNext();
   }
+  if (negate && (result *= -1) > 0) {
+    terminator.Crash("FORMAT integer field out of range");
+  }
   return result;
 }
 
-static void HandleControl(MutableModes &modes, std::uint16_t &scale,
-    FormatContext &context, char ch, char next, int n) {
+static void HandleControl(
+    FormatContext &context, std::uint16_t &scale, char ch, char next, int n) {
+  MutableModes &modes{context.mutableModes()};
   switch (ch) {
   case 'B':
     if (next == 'Z') {
@@ -130,9 +139,7 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
     break;
   case 'X':
     if (!next) {
-      if (context.handleRelativePosition) {
-        context.handleRelativePosition(n);
-      }
+      context.HandleRelativePosition(n);
       return;
     }
     break;
@@ -148,25 +155,20 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
     break;
   case 'T': {
     if (!next) {  // Tn
-      if (context.handleAbsolutePosition) {
-        context.handleAbsolutePosition(n);
-      }
+      context.HandleAbsolutePosition(n);
       return;
     }
     if (next == 'L' || next == 'R') {  // TLn & TRn
-      if (context.handleRelativePosition) {
-        context.handleRelativePosition(next == 'L' ? -n : n);
-      }
+      context.HandleRelativePosition(next == 'L' ? -n : n);
       return;
     }
   } break;
   default: break;
   }
   if (next) {
-    context.terminator.Crash(
-        "Unknown '%c%c' edit descriptor in FORMAT", ch, next);
+    context.Crash("Unknown '%c%c' edit descriptor in FORMAT", ch, next);
   } else {
-    context.terminator.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
+    context.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
   }
 }
 
@@ -174,35 +176,34 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
 // Handles all repetition counts and control edit descriptors.
 // Generally assumes that the format string has survived the common
 // format validator gauntlet.
-template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
+template<typename CHAR>
+int FormatControl<CHAR>::CueUpNextDataEdit(FormatContext &context, bool stop) {
   int unlimitedLoopCheck{-1};
   while (true) {
     std::optional<int> repeat;
     bool unlimited{false};
-    CHAR ch{Capitalize(GetNextChar())};
+    CHAR ch{Capitalize(GetNextChar(context))};
     while (ch == ',' || ch == ':') {
       // Skip commas, and don't complain if they're missing; the format
       // validator does that.
       if (stop && ch == ':') {
         return 0;
       }
-      ch = Capitalize(GetNextChar());
+      ch = Capitalize(GetNextChar(context));
     }
-    if (ch >= '0' && ch <= '9') {  // repeat count
-      repeat = GetIntField(ch);
-      ch = GetNextChar();
+    if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) {
+      repeat = GetIntField(context, ch);
+      ch = GetNextChar(context);
     } else if (ch == '*') {
       unlimited = true;
-      ch = GetNextChar();
+      ch = GetNextChar(context);
       if (ch != '(') {
-        context_.terminator.Crash(
-            "Invalid FORMAT: '*' may appear only before '('");
+        context.Crash("Invalid FORMAT: '*' may appear only before '('");
       }
     }
     if (ch == '(') {
       if (height_ >= maxHeight_) {
-        context_.terminator.Crash(
-            "FORMAT stack overflow: too many nested parentheses");
+        context.Crash("FORMAT stack overflow: too many nested parentheses");
       }
       stack_[height_].start = offset_ - 1;  // the '('
       if (unlimited || height_ == 0) {
@@ -218,15 +219,18 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
       }
       ++height_;
     } else if (height_ == 0) {
-      context_.terminator.Crash("FORMAT lacks initial '('");
+      context.Crash("FORMAT lacks initial '('");
     } else if (ch == ')') {
-      if (height_ == 1 && stop) {
-        return 0;  // end of FORMAT and no data items remain
+      if (height_ == 1) {
+        if (stop) {
+          return 0;  // end of FORMAT and no data items remain
+        }
+        context.HandleSlash();  // implied / before rightmost )
       }
       if (stack_[height_ - 1].remaining == Iteration::unlimited) {
         offset_ = stack_[height_ - 1].start + 1;
         if (offset_ == unlimitedLoopCheck) {
-          context_.terminator.Crash(
+          context.Crash(
               "Unlimited repetition in FORMAT lacks data edit descriptors");
         }
       } else if (stack_[height_ - 1].remaining-- > 0) {
@@ -242,8 +246,7 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
         ++offset_;
       }
       if (offset_ >= formatLength_) {
-        context_.terminator.Crash(
-            "FORMAT missing closing quote on character literal");
+        context.Crash("FORMAT missing closing quote on character literal");
       }
       ++offset_;
       std::size_t chars{
@@ -255,14 +258,13 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
       } else {
         --chars;
       }
-      HandleCharacterLiteral(context_, format_ + start, chars);
+      context.Emit(format_ + start, chars);
     } else if (ch == 'H') {
       // 9HHOLLERITH
       if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
-        context_.terminator.Crash("Invalid width on Hollerith in FORMAT");
+        context.Crash("Invalid width on Hollerith in FORMAT");
       }
-      HandleCharacterLiteral(
-          context_, format_ + offset_, static_cast<std::size_t>(*repeat));
+      context.Emit(format_ + offset_, static_cast<std::size_t>(*repeat));
       offset_ += *repeat;
     } else if (ch >= 'A' && ch <= 'Z') {
       int start{offset_ - 1};
@@ -276,35 +278,33 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
                   ch == 'F' || ch == 'D' || ch == 'G'))) {
         // Data edit descriptor found
         offset_ = start;
-        return repeat ? *repeat : 1;
+        return repeat && *repeat > 0 ? *repeat : 1;
       } else {
         // Control edit descriptor
         if (ch == 'T') {  // Tn, TLn, TRn
-          repeat = GetIntField();
+          repeat = GetIntField(context);
         }
-        HandleControl(modes_, scale_, context_, static_cast<char>(ch),
-            static_cast<char>(next), repeat ? *repeat : 1);
+        HandleControl(context, scale_, static_cast<char>(ch),
+            static_cast<char>(next), repeat && *repeat > 0 ? *repeat : 1);
       }
     } else if (ch == '/') {
-      if (context_.handleSlash) {
-        context_.handleSlash();
-      }
+      context.HandleSlash(repeat && *repeat > 0 ? *repeat : 1);
     } else {
-      context_.terminator.Crash(
-          "Invalid character '%c' in FORMAT", static_cast<char>(ch));
+      context.Crash("Invalid character '%c' in FORMAT", static_cast<char>(ch));
     }
   }
 }
 
 template<typename CHAR>
-void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
+void FormatControl<CHAR>::GetNext(
+    FormatContext &context, DataEdit &edit, int maxRepeat) {
 
   // TODO: DT editing
 
   // Return the next data edit descriptor
-  int repeat{CueUpNextDataEdit()};
+  int repeat{CueUpNextDataEdit(context)};
   auto start{offset_};
-  edit.descriptor = static_cast<char>(Capitalize(GetNextChar()));
+  edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
   if (edit.descriptor == 'E') {
     edit.variation = static_cast<char>(Capitalize(PeekNext()));
     if (edit.variation >= 'A' && edit.variation <= 'Z') {
@@ -316,15 +316,15 @@ void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
     edit.variation = '\0';
   }
 
-  edit.width = GetIntField();
-  edit.modes = modes_;
+  edit.width = GetIntField(context);
+  edit.modes = context.mutableModes();
   if (PeekNext() == '.') {
     ++offset_;
-    edit.digits = GetIntField();
+    edit.digits = GetIntField(context);
     CHAR ch{PeekNext()};
     if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
       ++offset_;
-      edit.expoDigits = GetIntField();
+      edit.expoDigits = GetIntField(context);
     } else {
       edit.expoDigits.reset();
     }
@@ -355,8 +355,9 @@ void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
   }
 }
 
-template<typename CHAR> void FormatControl<CHAR>::FinishOutput() {
-  CueUpNextDataEdit(true /* stop at colon or end of FORMAT */);
+template<typename CHAR>
+void FormatControl<CHAR>::FinishOutput(FormatContext &context) {
+  CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
 }
 
 template class FormatControl<char>;
index 94025f6..1f576d2 100644 (file)
@@ -16,7 +16,7 @@
 #include <cinttypes>
 #include <optional>
 
-namespace Fortran::runtime {
+namespace Fortran::runtime::io {
 
 enum EditingFlags {
   blankZero = 1,  // BLANK=ZERO or BZ edit
@@ -27,6 +27,8 @@ enum EditingFlags {
 struct MutableModes {
   std::uint8_t editingFlags{0};  // BN, DP, SS
   common::RoundingMode roundingMode{common::RoundingMode::TiesToEven};  // RN
+  bool pad{false};  // PAD= mode on READ
+  char delim{'\0'};  // DELIM=
 };
 
 // A single edit descriptor extracted from a FORMAT
@@ -40,14 +42,20 @@ struct DataEdit {
   int repeat{1};
 };
 
-struct FormatContext {
-  Terminator &terminator;
-  void (*handleCharacterLiteral1)(const char *, std::size_t){nullptr};
-  void (*handleCharacterLiteral2)(const char16_t *, std::size_t){nullptr};
-  void (*handleCharacterLiteral4)(const char32_t *, std::size_t){nullptr};
-  void (*handleSlash)(){nullptr};
-  void (*handleAbsolutePosition)(int){nullptr};  // Tn
-  void (*handleRelativePosition)(int){nullptr};  // nX, TRn, TLn (negated)
+class FormatContext : virtual public Terminator {
+public:
+  FormatContext() {}
+  explicit FormatContext(const MutableModes &modes) : mutableModes_{modes} {}
+  virtual void Emit(const char *, std::size_t);
+  virtual void Emit(const char16_t *, std::size_t);
+  virtual void Emit(const char32_t *, std::size_t);
+  virtual void HandleSlash(int = 1);
+  virtual void HandleRelativePosition(int);
+  virtual void HandleAbsolutePosition(int);
+  MutableModes &mutableModes() { return mutableModes_; }
+
+private:
+  MutableModes mutableModes_;
 };
 
 // Generates a sequence of DataEdits from a FORMAT statement or
@@ -55,8 +63,8 @@ struct FormatContext {
 // Errors are fatal.  See clause 13.4 in Fortran 2018 for background.
 template<typename CHAR = char> class FormatControl {
 public:
-  FormatControl(FormatContext &, const CHAR *format, std::size_t formatLength,
-      const MutableModes &initialModes, int maxHeight = maxMaxHeight);
+  FormatControl(Terminator &, const CHAR *format, std::size_t formatLength,
+      int maxHeight = maxMaxHeight);
 
   // Determines the max parenthesis nesting level by scanning and validating
   // the FORMAT string.
@@ -71,10 +79,10 @@ public:
 
   // Extracts the next data edit descriptor, handling control edit descriptors
   // along the way.
-  void GetNext(DataEdit &, int maxRepeat = 1);
+  void GetNext(FormatContext &, DataEdit &, int maxRepeat = 1);
 
   // Emit any remaining character literals after the last data item.
-  void FinishOutput();
+  void FinishOutput(FormatContext &);
 
 private:
   static constexpr std::uint8_t maxMaxHeight{100};
@@ -94,21 +102,21 @@ private:
     SkipBlanks();
     return offset_ < formatLength_ ? format_[offset_] : '\0';
   }
-  CHAR GetNextChar() {
+  CHAR GetNextChar(Terminator &terminator) {
     SkipBlanks();
     if (offset_ >= formatLength_) {
-      context_.terminator.Crash("FORMAT missing at least one ')'");
+      terminator.Crash("FORMAT missing at least one ')'");
     }
     return format_[offset_++];
   }
-  int GetIntField(CHAR firstCh = '\0');
+  int GetIntField(Terminator &, CHAR firstCh = '\0');
 
   // Advances through the FORMAT until the next data edit
   // descriptor has been found; handles control edit descriptors
   // along the way.  Returns the repeat count that appeared
   // before the descriptor (defaulting to 1) and leaves offset_
   // pointing to the data edit.
-  int CueUpNextDataEdit(bool stop = false);
+  int CueUpNextDataEdit(FormatContext &, bool stop = false);
 
   static constexpr CHAR Capitalize(CHAR ch) {
     return ch >= 'a' && ch <= 'z' ? ch + 'A' - 'a' : ch;
@@ -117,8 +125,6 @@ private:
   // Data members are arranged and typed so as to reduce size.
   // This structure may be allocated in stack space loaned by the
   // user program for internal I/O.
-  FormatContext &context_;
-  MutableModes modes_;
   std::uint16_t scale_{0};  // kP
   const std::uint8_t maxHeight_{maxMaxHeight};
   std::uint8_t height_{0};
diff --git a/flang/runtime/io-api.cc b/flang/runtime/io-api.cc
new file mode 100644 (file)
index 0000000..a140e0e
--- /dev/null
@@ -0,0 +1,31 @@
+//===-- runtime/io.cc -------------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "io-api.h"
+#include "format.h"
+#include "io-stmt.h"
+#include "memory.h"
+#include "terminator.h"
+#include <cstdlib>
+#include <memory>
+
+namespace Fortran::runtime::io {
+
+Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
+    std::size_t internalLength, const char *format, std::size_t formatLength,
+    void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
+    const char *sourceFile, int sourceLine) {
+  Terminator oom{sourceFile, sourceLine};
+  return &New<InternalFormattedIoStatementState<false>>{}(oom, internal,
+      internalLength, format, formatLength, sourceFile, sourceLine);
+}
+
+enum Iostat IONAME(EndIoStatement)(Cookie io) {
+  return static_cast<enum Iostat>(io->EndIoStatement());
+}
+}
index f413085..20f0f21 100644 (file)
@@ -19,7 +19,7 @@
 namespace Fortran::runtime {
 class Descriptor;
 class NamelistGroup;
-};
+}
 
 namespace Fortran::runtime::io {
 
@@ -60,30 +60,32 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &,
     void **scratchArea = nullptr, std::size_t scratchBytes = 0,
     const char *sourceFile = nullptr, int sourceLine = 0);
 Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &,
-    const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
+    const char *format, std::size_t formatLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
 Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &,
-    const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
+    const char *format, std::size_t formatLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
 
 // Internal I/O to/from a default-kind character scalar can avoid a
 // descriptor.
-Cookie IONAME(BeginInternalListOutput)(char *internal, std::size_t bytes,
-    void **scratchArea = nullptr, std::size_t scratchBytes = 0,
-    const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IONAME(BeginInternalListInput)(char *internal, std::size_t bytes,
-    void **scratchArea = nullptr, std::size_t scratchBytes = 0,
-    const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IONAME(BeginInternalFormattedOutput)(char *internal, std::size_t bytes,
-    const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
+Cookie IONAME(BeginInternalListOutput)(char *internal,
+    std::size_t internalLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
-Cookie IONAME(BeginInternalFormattedInput)(char *internal, std::size_t bytes,
-    const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
+Cookie IONAME(BeginInternalListInput)(char *internal,
+    std::size_t internalLength, void **scratchArea = nullptr,
     std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
     int sourceLine = 0);
+Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
+    std::size_t internalLength, const char *format, std::size_t formatLength,
+    void **scratchArea = nullptr, std::size_t scratchBytes = 0,
+    const char *sourceFile = nullptr, int sourceLine = 0);
+Cookie IONAME(BeginInternalFormattedInput)(char *internal,
+    std::size_t internalLength, const char *format, std::size_t formatLength,
+    void **scratchArea = nullptr, std::size_t scratchBytes = 0,
+    const char *sourceFile = nullptr, int sourceLine = 0);
 
 // Internal namelist I/O
 Cookie IONAME(BeginInternalNamelistOutput)(const Descriptor &,
@@ -110,10 +112,10 @@ Cookie IONAME(BeginUnformattedOutput)(ExternalUnit = DefaultUnit,
     const char *sourceFile = nullptr, int sourceLine = 0);
 Cookie IONAME(BeginUnformattedInput)(ExternalUnit = DefaultUnit,
     const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IONAME(BeginNamelistOutput)(const NamelistGroup &,
+Cookie IONAME(BeginExternalNamelistOutput)(const NamelistGroup &,
     ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
     int sourceLine = 0);
-Cookie IONAME(BeginNamelistInput)(const NamelistGroup &,
+Cookie IONAME(BeginExternalNamelistInput)(const NamelistGroup &,
     ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
     int sourceLine = 0);
 
@@ -150,7 +152,8 @@ Cookie IONAME(BeginInquireUnit)(
     ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
 Cookie IONAME(BeginInquireFile)(const char *, std::size_t, int kind = 1,
     const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IONAME(BeginInquireIoLength(const char *sourceFile = nullptr, int sourceLine = 0);
+Cookie IONAME(BeginInquireIoLength)(
+    const char *sourceFile = nullptr, int sourceLine = 0);
 
 // If an I/O statement has any IOSTAT=, ERR=, END=, or EOR= specifiers,
 // call EnableHandlers() immediately after the Begin...() call.
@@ -228,28 +231,28 @@ bool IONAME(InputLogical)(Cookie, bool &);
 // SetDelim(), GetIoMsg(), SetPad(), SetRound(), & SetSign()
 // are also acceptable for OPEN.
 // ACCESS=SEQUENTIAL, DIRECT, STREAM
-bool IONAME(SetAccessCookie, const char *, std::size_t);
+bool IONAME(SetAccess)(Cookie, const char *, std::size_t);
 // ACTION=READ, WRITE, or READWRITE
-bool IONAME(SetActionCookie, const char *, std::size_t);
+bool IONAME(SetAction)(Cookie, const char *, std::size_t);
 // ASYNCHRONOUS=YES, NO
-bool IONAME(SetAsynchronousCookie, const char *, std::size_t);
+bool IONAME(SetAsynchronous)(Cookie, const char *, std::size_t);
 // ENCODING=UTF-8, DEFAULT
-bool IONAME(SetEncodingCookie, const char *, std::size_t);
+bool IONAME(SetEncoding)(Cookie, const char *, std::size_t);
 // FORM=FORMATTED, UNFORMATTED
-bool IONAME(SetFormCookie, const char *, std::size_t);
+bool IONAME(SetForm)(Cookie, const char *, std::size_t);
 // POSITION=ASIS, REWIND, APPEND
-bool IONAME(SetPositionCookie, const char *, std::size_t);
-bool IONAME(SetReclCookie, std::size_t);  // RECL=
+bool IONAME(SetPosition)(Cookie, const char *, std::size_t);
+bool IONAME(SetRecl)(Cookie, std::size_t);  // RECL=
 
 // STATUS can be set during an OPEN or CLOSE statement.
 // For OPEN: STATUS=OLD, NEW, SCRATCH, REPLACE, UNKNOWN
 // For CLOSE: STATUS=KEEP, DELETE
-bool IONAME(SetStatusCookie, const char *, std::size_t);
+bool IONAME(SetStatus)(Cookie, const char *, std::size_t);
 
 // SetFile() may pass a CHARACTER argument of non-default kind,
 // and such filenames are converted to UTF-8 before being
 // presented to the filesystem.
-bool IONAME(SetFileCookie, const char *, std::size_t, int kind = 1);
+bool IONAME(SetFile)(Cookie, const char *, std::size_t, int kind = 1);
 
 // GetNewUnit() must not be called until after all Set...()
 // connection list specifiers have been called after
@@ -271,13 +274,15 @@ void IONAME(GetIoMsg)(Cookie, char *, std::size_t);  // IOMSG=
 // ACCESS, ACTION, ASYNCHRONOUS, BLANK, DECIMAL, DELIM, DIRECT, ENCODING,
 // FORM, FORMATTED, NAME, PAD, POSITION, READ, READWRITE, ROUND,
 // SEQUENTIAL, SIGN, STREAM, UNFORMATTED, WRITE:
-bool IONAME(InquireCharacter)(Cookie, const char *specifier, char *, std::size_t);
+bool IONAME(InquireCharacter)(
+    Cookie, const char *specifier, char *, std::size_t);
 // EXIST, NAMED, OPENED, and PENDING (without ID):
 bool IONAME(InquireLogical)(Cookie, const char *specifier, bool &);
 // PENDING with ID
 bool IONAME(InquirePendingId)(Cookie, std::int64_t, bool &);
 // NEXTREC, NUMBER, POS, RECL, SIZE
-bool IONAME(InquireInteger64)(Cookie, const char *specifier, std::int64_t &, int kind = 8);
+bool IONAME(InquireInteger64)(
+    Cookie, const char *specifier, std::int64_t &, int kind = 8);
 
 // The value of IOSTAT= is zero when no error, end-of-record,
 // or end-of-file condition has arisen; errors are positive values.
@@ -307,6 +312,6 @@ enum Iostat {
 // rather than by terminating the image.
 enum Iostat IONAME(EndIoStatement)(Cookie);
 
-};  // extern "C"
+}  // extern "C"
 }
 #endif
diff --git a/flang/runtime/io-error.cc b/flang/runtime/io-error.cc
new file mode 100644 (file)
index 0000000..74dcef8
--- /dev/null
@@ -0,0 +1,67 @@
+//===-- runtime/io-error.cc -------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "io-error.h"
+#include "magic-numbers.h"
+#include <cerrno>
+#include <cstdio>
+#include <cstring>
+
+namespace Fortran::runtime::io {
+
+void IoErrorHandler::Begin(const char *sourceFileName, int sourceLine) {
+  flags_ = 0;
+  ioStat_ = 0;
+  hitEnd_ = false;
+  hitEor_ = false;
+  SetLocation(sourceFileName, sourceLine);
+}
+
+void IoErrorHandler::SignalError(int iostatOrErrno) {
+  if (iostatOrErrno != 0) {
+    if (flags_ & hasIoStat) {
+      if (!ioStat_) {
+        ioStat_ = iostatOrErrno;
+      }
+    } else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT) {
+      Crash("INQUIRE on internal unit");
+    } else {
+      Crash("I/O error %d: %s", iostatOrErrno, std::strerror(iostatOrErrno));
+    }
+  }
+}
+
+void IoErrorHandler::SignalEnd() {
+  if (flags_ & hasEnd) {
+    hitEnd_ = true;
+  } else {
+    Crash("End of file");
+  }
+}
+
+void IoErrorHandler::SignalEor() {
+  if (flags_ & hasEor) {
+    hitEor_ = true;
+  } else {
+    Crash("End of record");
+  }
+}
+
+int IoErrorHandler::GetIoStat() const {
+  if (ioStat_) {
+    return ioStat_;
+  } else if (hitEnd_) {
+    return FORTRAN_RUNTIME_IOSTAT_END;
+  } else if (hitEor_) {
+    return FORTRAN_RUNTIME_IOSTAT_EOR;
+  } else {
+    return 0;
+  }
+}
+
+}
diff --git a/flang/runtime/io-error.h b/flang/runtime/io-error.h
new file mode 100644 (file)
index 0000000..08aea4e
--- /dev/null
@@ -0,0 +1,50 @@
+//===-- runtime/io-error.h --------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Distinguishes I/O error conditions; fatal ones lead to termination,
+// and those that the user program has chosen to handle are recorded
+// so that the highest-priority one can be returned as IOSTAT=.
+
+#ifndef FORTRAN_RUNTIME_IO_ERROR_H_
+#define FORTRAN_RUNTIME_IO_ERROR_H_
+
+#include "terminator.h"
+#include <cinttypes>
+
+namespace Fortran::runtime::io {
+
+class IoErrorHandler : virtual public Terminator {
+public:
+  using Terminator::Terminator;
+  void Begin(const char *sourceFileName, int sourceLine);
+  void HasIoStat() { flags_ |= hasIoStat; }
+  void HasErrLabel() { flags_ |= hasErr; }
+  void HasEndLabel() { flags_ |= hasEnd; }
+  void HasEorLabel() { flags_ |= hasEor; }
+
+  void SignalError(int iostatOrErrno);
+  void SignalEnd();
+  void SignalEor();
+
+  int GetIoStat() const;
+
+private:
+  enum Flag : std::uint8_t {
+    hasIoStat = 1,  // IOSTAT=
+    hasErr = 2,  // ERR=
+    hasEnd = 4,  // END=
+    hasEor = 8,  // EOR=
+  };
+  std::uint8_t flags_{0};
+  bool hitEnd_{false};
+  bool hitEor_{false};
+  int ioStat_{0};
+};
+
+}
+#endif  // FORTRAN_RUNTIME_IO_ERROR_H_
diff --git a/flang/runtime/io-stmt.cc b/flang/runtime/io-stmt.cc
new file mode 100644 (file)
index 0000000..221cd2d
--- /dev/null
@@ -0,0 +1,88 @@
+//===-- runtime/io-stmt.cc --------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "io-stmt.h"
+#include "memory.h"
+#include <algorithm>
+#include <cstring>
+
+namespace Fortran::runtime::io {
+
+int IoStatementState::EndIoStatement() { return GetIoStat(); }
+
+int InternalIoStatementState::EndIoStatement() {
+  auto result{GetIoStat()};
+  if (free_) {
+    FreeMemory(this);
+  }
+  return result;
+}
+
+InternalIoStatementState::InternalIoStatementState(
+    const char *sourceFile, int sourceLine)
+  : IoStatementState(sourceFile, sourceLine) {}
+
+template<bool isInput, typename CHAR>
+InternalFormattedIoStatementState<isInput,
+    CHAR>::InternalFormattedIoStatementState(Buffer internal,
+    std::size_t internalLength, const CHAR *format, std::size_t formatLength,
+    const char *sourceFile, int sourceLine)
+  : InternalIoStatementState{sourceFile, sourceLine}, FormatContext{},
+    internal_{internal}, internalLength_{internalLength}, format_{*this, format,
+                                                              formatLength} {
+  std::fill_n(internal_, internalLength_, static_cast<CHAR>(' '));
+}
+
+template<bool isInput, typename CHAR>
+void InternalFormattedIoStatementState<isInput, CHAR>::Emit(
+    const CHAR *data, std::size_t chars) {
+  if constexpr (isInput) {
+    FormatContext::Emit(data, chars);  // default Crash()
+  } else if (at_ + chars > internalLength_) {
+    SignalEor();
+  } else {
+    std::memcpy(internal_ + at_, data, chars * sizeof(CHAR));
+    at_ += chars;
+  }
+}
+
+template<bool isInput, typename CHAR>
+void InternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
+    int n) {
+  if (n < 0 || static_cast<std::size_t>(n) >= internalLength_) {
+    Crash("T%d control edit descriptor is out of range", n);
+  } else {
+    at_ = n;
+  }
+}
+
+template<bool isInput, typename CHAR>
+void InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
+    int n) {
+  if (n < 0) {
+    at_ -= std::min(at_, -static_cast<std::size_t>(n));
+  } else {
+    at_ += n;
+    if (at_ > internalLength_) {
+      Crash("TR%d control edit descriptor is out of range", n);
+    }
+  }
+}
+
+template<bool isInput, typename CHAR>
+int InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
+  format_.FinishOutput(*this);
+  auto result{GetIoStat()};
+  if (free_) {
+    FreeMemory(this);
+  }
+  return result;
+}
+
+template class InternalFormattedIoStatementState<false>;
+}
diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h
new file mode 100644 (file)
index 0000000..2e70efa
--- /dev/null
@@ -0,0 +1,64 @@
+//===-- runtime/io-stmt.h ---------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Represents state of an I/O statement in progress
+
+#ifndef FORTRAN_RUNTIME_IO_STMT_H_
+#define FORTRAN_RUNTIME_IO_STMT_H_
+
+#include "descriptor.h"
+#include "format.h"
+#include "io-error.h"
+#include <type_traits>
+
+namespace Fortran::runtime::io {
+
+class IoStatementState : public IoErrorHandler {
+public:
+  using IoErrorHandler::IoErrorHandler;
+  virtual int EndIoStatement();
+
+protected:
+};
+
+class InternalIoStatementState : public IoStatementState {
+public:
+  InternalIoStatementState(const char *sourceFile, int sourceLine);
+  virtual int EndIoStatement();
+
+protected:
+  bool free_{true};
+};
+
+template<bool IsInput, typename CHAR = char>
+class InternalFormattedIoStatementState : public InternalIoStatementState,
+                                          private FormatContext {
+private:
+  using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
+
+public:
+  InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
+      const CHAR *format, std::size_t formatLength,
+      const char *sourceFile = nullptr, int sourceLine = 0);
+  void Emit(const CHAR *, std::size_t chars);
+  // TODO pmk: void HandleSlash(int);
+  void HandleRelativePosition(int);
+  void HandleAbsolutePosition(int);
+  int EndIoStatement();
+
+private:
+  Buffer internal_;
+  std::size_t internalLength_;
+  std::size_t at_{0};
+  FormatControl<CHAR> format_;  // must be last, may be partial
+};
+
+extern template class InternalFormattedIoStatementState<false>;
+
+}
+#endif  // FORTRAN_RUNTIME_IO_STMT_H_
index b41666a..b607228 100644 (file)
@@ -17,6 +17,8 @@ These include:
    to an IOSTAT= or STAT= specifier on a Fortran I/O statement
    or coindexed data reference (see Fortran 2018 12.11.5,
    16.10.2, and 16.10.2.33)
+Codes from <errno.h>, e.g. ENOENT, are assumed to be positive
+and are used "raw" as IOSTAT values.
 #endif
 #ifndef FORTRAN_RUNTIME_MAGIC_NUMBERS_H_
 #define FORTRAN_RUNTIME_MAGIC_NUMBERS_H_
@@ -24,7 +26,7 @@ These include:
 #define FORTRAN_RUNTIME_IOSTAT_END (-1)
 #define FORTRAN_RUNTIME_IOSTAT_EOR (-2)
 #define FORTRAN_RUNTIME_IOSTAT_FLUSH (-3)
-#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 1
+#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 255
 
 #define FORTRAN_RUNTIME_STAT_FAILED_IMAGE 10
 #define FORTRAN_RUNTIME_STAT_LOCKED 11
index 1252614..ce36bc2 100644 (file)
@@ -7,24 +7,37 @@
 //===----------------------------------------------------------------------===//
 
 #include "main.h"
+#include "io-stmt.h"
 #include "terminator.h"
 #include <cfenv>
+#include <cstdio>
 #include <cstdlib>
+#include <limits>
 
 namespace Fortran::runtime {
-int argc;
-const char **argv;
-const char **envp;
-}
+ExecutionEnvironment executionEnvironment;
 
-extern "C" {
+void ExecutionEnvironment::Configure(
+    int ac, const char *av[], const char *env[]) {
+  argc = ac;
+  argv = av;
+  envp = env;
+  listDirectedOutputLineLengthLimit = 79;  // PGI default
 
-void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
-
-  Fortran::runtime::argc = argc;
-  Fortran::runtime::argv = argv;
-  Fortran::runtime::envp = envp;
+  if (auto *x{std::getenv("FORT_FMT_RECL")}) {
+    char *end;
+    auto n{std::strtol(x, &end, 10)};
+    if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
+      listDirectedOutputLineLengthLimit = n;
+    } else {
+      std::fprintf(
+          stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
+    }
+  }
+}
+}
 
+static void ConfigureFloatingPoint() {
 #ifdef feclearexcept  // a macro in some environments; omit std::
   feclearexcept(FE_ALL_EXCEPT);
 #else
@@ -35,8 +48,13 @@ void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
 #else
   std::fesetround(FE_TONEAREST);
 #endif
+}
 
+extern "C" {
+
+void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
   std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
-  // TODO: Runtime configuration settings from environment
+  Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
+  ConfigureFloatingPoint();
 }
 }
index 9a076b9..c966a36 100644 (file)
@@ -1,4 +1,4 @@
-//===-- runtime/main.cc -----------------------------------------*- C++ -*-===//
+//===-- runtime/main.h ------------------------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 #include "entry-names.h"
 
 namespace Fortran::runtime {
-extern int argc;
-extern const char **argv;
-extern const char **envp;
+struct ExecutionEnvironment {
+  void Configure(int argc, const char *argv[], const char *envp[]);
+
+  int argc;
+  const char **argv;
+  const char **envp;
+  int listDirectedOutputLineLengthLimit;
+};
+extern ExecutionEnvironment executionEnvironment;
 }
 
 extern "C" {
diff --git a/flang/runtime/memory.cc b/flang/runtime/memory.cc
new file mode 100644 (file)
index 0000000..ab7c63c
--- /dev/null
@@ -0,0 +1,33 @@
+//===-- runtime/memory.cc ---------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "memory.h"
+#include "terminator.h"
+#include <cstdlib>
+
+namespace Fortran::runtime {
+
+void *AllocateMemoryOrCrash(Terminator &terminator, std::size_t bytes) {
+  if (void *p{std::malloc(bytes)}) {
+    return p;
+  }
+  if (bytes > 0) {
+    terminator.Crash(
+        "Fortran runtime internal error: out of memory, needed %zd bytes",
+        bytes);
+  }
+  return nullptr;
+}
+
+void FreeMemory(void *p) { std::free(p); }
+
+void FreeMemoryAndNullify(void *&p) {
+  std::free(p);
+  p = nullptr;
+}
+}
diff --git a/flang/runtime/memory.h b/flang/runtime/memory.h
new file mode 100644 (file)
index 0000000..f44ceed
--- /dev/null
@@ -0,0 +1,43 @@
+//===-- runtime/memory.h ----------------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Thin wrapper around malloc()/free() to isolate the dependency,
+// ease porting, and provide an owning pointer.
+
+#ifndef FORTRAN_RUNTIME_MEMORY_H_
+#define FORTRAN_RUNTIME_MEMORY_H_
+
+#include <memory>
+
+namespace Fortran::runtime {
+
+class Terminator;
+
+void *AllocateMemoryOrCrash(Terminator &, std::size_t bytes);
+template<typename A> A &AllocateOrCrash(Terminator &t) {
+  return *reinterpret_cast<A *>(AllocateMemoryOrCrash(t, sizeof(A)));
+}
+void FreeMemory(void *);
+void FreeMemoryAndNullify(void *&);
+
+template<typename A> struct New {
+  template<typename... X> A &operator()(Terminator &terminator, X&&... x) {
+    return *new (AllocateMemoryOrCrash(terminator, sizeof(A))) A{std::forward<X>(x)...};
+  }
+};
+
+namespace {
+template<typename A> class OwningPtrDeleter {
+  void operator()(A *p) { FreeMemory(p); }
+};
+}
+
+template<typename A> using OwningPtr = std::unique_ptr<A, OwningPtrDeleter<A>>;
+}
+
+#endif  // FORTRAN_RUNTIME_MEMORY_H_
index 7977638..e2e9b7b 100644 (file)
@@ -35,6 +35,12 @@ namespace Fortran::runtime {
   std::abort();
 }
 
+[[noreturn]] void Terminator::CheckFailed(
+    const char *predicate, const char *file, int line) {
+  Crash("Internal error: RUNTIME_CHECK(%s) failed at %s(%d)", predicate, file,
+      line);
+}
+
 void NotifyOtherImagesOfNormalEnd() {
   // TODO
 }
index 99e0723..5fe381e 100644 (file)
@@ -29,12 +29,20 @@ public:
   }
   [[noreturn]] void Crash(const char *message, ...);
   [[noreturn]] void CrashArgs(const char *message, va_list &);
+  [[noreturn]] void CheckFailed(
+      const char *predicate, const char *file, int line);
 
 private:
   const char *sourceFileName_{nullptr};
   int sourceLine_{0};
 };
 
+#define RUNTIME_CHECK(terminator, pred) \
+  if (pred) \
+    ; \
+  else \
+    (terminator).CheckFailed(#pred, __FILE__, __LINE__)
+
 void NotifyOtherImagesOfNormalEnd();
 void NotifyOtherImagesOfFailImageStatement();
 void NotifyOtherImagesOfErrorTermination();
index 7a02bd7..6c11447 100644 (file)
@@ -8,7 +8,6 @@
 
 #include "transformational.h"
 #include "../lib/common/idioms.h"
-#include "../lib/evaluate/integer.h"
 #include <algorithm>
 #include <bitset>
 #include <cinttypes>
 
 namespace Fortran::runtime {
 
-template<int BITS> inline std::int64_t LoadInt64(const char *p) {
-  using Int = const evaluate::value::Integer<BITS>;
-  Int *ip{reinterpret_cast<Int *>(p)};
-  return ip->ToInt64();
-}
-
 static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
   switch (bytes) {
-  case 1: return LoadInt64<8>(p);
-  case 2: return LoadInt64<16>(p);
-  case 4: return LoadInt64<32>(p);
-  case 8: return LoadInt64<64>(p);
+  case 1: return *reinterpret_cast<const std::int8_t *>(p);
+  case 2: return *reinterpret_cast<const std::int16_t *>(p);
+  case 4: return *reinterpret_cast<const std::int32_t *>(p);
+  case 8: return *reinterpret_cast<const std::int64_t *>(p);
   default: CRASH_NO_CASE;
   }
 }
index a9ef7c4..5cbc230 100644 (file)
@@ -19,3 +19,13 @@ target_link_libraries(format-test
 )
 
 add_test(Format format-test)
+
+add_executable(hello-world
+  hello.cc
+)
+
+target_link_libraries(hello-world
+  FortranRuntime
+)
+
+add_test(HelloWorld hello-world)
index 95d44f1..50381e8 100644 (file)
@@ -1,5 +1,6 @@
 // Test basic FORMAT string traversal
 #include "../runtime/format.h"
+#include "../runtime/terminator.h"
 #include <cstdarg>
 #include <cstring>
 #include <iostream>
@@ -7,24 +8,50 @@
 #include <string>
 
 using namespace Fortran::runtime;
+using namespace Fortran::runtime::io;
 using namespace std::literals::string_literals;
 
 static int failures{0};
 using Results = std::list<std::string>;
-static Results results;
 
-static void handleCharacterLiteral(const char *s, std::size_t len) {
+// Test harness context for format control
+struct TestFormatContext : virtual public Terminator, public FormatContext {
+  TestFormatContext() : Terminator{"format.cc", 1} {}
+  void Emit(const char *, std::size_t);
+  void HandleSlash(int = 1);
+  void HandleRelativePosition(int);
+  void HandleAbsolutePosition(int);
+  void Report(const DataEdit &);
+  void Check(Results &);
+  Results results;
+};
+
+// Override the runtime's Crash() for testing purposes
+[[noreturn]] void Fortran::runtime::Terminator::Crash(const char *message, ...) {
+  std::va_list ap;
+  va_start(ap, message);
+  char buffer[1000];
+  std::vsnprintf(buffer, sizeof buffer, message, ap);
+  va_end(ap);
+  throw std::string{buffer};
+}
+
+void TestFormatContext::Emit(const char *s, std::size_t len) {
   std::string str{s, len};
   results.push_back("'"s + str + '\'');
 }
 
-static void handleSlash() { results.emplace_back("/"); }
+void TestFormatContext::HandleSlash(int n) {
+  while (n-- > 0) {
+    results.emplace_back("/");
+  }
+}
 
-static void handleAbsolutePosition(int n) {
+void TestFormatContext::HandleAbsolutePosition(int n) {
   results.push_back("T"s + std::to_string(n));
 }
 
-static void handleRelativePosition(int n) {
+void TestFormatContext::HandleRelativePosition(int n) {
   if (n < 0) {
     results.push_back("TL"s + std::to_string(-n));
   } else {
@@ -32,7 +59,7 @@ static void handleRelativePosition(int n) {
   }
 }
 
-static void Report(const DataEdit &edit) {
+void TestFormatContext::Report(const DataEdit &edit) {
   std::string str{edit.descriptor};
   if (edit.repeat != 1) {
     str = std::to_string(edit.repeat) + '*' + str;
@@ -51,17 +78,7 @@ static void Report(const DataEdit &edit) {
   results.push_back(str);
 }
 
-// Override the Crash() in the runtime library
-void Terminator::Crash(const char *message, ...) {
-  std::va_list ap;
-  va_start(ap, message);
-  char buffer[1000];
-  std::vsnprintf(buffer, sizeof buffer, message, ap);
-  va_end(ap);
-  throw std::string{buffer};
-}
-
-static void Check(Results &expect) {
+void TestFormatContext::Check(Results &expect) {
   if (expect != results) {
     std::cerr << "expected:";
     for (const std::string &s : expect) {
@@ -78,37 +95,33 @@ static void Check(Results &expect) {
   results.clear();
 }
 
-static void Test(FormatContext &context, int n, const char *format,
-    Results &&expect, int repeat = 1) {
-  MutableModes modes;
-  FormatControl control{context, format, std::strlen(format), modes};
+static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
+  TestFormatContext context;
+  FormatControl control{context, format, std::strlen(format)};
   try {
     for (int j{0}; j < n; ++j) {
       DataEdit edit;
-      control.GetNext(edit, repeat);
-      Report(edit);
+      control.GetNext(context, edit, repeat);
+      context.Report(edit);
     }
-    control.FinishOutput();
+    control.FinishOutput(context);
   } catch (const std::string &crash) {
-    results.push_back("Crash:"s + crash);
+    context.results.push_back("Crash:"s + crash);
   }
-  Check(expect);
+  context.Check(expect);
 }
 
 int main() {
-  Terminator terminator{"source", 1};
-  FormatContext context{terminator, &handleCharacterLiteral, nullptr, nullptr,
-      &handleSlash, &handleAbsolutePosition, &handleRelativePosition};
-  Test(context, 1, "('PI=',F9.7)", Results{"'PI='", "F9.7"});
-  Test(context, 1, "(3HPI=F9.7)", Results{"'PI='", "F9.7"});
-  Test(context, 1, "(3HPI=/F9.7)", Results{"'PI='", "/", "F9.7"});
-  Test(context, 2, "('PI=',F9.7)", Results{"'PI='", "F9.7", "'PI='", "F9.7"});
-  Test(context, 2, "(2('PI=',F9.7),'done')",
+  Test(1, "('PI=',F9.7)", Results{"'PI='", "F9.7"});
+  Test(1, "(3HPI=F9.7)", Results{"'PI='", "F9.7"});
+  Test(1, "(3HPI=/F9.7)", Results{"'PI='", "/", "F9.7"});
+  Test(2, "('PI=',F9.7)", Results{"'PI='", "F9.7", "/", "'PI='", "F9.7"});
+  Test(2, "(2('PI=',F9.7),'done')",
       Results{"'PI='", "F9.7", "'PI='", "F9.7", "'done'"});
-  Test(context, 2, "(3('PI=',F9.7,:),'tooFar')",
+  Test(2, "(3('PI=',F9.7,:),'tooFar')",
       Results{"'PI='", "F9.7", "'PI='", "F9.7"});
-  Test(context, 2, "(*('PI=',F9.7,:),'tooFar')",
+  Test(2, "(*('PI=',F9.7,:),'tooFar')",
       Results{"'PI='", "F9.7", "'PI='", "F9.7"});
-  Test(context, 1, "(3F9.7)", Results{"2*F9.7"}, 2);
+  Test(1, "(3F9.7)", Results{"2*F9.7"}, 2);
   return failures > 0;
 }
diff --git a/flang/test/runtime/hello.cc b/flang/test/runtime/hello.cc
new file mode 100644 (file)
index 0000000..9c52a01
--- /dev/null
@@ -0,0 +1,33 @@
+// Basic tests of I/O API
+
+#include "../../runtime/io-api.h"
+#include <cstring>
+#include <iostream>
+
+using namespace Fortran::runtime::io;
+
+static int failures{0};
+
+int main() {
+  char buffer[32];
+  const char *format1{"(12HHELLO, WORLD)"};
+  auto cookie{IONAME(BeginInternalFormattedOutput)(buffer, sizeof buffer, format1, std::strlen(format1))};
+  if (auto status{IONAME(EndIoStatement)(cookie)}) {
+    std::cerr << "format1 failed, status " << static_cast<int>(status) << '\n';
+    ++failures;
+  }
+  std::string got1{buffer, sizeof buffer};
+  std::string expect1{"HELLO, WORLD"};
+  expect1.resize(got1.length(), ' ');
+  if (got1 != expect1) {
+    std::cerr << "format1 failed, got '" << got1 << "', expected '" << expect1 << "'\n";
+    ++failures;
+  }
+
+  if (failures == 0) {
+    std::cout << "PASS\n";
+  } else {
+    std::cout << "FAIL " << failures << " tests\n";
+  }
+  return failures > 0;
+}