Skip to content

Commit 4dd0093

Browse files
klauslerklausler
committed
[flang][runtime] Preserve type on assignment to monomorphic pointers
Pointer associations unconditionally update the element byte size and derived type of the pointer's descriptor. This is okay when the pointer is polymorphic, but not when a pointer is associated with an extended type. To communicate this monomorphic case to the runtime, add new entry points, so as to not break forward binary compatibility. Fixes #149353.
1 parent 3de11b7 commit 4dd0093

File tree

9 files changed

+86
-28
lines changed

9 files changed

+86
-28
lines changed

‎flang-rt/include/flang-rt/runtime/descriptor.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -478,7 +478,8 @@ class Descriptor {
478478
const SubscriptValue *upper = nullptr,
479479
const SubscriptValue *stride = nullptr);
480480

481-
RT_API_ATTRS void ApplyMold(const Descriptor &, int rank);
481+
RT_API_ATTRS void ApplyMold(
482+
const Descriptor &, int rank, bool isMonomorphic = false);
482483

483484
RT_API_ATTRS void Check() const;
484485

‎flang-rt/lib/runtime/descriptor.cpp

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -252,18 +252,21 @@ RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
252252
return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
253253
}
254254

255-
RT_API_ATTRS void Descriptor::ApplyMold(const Descriptor &mold, int rank) {
256-
raw_.elem_len = mold.raw_.elem_len;
255+
RT_API_ATTRS void Descriptor::ApplyMold(
256+
const Descriptor &mold, int rank, bool isMonomorphic) {
257257
raw_.rank = rank;
258-
raw_.type = mold.raw_.type;
259258
for (int j{0}; j < rank && j < mold.raw_.rank; ++j) {
260259
GetDimension(j) = mold.GetDimension(j);
261260
}
262-
if (auto *addendum{Addendum()}) {
263-
if (auto *moldAddendum{mold.Addendum()}) {
264-
*addendum = *moldAddendum;
265-
} else {
266-
INTERNAL_CHECK(!addendum->derivedType());
261+
if (!isMonomorphic) {
262+
raw_.elem_len = mold.raw_.elem_len;
263+
raw_.type = mold.raw_.type;
264+
if (auto *addendum{Addendum()}) {
265+
if (auto *moldAddendum{mold.Addendum()}) {
266+
*addendum = *moldAddendum;
267+
} else {
268+
INTERNAL_CHECK(!addendum->derivedType());
269+
}
267270
}
268271
}
269272
}

‎flang-rt/lib/runtime/pointer.cpp

Lines changed: 30 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,20 @@ void RTDEF(PointerAssociate)(Descriptor &pointer, const Descriptor &target) {
7171
pointer.raw().attribute = CFI_attribute_pointer;
7272
}
7373

74+
void RTDEF(PointerAssociateMonomorphic)(
75+
Descriptor &pointer, const Descriptor &target) {
76+
DescriptorAddendum *addendum{pointer.Addendum()};
77+
const typeInfo::DerivedType *derived{
78+
addendum ? addendum->derivedType() : nullptr};
79+
std::size_t elementBytes{pointer.ElementBytes()};
80+
RTNAME(PointerAssociate)(pointer, target);
81+
// Restore the original type information for a monomophic pointer
82+
if (addendum) {
83+
addendum->set_derivedType(derived);
84+
}
85+
pointer.raw().elem_len = elementBytes;
86+
}
87+
7488
void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
7589
const Descriptor &target, const Descriptor &lowerBounds) {
7690
pointer = target;
@@ -87,9 +101,9 @@ void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
87101
}
88102
}
89103

90-
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
104+
static void RT_API_ATTRS PointerRemapping(Descriptor &pointer,
91105
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
92-
int sourceLine) {
106+
int sourceLine, bool isMonomorphic) {
93107
Terminator terminator{sourceFile, sourceLine};
94108
SubscriptValue byteStride{/*captured from first dimension*/};
95109
std::size_t boundElementBytes{bounds.ElementBytes()};
@@ -99,7 +113,7 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
99113
// the ranks may mismatch. Use target as a mold for initializing
100114
// the pointer descriptor.
101115
INTERNAL_CHECK(static_cast<std::size_t>(pointer.rank()) == boundsRank);
102-
pointer.ApplyMold(target, boundsRank);
116+
pointer.ApplyMold(target, boundsRank, isMonomorphic);
103117
pointer.set_base_addr(target.raw().base_addr);
104118
pointer.raw().attribute = CFI_attribute_pointer;
105119
for (unsigned j{0}; j < boundsRank; ++j) {
@@ -124,6 +138,19 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
124138
}
125139
}
126140

141+
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
142+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
143+
int sourceLine) {
144+
PointerRemapping(
145+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/false);
146+
}
147+
void RTDEF(PointerAssociateRemappingMonomorphic)(Descriptor &pointer,
148+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
149+
int sourceLine) {
150+
PointerRemapping(
151+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/true);
152+
}
153+
127154
RT_API_ATTRS void *AllocateValidatedPointerPayload(
128155
std::size_t byteSize, int allocatorIdx) {
129156
// Add space for a footer to validate during deallocation.

‎flang/include/flang/Lower/Runtime.h

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,10 +67,11 @@ void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &);
6767
void genPauseStatement(AbstractConverter &, const parser::PauseStmt &);
6868

