OSchip
/
llvm-project
mirror of https://github.com/THU-DSP-LAB/llvm-project.git
13
0
Fork 2
Code Issues Packages Projects Releases Wiki Activity

[flang] Implement user-defined derived type runtime I/O 

With derived type description tables now available to the
runtime library, it is possible to implement the concept
of "child" I/O statements in the runtime and use them to
convert instances of derived type I/O data transfers into
calls to user-defined subroutines when they have been specified
for a type.  (See Fortran 2018, subclauses 12.6.4.8 & 13.7.6).

 - Support formatted, list-directed, and NAMELIST
   transfers to internal parent units; support these, and unformatted
   transfers, for external parent units.
 - Support nested child defined derived type I/O.
 - Parse DT'foo'(v-list) FORMAT data edit descriptors and passes
   their strings &/or v-list values as arguments to the defined
   formatted I/O routines.
 - Fix problems with this feature encountered in semantics and
   FORMAT valiation during development and end-to-end testing.
 - Convert typeInfo::SpecialBinding from a struct to a class
   after adding a member function.

Differential Revision: https://reviews.llvm.org/D104930
This commit is contained in:
peter klausler 2021-06-25 10:40:08 -07:00
parent ad6bee87e6
commit 43fadefb0e
21 changed files with 989 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
flang/include/flang/Common/format.h
View File

