[flang] Support NAMELIST input of short arrays
NAMELIST array input does not need to fully define an array.
If another input item begins after at least one element,
it ends input into the array and the remaining items are
not modified.
The tricky part of supporting this feature is that it's not
always easy to determine whether the next non-blank thing in
the input is a value or the next item's name, esp. in the case
of logical data where T and F can be names. E.g.,
&group logicalArray = t f f t
= 1 /
should read three elements into "logicalArray" and then read
an integer or real variable named "t".
So the I/O runtime has to do some look-ahead to determine whether
the next thing in the input is a name followed by '=', '(', or '%'.
Since the '=' may be on a later record, possibly with intervening
NAMELIST comments, the runtime has to support a general form of
saving and restoring its current position. The infrastructure
in the I/O runtime already has to support repositioning for
list-directed repetition, even on non-positionable input sources
like terminals and sockets; this patch adds an internal RAII API
to make it easier to save a position and then do arbitrary
look-ahead.
Differential Revision: https://reviews.llvm.org/D112245
GitOrigin-RevId: b8452dba28e7449d0b1e47b5341ddf0bef55be68
diff --git a/runtime/connection.h b/runtime/connection.h
index 3a2f303..dfeebeb 100644
--- a/runtime/connection.h
+++ b/runtime/connection.h
@@ -66,5 +66,32 @@
// Mutable modes set at OPEN() that can be overridden in READ/WRITE & FORMAT
MutableModes modes; // BLANK=, DECIMAL=, SIGN=, ROUND=, PAD=, DELIM=, kP
};
+
+// Utility class for capturing and restoring a position in an input stream.
+class SavedPosition {
+public:
+ explicit SavedPosition(ConnectionState &c)
+ : connection_{c}, positionInRecord_{c.positionInRecord},
+ furthestPositionInRecord_{c.furthestPositionInRecord},
+ leftTabLimit_{c.leftTabLimit}, previousResumptionRecordNumber_{
+ c.resumptionRecordNumber} {
+ c.resumptionRecordNumber = c.currentRecordNumber;
+ }
+ ~SavedPosition() {
+ connection_.currentRecordNumber = *connection_.resumptionRecordNumber;
+ connection_.resumptionRecordNumber = previousResumptionRecordNumber_;
+ connection_.leftTabLimit = leftTabLimit_;
+ connection_.furthestPositionInRecord = furthestPositionInRecord_;
+ connection_.positionInRecord = positionInRecord_;
+ }
+
+private:
+ ConnectionState &connection_;
+ std::int64_t positionInRecord_;
+ std::int64_t furthestPositionInRecord_;
+ std::optional<std::int64_t> leftTabLimit_;
+ std::optional<std::int64_t> previousResumptionRecordNumber_;
+};
+
} // namespace Fortran::runtime::io
#endif // FORTRAN_RUNTIME_IO_CONNECTION_H_
diff --git a/runtime/descriptor-io.h b/runtime/descriptor-io.h
index 6246f34..f0d3deb 100644
--- a/runtime/descriptor-io.h
+++ b/runtime/descriptor-io.h
@@ -49,6 +49,7 @@
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+ bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
if (auto edit{io.GetNextDataEdit()}) {
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
@@ -57,8 +58,10 @@
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
- if (!EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
- return false;
+ if (EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
+ anyInput = true;
+ } else {
+ return anyInput && edit->IsNamelist();
}
}
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
@@ -79,6 +82,7 @@
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
+ bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
if (auto edit{io.GetNextDataEdit()}) {
RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
@@ -87,8 +91,10 @@
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
- if (!EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
- return false;
+ if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
+ anyInput = true;
+ } else {
+ return anyInput && edit->IsNamelist();
}
}
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
@@ -111,6 +117,7 @@
bool isListOutput{
io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr};
using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
+ bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
if (isListOutput) {
@@ -132,9 +139,11 @@
}
} else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
break;
- } else if (!EditRealInput<KIND>(
+ } else if (EditRealInput<KIND>(
io, *edit, reinterpret_cast<void *>(x))) {
- return false;
+ anyInput = true;
+ } else {
+ return anyInput && edit->IsNamelist();
}
}
}
@@ -154,6 +163,7 @@
descriptor.GetLowerBounds(subscripts);
std::size_t length{descriptor.ElementBytes() / sizeof(A)};
auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
+ bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
A *x{&ExtractElement<A>(io, descriptor, subscripts)};
if (listOutput) {
@@ -167,8 +177,10 @@
}
} else {
if (edit->descriptor != DataEdit::ListDirectedNullValue) {
- if (!EditDefaultCharacterInput(io, *edit, x, length)) {
- return false;
+ if (EditDefaultCharacterInput(io, *edit, x, length)) {
+ anyInput = true;
+ } else {
+ return anyInput && edit->IsNamelist();
}
}
}
@@ -191,6 +203,7 @@
descriptor.GetLowerBounds(subscripts);
auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+ bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
if (listOutput) {
@@ -207,8 +220,9 @@
bool truth{};
if (EditLogicalInput(io, *edit, truth)) {
x = truth;
+ anyInput = true;
} else {
- return false;
+ return anyInput && edit->IsNamelist();
}
}
}
diff --git a/runtime/edit-input.cpp b/runtime/edit-input.cpp
index 42f1556..c632865 100644
--- a/runtime/edit-input.cpp
+++ b/runtime/edit-input.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "edit-input.h"
+#include "namelist.h"
#include "flang/Common/real.h"
#include "flang/Common/uint128.h"
#include <algorithm>
@@ -69,6 +70,10 @@
RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
switch (edit.descriptor) {
case DataEdit::ListDirected:
+ if (IsNamelistName(io)) {
+ return false;
+ }
+ break;
case 'G':
case 'I':
break;
@@ -298,6 +303,10 @@
constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
switch (edit.descriptor) {
case DataEdit::ListDirected:
+ if (IsNamelistName(io)) {
+ return false;
+ }
+ return EditCommonRealInput<KIND>(io, edit, n);
case DataEdit::ListDirectedRealPart:
case DataEdit::ListDirectedImaginaryPart:
case 'F':
@@ -326,6 +335,10 @@
bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) {
switch (edit.descriptor) {
case DataEdit::ListDirected:
+ if (IsNamelistName(io)) {
+ return false;
+ }
+ break;
case 'L':
case 'G':
break;
@@ -407,6 +420,9 @@
io.HandleRelativePosition(1);
return EditDelimitedCharacterInput(io, x, length, *ch);
}
+ if (IsNamelistName(io)) {
+ return false;
+ }
// Undelimited list-directed character input: stop at a value separator
// or the end of the current record.
std::optional<int> remaining{length};
diff --git a/runtime/format.h b/runtime/format.h
index 1989aa7..8dccaab 100644
--- a/runtime/format.h
+++ b/runtime/format.h
@@ -51,6 +51,9 @@
return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
descriptor == ListDirectedImaginaryPart;
}
+ constexpr bool IsNamelist() const {
+ return IsListDirected() && modes.inNamelist;
+ }
static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
diff --git a/runtime/io-stmt.h b/runtime/io-stmt.h
index 24bbaf1..7e683b1 100644
--- a/runtime/io-stmt.h
+++ b/runtime/io-stmt.h
@@ -229,10 +229,10 @@
std::optional<DataEdit> GetNextDataEdit(
IoStatementState &, int maxRepeat = 1);
- // Each NAMELIST input item is a distinct "list-directed"
- // input statement. This member function resets this state
- // so that repetition and null values work correctly for each
- // successive NAMELIST input item.
+ // Each NAMELIST input item is treated like a distinct list-directed
+ // input statement. This member function resets some state so that
+ // repetition and null values work correctly for each successive
+ // NAMELIST input item.
void ResetForNextNamelistItem() {
remaining_ = 0;
eatComma_ = false;
diff --git a/runtime/namelist.cpp b/runtime/namelist.cpp
index b9b5fbc..c2c3d65 100644
--- a/runtime/namelist.cpp
+++ b/runtime/namelist.cpp
@@ -333,7 +333,7 @@
return false;
}
io.HandleRelativePosition(1);
- // Read the values into the descriptor
+ // Read the values into the descriptor. An array can be short.
listInput->ResetForNextNamelistItem();
if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
return false;
@@ -352,4 +352,25 @@
return true;
}
+bool IsNamelistName(IoStatementState &io) {
+ if (io.get_if<ListDirectedStatementState<Direction::Input>>()) {
+ ConnectionState &connection{io.GetConnectionState()};
+ if (connection.modes.inNamelist) {
+ SavedPosition savedPosition{connection};
+ if (auto ch{io.GetNextNonBlank()}) {
+ if (IsLegalIdStart(*ch)) {
+ do {
+ io.HandleRelativePosition(1);
+ ch = io.GetCurrentChar();
+ } while (ch && IsLegalIdChar(*ch));
+ ch = io.GetNextNonBlank();
+ // TODO: how to deal with NaN(...) ambiguity?
+ return ch && (ch == '=' || ch == '(' || ch == '%');
+ }
+ }
+ }
+ }
+ return false;
+}
+
} // namespace Fortran::runtime::io
diff --git a/runtime/namelist.h b/runtime/namelist.h
index 4f17553..a7c0912 100644
--- a/runtime/namelist.h
+++ b/runtime/namelist.h
@@ -15,6 +15,7 @@
namespace Fortran::runtime {
class Descriptor;
+class IoStatementState;
} // namespace Fortran::runtime
namespace Fortran::runtime::io {
@@ -33,5 +34,11 @@
std::size_t items;
const Item *item; // in original declaration order
};
+
+// Look ahead on input for an identifier followed by a '=', '(', or '%'
+// character; for use in disambiguating a name-like value (e.g. F or T) from a
+// NAMELIST group item name. Always false when not reading a NAMELIST.
+bool IsNamelistName(IoStatementState &);
+
} // namespace Fortran::runtime::io
#endif // FORTRAN_RUNTIME_NAMELIST_H_
diff --git a/unittests/Runtime/Namelist.cpp b/unittests/Runtime/Namelist.cpp
index 67336bb..fd5ee6b 100644
--- a/unittests/Runtime/Namelist.cpp
+++ b/unittests/Runtime/Namelist.cpp
@@ -161,4 +161,32 @@
EXPECT_EQ(got, expect);
}
+TEST(NamelistTests, ShortArrayInput) {
+ OwningPtr<Descriptor> aDesc{
+ MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+ std::vector<int>{2}, std::vector<int>(2, -1))};
+ OwningPtr<Descriptor> bDesc{
+ MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+ std::vector<int>{2}, std::vector<int>(2, -2))};
+ const NamelistGroup::Item items[]{{"a", *aDesc}, {"b", *bDesc}};
+ const NamelistGroup group{"nl", 2, items};
+ // Two 12-character lines of internal input
+ static char t1[]{"&nl a = 1 b "
+ " = 2 / "};
+ StaticDescriptor<1, true> statDesc;
+ Descriptor &internalDesc{statDesc.descriptor()};
+ SubscriptValue shape{2};
+ internalDesc.Establish(1, 12, t1, 1, &shape, 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);
+ EXPECT_EQ(*aDesc->ZeroBasedIndexedElement<int>(0), 1);
+ EXPECT_EQ(*aDesc->ZeroBasedIndexedElement<int>(1), -1);
+ EXPECT_EQ(*bDesc->ZeroBasedIndexedElement<int>(0), 2);
+ EXPECT_EQ(*bDesc->ZeroBasedIndexedElement<int>(1), -2);
+}
+
// TODO: Internal NAMELIST error tests