6969
void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
70-
mlir::Value pointer, mlir::Value target);
70+
mlir::Value pointer, mlir::Value target,
71+
bool isMonomorphic);
7172
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
7273
mlir::Value pointer, mlir::Value target,
73-
mlir::Value bounds);
74+
mlir::Value bounds, bool isMonomorphic);
7475
void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location,
7576
mlir::Value pointer, mlir::Value target,
7677
mlir::Value lbounds);

‎flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,10 +34,11 @@ mlir::Value genAssociated(fir::FirOpBuilder &, mlir::Location,
3434
mlir::Value pointer, mlir::Value target);
3535

3636
void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
37-
mlir::Value pointer, mlir::Value target);
37+
mlir::Value pointer, mlir::Value target,
38+
bool isMonomorphic);
3839
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
3940
mlir::Value pointer, mlir::Value target,
40-
mlir::Value bounds);
41+
mlir::Value bounds, bool isMonomorphic);
4142

4243
mlir::Value genCpuTime(fir::FirOpBuilder &, mlir::Location);
4344
void genDateAndTime(fir::FirOpBuilder &, mlir::Location,

‎flang/include/flang/Runtime/pointer.h

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,10 @@ void RTDECL(PointerAssociateScalar)(Descriptor &, void *);
5252

5353
// Associates a pointer with a target of the same rank, possibly with new lower
5454
// bounds, which are passed in a vector whose length must equal the rank.
55+
// Use the Monomorphic form if the pointer's type shouldn't change.
5556
void RTDECL(PointerAssociate)(Descriptor &, const Descriptor &target);
57+
void RTDECL(PointerAssociateMonomorphic)(
58+
Descriptor &, const Descriptor &target);
5659
void RTDECL(PointerAssociateLowerBounds)(
5760
Descriptor &, const Descriptor &target, const Descriptor &lowerBounds);
5861

@@ -62,6 +65,9 @@ void RTDECL(PointerAssociateLowerBounds)(
6265
void RTDECL(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
6366
const Descriptor &bounds, const char *sourceFile = nullptr,
6467
int sourceLine = 0);
68+
void RTDECL(PointerAssociateRemappingMonomorphic)(Descriptor &,
69+
const Descriptor &target, const Descriptor &bounds,
70+
const char *sourceFile = nullptr, int sourceLine = 0);
6571

6672
// Data pointer allocation and deallocation
6773

‎flang/lib/Lower/Bridge.cpp

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4517,7 +4517,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
45174517
boundsDesc);
45184518
return;
45194519
}
4520-
Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
4520+
Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs,
4521+
/*isMonomorphic=*/false);
45214522
return;
45224523
}
45234524

@@ -4703,8 +4704,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
47034704
mlir::Value lhs = lhsMutableBox.getAddr();
47044705
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
47054706
mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc);
4706-
Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
4707-
boundsDesc);
4707+
Fortran::lower::genPointerAssociateRemapping(
4708+
*builder, loc, lhs, rhs, boundsDesc,
4709+
lhsType && !lhsType->IsPolymorphic());
47084710
return;
47094711
}
47104712
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {

‎flang/lib/Lower/Runtime.cpp

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -205,22 +205,28 @@ void Fortran::lower::genPauseStatement(
205205
void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
206206
mlir::Location loc,
207207
mlir::Value pointer,
208-
mlir::Value target) {
208+
mlir::Value target,
209+
bool isMonomorphic) {
209210
mlir::func::FuncOp func =
210-
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc, builder);
211+
isMonomorphic
212+
? fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateMonomorphic)>(
213+
loc, builder)
214+
: fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc,
215+
builder);
211216
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
212217
builder, loc, func.getFunctionType(), pointer, target);
213218
builder.create<fir::CallOp>(loc, func, args);
214219
}
215220

216-
void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
217-
mlir::Location loc,
218-
mlir::Value pointer,
219-
mlir::Value target,
220-
mlir::Value bounds) {
221+
void Fortran::lower::genPointerAssociateRemapping(
222+
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value pointer,
223+
mlir::Value target, mlir::Value bounds, bool isMonomorphic) {
221224
mlir::func::FuncOp func =
222-
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
223-
builder);
225+
isMonomorphic
226+
? fir::runtime::getRuntimeFunc<mkRTKey(
227+
PointerAssociateRemappingMonomorphic)>(loc, builder)
228+
: fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(
229+
loc, builder);
224230
auto fTy = func.getFunctionType();
225231
auto sourceFile = fir::factory::locationToFilename(builder, loc);
226232
auto sourceLine =

‎flang/test/Lower/polymorphic.f90

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -178,6 +178,17 @@ subroutine polymorphic_to_nonpolymorphic(p)
178178
! CHECK-LABEL: func.func @_QMpolymorphic_testPpolymorphic_to_nonpolymorphic
179179
! Just checking that FIR is generated without error.
180180

181+
subroutine nonpolymorphic_to_polymorphic(p, t)
182+
type p1
183+
end type
184+
type(p1), pointer :: p(:)
185+
class(p1), target :: t(:)
186+
p(0:1) => t
187+
end subroutine
188+
189+
! CHECK-LABEL: func.func @_QMpolymorphic_testPnonpolymorphic_to_polymorphic
190+
! CHECK: fir.call @_FortranAPointerAssociateRemappingMonomorphic
191+
181192
! Test that lowering does not crash for function return with unlimited
182193
! polymoprhic value.
183194

0 commit comments

Comments
 (0)