[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
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 <stddef.h>
/* 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 @@
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 @@
}
/// returns true iff the expression in the parse tree is not really a format but
-/// rather a namelist variable.
+/// rather a namelist group
template <typename A>
static bool formatIsActuallyNamelist(const A &format) {
if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) {
@@ -1159,26 +1157,20 @@
return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder);
if (isFormatted) {
if (isIntern) {
- if (isNml)
- return getIORuntimeFunc<mkIOKey(BeginInternalNamelistInput)>(loc,
- builder);
if (isOtherIntern) {
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>(
loc, builder);
return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>(
loc, builder);
}
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc,
builder);
return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc,
builder);
}
- if (isNml)
- return getIORuntimeFunc<mkIOKey(BeginExternalNamelistInput)>(loc,
- builder);
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder);
return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc,
builder);
@@ -1189,26 +1181,20 @@
return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder);
if (isFormatted) {
if (isIntern) {
- if (isNml)
- return getIORuntimeFunc<mkIOKey(BeginInternalNamelistOutput)>(
- loc, builder);
if (isOtherIntern) {
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>(
loc, builder);
return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>(
loc, builder);
}
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc,
builder);
return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc,
builder);
}
- if (isNml)
- return getIORuntimeFunc<mkIOKey(BeginExternalNamelistOutput)>(loc,
- builder);
- if (isList)
+ if (isList || isNml)
return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder);
return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(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 @@
};
}
template <>
-constexpr TypeBuilderFunc getModel<const Fortran::runtime::NamelistGroup &>() {
+constexpr TypeBuilderFunc
+getModel<const Fortran::runtime::io::NamelistGroup &>() {
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 @@
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 @@
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 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 @@
// 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 <typename A, Direction DIR>
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 @@
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 @@
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<char32_t> PrepareInput(
- IoStatementState &io, const DataEdit &edit, std::optional<int> &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<int> remaining;
- std::optional<char32_t> next{PrepareInput(io, edit, remaining)};
+ std::optional<char32_t> next{io.PrepareInput(edit, remaining)};
common::UnsignedInt128 value{0};
for (; next; next = io.NextInField(remaining)) {
char32_t ch{*next};
@@ -67,7 +51,7 @@
// Returns true if there's a '-' sign.
static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit,
std::optional<char32_t> &next, std::optional<int> &remaining) {
- next = PrepareInput(io, edit, remaining);
+ next = io.PrepareInput(edit, remaining);
bool negative{false};
if (next) {
negative = *next == '-';
@@ -249,7 +233,19 @@
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 @@
return false;
}
std::optional<int> remaining;
- std::optional<char32_t> next{PrepareInput(io, edit, remaining)};
+ std::optional<char32_t> next{io.PrepareInput(edit, remaining)};
if (next && *next == '.') { // skip optional period
next = io.NextInField(remaining);
}
@@ -372,29 +368,53 @@
// 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 @@
} 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<std::size_t>(total) >
- io.GetConnectionState().RemainingSpaceInRecord() &&
+ int total{std::max(leadingSpaces, 1) + subTotal};
+ if (io.GetConnectionState().NeedAdvance(static_cast<std::size_t>(total)) &&
!io.AdvanceRecord()) {
return false;
}
@@ -135,9 +135,7 @@
: 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 ListDirectedLogicalOutput(IoStatementState &io,
ListDirectedStatementState<Direction::Output> &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 ListDirectedDefaultCharacterOutput(IoStatementState &io,
ListDirectedStatementState<Direction::Output> &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 @@
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 @@
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
}
-template <Direction DIR>
-Cookie BeginExternalListIO(
- ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+template <Direction DIR, template <Direction> 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 @@
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<ExternalListIoStatementState<DIR>>(
- unit, sourceFile, sourceLine)};
+ IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
+ std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
return &io;
}
Cookie IONAME(BeginExternalListOutput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
- return BeginExternalListIO<Direction::Output>(
- unitNumber, sourceFile, sourceLine);
+ return BeginExternalListIO<Direction::Output, ExternalListIoStatementState>(
+ "List-directed output", unitNumber, sourceFile, sourceLine);
}
Cookie IONAME(BeginExternalListInput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
- return BeginExternalListIO<Direction::Input>(
- unitNumber, sourceFile, sourceLine);
+ return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
+ "List-directed input", unitNumber, sourceFile, sourceLine);
}
template <Direction DIR>
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 @@
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 @@
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 @@
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 @@
// 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(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 @@
}
}
+std::optional<char32_t> IoStatementState::PrepareInput(
+ const DataEdit &edit, std::optional<int> &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<char32_t> IoStatementState::SkipSpaces(
std::optional<int> &remaining) {
while (!remaining || *remaining > 0) {
@@ -447,7 +461,7 @@
std::optional<char32_t> IoStatementState::NextInField(
std::optional<int> &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<char32_t> 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 @@
return ch;
}
-bool ListDirectedStatementState<Direction::Output>::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 @@
}
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 @@
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 @@
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 @@
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<char32_t> PrepareInput(
+ const DataEdit &edit, std::optional<int> &remaining);
+
std::optional<char32_t> SkipSpaces(std::optional<int> &remaining);
std::optional<char32_t> NextInField(std::optional<int> &remaining);
- std::optional<char32_t> GetNextNonBlank(); // can advance record
+ // Skips spaces, advances records, and ignores NAMELIST comments
+ std::optional<char32_t> GetNextNonBlank();
template <Direction D> void CheckFormattedStmtType(const char *name) {
if (!get_if<FormattedIoStatementState>() ||
@@ -148,19 +155,25 @@
void BadInquiryKeywordHashCrash(InquiryKeywordHash);
};
-// Common state for list-directed internal & external I/O
+// Common state for list-directed & NAMELIST I/O, both internal & external
template <Direction> class ListDirectedStatementState;
template <>
class ListDirectedStatementState<Direction::Output>
: 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<DataEdit> 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<Direction::Input>
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 <cstring>
+#include <limits>
+
+namespace Fortran::runtime::io {
+
+bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
+ IoStatementState &io{*cookie};
+ io.CheckFormattedStmtType<Direction::Output>("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<char>(*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<Direction::Output>(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<char>(*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<SubscriptValue> GetSubscriptValue(IoStatementState &io) {
+ std::optional<SubscriptValue> value;
+ std::optional<char32_t> 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<SubscriptValue>::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<char32_t> 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<std::intmax_t>(*low),
+ static_cast<std::intmax_t>(dimLower),
+ static_cast<std::intmax_t>(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<std::intmax_t>(*high),
+ static_cast<std::intmax_t>(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<Direction::Input>("InputNamelist");
+ ConnectionState &connection{io.GetConnectionState()};
+ connection.modes.inNamelist = true;
+ IoErrorHandler &handler{io.GetIoErrorHandler()};
+ // Check the group header
+ std::optional<char32_t> 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<maxRank, true, 16> 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<Direction::Input>(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 <cstddef>
+
+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 @@
// headers &/or footers
std::uint32_t length;
length = furthestPositionInRecord - sizeof length;
- ok &= Emit(reinterpret_cast<const char *>(&length), sizeof length,
- sizeof length, handler);
+ ok = ok &&
+ Emit(reinterpret_cast<const char *>(&length), sizeof length,
+ sizeof length, handler);
positionInRecord = 0;
- ok &= Emit(reinterpret_cast<const char *>(&length), sizeof length,
- sizeof length, handler);
+ ok = ok &&
+ Emit(reinterpret_cast<const char *>(&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 @@
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 <algorithm>
+#include <cinttypes>
+#include <complex>
+#include <cstring>
+#include <gtest/gtest.h>
+#include <limits>
+#include <string>
+#include <vector>
+
+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<int> ints;
+ for (int j{0}; j < 20; ++j) {
+ ints.push_back(j % 2 == 0 ? (1 << j) : -(1 << j));
+ }
+ std::vector<double> reals{0.0, -0.0, std::numeric_limits<double>::infinity(),
+ -std::numeric_limits<double>::infinity(),
+ std::numeric_limits<double>::quiet_NaN(),
+ std::numeric_limits<double>::max(), std::numeric_limits<double>::lowest(),
+ std::numeric_limits<double>::epsilon()};
+ std::vector<std::uint8_t> logicals;
+ logicals.push_back(false);
+ logicals.push_back(true);
+ logicals.push_back(false);
+ std::vector<std::complex<float>> complexes;
+ complexes.push_back(std::complex<float>{123.0, -0.5});
+ std::vector<std::string> characters;
+ characters.emplace_back("aBcDeFgHiJkLmNoPqRsTuVwXyZ");
+ characters.emplace_back("0123456789'\" ");
+ // Copy the data into new descriptors
+ OwningPtr<Descriptor> intDesc{
+ MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+ std::vector<int>{5, 4}, std::move(ints))};
+ OwningPtr<Descriptor> realDesc{
+ MakeArray<TypeCategory::Real, static_cast<int>(sizeof(double))>(
+ std::vector<int>{4, 2}, std::move(reals))};
+ OwningPtr<Descriptor> logicalDesc{
+ MakeArray<TypeCategory::Logical, static_cast<int>(sizeof(std::uint8_t))>(
+ std::vector<int>{3}, std::move(logicals))};
+ OwningPtr<Descriptor> complexDesc{
+ MakeArray<TypeCategory::Complex, static_cast<int>(sizeof(float))>(
+ std::vector<int>{}, std::move(complexes))};
+ OwningPtr<Descriptor> characterDesc{MakeArray<TypeCategory::Character, 1>(
+ std::vector<int>{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<int>(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<int>(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<int>(outStatus2);
+ std::string got2{buffer[0], sizeof buffer};
+ EXPECT_EQ(got2, expect);
+}
+
+TEST(NamelistTests, Subscripts) {
+ // INTEGER :: A(-1:0, -1:1)
+ OwningPtr<Descriptor> aDesc{
+ MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+ std::vector<int>{2, 3}, std::vector<int>(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<int>(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<int>(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 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 @@
// 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 @@
// 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<staticDescriptorMaxRank> wholeStaticDescriptor;
- static Descriptor &whole{wholeStaticDescriptor.descriptor()};
- static SubscriptValue extent[]{numLines};
+ StaticDescriptor<staticDescriptorMaxRank> 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<staticDescriptorMaxRank> sectionStaticDescriptor;
- static Descriptor §ion{sectionStaticDescriptor.descriptor()};
+ StaticDescriptor<staticDescriptorMaxRank> 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 @@
// 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 @@
" 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 @@
}
// 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<int>(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, 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<staticDescriptorMaxRank> staticDescriptor;
- static Descriptor &desc{staticDescriptor.descriptor()};
+ StaticDescriptor<staticDescriptorMaxRank> 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 @@
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<int>(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<int>(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 @@
}
using IndividualTestCaseTy = std::tuple<const char *, double, const char *>;
- static std::vector<IndividualTestCaseTy> individualTestCases{
+ static const std::vector<IndividualTestCaseTy> individualTestCases{
{"(F5.3,';')", 25., "*****;"},
{"(F5.3,';')", 2.5, "2.500;"},
{"(F5.3,';')", 0.25, "0.250;"},
@@ -638,7 +642,7 @@
// Ensure double input values correctly map to raw uint64 values
TEST(IOApiTests, FormatDoubleInputValues) {
using TestCaseTy = std::tuple<const char *, const char *, std::uint64_t>;
- static std::vector<TestCaseTy> testCases{
+ static const std::vector<TestCaseTy> testCases{
{"(F18.0)", " 0", 0x0},
{"(F18.0)", " ", 0x0},
{"(F18.0)", " -0", 0x8000000000000000},
@@ -663,7 +667,7 @@
{"(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 @@
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<int>(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 @@
template <TypeCategory CAT, int KIND, typename A>
static OwningPtr<Descriptor> MakeArray(const std::vector<int> &shape,
- const std::vector<A> &data, std::size_t elemLen = KIND) {
+ const std::vector<A> &data,
+ std::size_t elemLen = CAT == TypeCategory::Complex ? 2 * KIND : KIND) {
auto rank{static_cast<int>(shape.size())};
auto result{Descriptor::Create(TypeCode{CAT, KIND}, elemLen, nullptr, rank,
nullptr, CFI_attribute_allocatable)};
