Skip to content

Commit

Permalink
[flang][hlfir] Enable assignments with allocatable components.
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@vzakhari
vzakhari committed Jun 7, 2023
1 parent a4bf2be commit 6e4984a
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 52 deletions.
12 changes: 4 additions & 8 deletions flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
95 changes: 51 additions & 44 deletions flang/runtime/assign.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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()};
Expand Down Expand Up @@ -315,7 +300,7 @@ static void Assign(
Assign(to, newFrom, terminator,
flags &
(NeedFinalization | ComponentCanBeDefinedAssignment |
ExplicitLengthCharacterLHS));
ExplicitLengthCharacterLHS | CanBeDefinedAssignment));
newFrom.Deallocate();
}
return;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
}
Expand Down Expand Up @@ -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();
}
}
Expand Down
22 changes: 22 additions & 0 deletions flang/test/HLFIR/assign-codegen.fir
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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: }

0 comments on commit 6e4984a

Please sign in to comment.