[flang-commits] [flang] 04a920b - [flang] preserve pointer rank in polymorphic_pointer => NULL()
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Mon Apr 3 00:21:12 PDT 2023
Author: Jean Perier
Date: 2023-04-03T09:19:01+02:00
New Revision: 04a920b76acf0a52a3eb957c6331ba81a1173e2a
URL: https://github.com/llvm/llvm-project/commit/04a920b76acf0a52a3eb957c6331ba81a1173e2a
DIFF: https://github.com/llvm/llvm-project/commit/04a920b76acf0a52a3eb957c6331ba81a1173e2a.diff
LOG: [flang] preserve pointer rank in polymorphic_pointer => NULL()
The current lowering for polymorphic pointer association was not
dealing with NULL in a "context aware" fashion: it was calling the
`PointerAssociate` runtime entry point with a fir.box<none> target.
But the fir.box<none> is a descriptor for a scalar, this lead the
runtime to set the pointer rank to zero, regardless of its actual
rank.
I do not think there is a way to expose this problem with the Fortran
code currently supported by flang, because most further manipulation of
the pointer would either set the rank correctly, or do not rely on the
rank in the runtime descriptor.
However, this is incorrect, and when assumed rank are supported, the
following would have failed:
```
subroutine check_rank(p)
class(*), pointer :: p(..)
p => null()
select rank(p)
rank (1)
print *, "OK"
rank default
print *, "FAILED"
end select
end subroutine
class(*), pointer :: p(:)
p => null()
call check_rank(p)
end
```
Instead, detect NULL() in polymorphic pointer lowering and trigger the
deallocation of the pointer.
Differential Revision: https://reviews.llvm.org/D147317
Added:
Modified:
flang/lib/Lower/Bridge.cpp
flang/lib/Optimizer/Builder/MutableBox.cpp
flang/test/Lower/pointer-disassociate.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index ac5cdd57f2fd6..f27902c9c08cb 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2849,7 +2849,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
lbounds.push_back(
fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
- mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+ fir::MutableBoxValue lhsMutableBox = genExprMutableBox(loc, assign.lhs);
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ assign.rhs)) {
+ fir::factory::disassociateMutableBox(*builder, loc, lhsMutableBox);
+ return;
+ }
+ mlir::Value lhs = lhsMutableBox.getAddr();
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
if (!lbounds.empty()) {
mlir::Value boundsDesc = createLboundArray(lbounds, loc);
@@ -2936,7 +2942,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (!lowerToHighLevelFIR() && explicitIterationSpace())
TODO(loc, "polymorphic pointer assignment in FORALL");
- mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+ fir::MutableBoxValue lhsMutableBox = genExprMutableBox(loc, assign.lhs);
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ assign.rhs)) {
+ fir::factory::disassociateMutableBox(*builder, loc, lhsMutableBox);
+ return;
+ }
+ mlir::Value lhs = lhsMutableBox.getAddr();
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc);
Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index d092f3a2876b8..3c4169643e487 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -674,10 +674,11 @@ void fir::factory::disassociateMutableBox(fir::FirOpBuilder &builder,
auto boxTy = box.getBoxTy().dyn_cast<fir::BaseBoxType>();
auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(boxTy.getEleTy());
mlir::Type derivedType = fir::getDerivedType(eleTy);
- if (auto recTy = derivedType.dyn_cast<fir::RecordType>())
+ if (auto recTy = derivedType.dyn_cast<fir::RecordType>()) {
fir::runtime::genNullifyDerivedType(builder, loc, box.getAddr(), recTy,
box.rank());
- return;
+ return;
+ }
}
MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus();
}
diff --git a/flang/test/Lower/pointer-disassociate.f90 b/flang/test/Lower/pointer-disassociate.f90
index 753db13f63395..7e090b6406dce 100644
--- a/flang/test/Lower/pointer-disassociate.f90
+++ b/flang/test/Lower/pointer-disassociate.f90
@@ -1,5 +1,5 @@
! Test lowering of pointer disassociation
-! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir --polymorphic-type %s -o - | FileCheck %s
! -----------------------------------------------------------------------------
@@ -104,3 +104,30 @@ subroutine test_array_mold(p, x)
! CHECK: fir.store %[[VAL_9]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
p => NULL(x)
end subroutine
+
+subroutine test_polymorphic_null(p)
+ type t
+ end type
+ class(t), pointer :: p(:)
+ p => null()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_polymorphic_null(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFtest_polymorphic_nullTt>>>>>
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_polymorphic_nullE.dt.t)
+! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFtest_polymorphic_nullTt>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<{{.*}}>) -> !fir.ref<none>
+! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_6:.*]] = fir.call @_FortranAPointerNullifyDerived(%[[VAL_2]], %[[VAL_3]], %[[VAL_4]], %[[VAL_5]]) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+
+subroutine test_unlimited_polymorphic_null(p)
+ class(*), pointer :: p(:)
+ p => null()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_unlimited_polymorphic_null(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>
+! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xnone>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xnone>>, !fir.shape<1>) -> !fir.class<!fir.ptr<!fir.array<?xnone>>>
+! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>
More information about the flang-commits
mailing list