[flang][runtime] Make defined formatted I/O process format elementally (#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.
This commit is contained in:
Peter Klausler 2023-12-11 11:55:44 -08:00 committed by GitHub
parent 54397f9ac1
commit a6e77fdd74
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 74 additions and 45 deletions

View File

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

View File

@ -268,7 +268,33 @@ 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[]) {
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)) {
// Return true for NAMELIST input if any component appeared.
auto *listInput{
io.get_if<ListDirectedStatementState<Direction::Input>>()};
return DIR == Direction::Input && 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 +314,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 +322,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 +334,54 @@ 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);
}
if (!result.value()) {
// Return true for NAMELIST input if we got anything.
auto *listInput{
io.get_if<ListDirectedStatementState<Direction::Input>>()};
return DIR == Direction::Input && j > 0 && listInput &&
listInput->inNamelistSequence();
}
}
return true;
}
bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
@ -371,7 +411,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 +429,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>>()};