[flang][OpenACC] generate Destroy region to free memory of private and firstprivate if needed

flang/include/flang/Optimizer/Builder/HLFIRTools.h

@@ -485,9 +485,18 @@ hlfir::ElementalOp cloneToElementalOp(mlir::Location loc,
 /// would be incorrect.
 bool elementalOpMustProduceTemp(hlfir::ElementalOp elemental);
 
-std::pair<hlfir::Entity, mlir::Value>
-createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
-                   hlfir::Entity mold);
+/// Create a new temporary based on the provided \p mold entity.
+///
+/// The returned temporary has the same element type, shape and type parameters
+/// as the mold. When possible, the storage is stack-allocated; otherwise it is
+/// heap-allocated (for instance for arrays with dynamic shape or polymorphic
+/// cases). The bool result indicates whether heap allocation was used.
+///
+/// If the returned bool is true, callers are responsible for arranging cleanup
+/// (e.g., generating destruction/deallocation code at an appropriate point).
+std::pair<hlfir::Entity, bool> createTempFromMold(mlir::Location loc,
+                                                  fir::FirOpBuilder &builder,
+                                                  hlfir::Entity mold);
 
 // TODO: this does not support polymorphic molds
 hlfir::Entity createStackTempFromMold(mlir::Location loc,

flang/include/flang/Optimizer/OpenACC/Support/FIROpenACCTypeInterfaces.h

@@ -53,12 +53,15 @@ struct OpenACCMappableModel
   mlir::acc::VariableTypeCategory getTypeCategory(mlir::Type type,
                                                   mlir::Value var) const;
 
+  bool generatePrivateDestroy(mlir::Type type, mlir::OpBuilder &builder,
+                              mlir::Location loc, mlir::Value privatized) const;
+
   mlir::Value generatePrivateInit(mlir::Type type, mlir::OpBuilder &builder,
                                   mlir::Location loc,
                                   mlir::TypedValue<mlir::acc::MappableType> var,
                                   llvm::StringRef varName,
-                                  mlir::ValueRange extents,
-                                  mlir::Value initVal) const;
+                                  mlir::ValueRange extents, mlir::Value initVal,
+                                  bool &needsDestroy) const;
 };
 
 } // namespace fir::acc

flang/lib/Lower/Bridge.cpp

@@ -4994,8 +4994,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
           hlfir::Entity entity{baseValue};
           auto [temp, cleanup] =
               hlfir::createTempFromMold(loc, builder, entity);
