diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -946,6 +946,8 @@ bool IsNullPointer(const Expr &); bool IsObjectPointer(const Expr &, FoldingContext &); +const ProcedureRef *GetProcedureRef(const Expr &); + // 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 &, FoldingContext &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -784,6 +784,10 @@ } } +const ProcedureRef *GetProcedureRef(const Expr &expr) { + return UnwrapProcedureRef(expr); +} + // IsNullPointer() & variations template struct IsNullPointerHelper { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -189,17 +189,41 @@ 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> 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::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( diff --git a/flang/test/Lower/default-initialization-globals.f90 b/flang/test/Lower/default-initialization-globals.f90 --- a/flang/test/Lower/default-initialization-globals.f90 +++ b/flang/test/Lower/default-initialization-globals.f90 @@ -55,6 +55,12 @@ 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 @@ ! 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>>}> + ! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1> + ! CHECK: %[[ZEROBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> + ! CHECK: %[[RET:.*]] = fir.insert_value %[[UNDEF]], %[[ZEROBOX]], ["v", !fir.type<_QMtinitTtv{v:!fir.box>>}>] : (!fir.type<_QMtinitTtv{v:!fir.box>>}>, !fir.box>>) -> !fir.type<_QMtinitTtv{v:!fir.box>>}> + ! CHECK: fir.has_value %[[RET]] : !fir.type<_QMtinitTtv{v:!fir.box>>}> + end module