Skip to content

Commit 880b37f

Browse files
clementvalclementval
committed
[flang] Handle pointer assignment with polymorphic entities
This patch forces pointer and allocatable polymorphic entities to be tracked as descriptor. It also enables the pointer assignment between polymorphic entities. Pointer association between a non-polymorphic pointer and a polyrmophic target might require some more work as per 10.2.2.3 point 1. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D137150
1 parent 9472a81 commit 880b37f

File tree

7 files changed

+257
-93
lines changed

7 files changed

+257
-93
lines changed

‎flang/lib/Lower/Allocatable.cpp

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -621,6 +621,19 @@ isNonContiguousArrayPointer(const Fortran::semantics::Symbol &sym) {
621621
!sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS);
622622
}
623623

624+
/// Is this symbol a polymorphic pointer?
625+
static inline bool isPolymorphicPointer(const Fortran::semantics::Symbol &sym) {
626+
return Fortran::semantics::IsPointer(sym) &&
627+
Fortran::semantics::IsPolymorphic(sym);
628+
}
629+
630+
/// Is this symbol a polymorphic allocatable?
631+
static inline bool
632+
isPolymorphicAllocatable(const Fortran::semantics::Symbol &sym) {
633+
return Fortran::semantics::IsAllocatable(sym) &&
634+
Fortran::semantics::IsPolymorphic(sym);
635+
}
636+
624637
/// Is this a local procedure symbol in a procedure that contains internal
625638
/// procedures ?
626639
static bool mayBeCapturedInInternalProc(const Fortran::semantics::Symbol &sym) {
@@ -665,7 +678,8 @@ createMutableProperties(Fortran::lower::AbstractConverter &converter,
665678
Fortran::semantics::IsFunctionResult(sym) ||
666679
sym.attrs().test(Fortran::semantics::Attr::VOLATILE) ||
667680
isNonContiguousArrayPointer(sym) || useAllocateRuntime ||
668-
useDescForMutableBox || mayBeCapturedInInternalProc(sym))
681+
useDescForMutableBox || mayBeCapturedInInternalProc(sym) ||
682+
isPolymorphicPointer(sym) || isPolymorphicAllocatable(sym))
669683
return {};
670684
fir::MutableProperties mutableProperties;
671685
std::string name = converter.mangleName(sym);
@@ -754,6 +768,7 @@ void Fortran::lower::associateMutableBox(
754768
fir::ExtendedValue rhs = isArraySectionWithoutVectorSubscript(source)
755769
? converter.genExprBox(loc, source, stmtCtx)
756770
: converter.genExprAddr(loc, source, stmtCtx);
771+
757772
fir::factory::associateMutableBox(builder, loc, box, rhs, lbounds);
758773
}
759774

‎flang/lib/Lower/Bridge.cpp

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2442,9 +2442,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
24422442
std::optional<Fortran::evaluate::DynamicType> rhsType =
24432443
assign.rhs.GetType();
24442444
// Polymorphic lhs/rhs may need more care. See F2018 10.2.2.3.
2445-
if ((lhsType && lhsType->IsPolymorphic()) ||
2445+
// If the pointer object is not polymorphic (7.3.2.3) and the
2446+
// pointer target is polymorphic with dynamic type that differs
2447+
// from its declared type, the assignment target is the ancestor
2448+
// component of the pointer target that has the type of the
2449+
// pointer object. Otherwise, the assignment target is the pointer
2450+
// target.
2451+
if ((lhsType && !lhsType->IsPolymorphic()) &&
24462452
(rhsType && rhsType->IsPolymorphic()))
2447-
TODO(loc, "pointer assignment involving polymorphic entity");
2453+
TODO(loc, "non-polymorphic pointer assignment with polymorphic "
2454+
"entity on rhs");
24482455

24492456
llvm::SmallVector<mlir::Value> lbounds;
24502457
for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)

