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);
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,
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();
}
! Test lowering of pointer disassociation
-! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir --polymorphic-type %s -o - | FileCheck %s
! -----------------------------------------------------------------------------
! 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>>>>