Skip to content

Commit c329c4f

Browse files
jeanPerierjeanPerier
committed
Split allocatable assignment to avoid deallocation before RHS evaluation
The previous allocatable assignment lowering was both allocating the new storage and deallocating the old one/updating the allocatable before generating a normal assignment in the new storage. This is wrong in general because the previous allocatable value may be used in the assignment RHS, so the deallocation/allocatable update must be done after the assignment. This patch split genReallocIfNeeded in two parts: the first part that create a new storage if needed, to be called before lowering the assignment, and a second part that creates the deallocation/allocatable descriptor update after the assignment if a new storage was allocated. This fixes runtime error for allocatable assignments like `a = a(1:100)`.
1 parent b6cf384 commit c329c4f

File tree

6 files changed

+724
-348
lines changed

6 files changed

+724
-348
lines changed

‎flang/include/flang/Optimizer/Builder/BoxValue.h‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -467,6 +467,14 @@ inline bool isUnboxedValue(const ExtendedValue &exv) {
467467
[](const fir::UnboxedValue &box) { return box ? true : false; },
468468
[](const auto &) { return false; });
469469
}
470+
471+
/// Is the extended value `exv` a derived type with length parameters ?
472+
inline bool isDerivedWithLengthParameters(const ExtendedValue &exv) {
473+
auto type = fir::unwrapPassByRefType(fir::getBase(exv).getType());
474+
auto record = fir::unwrapSequenceType(type).dyn_cast<fir::RecordType>();
475+
return record && record.getNumLenParams() != 0;
476+
}
477+
470478
} // namespace fir
471479

472480
#endif // FORTRAN_OPTIMIZER_BUILDER_BOXVALUE_H

‎flang/include/flang/Optimizer/Builder/MutableBox.h‎

Lines changed: 18 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
#ifndef FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
1414
#define FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
1515

16+
#include "flang/Optimizer/Builder/BoxValue.h"
1617
#include "llvm/ADT/StringRef.h"
1718