‎flang/lib/Lower/ConvertExpr.cpp

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3747,7 +3747,7 @@ class ArrayExprLowering {
37473747
[&](const auto &e) {
37483748
auto f = genarr(e);
37493749
ExtValue exv = f(IterationSpace{});
3750-
if (fir::getBase(exv).getType().template isa<fir::BoxType>())
3750+
if (fir::getBase(exv).getType().template isa<fir::BaseBoxType>())
37513751
return exv;
37523752
fir::emitFatalError(getLoc(), "array must be emboxed");
37533753
},
@@ -5912,7 +5912,9 @@ class ArrayExprLowering {
59125912
// This case just requires that an embox operation be created to box the
59135913
// value. The value of the box is forwarded in the continuation.
59145914
mlir::Type reduceTy = reduceRank(arrTy, slice);
5915-
auto boxTy = fir::BoxType::get(reduceTy);
5915+
mlir::Type boxTy = fir::BoxType::get(reduceTy);
5916+
if (memref.getType().isa<fir::ClassType>())
5917+
boxTy = fir::ClassType::get(reduceTy);
59165918
if (components.substring) {
59175919
// Adjust char length to substring size.
59185920
fir::CharacterType charTy =
@@ -5925,7 +5927,7 @@ class ArrayExprLowering {
59255927
seqTy.getDimension()));
59265928
}
59275929
mlir::Value embox =
5928-
memref.getType().isa<fir::BoxType>()
5930+
memref.getType().isa<fir::BaseBoxType>()
59295931
? builder.create<fir::ReboxOp>(loc, boxTy, memref, shape, slice)
59305932
.getResult()
59315933
: builder

‎flang/lib/Optimizer/Builder/MutableBox.cpp

Lines changed: 18 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -22,12 +22,11 @@
2222

2323
/// Create a fir.box describing the new address, bounds, and length parameters
2424
/// for a MutableBox \p box.
25-
static mlir::Value createNewFirBox(fir::FirOpBuilder &builder,
26-
mlir::Location loc,
27-
const fir::MutableBoxValue &box,
28-
mlir::Value addr, mlir::ValueRange lbounds,
29-
mlir::ValueRange extents,
30-
mlir::ValueRange lengths) {
25+
static mlir::Value
26+
createNewFirBox(fir::FirOpBuilder &builder, mlir::Location loc,
27+
const fir::MutableBoxValue &box, mlir::Value addr,
28+
mlir::ValueRange lbounds, mlir::ValueRange extents,
29+
mlir::ValueRange lengths, mlir::Value tdesc = {}) {
3130
if (addr.getType().isa<fir::BaseBoxType>())
3231
// The entity is already boxed.
3332
return builder.createConvert(loc, box.getBoxTy(), addr);
@@ -72,7 +71,7 @@ static mlir::Value createNewFirBox(fir::FirOpBuilder &builder,
7271
}
7372
mlir::Value emptySlice;
7473
return builder.create<fir::EmboxOp>(loc, box.getBoxTy(), cleanedAddr, shape,
75-
emptySlice, cleanedLengths);
74+
emptySlice, cleanedLengths, tdesc);
7675
}
7776

7877
//===----------------------------------------------------------------------===//
@@ -201,11 +200,12 @@ class MutablePropertyWriter {
201200
/// Length parameters must be provided for the length parameters that are
202201
/// deferred.
203202
void updateMutableBox(mlir::Value addr, mlir::ValueRange lbounds,
204-
mlir::ValueRange extents, mlir::ValueRange lengths) {
203+
mlir::ValueRange extents, mlir::ValueRange lengths,
204+
mlir::Value tdesc = {}) {
205205
if (box.isDescribedByVariables())
206206
updateMutableProperties(addr, lbounds, extents, lengths);
207207
else
208-
updateIRBox(addr, lbounds, extents, lengths);
208+
updateIRBox(addr, lbounds, extents, lengths, tdesc);
209209
}
210210

211211
/// Update MutableBoxValue with a new fir.box. This requires that the mutable
@@ -267,9 +267,10 @@ class MutablePropertyWriter {
267267
private:
268268
/// Update the IR box (fir.ref<fir.box<T>>) of the MutableBoxValue.
269269
void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds,
270-
mlir::ValueRange extents, mlir::ValueRange lengths) {
271-
mlir::Value irBox =
272-
createNewFirBox(builder, loc, box, addr, lbounds, extents, lengths);
270+
mlir::ValueRange extents, mlir::ValueRange lengths,
271+
mlir::Value tdesc = {}) {
272+
mlir::Value irBox = createNewFirBox(builder, loc, box, addr, lbounds,
273+
extents, lengths, tdesc);
273274
builder.create<fir::StoreOp>(loc, irBox, box.getAddr());
274275
}
275276

@@ -477,8 +478,12 @@ void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,
477478
MutablePropertyWriter writer(builder, loc, box);
478479
source.match(
479480
[&](const fir::PolymorphicValue &p) {
481+
mlir::Value tdesc;
482+
if (auto polyBox = source.getBoxOf<fir::PolymorphicValue>())
483+
tdesc = polyBox->getTdesc();
480484
writer.updateMutableBox(p.getAddr(), /*lbounds=*/llvm::None,
481-
/*extents=*/llvm::None, /*lengths=*/llvm::None);
485+
/*extents=*/llvm::None, /*lengths=*/llvm::None,
486+
tdesc);
482487
},
483488
[&](const fir::UnboxedValue &addr) {
484489
writer.updateMutableBox(addr, /*lbounds=*/llvm::None,

0 commit comments

Comments
 (0)