04eb93b1d5
User-defined derived type editing in formatted I/O wasn't working with repeat counts; e.g., "2DT(10)". The solution required some code to be moved from GetNextDataEdit() to CueUpNextDataEdit() so that a stack entry for a nonparenthesized repeated data edit descriptor would work correctly -- all other data edit descriptors are capable of dealing with repetition in their callees, so the bug hadn't been exposed before. Debugging this problem led to some improvements in error messages for bad format strings, and those changes have been retained; also, a dead member function was discovered and expunged. Differential Revision: https://reviews.llvm.org/D117904
107 lines
4.4 KiB
C++
107 lines
4.4 KiB
C++
//===-- runtime/descriptor-io.cpp -----------------------------------------===//
|
|
//
|
|
// 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 "descriptor-io.h"
|
|
|
|
namespace Fortran::runtime::io::descr {
|
|
|
|
// User-defined derived type formatted I/O (maybe)
|
|
std::optional<bool> DefinedFormattedIo(IoStatementState &io,
|
|
const Descriptor &descriptor, const typeInfo::SpecialBinding &special) {
|
|
std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
|
|
if (peek &&
|
|
(peek->descriptor == DataEdit::DefinedDerivedType ||
|
|
peek->descriptor == DataEdit::ListDirected)) {
|
|
// User-defined derived type formatting
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
DataEdit edit{*io.GetNextDataEdit(1)}; // now consume it; no repeats
|
|
RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
|
|
char ioType[2 + edit.maxIoTypeChars];
|
|
auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
|
|
if (edit.descriptor == DataEdit::DefinedDerivedType) {
|
|
ioType[0] = 'D';
|
|
ioType[1] = 'T';
|
|
std::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars);
|
|
} else {
|
|
std::strcpy(
|
|
ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED");
|
|
ioTypeLen = std::strlen(ioType);
|
|
}
|
|
StaticDescriptor<1, true> statDesc;
|
|
Descriptor &vListDesc{statDesc.descriptor()};
|
|
vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1);
|
|
vListDesc.set_base_addr(edit.vList);
|
|
vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);
|
|
vListDesc.GetDimension(0).SetByteStride(
|
|
static_cast<SubscriptValue>(sizeof(int)));
|
|
ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};
|
|
ExternalFileUnit *external{actualExternal};
|
|
if (!external) {
|
|
// Create a new unit to service defined I/O for an
|
|
// internal I/O parent.
|
|
external = &ExternalFileUnit::NewUnit(handler, true);
|
|
}
|
|
ChildIo &child{external->PushChildIo(io)};
|
|
int unit{external->unitNumber()};
|
|
int ioStat{IostatOk};
|
|
char ioMsg[100];
|
|
if (special.IsArgDescriptor(0)) {
|
|
auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
|
|
const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
|
|
p(descriptor, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
|
|
sizeof ioMsg);
|
|
} else {
|
|
auto *p{special.GetProc<void (*)(const void *, int &, char *,
|
|
const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
|
|
p(descriptor.raw().base_addr, unit, ioType, vListDesc, ioStat, ioMsg,
|
|
ioTypeLen, sizeof ioMsg);
|
|
}
|
|
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
|
|
external->PopChildIo(child);
|
|
if (!actualExternal) {
|
|
// Close unit created for internal I/O above.
|
|
auto *closing{external->LookUpForClose(external->unitNumber())};
|
|
RUNTIME_CHECK(handler, external == closing);
|
|
external->DestroyClosed();
|
|
}
|
|
return handler.GetIoStat() == IostatOk;
|
|
} else {
|
|
// There's a user-defined I/O subroutine, but there's a FORMAT present and
|
|
// it does not have a DT data edit descriptor, so apply default formatting
|
|
// to the components of the derived type as usual.
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
|
|
// User-defined derived type unformatted I/O
|
|
bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor,
|
|
const typeInfo::SpecialBinding &special) {
|
|
// Unformatted I/O must have an external unit (or child thereof).
|
|
IoErrorHandler &handler{io.GetIoErrorHandler()};
|
|
ExternalFileUnit *external{io.GetExternalFileUnit()};
|
|
RUNTIME_CHECK(handler, external != nullptr);
|
|
ChildIo &child{external->PushChildIo(io)};
|
|
int unit{external->unitNumber()};
|
|
int ioStat{IostatOk};
|
|
char ioMsg[100];
|
|
if (special.IsArgDescriptor(0)) {
|
|
auto *p{special.GetProc<void (*)(
|
|
const Descriptor &, int &, int &, char *, std::size_t)>()};
|
|
p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg);
|
|
} else {
|
|
auto *p{special.GetProc<void (*)(
|
|
const void *, int &, int &, char *, std::size_t)>()};
|
|
p(descriptor.raw().base_addr, unit, ioStat, ioMsg, sizeof ioMsg);
|
|
}
|
|
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
|
|
external->PopChildIo(child);
|
|
return handler.GetIoStat() == IostatOk;
|
|
}
|
|
|
|
} // namespace Fortran::runtime::io::descr
|