[flang-commits] [flang] [flang][runtime] Make defined formatted I/O process format elementally (PR #74150)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Dec 1 14:22:17 PST 2023
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/74150
The present implementation of defined formatted I/O is incorrect for arrays in the data item list; it assumes that a DT defined format descriptor (or list-directed/namelist instance) applies to all of the elements in the array. The loop over the elements in the array is within the DefinedFormattedIo() template function that handles defined formatted I/O, not around its calls. This causes only one format list edit descriptor to be used for the whole array, which is of course wrong.
Invert this arrangment by performing the per-element looping in at the top level in FormattedDerivedTypeIo() instead.
Defined unformatted I/O remains as it was.
>From f39ca221be5e8d5530ea7be608318446805f2c17 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 1 Dec 2023 14:11:43 -0800
Subject: [PATCH] [flang][runtime] Make defined formatted I/O process format
elementally
The present implementation of defined formatted I/O is incorrect for
arrays in the data item list; it assumes that a DT defined format
descriptor (or list-directed/namelist instance) applies to all of
the elements in the array. The loop over the elements in the array
is within the DefinedFormattedIo() template function that handles
defined formatted I/O, not around its calls. This causes only
one format list edit descriptor to be used for the whole array,
which is of course wrong.
Invert this arrangment by performing the per-element looping in
at the top level in FormattedDerivedTypeIo() instead.
Defined unformatted I/O remains as it was.
---
flang/runtime/descriptor-io.cpp | 26 +++-------
flang/runtime/descriptor-io.h | 90 +++++++++++++++++++++++----------
2 files changed, 71 insertions(+), 45 deletions(-)
diff --git a/flang/runtime/descriptor-io.cpp b/flang/runtime/descriptor-io.cpp
index 563a69e999d5f45..c35b2442c86d308 100644
--- a/flang/runtime/descriptor-io.cpp
+++ b/flang/runtime/descriptor-io.cpp
@@ -14,7 +14,8 @@ namespace Fortran::runtime::io::descr {
// Defined formatted I/O (maybe)
std::optional<bool> DefinedFormattedIo(IoStatementState &io,
const Descriptor &descriptor, const typeInfo::DerivedType &derived,
- const typeInfo::SpecialBinding &special) {
+ const typeInfo::SpecialBinding &special,
+ const SubscriptValue subscripts[]) {
std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
if (peek &&
(peek->descriptor == DataEdit::DefinedDerivedType ||
@@ -61,9 +62,6 @@ std::optional<bool> DefinedFormattedIo(IoStatementState &io,
// I/O subroutine reads counts towards READ(SIZE=).
startPos = io.InquirePos();
}
- std::size_t numElements{descriptor.Elements()};
- SubscriptValue subscripts[maxRank];
- descriptor.GetLowerBounds(subscripts);
if (special.IsArgDescriptor(0)) {
// "dtv" argument is "class(t)", pass a descriptor
auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
@@ -72,25 +70,15 @@ std::optional<bool> DefinedFormattedIo(IoStatementState &io,
Descriptor &elementDesc{elementStatDesc.descriptor()};
elementDesc.Establish(
derived, nullptr, 0, nullptr, CFI_attribute_pointer);
- for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
- elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
- p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
- sizeof ioMsg);
- if (ioStat != IostatOk) {
- break;
- }
- }
+ elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
+ p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
+ sizeof ioMsg);
} else {
// "dtv" argument is "type(t)", pass a raw pointer
auto *p{special.GetProc<void (*)(const void *, int &, char *,
const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
- for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
- p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
- ioMsg, ioTypeLen, sizeof ioMsg);
- if (ioStat != IostatOk) {
- break;
- }
- }
+ p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
+ ioMsg, ioTypeLen, sizeof ioMsg);
}
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
external->PopChildIo(child);
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index 2b5bf8248aca2a3..534298b57cf31a1 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -268,7 +268,34 @@ static bool DefaultComponentIO(IoStatementState &io,
}
template <Direction DIR>
-static bool DefaultComponentwiseIO(IoStatementState &io,
+static bool DefaultComponentwiseFormattedIO(IoStatementState &io,
+ const Descriptor &descriptor, const typeInfo::DerivedType &type,
+ const NonTbpDefinedIoTable *table, const SubscriptValue subscripts[],
+ bool isFirstElement) {
+ IoErrorHandler &handler{io.GetIoErrorHandler()};
+ const Descriptor &compArray{type.component()};
+ RUNTIME_CHECK(handler, compArray.rank() == 1);
+ std::size_t numComponents{compArray.Elements()};
+ SubscriptValue at[maxRank];
+ compArray.GetLowerBounds(at);
+ for (std::size_t k{0}; k < numComponents;
+ ++k, compArray.IncrementSubscripts(at)) {
+ const typeInfo::Component &component{
+ *compArray.Element<typeInfo::Component>(at)};
+ if (!DefaultComponentIO<DIR>(
+ io, component, descriptor, subscripts, handler, table)) {
+ // Truncated nonempty namelist input sequence?
+ auto *listInput{
+ io.get_if<ListDirectedStatementState<Direction::Input>>()};
+ return DIR == Direction::Input && (!isFirstElement || k > 0) &&
+ listInput && listInput->inNamelistSequence();
+ }
+ }
+ return true;
+}
+
+template <Direction DIR>
+static bool DefaultComponentwiseUnformattedIO(IoStatementState &io,
const Descriptor &descriptor, const typeInfo::DerivedType &type,
const NonTbpDefinedIoTable *table) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
@@ -288,11 +315,7 @@ static bool DefaultComponentwiseIO(IoStatementState &io,
*compArray.Element<typeInfo::Component>(at)};
if (!DefaultComponentIO<DIR>(
io, component, descriptor, subscripts, handler, table)) {
- // Truncated nonempty namelist input sequence?
- auto *listInput{
- io.get_if<ListDirectedStatementState<Direction::Input>>()};
- return DIR == Direction::Input && (j > 0 || k > 0) && listInput &&
- listInput->inNamelistSequence();
+ return false;
}
}
}
@@ -300,7 +323,8 @@ static bool DefaultComponentwiseIO(IoStatementState &io,
}
std::optional<bool> DefinedFormattedIo(IoStatementState &, const Descriptor &,
- const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
+ const typeInfo::DerivedType &, const typeInfo::SpecialBinding &,
+ const SubscriptValue[]);
template <Direction DIR>
static bool FormattedDerivedTypeIO(IoStatementState &io,
@@ -311,37 +335,50 @@ static bool FormattedDerivedTypeIO(IoStatementState &io,
RUNTIME_CHECK(handler, addendum != nullptr);
const typeInfo::DerivedType *type{addendum->derivedType()};
RUNTIME_CHECK(handler, type != nullptr);
+ std::optional<typeInfo::SpecialBinding> nonTbpSpecial;
+ const typeInfo::SpecialBinding *special{nullptr};
if (table) {
if (const auto *definedIo{table->Find(*type,
DIR == Direction::Input ? common::DefinedIo::ReadFormatted
: common::DefinedIo::WriteFormatted)}) {
if (definedIo->subroutine) {
- typeInfo::SpecialBinding special{DIR == Direction::Input
+ nonTbpSpecial.emplace(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadFormatted
: typeInfo::SpecialBinding::Which::WriteFormatted,
definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
- false};
- if (std::optional<bool> wasDefined{
- DefinedFormattedIo(io, descriptor, *type, special)}) {
- return *wasDefined;
- }
- } else {
- return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+ false);
+ special = &*nonTbpSpecial;
}
}
}
- if (const typeInfo::SpecialBinding *
- special{type->FindSpecialBinding(DIR == Direction::Input
- ? typeInfo::SpecialBinding::Which::ReadFormatted
- : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
- if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
- if (std::optional<bool> wasDefined{
- DefinedFormattedIo(io, descriptor, *type, *special)}) {
- return *wasDefined; // defined I/O was applied
+ if (!special) {
+ if (const typeInfo::SpecialBinding *
+ binding{type->FindSpecialBinding(DIR == Direction::Input
+ ? typeInfo::SpecialBinding::Which::ReadFormatted
+ : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
+ if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) {
+ special = binding;
}
}
}
- return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+ SubscriptValue subscripts[maxRank];
+ descriptor.GetLowerBounds(subscripts);
+ std::size_t numElements{descriptor.Elements()};
+ for (std::size_t j{0}; j < numElements;
+ ++j, descriptor.IncrementSubscripts(subscripts)) {
+ std::optional<bool> result;
+ if (special) {
+ result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts);
+ }
+ if (!result) {
+ result = DefaultComponentwiseFormattedIO<DIR>(
+ io, descriptor, *type, table, subscripts, j > 0);
+ }
+ if (!result.value()) {
+ return false;
+ }
+ }
+ return true;
}
bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
@@ -371,7 +408,8 @@ static bool UnformattedDescriptorIO(IoStatementState &io,
return *wasDefined;
}
} else {
- return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+ return DefaultComponentwiseUnformattedIO<DIR>(
+ io, descriptor, *type, table);
}
}
}
@@ -388,7 +426,7 @@ static bool UnformattedDescriptorIO(IoStatementState &io,
// TODO: If no component at any level has defined READ or WRITE
// (as appropriate), the elements are contiguous, and no byte swapping
// is active, do a block transfer via the code below.
- return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+ return DefaultComponentwiseUnformattedIO<DIR>(io, descriptor, *type, table);
} else {
// intrinsic type unformatted I/O
auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
More information about the flang-commits
mailing list