[flang-commits] [flang] cc180f4 - [flang] Support for character array formats
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Aug 18 15:36:01 PDT 2022
Author: Peter Klausler
Date: 2022-08-18T15:35:47-07:00
New Revision: cc180f4c8cd9a03fe737ed98abb5e54aaacf4ba8
URL: https://github.com/llvm/llvm-project/commit/cc180f4c8cd9a03fe737ed98abb5e54aaacf4ba8
DIFF: https://github.com/llvm/llvm-project/commit/cc180f4c8cd9a03fe737ed98abb5e54aaacf4ba8.diff
LOG: [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
Added:
Modified:
flang/include/flang/Runtime/io-api.h
flang/lib/Semantics/check-io.cpp
flang/runtime/format-implementation.h
flang/runtime/format.h
flang/runtime/io-api.cpp
flang/runtime/io-stmt.cpp
flang/runtime/io-stmt.h
flang/test/Semantics/assign06.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Runtime/io-api.h b/flang/include/flang/Runtime/io-api.h
index 27cffdad42c13..972fbace66aec 100644
--- a/flang/include/flang/Runtime/io-api.h
+++ b/flang/include/flang/Runtime/io-api.h
@@ -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,
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index fa044b2615c6f..60980405fdc08 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -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)};
diff --git a/flang/runtime/format-implementation.h b/flang/runtime/format-implementation.h
index f29b59276f81e..251ce241c9a3b 100644
--- a/flang/runtime/format-implementation.h
+++ b/flang/runtime/format-implementation.h
@@ -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_
diff --git a/flang/runtime/format.h b/flang/runtime/format.h
index 2db7a788f4fe3..718a2677c14c9 100644
--- a/flang/runtime/format.h
+++ b/flang/runtime/format.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 @@ template <typename CONTEXT> class FormatControl {
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 @@ template <typename CONTEXT> class FormatControl {
// 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
diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp
index bdde5767b3a2f..152ac9fb6f60f 100644
--- a/flang/runtime/io-api.cpp
+++ b/flang/runtime/io-api.cpp
@@ -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>
diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp
index d2e32f12b9ff7..fa73371e3f7f5 100644
--- a/flang/runtime/io-stmt.cpp
+++ b/flang/runtime/io-stmt.cpp
@@ -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() {
diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h
index 46fc2157fbb54..388bcaa1aad81 100644
--- a/flang/runtime/io-stmt.h
+++ b/flang/runtime/io-stmt.h
@@ -358,10 +358,11 @@ class InternalFormattedIoStatementState
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 @@ class ExternalFormattedIoStatementState
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 @@ class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
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();
diff --git a/flang/test/Semantics/assign06.f90 b/flang/test/Semantics/assign06.f90
index c9e9d859add3c..70b3f60d4edea 100644
--- a/flang/test/Semantics/assign06.f90
+++ b/flang/test/Semantics/assign06.f90
@@ -11,8 +11,8 @@ subroutine test(n)
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 @@ subroutine test(n)
!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
More information about the flang-commits
mailing list