Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2024-11-23 13:50:11 +00:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[flang] Implement NAMELIST I/O in the runtime

Browse Source 
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
This commit is contained in:
peter klausler 2021-05-05 11:37:49 -07:00
parent 306370be0b
commit 6a1c3efa05
23 changed files with 751 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/include/flang/ISO_Fortran_binding.h
View File

@ -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.
*/

32
flang/lib/Lower/IO.cpp
View File

@ -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 <typename A>
static bool formatIsActuallyNamelist(const A &format) {
if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) {
@ -1159,26 +1157,20 @@ mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder,
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 @@ mlir::FuncOp getBeginDataTransfer(mlir::Location loc, FirOpBuilder &builder,
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);

3
flang/lib/Lower/RTBuilder.h
View File

@ -164,7 +164,8 @@ constexpr TypeBuilderFunc getModel<const Fortran::runtime::Descriptor &>() {
};
}
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

1
flang/runtime/CMakeLists.txt
View File

@ -54,6 +54,7 @@ add_flang_library(FortranRuntime
main.cpp
memory.cpp
misc-intrinsic.cpp
namelist.cpp
numeric.cpp
random.cpp
reduction.cpp

4
flang/runtime/connection.cpp
View File

@ -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;
}

1
flang/runtime/connection.h
View File

@ -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);

4
flang/runtime/descriptor-io.h
View File

@ -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 <typename A, Direction DIR>
inline bool FormattedIntegerIO(
IoStatementState &io, const Descriptor &descriptor) {

19
flang/runtime/descriptor.cpp
View File

@ -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
}

8
flang/runtime/descriptor.h
View File

@ -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;

94
flang/runtime/edit-input.cpp
View File

@ -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 @@ 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<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 @@ 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<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 @@ 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(

42
flang/runtime/edit-output.cpp
View File

@ -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<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 @@ 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<binaryPrecision>::Edit(const DataEdit &edit) {
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 EditLogicalOutput(IoStatementState &io, const DataEdit &edit, bool truth) {
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;
}

3
flang/runtime/format.h
View File

@ -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)"

22
flang/runtime/io-api.cpp
View File

@ -147,9 +147,9 @@ Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
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 @@ 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<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>

29
flang/runtime/io-api.h
View File

@ -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()

39
flang/runtime/io-stmt.cpp
View File

@ -427,6 +427,20 @@ bool IoStatementState::EmitField(
}
}
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::SkipSpaces(
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::NextInField(
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 @@ std::optional<char32_t> IoStatementState::GetNextNonBlank() {
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 @@ bool ListDirectedStatementState<Direction::Output>::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<Direction::Input>::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<Direction::Input>::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) {

25
flang/runtime/io-stmt.h
View File

@ -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<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 @@ 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 <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>

309
flang/runtime/namelist.cpp Normal file
View File

@ -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

37
flang/runtime/namelist.h Normal file
View File

@ -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_

12
flang/runtime/unit.cpp
View File

@ -446,14 +446,16 @@ bool ExternalFileUnit::AdvanceRecord(IoErrorHandler &handler) {
// 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_ +=

1
flang/unittests/RuntimeGTest/CMakeLists.txt
View File

@ -3,6 +3,7 @@ add_flang_unittest(FlangRuntimeTests
CrashHandlerFixture.cpp
Format.cpp
MiscIntrinsic.cpp
Namelist.cpp
Numeric.cpp
NumericalFormatTest.cpp
Random.cpp

164
flang/unittests/RuntimeGTest/Namelist.cpp Normal file
View File

@ -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

74
flang/unittests/RuntimeGTest/NumericalFormatTest.cpp
View File

@ -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<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 &section{sectionStaticDescriptor.descriptor()};
StaticDescriptor<staticDescriptorMaxRank> sectionStaticDescriptor;
Descriptor &section{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<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, 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<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 @@ 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<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 @@ TEST(IOApiTests, FormatDoubleValues) {
}
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 @@ TEST(IOApiTests, FormatDoubleValues) {
// 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 @@ 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<int>(status)
<< " iomsg '" << iomsg << "'";

3
flang/unittests/RuntimeGTest/tools.h
View File

@ -34,7 +34,8 @@ static void StoreElement(
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)};