[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:
Peter Klausler 2022-08-18 10:52:59 -07:00
parent ad8eb85545
commit cc180f4c8c
8 changed files with 106 additions and 56 deletions

View File

@ -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,

View File

@ -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)};

View File

@ -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_

View File

@ -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

View File

@ -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>

View File

@ -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() {

View File

@ -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();

View File

@ -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