[flang-commits] [flang] 8489f17 - [flang][runtime] Handle explicit-length character padding & truncation in Assign()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Mar 2 10:43:22 PST 2023
Author: Peter Klausler
Date: 2023-03-02T10:33:59-08:00
New Revision: 8489f17713833b7ae79a734e065e9c181b9bc294
URL: https://github.com/llvm/llvm-project/commit/8489f17713833b7ae79a734e065e9c181b9bc294
DIFF: https://github.com/llvm/llvm-project/commit/8489f17713833b7ae79a734e065e9c181b9bc294.diff
LOG: [flang][runtime] Handle explicit-length character padding & truncation in Assign()
When the left-hand side of an allocatable assignment has an explicit character length,
rather than a deferred length that might imply reallocation, handle any discrepancy
in lengths via truncation or blank padding.
Differential Revision: https://reviews.llvm.org/D145111
Added:
Modified:
flang/include/flang/Runtime/assign.h
flang/runtime/assign.cpp
flang/runtime/type-info.h
Removed:
################################################################################
diff --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h
index 0cc2eb64536d0..0b049b9d4b75d 100644
--- a/flang/include/flang/Runtime/assign.h
+++ b/flang/include/flang/Runtime/assign.h
@@ -36,6 +36,16 @@ void RTNAME(Assign)(Descriptor &to, const Descriptor &from,
// reallocation.
void RTNAME(AssignTemporary)(Descriptor &to, const Descriptor &from,
const char *sourceFile = nullptr, int sourceLine = 0);
+// This variant is for assignments to explicit-length CHARACTER left-hand
+// sides that might need to handle truncation or blank-fill, and
+// must maintain the character length even if an allocatable array
+// is reallocated.
+void RTNAME(AssignExplicitLengthCharacter)(Descriptor &to,
+ const Descriptor &from, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+// This variant is assignments to whole polymorphic allocatables.
+void RTNAME(AssignPolymorphic)(Descriptor &to, const Descriptor &from,
+ const char *sourceFile = nullptr, int sourceLine = 0);
} // extern "C"
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_ASSIGN_H_
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 61e70954207c4..b737e47f6d372 100644
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -16,35 +16,54 @@
namespace Fortran::runtime {
+enum AssignFlags {
+ NoAssignFlags = 0,
+ MaybeReallocate = 1 << 0,
+ NeedFinalization = 1 << 1,
+ CanBeDefinedAssignment = 1 << 2,
+ ComponentCanBeDefinedAssignment = 1 << 3,
+ ExplicitLengthCharacterLHS = 1 << 4,
+ PolymorphicLHS = 1 << 5
+};
+
// Predicate: is the left-hand side of an assignment an allocated allocatable
// that must be deallocated?
static inline bool MustDeallocateLHS(
- Descriptor &to, const Descriptor &from, Terminator &terminator) {
+ Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
// Top-level assignments to allocatable variables (*not* components)
// may first deallocate existing content if there's about to be a
// change in type or shape; see F'2018 10.2.1.3(3).
+ if (!(flags & MaybeReallocate)) {
+ return false;
+ }
if (!to.IsAllocatable() || !to.IsAllocated()) {
return false;
}
if (to.type() != from.type()) {
return true;
}
- DescriptorAddendum *toAddendum{to.Addendum()};
- const typeInfo::DerivedType *toDerived{
- toAddendum ? toAddendum->derivedType() : nullptr};
- const DescriptorAddendum *fromAddendum{from.Addendum()};
- const typeInfo::DerivedType *fromDerived{
- fromAddendum ? fromAddendum->derivedType() : nullptr};
- if (toDerived != fromDerived) {
+ if (!(flags & ExplicitLengthCharacterLHS) && to.type().IsCharacter() &&
+ to.ElementBytes() != from.ElementBytes()) {
return true;
}
- if (toAddendum) {
- // Distinct LEN parameters? Deallocate
- std::size_t lenParms{fromDerived ? fromDerived->LenParameters() : 0};
- for (std::size_t j{0}; j < lenParms; ++j) {
- if (toAddendum->LenParameterValue(j) !=
- fromAddendum->LenParameterValue(j)) {
- return true;
+ if (flags & PolymorphicLHS) {
+ DescriptorAddendum *toAddendum{to.Addendum()};
+ const typeInfo::DerivedType *toDerived{
+ toAddendum ? toAddendum->derivedType() : nullptr};
+ const DescriptorAddendum *fromAddendum{from.Addendum()};
+ const typeInfo::DerivedType *fromDerived{
+ fromAddendum ? fromAddendum->derivedType() : nullptr};
+ if (toDerived != fromDerived) {
+ return true;
+ }
+ if (fromDerived) {
+ // Distinct LEN parameters? Deallocate
+ std::size_t lenParms{fromDerived->LenParameters()};
+ for (std::size_t j{0}; j < lenParms; ++j) {
+ if (toAddendum->LenParameterValue(j) !=
+ fromAddendum->LenParameterValue(j)) {
+ return true;
+ }
}
}
}
@@ -63,9 +82,11 @@ static inline bool MustDeallocateLHS(
// Utility: allocate the allocatable left-hand side, either because it was
// originally deallocated or because it required reallocation
static int AllocateAssignmentLHS(
- Descriptor &to, const Descriptor &from, Terminator &terminator) {
+ Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
to.raw().type = from.raw().type;
- to.raw().elem_len = from.ElementBytes();
+ if (!(flags & ExplicitLengthCharacterLHS)) {
+ to.raw().elem_len = from.ElementBytes();
+ }
const typeInfo::DerivedType *derived{nullptr};
if (const DescriptorAddendum * fromAddendum{from.Addendum()}) {
derived = fromAddendum->derivedType();
@@ -199,6 +220,23 @@ static void DoElementalDefinedAssignment(const Descriptor &to,
}
}
+template <typename CHAR>
+static void BlankPadCharacterAssignment(Descriptor &to, const Descriptor &from,
+ SubscriptValue toAt[], SubscriptValue fromAt[], std::size_t elements,
+ std::size_t toElementBytes, std::size_t fromElementBytes) {
+ std::size_t padding{(toElementBytes - fromElementBytes) / sizeof(CHAR)};
+ for (; elements-- > 0;
+ to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
+ CHAR *p{to.Element<CHAR>(toAt)};
+ std::memmove(
+ p, from.Element<std::add_const_t<CHAR>>(fromAt), fromElementBytes);
+ p += fromElementBytes;
+ for (auto n{padding}; n-- > 0;) {
+ *p++ = CHAR{' '};
+ }
+ }
+}
+
// Common implementation of assignments, both intrinsic assignments and
// those cases of polymorphic user-defined ASSIGNMENT(=) TBPs that could not
// be resolved in semantics. Most assignment statements do not need any
@@ -210,33 +248,39 @@ static void DoElementalDefinedAssignment(const Descriptor &to,
// of elements, but their shape need not to conform (the assignment is done in
// element sequence order). This facilitates some internal usages, like when
// dealing with array constructors.
-static void Assign(Descriptor &to, const Descriptor &from,
- Terminator &terminator, bool maybeReallocate, bool needFinalization,
- bool canBeDefinedAssignment, bool componentCanBeDefinedAssignment) {
- bool mustDeallocateLHS{
- maybeReallocate && MustDeallocateLHS(to, from, terminator)};
+static void Assign(
+ Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
+ bool mustDeallocateLHS{MustDeallocateLHS(to, from, terminator, flags)};
DescriptorAddendum *toAddendum{to.Addendum()};
const typeInfo::DerivedType *toDerived{
toAddendum ? toAddendum->derivedType() : nullptr};
- if (canBeDefinedAssignment && toDerived) {
- needFinalization &= !toDerived->noFinalizationNeeded();
- // Check for a user-defined assignment type-bound procedure;
- // see 10.2.1.4-5. A user-defined assignment TBP defines all of
- // the semantics, including allocatable (re)allocation and any
- // finalization.
- if (to.rank() == 0) {
+ if (toDerived) {
+ if (flags & CanBeDefinedAssignment) {
+ // Check for a user-defined assignment type-bound procedure;
+ // see 10.2.1.4-5. A user-defined assignment TBP defines all of
+ // the semantics, including allocatable (re)allocation and any
+ // finalization.
+ if (to.rank() == 0) {
+ if (const auto *special{toDerived->FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
+ return DoScalarDefinedAssignment(to, from, *special);
+ }
+ }
if (const auto *special{toDerived->FindSpecialBinding(
- typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
- return DoScalarDefinedAssignment(to, from, *special);
+ typeInfo::SpecialBinding::Which::ElementalAssignment)}) {
+ return DoElementalDefinedAssignment(to, from, *special);
}
}
- if (const auto *special{toDerived->FindSpecialBinding(
- typeInfo::SpecialBinding::Which::ElementalAssignment)}) {
- return DoElementalDefinedAssignment(to, from, *special);
+ if ((flags & NeedFinalization) && toDerived->noFinalizationNeeded()) {
+ flags &= ~NeedFinalization;
}
}
- bool isSimpleMemmove{!toDerived && to.rank() == from.rank() &&
- to.IsContiguous() && from.IsContiguous()};
+ std::size_t toElementBytes{to.ElementBytes()};
+ std::size_t fromElementBytes{from.ElementBytes()};
+ auto isSimpleMemmove{[&]() {
+ return !toDerived && to.rank() == from.rank() && to.IsContiguous() &&
+ from.IsContiguous() && toElementBytes == fromElementBytes;
+ }};
StaticDescriptor<maxRank, true, 10 /*?*/> deferredDeallocStatDesc;
Descriptor *deferDeallocation{nullptr};
if (MayAlias(to, from)) {
@@ -244,7 +288,7 @@ static void Assign(Descriptor &to, const Descriptor &from,
deferDeallocation = &deferredDeallocStatDesc.descriptor();
std::memcpy(deferDeallocation, &to, to.SizeInBytes());
to.set_base_addr(nullptr);
- } else if (!isSimpleMemmove) {
+ } else if (!isSimpleMemmove()) {
// Handle LHS/RHS aliasing by copying RHS into a temp, then
// recursively assigning from that temp.
auto descBytes{from.SizeInBytes()};
@@ -255,18 +299,20 @@ static void Assign(Descriptor &to, const Descriptor &from,
if (stat == StatOk) {
char *toAt{newFrom.OffsetElement()};
std::size_t fromElements{from.Elements()};
- std::size_t elementBytes{from.ElementBytes()};
if (from.IsContiguous()) {
- std::memcpy(toAt, from.OffsetElement(), fromElements * elementBytes);
+ std::memcpy(
+ toAt, from.OffsetElement(), fromElements * fromElementBytes);
} else {
SubscriptValue fromAt[maxRank];
for (from.GetLowerBounds(fromAt); fromElements-- > 0;
- toAt += elementBytes, from.IncrementSubscripts(fromAt)) {
- std::memcpy(toAt, from.Element<char>(fromAt), elementBytes);
+ toAt += fromElementBytes, from.IncrementSubscripts(fromAt)) {
+ std::memcpy(toAt, from.Element<char>(fromAt), fromElementBytes);
}
}
- Assign(to, newFrom, terminator, /*maybeReallocate=*/false,
- needFinalization, false, componentCanBeDefinedAssignment);
+ Assign(to, newFrom, terminator,
+ flags &
+ (NeedFinalization | ComponentCanBeDefinedAssignment |
+ ExplicitLengthCharacterLHS));
newFrom.Deallocate();
}
return;
@@ -275,24 +321,25 @@ static void Assign(Descriptor &to, const Descriptor &from,
if (to.IsAllocatable()) {
if (mustDeallocateLHS) {
if (deferDeallocation) {
- if (needFinalization && toDerived) {
+ if ((flags & NeedFinalization) && toDerived) {
Finalize(to, *toDerived);
- needFinalization = false;
+ flags &= ~NeedFinalization;
}
} else {
- to.Destroy(/*finalize=*/needFinalization);
- needFinalization = false;
+ to.Destroy((flags & NeedFinalization) != 0);
+ flags &= ~NeedFinalization;
}
- } else if (to.rank() != from.rank()) {
+ } else if (to.rank() != from.rank() && !to.IsAllocated()) {
terminator.Crash("Assign: mismatched ranks (%d != %d) in assignment to "
"unallocated allocatable",
to.rank(), from.rank());
}
if (!to.IsAllocated()) {
- if (AllocateAssignmentLHS(to, from, terminator) != StatOk) {
+ if (AllocateAssignmentLHS(to, from, terminator, flags) != StatOk) {
return;
}
- needFinalization = false;
+ flags &= ~NeedFinalization;
+ toElementBytes = to.ElementBytes(); // may have changed
}
}
SubscriptValue toAt[maxRank];
@@ -312,18 +359,17 @@ static void Assign(Descriptor &to, const Descriptor &from,
terminator.Crash("Assign: mismatching types (to code %d != from code %d)",
to.type().raw(), from.type().raw());
}
- std::size_t elementBytes{to.ElementBytes()};
- if (elementBytes != from.ElementBytes()) {
- terminator.Crash(
- "Assign: mismatching element sizes (to %zd bytes != from %zd bytes)",
- elementBytes, from.ElementBytes());
+ if (toElementBytes > fromElementBytes && !to.type().IsCharacter()) {
+ terminator.Crash("Assign: mismatching non-character element sizes (to %zd "
+ "bytes != from %zd bytes)",
+ toElementBytes, fromElementBytes);
}
if (const typeInfo::DerivedType *
updatedToDerived{toAddendum ? toAddendum->derivedType() : nullptr}) {
// Derived type intrinsic assignment, which is componentwise and elementwise
// for all components, including parent components (10.2.1.2-3).
// The target is first finalized if still necessary (7.5.6.3(1))
- if (needFinalization) {
+ if (flags & NeedFinalization) {
Finalize(to, *updatedToDerived);
}
// Copy the data components (incl. the parent) first.
@@ -333,6 +379,16 @@ static void Assign(Descriptor &to, const Descriptor &from,
const auto &comp{
*componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(
k)}; // TODO: exploit contiguity here
+ // Use PolymorphicLHS for components so that the right things happen
+ // when the components are polymorphic; when they're not, they're both
+ // not, and their declared types will match.
+ int nestedFlags{MaybeReallocate | PolymorphicLHS};
+ if (comp.genre() != typeInfo::Component::Genre::Allocatable &&
+ (flags & ComponentCanBeDefinedAssignment)) {
+ // Allocatable components are assigned via intrinsic assignment,
+ // not defined assignment (see F'2018 10.2.1.3 paragraph 13).
+ nestedFlags |= CanBeDefinedAssignment | ComponentCanBeDefinedAssignment;
+ }
switch (comp.genre()) {
case typeInfo::Component::Genre::Data:
if (comp.category() == TypeCategory::Derived) {
@@ -344,10 +400,7 @@ static void Assign(Descriptor &to, const Descriptor &from,
comp.CreatePointerDescriptor(toCompDesc, to, terminator, toAt);
comp.CreatePointerDescriptor(
fromCompDesc, from, terminator, fromAt);
- Assign(toCompDesc, fromCompDesc, terminator,
- /*maybeReallocate=*/true,
- /*needFinalization=*/false, componentCanBeDefinedAssignment,
- componentCanBeDefinedAssignment);
+ Assign(toCompDesc, fromCompDesc, terminator, nestedFlags);
}
} else { // Component has intrinsic type; simply copy raw bytes
std::size_t componentByteSize{comp.SizeInBytes(to)};
@@ -392,9 +445,7 @@ static void Assign(Descriptor &to, const Descriptor &from,
continue; // F'2018 10.2.1.3(13)(2)
}
}
- Assign(*toDesc, *fromDesc, terminator, /*maybeReallocate=*/true,
- /*needFinalization=*/false, componentCanBeDefinedAssignment,
- componentCanBeDefinedAssignment);
+ Assign(*toDesc, *fromDesc, terminator, nestedFlags);
}
break;
}
@@ -413,14 +464,33 @@ static void Assign(Descriptor &to, const Descriptor &from,
}
}
} else { // intrinsic type, intrinsic assignment
- if (isSimpleMemmove) {
- std::memmove(
- to.raw().base_addr, from.raw().base_addr, toElements * elementBytes);
- } else { // elemental copies
+ if (isSimpleMemmove()) {
+ std::memmove(to.raw().base_addr, from.raw().base_addr,
+ toElements * toElementBytes);
+ } else if (toElementBytes > fromElementBytes) { // blank padding
+ switch (to.type().raw()) {
+ case CFI_type_signed_char:
+ case CFI_type_char:
+ BlankPadCharacterAssignment<char>(to, from, toAt, fromAt, toElements,
+ toElementBytes, fromElementBytes);
+ break;
+ case CFI_type_char16_t:
+ BlankPadCharacterAssignment<char16_t>(to, from, toAt, fromAt,
+ toElements, toElementBytes, fromElementBytes);
+ break;
+ case CFI_type_char32_t:
+ BlankPadCharacterAssignment<char32_t>(to, from, toAt, fromAt,
+ toElements, toElementBytes, fromElementBytes);
+ break;
+ default:
+ terminator.Crash("unexpected type code %d in blank padded Assign()",
+ to.type().raw());
+ }
+ } else { // elemental copies, possibly with character truncation
for (std::size_t n{toElements}; n-- > 0;
to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
std::memmove(to.Element<char>(toAt), from.Element<const char>(fromAt),
- elementBytes);
+ toElementBytes);
}
}
}
@@ -443,8 +513,7 @@ void DoFromSourceAssign(
alloc.IncrementSubscripts(allocAt)) {
Descriptor allocElement{*Descriptor::Create(*allocDerived,
reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0)};
- Assign(allocElement, source, terminator, /*maybeReallocate=*/false,
- /*needFinalization=*/false, false, false);
+ Assign(allocElement, source, terminator, NoAssignFlags);
}
} else { // intrinsic type
for (std::size_t n{alloc.Elements()}; n-- > 0;
@@ -454,8 +523,7 @@ void DoFromSourceAssign(
}
}
} else {
- Assign(alloc, source, terminator, /*maybeReallocate=*/false,
- /*needFinalization=*/false, false, false);
+ Assign(alloc, source, terminator, NoAssignFlags);
}
}
@@ -466,20 +534,30 @@ void RTNAME(Assign)(Descriptor &to, const Descriptor &from,
// All top-level defined assignments can be recognized in semantics and
// will have been already been converted to calls, so don't check for
// defined assignment apart from components.
- Assign(to, from, terminator, /*maybeReallocate=*/true,
- /*needFinalization=*/true,
- /*canBeDefinedAssignment=*/false,
- /*componentCanBeDefinedAssignment=*/true);
+ Assign(to, from, terminator,
+ MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment);
}
void RTNAME(AssignTemporary)(Descriptor &to, const Descriptor &from,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
- Assign(to, from, terminator, /*maybeReallocate=*/false,
- /*needFinalization=*/false,
- /*canBeDefinedAssignment=*/false,
- /*componentCanBeDefinedAssignment=*/false);
+ Assign(to, from, terminator, PolymorphicLHS);
+}
+
+void RTNAME(AssignExplicitLengthCharacter)(Descriptor &to,
+ const Descriptor &from, const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ Assign(to, from, terminator,
+ MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment |
+ ExplicitLengthCharacterLHS);
}
+void RTNAME(AssignPolymorphic)(Descriptor &to, const Descriptor &from,
+ const char *sourceFile, int sourceLine) {
+ Terminator terminator{sourceFile, sourceLine};
+ Assign(to, from, terminator,
+ MaybeReallocate | NeedFinalization | ComponentCanBeDefinedAssignment |
+ PolymorphicLHS);
+}
} // extern "C"
} // namespace Fortran::runtime
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
index 0b8efd58695f8..d01e5c473d012 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -78,7 +78,7 @@ class Component {
std::size_t GetElementByteSize(const Descriptor &) const;
std::size_t GetElements(const Descriptor &) const;
- // For ocmponents that are descriptors, returns size of descriptor;
+ // For components that are descriptors, returns size of descriptor;
// for Genre::Data, returns elemental byte size times element count.
std::size_t SizeInBytes(const Descriptor &) const;
More information about the flang-commits
mailing list