-          auto needCleanup = fir::getIntIfConstant(cleanup);
-          if (needCleanup && *needCleanup) {
+          if (cleanup) {
             if (auto declareOp =
                     mlir::dyn_cast<hlfir::DeclareOp>(temp.getDefiningOp()))
               temps.push_back(declareOp.getMemref());

flang/lib/Lower/OpenACC.cpp

@@ -978,15 +978,40 @@ static RecipeOp genRecipeOp(
   auto mappableTy = mlir::dyn_cast<mlir::acc::MappableType>(ty);
   assert(mappableTy &&
          "Expected that all variable types are considered mappable");
+  bool needsDestroy = false;
   auto retVal = mappableTy.generatePrivateInit(
       builder, loc,
       mlir::cast<mlir::TypedValue<mlir::acc::MappableType>>(
           initBlock->getArgument(0)),
       initName,
       initBlock->getArguments().take_back(initBlock->getArguments().size() - 1),
-      initValue);
+      initValue, needsDestroy);
   mlir::acc::YieldOp::create(builder, loc,
                              retVal ? retVal : initBlock->getArgument(0));
+  // Create destroy region and generate destruction if requested.
+  if (needsDestroy) {
+    llvm::SmallVector<mlir::Type> destroyArgsTy;
+    llvm::SmallVector<mlir::Location> destroyArgsLoc;
+    // original and privatized/reduction value
+    destroyArgsTy.push_back(ty);
+    destroyArgsTy.push_back(ty);
+    destroyArgsLoc.push_back(loc);
+    destroyArgsLoc.push_back(loc);
+    // Append bounds arguments (if any) in the same order as init region
+    if (argsTy.size() > 1) {
+      destroyArgsTy.append(argsTy.begin() + 1, argsTy.end());
+      destroyArgsLoc.insert(destroyArgsLoc.end(), argsTy.size() - 1, loc);
+    }
+
+    builder.createBlock(&recipe.getDestroyRegion(),
+                        recipe.getDestroyRegion().end(), destroyArgsTy,
+                        destroyArgsLoc);
+    builder.setInsertionPointToEnd(&recipe.getDestroyRegion().back());
+    // Call interface on the privatized/reduction value (2nd argument).
+    (void)mappableTy.generatePrivateDestroy(
+        builder, loc, recipe.getDestroyRegion().front().getArgument(1));
+    mlir::acc::TerminatorOp::create(builder, loc);
+  }
   return recipe;
 }
 

flang/lib/Lower/Support/PrivateReductionUtils.cpp

@@ -516,15 +516,10 @@ void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxedArray(
       return createStackTempFromMold(loc, builder, source);
 
     auto [temp, needsDealloc] = createTempFromMold(loc, builder, source);
-    // if needsDealloc isn't statically false, add cleanup region. Always
+    // if needsDealloc, add cleanup region. Always
     // do this for allocatable boxes because they might have been re-allocated
     // in the body of the loop/parallel region
-
-    std::optional<int64_t> cstNeedsDealloc =
-        fir::getIntIfConstant(needsDealloc);
-    assert(cstNeedsDealloc.has_value() &&
-           "createTempFromMold decides this statically");
-    if (cstNeedsDealloc.has_value() && *cstNeedsDealloc != false) {
+    if (needsDealloc) {
       mlir::OpBuilder::InsertionGuard guard(builder);
       createCleanupRegion(converter, loc, argType, cleanupRegion, sym,
                           isDoConcurrent);

flang/lib/Optimizer/Builder/HLFIRTools.cpp

@@ -1392,7 +1392,7 @@ bool hlfir::elementalOpMustProduceTemp(hlfir::ElementalOp elemental) {
   return false;
 }
 
-std::pair<hlfir::Entity, mlir::Value>
+std::pair<hlfir::Entity, bool>
 hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
                           hlfir::Entity mold) {
   assert(!mold.isAssumedRank() &&
@@ -1425,7 +1425,7 @@ hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
       loc, mold.getElementOrSequenceType(), shape, extents, lenParams,
       genTempDeclareOp, mold.isPolymorphic() ? mold.getBase() : nullptr,
       useStack, tmpName);
-  return {hlfir::Entity{base}, builder.createBool(loc, isHeapAlloc)};
+  return {hlfir::Entity{base}, isHeapAlloc};
 }
 
 hlfir::Entity hlfir::createStackTempFromMold(mlir::Location loc,

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

@@ -136,12 +136,12 @@ createArrayTemp(mlir::Location loc, fir::FirOpBuilder &builder,
 static mlir::Value copyInTempAndPackage(mlir::Location loc,
                                         fir::FirOpBuilder &builder,
                                         hlfir::Entity source) {
-  auto [temp, cleanup] = hlfir::createTempFromMold(loc, builder, source);
+  auto [temp, mustFree] = hlfir::createTempFromMold(loc, builder, source);
   assert(!temp.isAllocatable() && "expect temp to already be allocated");
   hlfir::AssignOp::create(builder, loc, source, temp, /*realloc=*/false,
                           /*keep_lhs_length_if_realloc=*/false,
                           /*temporary_lhs=*/true);
-  return packageBufferizedExpr(loc, builder, temp, cleanup);
+  return packageBufferizedExpr(loc, builder, temp, mustFree);
 }
 
 struct AsExprOpConversion : public mlir::OpConversionPattern<hlfir::AsExprOp> {

flang/lib/Optimizer/OpenACC/Support/FIROpenACCTypeInterfaces.cpp

@@ -548,7 +548,8 @@ template <typename Ty>
 mlir::Value OpenACCMappableModel<Ty>::generatePrivateInit(
     mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
     mlir::TypedValue<mlir::acc::MappableType> var, llvm::StringRef varName,
-    mlir::ValueRange extents, mlir::Value initVal) const {
+    mlir::ValueRange extents, mlir::Value initVal, bool &needsDestroy) const {
+  needsDestroy = false;
   mlir::Value retVal;
   mlir::Type unwrappedTy = fir::unwrapRefType(type);
   mlir::ModuleOp mod = builder.getInsertionBlock()
@@ -615,9 +616,11 @@ mlir::Value OpenACCMappableModel<Ty>::generatePrivateInit(
       mlir::Value firClass =
           fir::EmboxOp::create(builder, loc, boxTy, allocatedScalar);
       fir::StoreOp::create(builder, loc, firClass, retVal);
+      needsDestroy = true;
     } else if (mlir::isa<fir::SequenceType>(innerTy)) {
       hlfir::Entity source = hlfir::Entity{var};
-      auto [temp, cleanup] = hlfir::createTempFromMold(loc, firBuilder, source);
+      auto [temp, cleanupFlag] =
+          hlfir::createTempFromMold(loc, firBuilder, source);
       if (fir::isa_ref_type(type)) {
         // When the temp is created - it is not a reference - thus we can
         // end up with a type inconsistency. Therefore ensure storage is created
@@ -636,6 +639,9 @@ mlir::Value OpenACCMappableModel<Ty>::generatePrivateInit(
       } else {
         retVal = temp;
       }
+      // If heap was allocated, a destroy is required later.
+      if (cleanupFlag)
+        needsDestroy = true;
     } else {
       TODO(loc, "Unsupported boxed type for OpenACC private-like recipe");
     }
@@ -667,23 +673,69 @@ template mlir::Value
 OpenACCMappableModel<fir::BaseBoxType>::generatePrivateInit(
     mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
     mlir::TypedValue<mlir::acc::MappableType> var, llvm::StringRef varName,
-    mlir::ValueRange extents, mlir::Value initVal) const;
+    mlir::ValueRange extents, mlir::Value initVal, bool &needsDestroy) const;
 
 template mlir::Value
 OpenACCMappableModel<fir::ReferenceType>::generatePrivateInit(
     mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
     mlir::TypedValue<mlir::acc::MappableType> var, llvm::StringRef varName,
-    mlir::ValueRange extents, mlir::Value initVal) const;
+    mlir::ValueRange extents, mlir::Value initVal, bool &needsDestroy) const;
 
 template mlir::Value OpenACCMappableModel<fir::HeapType>::generatePrivateInit(
     mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
     mlir::TypedValue<mlir::acc::MappableType> var, llvm::StringRef varName,
-    mlir::ValueRange extents, mlir::Value initVal) const;
+    mlir::ValueRange extents, mlir::Value initVal, bool &needsDestroy) const;
 
 template mlir::Value
 OpenACCMappableModel<fir::PointerType>::generatePrivateInit(
     mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
     mlir::TypedValue<mlir::acc::MappableType> var, llvm::StringRef varName,
-    mlir::ValueRange extents, mlir::Value initVal) const;
+    mlir::ValueRange extents, mlir::Value initVal, bool &needsDestroy) const;
+
+template <typename Ty>
+bool OpenACCMappableModel<Ty>::generatePrivateDestroy(
+    mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
+    mlir::Value privatized) const {
+  // TODO: This is only dealing with cleaning-up heap allocation of the
+  // variable when any was made. Some Fortran types may have allocatable
+  // components. Currently the init is not doing deep copies of such components,
+  // so they are not freed here either. Likewise, the copies, when any, are not
+  // made using Fortran user defined assignments, so the destructors are not
+  // called either. This deserve a standard clarification, and in the meantime,
+  // it would likely be better to reject the privatization of such types.
+  mlir::Type unwrappedTy = fir::unwrapRefType(type);
+  // For boxed scalars allocated with AllocMem during init, free the heap.
+  if (auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(unwrappedTy)) {
+    // Load the box, take the address and free target if it was heap allocated.
+    mlir::Value boxVal = privatized;
+    if (fir::isa_ref_type(boxVal.getType()))
+      boxVal = fir::LoadOp::create(builder, loc, boxVal);
+    mlir::Value addr = fir::BoxAddrOp::create(builder, loc, boxVal);
+    // FreeMem only accepts fir.heap and this may not be represented in the box
+    // type if the privatized entity is not an allocatable.
+    mlir::Type heapType =
+        fir::HeapType::get(fir::unwrapRefType(addr.getType()));
+    if (heapType != addr.getType())
+      addr = fir::ConvertOp::create(builder, loc, heapType, addr);
+    fir::FreeMemOp::create(builder, loc, addr);
+    return true;
+  }
+
+  // Nothing to do for other categories by default, they are stack allocated.
+  return true;
+}
+
+template bool OpenACCMappableModel<fir::BaseBoxType>::generatePrivateDestroy(
+    mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
+    mlir::Value privatized) const;
+template bool OpenACCMappableModel<fir::ReferenceType>::generatePrivateDestroy(
+    mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
+    mlir::Value privatized) const;
+template bool OpenACCMappableModel<fir::HeapType>::generatePrivateDestroy(
+    mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
+    mlir::Value privatized) const;
+template bool OpenACCMappableModel<fir::PointerType>::generatePrivateDestroy(
+    mlir::Type type, mlir::OpBuilder &builder, mlir::Location loc,
+    mlir::Value privatized) const;
 
 } // namespace fir::acc

flang/test/HLFIR/as_expr-codegen.fir

@@ -13,8 +13,8 @@ func.func @char_expr(%addr: !fir.ref<!fir.char<1,?>>, %len: index) {
 // CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "c"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
 // CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_1]] : index) {bindc_name = ".tmp"}
 // CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[VAL_1]] {uniq_name = ".tmp"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
-// CHECK:  %[[VAL_5:.*]] = arith.constant false
 // CHECK:  hlfir.assign %[[VAL_2]]#0 to %[[VAL_4]]#0 temporary_lhs : !fir.boxchar<1>, !fir.boxchar<1>
+// CHECK:  %[[VAL_5:.*]] = arith.constant false
 // CHECK:  %[[VAL_6:.*]] = fir.undefined tuple<!fir.boxchar<1>, i1>
 // CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_5]], [1 : index] : (tuple<!fir.boxchar<1>, i1>, i1) -> tuple<!fir.boxchar<1>, i1>
 // CHECK:  %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_4]]#0, [0 : index] : (tuple<!fir.boxchar<1>, i1>, !fir.boxchar<1>) -> tuple<!fir.boxchar<1>, i1>
@@ -30,8 +30,8 @@ func.func @char_expr_2(%addr: !fir.ref<!fir.char<1,10>>, %len: index) {
 // CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".tmp"}
 // CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "c"} : (!fir.ref<!fir.char<1,10>>, index) -> (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>)
 // CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[VAL_1]] {uniq_name = ".tmp"} : (!fir.ref<!fir.char<1,10>>, index) -> (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>)
-// CHECK:  %[[VAL_5:.*]] = arith.constant false
 // CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_4]]#0 temporary_lhs : !fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>
+// CHECK:  %[[VAL_5:.*]] = arith.constant false
 // CHECK:  %[[VAL_6:.*]] = fir.undefined tuple<!fir.ref<!fir.char<1,10>>, i1>
 // CHECK:  %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_5]], [1 : index] : (tuple<!fir.ref<!fir.char<1,10>>, i1>, i1) -> tuple<!fir.ref<!fir.char<1,10>>, i1>
 // CHECK:  %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_4]]#0, [0 : index] : (tuple<!fir.ref<!fir.char<1,10>>, i1>, !fir.ref<!fir.char<1,10>>) -> tuple<!fir.ref<!fir.char<1,10>>, i1>
@@ -47,8 +47,8 @@ func.func @shape_from_type(%arg0 : !fir.ref<!fir.array<10x20xi32>>) {
 // CHECK:    %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
 // CHECK:    %[[VAL_4:.*]] = fir.allocmem !fir.array<10x20xi32> {bindc_name = ".tmp", uniq_name = ""}
 // CHECK:    %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_3]]) {uniq_name = ".tmp"} : (!fir.heap<!fir.array<10x20xi32>>, !fir.shape<2>) -> (!fir.heap<!fir.array<10x20xi32>>, !fir.heap<!fir.array<10x20xi32>>)
-// CHECK:    %[[VAL_5:.*]] = arith.constant true
 // CHECK:    hlfir.assign %[[VAL_0]] to %[[VAL_6]]#0 temporary_lhs : !fir.ref<!fir.array<10x20xi32>>, !fir.heap<!fir.array<10x20xi32>>
+// CHECK:    %[[VAL_5:.*]] = arith.constant true
 // CHECK:    %[[VAL_7:.*]] = fir.undefined tuple<!fir.heap<!fir.array<10x20xi32>>, i1>
 // CHECK:    %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_5]], [1 : index] : (tuple<!fir.heap<!fir.array<10x20xi32>>, i1>, i1) -> tuple<!fir.heap<!fir.array<10x20xi32>>, i1>
 // CHECK:    %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_6]]#0, [0 : index] : (tuple<!fir.heap<!fir.array<10x20xi32>>, i1>, !fir.heap<!fir.array<10x20xi32>>) -> tuple<!fir.heap<!fir.array<10x20xi32>>, i1>
@@ -66,8 +66,8 @@ func.func @shape_from_box(%arg0 : !fir.box<!fir.array<10x?xi32>>) {
 // CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_1]], %[[VAL_3]]#1 : (index, index) -> !fir.shape<2>
 // CHECK:    %[[VAL_5:.*]] = fir.allocmem !fir.array<10x?xi32>, %[[VAL_3]]#1 {bindc_name = ".tmp", uniq_name = ""}
 // CHECK:    %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_5]](%[[VAL_4]]) {uniq_name = ".tmp"} : (!fir.heap<!fir.array<10x?xi32>>, !fir.shape<2>) -> (!fir.box<!fir.array<10x?xi32>>, !fir.heap<!fir.array<10x?xi32>>)
-// CHECK:    %[[VAL_6:.*]] = arith.constant true
 // CHECK:    hlfir.assign %[[VAL_0]] to %[[VAL_7]]#0 temporary_lhs : !fir.box<!fir.array<10x?xi32>>, !fir.box<!fir.array<10x?xi32>>
+// CHECK:    %[[VAL_6:.*]] = arith.constant true
 // CHECK:    %[[VAL_8:.*]] = fir.undefined tuple<!fir.box<!fir.array<10x?xi32>>, i1>
 // CHECK:    %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_6]], [1 : index] : (tuple<!fir.box<!fir.array<10x?xi32>>, i1>, i1) -> tuple<!fir.box<!fir.array<10x?xi32>>, i1>
 // CHECK:    %[[VAL_10:.*]] = fir.insert_value %[[VAL_9]], %[[VAL_7]]#0, [0 : index] : (tuple<!fir.box<!fir.array<10x?xi32>>, i1>, !fir.box<!fir.array<10x?xi32>>) -> tuple<!fir.box<!fir.array<10x?xi32>>, i1>