[flang] Support for character array formats
A character array can be used as a format in an I/O data transfer statement, with the interpretation that its elements are concatenated in element order to constitute the format. Support in the runtime with an extra optional descriptor argument to six I/O API calls; support in semantics by removing an earlier check for a simply contiguous array presented as a format. Some work needs to be done in lowering to pass a character array descriptor to the I/O runtime API when present Differential Revision: https://reviews.llvm.org/D132167
This commit is contained in:
parent
ad8eb85545
commit
cc180f4c8c
@ -59,6 +59,8 @@ extern "C" {
|
||||
// Cookie cookie{BeginExternalListOutput(DefaultUnit,__FILE__,__LINE__)};
|
||||
// OutputInteger32(cookie, 666);
|
||||
// EndIoStatement(cookie);
|
||||
// Formatted I/O with explicit formats can supply the format as a
|
||||
// const char * pointer with a length, or with a descriptor.
|
||||
|
||||
// Internal I/O initiation
|
||||
// Internal I/O can loan the runtime library an optional block of memory
|
||||
@ -86,11 +88,11 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &,
|
||||
Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &,
|
||||
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
|
||||
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &,
|
||||
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
|
||||
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
|
||||
// Internal I/O to/from a default-kind character scalar can avoid a
|
||||
// descriptor.
|
||||
@ -105,11 +107,13 @@ Cookie IONAME(BeginInternalListInput)(const char *internal,
|
||||
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
|
||||
std::size_t internalLength, const char *format, std::size_t formatLength,
|
||||
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
const char *sourceFile = nullptr, int sourceLine = 0,
|
||||
const Descriptor *formatDescriptor = nullptr);
|
||||
Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
|
||||
std::size_t internalLength, const char *format, std::size_t formatLength,
|
||||
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
const char *sourceFile = nullptr, int sourceLine = 0,
|
||||
const Descriptor *formatDescriptor = nullptr);
|
||||
|
||||
// External unit numbers must fit in default integers. When the integer
|
||||
// provided as UNIT is of a wider type than the default integer, it could
|
||||
@ -134,10 +138,10 @@ Cookie IONAME(BeginExternalListInput)(ExternalUnit = DefaultUnit,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
Cookie IONAME(BeginExternalFormattedOutput)(const char *format, std::size_t,
|
||||
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
Cookie IONAME(BeginExternalFormattedInput)(const char *format, std::size_t,
|
||||
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
Cookie IONAME(BeginUnformattedOutput)(ExternalUnit = DefaultUnit,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
Cookie IONAME(BeginUnformattedInput)(ExternalUnit = DefaultUnit,
|
||||
|
@ -252,13 +252,6 @@ void IoChecker::Enter(const parser::Format &spec) {
|
||||
"Format expression must be default character or default scalar integer"_err_en_US);
|
||||
return;
|
||||
}
|
||||
if (expr->Rank() > 0 &&
|
||||
!IsSimplyContiguous(*expr, context_.foldingContext())) {
|
||||
// The runtime APIs don't allow arbitrary descriptors for formats.
|
||||
context_.Say(format.source,
|
||||
"Format expression must be a simply contiguous array if not scalar"_err_en_US);
|
||||
return;
|
||||
}
|
||||
flags_.set(Flag::CharFmt);
|
||||
const std::optional<std::string> constantFormat{
|
||||
GetConstExpr<std::string>(format)};
|
||||
|
@ -14,20 +14,47 @@
|
||||
#include "emit-encoded.h"
|
||||
#include "format.h"
|
||||
#include "io-stmt.h"
|
||||
#include "memory.h"
|
||||
#include "flang/Common/format.h"
|
||||
#include "flang/Decimal/decimal.h"
|
||||
#include "flang/Runtime/main.h"
|
||||
#include <algorithm>
|
||||
#include <cstring>
|
||||
#include <limits>
|
||||
|
||||
namespace Fortran::runtime::io {
|
||||
|
||||
template <typename CONTEXT>
|
||||
FormatControl<CONTEXT>::FormatControl(const Terminator &terminator,
|
||||
const CharType *format, std::size_t formatLength, int maxHeight)
|
||||
const CharType *format, std::size_t formatLength,
|
||||
const Descriptor *formatDescriptor, int maxHeight)
|
||||
: maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
|
||||
formatLength_{static_cast<int>(formatLength)} {
|
||||
RUNTIME_CHECK(terminator, maxHeight == maxHeight_);
|
||||
if (!format && formatDescriptor) {
|
||||
// The format is a character array passed via a descriptor.
|
||||
formatLength = formatDescriptor->SizeInBytes() / sizeof(CharType);
|
||||
formatLength_ = static_cast<int>(formatLength);
|
||||
if (formatDescriptor->IsContiguous()) {
|
||||
// Treat the contiguous array as a single character value.
|
||||
format = const_cast<const CharType *>(
|
||||
reinterpret_cast<CharType *>(formatDescriptor->raw().base_addr));
|
||||
} else {
|
||||
// Concatenate its elements into a temporary array.
|
||||
char *p{reinterpret_cast<char *>(
|
||||
AllocateMemoryOrCrash(terminator, formatLength * sizeof(CharType)))};
|
||||
format = p;
|
||||
SubscriptValue at[maxRank];
|
||||
formatDescriptor->GetLowerBounds(at);
|
||||
auto elementBytes{formatDescriptor->ElementBytes()};
|
||||
for (std::size_t j{0}; j < formatLength; ++j) {
|
||||
std::memcpy(p, formatDescriptor->Element<char>(at), elementBytes);
|
||||
p += elementBytes;
|
||||
formatDescriptor->IncrementSubscripts(at);
|
||||
}
|
||||
freeFormat_ = true;
|
||||
}
|
||||
}
|
||||
RUNTIME_CHECK(
|
||||
terminator, formatLength == static_cast<std::size_t>(formatLength_));
|
||||
stack_[0].start = offset_;
|
||||
@ -474,6 +501,9 @@ DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
|
||||
template <typename CONTEXT>
|
||||
void FormatControl<CONTEXT>::Finish(Context &context) {
|
||||
CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
|
||||
if (freeFormat_) {
|
||||
FreeMemory(const_cast<CharType *>(format_));
|
||||
}
|
||||
}
|
||||
} // namespace Fortran::runtime::io
|
||||
#endif // FORTRAN_RUNTIME_FORMAT_IMPLEMENTATION_H_
|
||||
|
@ -18,6 +18,10 @@
|
||||
#include <cinttypes>
|
||||
#include <optional>
|
||||
|
||||
namespace Fortran::runtime {
|
||||
class Descriptor;
|
||||
} // namespace Fortran::runtime
|
||||
|
||||
namespace Fortran::runtime::io {
|
||||
|
||||
class IoStatementState;
|
||||
@ -86,7 +90,8 @@ public:
|
||||
|
||||
FormatControl() {}
|
||||
FormatControl(const Terminator &, const CharType *format,
|
||||
std::size_t formatLength, int maxHeight = maxMaxHeight);
|
||||
std::size_t formatLength, const Descriptor *formatDescriptor = nullptr,
|
||||
int maxHeight = maxMaxHeight);
|
||||
|
||||
// For attempting to allocate in a user-supplied stack area
|
||||
static std::size_t GetNeededSize(int maxHeight) {
|
||||
@ -177,8 +182,9 @@ private:
|
||||
// user program for internal I/O.
|
||||
const std::uint8_t maxHeight_{maxMaxHeight};
|
||||
std::uint8_t height_{0};
|
||||
bool freeFormat_{false};
|
||||
const CharType *format_{nullptr};
|
||||
int formatLength_{0};
|
||||
int formatLength_{0}; // in units of characters
|
||||
int offset_{0}; // next item is at format_[offset_]
|
||||
|
||||
// must be last, may be incomplete
|
||||
|
@ -70,26 +70,31 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &descriptor,
|
||||
template <Direction DIR>
|
||||
Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
|
||||
const char *format, std::size_t formatLength, void ** /*scratchArea*/,
|
||||
std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
|
||||
std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor) {
|
||||
Terminator oom{sourceFile, sourceLine};
|
||||
return &New<InternalFormattedIoStatementState<DIR>>{oom}(
|
||||
descriptor, format, formatLength, sourceFile, sourceLine)
|
||||
return &New<InternalFormattedIoStatementState<DIR>>{oom}(descriptor, format,
|
||||
formatLength, sourceFile, sourceLine, formatDescriptor)
|
||||
.release()
|
||||
->ioStatementState();
|
||||
}
|
||||
|
||||
Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
|
||||
const char *format, std::size_t formatLength, void **scratchArea,
|
||||
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
|
||||
std::size_t scratchBytes, const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor) {
|
||||
return BeginInternalArrayFormattedIO<Direction::Output>(descriptor, format,
|
||||
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
|
||||
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
}
|
||||
|
||||
Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
|
||||
const char *format, std::size_t formatLength, void **scratchArea,
|
||||
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
|
||||
std::size_t scratchBytes, const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor) {
|
||||
return BeginInternalArrayFormattedIO<Direction::Input>(descriptor, format,
|
||||
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
|
||||
formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
}
|
||||
|
||||
template <Direction DIR>
|
||||
@ -123,10 +128,12 @@ Cookie BeginInternalFormattedIO(
|
||||
std::conditional_t<DIR == Direction::Input, const char, char> *internal,
|
||||
std::size_t internalLength, const char *format, std::size_t formatLength,
|
||||
void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor) {
|
||||
Terminator oom{sourceFile, sourceLine};
|
||||
return &New<InternalFormattedIoStatementState<DIR>>{oom}(
|
||||
internal, internalLength, format, formatLength, sourceFile, sourceLine)
|
||||
return &New<InternalFormattedIoStatementState<DIR>>{oom}(internal,
|
||||
internalLength, format, formatLength, sourceFile, sourceLine,
|
||||
formatDescriptor)
|
||||
.release()
|
||||
->ioStatementState();
|
||||
}
|
||||
@ -134,17 +141,19 @@ Cookie BeginInternalFormattedIO(
|
||||
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
|
||||
std::size_t internalLength, const char *format, std::size_t formatLength,
|
||||
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
|
||||
int sourceLine) {
|
||||
int sourceLine, const Descriptor *formatDescriptor) {
|
||||
return BeginInternalFormattedIO<Direction::Output>(internal, internalLength,
|
||||
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
|
||||
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
}
|
||||
|
||||
Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
|
||||
std::size_t internalLength, const char *format, std::size_t formatLength,
|
||||
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
|
||||
int sourceLine) {
|
||||
int sourceLine, const Descriptor *formatDescriptor) {
|
||||
return BeginInternalFormattedIO<Direction::Input>(internal, internalLength,
|
||||
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine);
|
||||
format, formatLength, scratchArea, scratchBytes, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
}
|
||||
|
||||
static Cookie NoopUnit(const Terminator &terminator, int unitNumber,
|
||||
@ -235,7 +244,8 @@ Cookie IONAME(BeginExternalListInput)(
|
||||
|
||||
template <Direction DIR>
|
||||
Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
|
||||
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
|
||||
ExternalUnit unitNumber, const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
if (unitNumber == DefaultUnit) {
|
||||
unitNumber = DIR == Direction::Input ? 5 : 6;
|
||||
@ -259,7 +269,8 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
|
||||
}
|
||||
if (iostat == IostatOk) {
|
||||
return &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
|
||||
*child, format, formatLength, sourceFile, sourceLine);
|
||||
*child, format, formatLength, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
} else {
|
||||
return &child->BeginIoStatement<ErroneousIoStatementState>(
|
||||
iostat, nullptr /* no unit */, sourceFile, sourceLine);
|
||||
@ -270,7 +281,8 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
|
||||
}
|
||||
if (iostat == IostatOk) {
|
||||
return &unit->BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
|
||||
terminator, *unit, format, formatLength, sourceFile, sourceLine);
|
||||
terminator, *unit, format, formatLength, sourceFile, sourceLine,
|
||||
formatDescriptor);
|
||||
} else {
|
||||
return &unit->BeginIoStatement<ErroneousIoStatementState>(
|
||||
terminator, iostat, unit, sourceFile, sourceLine);
|
||||
@ -280,16 +292,16 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
|
||||
|
||||
Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
|
||||
std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
|
||||
int sourceLine) {
|
||||
return BeginExternalFormattedIO<Direction::Output>(
|
||||
format, formatLength, unitNumber, sourceFile, sourceLine);
|
||||
int sourceLine, const Descriptor *formatDescriptor) {
|
||||
return BeginExternalFormattedIO<Direction::Output>(format, formatLength,
|
||||
unitNumber, sourceFile, sourceLine, formatDescriptor);
|
||||
}
|
||||
|
||||
Cookie IONAME(BeginExternalFormattedInput)(const char *format,
|
||||
std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
|
||||
int sourceLine) {
|
||||
return BeginExternalFormattedIO<Direction::Input>(
|
||||
format, formatLength, unitNumber, sourceFile, sourceLine);
|
||||
int sourceLine, const Descriptor *formatDescriptor) {
|
||||
return BeginExternalFormattedIO<Direction::Input>(format, formatLength,
|
||||
unitNumber, sourceFile, sourceLine, formatDescriptor);
|
||||
}
|
||||
|
||||
template <Direction DIR>
|
||||
|
@ -140,16 +140,19 @@ void InternalIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
|
||||
template <Direction DIR, typename CHAR>
|
||||
InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
|
||||
Buffer buffer, std::size_t length, const CharType *format,
|
||||
std::size_t formatLength, const char *sourceFile, int sourceLine)
|
||||
std::size_t formatLength, const char *sourceFile, int sourceLine,
|
||||
const Descriptor *formatDescriptor)
|
||||
: InternalIoStatementState<DIR>{buffer, length, sourceFile, sourceLine},
|
||||
ioStatementState_{*this}, format_{*this, format, formatLength} {}
|
||||
ioStatementState_{*this}, format_{*this, format, formatLength,
|
||||
formatDescriptor} {}
|
||||
|
||||
template <Direction DIR, typename CHAR>
|
||||
InternalFormattedIoStatementState<DIR, CHAR>::InternalFormattedIoStatementState(
|
||||
const Descriptor &d, const CharType *format, std::size_t formatLength,
|
||||
const char *sourceFile, int sourceLine)
|
||||
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
|
||||
: InternalIoStatementState<DIR>{d, sourceFile, sourceLine},
|
||||
ioStatementState_{*this}, format_{*this, format, formatLength} {}
|
||||
ioStatementState_{*this}, format_{*this, format, formatLength,
|
||||
formatDescriptor} {}
|
||||
|
||||
template <Direction DIR, typename CHAR>
|
||||
void InternalFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
|
||||
@ -395,9 +398,9 @@ void ExternalIoStatementState<DIR>::FinishReadingRecord() {
|
||||
template <Direction DIR, typename CHAR>
|
||||
ExternalFormattedIoStatementState<DIR, CHAR>::ExternalFormattedIoStatementState(
|
||||
ExternalFileUnit &unit, const CHAR *format, std::size_t formatLength,
|
||||
const char *sourceFile, int sourceLine)
|
||||
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
|
||||
: ExternalIoStatementState<DIR>{unit, sourceFile, sourceLine},
|
||||
format_{*this, format, formatLength} {}
|
||||
format_{*this, format, formatLength, formatDescriptor} {}
|
||||
|
||||
template <Direction DIR, typename CHAR>
|
||||
void ExternalFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
|
||||
@ -850,10 +853,11 @@ void ChildIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
|
||||
template <Direction DIR, typename CHAR>
|
||||
ChildFormattedIoStatementState<DIR, CHAR>::ChildFormattedIoStatementState(
|
||||
ChildIo &child, const CHAR *format, std::size_t formatLength,
|
||||
const char *sourceFile, int sourceLine)
|
||||
const char *sourceFile, int sourceLine, const Descriptor *formatDescriptor)
|
||||
: ChildIoStatementState<DIR>{child, sourceFile, sourceLine},
|
||||
mutableModes_{child.parent().mutableModes()}, format_{*this, format,
|
||||
formatLength} {}
|
||||
formatLength,
|
||||
formatDescriptor} {}
|
||||
|
||||
template <Direction DIR, typename CHAR>
|
||||
void ChildFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
|
||||
|
@ -358,10 +358,11 @@ public:
|
||||
using typename InternalIoStatementState<DIR>::Buffer;
|
||||
InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
|
||||
const CharType *format, std::size_t formatLength,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
const char *sourceFile = nullptr, int sourceLine = 0,
|
||||
const Descriptor *formatDescriptor = nullptr);
|
||||
InternalFormattedIoStatementState(const Descriptor &, const CharType *format,
|
||||
std::size_t formatLength, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
IoStatementState &ioStatementState() { return ioStatementState_; }
|
||||
void CompleteOperation();
|
||||
int EndIoStatement();
|
||||
@ -444,7 +445,7 @@ public:
|
||||
using CharType = CHAR;
|
||||
ExternalFormattedIoStatementState(ExternalFileUnit &, const CharType *format,
|
||||
std::size_t formatLength, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
void CompleteOperation();
|
||||
int EndIoStatement();
|
||||
std::optional<DataEdit> GetNextDataEdit(
|
||||
@ -500,7 +501,7 @@ public:
|
||||
using CharType = CHAR;
|
||||
ChildFormattedIoStatementState(ChildIo &, const CharType *format,
|
||||
std::size_t formatLength, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
int sourceLine = 0, const Descriptor *formatDescriptor = nullptr);
|
||||
MutableModes &mutableModes() { return mutableModes_; }
|
||||
void CompleteOperation();
|
||||
int EndIoStatement();
|
||||
|
@ -11,8 +11,8 @@ program main
|
||||
integer(kind=1) :: badlab1
|
||||
real :: badlab2
|
||||
integer :: badlab3(1)
|
||||
real, pointer :: badlab4(:) ! not contiguous
|
||||
real, pointer, contiguous :: oklab4(:)
|
||||
character, pointer :: badlab4(:) ! not contiguous
|
||||
character, pointer, contiguous :: oklab4(:)
|
||||
assign 1 to lab ! ok
|
||||
assign 1 to implicitlab1 ! ok
|
||||
!ERROR: 'badlab1' must be a default integer scalar variable
|
||||
@ -44,9 +44,9 @@ program main
|
||||
!Legacy extension cases
|
||||
write(*,fmt=badlab2)
|
||||
write(*,fmt=badlab3)
|
||||
!ERROR: Format expression must be a simply contiguous array if not scalar
|
||||
write(*,fmt=badlab4)
|
||||
write(*,fmt=badlab5) ! ok legacy extension
|
||||
!Array cases
|
||||
write(*,fmt=badlab4) ! ok
|
||||
write(*,fmt=badlab5) ! ok
|
||||
1 continue
|
||||
3 format('yes')
|
||||
end subroutine test
|
||||
|
Loading…
x
Reference in New Issue
Block a user