[flang] Avoid double finalization when intrinsic assignment is done in the runtime
genRecordAssignment is emitting code to call Assign in the runtime for some cases.
In these cases, the finalization is done by the runtime so we do not need to do it in
a separate cal to avoid multiple finalization..
Also refactor the code in Bridge so the actual finalization of allocatable
is done before any reallocation. We might need to push this into ReallocIfNeeded.
It is not clear if the allocatable lhs needs to be finalized in any cases or only if it is
reallocated.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D143186
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index aa844e5..5785539 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2813,33 +2813,32 @@
std::optional<fir::factory::MutableBoxReallocation> lhsRealloc;
std::optional<fir::MutableBoxValue> lhsMutableBox;
- // Finalize LHS on intrinsic assignment.
- if (lhsType->IsPolymorphic() ||
- lhsType->IsUnlimitedPolymorphic() ||
- (isDerivedCategory(lhsType->category()) &&
- Fortran::semantics::IsFinalizable(
- lhsType->GetDerivedTypeSpec()))) {
- if (lhsIsWholeAllocatable) {
- lhsMutableBox = genExprMutableBox(loc, assign.lhs);
- mlir::Value isAllocated =
- fir::factory::genIsAllocatedOrAssociatedTest(
- *builder, loc, *lhsMutableBox);
- builder->genIfThen(loc, isAllocated)
- .genThen([&]() {
- fir::runtime::genDerivedTypeDestroy(
- *builder, loc, fir::getBase(*lhsMutableBox));
- })
- .end();
- } else {
- fir::ExtendedValue exv = genExprBox(loc, assign.lhs, stmtCtx);
- fir::runtime::genDerivedTypeDestroy(*builder, loc,
- fir::getBase(exv));
- }
- }
+ // Set flag to know if the LHS needs finalization. Polymorphic,
+ // unlimited polymorphic assignment will be done with genAssign.
+ // Assign runtime function performs the finalization.
+ bool needFinalization = !lhsType->IsPolymorphic() &&
+ !lhsType->IsUnlimitedPolymorphic() &&
+ (isDerivedCategory(lhsType->category()) &&
+ Fortran::semantics::IsFinalizable(
+ lhsType->GetDerivedTypeSpec()));
auto lhs = [&]() -> fir::ExtendedValue {
if (lhsIsWholeAllocatable) {
lhsMutableBox = genExprMutableBox(loc, assign.lhs);
+ // Finalize if needed.
+ if (needFinalization) {
+ mlir::Value isAllocated =
+ fir::factory::genIsAllocatedOrAssociatedTest(
+ *builder, loc, *lhsMutableBox);
+ builder->genIfThen(loc, isAllocated)
+ .genThen([&]() {
+ fir::runtime::genDerivedTypeDestroy(
+ *builder, loc, fir::getBase(*lhsMutableBox));
+ })
+ .end();
+ needFinalization = false;
+ }
+
llvm::SmallVector<mlir::Value> lengthParams;
if (const fir::CharBoxValue *charBox = rhs.getCharBox())
lengthParams.push_back(charBox->getLen());
@@ -2882,7 +2881,8 @@
} else if (isDerivedCategory(lhsType->category())) {
// Fortran 2018 10.2.1.3 p13 and p14
// Recursively gen an assignment on each element pair.
- fir::factory::genRecordAssignment(*builder, loc, lhs, rhs);
+ fir::factory::genRecordAssignment(*builder, loc, lhs, rhs,
+ needFinalization);
} else {
llvm_unreachable("unknown category");
}
