diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h --- a/flang/runtime/descriptor-io.h +++ b/flang/runtime/descriptor-io.h @@ -291,8 +291,8 @@ return true; } -std::optional DefinedFormattedIo( - IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &); +std::optional DefinedFormattedIo(IoStatementState &, const Descriptor &, + const typeInfo::DerivedType &, const typeInfo::SpecialBinding &); template static bool FormattedDerivedTypeIO( @@ -308,15 +308,15 @@ ? typeInfo::SpecialBinding::Which::ReadFormatted : typeInfo::SpecialBinding::Which::WriteFormatted)}) { if (std::optional wasDefined{ - DefinedFormattedIo(io, descriptor, *special)}) { + DefinedFormattedIo(io, descriptor, *type, *special)}) { return *wasDefined; // user-defined I/O was applied } } return DefaultComponentwiseIO(io, descriptor, *type); } -bool DefinedUnformattedIo( - IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &); +bool DefinedUnformattedIo(IoStatementState &, const Descriptor &, + const typeInfo::DerivedType &, const typeInfo::SpecialBinding &); // Unformatted I/O template @@ -332,7 +332,7 @@ ? typeInfo::SpecialBinding::Which::ReadUnformatted : typeInfo::SpecialBinding::Which::WriteUnformatted)}) { // User-defined derived type unformatted I/O - return DefinedUnformattedIo(io, descriptor, *special); + return DefinedUnformattedIo(io, descriptor, *type, *special); } else { // Default derived type unformatted I/O // TODO: If no component at any level has user defined READ or WRITE diff --git a/flang/runtime/descriptor-io.cpp b/flang/runtime/descriptor-io.cpp --- a/flang/runtime/descriptor-io.cpp +++ b/flang/runtime/descriptor-io.cpp @@ -13,7 +13,8 @@ // User-defined derived type formatted I/O (maybe) std::optional DefinedFormattedIo(IoStatementState &io, - const Descriptor &descriptor, const typeInfo::SpecialBinding &special) { + const Descriptor &descriptor, const typeInfo::DerivedType &derived, + const typeInfo::SpecialBinding &special) { std::optional peek{io.GetNextDataEdit(0 /*to peek at it*/)}; if (peek && (peek->descriptor == DataEdit::DefinedDerivedType || @@ -33,8 +34,8 @@ ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED"); ioTypeLen = std::strlen(ioType); } - StaticDescriptor<1, true> statDesc; - Descriptor &vListDesc{statDesc.descriptor()}; + StaticDescriptor<1, true> vListStatDesc; + Descriptor &vListDesc{vListStatDesc.descriptor()}; vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1); vListDesc.set_base_addr(edit.vList); vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries); @@ -60,16 +61,36 @@ // 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()}; - p(descriptor, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen, - sizeof ioMsg); + StaticDescriptor<1, true, 10 /*?*/> elementStatDesc; + 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(subscripts)); + p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen, + sizeof ioMsg); + if (ioStat != IostatOk) { + break; + } + } } else { + // "dtv" argument is "type(t)", pass a raw pointer auto *p{special.GetProc()}; - p(descriptor.raw().base_addr, unit, ioType, vListDesc, ioStat, ioMsg, - ioTypeLen, sizeof ioMsg); + for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) { + p(descriptor.Element(subscripts), unit, ioType, vListDesc, ioStat, + ioMsg, ioTypeLen, sizeof ioMsg); + if (ioStat != IostatOk) { + break; + } + } } handler.Forward(ioStat, ioMsg, sizeof ioMsg); external->PopChildIo(child); @@ -93,6 +114,7 @@ // User-defined derived type unformatted I/O bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor, + const typeInfo::DerivedType &derived, const typeInfo::SpecialBinding &special) { // Unformatted I/O must have an external unit (or child thereof). IoErrorHandler &handler{io.GetIoErrorHandler()}; @@ -102,14 +124,34 @@ int unit{external->unitNumber()}; int ioStat{IostatOk}; char ioMsg[100]; + 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()}; - p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg); + StaticDescriptor<1, true, 10 /*?*/> elementStatDesc; + 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(subscripts)); + p(elementDesc, unit, ioStat, ioMsg, sizeof ioMsg); + if (ioStat != IostatOk) { + break; + } + } } else { + // "dtv" argument is "type(t)", pass a raw pointer auto *p{special.GetProc()}; - p(descriptor.raw().base_addr, unit, ioStat, ioMsg, sizeof ioMsg); + for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) { + p(descriptor.Element(subscripts), unit, ioStat, ioMsg, + sizeof ioMsg); + if (ioStat != IostatOk) { + break; + } + } } handler.Forward(ioStat, ioMsg, sizeof ioMsg); external->PopChildIo(child);