[flang-commits] [flang] 6e4984a - [flang][hlfir] Enable assignments with allocatable components.
Slava Zakharin via flang-commits
flang-commits at lists.llvm.org
Tue Jun 6 20:25:20 PDT 2023
Author: Slava Zakharin
Date: 2023-06-06T20:25:07-07:00
New Revision: 6e4984a9d5f34f68f29779b07fff580639bd2f73
URL: https://github.com/llvm/llvm-project/commit/6e4984a9d5f34f68f29779b07fff580639bd2f73
DIFF: https://github.com/llvm/llvm-project/commit/6e4984a9d5f34f68f29779b07fff580639bd2f73.diff
LOG: [flang][hlfir] Enable assignments with allocatable components.
The TODO was left there to verify that Assign() runtime handles
overlaps of allocatable components. It did not, and this change-set
fixes it. Note that the same Assign() issue can be reproduced
without HLFIR. In the following example the LHS would be reallocated
before value of RHS (essentially, the same memory) is read:
```
program main
type t1
integer, allocatable :: a(:)
end type t1
type(t1) :: x, y
allocate(x%a(10))
do i =1,10
x%a(i) = 2*i
end do
x = x
print *, x%a
deallocate(x%a)
end program main
```
The test's output would be incorrect (though, this depends on the memory
reuse by malloc):
0 0 0 0 10 12 14 16 18 20
It is very hard to add a Flang unittest exploiting derived types.
Reviewed By: klausler
Differential Revision: https://reviews.llvm.org/D152306
Added:
Modified:
flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
flang/runtime/assign.cpp
flang/test/HLFIR/assign-codegen.fir
Removed:
################################################################################
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
index 22ad5371543c9..4cb5cd6fdbf4c 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
@@ -140,14 +140,10 @@ class AssignOpConversion : public mlir::OpRewritePattern<hlfir::AssignOp> {
builder.create<fir::StoreOp>(loc, to, toMutableBox);
fir::runtime::genAssign(builder, loc, toMutableBox, from);
} else {
- // Assume overlap does not matter for scalar (dealt with memmove for
- // characters).
- // This is not true if this is a derived type with "recursive" allocatable
- // components, in which case an overlap would matter because the LHS
- // reallocation, if any, may modify the RHS component value before it is
- // copied into the LHS.
- if (fir::isRecordWithAllocatableMember(lhs.getFortranElementType()))
- TODO(loc, "assignment with allocatable components");
+ // genScalarAssignment() must take care of potential overlap
+ // between LHS and RHS. Note that the overlap is possible
+ // also for components of LHS/RHS, and the Assign() runtime
+ // must take care of it.
fir::factory::genScalarAssignment(builder, loc, lhsExv, rhsExv);
}
rewriter.eraseOp(assignOp);
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 49e86c20b17cc..80ad97c4e6da0 100644
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -23,7 +23,8 @@ enum AssignFlags {
CanBeDefinedAssignment = 1 << 2,
ComponentCanBeDefinedAssignment = 1 << 3,
ExplicitLengthCharacterLHS = 1 << 4,
- PolymorphicLHS = 1 << 5
+ PolymorphicLHS = 1 << 5,
+ DeallocateLHS = 1 << 6
};
// Predicate: is the left-hand side of an assignment an allocated allocatable
@@ -249,30 +250,14 @@ static void BlankPadCharacterAssignment(Descriptor &to, const Descriptor &from,
// dealing with array constructors.
static void Assign(
Descriptor &to, const Descriptor &from, Terminator &terminator, int flags) {
- bool mustDeallocateLHS{MustDeallocateLHS(to, from, terminator, flags)};
+ bool mustDeallocateLHS{(flags & DeallocateLHS) ||
+ MustDeallocateLHS(to, from, terminator, flags)};
DescriptorAddendum *toAddendum{to.Addendum()};
const typeInfo::DerivedType *toDerived{
toAddendum ? toAddendum->derivedType() : nullptr};
- 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::ElementalAssignment)}) {
- return DoElementalDefinedAssignment(to, from, *toDerived, *special);
- }
- }
- if ((flags & NeedFinalization) && toDerived->noFinalizationNeeded()) {
- flags &= ~NeedFinalization;
- }
+ if (toDerived && (flags & NeedFinalization) &&
+ toDerived->noFinalizationNeeded()) {
+ flags &= ~NeedFinalization;
}
std::size_t toElementBytes{to.ElementBytes()};
std::size_t fromElementBytes{from.ElementBytes()};
@@ -315,7 +300,7 @@ static void Assign(
Assign(to, newFrom, terminator,
flags &
(NeedFinalization | ComponentCanBeDefinedAssignment |
- ExplicitLengthCharacterLHS));
+ ExplicitLengthCharacterLHS | CanBeDefinedAssignment));
newFrom.Deallocate();
}
return;
@@ -345,6 +330,27 @@ static void Assign(
toElementBytes = to.ElementBytes(); // may have changed
}
}
+ if (toDerived && (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.
+ //
+ // Note that the aliasing and LHS (re)allocation handling above
+ // needs to run even with CanBeDefinedAssignment flag, when
+ // the Assign() is invoked recursively for component-per-component
+ // assignments.
+ 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::ElementalAssignment)}) {
+ return DoElementalDefinedAssignment(to, from, *toDerived, *special);
+ }
+ }
SubscriptValue toAt[maxRank];
to.GetLowerBounds(toAt);
// Scalar expansion of the RHS is implied by using the same empty
@@ -429,32 +435,31 @@ static void Assign(
to.Element<char>(toAt) + comp.offset())};
const auto *fromDesc{reinterpret_cast<const Descriptor *>(
from.Element<char>(fromAt) + comp.offset())};
+ // Allocatable components of the LHS are unconditionally
+ // deallocated before assignment (F'2018 10.2.1.3(13)(1)),
+ // unlike a "top-level" assignment to a variable, where
+ // deallocation is optional.
+ //
+ // Be careful not to destroy/reallocate the LHS, if there is
+ // overlap between LHS and RHS (it seems that partial overlap
+ // is not possible, though).
+ // Invoke Assign() recursively to deal with potential aliasing.
if (toDesc->IsAllocatable()) {
- if (toDesc->IsAllocated()) {
- // Allocatable components of the LHS are unconditionally
- // deallocated before assignment (F'2018 10.2.1.3(13)(1)),
- // unlike a "top-level" assignment to a variable, where
- // deallocation is optional.
- // TODO: Consider skipping this step and deferring the
- // deallocation to the recursive activation of Assign(),
- // which might be able to avoid deallocation/reallocation
- // when the existing allocation can be reoccupied.
- toDesc->Destroy(false /*already finalized*/);
- }
if (!fromDesc->IsAllocated()) {
+ // No aliasing.
+ //
+ // If to is not allocated, the Destroy() call is a no-op.
+ // This is just a shortcut, because the recursive Assign()
+ // below would initiate the destruction for to.
+ // No finalization is required.
+ toDesc->Destroy();
continue; // F'2018 10.2.1.3(13)(2)
}
-
- // F'2018 10.2.1.3(13) (2)
- // If from is allocated, allocate to with the same type.
- if (nestedFlags & CanBeDefinedAssignment) {
- if (AllocateAssignmentLHS(
- *toDesc, *fromDesc, terminator, nestedFlags) != StatOk) {
- return;
- }
- }
}
- Assign(*toDesc, *fromDesc, terminator, nestedFlags);
+ // Force LHS deallocation with DeallocateLHS flag.
+ // The actual deallocation may be avoided, if the existing
+ // location can be reoccupied.
+ Assign(*toDesc, *fromDesc, terminator, nestedFlags | DeallocateLHS);
}
break;
}
@@ -504,6 +509,8 @@ static void Assign(
}
}
if (deferDeallocation) {
+ // deferDeallocation is used only when LHS is an allocatable.
+ // The finalization has already been run for it.
deferDeallocation->Destroy();
}
}
diff --git a/flang/test/HLFIR/assign-codegen.fir b/flang/test/HLFIR/assign-codegen.fir
index 401d55bb53940..7d3b4d54b04cf 100644
--- a/flang/test/HLFIR/assign-codegen.fir
+++ b/flang/test/HLFIR/assign-codegen.fir
@@ -245,3 +245,25 @@ func.func @assign_i1_to_polymorphic(%arg0: !fir.ref<!fir.class<!fir.heap<none>>>
// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.logical<4>>) -> !fir.box<none>
// CHECK: %[[VAL_13:.*]] = fir.call @_FortranAAssignPolymorphic(%[[VAL_10]], %[[VAL_11]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
+func.func @test_allocatable_component(%arg0: !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> {fir.bindc_name = "x", fir.target}, %arg1: !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> {fir.bindc_name = "y", fir.target}) {
+ %4:2 = hlfir.declare %arg0 {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtestEx"} : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>)
+ %5:2 = hlfir.declare %arg1 {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtestEy"} : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>)
+ hlfir.assign %5#0 to %4#0 : !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+ return
+}
+// CHECK-LABEL: func.func @test_allocatable_component(
+// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> {fir.bindc_name = "x", fir.target},
+// CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> {fir.bindc_name = "y", fir.target}) {
+// CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+// CHECK: %[[VAL_3:.*]] = fir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtestEx"} : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+// CHECK: %[[VAL_4:.*]] = fir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtestEy"} : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+// CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_3]] : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+// CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_4]] : (!fir.ref<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>
+// CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>
+// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>) -> !fir.ref<!fir.box<none>>
+// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.type<_QFtestTt1{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<none>
+// CHECK: %[[VAL_12:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+// CHECK: %[[VAL_13:.*]] = fir.call @_FortranAAssign(%[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+// CHECK: return
+// CHECK: }
More information about the flang-commits
mailing list