[flang-commits] [PATCH] D147317: [flang] preserve pointer rank in polymorphic_pointer => NULL()

[Jean Perier via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG04a920b76acf: [flang] preserve pointer rank in polymorphic_pointer => NULL() (authored by jeanPerier).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D147317/new/

https://reviews.llvm.org/D147317

Files:
  flang/lib/Lower/Bridge.cpp
  flang/lib/Optimizer/Builder/MutableBox.cpp
  flang/test/Lower/pointer-disassociate.f90


Index: flang/test/Lower/pointer-disassociate.f90
===================================================================
--- flang/test/Lower/pointer-disassociate.f90
+++ 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 @@
   ! 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>>>>
Index: flang/lib/Optimizer/Builder/MutableBox.cpp
===================================================================
--- flang/lib/Optimizer/Builder/MutableBox.cpp
+++ flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -674,10 +674,11 @@
     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();
 }
Index: flang/lib/Lower/Bridge.cpp
===================================================================
--- flang/lib/Lower/Bridge.cpp
+++ flang/lib/Lower/Bridge.cpp
@@ -2849,7 +2849,13 @@
       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 @@
       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,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D147317.510414.patch
Type: text/x-patch
Size: 4733 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230403/5e2b6a1e/attachment-0001.bin>