@ -136,11 +136,11 @@ private:
const CHAR *cursor_{}; // current location in format_
const CHAR *laCursor_{}; // lookahead cursor
Token token_{}; // current token
TokenKind previousTokenKind_{TokenKind::None};
int64_t integerValue_{-1}; // value of UnsignedInteger token
Token knrToken_{}; // k, n, or r UnsignedInteger token
int64_t knrValue_{-1}; // -1 ==> not present
int64_t wValue_{-1};
bool previousTokenWasInt_{false};
char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name
bool formatHasErrors_{false};
bool unterminatedFormatError_{false};
@ -179,7 +179,7 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
// At entry, cursor_ points before the start of the next token.
// At exit, cursor_ points to last CHAR of token_.
previousTokenWasInt_ = token_.kind() == TokenKind::UnsignedInteger;
previousTokenKind_ = token_.kind();
CHAR c{NextChar()};
token_.set_kind(TokenKind::None);
token_.set_offset(cursor_ - format_);
@ -416,7 +416,8 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
}
}
SetLength();
if (stmt_ == IoStmtKind::Read) { // 13.3.2p6
if (stmt_ == IoStmtKind::Read &&
previousTokenKind_ != TokenKind::DT) { // 13.3.2p6
ReportError("String edit descriptor in READ format expression");
} else if (token_.kind() != TokenKind::String) {
ReportError("Unterminated string");
@ -829,7 +830,8 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
// Possible first token of the next format item; token not yet processed.
if (commaRequired) {
const char *s{"Expected ',' or ')' in format expression"}; // C1302
if (previousTokenWasInt_ && itemsWithLeadingInts_.test(token_.kind())) {
if (previousTokenKind_ == TokenKind::UnsignedInteger &&
itemsWithLeadingInts_.test(token_.kind())) {
ReportError(s);
} else {
ReportWarning(s);

10
flang/lib/Semantics/check-declarations.cpp
View File

@ -1797,9 +1797,15 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType,
void CheckHelper::CheckDioDummyIsDerived(
const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
if (const DeclTypeSpec * type{arg.GetType()}) {
const DerivedTypeSpec *derivedType{type->AsDerived()};
if (derivedType) {
if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
CheckAlreadySeenDefinedIo(derivedType, ioKind, subp);
bool isPolymorphic{type->IsPolymorphic()};
if (isPolymorphic != IsExtensibleType(derivedType)) {
messages_.Say(arg.name(),
"Dummy argument '%s' of a defined input/output procedure must be %s when the derived type is %s"_err_en_US,
arg.name(), isPolymorphic ? "TYPE()" : "CLASS()",
isPolymorphic ? "not extensible" : "extensible");
}
} else {
messages_.Say(arg.name(),
"Dummy argument '%s' of a defined input/output procedure must have a"

1
flang/runtime/CMakeLists.txt
View File

@ -40,6 +40,7 @@ add_flang_library(FortranRuntime
connection.cpp
derived.cpp
descriptor.cpp
descriptor-io.cpp
dot-product.cpp
edit-input.cpp
edit-output.cpp

14
flang/runtime/derived.cpp
View File

@ -20,9 +20,9 @@ static const typeInfo::SpecialBinding *FindFinal(
for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
const auto &special{
*specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
switch (special.which) {
switch (special.which()) {
case typeInfo::SpecialBinding::Which::Final:
if (special.rank == rank) {
if (special.rank() == rank) {
return &special;
}
break;
@ -40,20 +40,20 @@ static const typeInfo::SpecialBinding *FindFinal(
static void CallFinalSubroutine(
const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
if (const auto *special{FindFinal(derived, descriptor.rank())}) {
if (special->which == typeInfo::SpecialBinding::Which::ElementalFinal) {
if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) {
std::size_t byteStride{descriptor.ElementBytes()};
auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
auto *p{special->GetProc<void (*)(char *)>()};
// Finalizable objects must be contiguous.
std::size_t elements{descriptor.Elements()};
for (std::size_t j{0}; j < elements; ++j) {
p(descriptor.OffsetElement<char>(j * byteStride));
}
} else if (special->isArgDescriptorSet & 1) {
auto p{reinterpret_cast<void (*)(const Descriptor &)>(special->proc)};
} else if (special->IsArgDescriptor(0)) {
auto *p{special->GetProc<void (*)(const Descriptor &)>()};
p(descriptor);
} else {
// Finalizable objects must be contiguous.
auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
auto *p{special->GetProc<void (*)(char *)>()};
p(descriptor.OffsetElement<char>());
}
}

106
flang/runtime/descriptor-io.cpp Normal file
View File

@ -0,0 +1,106 @@
//===-- 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()}; // consume it this time
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<0, 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

178
flang/runtime/descriptor-io.h
View File

@ -10,6 +10,9 @@
#define FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
// Implementation of I/O data list item transfers based on descriptors.
// (All I/O items come through here so that the code is exercised for test;
// some scalar I/O data transfer APIs could be changed to bypass their use
// of descriptors in the future for better efficiency.)
#include "cpp-type.h"
#include "descriptor.h"
@ -18,6 +21,7 @@
#include "io-stmt.h"
#include "terminator.h"
#include "type-info.h"
#include "unit.h"
#include "flang/Common/uint128.h"
namespace Fortran::runtime::io::descr {
@ -243,42 +247,110 @@ static bool DefaultFormattedComponentIO(IoStatementState &io,
}
}
std::optional<bool> DefinedFormattedIo(
IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
template <Direction DIR>
static bool FormattedDerivedTypeIO(
IoStatementState &io, const Descriptor &descriptor) {
Terminator &terminator{io.GetIoErrorHandler()};
IoErrorHandler &handler{io.GetIoErrorHandler()};
// Derived type information must be present for formatted I/O.
const DescriptorAddendum *addendum{descriptor.Addendum()};
RUNTIME_CHECK(terminator, addendum != nullptr);
RUNTIME_CHECK(handler, addendum != nullptr);
const typeInfo::DerivedType *type{addendum->derivedType()};
RUNTIME_CHECK(terminator, type != nullptr);
if (false) {
// TODO: user-defined derived type formatted I/O
} else {
// Default derived type formatting
const Descriptor &compArray{type->component()};
RUNTIME_CHECK(terminator, compArray.rank() == 1);
std::size_t numComponents{compArray.Elements()};
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
for (std::size_t j{0}; j < numElements;
++j, descriptor.IncrementSubscripts(subscripts)) {
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 (!DefaultFormattedComponentIO<DIR>(
io, component, descriptor, subscripts, terminator)) {
return false;
}
RUNTIME_CHECK(handler, type != nullptr);
if (const typeInfo::SpecialBinding *
special{type->FindSpecialBinding(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadFormatted
: typeInfo::SpecialBinding::Which::WriteFormatted)}) {
if (std::optional<bool> wasDefined{
DefinedFormattedIo(io, descriptor, *special)}) {
return *wasDefined; // user-defined I/O was applied
}
}
// Default componentwise derived type formatting
const Descriptor &compArray{type->component()};
RUNTIME_CHECK(handler, compArray.rank() == 1);
std::size_t numComponents{compArray.Elements()};
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
for (std::size_t j{0}; j < numElements;
++j, descriptor.IncrementSubscripts(subscripts)) {
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 (!DefaultFormattedComponentIO<DIR>(
io, component, descriptor, subscripts, handler)) {
return false;
}
}
}
return true;
}
bool DefinedUnformattedIo(
IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
// Unformatted I/O
template <Direction DIR>
static bool UnformattedDescriptorIO(
IoStatementState &io, const Descriptor &descriptor) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
const DescriptorAddendum *addendum{descriptor.Addendum()};
const typeInfo::DerivedType *type{
addendum ? addendum->derivedType() : nullptr};
if (const typeInfo::SpecialBinding *
special{type
? type->FindSpecialBinding(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted)
: nullptr}) {
// User-defined derived type unformatted I/O
return DefinedUnformattedIo(io, descriptor, *special);
} else {
// Regular derived type unformatted I/O, not user-defined
auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
RUNTIME_CHECK(handler, externalUnf != nullptr || childUnf != nullptr);
std::size_t elementBytes{descriptor.ElementBytes()};
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
using CharType =
std::conditional_t<DIR == Direction::Output, const char, char>;
auto Transfer{[=](CharType &x, std::size_t totalBytes,
std::size_t elementBytes) -> bool {
if constexpr (DIR == Direction::Output) {
return externalUnf ? externalUnf->Emit(&x, totalBytes, elementBytes)
: childUnf->Emit(&x, totalBytes, elementBytes);
} else {
return externalUnf ? externalUnf->Receive(&x, totalBytes, elementBytes)
: childUnf->Receive(&x, totalBytes, elementBytes);
}
}};
if (descriptor.IsContiguous()) { // contiguous unformatted I/O
char &x{ExtractElement<char>(io, descriptor, subscripts)};
return Transfer(x, numElements * elementBytes, elementBytes);
} else { // non-contiguous unformatted I/O
for (std::size_t j{0}; j < numElements; ++j) {
char &x{ExtractElement<char>(io, descriptor, subscripts)};
if (!Transfer(x, elementBytes, elementBytes)) {
return false;
}
if (!descriptor.IncrementSubscripts(subscripts) &&
j + 1 < numElements) {
handler.Crash("DescriptorIO: subscripts out of bounds");
}
}
return true;
}
}
}
template <Direction DIR>
static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
if (!io.get_if<IoDirectionState<DIR>>()) {
@ -291,44 +363,14 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
return false;
}
}
if (auto *unf{io.get_if<UnformattedIoStatementState<DIR>>()}) {
std::size_t elementBytes{descriptor.ElementBytes()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
std::size_t numElements{descriptor.Elements()};
if (false) {
// TODO: user-defined derived type unformatted I/O
} else if (descriptor.IsContiguous()) { // contiguous unformatted I/O
char &x{ExtractElement<char>(io, descriptor, subscripts)};
auto totalBytes{numElements * elementBytes};
if constexpr (DIR == Direction::Output) {
return unf->Emit(&x, totalBytes, elementBytes);
} else {
return unf->Receive(&x, totalBytes, elementBytes);
}
} else { // non-contiguous unformatted I/O
for (std::size_t j{0}; j < numElements; ++j) {
char &x{ExtractElement<char>(io, descriptor, subscripts)};
if constexpr (DIR == Direction::Output) {
if (!unf->Emit(&x, elementBytes, elementBytes)) {
return false;
}
} else {
if (!unf->Receive(&x, elementBytes, elementBytes)) {
return false;
}
}
if (!descriptor.IncrementSubscripts(subscripts) &&
j + 1 < numElements) {
io.GetIoErrorHandler().Crash(
"DescriptorIO: subscripts out of bounds");
}
}
return true;
}
} else if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
if (!io.get_if<FormattedIoStatementState>()) {
return UnformattedDescriptorIO<DIR>(io, descriptor);
}
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
TypeCategory cat{catAndKind->first};
int kind{catAndKind->second};
switch (catAndKind->first) {
switch (cat) {
case TypeCategory::Integer:
switch (kind) {
case 1:
@ -347,7 +389,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 16>, DIR>(
io, descriptor);
default:
io.GetIoErrorHandler().Crash(
handler.Crash(
"DescriptorIO: Unimplemented INTEGER kind (%d) in descriptor",
kind);
return false;
@ -368,7 +410,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
case 16:
return FormattedRealIO<16, DIR>(io, descriptor);
default:
io.GetIoErrorHandler().Crash(
handler.Crash(
"DescriptorIO: Unimplemented REAL kind (%d) in descriptor", kind);
return false;
}
@ -388,7 +430,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
case 16:
return FormattedComplexIO<16, DIR>(io, descriptor);
default:
io.GetIoErrorHandler().Crash(
handler.Crash(
"DescriptorIO: Unimplemented COMPLEX kind (%d) in descriptor",
kind);
return false;
@ -399,7 +441,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
return FormattedCharacterIO<char, DIR>(io, descriptor);
// TODO cases 2, 4
default:
io.GetIoErrorHandler().Crash(
handler.Crash(
"DescriptorIO: Unimplemented CHARACTER kind (%d) in descriptor",
kind);
return false;
@ -419,7 +461,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
return FormattedLogicalIO<CppTypeFor<TypeCategory::Integer, 8>, DIR>(
io, descriptor);
default:
io.GetIoErrorHandler().Crash(
handler.Crash(
"DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor",
kind);
return false;
@ -428,7 +470,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
return FormattedDerivedTypeIO<DIR>(io, descriptor);
}
}
io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor",
handler.Crash("DescriptorIO: Bad type code (%d) in descriptor",
static_cast<int>(descriptor.type().raw()));
return false;
}

87
flang/runtime/format-implementation.h
View File

@ -338,10 +338,12 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
++offset_;
}
}
if (ch == 'E' ||
(!next &&
(ch == 'A' || ch == 'I' || ch == 'B' || ch == 'O' || ch == 'Z' ||
ch == 'F' || ch == 'D' || ch == 'G' || ch == 'L'))) {
if ((!next &&
(ch == 'A' || ch == 'I' || ch == 'B' || ch == 'E' || ch == 'D' ||
ch == 'O' || ch == 'Z' || ch == 'F' || ch == 'G' ||
ch == 'L')) ||
(ch == 'E' && (next == 'N' || next == 'S' || next == 'X')) ||
(ch == 'D' && next == 'T')) {
// Data edit descriptor found
offset_ = start;
return repeat && *repeat > 0 ? *repeat : 1;
@ -363,34 +365,86 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
}
}
// Returns the next data edit descriptor
template <typename CONTEXT>
DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
Context &context, int maxRepeat) {
// TODO: DT editing
// Return the next data edit descriptor
int repeat{CueUpNextDataEdit(context)};
auto start{offset_};
DataEdit edit;
edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
if (edit.descriptor == 'E') {
edit.variation = static_cast<char>(Capitalize(PeekNext()));
if (edit.variation >= 'A' && edit.variation <= 'Z') {
if (auto next{static_cast<char>(Capitalize(PeekNext()))};
next == 'N' || next == 'S' || next == 'X') {
edit.variation = next;
++offset_;
}
} else if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
// DT'iotype'(v_list) user-defined derived type I/O
edit.descriptor = DataEdit::DefinedDerivedType;
++offset_;
if (auto quote{static_cast<char>(PeekNext())};
quote == '\'' || quote == '"') {
// Capture the quoted 'iotype'
bool ok{false}, tooLong{false};
for (++offset_; offset_ < formatLength_;) {
auto ch{static_cast<char>(format_[offset_++])};
if (ch == quote &&
(offset_ == formatLength_ ||
static_cast<char>(format_[offset_]) != quote)) {
ok = true;
break; // that was terminating quote
} else if (edit.ioTypeChars >= edit.maxIoTypeChars) {
tooLong = true;
} else {
edit.ioType[edit.ioTypeChars++] = ch;
if (ch == quote) {
++offset_;
}
}
}
if (!ok) {
context.SignalError(
IostatErrorInFormat, "Unclosed DT'iotype' in FORMAT");
} else if (tooLong) {
context.SignalError(
IostatErrorInFormat, "Excessive DT'iotype' in FORMAT");
}
}
if (PeekNext() == '(') {
// Capture the v_list arguments
bool ok{false}, tooLong{false};
for (++offset_; offset_ < formatLength_;) {
int n{GetIntField(context)};
if (edit.vListEntries >= edit.maxVListEntries) {
tooLong = true;
} else {
edit.vList[edit.vListEntries++] = n;
}
auto ch{static_cast<char>(GetNextChar(context))};
if (ch != ',') {
ok = ch == ')';
break;
}
}
if (!ok) {
context.SignalError(
IostatErrorInFormat, "Unclosed DT(v_list) in FORMAT");
} else if (tooLong) {
context.SignalError(
IostatErrorInFormat, "Excessive DT(v_list) in FORMAT");
}
}
}
if (edit.descriptor == 'A') { // width is optional for A[w]
auto ch{PeekNext()};
if (ch >= '0' && ch <= '9') {
edit.width = GetIntField(context);
}
} else {
} else if (edit.descriptor != DataEdit::DefinedDerivedType) {
edit.width = GetIntField(context);
}
edit.modes = context.mutableModes();
if (PeekNext() == '.') {
if (edit.descriptor != DataEdit::DefinedDerivedType && PeekNext() == '.') {
++offset_;
edit.digits = GetIntField(context);
CharType ch{PeekNext()};
@ -399,14 +453,15 @@ DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
edit.expoDigits = GetIntField(context);
}
}
edit.modes = context.mutableModes();
// Handle repeated nonparenthesized edit descriptors
if (repeat > 1) {
if (repeat > maxRepeat) {
stack_[height_].start = start; // after repeat count
stack_[height_].remaining = repeat; // full count
++height_;
}
edit.repeat = 1;
edit.repeat = std::min(1, maxRepeat); // 0 if maxRepeat==0
if (height_ > 1) { // Subtle: stack_[0].start doesn't necessarily point to '('
int start{stack_[height_ - 1].start};
if (format_[start] != '(') {

46
flang/runtime/format.cpp
View File

@ -9,50 +9,6 @@
#include "format-implementation.h"
namespace Fortran::runtime::io {
DataEdit DefaultFormatControlCallbacks::GetNextDataEdit(int) {
Crash("DefaultFormatControlCallbacks::GetNextDataEdit() called for "
"non-formatted I/O statement");
return {};
}
bool DefaultFormatControlCallbacks::Emit(
const char *, std::size_t, std::size_t) {
Crash("DefaultFormatControlCallbacks::Emit(char) called for non-output I/O "
"statement");
return {};
}
bool DefaultFormatControlCallbacks::Emit(const char16_t *, std::size_t) {
Crash("DefaultFormatControlCallbacks::Emit(char16_t) called for non-output "
"I/O statement");
return {};
}
bool DefaultFormatControlCallbacks::Emit(const char32_t *, std::size_t) {
Crash("DefaultFormatControlCallbacks::Emit(char32_t) called for non-output "
"I/O statement");
return {};
}
std::optional<char32_t> DefaultFormatControlCallbacks::GetCurrentChar() {
Crash("DefaultFormatControlCallbacks::GetCurrentChar() called for non-input "
"I/O "
"statement");
return {};
}
bool DefaultFormatControlCallbacks::AdvanceRecord(int) {
Crash("DefaultFormatControlCallbacks::AdvanceRecord() called unexpectedly");
return {};
}
void DefaultFormatControlCallbacks::BackspaceRecord() {
Crash("DefaultFormatControlCallbacks::BackspaceRecord() called unexpectedly");
}
void DefaultFormatControlCallbacks::HandleAbsolutePosition(std::int64_t) {
Crash("DefaultFormatControlCallbacks::HandleAbsolutePosition() called for "
"non-formatted I/O statement");
}
void DefaultFormatControlCallbacks::HandleRelativePosition(std::int64_t) {
Crash("DefaultFormatControlCallbacks::HandleRelativePosition() called for "
"non-formatted I/O statement");
}
template class FormatControl<
InternalFormattedIoStatementState<Direction::Output>>;
template class FormatControl<
@ -61,4 +17,6 @@ template class FormatControl<
ExternalFormattedIoStatementState<Direction::Output>>;
template class FormatControl<
ExternalFormattedIoStatementState<Direction::Input>>;
template class FormatControl<ChildFormattedIoStatementState<Direction::Output>>;
template class FormatControl<ChildFormattedIoStatementState<Direction::Input>>;
} // namespace Fortran::runtime::io

29
flang/runtime/format.h
View File

@ -51,32 +51,28 @@ struct DataEdit {
descriptor == ListDirectedImaginaryPart;
}
static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
char variation{'\0'}; // N, S, or X for EN, ES, EX
std::optional<int> width; // the 'w' field; optional for A
std::optional<int> digits; // the 'm' or 'd' field
std::optional<int> expoDigits; // 'Ee' field
MutableModes modes;
int repeat{1};
};
// FormatControl<A> requires that A have these member functions;
// these default implementations just crash if called.
struct DefaultFormatControlCallbacks : public IoErrorHandler {
using IoErrorHandler::IoErrorHandler;
DataEdit GetNextDataEdit(int = 1);
bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
bool Emit(const char16_t *, std::size_t);
bool Emit(const char32_t *, std::size_t);
std::optional<char32_t> GetCurrentChar();
bool AdvanceRecord(int = 1);
void BackspaceRecord();
void HandleAbsolutePosition(std::int64_t);
void HandleRelativePosition(std::int64_t);
// "iotype" &/or "v_list" values for a DT'iotype'(v_list)
// user-defined derived type data edit descriptor
static constexpr std::size_t maxIoTypeChars{32};
static constexpr std::size_t maxVListEntries{4};
std::uint8_t ioTypeChars{0};
std::uint8_t vListEntries{0};
char ioType[maxIoTypeChars];
int vList[maxVListEntries];
};
// Generates a sequence of DataEdits from a FORMAT statement or
// default-CHARACTER string. Driven by I/O item list processing.
// Errors are fatal. See clause 13.4 in Fortran 2018 for background.
// Errors are fatal. See subclause 13.4 in Fortran 2018 for background.
template <typename CONTEXT> class FormatControl {
public:
using Context = CONTEXT;
@ -98,7 +94,8 @@ public:
}
// Extracts the next data edit descriptor, handling control edit descriptors
// along the way.
// along the way. If maxRepeat==0, this is a peek at the next data edit
// descriptor.
DataEdit GetNextDataEdit(Context &, int maxRepeat = 1);
// Emit any remaining character literals after the last data item (on output)

126
flang/runtime/io-api.cpp
View File

@ -156,22 +156,29 @@ Cookie BeginExternalListIO(const char *what, int unitNumber,
}
ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
unitNumber, DIR, false /*!unformatted*/, terminator)};
if (unit.access == Access::Direct) {
terminator.Crash("%s attempted on direct access file", what);
return nullptr;
if (ChildIo * child{unit.GetChildIo()}) {
return child->CheckFormattingAndDirection(terminator, what, false, DIR)
? &child->BeginIoStatement<ChildListIoStatementState<DIR>>(
*child, sourceFile, sourceLine)
: nullptr;
} else {
if (unit.access == Access::Direct) {
terminator.Crash("%s attempted on direct access file", what);
return nullptr;
}
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = false;
}
if (*unit.isUnformatted) {
terminator.Crash("%s attempted on unformatted file", what);
return nullptr;
}
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
return &io;
}
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = false;
}
if (*unit.isUnformatted) {
terminator.Crash("%s attempted on unformatted file", what);
return nullptr;
}
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
return &io;
}
Cookie IONAME(BeginExternalListOutput)(
@ -195,19 +202,29 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
}
ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
unitNumber, DIR, false /*!unformatted*/, terminator)};
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = false;
if (ChildIo * child{unit.GetChildIo()}) {
return child->CheckFormattingAndDirection(terminator,
DIR == Direction::Output ? "formatted output"
: "formatted input",
false, DIR)
? &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
*child, sourceFile, sourceLine)
: nullptr;
} else {
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = false;
}
if (*unit.isUnformatted) {
terminator.Crash("Formatted I/O attempted on unformatted file");
return nullptr;
}
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
IoStatementState &io{
unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
unit, format, formatLength, sourceFile, sourceLine)};
return &io;
}
if (*unit.isUnformatted) {
terminator.Crash("Formatted I/O attempted on unformatted file");
return nullptr;
}
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
IoStatementState &io{
unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
unit, format, formatLength, sourceFile, sourceLine)};
return &io;
}
Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
@ -230,25 +247,36 @@ Cookie BeginUnformattedIO(
Terminator terminator{sourceFile, sourceLine};
ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
unitNumber, DIR, true /*unformatted*/, terminator)};
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = true;
}
if (!*unit.isUnformatted) {
terminator.Crash("Unformatted I/O attempted on formatted file");
}
IoStatementState &io{unit.BeginIoStatement<UnformattedIoStatementState<DIR>>(
unit, sourceFile, sourceLine)};
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
if constexpr (DIR == Direction::Output) {
if (unit.access == Access::Sequential && !unit.isFixedRecordLength) {
// Create space for (sub)record header to be completed by
// UnformattedIoStatementState<Direction::Output>::EndIoStatement()
unit.recordLength.reset(); // in case of prior BACKSPACE
io.Emit("\0\0\0\0", 4); // placeholder for record length header
if (ChildIo * child{unit.GetChildIo()}) {
return child->CheckFormattingAndDirection(terminator,
DIR == Direction::Output ? "unformatted output"
: "unformatted input",
true, DIR)
? &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
*child, sourceFile, sourceLine)
: nullptr;
} else {
if (!unit.isUnformatted.has_value()) {
unit.isUnformatted = true;
}
if (!*unit.isUnformatted) {
terminator.Crash("Unformatted I/O attempted on formatted file");
}
IoStatementState &io{
unit.BeginIoStatement<ExternalUnformattedIoStatementState<DIR>>(
unit, sourceFile, sourceLine)};
IoErrorHandler handler{terminator};
unit.SetDirection(DIR, handler);
if constexpr (DIR == Direction::Output) {
if (unit.access == Access::Sequential && !unit.isFixedRecordLength) {
// Create space for (sub)record header to be completed by
// ExternalUnformattedIoStatementState<Direction::Output>::EndIoStatement()
unit.recordLength.reset(); // in case of prior BACKSPACE
io.Emit("\0\0\0\0", 4); // placeholder for record length header
}
}
return &io;
}
return &io;
}
Cookie IONAME(BeginUnformattedOutput)(
@ -276,9 +304,7 @@ Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
bool ignored{false};
ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreate(
ExternalFileUnit::NewUnit(terminator), terminator, ignored)};
ExternalFileUnit &unit{ExternalFileUnit::NewUnit(terminator)};
return &unit.BeginIoStatement<OpenStatementState>(
unit, false /*was an existing file*/, sourceFile, sourceLine);
}
@ -895,7 +921,8 @@ bool IONAME(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
bool IONAME(OutputUnformattedBlock)(Cookie cookie, const char *x,
std::size_t length, std::size_t elementBytes) {
IoStatementState &io{*cookie};
if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Output>>()}) {
if (auto *unf{io.get_if<
ExternalUnformattedIoStatementState<Direction::Output>>()}) {
return unf->Emit(x, length, elementBytes);
}
io.GetIoErrorHandler().Crash("OutputUnformattedBlock() called for an I/O "
@ -910,7 +937,8 @@ bool IONAME(InputUnformattedBlock)(
if (io.GetIoErrorHandler().InError()) {
return false;
}
if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Input>>()}) {
if (auto *unf{
io.get_if<ExternalUnformattedIoStatementState<Direction::Input>>()}) {
return unf->Receive(x, length, elementBytes);
}
io.GetIoErrorHandler().Crash("InputUnformattedBlock() called for an I/O "

8
flang/runtime/io-error.cpp
View File

@ -57,6 +57,14 @@ void IoErrorHandler::SignalError(int iostatOrErrno) {
SignalError(iostatOrErrno, nullptr);
}
void IoErrorHandler::Forward(
int ioStatOrErrno, const char *msg, std::size_t length) {
SignalError(ioStatOrErrno);
if (ioStat_ != IostatOk && (flags_ & hasIoMsg)) {
ioMsg_ = SaveDefaultCharacter(msg, length, *this);
}
}
void IoErrorHandler::SignalErrno() { SignalError(errno); }
void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }

5
flang/runtime/io-error.h
View File

@ -32,6 +32,9 @@ public:
void HasEndLabel() { flags_ |= hasEnd; }
void HasEorLabel() { flags_ |= hasEor; }
void HasIoMsg() { flags_ |= hasIoMsg; }
void HandleAnything() {
flags_ = hasIoStat | hasErr | hasEnd | hasEor | hasIoMsg;
}
bool InError() const { return ioStat_ != IostatOk; }
@ -41,6 +44,8 @@ public:
SignalError(IostatGenericError, msg, std::forward<X>(xs)...);
}
void Forward(int iostatOrErrno, const char *, std::size_t);
void SignalErrno(); // SignalError(errno)
void SignalEnd(); // input only; EOF on internal write is an error
void SignalEor(); // non-advancing input only; EOR on write is an error

205
flang/runtime/io-stmt.cpp
View File

@ -21,32 +21,64 @@ namespace Fortran::runtime::io {
int IoStatementBase::EndIoStatement() { return GetIoStat(); }
bool IoStatementBase::Emit(const char *, std::size_t, std::size_t) {
return false;
}
bool IoStatementBase::Emit(const char *, std::size_t) {
return false;
}
bool IoStatementBase::Emit(const char16_t *, std::size_t) {
return false;
}
bool IoStatementBase::Emit(const char32_t *, std::size_t) {
return false;
}
std::optional<char32_t> IoStatementBase::GetCurrentChar() {
return std::nullopt;
}
bool IoStatementBase::AdvanceRecord(int) { return false; }
void IoStatementBase::BackspaceRecord() {}
bool IoStatementBase::Receive(char *, std::size_t, std::size_t) {
return false;
}
std::optional<DataEdit> IoStatementBase::GetNextDataEdit(
IoStatementState &, int) {
return std::nullopt;
}
ExternalFileUnit *IoStatementBase::GetExternalFileUnit() const {
return nullptr;
}
bool IoStatementBase::BeginReadingRecord() { return true; }
void IoStatementBase::FinishReadingRecord() {}
void IoStatementBase::HandleAbsolutePosition(std::int64_t) {}
void IoStatementBase::HandleRelativePosition(std::int64_t) {}
bool IoStatementBase::Inquire(InquiryKeywordHash, char *, std::size_t) {
Crash(
"IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
return false;
}
bool IoStatementBase::Inquire(InquiryKeywordHash, bool &) {
Crash(
"IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
return false;
}
bool IoStatementBase::Inquire(InquiryKeywordHash, std::int64_t, bool &) {
Crash(
"IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
return false;
}
bool IoStatementBase::Inquire(InquiryKeywordHash, std::int64_t &) {
Crash(
"IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
return false;
}
@ -69,12 +101,12 @@ InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
template <Direction DIR, typename CHAR>
bool InternalIoStatementState<DIR, CHAR>::Emit(
const CharType *data, std::size_t chars, std::size_t /*elementBytes*/) {
const CharType *data, std::size_t chars) {
if constexpr (DIR == Direction::Input) {
Crash("InternalIoStatementState<Direction::Input>::Emit() called");
return false;
}
return unit_.Emit(data, chars, *this);
return unit_.Emit(data, chars * sizeof(CharType), *this);
}
template <Direction DIR, typename CHAR>
@ -252,6 +284,14 @@ bool ExternalIoStatementState<DIR>::Emit(
return unit().Emit(data, bytes, elementBytes, *this);
}
template <Direction DIR>
bool ExternalIoStatementState<DIR>::Emit(const char *data, std::size_t bytes) {
if constexpr (DIR == Direction::Input) {
Crash("ExternalIoStatementState::Emit(char) called for input statement");
}
return unit().Emit(data, bytes, 0, *this);
}
template <Direction DIR>
bool ExternalIoStatementState<DIR>::Emit(
const char16_t *data, std::size_t chars) {
@ -261,7 +301,7 @@ bool ExternalIoStatementState<DIR>::Emit(
}
// TODO: UTF-8 encoding
return unit().Emit(reinterpret_cast<const char *>(data), chars * sizeof *data,
static_cast<int>(sizeof *data), *this);
sizeof *data, *this);
}
template <Direction DIR>
@ -273,7 +313,7 @@ bool ExternalIoStatementState<DIR>::Emit(
}
// TODO: UTF-8 encoding
return unit().Emit(reinterpret_cast<const char *>(data), chars * sizeof *data,
static_cast<int>(sizeof *data), *this);
sizeof *data, *this);
}
template <Direction DIR>
@ -354,6 +394,24 @@ bool IoStatementState::Emit(
[=](auto &x) { return x.get().Emit(data, n, elementBytes); }, u_);
}
bool IoStatementState::Emit(const char *data, std::size_t n) {
return std::visit([=](auto &x) { return x.get().Emit(data, n); }, u_);
}
bool IoStatementState::Emit(const char16_t *data, std::size_t chars) {
return std::visit([=](auto &x) { return x.get().Emit(data, chars); }, u_);
}
bool IoStatementState::Emit(const char32_t *data, std::size_t chars) {
return std::visit([=](auto &x) { return x.get().Emit(data, chars); }, u_);
}
bool IoStatementState::Receive(
char *data, std::size_t n, std::size_t elementBytes) {
return std::visit(
[=](auto &x) { return x.get().Receive(data, n, elementBytes); }, u_);
}
std::optional<char32_t> IoStatementState::GetCurrentChar() {
return std::visit([&](auto &x) { return x.get().GetCurrentChar(); }, u_);
}
@ -370,6 +428,10 @@ void IoStatementState::HandleRelativePosition(std::int64_t n) {
std::visit([=](auto &x) { x.get().HandleRelativePosition(n); }, u_);
}
void IoStatementState::HandleAbsolutePosition(std::int64_t n) {
std::visit([=](auto &x) { x.get().HandleAbsolutePosition(n); }, u_);
}
int IoStatementState::EndIoStatement() {
return std::visit([](auto &x) { return x.get().EndIoStatement(); }, u_);
}
@ -682,23 +744,100 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
}
template <Direction DIR>
bool UnformattedIoStatementState<DIR>::Receive(
bool ExternalUnformattedIoStatementState<DIR>::Receive(
char *data, std::size_t bytes, std::size_t elementBytes) {
if constexpr (DIR == Direction::Output) {
this->Crash(
"UnformattedIoStatementState::Receive() called for output statement");
this->Crash("ExternalUnformattedIoStatementState::Receive() called for "
"output statement");
}
return this->unit().Receive(data, bytes, elementBytes, *this);
}
template <Direction DIR>
bool UnformattedIoStatementState<DIR>::Emit(
ChildIoStatementState<DIR>::ChildIoStatementState(
ChildIo &child, const char *sourceFile, int sourceLine)
: IoStatementBase{sourceFile, sourceLine}, child_{child} {}
template <Direction DIR>
MutableModes &ChildIoStatementState<DIR>::mutableModes() {
return child_.parent().mutableModes();
}
template <Direction DIR>
ConnectionState &ChildIoStatementState<DIR>::GetConnectionState() {
return child_.parent().GetConnectionState();
}
template <Direction DIR>
ExternalFileUnit *ChildIoStatementState<DIR>::GetExternalFileUnit() const {
return child_.parent().GetExternalFileUnit();
}
template <Direction DIR> int ChildIoStatementState<DIR>::EndIoStatement() {
auto result{IoStatementBase::EndIoStatement()};
child_.EndIoStatement(); // annihilates *this in child_.u_
return result;
}
template <Direction DIR>
bool ChildIoStatementState<DIR>::Emit(
const char *data, std::size_t bytes, std::size_t elementBytes) {
if constexpr (DIR == Direction::Input) {
this->Crash(
"UnformattedIoStatementState::Emit() called for input statement");
}
return ExternalIoStatementState<DIR>::Emit(data, bytes, elementBytes);
return child_.parent().Emit(data, bytes, elementBytes);
}
template <Direction DIR>
bool ChildIoStatementState<DIR>::Emit(const char *data, std::size_t bytes) {
return child_.parent().Emit(data, bytes);
}
template <Direction DIR>
bool ChildIoStatementState<DIR>::Emit(const char16_t *data, std::size_t chars) {
return child_.parent().Emit(data, chars);
}
template <Direction DIR>
bool ChildIoStatementState<DIR>::Emit(const char32_t *data, std::size_t chars) {
return child_.parent().Emit(data, chars);
}
template <Direction DIR>
std::optional<char32_t> ChildIoStatementState<DIR>::GetCurrentChar() {
return child_.parent().GetCurrentChar();
}
template <Direction DIR>
void ChildIoStatementState<DIR>::HandleAbsolutePosition(std::int64_t n) {
return child_.parent().HandleAbsolutePosition(n);
}
template <Direction DIR>
void ChildIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
return child_.parent().HandleRelativePosition(n);
}
template <Direction DIR, typename CHAR>
ChildFormattedIoStatementState<DIR, CHAR>::ChildFormattedIoStatementState(
ChildIo &child, const CHAR *format, std::size_t formatLength,
const char *sourceFile, int sourceLine)
: ChildIoStatementState<DIR>{child, sourceFile, sourceLine},
mutableModes_{child.parent().mutableModes()}, format_{*this, format,
formatLength} {}
template <Direction DIR, typename CHAR>
int ChildFormattedIoStatementState<DIR, CHAR>::EndIoStatement() {
format_.Finish(*this);
return ChildIoStatementState<DIR>::EndIoStatement();
}
template <Direction DIR, typename CHAR>
bool ChildFormattedIoStatementState<DIR, CHAR>::AdvanceRecord(int) {
return false; // no can do in a child I/O
}
template <Direction DIR>
bool ChildUnformattedIoStatementState<DIR>::Receive(
char *data, std::size_t bytes, std::size_t elementBytes) {
return this->child().parent().Receive(data, bytes, elementBytes);
}
template class InternalIoStatementState<Direction::Output>;
@ -713,8 +852,16 @@ template class ExternalFormattedIoStatementState<Direction::Output>;
template class ExternalFormattedIoStatementState<Direction::Input>;
template class ExternalListIoStatementState<Direction::Output>;
template class ExternalListIoStatementState<Direction::Input>;
template class UnformattedIoStatementState<Direction::Output>;
template class UnformattedIoStatementState<Direction::Input>;
template class ExternalUnformattedIoStatementState<Direction::Output>;
template class ExternalUnformattedIoStatementState<Direction::Input>;
template class ChildIoStatementState<Direction::Output>;
template class ChildIoStatementState<Direction::Input>;
template class ChildFormattedIoStatementState<Direction::Output>;
template class ChildFormattedIoStatementState<Direction::Input>;
template class ChildListIoStatementState<Direction::Output>;
template class ChildListIoStatementState<Direction::Input>;
template class ChildUnformattedIoStatementState<Direction::Output>;
template class ChildUnformattedIoStatementState<Direction::Input>;
int ExternalMiscIoStatementState::EndIoStatement() {
ExternalFileUnit &ext{unit()};
@ -742,6 +889,12 @@ InquireUnitState::InquireUnitState(
bool InquireUnitState::Inquire(
InquiryKeywordHash inquiry, char *result, std::size_t length) {
if (unit().createdForInternalChildIo()) {
SignalError(IostatInquireInternalUnit,
"INQUIRE of unit created for defined derived type I/O of an internal "
"unit");
return false;
}
const char *str{nullptr};
switch (inquiry) {
case HashInquiryKeyword("ACCESS"):
@ -1161,10 +1314,4 @@ InquireIOLengthState::InquireIOLengthState(
const char *sourceFile, int sourceLine)
: NoUnitIoStatementState{sourceFile, sourceLine, *this} {}
bool InquireIOLengthState::Emit(
const char *, std::size_t n, std::size_t /*elementBytes*/) {
bytes_ += n;
return true;
}
} // namespace Fortran::runtime::io

156
flang/runtime/io-stmt.h
View File

@ -25,6 +25,7 @@
namespace Fortran::runtime::io {
class ExternalFileUnit;
class ChildIo;
class OpenStatementState;
class InquireUnitState;
@ -41,7 +42,10 @@ template <Direction, typename CHAR = char> class InternalListIoStatementState;
template <Direction, typename CHAR = char>
class ExternalFormattedIoStatementState;
template <Direction> class ExternalListIoStatementState;
template <Direction> class UnformattedIoStatementState;
template <Direction> class ExternalUnformattedIoStatementState;
template <Direction, typename CHAR = char> class ChildFormattedIoStatementState;
template <Direction> class ChildListIoStatementState;
template <Direction> class ChildUnformattedIoStatementState;
struct InputStatementState {};
struct OutputStatementState {};
@ -60,17 +64,19 @@ public:
// to interact with the state of the I/O statement in progress.
// This design avoids virtual member functions and function pointers,
// which may not have good support in some runtime environments.
std::optional<DataEdit> GetNextDataEdit(int = 1);
bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
int EndIoStatement();
bool Emit(const char *, std::size_t, std::size_t elementBytes);
bool Emit(const char *, std::size_t);
bool Emit(const char16_t *, std::size_t chars);
bool Emit(const char32_t *, std::size_t chars);
bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
std::optional<char32_t> GetCurrentChar(); // vacant after end of record
bool AdvanceRecord(int = 1);
void BackspaceRecord();
void HandleRelativePosition(std::int64_t);
int EndIoStatement();
ConnectionState &GetConnectionState();
IoErrorHandler &GetIoErrorHandler() const;
void HandleAbsolutePosition(std::int64_t); // for r* in list I/O
std::optional<DataEdit> GetNextDataEdit(int = 1);
ExternalFileUnit *GetExternalFileUnit() const; // null if internal unit
MutableModes &mutableModes();
bool BeginReadingRecord();
void FinishReadingRecord();
bool Inquire(InquiryKeywordHash, char *, std::size_t);
@ -78,6 +84,10 @@ public:
bool Inquire(InquiryKeywordHash, std::int64_t, bool &); // PENDING=
bool Inquire(InquiryKeywordHash, std::int64_t &);
MutableModes &mutableModes();
ConnectionState &GetConnectionState();
IoErrorHandler &GetIoErrorHandler() const;
// N.B.: this also works with base classes
template <typename A> A *get_if() const {
return std::visit(
@ -129,8 +139,18 @@ private:
ExternalFormattedIoStatementState<Direction::Input>>,
std::reference_wrapper<ExternalListIoStatementState<Direction::Output>>,
std::reference_wrapper<ExternalListIoStatementState<Direction::Input>>,
std::reference_wrapper<UnformattedIoStatementState<Direction::Output>>,
std::reference_wrapper<UnformattedIoStatementState<Direction::Input>>,
std::reference_wrapper<
ExternalUnformattedIoStatementState<Direction::Output>>,
std::reference_wrapper<
ExternalUnformattedIoStatementState<Direction::Input>>,
std::reference_wrapper<ChildFormattedIoStatementState<Direction::Output>>,
std::reference_wrapper<ChildFormattedIoStatementState<Direction::Input>>,
std::reference_wrapper<ChildListIoStatementState<Direction::Output>>,
std::reference_wrapper<ChildListIoStatementState<Direction::Input>>,
std::reference_wrapper<
ChildUnformattedIoStatementState<Direction::Output>>,
std::reference_wrapper<
ChildUnformattedIoStatementState<Direction::Input>>,
std::reference_wrapper<InquireUnitState>,
std::reference_wrapper<InquireNoUnitState>,
std::reference_wrapper<InquireUnconnectedFileState>,
@ -140,18 +160,30 @@ private:
};
// Base class for all per-I/O statement state classes.
// Inherits IoErrorHandler from its base.
struct IoStatementBase : public DefaultFormatControlCallbacks {
using DefaultFormatControlCallbacks::DefaultFormatControlCallbacks;
struct IoStatementBase : public IoErrorHandler {
using IoErrorHandler::IoErrorHandler;
// These are default no-op backstops that can be overridden by descendants.
int EndIoStatement();
bool Emit(const char *, std::size_t, std::size_t elementBytes);
bool Emit(const char *, std::size_t);
bool Emit(const char16_t *, std::size_t chars);
bool Emit(const char32_t *, std::size_t chars);
bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
std::optional<char32_t> GetCurrentChar();
bool AdvanceRecord(int);
void BackspaceRecord();
void HandleRelativePosition(std::int64_t);
void HandleAbsolutePosition(std::int64_t);
std::optional<DataEdit> GetNextDataEdit(IoStatementState &, int = 1);
ExternalFileUnit *GetExternalFileUnit() const { return nullptr; }
bool BeginReadingRecord() { return true; }
void FinishReadingRecord() {}
ExternalFileUnit *GetExternalFileUnit() const;
bool BeginReadingRecord();
void FinishReadingRecord();
bool Inquire(InquiryKeywordHash, char *, std::size_t);
bool Inquire(InquiryKeywordHash, bool &);
bool Inquire(InquiryKeywordHash, std::int64_t, bool &);
bool Inquire(InquiryKeywordHash, std::int64_t &);
void BadInquiryKeywordHashCrash(InquiryKeywordHash);
};
@ -207,8 +239,11 @@ public:
InternalIoStatementState(
const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
int EndIoStatement();
bool Emit(const CharType *, std::size_t chars /* not necessarily bytes */,
std::size_t elementBytes = 0);
using IoStatementBase::Emit;
bool Emit(
const CharType *data, std::size_t chars /* not necessarily bytes */);
std::optional<char32_t> GetCurrentChar();
bool AdvanceRecord(int = 1);
void BackspaceRecord();
@ -275,7 +310,7 @@ public:
MutableModes &mutableModes();
ConnectionState &GetConnectionState();
int EndIoStatement();
ExternalFileUnit *GetExternalFileUnit() { return &unit_; }
ExternalFileUnit *GetExternalFileUnit() const { return &unit_; }
private:
ExternalFileUnit &unit_;
@ -287,7 +322,8 @@ class ExternalIoStatementState : public ExternalIoStatementBase,
public:
using ExternalIoStatementBase::ExternalIoStatementBase;
int EndIoStatement();
bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
bool Emit(const char *, std::size_t, std::size_t elementBytes);
bool Emit(const char *, std::size_t);
bool Emit(const char16_t *, std::size_t chars /* not bytes */);
bool Emit(const char32_t *, std::size_t chars /* not bytes */);
std::optional<char32_t> GetCurrentChar();
@ -331,13 +367,73 @@ public:
};
template <Direction DIR>
class UnformattedIoStatementState : public ExternalIoStatementState<DIR> {
class ExternalUnformattedIoStatementState
: public ExternalIoStatementState<DIR> {
public:
using ExternalIoStatementState<DIR>::ExternalIoStatementState;
bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
};
template <Direction DIR>
class ChildIoStatementState : public IoStatementBase,
public IoDirectionState<DIR> {
public:
ChildIoStatementState(
ChildIo &, const char *sourceFile = nullptr, int sourceLine = 0);
ChildIo &child() { return child_; }
MutableModes &mutableModes();
ConnectionState &GetConnectionState();
ExternalFileUnit *GetExternalFileUnit() const;
int EndIoStatement();
bool Emit(const char *, std::size_t, std::size_t elementBytes);
bool Emit(const char *, std::size_t);
bool Emit(const char16_t *, std::size_t chars /* not bytes */);
bool Emit(const char32_t *, std::size_t chars /* not bytes */);
std::optional<char32_t> GetCurrentChar();
void HandleRelativePosition(std::int64_t);
void HandleAbsolutePosition(std::int64_t);
private:
ChildIo &child_;
};
template <Direction DIR, typename CHAR>
class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
public FormattedIoStatementState {
public:
using CharType = CHAR;
ChildFormattedIoStatementState(ChildIo &, const CharType *format,
std::size_t formatLength, const char *sourceFile = nullptr,
int sourceLine = 0);
MutableModes &mutableModes() { return mutableModes_; }
int EndIoStatement();
bool AdvanceRecord(int = 1);
std::optional<DataEdit> GetNextDataEdit(
IoStatementState &, int maxRepeat = 1) {
return format_.GetNextDataEdit(*this, maxRepeat);
}
private:
MutableModes mutableModes_;
FormatControl<ChildFormattedIoStatementState> format_;
};
template <Direction DIR>
class ChildListIoStatementState : public ChildIoStatementState<DIR>,
public ListDirectedStatementState<DIR> {
public:
using ChildIoStatementState<DIR>::ChildIoStatementState;
using ListDirectedStatementState<DIR>::GetNextDataEdit;
};
template <Direction DIR>
class ChildUnformattedIoStatementState : public ChildIoStatementState<DIR> {
public:
using ChildIoStatementState<DIR>::ChildIoStatementState;
bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
};
// OPEN
class OpenStatementState : public ExternalIoStatementBase {
public:
OpenStatementState(ExternalFileUnit &unit, bool wasExtant,
@ -415,8 +511,17 @@ extern template class ExternalFormattedIoStatementState<Direction::Output>;
extern template class ExternalFormattedIoStatementState<Direction::Input>;
extern template class ExternalListIoStatementState<Direction::Output>;
extern template class ExternalListIoStatementState<Direction::Input>;
extern template class UnformattedIoStatementState<Direction::Output>;
extern template class UnformattedIoStatementState<Direction::Input>;
extern template class ExternalUnformattedIoStatementState<Direction::Output>;
extern template class ExternalUnformattedIoStatementState<Direction::Input>;
extern template class ChildIoStatementState<Direction::Output>;
extern template class ChildIoStatementState<Direction::Input>;
extern template class ChildFormattedIoStatementState<Direction::Output>;
extern template class ChildFormattedIoStatementState<Direction::Input>;
extern template class ChildListIoStatementState<Direction::Output>;
extern template class ChildListIoStatementState<Direction::Input>;
extern template class ChildUnformattedIoStatementState<Direction::Output>;
extern template class ChildUnformattedIoStatementState<Direction::Input>;
extern template class FormatControl<
InternalFormattedIoStatementState<Direction::Output>>;
extern template class FormatControl<
@ -425,6 +530,10 @@ extern template class FormatControl<
ExternalFormattedIoStatementState<Direction::Output>>;
extern template class FormatControl<
ExternalFormattedIoStatementState<Direction::Input>>;
extern template class FormatControl<
ChildFormattedIoStatementState<Direction::Output>>;
extern template class FormatControl<
ChildFormattedIoStatementState<Direction::Input>>;
class InquireUnitState : public ExternalIoStatementBase {
public:
@ -463,7 +572,6 @@ class InquireIOLengthState : public NoUnitIoStatementState,
public:
InquireIOLengthState(const char *sourceFile = nullptr, int sourceLine = 0);
std::size_t bytes() const { return bytes_; }
bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
private:
std::size_t bytes_{0};

4
flang/runtime/tools.cpp
View File

@ -71,9 +71,11 @@ int IdentifyValue(
void ToFortranDefaultCharacter(
char *to, std::size_t toLength, const char *from) {
std::size_t len{std::strlen(from)};
std::memcpy(to, from, std::max(toLength, len));
if (len < toLength) {
std::memcpy(to, from, len);
std::memset(to + len, ' ', toLength - len);
} else {
std::memcpy(to, from, toLength);
}
}

68
flang/runtime/type-info.cpp
View File

@ -82,6 +82,21 @@ const Component *DerivedType::FindDataComponent(
: nullptr;
}
const SpecialBinding *DerivedType::FindSpecialBinding(
SpecialBinding::Which which) const {
const Descriptor &specialDesc{special()};
std::size_t n{specialDesc.Elements()};
SubscriptValue at[maxRank];
specialDesc.GetLowerBounds(at);
for (std::size_t j{0}; j < n; ++j, specialDesc.IncrementSubscripts(at)) {
const SpecialBinding &special{*specialDesc.Element<SpecialBinding>(at)};
if (special.which() == which) {
return &special;
}
}
return nullptr;
}
static void DumpScalarCharacter(
FILE *f, const Descriptor &desc, const char *what) {
if (desc.raw().version == CFI_VERSION &&
@ -103,7 +118,7 @@ FILE *DerivedType::Dump(FILE *f) const {
int offset{j * static_cast<int>(sizeof *uints)};
std::fprintf(f, " [+%3d](0x%p) %#016jx", offset,
reinterpret_cast<const void *>(&uints[j]),
static_cast<std::intmax_t>(uints[j]));
static_cast<std::uintmax_t>(uints[j]));
if (offset == offsetof(DerivedType, binding_)) {
std::fputs(" <-- binding_\n", f);
} else if (offset == offsetof(DerivedType, name_)) {
@ -151,6 +166,15 @@ FILE *DerivedType::Dump(FILE *f) const {
std::fputs(" bad descriptor: ", f);
compDesc.Dump(f);
}
const Descriptor &specialDesc{special()};
std::fprintf(
f, "\n special descriptor (byteSize 0x%zx): ", special_.byteSize);
specialDesc.Dump(f);
std::size_t specials{specialDesc.Elements()};
for (std::size_t j{0}; j < specials; ++j) {
std::fprintf(f, " [%3zd] ", j);
specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
}
return f;
}
@ -174,4 +198,46 @@ FILE *Component::Dump(FILE *f) const {
return f;
}
FILE *SpecialBinding::Dump(FILE *f) const {
std::fprintf(
f, "SpecialBinding @ 0x%p:\n", reinterpret_cast<const void *>(this));
switch (which_) {
case Which::Assignment:
std::fputs(" Assignment", f);
break;
case Which::ElementalAssignment:
std::fputs(" ElementalAssignment", f);
break;
case Which::Final:
std::fputs(" Final", f);
break;
case Which::ElementalFinal:
std::fputs(" ElementalFinal", f);
break;
case Which::AssumedRankFinal:
std::fputs(" AssumedRankFinal", f);
break;
case Which::ReadFormatted:
std::fputs(" ReadFormatted", f);
break;
case Which::ReadUnformatted:
std::fputs(" ReadUnformatted", f);
break;
case Which::WriteFormatted:
std::fputs(" WriteFormatted", f);
break;
case Which::WriteUnformatted:
std::fputs(" WriteUnformatted", f);
break;
default:
std::fprintf(
f, " Unknown which: 0x%x", static_cast<std::uint8_t>(which_));
break;
}
std::fprintf(f, "\n rank: %d\n", rank_);
std::fprintf(f, " isArgDescriptoSetr: 0x%x\n", isArgDescriptorSet_);
std::fprintf(f, " proc: 0x%p\n", reinterpret_cast<void *>(proc_));
return f;
}
} // namespace Fortran::runtime::typeInfo

178
flang/runtime/type-info.h
View File

@ -20,81 +20,7 @@
namespace Fortran::runtime::typeInfo {
class Component;
class DerivedType {
public:
~DerivedType(); // never defined
const Descriptor &binding() const { return binding_.descriptor(); }
const Descriptor &name() const { return name_.descriptor(); }
std::uint64_t sizeInBytes() const { return sizeInBytes_; }
const Descriptor &parent() const { return parent_.descriptor(); }
std::uint64_t typeHash() const { return typeHash_; }
const Descriptor &uninstatiated() const {
return uninstantiated_.descriptor();
}
const Descriptor &kindParameter() const {
return kindParameter_.descriptor();
}
const Descriptor &lenParameterKind() const {
return lenParameterKind_.descriptor();
}
const Descriptor &component() const { return component_.descriptor(); }
const Descriptor &procPtr() const { return procPtr_.descriptor(); }
const Descriptor &special() const { return special_.descriptor(); }
std::size_t LenParameters() const { return lenParameterKind().Elements(); }
// Finds a data component by name in this derived type or tis ancestors.
const Component *FindDataComponent(
const char *name, std::size_t nameLen) const;
FILE *Dump(FILE * = stdout) const;
private:
// This member comes first because it's used like a vtable by generated code.
// It includes all of the ancestor types' bindings, if any, first,
// with any overrides from descendants already applied to them. Local
// bindings then follow in alphabetic order of binding name.
StaticDescriptor<1, true>
binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
StaticDescriptor<0> name_; // CHARACTER(:), POINTER
std::uint64_t sizeInBytes_{0};
StaticDescriptor<0, true> parent_; // TYPE(DERIVEDTYPE), POINTER
// Instantiations of a parameterized derived type with KIND type
// parameters will point this data member to the description of
// the original uninstantiated type, which may be shared from a
// module via use association. The original uninstantiated derived
// type description will point to itself. Derived types that have
// no KIND type parameters will have a null pointer here.
StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
// TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
std::uint64_t typeHash_{0};
// These pointer targets include all of the items from the parent, if any.
StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
StaticDescriptor<1>
lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
// This array of local data components includes the parent component.
// Components are in component order, not collation order of their names.
// It does not include procedure pointer components.
StaticDescriptor<1, true>
component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
// Procedure pointer components
StaticDescriptor<1, true>
procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
// Does not include special bindings from ancestral types.
StaticDescriptor<1, true>
special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
};
class DerivedType;
using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
@ -177,7 +103,8 @@ struct ProcPtrComponent {
ProcedurePointer procInitialization; // for Genre::Procedure
};
struct SpecialBinding {
class SpecialBinding {
public:
enum class Which : std::uint8_t {
None = 0,
Assignment = 4,
@ -189,13 +116,27 @@ struct SpecialBinding {
ReadUnformatted = 17,
WriteFormatted = 18,
WriteUnformatted = 19
} which{Which::None};
};
Which which() const { return which_; }
int rank() const { return rank_; }
bool IsArgDescriptor(int zeroBasedArg) const {
return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
}
template <typename PROC> PROC GetProc() const {
return reinterpret_cast<PROC>(proc_);
}
FILE *Dump(FILE *) const;
private:
Which which_{Which::None};
// Used for Which::Final only. Which::Assignment always has rank 0, as
// type-bound defined assignment for rank > 0 must be elemental
// due to the required passed object dummy argument, which are scalar.
// User defined derived type I/O is always scalar.
std::uint8_t rank{0};
std::uint8_t rank_{0};
// The following little bit-set identifies which dummy arguments are
// passed via descriptors for their derived type arguments.
@ -222,9 +163,86 @@ struct SpecialBinding {
// the case when and only when the derived type is extensible.
// When false, the user derived type I/O subroutine must have been
// called via a generic interface, not a generic TBP.
std::uint8_t isArgDescriptorSet{0};
std::uint8_t isArgDescriptorSet_{0};
ProcedurePointer proc{nullptr};
ProcedurePointer proc_{nullptr};
};
class DerivedType {
public:
~DerivedType(); // never defined
const Descriptor &binding() const { return binding_.descriptor(); }
const Descriptor &name() const { return name_.descriptor(); }
std::uint64_t sizeInBytes() const { return sizeInBytes_; }
const Descriptor &parent() const { return parent_.descriptor(); }
std::uint64_t typeHash() const { return typeHash_; }
const Descriptor &uninstatiated() const {
return uninstantiated_.descriptor();
}
const Descriptor &kindParameter() const {
return kindParameter_.descriptor();
}
const Descriptor &lenParameterKind() const {
return lenParameterKind_.descriptor();
}
const Descriptor &component() const { return component_.descriptor(); }
const Descriptor &procPtr() const { return procPtr_.descriptor(); }
const Descriptor &special() const { return special_.descriptor(); }
std::size_t LenParameters() const { return lenParameterKind().Elements(); }
// Finds a data component by name in this derived type or tis ancestors.
const Component *FindDataComponent(
const char *name, std::size_t nameLen) const;
const SpecialBinding *FindSpecialBinding(SpecialBinding::Which) const;
FILE *Dump(FILE * = stdout) const;
private:
// This member comes first because it's used like a vtable by generated code.
// It includes all of the ancestor types' bindings, if any, first,
// with any overrides from descendants already applied to them. Local
// bindings then follow in alphabetic order of binding name.
StaticDescriptor<1, true>
binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
StaticDescriptor<0> name_; // CHARACTER(:), POINTER
std::uint64_t sizeInBytes_{0};
StaticDescriptor<0, true> parent_; // TYPE(DERIVEDTYPE), POINTER
// Instantiations of a parameterized derived type with KIND type
// parameters will point this data member to the description of
// the original uninstantiated type, which may be shared from a
// module via use association. The original uninstantiated derived
// type description will point to itself. Derived types that have
// no KIND type parameters will have a null pointer here.
StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
// TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
std::uint64_t typeHash_{0};
// These pointer targets include all of the items from the parent, if any.
StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
StaticDescriptor<1>
lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
// This array of local data components includes the parent component.
// Components are in component order, not collation order of their names.
// It does not include procedure pointer components.
StaticDescriptor<1, true>
component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
// Procedure pointer components
StaticDescriptor<1, true>
procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
// Does not include special bindings from ancestral types.
StaticDescriptor<1, true>
special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
};
} // namespace Fortran::runtime::typeInfo
#endif // FORTRAN_RUNTIME_TYPE_INFO_H_

1
flang/runtime/unit-map.cpp
View File

@ -92,4 +92,5 @@ ExternalFileUnit &UnitMap::Create(int n, const Terminator &terminator) {
bucket_[Hash(n)].swap(chain.next); // pushes new node as list head
return chain.unit;
}
} // namespace Fortran::runtime::io

46
flang/runtime/unit.cpp
View File

@ -87,8 +87,11 @@ ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
return GetUnitMap().LookUpForClose(unit);
}
int ExternalFileUnit::NewUnit(const Terminator &terminator) {
return GetUnitMap().NewUnit(terminator).unitNumber();
ExternalFileUnit &ExternalFileUnit::NewUnit(
const Terminator &terminator, bool forChildIo) {
ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
unit.createdForInternalChildIo_ = forChildIo;
return unit;
}
void ExternalFileUnit::OpenUnit(std::optional<OpenStatus> status,
@ -697,4 +700,43 @@ void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) {
BeginRecord();
impliedEndfile_ = false;
}
ChildIo &ExternalFileUnit::PushChildIo(IoStatementState &parent) {
OwningPtr<ChildIo> current{std::move(child_)};
Terminator &terminator{parent.GetIoErrorHandler()};
OwningPtr<ChildIo> next{New<ChildIo>{terminator}(parent, std::move(current))};
child_.reset(next.release());
return *child_;
}
void ExternalFileUnit::PopChildIo(ChildIo &child) {
if (child_.get() != &child) {
child.parent().GetIoErrorHandler().Crash(
"ChildIo being popped is not top of stack");
}
child_.reset(child.AcquirePrevious().release()); // deletes top child
}
void ChildIo::EndIoStatement() {
io_.reset();
u_.emplace<std::monostate>();
}
bool ChildIo::CheckFormattingAndDirection(Terminator &terminator,
const char *what, bool unformatted, Direction direction) {
bool parentIsUnformatted{!parent_.get_if<FormattedIoStatementState>()};
bool parentIsInput{!parent_.get_if<IoDirectionState<Direction::Output>>()};
if (unformatted != parentIsUnformatted) {
terminator.Crash("Child %s attempted on %s parent I/O unit", what,
parentIsUnformatted ? "unformatted" : "formatted");
return false;
} else if (parentIsInput != (direction == Direction::Input)) {
terminator.Crash("Child %s attempted on %s parent I/O unit", what,
parentIsInput ? "input" : "output");
return false;
} else {
return true;
}
}
} // namespace Fortran::runtime::io

57
flang/runtime/unit.h
View File

@ -28,6 +28,7 @@
namespace Fortran::runtime::io {
class UnitMap;
class ChildIo;
class ExternalFileUnit : public ConnectionState,
public OpenFile,
@ -36,6 +37,7 @@ public:
explicit ExternalFileUnit(int unitNumber) : unitNumber_{unitNumber} {}
int unitNumber() const { return unitNumber_; }
bool swapEndianness() const { return swapEndianness_; }
bool createdForInternalChildIo() const { return createdForInternalChildIo_; }
static ExternalFileUnit *LookUp(int unit);
static ExternalFileUnit &LookUpOrCrash(int unit, const Terminator &);
@ -46,7 +48,7 @@ public:
static ExternalFileUnit *LookUp(const char *path);
static ExternalFileUnit &CreateNew(int unit, const Terminator &);
static ExternalFileUnit *LookUpForClose(int unit);
static int NewUnit(const Terminator &);
static ExternalFileUnit &NewUnit(const Terminator &, bool forChildIo = false);
static void CloseAll(IoErrorHandler &);
static void FlushAll(IoErrorHandler &);
@ -62,7 +64,6 @@ public:
template <typename A, typename... X>
IoStatementState &BeginIoStatement(X &&...xs) {
// TODO: Child data transfer statements vs. locking
lock_.Take(); // dropped in EndIoStatement()
A &state{u_.emplace<A>(std::forward<X>(xs)...)};
if constexpr (!std::is_same_v<A, OpenStatementState>) {
@ -91,6 +92,10 @@ public:
BeginRecord();
}
ChildIo *GetChildIo() { return child_.get(); }
ChildIo &PushChildIo(IoStatementState &);
void PopChildIo(ChildIo &);
private:
static UnitMap &GetUnitMap();
const char *FrameNextInput(IoErrorHandler &, std::size_t);
@ -116,8 +121,8 @@ private:
ExternalFormattedIoStatementState<Direction::Input>,
ExternalListIoStatementState<Direction::Output>,
ExternalListIoStatementState<Direction::Input>,
UnformattedIoStatementState<Direction::Output>,
UnformattedIoStatementState<Direction::Input>, InquireUnitState,
ExternalUnformattedIoStatementState<Direction::Output>,
ExternalUnformattedIoStatementState<Direction::Input>, InquireUnitState,
ExternalMiscIoStatementState>
u_;
@ -132,6 +137,50 @@ private:
std::size_t recordOffsetInFrame_{0}; // of currentRecordNumber
bool swapEndianness_{false};
bool createdForInternalChildIo_{false};
// A stack of child I/O pseudo-units for user-defined derived type
// I/O that have this unit number.
OwningPtr<ChildIo> child_;
};
// A pseudo-unit for child I/O statements in user-defined derived type
// I/O subroutines; it forwards operations to the parent I/O statement,
// which can also be a child I/O statement.
class ChildIo {
public:
ChildIo(IoStatementState &parent, OwningPtr<ChildIo> &&previous)
: parent_{parent}, previous_{std::move(previous)} {}
IoStatementState &parent() const { return parent_; }
void EndIoStatement();
template <typename A, typename... X>
IoStatementState &BeginIoStatement(X &&...xs) {
A &state{u_.emplace<A>(std::forward<X>(xs)...)};
io_.emplace(state);
return *io_;
}
OwningPtr<ChildIo> AcquirePrevious() { return std::move(previous_); }
bool CheckFormattingAndDirection(
Terminator &, const char *what, bool unformatted, Direction);
private:
IoStatementState &parent_;
OwningPtr<ChildIo> previous_;
std::variant<std::monostate,
ChildFormattedIoStatementState<Direction::Output>,
ChildFormattedIoStatementState<Direction::Input>,
ChildListIoStatementState<Direction::Output>,
ChildListIoStatementState<Direction::Input>,
ChildUnformattedIoStatementState<Direction::Output>,
ChildUnformattedIoStatementState<Direction::Input>>
u_;
std::optional<IoStatementState> io_;
};
} // namespace Fortran::runtime::io

2
flang/test/Semantics/typeinfo01.f90
View File

@ -171,7 +171,7 @@ module m09
end module
module m10
type :: t
type, bind(c) :: t ! non-extensible
end type
interface read(formatted)
procedure :: rf