[flang] Handle NULL(mold) used in initializer region

NULL intrinsic with a MOLD argument can be used in a type constructor.
This patch handles this use case with a specific lowering that create
an unallocated box with the MOLD type.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D134554

flang/include/flang/Evaluate/tools.h

@@ -946,6 +946,8 @@ bool IsNullProcedurePointer(const Expr<SomeType> &);
 bool IsNullPointer(const Expr<SomeType> &);
 bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
 
+const ProcedureRef *GetProcedureRef(const Expr<SomeType> &);
+
 // Can Expr be passed as absent to an optional dummy argument.
 // See 15.5.2.12 point 1 for more details.
 bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);

flang/lib/Evaluate/tools.cpp

@@ -784,6 +784,10 @@ bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
   }
 }
 
+const ProcedureRef *GetProcedureRef(const Expr<SomeType> &expr) {
+  return UnwrapProcedureRef(expr);
+}
+
 // IsNullPointer() & variations
 
 template <bool IS_PROC_PTR> struct IsNullPointerHelper {

flang/lib/Lower/ConvertVariable.cpp

@@ -189,17 +189,41 @@ mlir::Value Fortran::lower::genInitialDataTarget(
     return fir::factory::createUnallocatedBox(builder, loc, boxType,
                                               /*nonDeferredParams=*/llvm::None);
   // Pointer initial data target, and NULL(mold).
-  if (const Fortran::semantics::Symbol *sym =
-          Fortran::evaluate::GetFirstSymbol(initialTarget)) {
+  for (const auto &sym : Fortran::evaluate::CollectSymbols(initialTarget)) {
     // Length parameters processing will need care in global initializer
     // context.
-    if (hasDerivedTypeWithLengthParameters(*sym))
+    if (hasDerivedTypeWithLengthParameters(sym))
       TODO(loc, "initial-data-target with derived type length parameters");
 
-    auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
+    auto var = Fortran::lower::pft::Variable(sym, /*global=*/true);
     Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
                                         storeMap);
   }
+
+  // Handle NULL(mold) as a special case. Return an unallocated box of MOLD
+  // type. The return box is correctly created as a fir.box<fir.ptr<T>> where
+  // T is extracted from the MOLD argument.
+  if (const Fortran::evaluate::ProcedureRef *procRef =
+          Fortran::evaluate::GetProcedureRef(initialTarget)) {
+    const Fortran::evaluate::SpecificIntrinsic *intrinsic =
+        procRef->proc().GetSpecificIntrinsic();
+    if (intrinsic && intrinsic->name == "null") {
+      assert(procRef->arguments().size() == 1 &&
+             "Expecting mold argument for NULL intrinsic");
+      const auto *argExpr = procRef->arguments()[0].value().UnwrapExpr();
+      assert(argExpr);
+      const Fortran::semantics::Symbol *sym =
+          Fortran::evaluate::GetFirstSymbol(*argExpr);
+      fir::ExtendedValue exv =
+          globalOpSymMap.lookupSymbol(sym).toExtendedValue();
+      const auto *mold = exv.getBoxOf<fir::MutableBoxValue>();
+      fir::BoxType boxType = mold->getBoxTy();
+      mlir::Value box =
+          fir::factory::createUnallocatedBox(builder, loc, boxType, {});
+      return box;
+    }
+  }
+
   mlir::Value box;
   if (initialTarget.Rank() > 0) {
     box = fir::getBase(Fortran::lower::createSomeArrayBox(

flang/test/Lower/default-initialization-globals.f90

@@ -55,6 +55,12 @@ module tinit
     integer :: j = 3
   end type
 
+  type tv
+    real, pointer :: v(:)
+  end type
+
+  real, pointer :: mv(:)
+
   ! Test scalar with default init
   type(t0) :: at0
 ! CHECK-LABEL: fir.global @_QMtinitEat0 : !fir.type<_QMtinitTt0{k:i32}> {
@@ -125,6 +131,17 @@ module tinit
   ! CHECK: %[[VAL_45:.*]] = fir.undefined i32
   ! CHECK: %[[VAL_46:.*]] = fir.insert_value %[[VAL_44]], %[[VAL_45]], ["l", !fir.type<_QMtinitTtextendst0{k:i32,l:i32}>] : (!fir.type<_QMtinitTtextendst0{k:i32,l:i32}>, i32) -> !fir.type<_QMtinitTtextendst0{k:i32,l:i32}>
   ! CHECK: fir.has_value %[[VAL_46]] : !fir.type<_QMtinitTtextendst0{k:i32,l:i32}>
+
+  type(tv) :: withmold = tv(null(mv))
+  ! CHECK-LABEL: fir.global @_QMtinitEwithmold
+  ! CHECK: %[[C0:.*]] = arith.constant 0 : index
+  ! CHECK: %[[UNDEF:.*]] = fir.undefined !fir.type<_QMtinitTtv{v:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+  ! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+  ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+  ! CHECK: %[[ZEROBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK: %[[RET:.*]] = fir.insert_value %[[UNDEF]], %[[ZEROBOX]], ["v", !fir.type<_QMtinitTtv{v:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>] : (!fir.type<_QMtinitTtv{v:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>, !fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.type<_QMtinitTtv{v:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+  ! CHECK: fir.has_value %[[RET]] : !fir.type<_QMtinitTtv{v:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+
 end module