@@ -122,6 +122,58 @@ fir::ShapeShiftOp Fortran::lower::omp::getShapeShift(fir::FirOpBuilder &builder,
122122 return shapeShift;
123123}
124124
125+ // Initialize box newBox using moldBox. These should both have the same type and
126+ // be boxes containing derived types e.g.
127+ // fir.box<!fir.type<>>
128+ // fir.box<!fir.heap<!fir.type<>>
129+ // fir.box<!fir.heap<!fir.array<fir.type<>>>
130+ // fir.class<...<!fir.type<>>>
131+ // If the type doesn't match , this does nothing
132+ static void initializeIfDerivedTypeBox (fir::FirOpBuilder &builder,
133+ mlir::Location loc, mlir::Value newBox,
134+ mlir::Value moldBox, bool hasInitializer,
135+ bool isFirstPrivate) {
136+ fir::BoxType boxTy = mlir::dyn_cast<fir::BoxType>(newBox.getType ());
137+ fir::ClassType classTy = mlir::dyn_cast<fir::ClassType>(newBox.getType ());
138+ if (!boxTy && !classTy)
139+ return ;
140+
141+ // remove pointer and array types in the middle
142+ mlir::Type eleTy;
143+ if (boxTy)
144+ eleTy = boxTy.getElementType ();
145+ if (classTy)
146+ eleTy = classTy.getEleTy ();
147+ mlir::Type derivedTy = fir::unwrapRefType (eleTy);
148+ if (auto array = mlir::dyn_cast<fir::SequenceType>(derivedTy))
149+ derivedTy = array.getElementType ();
150+
151+ if (!fir::isa_derived (derivedTy))
152+ return ;
153+ assert (moldBox.getType () == newBox.getType ());
154+
155+ if (hasInitializer)
156+ fir::runtime::genDerivedTypeInitialize (builder, loc, newBox);
157+
158+ if (hlfir::mayHaveAllocatableComponent (derivedTy) && !isFirstPrivate)
159+ fir::runtime::genDerivedTypeInitializeClone (builder, loc, newBox, moldBox);
160+ }
161+
162+ static bool
163+ isDerivedTypeNeedingInitialization (const Fortran::semantics::Symbol &sym) {
164+ // Fortran::lower::hasDefaultInitialization returns false for ALLOCATABLE, so
165+ // re-implement here.
166+ // ignorePointer=true because either the pointer points to the same target as
167+ // the original variable, or it is uninitialized.
168+ if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType ())
169+ if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
170+ declTypeSpec->AsDerived ())
171+ if (derivedTypeSpec->HasDefaultInitialization (
172+ /* ignoreAllocatable=*/ false , /* ignorePointer=*/ true ))
173+ return true ;
174+ return false ;
175+ }
176+
125177static mlir::Value generateZeroShapeForRank (fir::FirOpBuilder &builder,
126178 mlir::Location loc,
127179 mlir::Value moldArg) {
@@ -145,19 +197,18 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
145197 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type argType,
146198 mlir::Value scalarInitValue, mlir::Block *initBlock,
147199 mlir::Value allocatedPrivVarArg, mlir::Value moldArg,
148- mlir::Region &cleanupRegion, bool isPrivate ,
200+ mlir::Region &cleanupRegion, DeclOperationKind kind ,
149201 const Fortran::semantics::Symbol *sym) {
150202 mlir::Type ty = fir::unwrapRefType (argType);
151203 builder.setInsertionPointToEnd (initBlock);
152204 auto yield = [&](mlir::Value ret) {
153205 builder.create <mlir::omp::YieldOp>(loc, ret);
154206 };
155207
156- if (isPrivate )
208+ if (isPrivatization (kind) )
157209 assert (sym && " Symbol information is needed to privatize derived types" );
158210 bool needsInitialization =
159- sym ? Fortran::lower::hasDefaultInitialization (sym->GetUltimate ())
160- : false ;
211+ sym ? isDerivedTypeNeedingInitialization (sym->GetUltimate ()) : false ;
161212
162213 if (fir::isa_trivial (ty)) {
163214 builder.setInsertionPointToEnd (initBlock);
@@ -210,7 +261,8 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
210261
211262 // The initial state of a private pointer is undefined so we don't need to
212263 // match the mold argument (OpenMP 5.2 end of page 106).
213- if (isPrivate && mlir::isa<fir::PointerType>(boxTy.getEleTy ())) {
264+ if (isPrivatization (kind) &&
265+ mlir::isa<fir::PointerType>(boxTy.getEleTy ())) {
214266 // we need a shape with the right rank so that the embox op is lowered
215267 // to an llvm struct of the right type. This returns nullptr if the types
216268 // aren't right.
@@ -242,7 +294,7 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
242294 TODO (loc, " Reduction/Privatization of non-allocatable trivial or "
243295 " character typed box" );
244296
245- if ((isDerived || isChar) && (!isPrivate || scalarInitValue))
297+ if ((isDerived || isChar) && (isReduction (kind) || scalarInitValue))
246298 TODO (loc, " Reduction of an unsupported boxed type" );
247299
248300 fir::IfOp ifUnallocated{nullptr };
@@ -259,8 +311,9 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
259311 mlir::Value box = builder.create <fir::EmboxOp>(
260312 loc, ty, valAlloc, /* shape=*/ mlir::Value{}, /* slice=*/ mlir::Value{},
261313 lenParams);
262- if (needsInitialization)
263- fir::runtime::genDerivedTypeInitialize (builder, loc, box);
314+ initializeIfDerivedTypeBox (
315+ builder, loc, box, moldArg, needsInitialization,
316+ /* isFirstPrivate=*/ kind == DeclOperationKind::FirstPrivate);
264317 fir::StoreOp lastOp = builder.create <fir::StoreOp>(loc, box, boxAlloca);
265318
266319 createCleanupRegion (builder, loc, argType, cleanupRegion, sym);
@@ -335,8 +388,10 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
335388
336389 if (scalarInitValue)
337390 builder.create <hlfir::AssignOp>(loc, scalarInitValue, box);
338- if (needsInitialization)
339- fir::runtime::genDerivedTypeInitialize (builder, loc, box);
391+
392+ initializeIfDerivedTypeBox (builder, loc, box, moldArg, needsInitialization,
393+ /* isFirstPrivate=*/ kind ==
394+ DeclOperationKind::FirstPrivate);
340395
341396 builder.create <fir::StoreOp>(loc, box, boxAlloca);
342397 if (ifUnallocated)
@@ -371,13 +426,15 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
371426 }
372427
373428 if (fir::isa_derived (ty)) {
374- if (needsInitialization) {
375- builder.setInsertionPointToStart (initBlock);
376- mlir::Type boxedTy = fir::BoxType::get (ty);
377- mlir::Value box =
378- builder.create <fir::EmboxOp>(loc, boxedTy, allocatedPrivVarArg);
379- fir::runtime::genDerivedTypeInitialize (builder, loc, box);
380- }
429+ builder.setInsertionPointToStart (initBlock);
430+ mlir::Type boxedTy = fir::BoxType::get (ty);
431+ mlir::Value newBox =
432+ builder.create <fir::EmboxOp>(loc, boxedTy, allocatedPrivVarArg);
433+ mlir::Value moldBox = builder.create <fir::EmboxOp>(loc, boxedTy, moldArg);
434+ initializeIfDerivedTypeBox (
435+ builder, loc, newBox, moldBox, needsInitialization,
436+ /* isFirstPrivate=*/ kind == DeclOperationKind::FirstPrivate);
437+
381438 if (sym && hasFinalization (*sym))
382439 createCleanupRegion (builder, loc, argType, cleanupRegion, sym);
383440
0 commit comments