diff --git a/flang/include/flang/Common/format.h b/flang/include/flang/Common/format.h index 99b8cbe41d7cf..e38ea6b0dfedf 100644 --- a/flang/include/flang/Common/format.h +++ b/flang/include/flang/Common/format.h @@ -136,11 +136,11 @@ template class FormatValidator { 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 void FormatValidator::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 void FormatValidator::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 bool FormatValidator::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); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 5d063f14499a3..b57d19b8a62e5 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -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" diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index 5f4bbc73c23d2..1f7e3d14728a4 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -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 diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp index ef4bddc8a4669..4875ef2a4bc57 100644 --- a/flang/runtime/derived.cpp +++ b/flang/runtime/derived.cpp @@ -20,9 +20,9 @@ static const typeInfo::SpecialBinding *FindFinal( for (std::size_t j{0}; j < totalSpecialBindings; ++j) { const auto &special{ *specialDesc.ZeroBasedIndexedElement(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(special->proc)}; + auto *p{special->GetProc()}; // Finalizable objects must be contiguous. std::size_t elements{descriptor.Elements()}; for (std::size_t j{0}; j < elements; ++j) { p(descriptor.OffsetElement(j * byteStride)); } - } else if (special->isArgDescriptorSet & 1) { - auto p{reinterpret_cast(special->proc)}; + } else if (special->IsArgDescriptor(0)) { + auto *p{special->GetProc()}; p(descriptor); } else { // Finalizable objects must be contiguous. - auto p{reinterpret_cast(special->proc)}; + auto *p{special->GetProc()}; p(descriptor.OffsetElement()); } } diff --git a/flang/runtime/descriptor-io.cpp b/flang/runtime/descriptor-io.cpp new file mode 100644 index 0000000000000..2e552b7c5228e --- /dev/null +++ b/flang/runtime/descriptor-io.cpp @@ -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 DefinedFormattedIo(IoStatementState &io, + const Descriptor &descriptor, const typeInfo::SpecialBinding &special) { + std::optional 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(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()}; + p(descriptor, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen, + sizeof ioMsg); + } else { + auto *p{special.GetProc()}; + 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()}; + p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg); + } else { + auto *p{special.GetProc()}; + 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 diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h index 09d068612325b..2ebb449e46d11 100644 --- a/flang/runtime/descriptor-io.h +++ b/flang/runtime/descriptor-io.h @@ -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,92 +247,130 @@ static bool DefaultFormattedComponentIO(IoStatementState &io, } } +std::optional DefinedFormattedIo( + IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &); + template 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(at)}; - if (!DefaultFormattedComponentIO( - 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 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(at)}; + if (!DefaultFormattedComponentIO( + io, component, descriptor, subscripts, handler)) { + return false; } } } return true; } +bool DefinedUnformattedIo( + IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &); + +// Unformatted I/O template -static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) { - if (!io.get_if>()) { - io.GetIoErrorHandler().Crash( - "DescriptorIO() called for wrong I/O direction"); - return false; - } - if constexpr (DIR == Direction::Input) { - if (!io.BeginReadingRecord()) { - return false; - } - } - if (auto *unf{io.get_if>()}) { +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>()}; + auto *childUnf{io.get_if>()}; + 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); - 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(io, descriptor, subscripts)}; - auto totalBytes{numElements * elementBytes}; + using CharType = + std::conditional_t; + auto Transfer{[=](CharType &x, std::size_t totalBytes, + std::size_t elementBytes) -> bool { if constexpr (DIR == Direction::Output) { - return unf->Emit(&x, totalBytes, elementBytes); + return externalUnf ? externalUnf->Emit(&x, totalBytes, elementBytes) + : childUnf->Emit(&x, totalBytes, elementBytes); } else { - return unf->Receive(&x, totalBytes, elementBytes); + return externalUnf ? externalUnf->Receive(&x, totalBytes, elementBytes) + : childUnf->Receive(&x, totalBytes, elementBytes); } + }}; + if (descriptor.IsContiguous()) { // contiguous unformatted I/O + char &x{ExtractElement(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(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 (!Transfer(x, elementBytes, elementBytes)) { + return false; } if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "DescriptorIO: subscripts out of bounds"); + handler.Crash("DescriptorIO: subscripts out of bounds"); } } return true; } - } else if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) { + } +} + +template +static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) { + if (!io.get_if>()) { + io.GetIoErrorHandler().Crash( + "DescriptorIO() called for wrong I/O direction"); + return false; + } + if constexpr (DIR == Direction::Input) { + if (!io.BeginReadingRecord()) { + return false; + } + } + if (!io.get_if()) { + return UnformattedDescriptorIO(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, 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(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, 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(io, descriptor); } } - io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor", + handler.Crash("DescriptorIO: Bad type code (%d) in descriptor", static_cast(descriptor.type().raw())); return false; } diff --git a/flang/runtime/format-implementation.h b/flang/runtime/format-implementation.h index 91d80a7336019..63ca682eb3e7a 100644 --- a/flang/runtime/format-implementation.h +++ b/flang/runtime/format-implementation.h @@ -338,10 +338,12 @@ int FormatControl::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::CueUpNextDataEdit(Context &context, bool stop) { } } +// Returns the next data edit descriptor template DataEdit FormatControl::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(Capitalize(GetNextChar(context))); if (edit.descriptor == 'E') { - edit.variation = static_cast(Capitalize(PeekNext())); - if (edit.variation >= 'A' && edit.variation <= 'Z') { + if (auto next{static_cast(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(PeekNext())}; + quote == '\'' || quote == '"') { + // Capture the quoted 'iotype' + bool ok{false}, tooLong{false}; + for (++offset_; offset_ < formatLength_;) { + auto ch{static_cast(format_[offset_++])}; + if (ch == quote && + (offset_ == formatLength_ || + static_cast(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(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::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] != '(') { diff --git a/flang/runtime/format.cpp b/flang/runtime/format.cpp index 65ed12447bb58..e46cada81aa6c 100644 --- a/flang/runtime/format.cpp +++ b/flang/runtime/format.cpp @@ -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 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>; template class FormatControl< @@ -61,4 +17,6 @@ template class FormatControl< ExternalFormattedIoStatementState>; template class FormatControl< ExternalFormattedIoStatementState>; +template class FormatControl>; +template class FormatControl>; } // namespace Fortran::runtime::io diff --git a/flang/runtime/format.h b/flang/runtime/format.h index 9dcd59a54a8bc..77daa38f3262e 100644 --- a/flang/runtime/format.h +++ b/flang/runtime/format.h @@ -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 width; // the 'w' field; optional for A std::optional digits; // the 'm' or 'd' field std::optional expoDigits; // 'Ee' field MutableModes modes; int repeat{1}; -}; -// FormatControl 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 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 class FormatControl { public: using Context = CONTEXT; @@ -98,7 +94,8 @@ template class FormatControl { } // 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) diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp index 8754cd666ae7a..d1b13cb330eba 100644 --- a/flang/runtime/io-api.cpp +++ b/flang/runtime/io-api.cpp @@ -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 (!unit.isUnformatted.has_value()) { - unit.isUnformatted = false; - } - if (*unit.isUnformatted) { - terminator.Crash("%s attempted on unformatted file", what); - return nullptr; + if (ChildIo * child{unit.GetChildIo()}) { + return child->CheckFormattingAndDirection(terminator, what, false, DIR) + ? &child->BeginIoStatement>( + *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>( + std::forward(xs)..., unit, sourceFile, sourceLine)}; + return &io; } - IoErrorHandler handler{terminator}; - unit.SetDirection(DIR, handler); - IoStatementState &io{unit.BeginIoStatement>( - std::forward(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 (*unit.isUnformatted) { - terminator.Crash("Formatted I/O attempted on unformatted file"); - return nullptr; + if (ChildIo * child{unit.GetChildIo()}) { + return child->CheckFormattingAndDirection(terminator, + DIR == Direction::Output ? "formatted output" + : "formatted input", + false, DIR) + ? &child->BeginIoStatement>( + *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>( + unit, format, formatLength, sourceFile, sourceLine)}; + return &io; } - IoErrorHandler handler{terminator}; - unit.SetDirection(DIR, handler); - IoStatementState &io{ - unit.BeginIoStatement>( - 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>( - 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::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>( + *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>( + 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::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( 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>()}) { + if (auto *unf{io.get_if< + ExternalUnformattedIoStatementState>()}) { 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>()}) { + if (auto *unf{ + io.get_if>()}) { return unf->Receive(x, length, elementBytes); } io.GetIoErrorHandler().Crash("InputUnformattedBlock() called for an I/O " diff --git a/flang/runtime/io-error.cpp b/flang/runtime/io-error.cpp index bc835bad1dc13..19342c5aa427b 100644 --- a/flang/runtime/io-error.cpp +++ b/flang/runtime/io-error.cpp @@ -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); } diff --git a/flang/runtime/io-error.h b/flang/runtime/io-error.h index e51df9b5be866..dd2a269fef89a 100644 --- a/flang/runtime/io-error.h +++ b/flang/runtime/io-error.h @@ -32,6 +32,9 @@ class IoErrorHandler : public Terminator { 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 @@ class IoErrorHandler : public Terminator { SignalError(IostatGenericError, msg, std::forward(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 diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp index 099d9038a8acd..3432f847cce51 100644 --- a/flang/runtime/io-stmt.cpp +++ b/flang/runtime/io-stmt.cpp @@ -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 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 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::InternalIoStatementState( template bool InternalIoStatementState::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::Emit() called"); return false; } - return unit_.Emit(data, chars, *this); + return unit_.Emit(data, chars * sizeof(CharType), *this); } template @@ -252,6 +284,14 @@ bool ExternalIoStatementState::Emit( return unit().Emit(data, bytes, elementBytes, *this); } +template +bool ExternalIoStatementState::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 bool ExternalIoStatementState::Emit( const char16_t *data, std::size_t chars) { @@ -261,7 +301,7 @@ bool ExternalIoStatementState::Emit( } // TODO: UTF-8 encoding return unit().Emit(reinterpret_cast(data), chars * sizeof *data, - static_cast(sizeof *data), *this); + sizeof *data, *this); } template @@ -273,7 +313,7 @@ bool ExternalIoStatementState::Emit( } // TODO: UTF-8 encoding return unit().Emit(reinterpret_cast(data), chars * sizeof *data, - static_cast(sizeof *data), *this); + sizeof *data, *this); } template @@ -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 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::GetNextDataEdit( } template -bool UnformattedIoStatementState::Receive( +bool ExternalUnformattedIoStatementState::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 -bool UnformattedIoStatementState::Emit( +ChildIoStatementState::ChildIoStatementState( + ChildIo &child, const char *sourceFile, int sourceLine) + : IoStatementBase{sourceFile, sourceLine}, child_{child} {} + +template +MutableModes &ChildIoStatementState::mutableModes() { + return child_.parent().mutableModes(); +} + +template +ConnectionState &ChildIoStatementState::GetConnectionState() { + return child_.parent().GetConnectionState(); +} + +template +ExternalFileUnit *ChildIoStatementState::GetExternalFileUnit() const { + return child_.parent().GetExternalFileUnit(); +} + +template int ChildIoStatementState::EndIoStatement() { + auto result{IoStatementBase::EndIoStatement()}; + child_.EndIoStatement(); // annihilates *this in child_.u_ + return result; +} + +template +bool ChildIoStatementState::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::Emit(data, bytes, elementBytes); + return child_.parent().Emit(data, bytes, elementBytes); +} + +template +bool ChildIoStatementState::Emit(const char *data, std::size_t bytes) { + return child_.parent().Emit(data, bytes); +} + +template +bool ChildIoStatementState::Emit(const char16_t *data, std::size_t chars) { + return child_.parent().Emit(data, chars); +} + +template +bool ChildIoStatementState::Emit(const char32_t *data, std::size_t chars) { + return child_.parent().Emit(data, chars); +} + +template +std::optional ChildIoStatementState::GetCurrentChar() { + return child_.parent().GetCurrentChar(); +} + +template +void ChildIoStatementState::HandleAbsolutePosition(std::int64_t n) { + return child_.parent().HandleAbsolutePosition(n); +} + +template +void ChildIoStatementState::HandleRelativePosition(std::int64_t n) { + return child_.parent().HandleRelativePosition(n); +} + +template +ChildFormattedIoStatementState::ChildFormattedIoStatementState( + ChildIo &child, const CHAR *format, std::size_t formatLength, + const char *sourceFile, int sourceLine) + : ChildIoStatementState{child, sourceFile, sourceLine}, + mutableModes_{child.parent().mutableModes()}, format_{*this, format, + formatLength} {} + +template +int ChildFormattedIoStatementState::EndIoStatement() { + format_.Finish(*this); + return ChildIoStatementState::EndIoStatement(); +} + +template +bool ChildFormattedIoStatementState::AdvanceRecord(int) { + return false; // no can do in a child I/O +} + +template +bool ChildUnformattedIoStatementState::Receive( + char *data, std::size_t bytes, std::size_t elementBytes) { + return this->child().parent().Receive(data, bytes, elementBytes); } template class InternalIoStatementState; @@ -713,8 +852,16 @@ template class ExternalFormattedIoStatementState; template class ExternalFormattedIoStatementState; template class ExternalListIoStatementState; template class ExternalListIoStatementState; -template class UnformattedIoStatementState; -template class UnformattedIoStatementState; +template class ExternalUnformattedIoStatementState; +template class ExternalUnformattedIoStatementState; +template class ChildIoStatementState; +template class ChildIoStatementState; +template class ChildFormattedIoStatementState; +template class ChildFormattedIoStatementState; +template class ChildListIoStatementState; +template class ChildListIoStatementState; +template class ChildUnformattedIoStatementState; +template class ChildUnformattedIoStatementState; 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 diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h index b76c5202619b7..34c4a47363c0d 100644 --- a/flang/runtime/io-stmt.h +++ b/flang/runtime/io-stmt.h @@ -25,6 +25,7 @@ namespace Fortran::runtime::io { class ExternalFileUnit; +class ChildIo; class OpenStatementState; class InquireUnitState; @@ -41,7 +42,10 @@ template class InternalListIoStatementState; template class ExternalFormattedIoStatementState; template class ExternalListIoStatementState; -template class UnformattedIoStatementState; +template class ExternalUnformattedIoStatementState; +template class ChildFormattedIoStatementState; +template class ChildListIoStatementState; +template class ChildUnformattedIoStatementState; struct InputStatementState {}; struct OutputStatementState {}; @@ -60,17 +64,19 @@ class IoStatementState { // 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 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 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 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 @@ class IoStatementState { 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 A *get_if() const { return std::visit( @@ -129,8 +139,18 @@ class IoStatementState { ExternalFormattedIoStatementState>, std::reference_wrapper>, std::reference_wrapper>, - std::reference_wrapper>, - std::reference_wrapper>, + std::reference_wrapper< + ExternalUnformattedIoStatementState>, + std::reference_wrapper< + ExternalUnformattedIoStatementState>, + std::reference_wrapper>, + std::reference_wrapper>, + std::reference_wrapper>, + std::reference_wrapper>, + std::reference_wrapper< + ChildUnformattedIoStatementState>, + std::reference_wrapper< + ChildUnformattedIoStatementState>, std::reference_wrapper, std::reference_wrapper, std::reference_wrapper, @@ -140,18 +160,30 @@ class IoStatementState { }; // 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 GetCurrentChar(); + bool AdvanceRecord(int); + void BackspaceRecord(); + void HandleRelativePosition(std::int64_t); + void HandleAbsolutePosition(std::int64_t); std::optional 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 @@ class InternalIoStatementState : public IoStatementBase, 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 GetCurrentChar(); bool AdvanceRecord(int = 1); void BackspaceRecord(); @@ -275,7 +310,7 @@ class ExternalIoStatementBase : public IoStatementBase { 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 GetCurrentChar(); @@ -331,13 +367,73 @@ class ExternalListIoStatementState : public ExternalIoStatementState, }; template -class UnformattedIoStatementState : public ExternalIoStatementState { +class ExternalUnformattedIoStatementState + : public ExternalIoStatementState { public: using ExternalIoStatementState::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 +class ChildIoStatementState : public IoStatementBase, + public IoDirectionState { +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 GetCurrentChar(); + void HandleRelativePosition(std::int64_t); + void HandleAbsolutePosition(std::int64_t); + +private: + ChildIo &child_; +}; + +template +class ChildFormattedIoStatementState : public ChildIoStatementState, + 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 GetNextDataEdit( + IoStatementState &, int maxRepeat = 1) { + return format_.GetNextDataEdit(*this, maxRepeat); + } + +private: + MutableModes mutableModes_; + FormatControl format_; +}; + +template +class ChildListIoStatementState : public ChildIoStatementState, + public ListDirectedStatementState { +public: + using ChildIoStatementState::ChildIoStatementState; + using ListDirectedStatementState::GetNextDataEdit; +}; + +template +class ChildUnformattedIoStatementState : public ChildIoStatementState { +public: + using ChildIoStatementState::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; extern template class ExternalFormattedIoStatementState; extern template class ExternalListIoStatementState; extern template class ExternalListIoStatementState; -extern template class UnformattedIoStatementState; -extern template class UnformattedIoStatementState; +extern template class ExternalUnformattedIoStatementState; +extern template class ExternalUnformattedIoStatementState; +extern template class ChildIoStatementState; +extern template class ChildIoStatementState; +extern template class ChildFormattedIoStatementState; +extern template class ChildFormattedIoStatementState; +extern template class ChildListIoStatementState; +extern template class ChildListIoStatementState; +extern template class ChildUnformattedIoStatementState; +extern template class ChildUnformattedIoStatementState; + extern template class FormatControl< InternalFormattedIoStatementState>; extern template class FormatControl< @@ -425,6 +530,10 @@ extern template class FormatControl< ExternalFormattedIoStatementState>; extern template class FormatControl< ExternalFormattedIoStatementState>; +extern template class FormatControl< + ChildFormattedIoStatementState>; +extern template class FormatControl< + ChildFormattedIoStatementState>; 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}; diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp index c67da77e0c118..07f38cdf3efa5 100644 --- a/flang/runtime/tools.cpp +++ b/flang/runtime/tools.cpp @@ -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); } } diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp index df72fc466a29b..9385eabf2dc84 100644 --- a/flang/runtime/type-info.cpp +++ b/flang/runtime/type-info.cpp @@ -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(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(sizeof *uints)}; std::fprintf(f, " [+%3d](0x%p) %#016jx", offset, reinterpret_cast(&uints[j]), - static_cast(uints[j])); + static_cast(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(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(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(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(proc_)); + return f; +} + } // namespace Fortran::runtime::typeInfo diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h index 05a4c41a34997..0dfb4b64ffd35 100644 --- a/flang/runtime/type-info.h +++ b/flang/runtime/type-info.h @@ -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 PROC GetProc() const { + return reinterpret_cast(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}; +}; + +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 - ProcedurePointer proc{nullptr}; + // 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_ diff --git a/flang/runtime/unit-map.cpp b/flang/runtime/unit-map.cpp index 1cd2115f4aa1b..915c747371850 100644 --- a/flang/runtime/unit-map.cpp +++ b/flang/runtime/unit-map.cpp @@ -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 diff --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp index 79f3722fb7aba..aafb71fb6d73c 100644 --- a/flang/runtime/unit.cpp +++ b/flang/runtime/unit.cpp @@ -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 status, @@ -697,4 +700,43 @@ void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) { BeginRecord(); impliedEndfile_ = false; } + +ChildIo &ExternalFileUnit::PushChildIo(IoStatementState &parent) { + OwningPtr current{std::move(child_)}; + Terminator &terminator{parent.GetIoErrorHandler()}; + OwningPtr next{New{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(); +} + +bool ChildIo::CheckFormattingAndDirection(Terminator &terminator, + const char *what, bool unformatted, Direction direction) { + bool parentIsUnformatted{!parent_.get_if()}; + bool parentIsInput{!parent_.get_if>()}; + 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 diff --git a/flang/runtime/unit.h b/flang/runtime/unit.h index 9634f1a95804e..68876ff536399 100644 --- a/flang/runtime/unit.h +++ b/flang/runtime/unit.h @@ -28,6 +28,7 @@ namespace Fortran::runtime::io { class UnitMap; +class ChildIo; class ExternalFileUnit : public ConnectionState, public OpenFile, @@ -36,6 +37,7 @@ class ExternalFileUnit : public ConnectionState, 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 @@ class ExternalFileUnit : public ConnectionState, 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 @@ class ExternalFileUnit : public ConnectionState, template IoStatementState &BeginIoStatement(X &&...xs) { - // TODO: Child data transfer statements vs. locking lock_.Take(); // dropped in EndIoStatement() A &state{u_.emplace(std::forward(xs)...)}; if constexpr (!std::is_same_v) { @@ -91,6 +92,10 @@ class ExternalFileUnit : public ConnectionState, 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 @@ class ExternalFileUnit : public ConnectionState, ExternalFormattedIoStatementState, ExternalListIoStatementState, ExternalListIoStatementState, - UnformattedIoStatementState, - UnformattedIoStatementState, InquireUnitState, + ExternalUnformattedIoStatementState, + ExternalUnformattedIoStatementState, InquireUnitState, ExternalMiscIoStatementState> u_; @@ -132,6 +137,50 @@ class ExternalFileUnit : public ConnectionState, 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 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 &&previous) + : parent_{parent}, previous_{std::move(previous)} {} + + IoStatementState &parent() const { return parent_; } + + void EndIoStatement(); + + template + IoStatementState &BeginIoStatement(X &&...xs) { + A &state{u_.emplace(std::forward(xs)...)}; + io_.emplace(state); + return *io_; + } + + OwningPtr AcquirePrevious() { return std::move(previous_); } + + bool CheckFormattingAndDirection( + Terminator &, const char *what, bool unformatted, Direction); + +private: + IoStatementState &parent_; + OwningPtr previous_; + std::variant, + ChildFormattedIoStatementState, + ChildListIoStatementState, + ChildListIoStatementState, + ChildUnformattedIoStatementState, + ChildUnformattedIoStatementState> + u_; + std::optional io_; }; } // namespace Fortran::runtime::io diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90 index a68c392ad7513..088c6e56b6b76 100644 --- a/flang/test/Semantics/typeinfo01.f90 +++ b/flang/test/Semantics/typeinfo01.f90 @@ -171,7 +171,7 @@ subroutine wu(x,u,iostat,iomsg) end module module m10 - type :: t + type, bind(c) :: t ! non-extensible end type interface read(formatted) procedure :: rf