Dispose, // nonstandard
)
+// Floating-point rounding modes; these are packed into a byte to save
+// room in the runtime's format processing context structure.
+enum class RoundingMode : std::uint8_t {
+ TiesToEven, // ROUND=NEAREST, RN - default IEEE rounding
+ ToZero, // ROUND=ZERO, RZ - truncation
+ Down, // ROUND=DOWN, RD
+ Up, // ROUND=UP, RU
+ TiesAwayFromZero, // ROUND=COMPATIBLE, RC - ties round away from zero
+};
+
// Fortran arrays may have up to 15 dimensions (See Fortran 2018 section 5.4.6).
static constexpr int maxRank{15};
}
RealFlags flags{};
};
-ENUM_CLASS(RoundingMode, TiesToEven, ToZero, Down, Up, TiesAwayFromZero)
-
struct Rounding {
- RoundingMode mode{RoundingMode::TiesToEven};
+ common::RoundingMode mode{common::RoundingMode::TiesToEven};
// When set, emulate status flag behavior peculiar to x86
// (viz., fail to set the Underflow flag when an inexact product of a
// multiplication is rounded up to a normal number from a subnormal
} else if (name == "ceiling" || name == "floor" || name == "nint") {
if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
// NINT rounds ties away from zero, not to even
- RoundingMode mode{name == "ceiling"
- ? RoundingMode::Up
- : name == "floor" ? RoundingMode::Down
- : RoundingMode::TiesAwayFromZero};
+ common::RoundingMode mode{name == "ceiling"
+ ? common::RoundingMode::Up
+ : name == "floor" ? common::RoundingMode::Down
+ : common::RoundingMode::TiesAwayFromZero};
return std::visit(
[&](const auto &kx) {
using TR = ResultType<decltype(kx)>;
context, std::move(funcRef), &Scalar<ComplexT>::AIMAG);
} else if (name == "aint" || name == "anint") {
// ANINT rounds ties away from zero, not to even
- RoundingMode mode{
- name == "aint" ? RoundingMode::ToZero : RoundingMode::TiesAwayFromZero};
+ common::RoundingMode mode{name == "aint"
+ ? common::RoundingMode::ToZero
+ : common::RoundingMode::TiesAwayFromZero};
return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
ScalarFunc<T, T>([&name, &context, mode](
const Scalar<T> &x) -> Scalar<T> {
return;
}
switch (context.rounding().mode) {
- case RoundingMode::TiesToEven: fesetround(FE_TONEAREST); break;
- case RoundingMode::ToZero: fesetround(FE_TOWARDZERO); break;
- case RoundingMode::Up: fesetround(FE_UPWARD); break;
- case RoundingMode::Down: fesetround(FE_DOWNWARD); break;
- case RoundingMode::TiesAwayFromZero:
+ case common::RoundingMode::TiesToEven: fesetround(FE_TONEAREST); break;
+ case common::RoundingMode::ToZero: fesetround(FE_TOWARDZERO); break;
+ case common::RoundingMode::Up: fesetround(FE_UPWARD); break;
+ case common::RoundingMode::Down: fesetround(FE_DOWNWARD); break;
+ case common::RoundingMode::TiesAwayFromZero:
fesetround(FE_TONEAREST);
context.messages().Say(
"TiesAwayFromZero rounding mode is not available when folding constants"
}
if (order == Ordering::Equal) {
// x + (-x) -> +0.0 unless rounding is directed downwards
- if (rounding.mode == RoundingMode::Down) {
+ if (rounding.mode == common::RoundingMode::Down) {
result.value.word_ = result.value.word_.IBSET(bits - 1); // -0.0
}
return result;
template<typename W, int P, bool IM>
ValueWithRealFlags<Real<W, P, IM>> Real<W, P, IM>::ToWholeNumber(
- RoundingMode mode) const {
+ common::RoundingMode mode) const {
ValueWithRealFlags<Real> result{*this};
if (IsNotANumber()) {
result.flags.set(RealFlag::InvalidArgument);
result.flags.reset(RealFlag::Inexact); // result *is* exact
// Return (ival-adjust) with original sign in case we've generated a zero.
result.value =
- result.value.Subtract(adjust, Rounding{RoundingMode::ToZero})
+ result.value.Subtract(adjust, Rounding{common::RoundingMode::ToZero})
.value.SIGN(*this);
}
}
}
if (exponent >= maxExponent) {
// Infinity or overflow
- if (rounding.mode == RoundingMode::TiesToEven ||
- rounding.mode == RoundingMode::TiesAwayFromZero ||
- (rounding.mode == RoundingMode::Up && !negative) ||
- (rounding.mode == RoundingMode::Down && negative)) {
+ if (rounding.mode == common::RoundingMode::TiesToEven ||
+ rounding.mode == common::RoundingMode::TiesAwayFromZero ||
+ (rounding.mode == common::RoundingMode::Up && !negative) ||
+ (rounding.mode == common::RoundingMode::Down && negative)) {
word_ = Word{maxExponent}.SHIFTL(significandBits); // Inf
} else {
// directed rounding: round to largest finite value rather than infinity
if (rounding.x86CompatibleBehavior && Exponent() != 0 && multiply &&
bits.sticky() &&
(bits.guard() ||
- (rounding.mode != RoundingMode::Up &&
- rounding.mode != RoundingMode::Down))) {
+ (rounding.mode != common::RoundingMode::Up &&
+ rounding.mode != common::RoundingMode::Down))) {
// x86 edge case in which Underflow fails to signal when a subnormal
// inexact multiplication product rounds to a normal result when
// the guard bit is set or we're not using directed rounding
result.flags |= result.value.Round(rounding, roundingBits, multiply);
}
-inline enum decimal::FortranRounding MapRoundingMode(RoundingMode rounding) {
+inline enum decimal::FortranRounding MapRoundingMode(
+ common::RoundingMode rounding) {
switch (rounding) {
- case RoundingMode::TiesToEven: break;
- case RoundingMode::ToZero: return decimal::RoundToZero;
- case RoundingMode::Down: return decimal::RoundDown;
- case RoundingMode::Up: return decimal::RoundUp;
- case RoundingMode::TiesAwayFromZero: return decimal::RoundCompatible;
+ case common::RoundingMode::TiesToEven: break;
+ case common::RoundingMode::ToZero: return decimal::RoundToZero;
+ case common::RoundingMode::Down: return decimal::RoundDown;
+ case common::RoundingMode::Up: return decimal::RoundUp;
+ case common::RoundingMode::TiesAwayFromZero: return decimal::RoundCompatible;
}
return decimal::RoundNearest; // dodge gcc warning about lack of result
}
// Conversion to integer in the same real format (AINT(), ANINT())
ValueWithRealFlags<Real> ToWholeNumber(
- RoundingMode = RoundingMode::ToZero) const;
+ common::RoundingMode = common::RoundingMode::ToZero) const;
// Conversion to an integer (INT(), NINT(), FLOOR(), CEILING())
template<typename INT>
constexpr ValueWithRealFlags<INT> ToInteger(
- RoundingMode mode = RoundingMode::ToZero) const {
+ common::RoundingMode mode = common::RoundingMode::ToZero) const {
ValueWithRealFlags<INT> result;
if (IsNotANumber()) {
result.flags.set(RealFlag::InvalidArgument);
Rounding rounding, bool isNegative, bool isOdd) const {
bool round{false}; // to dodge bogus g++ warning about missing return
switch (rounding.mode) {
- case RoundingMode::TiesToEven:
+ case common::RoundingMode::TiesToEven:
round = guard_ && (round_ | sticky_ | isOdd);
break;
- case RoundingMode::ToZero: break;
- case RoundingMode::Down: round = isNegative && !empty(); break;
- case RoundingMode::Up: round = !isNegative && !empty(); break;
- case RoundingMode::TiesAwayFromZero: round = guard_; break;
+ case common::RoundingMode::ToZero: break;
+ case common::RoundingMode::Down: round = isNegative && !empty(); break;
+ case common::RoundingMode::Up: round = !isNegative && !empty(); break;
+ case common::RoundingMode::TiesAwayFromZero: round = guard_; break;
}
return round;
}
ISO_Fortran_binding.cc
derived-type.cc
descriptor.cc
+ format.cc
main.cc
stop.cc
terminator.cc
--- /dev/null
+//===-- runtime/format.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 "format.h"
+#include "../lib/common/format.h"
+#include "../lib/decimal/decimal.h"
+#include <limits>
+
+namespace Fortran::runtime {
+
+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)} {
+ // 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);
+ }
+ stack_[0].start = offset_;
+ stack_[0].remaining = Iteration::unlimited; // 13.4(8)
+}
+
+template<typename CHAR>
+int FormatControl<CHAR>::GetMaxParenthesisNesting(
+ Terminator &terminator, const CHAR *format, std::size_t formatLength) {
+ using Validator = common::FormatValidator<CHAR>;
+ typename Validator::Reporter reporter{
+ [&](const common::FormatMessage &message) {
+ terminator.Crash(message.text, message.arg);
+ return false; // crashes on error above
+ }};
+ Validator validator{format, formatLength, reporter};
+ validator.Check();
+ 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) {
+ CHAR ch{firstCh ? firstCh : PeekNext()};
+ if (ch < '0' || ch > '9') {
+ context_.terminator.Crash(
+ "Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
+ }
+ int result{0};
+ 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");
+ }
+ result = 10 * result + ch - '0';
+ if (firstCh) {
+ firstCh = '\0';
+ } else {
+ ++offset_;
+ }
+ ch = PeekNext();
+ }
+ return result;
+}
+
+static void HandleControl(MutableModes &modes, std::uint16_t &scale,
+ FormatContext &context, char ch, char next, int n) {
+ switch (ch) {
+ case 'B':
+ if (next == 'Z') {
+ modes.editingFlags |= blankZero;
+ return;
+ }
+ if (next == 'N') {
+ modes.editingFlags &= ~blankZero;
+ return;
+ }
+ break;
+ case 'D':
+ if (next == 'C') {
+ modes.editingFlags |= decimalComma;
+ return;
+ }
+ if (next == 'P') {
+ modes.editingFlags &= ~decimalComma;
+ return;
+ }
+ break;
+ case 'P':
+ if (!next) {
+ scale = n; // kP - decimal scaling by 10**k (TODO)
+ return;
+ }
+ break;
+ case 'R':
+ switch (next) {
+ case 'N': modes.roundingMode = common::RoundingMode::TiesToEven; return;
+ case 'Z': modes.roundingMode = common::RoundingMode::ToZero; return;
+ case 'U': modes.roundingMode = common::RoundingMode::Up; return;
+ case 'D': modes.roundingMode = common::RoundingMode::Down; return;
+ case 'C':
+ modes.roundingMode = common::RoundingMode::TiesAwayFromZero;
+ return;
+ default: break;
+ }
+ break;
+ case 'X':
+ if (!next) {
+ if (context.handleRelativePosition) {
+ context.handleRelativePosition(n);
+ }
+ return;
+ }
+ break;
+ case 'S':
+ if (next == 'P') {
+ modes.editingFlags |= signPlus;
+ return;
+ }
+ if (!next || next == 'S') {
+ modes.editingFlags &= ~signPlus;
+ return;
+ }
+ break;
+ case 'T': {
+ if (!next) { // Tn
+ if (context.handleAbsolutePosition) {
+ context.handleAbsolutePosition(n);
+ }
+ return;
+ }
+ if (next == 'L' || next == 'R') { // TLn & TRn
+ if (context.handleRelativePosition) {
+ context.handleRelativePosition(next == 'L' ? -n : n);
+ }
+ return;
+ }
+ } break;
+ default: break;
+ }
+ if (next) {
+ context.terminator.Crash(
+ "Unknown '%c%c' edit descriptor in FORMAT", ch, next);
+ } else {
+ context.terminator.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
+ }
+}
+
+// Locates the next data edit descriptor in the format.
+// 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) {
+ int unlimitedLoopCheck{-1};
+ while (true) {
+ std::optional<int> repeat;
+ bool unlimited{false};
+ CHAR ch{Capitalize(GetNextChar())};
+ 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());
+ }
+ if (ch >= '0' && ch <= '9') { // repeat count
+ repeat = GetIntField(ch);
+ ch = GetNextChar();
+ } else if (ch == '*') {
+ unlimited = true;
+ ch = GetNextChar();
+ if (ch != '(') {
+ context_.terminator.Crash(
+ "Invalid FORMAT: '*' may appear only before '('");
+ }
+ }
+ if (ch == '(') {
+ if (height_ >= maxHeight_) {
+ context_.terminator.Crash(
+ "FORMAT stack overflow: too many nested parentheses");
+ }
+ stack_[height_].start = offset_ - 1; // the '('
+ if (unlimited || height_ == 0) {
+ stack_[height_].remaining = Iteration::unlimited;
+ unlimitedLoopCheck = offset_ - 1;
+ } else if (repeat) {
+ if (*repeat <= 0) {
+ *repeat = 1; // error recovery
+ }
+ stack_[height_].remaining = *repeat - 1;
+ } else {
+ stack_[height_].remaining = 0;
+ }
+ ++height_;
+ } else if (height_ == 0) {
+ context_.terminator.Crash("FORMAT lacks initial '('");
+ } else if (ch == ')') {
+ if (height_ == 1 && stop) {
+ return 0; // end of FORMAT and no data items remain
+ }
+ if (stack_[height_ - 1].remaining == Iteration::unlimited) {
+ offset_ = stack_[height_ - 1].start + 1;
+ if (offset_ == unlimitedLoopCheck) {
+ context_.terminator.Crash(
+ "Unlimited repetition in FORMAT lacks data edit descriptors");
+ }
+ } else if (stack_[height_ - 1].remaining-- > 0) {
+ offset_ = stack_[height_ - 1].start + 1;
+ } else {
+ --height_;
+ }
+ } else if (ch == '\'' || ch == '"') {
+ // Quoted 'character literal'
+ CHAR quote{ch};
+ auto start{offset_};
+ while (offset_ < formatLength_ && format_[offset_] != quote) {
+ ++offset_;
+ }
+ if (offset_ >= formatLength_) {
+ context_.terminator.Crash(
+ "FORMAT missing closing quote on character literal");
+ }
+ ++offset_;
+ std::size_t chars{
+ static_cast<std::size_t>(&format_[offset_] - &format_[start])};
+ if (PeekNext() == quote) {
+ // subtle: handle doubled quote character in a literal by including
+ // the first in the output, then treating the second as the start
+ // of another character literal.
+ } else {
+ --chars;
+ }
+ HandleCharacterLiteral(context_, format_ + start, chars);
+ } else if (ch == 'H') {
+ // 9HHOLLERITH
+ if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
+ context_.terminator.Crash("Invalid width on Hollerith in FORMAT");
+ }
+ HandleCharacterLiteral(
+ context_, format_ + offset_, static_cast<std::size_t>(*repeat));
+ offset_ += *repeat;
+ } else if (ch >= 'A' && ch <= 'Z') {
+ int start{offset_ - 1};
+ CHAR next{Capitalize(PeekNext())};
+ if (next < 'A' || next > 'Z') {
+ next = '\0';
+ }
+ if (ch == 'E' ||
+ (!next &&
+ (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'O' || ch == 'Z' ||
+ ch == 'F' || ch == 'D' || ch == 'G'))) {
+ // Data edit descriptor found
+ offset_ = start;
+ return repeat ? *repeat : 1;
+ } else {
+ // Control edit descriptor
+ if (ch == 'T') { // Tn, TLn, TRn
+ repeat = GetIntField();
+ }
+ HandleControl(modes_, scale_, context_, static_cast<char>(ch),
+ static_cast<char>(next), repeat ? *repeat : 1);
+ }
+ } else if (ch == '/') {
+ if (context_.handleSlash) {
+ context_.handleSlash();
+ }
+ } else {
+ context_.terminator.Crash(
+ "Invalid character '%c' in FORMAT", static_cast<char>(ch));
+ }
+ }
+}
+
+template<typename CHAR>
+void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
+
+ // TODO: DT editing
+
+ // Return the next data edit descriptor
+ int repeat{CueUpNextDataEdit()};
+ auto start{offset_};
+ edit.descriptor = static_cast<char>(Capitalize(GetNextChar()));
+ if (edit.descriptor == 'E') {
+ edit.variation = static_cast<char>(Capitalize(PeekNext()));
+ if (edit.variation >= 'A' && edit.variation <= 'Z') {
+ ++offset_;
+ } else {
+ edit.variation = '\0';
+ }
+ } else {
+ edit.variation = '\0';
+ }
+
+ edit.width = GetIntField();
+ edit.modes = modes_;
+ if (PeekNext() == '.') {
+ ++offset_;
+ edit.digits = GetIntField();
+ CHAR ch{PeekNext()};
+ if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
+ ++offset_;
+ edit.expoDigits = GetIntField();
+ } else {
+ edit.expoDigits.reset();
+ }
+ } else {
+ edit.digits.reset();
+ edit.expoDigits.reset();
+ }
+
+ // Handle repeated nonparenthesized edit descriptors
+ if (repeat > 1) {
+ stack_[height_].start = start; // after repeat count
+ stack_[height_].remaining = repeat; // full count
+ ++height_;
+ }
+ edit.repeat = 1;
+ if (height_ > 1) {
+ int start{stack_[height_ - 1].start};
+ if (format_[start] != '(') {
+ if (stack_[height_ - 1].remaining > maxRepeat) {
+ edit.repeat = maxRepeat;
+ stack_[height_ - 1].remaining -= maxRepeat;
+ offset_ = start; // repeat same edit descriptor next time
+ } else {
+ edit.repeat = stack_[height_ - 1].remaining;
+ --height_;
+ }
+ }
+ }
+}
+
+template<typename CHAR> void FormatControl<CHAR>::FinishOutput() {
+ CueUpNextDataEdit(true /* stop at colon or end of FORMAT */);
+}
+
+template class FormatControl<char>;
+template class FormatControl<char16_t>;
+template class FormatControl<char32_t>;
+}
--- /dev/null
+//===-- runtime/format.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
+//
+//===----------------------------------------------------------------------===//
+
+// FORMAT string processing
+
+#ifndef FORTRAN_RUNTIME_FORMAT_H_
+#define FORTRAN_RUNTIME_FORMAT_H_
+
+#include "terminator.h"
+#include "../lib/common/Fortran.h"
+#include <cinttypes>
+#include <optional>
+
+namespace Fortran::runtime {
+
+enum EditingFlags {
+ blankZero = 1, // BLANK=ZERO or BZ edit
+ decimalComma = 2, // DECIMAL=COMMA or DC edit
+ signPlus = 4, // SIGN=PLUS or SP edit
+};
+
+struct MutableModes {
+ std::uint8_t editingFlags{0}; // BN, DP, SS
+ common::RoundingMode roundingMode{common::RoundingMode::TiesToEven}; // RN
+};
+
+// A single edit descriptor extracted from a FORMAT
+struct DataEdit {
+ char descriptor; // capitalized: one of A, I, B, O, Z, F, E(N/S/X), D, G
+ char variation{'\0'}; // N, S, or X for EN, ES, EX
+ int width; // the 'w' field
+ std::optional<int> digits; // the 'm' or 'd' field
+ std::optional<int> expoDigits; // 'Ee' field
+ MutableModes modes;
+ 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)
+};
+
+// Generates a sequence of DataEdits from a FORMAT statement or
+// default-CHARACTER string. Driven by I/O item list processing.
+// 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);
+
+ // Determines the max parenthesis nesting level by scanning and validating
+ // the FORMAT string.
+ static int GetMaxParenthesisNesting(
+ Terminator &, const CHAR *format, std::size_t formatLength);
+
+ // For attempting to allocate in a user-supplied stack area
+ static std::size_t GetNeededSize(int maxHeight) {
+ return sizeof(FormatControl) -
+ sizeof(Iteration) * (maxMaxHeight - maxHeight);
+ }
+
+ // Extracts the next data edit descriptor, handling control edit descriptors
+ // along the way.
+ void GetNext(DataEdit &, int maxRepeat = 1);
+
+ // Emit any remaining character literals after the last data item.
+ void FinishOutput();
+
+private:
+ static constexpr std::uint8_t maxMaxHeight{100};
+
+ struct Iteration {
+ static constexpr int unlimited{-1};
+ int start{0}; // offset in format_ of '(' or a repeated edit descriptor
+ int remaining{0}; // while >0, decrement and iterate
+ };
+
+ void SkipBlanks() {
+ while (offset_ < formatLength_ && format_[offset_] == ' ') {
+ ++offset_;
+ }
+ }
+ CHAR PeekNext() {
+ SkipBlanks();
+ return offset_ < formatLength_ ? format_[offset_] : '\0';
+ }
+ CHAR GetNextChar() {
+ SkipBlanks();
+ if (offset_ >= formatLength_) {
+ context_.terminator.Crash("FORMAT missing at least one ')'");
+ }
+ return format_[offset_++];
+ }
+ int GetIntField(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);
+
+ static constexpr CHAR Capitalize(CHAR ch) {
+ return ch >= 'a' && ch <= 'z' ? ch + 'A' - 'a' : ch;
+ }
+
+ // 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};
+ const CHAR *format_;
+ int formatLength_;
+ int offset_{0}; // next item is at format_[offset_]
+
+ // must be last, may be incomplete
+ Iteration stack_[maxMaxHeight];
+};
+
+extern template class FormatControl<char>;
+extern template class FormatControl<char16_t>;
+extern template class FormatControl<char32_t>;
+}
+#endif // FORTRAN_RUNTIME_FORMAT_H_
[[noreturn]] void RTNAME(StopStatementText)(
const char *code, bool isErrorStop, bool quiet) {
if (!quiet) {
- std::fprintf(stderr, "Fortran %s: %s\n",
- isErrorStop ? "ERROR STOP" : "STOP", code);
+ std::fprintf(
+ stderr, "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);
DescribeIEEESignaledExceptions();
}
std::exit(EXIT_FAILURE);
add_subdirectory(decimal)
add_subdirectory(evaluate)
+add_subdirectory(runtime)
add_subdirectory(semantics)
#include <cstdlib>
#include <cstring>
+using Fortran::common::RoundingMode;
using Fortran::evaluate::RealFlag;
ScopedHostFloatingPointEnvironment::ScopedHostFloatingPointEnvironment(
#include "../../lib/evaluate/common.h"
#include <fenv.h>
+using Fortran::common::RoundingMode;
using Fortran::evaluate::RealFlags;
using Fortran::evaluate::Rounding;
-using Fortran::evaluate::RoundingMode;
class ScopedHostFloatingPointEnvironment {
public:
--- /dev/null
+#===-- test/runtime/CMakeLists.txt -----------------------------------------===#
+#
+# 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
+#
+#------------------------------------------------------------------------------#
+
+if(CMAKE_COMPILER_IS_GNUCXX OR (CMAKE_CXX_COMPILER_ID MATCHES "Clang"))
+ set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fexceptions")
+endif()
+
+add_executable(format-test
+ format.cc
+)
+
+target_link_libraries(format-test
+ FortranRuntime
+)
+
+add_test(Format format-test)
--- /dev/null
+// Test basic FORMAT string traversal
+#include "../runtime/format.h"
+#include <cstdarg>
+#include <cstring>
+#include <iostream>
+#include <list>
+#include <string>
+
+using namespace Fortran::runtime;
+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) {
+ std::string str{s, len};
+ results.push_back("'"s + str + '\'');
+}
+
+static void handleSlash() { results.emplace_back("/"); }
+
+static void handleAbsolutePosition(int n) {
+ results.push_back("T"s + std::to_string(n));
+}
+
+static void handleRelativePosition(int n) {
+ if (n < 0) {
+ results.push_back("TL"s + std::to_string(-n));
+ } else {
+ results.push_back(std::to_string(n) + 'X');
+ }
+}
+
+static void Report(const DataEdit &edit) {
+ std::string str{edit.descriptor};
+ if (edit.repeat != 1) {
+ str = std::to_string(edit.repeat) + '*' + str;
+ }
+ if (edit.variation) {
+ str += edit.variation;
+ }
+ str += std::to_string(edit.width);
+ if (edit.digits) {
+ str += "."s + std::to_string(*edit.digits);
+ }
+ if (edit.expoDigits) {
+ str += "E"s + std::to_string(*edit.expoDigits);
+ }
+ // modes?
+ 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) {
+ if (expect != results) {
+ std::cerr << "expected:";
+ for (const std::string &s : expect) {
+ std::cerr << ' ' << s;
+ }
+ std::cerr << "\ngot:";
+ for (const std::string &s : results) {
+ std::cerr << ' ' << s;
+ }
+ std::cerr << '\n';
+ ++failures;
+ }
+ expect.clear();
+ 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};
+ try {
+ for (int j{0}; j < n; ++j) {
+ DataEdit edit;
+ control.GetNext(edit, repeat);
+ Report(edit);
+ }
+ control.FinishOutput();
+ } catch (const std::string &crash) {
+ results.push_back("Crash:"s + crash);
+ }
+ 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')",
+ Results{"'PI='", "F9.7", "'PI='", "F9.7", "'done'"});
+ Test(context, 2, "(3('PI=',F9.7,:),'tooFar')",
+ Results{"'PI='", "F9.7", "'PI='", "F9.7"});
+ Test(context, 2, "(*('PI=',F9.7,:),'tooFar')",
+ Results{"'PI='", "F9.7", "'PI='", "F9.7"});
+ Test(context, 1, "(3F9.7)", Results{"2*F9.7"}, 2);
+ return failures > 0;
+}
projects / platform / upstream / llvm.git / commitdiff