From 6a1c3efa051e012aaf102b7d9e7e428a58ea8ad9 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 5 May 2021 11:37:49 -0700 Subject: [PATCH] [flang] Implement NAMELIST I/O in the runtime Add InputNamelist and OutputNamelist as I/O data transfer APIs to be used with internal & external list-directed I/O; delete the needless original namelist-specific Begin... calls. Implement NAMELIST output and input; add basic tests. Differential Revision: https://reviews.llvm.org/D101931 --- flang/include/flang/ISO_Fortran_binding.h | 2 +- flang/lib/Lower/IO.cpp | 32 +-- flang/lib/Lower/RTBuilder.h | 3 +- flang/runtime/CMakeLists.txt | 1 + flang/runtime/connection.cpp | 4 + flang/runtime/connection.h | 1 + flang/runtime/descriptor-io.h | 4 + flang/runtime/descriptor.cpp | 19 ++ flang/runtime/descriptor.h | 8 +- flang/runtime/edit-input.cpp | 94 ++++--- flang/runtime/edit-output.cpp | 42 +-- flang/runtime/format.h | 3 +- flang/runtime/io-api.cpp | 22 +- flang/runtime/io-api.h | 29 +- flang/runtime/io-stmt.cpp | 39 +-- flang/runtime/io-stmt.h | 25 +- flang/runtime/namelist.cpp | 309 +++++++++++++++++++++ flang/runtime/namelist.h | 37 +++ flang/runtime/unit.cpp | 12 +- flang/unittests/RuntimeGTest/CMakeLists.txt | 1 + flang/unittests/RuntimeGTest/Namelist.cpp | 164 +++++++++++ .../unittests/RuntimeGTest/NumericalFormatTest.cpp | 74 ++--- flang/unittests/RuntimeGTest/tools.h | 3 +- 23 files changed, 751 insertions(+), 177 deletions(-) create mode 100644 flang/runtime/namelist.cpp create mode 100644 flang/runtime/namelist.h create mode 100644 flang/unittests/RuntimeGTest/Namelist.cpp diff --git a/flang/include/flang/ISO_Fortran_binding.h b/flang/include/flang/ISO_Fortran_binding.h index f616902..bbb9587 100644 --- a/flang/include/flang/ISO_Fortran_binding.h +++ b/flang/include/flang/ISO_Fortran_binding.h @@ -13,7 +13,7 @@ #include /* Standard interface to Fortran from C and C++. - * These interfaces are named in section 18.5 of the Fortran 2018 + * These interfaces are named in subclause 18.5 of the Fortran 2018 * standard, with most of the actual details being left to the * implementation. */ diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index aae12aa..cca8561 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -39,12 +39,10 @@ static constexpr std::tuple< mkIOKey(BeginInternalArrayFormattedOutput), mkIOKey(BeginInternalArrayFormattedInput), mkIOKey(BeginInternalListOutput), mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalFormattedOutput), - mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginInternalNamelistOutput), - mkIOKey(BeginInternalNamelistInput), mkIOKey(BeginExternalListOutput), + mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginExternalListOutput), mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput), mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput), - mkIOKey(BeginUnformattedInput), mkIOKey(BeginExternalNamelistOutput), - mkIOKey(BeginExternalNamelistInput), mkIOKey(BeginAsynchronousOutput), + mkIOKey(BeginUnformattedInput), mkIOKey(BeginAsynchronousOutput), mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll), mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace), mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit), @@ -810,7 +808,7 @@ static const auto *getIOControl(const A &stmt) { } /// returns true iff the expression in the parse tree is not really a format but -/// rather a namelist variable. +/// rather a namelist group template static bool formatIsActuallyNamelist(const A &format) { if (auto *e = std::get_if(&format.u)) { @@ -1159,26 +1157,20 @@ mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, return getIORuntimeFunc(loc, builder); if (isFormatted) { if (isIntern) { - if (isNml) - return getIORuntimeFunc(loc, - builder); if (isOtherIntern) { - if (isList) + if (isList || isNml) return getIORuntimeFunc( loc, builder); return getIORuntimeFunc( loc, builder); } - if (isList) + if (isList || isNml) return getIORuntimeFunc(loc, builder); return getIORuntimeFunc(loc, builder); } - if (isNml) - return getIORuntimeFunc(loc, - builder); - if (isList) + if (isList || isNml) return getIORuntimeFunc(loc, builder); return getIORuntimeFunc(loc, builder); @@ -1189,26 +1181,20 @@ mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder, return getIORuntimeFunc(loc, builder); if (isFormatted) { if (isIntern) { - if (isNml) - return getIORuntimeFunc( - loc, builder); if (isOtherIntern) { - if (isList) + if (isList || isNml) return getIORuntimeFunc( loc, builder); return getIORuntimeFunc( loc, builder); } - if (isList) + if (isList || isNml) return getIORuntimeFunc(loc, builder); return getIORuntimeFunc(loc, builder); } - if (isNml) - return getIORuntimeFunc(loc, - builder); - if (isList) + if (isList || isNml) return getIORuntimeFunc(loc, builder); return getIORuntimeFunc(loc, builder); diff --git a/flang/lib/Lower/RTBuilder.h b/flang/lib/Lower/RTBuilder.h index 4b130b6..38dfa60 100644 --- a/flang/lib/Lower/RTBuilder.h +++ b/flang/lib/Lower/RTBuilder.h @@ -164,7 +164,8 @@ constexpr TypeBuilderFunc getModel() { }; } template <> -constexpr TypeBuilderFunc getModel() { +constexpr TypeBuilderFunc +getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { // FIXME: a namelist group must be some well-defined data structure, use a // tuple as a proxy for the moment diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 781e8e5..c63fd3d 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -54,6 +54,7 @@ add_flang_library(FortranRuntime main.cpp memory.cpp misc-intrinsic.cpp + namelist.cpp numeric.cpp random.cpp reduction.cpp diff --git a/flang/runtime/connection.cpp b/flang/runtime/connection.cpp index d61f4ce..dc6823a 100644 --- a/flang/runtime/connection.cpp +++ b/flang/runtime/connection.cpp @@ -18,6 +18,10 @@ std::size_t ConnectionState::RemainingSpaceInRecord() const { return positionInRecord >= recl ? 0 : recl - positionInRecord; } +bool ConnectionState::NeedAdvance(std::size_t width) const { + return positionInRecord > 0 && width > RemainingSpaceInRecord(); +} + bool ConnectionState::IsAtEOF() const { return endfileRecordNumber && currentRecordNumber >= *endfileRecordNumber; } diff --git a/flang/runtime/connection.h b/flang/runtime/connection.h index 24aae65..6eb6b62 100644 --- a/flang/runtime/connection.h +++ b/flang/runtime/connection.h @@ -35,6 +35,7 @@ struct ConnectionAttributes { struct ConnectionState : public ConnectionAttributes { bool IsAtEOF() const; // true when read has hit EOF or endfile record std::size_t RemainingSpaceInRecord() const; + bool NeedAdvance(std::size_t) const; void HandleAbsolutePosition(std::int64_t); void HandleRelativePosition(std::int64_t); diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h index 4947668..e664f4c 100644 --- a/flang/runtime/descriptor-io.h +++ b/flang/runtime/descriptor-io.h @@ -32,6 +32,10 @@ inline A &ExtractElement(IoStatementState &io, const Descriptor &descriptor, // Per-category descriptor-based I/O templates +// TODO (perhaps as a nontrivial but small starter project): implement +// automatic repetition counts, like "10*3.14159", for list-directed and +// NAMELIST array output. + template inline bool FormattedIntegerIO( IoStatementState &io, const Descriptor &descriptor) { diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp index 3a75025..6715afa 100644 --- a/flang/runtime/descriptor.cpp +++ b/flang/runtime/descriptor.cpp @@ -234,6 +234,25 @@ bool Descriptor::SubscriptsForZeroBasedElementNumber(SubscriptValue *subscript, return true; } +bool Descriptor::EstablishPointerSection(const Descriptor &source, + const SubscriptValue *lower, const SubscriptValue *upper, + const SubscriptValue *stride) { + *this = source; + raw_.attribute = CFI_attribute_pointer; + int newRank{raw_.rank}; + for (int j{0}; j < raw_.rank; ++j) { + if (!stride || stride[j] == 0) { + if (newRank > 0) { + --newRank; + } else { + return false; + } + } + } + raw_.rank = newRank; + return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS; +} + void Descriptor::Check() const { // TODO } diff --git a/flang/runtime/descriptor.h b/flang/runtime/descriptor.h index 2ce90f3..d86c136 100644 --- a/flang/runtime/descriptor.h +++ b/flang/runtime/descriptor.h @@ -314,9 +314,13 @@ public: return true; } - void Check() const; + // Establishes a pointer to a section or element. + bool EstablishPointerSection(const Descriptor &source, + const SubscriptValue *lower = nullptr, + const SubscriptValue *upper = nullptr, + const SubscriptValue *stride = nullptr); - // TODO: creation of array sections + void Check() const; void Dump(FILE * = stdout) const; diff --git a/flang/runtime/edit-input.cpp b/flang/runtime/edit-input.cpp index 08693f2..6ecbc16 100644 --- a/flang/runtime/edit-input.cpp +++ b/flang/runtime/edit-input.cpp @@ -13,26 +13,10 @@ namespace Fortran::runtime::io { -// For fixed-width fields, initialize the number of remaining characters. -// Skip over leading blanks, then return the first non-blank character (if any). -static std::optional PrepareInput( - IoStatementState &io, const DataEdit &edit, std::optional &remaining) { - remaining.reset(); - if (edit.descriptor == DataEdit::ListDirected) { - io.GetNextNonBlank(); - } else { - if (edit.width.value_or(0) > 0) { - remaining = *edit.width; - } - io.SkipSpaces(remaining); - } - return io.NextInField(remaining); -} - static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n, int base, int totalBitSize) { std::optional remaining; - std::optional next{PrepareInput(io, edit, remaining)}; + std::optional next{io.PrepareInput(edit, remaining)}; common::UnsignedInt128 value{0}; for (; next; next = io.NextInField(remaining)) { char32_t ch{*next}; @@ -67,7 +51,7 @@ static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n, // Returns true if there's a '-' sign. static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit, std::optional &next, std::optional &remaining) { - next = PrepareInput(io, edit, remaining); + next = io.PrepareInput(edit, remaining); bool negative{false}; if (next) { negative = *next == '-'; @@ -249,7 +233,19 @@ static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io, exponent = 0; return 0; } - if (remaining) { + // Consume the trailing ')' of a list-directed or NAMELIST complex + // input value. + if (edit.descriptor == DataEdit::ListDirectedImaginaryPart) { + if (next && (*next == ' ' || *next == '\t')) { + next = io.NextInField(remaining); + } + if (!next) { // NextInField fails on separators like ')' + next = io.GetCurrentChar(); + if (next && *next == ')') { + io.HandleRelativePosition(1); + } + } + } else if (remaining) { while (next && (*next == ' ' || *next == '\t')) { next = io.NextInField(remaining); } @@ -338,7 +334,7 @@ bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) { return false; } std::optional remaining; - std::optional next{PrepareInput(io, edit, remaining)}; + std::optional next{io.PrepareInput(edit, remaining)}; if (next && *next == '.') { // skip optional period next = io.NextInField(remaining); } @@ -372,29 +368,53 @@ bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) { // See 13.10.3.1 paragraphs 7-9 in Fortran 2018 static bool EditDelimitedCharacterInput( IoStatementState &io, char *x, std::size_t length, char32_t delimiter) { + bool result{true}; while (true) { - if (auto ch{io.GetCurrentChar()}) { - io.HandleRelativePosition(1); - if (*ch == delimiter) { - ch = io.GetCurrentChar(); - if (ch && *ch == delimiter) { - // Repeated delimiter: use as character value. Can't straddle a - // record boundary. + auto ch{io.GetCurrentChar()}; + if (!ch) { + if (io.AdvanceRecord()) { + continue; + } else { + result = false; // EOF in character value + break; + } + } + io.HandleRelativePosition(1); + if (*ch == delimiter) { + if (auto next{io.GetCurrentChar()}) { + if (*next == delimiter) { + // Repeated delimiter: use as character value io.HandleRelativePosition(1); - } else { - std::fill_n(x, length, ' '); - return true; + } else { // closing delimiter + break; } + } else { // delimiter was at the end of the record + if (length > 0) { + // Look ahead on next record: if it begins with the delimiter, + // treat it as a split character value, ignoring both delimiters + ConnectionState &connection{io.GetConnectionState()}; + auto position{connection.positionInRecord}; + if (io.AdvanceRecord()) { + if (auto next{io.GetCurrentChar()}; next && *next == delimiter) { + // Character constant split over a record boundary + io.HandleRelativePosition(1); + continue; + } + // Not a character value split over a record boundary. + io.BackspaceRecord(); + connection.HandleAbsolutePosition(position); + } + } + break; } - if (length > 0) { - *x++ = *ch; - --length; - } - } else if (!io.AdvanceRecord()) { // EOF - std::fill_n(x, length, ' '); - return false; + } + if (length > 0) { + *x++ = *ch; + --length; } } + std::fill_n(x, length, ' '); + return result; } static bool EditListDirectedDefaultCharacterInput( diff --git a/flang/runtime/edit-output.cpp b/flang/runtime/edit-output.cpp index 76f24cb..2c5803b 100644 --- a/flang/runtime/edit-output.cpp +++ b/flang/runtime/edit-output.cpp @@ -74,14 +74,14 @@ bool EditIntegerOutput(IoStatementState &io, const DataEdit &edit, INT n) { } else if (n == 0) { leadingZeroes = 1; } - int total{signChars + leadingZeroes + digits}; - if (editWidth > 0 && total > editWidth) { + int subTotal{signChars + leadingZeroes + digits}; + int leadingSpaces{std::max(0, editWidth - subTotal)}; + if (editWidth > 0 && leadingSpaces + subTotal > editWidth) { return io.EmitRepeated('*', editWidth); } - int leadingSpaces{std::max(0, editWidth - total)}; if (edit.IsListDirected()) { - if (static_cast(total) > - io.GetConnectionState().RemainingSpaceInRecord() && + int total{std::max(leadingSpaces, 1) + subTotal}; + if (io.GetConnectionState().NeedAdvance(static_cast(total)) && !io.AdvanceRecord()) { return false; } @@ -135,9 +135,7 @@ bool RealOutputEditingBase::EmitPrefix( : 0}; length += prefixLength + suffixLength; ConnectionState &connection{io_.GetConnectionState()}; - return (connection.positionInRecord == 0 || - length <= connection.RemainingSpaceInRecord() || - io_.AdvanceRecord()) && + return (!connection.NeedAdvance(length) || io_.AdvanceRecord()) && io_.Emit(" (", prefixLength); } else if (width > length) { return io_.EmitRepeated(' ', width - length); @@ -416,7 +414,7 @@ bool RealOutputEditing::Edit(const DataEdit &edit) { bool ListDirectedLogicalOutput(IoStatementState &io, ListDirectedStatementState &list, bool truth) { - return list.EmitLeadingSpaceOrAdvance(io, 1) && io.Emit(truth ? "T" : "F", 1); + return list.EmitLeadingSpaceOrAdvance(io) && io.Emit(truth ? "T" : "F", 1); } bool EditLogicalOutput(IoStatementState &io, const DataEdit &edit, bool truth) { @@ -436,38 +434,42 @@ bool EditLogicalOutput(IoStatementState &io, const DataEdit &edit, bool truth) { bool ListDirectedDefaultCharacterOutput(IoStatementState &io, ListDirectedStatementState &list, const char *x, std::size_t length) { - bool ok{list.EmitLeadingSpaceOrAdvance(io, length, true)}; + bool ok{true}; MutableModes &modes{io.mutableModes()}; ConnectionState &connection{io.GetConnectionState()}; if (modes.delim) { + ok = ok && list.EmitLeadingSpaceOrAdvance(io); // Value is delimited with ' or " marks, and interior // instances of that character are doubled. When split // over multiple lines, delimit each lines' part. - ok &= io.Emit(&modes.delim, 1); + ok = ok && io.Emit(&modes.delim, 1); for (std::size_t j{0}; j < length; ++j) { - if (list.NeedAdvance(connection, 2)) { - ok &= io.Emit(&modes.delim, 1) && io.AdvanceRecord() && + if (connection.NeedAdvance(2)) { + ok = ok && io.Emit(&modes.delim, 1) && io.AdvanceRecord() && io.Emit(&modes.delim, 1); } if (x[j] == modes.delim) { - ok &= io.EmitRepeated(modes.delim, 2); + ok = ok && io.EmitRepeated(modes.delim, 2); } else { - ok &= io.Emit(&x[j], 1); + ok = ok && io.Emit(&x[j], 1); } } - ok &= io.Emit(&modes.delim, 1); + ok = ok && io.Emit(&modes.delim, 1); } else { // Undelimited list-directed output + ok = ok && + list.EmitLeadingSpaceOrAdvance( + io, length > 0 && !list.lastWasUndelimitedCharacter()); std::size_t put{0}; - while (put < length) { + while (ok && put < length) { auto chunk{std::min(length - put, connection.RemainingSpaceInRecord())}; - ok &= io.Emit(x + put, chunk); + ok = ok && io.Emit(x + put, chunk); put += chunk; if (put < length) { - ok &= io.AdvanceRecord() && io.Emit(" ", 1); + ok = ok && io.AdvanceRecord() && io.Emit(" ", 1); } } - list.lastWasUndelimitedCharacter = true; + list.set_lastWasUndelimitedCharacter(true); } return ok; } diff --git a/flang/runtime/format.h b/flang/runtime/format.h index 3a10b88..9dcd59a 100644 --- a/flang/runtime/format.h +++ b/flang/runtime/format.h @@ -34,13 +34,14 @@ struct MutableModes { bool pad{true}; // PAD= mode on READ char delim{'\0'}; // DELIM= short scale{0}; // kP + bool inNamelist{false}; // skip ! comments }; // 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 - // Special internal data edit descriptors for list-directed I/O + // Special internal data edit descriptors for list-directed & NAMELIST I/O static constexpr char ListDirected{'g'}; // non-COMPLEX list-directed static constexpr char ListDirectedRealPart{'r'}; // emit "(r," or "(r;" static constexpr char ListDirectedImaginaryPart{'z'}; // emit "z)" diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp index 1fa2fb9..9c2d436 100644 --- a/flang/runtime/io-api.cpp +++ b/flang/runtime/io-api.cpp @@ -147,9 +147,9 @@ Cookie IONAME(BeginInternalFormattedInput)(const char *internal, format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine); } -template -Cookie BeginExternalListIO( - ExternalUnit unitNumber, const char *sourceFile, int sourceLine) { +template class STATE, typename... A> +Cookie BeginExternalListIO(const char *what, int unitNumber, + const char *sourceFile, int sourceLine, A &&...xs) { Terminator terminator{sourceFile, sourceLine}; if (unitNumber == DefaultUnit) { unitNumber = DIR == Direction::Input ? 5 : 6; @@ -157,33 +157,33 @@ Cookie BeginExternalListIO( ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous( unitNumber, DIR, false /*!unformatted*/, terminator)}; if (unit.access == Access::Direct) { - terminator.Crash("List-directed I/O attempted on direct access file"); + terminator.Crash("%s attempted on direct access file", what); return nullptr; } if (!unit.isUnformatted.has_value()) { unit.isUnformatted = false; } if (*unit.isUnformatted) { - terminator.Crash("List-directed I/O attempted on unformatted file"); + terminator.Crash("%s attempted on unformatted file", what); return nullptr; } IoErrorHandler handler{terminator}; unit.SetDirection(DIR, handler); - IoStatementState &io{unit.BeginIoStatement>( - unit, sourceFile, sourceLine)}; + IoStatementState &io{unit.BeginIoStatement>( + std::forward(xs)..., unit, sourceFile, sourceLine)}; return &io; } Cookie IONAME(BeginExternalListOutput)( ExternalUnit unitNumber, const char *sourceFile, int sourceLine) { - return BeginExternalListIO( - unitNumber, sourceFile, sourceLine); + return BeginExternalListIO( + "List-directed output", unitNumber, sourceFile, sourceLine); } Cookie IONAME(BeginExternalListInput)( ExternalUnit unitNumber, const char *sourceFile, int sourceLine) { - return BeginExternalListIO( - unitNumber, sourceFile, sourceLine); + return BeginExternalListIO( + "List-directed input", unitNumber, sourceFile, sourceLine); } template diff --git a/flang/runtime/io-api.h b/flang/runtime/io-api.h index 80a6de9..13254ce 100644 --- a/flang/runtime/io-api.h +++ b/flang/runtime/io-api.h @@ -18,11 +18,11 @@ namespace Fortran::runtime { class Descriptor; -class NamelistGroup; } // namespace Fortran::runtime namespace Fortran::runtime::io { +class NamelistGroup; class IoStatementState; using Cookie = IoStatementState *; using ExternalUnit = int; @@ -70,6 +70,10 @@ constexpr std::size_t RecommendedInternalIoScratchAreaBytes( return 32 + 8 * maxFormatParenthesesNestingDepth; } +// For NAMELIST I/O, use the API for the appropriate form of list-directed +// I/O initiation and configuration, then call OutputNamelist/InputNamelist +// below. + // Internal I/O to/from character arrays &/or non-default-kind character // requires a descriptor, which is copied. Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &, @@ -106,16 +110,6 @@ Cookie IONAME(BeginInternalFormattedInput)(const char *internal, void **scratchArea = nullptr, std::size_t scratchBytes = 0, const char *sourceFile = nullptr, int sourceLine = 0); -// Internal namelist I/O -Cookie IONAME(BeginInternalNamelistOutput)(const Descriptor &, - const NamelistGroup &, void **scratchArea = nullptr, - std::size_t scratchBytes = 0, const char *sourceFile = nullptr, - int sourceLine = 0); -Cookie IONAME(BeginInternalNamelistInput)(const Descriptor &, - const NamelistGroup &, void **scratchArea = nullptr, - std::size_t scratchBytes = 0, const char *sourceFile = nullptr, - int sourceLine = 0); - // External synchronous I/O initiation Cookie IONAME(BeginExternalListOutput)(ExternalUnit = DefaultUnit, const char *sourceFile = nullptr, int sourceLine = 0); @@ -131,12 +125,6 @@ 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(BeginExternalNamelistOutput)(const NamelistGroup &, - ExternalUnit = DefaultUnit, const char *sourceFile = nullptr, - int sourceLine = 0); -Cookie IONAME(BeginExternalNamelistInput)(const NamelistGroup &, - ExternalUnit = DefaultUnit, const char *sourceFile = nullptr, - int sourceLine = 0); // Asynchronous I/O is supported (at most) for unformatted direct access // block transfers. @@ -215,7 +203,7 @@ bool IONAME(SetRound)(Cookie, const char *, std::size_t); // SIGN=PLUS, SUPPRESS, PROCESSOR_DEFINED bool IONAME(SetSign)(Cookie, const char *, std::size_t); -// Data item transfer for modes other than namelist. +// Data item transfer for modes other than NAMELIST: // Any data object that can be passed as an actual argument without the // use of a temporary can be transferred by means of a descriptor; // vector-valued subscripts and coindexing will require elementwise @@ -254,6 +242,11 @@ bool IONAME(InputAscii)(Cookie, char *, std::size_t); bool IONAME(OutputLogical)(Cookie, bool); bool IONAME(InputLogical)(Cookie, bool &); +// NAMELIST I/O must be the only data item in an (otherwise) +// list-directed I/O statement. +bool IONAME(OutputNamelist)(Cookie, const NamelistGroup &); +bool IONAME(InputNamelist)(Cookie, const NamelistGroup &); + // Additional specifier interfaces for the connection-list of // on OPEN statement (only). SetBlank(), SetDecimal(), // SetDelim(), GetIoMsg(), SetPad(), SetRound(), & SetSign() diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp index 89279b3..099d903 100644 --- a/flang/runtime/io-stmt.cpp +++ b/flang/runtime/io-stmt.cpp @@ -427,6 +427,20 @@ bool IoStatementState::EmitField( } } +std::optional IoStatementState::PrepareInput( + const DataEdit &edit, std::optional &remaining) { + remaining.reset(); + if (edit.descriptor == DataEdit::ListDirected) { + GetNextNonBlank(); + } else { + if (edit.width.value_or(0) > 0) { + remaining = *edit.width; + } + SkipSpaces(remaining); + } + return NextInField(remaining); +} + std::optional IoStatementState::SkipSpaces( std::optional &remaining) { while (!remaining || *remaining > 0) { @@ -447,7 +461,7 @@ std::optional IoStatementState::SkipSpaces( std::optional IoStatementState::NextInField( std::optional &remaining) { - if (!remaining) { // list-directed or namelist: check for separators + if (!remaining) { // list-directed or NAMELIST: check for separators if (auto next{GetCurrentChar()}) { switch (*next) { case ' ': @@ -494,8 +508,9 @@ std::optional IoStatementState::NextInField( std::optional IoStatementState::GetNextNonBlank() { auto ch{GetCurrentChar()}; - while (!ch || *ch == ' ' || *ch == '\t') { - if (ch) { + bool inNamelist{GetConnectionState().modes.inNamelist}; + while (!ch || *ch == ' ' || *ch == '\t' || (inNamelist && *ch == '!')) { + if (ch && (*ch == ' ' || *ch == '\t')) { HandleRelativePosition(1); } else if (!AdvanceRecord()) { return std::nullopt; @@ -505,12 +520,6 @@ std::optional IoStatementState::GetNextNonBlank() { return ch; } -bool ListDirectedStatementState::NeedAdvance( - const ConnectionState &connection, std::size_t width) const { - return connection.positionInRecord > 0 && - width > connection.RemainingSpaceInRecord(); -} - bool IoStatementState::Inquire( InquiryKeywordHash inquiry, char *out, std::size_t chars) { return std::visit( @@ -538,9 +547,9 @@ bool ListDirectedStatementState::EmitLeadingSpaceOrAdvance( } const ConnectionState &connection{io.GetConnectionState()}; int space{connection.positionInRecord == 0 || - !(isCharacter && lastWasUndelimitedCharacter)}; - lastWasUndelimitedCharacter = false; - if (NeedAdvance(connection, space + length)) { + !(isCharacter && lastWasUndelimitedCharacter())}; + set_lastWasUndelimitedCharacter(false); + if (connection.NeedAdvance(space + length)) { return io.AdvanceRecord(); } if (space) { @@ -596,10 +605,6 @@ ListDirectedStatementState::GetNextDataEdit( auto ch{io.GetNextNonBlank()}; if (imaginaryPart_) { imaginaryPart_ = false; - if (ch && *ch == ')') { - io.HandleRelativePosition(1); - ch = io.GetNextNonBlank(); - } } else if (realPart_) { realPart_ = false; imaginaryPart_ = true; @@ -621,6 +626,8 @@ ListDirectedStatementState::GetNextDataEdit( return edit; } // Consume comma & whitespace after previous item. + // This includes the comma between real and imaginary components + // in list-directed/NAMELIST complex input. io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); if (!ch) { diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h index 000b1ac..b76c520 100644 --- a/flang/runtime/io-stmt.h +++ b/flang/runtime/io-stmt.h @@ -93,9 +93,16 @@ public: bool EmitRepeated(char, std::size_t); bool EmitField(const char *, std::size_t length, std::size_t width); + // For fixed-width fields, initialize the number of remaining characters. + // Skip over leading blanks, then return the first non-blank character (if + // any). + std::optional PrepareInput( + const DataEdit &edit, std::optional &remaining); + std::optional SkipSpaces(std::optional &remaining); std::optional NextInField(std::optional &remaining); - std::optional GetNextNonBlank(); // can advance record + // Skips spaces, advances records, and ignores NAMELIST comments + std::optional GetNextNonBlank(); template void CheckFormattedStmtType(const char *name) { if (!get_if() || @@ -148,19 +155,25 @@ struct IoStatementBase : public DefaultFormatControlCallbacks { void BadInquiryKeywordHashCrash(InquiryKeywordHash); }; -// Common state for list-directed internal & external I/O +// Common state for list-directed & NAMELIST I/O, both internal & external template class ListDirectedStatementState; template <> class ListDirectedStatementState : public FormattedIoStatementState { public: - static std::size_t RemainingSpaceInRecord(const ConnectionState &); - bool NeedAdvance(const ConnectionState &, std::size_t) const; bool EmitLeadingSpaceOrAdvance( - IoStatementState &, std::size_t, bool isCharacter = false); + IoStatementState &, std::size_t = 1, bool isCharacter = false); std::optional GetNextDataEdit( IoStatementState &, int maxRepeat = 1); - bool lastWasUndelimitedCharacter{false}; + bool lastWasUndelimitedCharacter() const { + return lastWasUndelimitedCharacter_; + } + void set_lastWasUndelimitedCharacter(bool yes = true) { + lastWasUndelimitedCharacter_ = yes; + } + +private: + bool lastWasUndelimitedCharacter_{false}; }; template <> class ListDirectedStatementState diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp new file mode 100644 index 0000000..f26ae84 --- /dev/null +++ b/flang/runtime/namelist.cpp @@ -0,0 +1,309 @@ +//===-- runtime/namelist.cpp ------------------------------------*- 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 "namelist.h" +#include "descriptor-io.h" +#include "io-api.h" +#include "io-stmt.h" +#include +#include + +namespace Fortran::runtime::io { + +bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) { + IoStatementState &io{*cookie}; + io.CheckFormattedStmtType("OutputNamelist"); + ConnectionState &connection{io.GetConnectionState()}; + connection.modes.inNamelist = true; + // Internal functions to advance records and convert case + const auto EmitWithAdvance{[&](char ch) -> bool { + return (!connection.NeedAdvance(1) || io.AdvanceRecord()) && + io.Emit(&ch, 1); + }}; + const auto EmitUpperCase{[&](const char *str) -> bool { + if (connection.NeedAdvance(std::strlen(str)) && + !(io.AdvanceRecord() && io.Emit(" ", 1))) { + return false; + } + for (; *str; ++str) { + char up{*str >= 'a' && *str <= 'z' ? static_cast(*str - 'a' + 'A') + : *str}; + if (!io.Emit(&up, 1)) { + return false; + } + } + return true; + }}; + // &GROUP + if (!(EmitWithAdvance('&') && EmitUpperCase(group.groupName))) { + return false; + } + for (std::size_t j{0}; j < group.items; ++j) { + // [,]ITEM=... + const NamelistGroup::Item &item{group.item[j]}; + if (!(EmitWithAdvance(j == 0 ? ' ' : ',') && EmitUpperCase(item.name) && + EmitWithAdvance('=') && + descr::DescriptorIO(io, item.descriptor))) { + return false; + } + } + // terminal / + return EmitWithAdvance('/'); +} + +static bool GetLowerCaseName( + IoStatementState &io, char buffer[], std::size_t maxLength) { + if (auto ch{io.GetCurrentChar()}) { + static const auto IsLegalIdStart{[](char32_t ch) -> bool { + return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || + ch == '_' || ch == '@' || ch == '$'; + }}; + if (IsLegalIdStart(*ch)) { + std::size_t j{0}; + do { + buffer[j] = + static_cast(*ch >= 'A' && *ch <= 'Z' ? *ch - 'A' + 'a' : *ch); + io.HandleRelativePosition(1); + ch = io.GetCurrentChar(); + } while (++j < maxLength && ch && + (IsLegalIdStart(*ch) || (*ch >= '0' && *ch <= '9'))); + buffer[j++] = '\0'; + if (j <= maxLength) { + return true; + } + io.GetIoErrorHandler().SignalError( + "Identifier '%s...' in NAMELIST input group is too long", buffer); + } + } + return false; +} + +static std::optional GetSubscriptValue(IoStatementState &io) { + std::optional value; + std::optional ch{io.GetCurrentChar()}; + bool negate{ch && *ch == '-'}; + if (negate) { + io.HandleRelativePosition(1); + ch = io.GetCurrentChar(); + } + bool overflow{false}; + while (ch && *ch >= '0' && *ch <= '9') { + SubscriptValue was{value.value_or(0)}; + overflow |= was >= std::numeric_limits::max() / 10; + value = 10 * was + *ch - '0'; + io.HandleRelativePosition(1); + ch = io.GetCurrentChar(); + } + if (overflow) { + io.GetIoErrorHandler().SignalError( + "NAMELIST input subscript value overflow"); + return std::nullopt; + } + if (negate) { + if (value) { + return -*value; + } else { + io.HandleRelativePosition(-1); // give back '-' with no digits + } + } + return value; +} + +static bool HandleSubscripts(IoStatementState &io, Descriptor &desc, + const Descriptor &source, const char *name) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + io.HandleRelativePosition(1); // skip '(' + // Allow for blanks in subscripts; it's nonstandard, but not ambiguous + // within the parentheses + SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank]; + int j{0}; + std::size_t elemLen{source.ElementBytes()}; + bool ok{true}; + std::optional ch{io.GetNextNonBlank()}; + for (; ch && *ch != ')'; ++j) { + SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; + if (j < maxRank && j < source.rank()) { + const Dimension &dim{source.GetDimension(j)}; + dimLower = dim.LowerBound(); + dimUpper = dim.UpperBound(); + dimStride = elemLen ? dim.ByteStride() / elemLen : 1; + } else if (ok) { + handler.SignalError( + "Too many subscripts for rank-%d NAMELIST group item '%s'", + source.rank(), name); + ok = false; + } + if (auto low{GetSubscriptValue(io)}) { + if (*low < dimLower || (dimUpper >= dimLower && *low > dimUpper)) { + if (ok) { + handler.SignalError("Subscript %jd out of range %jd..%jd in NAMELIST " + "group item '%s' dimension %d", + static_cast(*low), + static_cast(dimLower), + static_cast(dimUpper), name, j + 1); + ok = false; + } + } else { + dimLower = *low; + } + ch = io.GetNextNonBlank(); + } + if (ch && *ch == ':') { + io.HandleRelativePosition(1); + ch = io.GetNextNonBlank(); + if (auto high{GetSubscriptValue(io)}) { + if (*high > dimUpper) { + if (ok) { + handler.SignalError( + "Subscript triplet upper bound %jd out of range (>%jd) in " + "NAMELIST group item '%s' dimension %d", + static_cast(*high), + static_cast(dimUpper), name, j + 1); + ok = false; + } + } else { + dimUpper = *high; + } + ch = io.GetNextNonBlank(); + } + if (ch && *ch == ':') { + io.HandleRelativePosition(1); + ch = io.GetNextNonBlank(); + if (auto str{GetSubscriptValue(io)}) { + dimStride = *str; + ch = io.GetNextNonBlank(); + } + } + } else { // scalar + dimUpper = dimLower; + dimStride = 0; + } + if (ch && *ch == ',') { + io.HandleRelativePosition(1); + ch = io.GetNextNonBlank(); + } + if (ok) { + lower[j] = dimLower; + upper[j] = dimUpper; + stride[j] = dimStride; + } + } + if (ok) { + if (ch && *ch == ')') { + io.HandleRelativePosition(1); + if (desc.EstablishPointerSection(source, lower, upper, stride)) { + return true; + } else { + handler.SignalError( + "Bad subscripts for NAMELIST input group item '%s'", name); + } + } else { + handler.SignalError( + "Bad subscripts (missing ')') for NAMELIST input group item '%s'", + name); + } + } + return false; +} + +bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) { + IoStatementState &io{*cookie}; + io.CheckFormattedStmtType("InputNamelist"); + ConnectionState &connection{io.GetConnectionState()}; + connection.modes.inNamelist = true; + IoErrorHandler &handler{io.GetIoErrorHandler()}; + // Check the group header + std::optional next{io.GetNextNonBlank()}; + if (!next || *next != '&') { + handler.SignalError( + "NAMELIST input group does not begin with '&' (at '%lc')", *next); + return false; + } + io.HandleRelativePosition(1); + char name[101]; + if (!GetLowerCaseName(io, name, sizeof name)) { + handler.SignalError("NAMELIST input group has no name"); + return false; + } + RUNTIME_CHECK(handler, group.groupName != nullptr); + if (std::strcmp(group.groupName, name) != 0) { + handler.SignalError( + "NAMELIST input group name '%s' is not the expected '%s'", name, + group.groupName); + return false; + } + // Read the group's items + while (true) { + next = io.GetNextNonBlank(); + if (!next || *next == '/') { + break; + } + if (!GetLowerCaseName(io, name, sizeof name)) { + handler.SignalError( + "NAMELIST input group '%s' was not terminated", group.groupName); + return false; + } + std::size_t itemIndex{0}; + for (; itemIndex < group.items; ++itemIndex) { + if (std::strcmp(name, group.item[itemIndex].name) == 0) { + break; + } + } + if (itemIndex >= group.items) { + handler.SignalError( + "'%s' is not an item in NAMELIST group '%s'", name, group.groupName); + return false; + } + // Handle indexing and components, if any. No spaces are allowed. + // A copy of the descriptor is made if necessary. + const Descriptor &itemDescriptor{group.item[itemIndex].descriptor}; + const Descriptor *useDescriptor{&itemDescriptor}; + StaticDescriptor staticDesc[2]; + int whichStaticDesc{0}; + next = io.GetCurrentChar(); + if (next && (*next == '(' || *next == '%')) { + do { + if (*next == '(') { + Descriptor &mutableDescriptor{ + staticDesc[whichStaticDesc].descriptor()}; + whichStaticDesc ^= 1; + HandleSubscripts(io, mutableDescriptor, *useDescriptor, name); + useDescriptor = &mutableDescriptor; + } else { + handler.Crash("unimplemented: component references in NAMELIST"); + } + next = io.GetCurrentChar(); + } while (next && (*next == '(' || *next == '%')); + } + // Skip the '=' + next = io.GetNextNonBlank(); + if (!next || *next != '=') { + handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'", + name, group.groupName); + return false; + } + io.HandleRelativePosition(1); + // Read the values into the descriptor + if (!descr::DescriptorIO(io, *useDescriptor)) { + return false; + } + next = io.GetNextNonBlank(); + if (next && *next == ',') { + io.HandleRelativePosition(1); + } + } + if (!next || *next != '/') { + handler.SignalError( + "No '/' found after NAMELIST group '%s'", group.groupName); + return false; + } + io.HandleRelativePosition(1); + return true; +} + +} // namespace Fortran::runtime::io diff --git a/flang/runtime/namelist.h b/flang/runtime/namelist.h new file mode 100644 index 0000000..4f17553 --- /dev/null +++ b/flang/runtime/namelist.h @@ -0,0 +1,37 @@ +//===-- runtime/namelist.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 +// +//===----------------------------------------------------------------------===// + +// Defines the data structure used for NAMELIST I/O + +#ifndef FORTRAN_RUNTIME_NAMELIST_H_ +#define FORTRAN_RUNTIME_NAMELIST_H_ + +#include + +namespace Fortran::runtime { +class Descriptor; +} // namespace Fortran::runtime + +namespace Fortran::runtime::io { + +// A NAMELIST group is a named ordered collection of distinct variable names. +// It is packaged by lowering into an instance of this class. +// If all the items are variables with fixed addresses, the NAMELIST group +// description can be in a read-only section. +class NamelistGroup { +public: + struct Item { + const char *name; // NUL-terminated lower-case + const Descriptor &descriptor; + }; + const char *groupName; // NUL-terminated lower-case + std::size_t items; + const Item *item; // in original declaration order +}; +} // namespace Fortran::runtime::io +#endif // FORTRAN_RUNTIME_NAMELIST_H_ diff --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp index 646908f..5a256c2 100644 --- a/flang/runtime/unit.cpp +++ b/flang/runtime/unit.cpp @@ -446,14 +446,16 @@ bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) { // headers &/or footers std::uint32_t length; length = furthestPositionInRecord - sizeof length; - ok &= Emit(reinterpret_cast(&length), sizeof length, - sizeof length, handler); + ok = ok && + Emit(reinterpret_cast(&length), sizeof length, + sizeof length, handler); positionInRecord = 0; - ok &= Emit(reinterpret_cast(&length), sizeof length, - sizeof length, handler); + ok = ok && + Emit(reinterpret_cast(&length), sizeof length, + sizeof length, handler); } else { // Terminate formatted variable length record - ok &= Emit("\n", 1, 1, handler); // TODO: Windows CR+LF + ok = ok && Emit("\n", 1, 1, handler); // TODO: Windows CR+LF } } frameOffsetInFile_ += diff --git a/flang/unittests/RuntimeGTest/CMakeLists.txt b/flang/unittests/RuntimeGTest/CMakeLists.txt index cc29f31..cad827a 100644 --- a/flang/unittests/RuntimeGTest/CMakeLists.txt +++ b/flang/unittests/RuntimeGTest/CMakeLists.txt @@ -3,6 +3,7 @@ add_flang_unittest(FlangRuntimeTests CrashHandlerFixture.cpp Format.cpp MiscIntrinsic.cpp + Namelist.cpp Numeric.cpp NumericalFormatTest.cpp Random.cpp diff --git a/flang/unittests/RuntimeGTest/Namelist.cpp b/flang/unittests/RuntimeGTest/Namelist.cpp new file mode 100644 index 0000000..fc38cee --- /dev/null +++ b/flang/unittests/RuntimeGTest/Namelist.cpp @@ -0,0 +1,164 @@ +//===-- flang/unittests/RuntimeGTest/Namelist.cpp ---------------*- 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 "../../runtime/namelist.h" +#include "CrashHandlerFixture.h" +#include "tools.h" +#include "../../runtime/descriptor.h" +#include "../../runtime/io-api.h" +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace Fortran::runtime; +using namespace Fortran::runtime::io; + +struct NamelistTests : CrashHandlerFixture {}; + +static void ClearDescriptorStorage(const Descriptor &descriptor) { + std::memset(descriptor.raw().base_addr, 0, + descriptor.Elements() * descriptor.ElementBytes()); +} + +TEST(NamelistTests, BasicSanity) { + static constexpr int numLines{12}; + static constexpr int lineLength{32}; + static char buffer[numLines][lineLength]; + StaticDescriptor<1> statDescs[1]; + Descriptor &internalDesc{statDescs[0].descriptor()}; + SubscriptValue extent[]{numLines}; + internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/lineLength, + &buffer, 1, extent, CFI_attribute_pointer); + // Set up data arrays + std::vector ints; + for (int j{0}; j < 20; ++j) { + ints.push_back(j % 2 == 0 ? (1 << j) : -(1 << j)); + } + std::vector reals{0.0, -0.0, std::numeric_limits::infinity(), + -std::numeric_limits::infinity(), + std::numeric_limits::quiet_NaN(), + std::numeric_limits::max(), std::numeric_limits::lowest(), + std::numeric_limits::epsilon()}; + std::vector logicals; + logicals.push_back(false); + logicals.push_back(true); + logicals.push_back(false); + std::vector> complexes; + complexes.push_back(std::complex{123.0, -0.5}); + std::vector characters; + characters.emplace_back("aBcDeFgHiJkLmNoPqRsTuVwXyZ"); + characters.emplace_back("0123456789'\" "); + // Copy the data into new descriptors + OwningPtr intDesc{ + MakeArray(sizeof(int))>( + std::vector{5, 4}, std::move(ints))}; + OwningPtr realDesc{ + MakeArray(sizeof(double))>( + std::vector{4, 2}, std::move(reals))}; + OwningPtr logicalDesc{ + MakeArray(sizeof(std::uint8_t))>( + std::vector{3}, std::move(logicals))}; + OwningPtr complexDesc{ + MakeArray(sizeof(float))>( + std::vector{}, std::move(complexes))}; + OwningPtr characterDesc{MakeArray( + std::vector{2}, std::move(characters), characters[0].size())}; + // Create a NAMELIST group + static constexpr int items{5}; + const NamelistGroup::Item itemArray[items]{{"ints", *intDesc}, + {"reals", *realDesc}, {"logicals", *logicalDesc}, + {"complexes", *complexDesc}, {"characters", *characterDesc}}; + const NamelistGroup group{"group1", items, itemArray}; + // Do an internal NAMELIST write and check results + auto outCookie1{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDelim)(outCookie1, "APOSTROPHE", 10)); + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie1, group)); + auto outStatus1{IONAME(EndIoStatement)(outCookie1)}; + ASSERT_EQ(outStatus1, 0) << "Failed namelist output sanity, status " + << static_cast(outStatus1); + + static const std::string expect{"&GROUP1 INTS= 1 -2 4 -8 16 -32 " + " 64 -128 256 -512 1024 -2048 " + " 4096 -8192 16384 -32768 65536 " + " -131072 262144 -524288,REALS= " + " 0. -0. Inf -Inf NaN " + " 1.7976931348623157E+308 " + " -1.7976931348623157E+308 " + " 2.220446049250313E-16,LOGICALS=" + "F T F,COMPLEXES= (123.,-.5), " + " CHARACTERS= 'aBcDeFgHiJkLmNoPq'" + "'RsTuVwXyZ' '0123456789''\" '" + "' '/ "}; + std::string got{buffer[0], sizeof buffer}; + EXPECT_EQ(got, expect); + + // Clear the arrays, read them back, write out again, and compare + ClearDescriptorStorage(*intDesc); + ClearDescriptorStorage(*realDesc); + ClearDescriptorStorage(*logicalDesc); + ClearDescriptorStorage(*complexDesc); + ClearDescriptorStorage(*characterDesc); + auto inCookie{IONAME(BeginInternalArrayListInput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group)); + auto inStatus{IONAME(EndIoStatement)(inCookie)}; + ASSERT_EQ(inStatus, 0) << "Failed namelist input sanity, status " + << static_cast(inStatus); + auto outCookie2{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDelim)(outCookie2, "APOSTROPHE", 10)); + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie2, group)); + auto outStatus2{IONAME(EndIoStatement)(outCookie2)}; + ASSERT_EQ(outStatus2, 0) << "Failed namelist output sanity rewrite, status " + << static_cast(outStatus2); + std::string got2{buffer[0], sizeof buffer}; + EXPECT_EQ(got2, expect); +} + +TEST(NamelistTests, Subscripts) { + // INTEGER :: A(-1:0, -1:1) + OwningPtr aDesc{ + MakeArray(sizeof(int))>( + std::vector{2, 3}, std::vector(6, 0))}; + aDesc->GetDimension(0).SetBounds(-1, 0); + aDesc->GetDimension(1).SetBounds(-1, 1); + const NamelistGroup::Item items[]{{"a", *aDesc}}; + const NamelistGroup group{"justa", 1, items}; + static char t1[]{"&justa A(0,1:-1:-2)=1 2/"}; + StaticDescriptor<1> statDescs[2]; + Descriptor &internalDesc{statDescs[0].descriptor()}; + internalDesc.Establish(TypeCode{CFI_type_char}, + /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer); + auto inCookie{IONAME(BeginInternalArrayListInput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group)); + auto inStatus{IONAME(EndIoStatement)(inCookie)}; + ASSERT_EQ(inStatus, 0) << "Failed namelist input subscripts, status " + << static_cast(inStatus); + char out[40]; + internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/sizeof out, + out, 0, nullptr, CFI_attribute_pointer); + auto outCookie{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group)); + auto outStatus{IONAME(EndIoStatement)(outCookie)}; + ASSERT_EQ(outStatus, 0) + << "Failed namelist output subscripts rewrite, status " + << static_cast(outStatus); + std::string got{out, sizeof out}; + static const std::string expect{"&JUSTA A= 0 2 0 0 0 1/ "}; + EXPECT_EQ(got, expect); +} + +// TODO: Internal NAMELIST error tests diff --git a/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp b/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp index 7788c43..470c2c6 100644 --- a/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp +++ b/flang/unittests/RuntimeGTest/NumericalFormatTest.cpp @@ -34,11 +34,10 @@ static bool CompareFormattedStrings( static bool CompareFormatReal( const char *format, double x, const char *expect) { char buffer[800]; - auto *cookie{IONAME(BeginInternalFormattedOutput)( + auto cookie{IONAME(BeginInternalFormattedOutput)( buffer, sizeof buffer, format, std::strlen(format))}; - IONAME(OutputReal64)(cookie, x); + EXPECT_TRUE(IONAME(OutputReal64)(cookie, x)); auto status{IONAME(EndIoStatement)(cookie)}; - EXPECT_EQ(status, 0); return CompareFormattedStrings(expect, std::string{buffer, sizeof buffer}); } @@ -61,7 +60,7 @@ TEST(IOApiTests, HelloWorldOutputTest) { // Create format for all types and values to be written const char *format{"(6HHELLO,,A6,2X,I3,1X,'0x',Z8,1X,L1)"}; - auto *cookie{IONAME(BeginInternalFormattedOutput)( + auto cookie{IONAME(BeginInternalFormattedOutput)( buffer, bufferSize, format, std::strlen(format))}; // Write string, integer, and logical values to buffer @@ -86,21 +85,21 @@ TEST(IOApiTests, MultilineOutputTest) { // Allocate buffer for multiline output static constexpr int numLines{5}; static constexpr int lineLength{32}; - static char buffer[numLines][lineLength]; + char buffer[numLines][lineLength]; // Create descriptor for entire buffer static constexpr int staticDescriptorMaxRank{1}; - static StaticDescriptor wholeStaticDescriptor; - static Descriptor &whole{wholeStaticDescriptor.descriptor()}; - static SubscriptValue extent[]{numLines}; + StaticDescriptor wholeStaticDescriptor; + Descriptor &whole{wholeStaticDescriptor.descriptor()}; + static const SubscriptValue extent[]{numLines}; whole.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/lineLength, &buffer, staticDescriptorMaxRank, extent, CFI_attribute_pointer); whole.Dump(stderr); whole.Check(); // Create descriptor for buffer section - static StaticDescriptor sectionStaticDescriptor; - static Descriptor §ion{sectionStaticDescriptor.descriptor()}; + StaticDescriptor sectionStaticDescriptor; + Descriptor §ion{sectionStaticDescriptor.descriptor()}; static const SubscriptValue lowers[]{0}, uppers[]{4}, strides[]{1}; section.Establish(whole.type(), /*elementBytes=*/whole.ElementBytes(), nullptr, /*maxRank=*/staticDescriptorMaxRank, extent, @@ -116,7 +115,7 @@ TEST(IOApiTests, MultilineOutputTest) { // Create format string and initialize IO operation const char *format{ "('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,17X,'abcd',1(2I4))"}; - static auto *cookie{IONAME(BeginInternalArrayFormattedOutput)( + auto cookie{IONAME(BeginInternalArrayFormattedOutput)( section, format, std::strlen(format))}; // Write data to buffer @@ -138,18 +137,19 @@ TEST(IOApiTests, MultilineOutputTest) { " 888 999 " " "}; // Ensure formatted string matches expected output - ASSERT_TRUE( + EXPECT_TRUE( CompareFormattedStrings(expect, std::string{buffer[0], sizeof buffer})) - << "Expected " << expect << " but got " << buffer; + << "Expected '" << expect << "' but got '" + << std::string{buffer[0], sizeof buffer} << "'"; } TEST(IOApiTests, ListInputTest) { static const char input[]{",1*,(5.,6..)"}; - static auto *cookie{IONAME(BeginInternalListInput)(input, sizeof input - 1)}; + auto cookie{IONAME(BeginInternalListInput)(input, sizeof input - 1)}; // Create real values for IO tests static constexpr int numRealValues{6}; - static float z[numRealValues]; + float z[numRealValues]; for (int j{0}; j < numRealValues; ++j) { z[j] = -(j + 1); } @@ -161,13 +161,13 @@ TEST(IOApiTests, ListInputTest) { } // Ensure no IO errors occured during IO operations above - static auto status{IONAME(EndIoStatement)(cookie)}; + auto status{IONAME(EndIoStatement)(cookie)}; ASSERT_EQ(status, 0) << "Failed complex list-directed input, status " << static_cast(status); // Ensure writing complex values from floats does not result in an error static constexpr int bufferSize{33}; - static char output[bufferSize]; + char output[bufferSize]; output[bufferSize - 1] = '\0'; cookie = IONAME(BeginInternalListOutput)(output, bufferSize - 1); for (int j{0}; j < numRealValues; j += 2) { @@ -189,22 +189,22 @@ TEST(IOApiTests, ListInputTest) { } TEST(IOApiTests, DescriptorOutputTest) { - static constexpr int bufferSize{9}; - static char buffer[bufferSize]; - static const char *format{"(2A4)"}; - static auto *cookie{IONAME(BeginInternalFormattedOutput)( + static constexpr int bufferSize{10}; + char buffer[bufferSize]; + const char *format{"(2A4)"}; + auto cookie{IONAME(BeginInternalFormattedOutput)( buffer, bufferSize, format, std::strlen(format))}; // Create descriptor for output static constexpr int staticDescriptorMaxRank{1}; - static StaticDescriptor staticDescriptor; - static Descriptor &desc{staticDescriptor.descriptor()}; + StaticDescriptor staticDescriptor; + Descriptor &desc{staticDescriptor.descriptor()}; static constexpr int subscriptExtent{2}; static const SubscriptValue extent[]{subscriptExtent}; // Manually write to descriptor buffer static constexpr int dataLength{4}; - static char data[subscriptExtent][dataLength]; + char data[subscriptExtent][dataLength]; std::memcpy(data[0], "ABCD", dataLength); std::memcpy(data[1], "EFGH", dataLength); desc.Establish(TypeCode{CFI_type_char}, dataLength, &data, @@ -214,28 +214,32 @@ TEST(IOApiTests, DescriptorOutputTest) { IONAME(OutputDescriptor)(cookie, desc); // Ensure no errors were encountered in initializing the cookie and descriptor - static auto formatStatus{IONAME(EndIoStatement)(cookie)}; + auto formatStatus{IONAME(EndIoStatement)(cookie)}; ASSERT_EQ(formatStatus, 0) << "descrOutputTest: '" << format << "' failed, status " << static_cast(formatStatus); // Ensure buffer matches expected output - ASSERT_TRUE( - CompareFormattedStrings("ABCDEFGH ", std::string{buffer, sizeof buffer})); + EXPECT_TRUE( + CompareFormattedStrings("ABCDEFGH ", std::string{buffer, sizeof buffer})) + << "descrOutputTest: formatted: got '" + << std::string{buffer, sizeof buffer} << "'"; // Begin list-directed output on cookie by descriptor cookie = IONAME(BeginInternalListOutput)(buffer, sizeof buffer); IONAME(OutputDescriptor)(cookie, desc); // Ensure list-directed output does not result in an IO error - static auto listDirectedStatus{IONAME(EndIoStatement)(cookie)}; + auto listDirectedStatus{IONAME(EndIoStatement)(cookie)}; ASSERT_EQ(listDirectedStatus, 0) << "descrOutputTest: list-directed failed, status " << static_cast(listDirectedStatus); // Ensure buffer matches expected output - ASSERT_TRUE( - CompareFormattedStrings(" ABCDEFGH", std::string{buffer, sizeof buffer})); + EXPECT_TRUE( + CompareFormattedStrings(" ABCDEFGH ", std::string{buffer, sizeof buffer})) + << "descrOutputTest: list-directed: got '" + << std::string{buffer, sizeof buffer} << "'"; } //------------------------------------------------------------------------------ @@ -608,7 +612,7 @@ TEST(IOApiTests, FormatDoubleValues) { } using IndividualTestCaseTy = std::tuple; - static std::vector individualTestCases{ + static const std::vector individualTestCases{ {"(F5.3,';')", 25., "*****;"}, {"(F5.3,';')", 2.5, "2.500;"}, {"(F5.3,';')", 0.25, "0.250;"}, @@ -638,7 +642,7 @@ TEST(IOApiTests, FormatDoubleValues) { // Ensure double input values correctly map to raw uint64 values TEST(IOApiTests, FormatDoubleInputValues) { using TestCaseTy = std::tuple; - static std::vector testCases{ + static const std::vector testCases{ {"(F18.0)", " 0", 0x0}, {"(F18.0)", " ", 0x0}, {"(F18.0)", " -0", 0x8000000000000000}, @@ -663,7 +667,7 @@ TEST(IOApiTests, FormatDoubleInputValues) { {"(DC,F18.0)", " 12,5", 0x4029000000000000}, }; for (auto const &[format, data, want] : testCases) { - auto *cookie{IONAME(BeginInternalFormattedInput)( + auto cookie{IONAME(BeginInternalFormattedInput)( data, std::strlen(data), format, std::strlen(format))}; union { double x; @@ -676,12 +680,12 @@ TEST(IOApiTests, FormatDoubleInputValues) { IONAME(InputReal64)(cookie, u.x); static constexpr int bufferSize{65}; - static char iomsg[bufferSize]; + char iomsg[bufferSize]; std::memset(iomsg, '\0', bufferSize - 1); // Ensure no errors were encountered reading input buffer into union value IONAME(GetIoMsg)(cookie, iomsg, bufferSize - 1); - static auto status{IONAME(EndIoStatement)(cookie)}; + auto status{IONAME(EndIoStatement)(cookie)}; ASSERT_EQ(status, 0) << '\'' << format << "' failed reading '" << data << "', status " << static_cast(status) << " iomsg '" << iomsg << "'"; diff --git a/flang/unittests/RuntimeGTest/tools.h b/flang/unittests/RuntimeGTest/tools.h index c2c31dc..bca579b 100644 --- a/flang/unittests/RuntimeGTest/tools.h +++ b/flang/unittests/RuntimeGTest/tools.h @@ -34,7 +34,8 @@ static void StoreElement( template static OwningPtr MakeArray(const std::vector &shape, - const std::vector &data, std::size_t elemLen = KIND) { + const std::vector &data, + std::size_t elemLen = CAT == TypeCategory::Complex ? 2 * KIND : KIND) { auto rank{static_cast(shape.size())}; auto result{Descriptor::Create(TypeCode{CAT, KIND}, elemLen, nullptr, rank, nullptr, CFI_attribute_allocatable)}; -- 2.7.4