Skip to content

Commit ae780be

Browse files
klauslerklausler
committed
[flang][runtime] Preserve type when remapping monomorphic pointers
Pointer remappings 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 a new entry point so as to not break forward binary compatibility. Fixes #149353.
1 parent 3de11b7 commit ae780be

File tree

9 files changed

+59
-23
lines changed

9 files changed

+59
-23
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: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -87,9 +87,9 @@ void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
8787
}
8888
}
8989

90-
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
90+
static void RT_API_ATTRS PointerRemapping(Descriptor &pointer,
9191
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
92-
int sourceLine) {
92+
int sourceLine, bool isMonomorphic) {
9393
Terminator terminator{sourceFile, sourceLine};
9494
SubscriptValue byteStride{/*captured from first dimension*/};
9595
std::size_t boundElementBytes{bounds.ElementBytes()};
@@ -99,7 +99,7 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
9999
// the ranks may mismatch. Use target as a mold for initializing
100100
// the pointer descriptor.
101101
INTERNAL_CHECK(static_cast<std::size_t>(pointer.rank()) == boundsRank);
102-
pointer.ApplyMold(target, boundsRank);
102+
pointer.ApplyMold(target, boundsRank, isMonomorphic);
103103
pointer.set_base_addr(target.raw().base_addr);
104104
pointer.raw().attribute = CFI_attribute_pointer;
105105
for (unsigned j{0}; j < boundsRank; ++j) {
@@ -124,6 +124,19 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
124124
}
125125
}
126126

127+
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
128+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
129+
int sourceLine) {
130+
PointerRemapping(
131+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/false);
132+
}
133+
void RTDEF(PointerAssociateRemappingMonomorphic)(Descriptor &pointer,
134+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
135+
int sourceLine) {
136+
PointerRemapping(
137+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/true);
138+
}
139+
127140
RT_API_ATTRS void *AllocateValidatedPointerPayload(
128141
std::size_t byteSize, int allocatorIdx) {
129142
// Add space for a footer to validate during deallocation.

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
7070
mlir::Value pointer, mlir::Value target);
7171
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
7272
mlir::Value pointer, mlir::Value target,
73-
mlir::Value bounds);
73+
mlir::Value bounds, bool isMonomorphic);
7474
void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location,
7575
mlir::Value pointer, mlir::Value target,
7676
mlir::Value lbounds);

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
3737
mlir::Value pointer, mlir::Value target);
3838
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
3939
mlir::Value pointer, mlir::Value target,
40-
mlir::Value bounds);
40+
mlir::Value bounds, bool isMonomorphic);
4141

4242
mlir::Value genCpuTime(fir::FirOpBuilder &, mlir::Location);
4343
void genDateAndTime(fir::FirOpBuilder &, mlir::Location,

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,9 +59,14 @@ void RTDECL(PointerAssociateLowerBounds)(
5959
// Associates a pointer with a target with bounds remapping. The target must be
6060
// simply contiguous &/or of rank 1. The bounds constitute a [2,newRank]
6161
// integer array whose columns are [lower bound, upper bound] on each dimension.
62+
// Use the Monomorphic form if the pointer's type shouldn't change and
63+
// the target is polymorphic.
6264
void RTDECL(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
6365
const Descriptor &bounds, const char *sourceFile = nullptr,
6466
int sourceLine = 0);
67+
void RTDECL(PointerAssociateRemappingMonomorphic)(Descriptor &,
68+
const Descriptor &target, const Descriptor &bounds,
69+
const char *sourceFile = nullptr, int sourceLine = 0);
6570

6671
// Data pointer allocation and deallocation
6772

‎flang/lib/Lower/Bridge.cpp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4703,8 +4703,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
47034703
mlir::Value lhs = lhsMutableBox.getAddr();
47044704
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
47054705
mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc);
4706-
Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
4707-
boundsDesc);
4706+
Fortran::lower::genPointerAssociateRemapping(
4707+
*builder, loc, lhs, rhs, boundsDesc,
4708+
lhsType && rhsType && !lhsType->IsPolymorphic() &&
4709+
rhsType->IsPolymorphic());
47084710
return;
47094711
}
47104712
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {

‎flang/lib/Lower/Runtime.cpp

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -213,14 +213,15 @@ void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
213213
builder.create<fir::CallOp>(loc, func, args);
214214
}
215215

216-
void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
217-
mlir::Location loc,
218-
mlir::Value pointer,
219-
mlir::Value target,
220-
mlir::Value bounds) {
216+
void Fortran::lower::genPointerAssociateRemapping(
217+
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value pointer,
218+
mlir::Value target, mlir::Value bounds, bool isMonomorphic) {
221219
mlir::func::FuncOp func =
222-
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
223-
builder);
220+
isMonomorphic
221+
? fir::runtime::getRuntimeFunc<mkRTKey(
222+
PointerAssociateRemappingMonomorphic)>(loc, builder)
223+
: fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(
224+
loc, builder);
224225
auto fTy = func.getFunctionType();
225226
auto sourceFile = fir::factory::locationToFilename(builder, loc);
226227
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)