1819
namespace mlir {
@@ -24,8 +25,6 @@ class Location;
2425

2526
namespace fir {
2627
class FirOpBuilder;
27-
class MutableBoxValue;
28-
class ExtendedValue;
2928
} // namespace fir
3029

3130
namespace fir::factory {
@@ -86,10 +85,23 @@ void disassociateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
8685
/// parameter mismatch can trigger a reallocation. See Fortran 10.2.1.3 point 3
8786
/// that this function is implementing for more details. The polymorphic
8887
/// requirements are not yet covered by this function.
89-
void genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc,
90-
const fir::MutableBoxValue &box,
91-
mlir::ValueRange lbounds, mlir::ValueRange shape,
92-
mlir::ValueRange lengthParams);
88+
struct MutableBoxReallocation {
89+
fir::ExtendedValue newValue;
90+
mlir::Value oldAddress;
91+
mlir::Value wasReallocated;
92+
mlir::Value oldAddressWasAllocated;
93+
};
94+
95+
MutableBoxReallocation genReallocIfNeeded(fir::FirOpBuilder &builder,
96+
mlir::Location loc,
97+
const fir::MutableBoxValue &box,
98+
mlir::ValueRange shape,
99+
mlir::ValueRange lengthParams);
100+
101+
void finalizeRealloc(fir::FirOpBuilder &builder, mlir::Location loc,
102+
const fir::MutableBoxValue &box, mlir::ValueRange lbounds,
103+
bool takeLboundsIfRealloc,
104+
const MutableBoxReallocation &realloc);
93105

94106
/// Finalize a mutable box if it is allocated or associated. This includes both
95107
/// calling the finalizer, if any, and deallocating the storage.

‎flang/lib/Lower/Bridge.cpp‎

Lines changed: 28 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1942,26 +1942,25 @@ class FirConverter : public Fortran::lower::AbstractConverter {
19421942
isNumericScalarCategory(lhsType->category());
19431943
auto rhs = isNumericScalar ? genExprValue(assign.rhs, stmtCtx)
19441944
: genExprAddr(assign.rhs, stmtCtx);
1945-
auto lowerAllocatableLHS = [&]() -> fir::ExtendedValue {
1946-
auto lhs = genExprMutableBox(loc, assign.lhs);
1947-
llvm::SmallVector<mlir::Value> lengthParams;
1948-
if (auto *charBox = rhs.getCharBox())
1949-
lengthParams.push_back(charBox->getLen());
1950-
else if (lhs.isDerivedWithLengthParameters())
1951-
TODO(loc, "assignment to derived type allocatable with "
1952-
"length parameters");
1953-
fir::factory::genReallocIfNeeded(
1954-
*builder, loc, lhs, /*lbounds=*/llvm::None,
1955-
/*shape=*/llvm::None, lengthParams);
1956-
// Assume lhs is not polymorphic for now given TODO above,
1957-
// otherwise, the read would is conservative and returns
1958-
// BoxValue for derived types.
1959-
return fir::factory::genMutableBoxRead(
1960-
*builder, loc, lhs, /*mayBePolymorphic=*/false);
1961-
};
1962-
auto lhs = isWholeAllocatable(assign.lhs)
1963-
? lowerAllocatableLHS()
1964-
: genExprAddr(assign.lhs, stmtCtx);
1945+
bool lhsIsWholeAllocatable = isWholeAllocatable(assign.lhs);
1946+
llvm::Optional<fir::factory::MutableBoxReallocation> lhsRealloc;
1947+
llvm::Optional<fir::MutableBoxValue> lhsMutableBox;
1948+
auto lhs = [&]() -> fir::ExtendedValue {
1949+
if (lhsIsWholeAllocatable) {
1950+
lhsMutableBox = genExprMutableBox(loc, assign.lhs);
1951+
llvm::SmallVector<mlir::Value> lengthParams;
1952+
if (auto *charBox = rhs.getCharBox())
1953+
lengthParams.push_back(charBox->getLen());
1954+
else if (fir::isDerivedWithLengthParameters(rhs))
1955+
TODO(loc, "assignment to derived type allocatable with "
1956+
"length parameters");
1957+
lhsRealloc = fir::factory::genReallocIfNeeded(
1958+
*builder, loc, *lhsMutableBox,
1959+
/*shape=*/llvm::None, lengthParams);
1960+
return lhsRealloc->newValue;
1961+
}
1962+
return genExprAddr(assign.lhs, stmtCtx);
1963+
}();
19651964

19661965
if (isNumericScalar) {
19671966
// Fortran 2018 10.2.1.3 p8 and p9
@@ -1983,21 +1982,22 @@ class FirConverter : public Fortran::lower::AbstractConverter {
19831982
toLocation(), builder->getRefType(toTy), addr);
19841983
}
19851984
builder->create<fir::StoreOp>(loc, cast, addr);
1986-
return;
1987-
}
1988-
if (isCharacterCategory(lhsType->category())) {
1985+
} else if (isCharacterCategory(lhsType->category())) {
19891986
// Fortran 2018 10.2.1.3 p10 and p11
19901987
fir::factory::CharacterExprHelper{*builder, loc}.createAssign(
19911988
lhs, rhs);
1992-
return;
1993-
}
1994-
if (isDerivedCategory(lhsType->category())) {
1989+
} else if (isDerivedCategory(lhsType->category())) {
19951990
// Fortran 2018 10.2.1.3 p13 and p14
19961991
// Recursively gen an assignment on each element pair.
19971992
fir::factory::genRecordAssignment(*builder, loc, lhs, rhs);
1998-
return;
1993+
} else {
1994+
llvm_unreachable("unknown category");
19991995
}
2000-
llvm_unreachable("unknown category");
1996+
if (lhsIsWholeAllocatable)
1997+
fir::factory::finalizeRealloc(
1998+
*builder, loc, lhsMutableBox.getValue(),
1999+
/*lbounds=*/llvm::None, /*takeLboundsIfRealloc=*/false,
2000+
lhsRealloc.getValue());
20012001
},
20022002

20032003
// [2] User defined assignment. If the context is a scalar

‎flang/lib/Lower/ConvertExpr.cpp‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2741,12 +2741,11 @@ class ArrayExprLowering {
27412741
auto lbs = fir::factory::getOrigins(arrayOperands[0].shape);
27422742
lbounds.append(lbs.begin(), lbs.end());
27432743
}
2744-
fir::factory::genReallocIfNeeded(builder, loc, mutableBox, lbounds,
2745-
destShape, lengthParams);
2744+
auto realloc = fir::factory::genReallocIfNeeded(builder, loc, mutableBox,
2745+
destShape, lengthParams);
27462746
// Create ArrayLoad for the mutable box and save it into `destination`.
27472747
PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut);
2748-
ccStoreToDest =
2749-
genarr(fir::factory::genMutableBoxRead(builder, loc, mutableBox));
2748+
ccStoreToDest = genarr(realloc.newValue);
27502749
// If the rhs is scalar, get shape from the allocatable ArrayLoad.
27512750
if (destShape.empty())
27522751
destShape = getShape(destination);
@@ -2761,6 +2760,8 @@ class ArrayExprLowering {
27612760
loc, destination, fir::getBase(exv), destination.memref(),
27622761
destination.slice(), destination.typeparams());
27632762
}
2763+
fir::factory::finalizeRealloc(builder, loc, mutableBox, lbounds,
2764+
takeLboundsIfRealloc, realloc);
27642765
}
27652766

27662767
/// Entry point for when an array expression appears in a context where the

0 commit comments

Comments
 (0)