[Flang][OpenMP] Lower allocatable or pointer in private clause

[d-smirnov]

Summary

This patch lowers allocatables and pointers named in "private" OpenMP clause.

[clementval]

Can you add the context to your patch.

[d-smirnov]

Handling private clause for allocatables

[d-smirnov]

Added epilogue

[clementval]

I see that this is WIP but I guess since you put it on phab it is to get some reviews. There are couple of places where you don't follow the llvm guidlines.

flang/lib/Lower/Bridge.cpp

610–611

This change is not needed.

735–739

Not needed change and the code is already following the guidelines.

805

This is probably not needed.

808–811

Don't brace on simple single statement bodies.

https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements

flang/lib/Lower/OpenMP.cpp

140–143

https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements

144–146

https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements

[tschuett]

flang/lib/Lower/Bridge.cpp

808–811

The flang code style diverges unfortunately.

[clementval]

flang/lib/Lower/Bridge.cpp

808–811

In lowering it does not. At least not on this point.

[d-smirnov]

Small refactoring

[d-smirnov]

Linter

flang/lib/Lower/Bridge.cpp

610–611

reverted

735–739

reverted

805

Removed

808–811

I believe a wrapped condition of the "if" statement here affects readability

flang/lib/Lower/OpenMP.cpp

140–143

reverted

144–146

reverted

[kiranchandramohan]

Thanks @d-smirnov for the patch and for addressing the comments from Valentin.

Could you check whether the following issues are fixed by this patch?
https://github.com/llvm/llvm-project/issues/61453
https://github.com/llvm/llvm-project/issues/61876
https://github.com/llvm/llvm-project/issues/61199
https://github.com/llvm/llvm-project/issues/60871
https://github.com/flang-compiler/f18-llvm-project/issues/1229
https://github.com/flang-compiler/f18-llvm-project/issues/1171#issuecomment-955180002

[d-smirnov]

+ pointers

[d-smirnov]

Linter + bugfix

[d-smirnov]

Linter

[d-smirnov]

Rebased

[kiranchandramohan]

flang/lib/Lower/Bridge.cpp

631

There seems to be some very similar code in line 739 onwards. Can this be refactored and shared?

[d-smirnov]

refactored

[kiranchandramohan]

Some minor comments for tests. Looking mostly OK.

flang/lib/Lower/Bridge.cpp

12

Nit: Accidental change.

flang/lib/Lower/OpenMP.cpp

670–672

Nit: braces not required.

flang/test/Lower/OpenMP/parallel-private-clause.f90

184–233

There is a lot of code here that is not being checked. Can the additional code be removed if they are not checked. Also, only check what is relevant.

371

Nit: Use capital letters for capture variables (like r here).

390

The dealloc check for this is missing.

[d-smirnov]

addressed change requests

flang/lib/Lower/Bridge.cpp

12

reverted

631

Looks like I accidentally left the copied code here. Removed

flang/lib/Lower/OpenMP.cpp

670–672

removed

flang/test/Lower/OpenMP/parallel-private-clause.f90

184–233

removed

371

Amended

390

Added

[kiranchandramohan]

LG.

flang/include/flang/Lower/AbstractConverter.h

public:
   /// Get the code defined by a label
   virtual pft::Evaluation *lookupLabel(pft::Label label) = 0;
 
   /// For a given symbol which is host-associated, create a clone using
   /// parameters from the host-associated symbol.
   virtual bool
   createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0;
 
+  virtual void
+  createHostAssociateVarCloneDealloc(const Fortran::semantics::Symbol &sym) = 0;
+
   virtual void copyHostAssociateVar(
       const Fortran::semantics::Symbol &sym,
       mlir::OpBuilder::InsertPoint *copyAssignIP = nullptr) = 0;
 
   /// Collect the set of symbols with \p flag in \p eval
   /// region if \p collectSymbols is true. Likewise, collect the
   /// set of the host symbols with \p flag of the associated symbols in \p eval
   /// region if collectHostAssociatedSymbols is true.

flang/include/flang/Lower/OpenMP.h

 //===-- Lower/OpenMP.h -- lower Open MP directives --------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_OPENMP_H
 #define FORTRAN_LOWER_OPENMP_H
 
+#include "flang/Lower/SymbolMap.h"
 #include <cinttypes>
 
 namespace mlir {
 class Value;
 class Operation;
 } // namespace mlir
 
 namespace fir {

 
 namespace pft {
 struct Evaluation;
 struct Variable;
 } // namespace pft
 
 void genOpenMPConstruct(AbstractConverter &, pft::Evaluation &,
                         const parser::OpenMPConstruct &);
+void genOpenMPEpilogue(AbstractConverter &, Fortran::lower::SymMap &,
+                       const parser::OpenMPConstruct &);
 void genOpenMPDeclarativeConstruct(AbstractConverter &, pft::Evaluation &,
                                    const parser::OpenMPDeclarativeConstruct &);
 int64_t getCollapseValue(const Fortran::parser::OmpClauseList &clauseList);
 void genThreadprivateOp(AbstractConverter &, const pft::Variable &);
 void genOpenMPReduction(AbstractConverter &,
                         const Fortran::parser::OmpClauseList &clauseList);
 
 mlir::Operation *findReductionChain(mlir::Value, mlir::Value * = nullptr);
 fir::ConvertOp getConvertFromReductionOp(mlir::Operation *, mlir::Value);
 void updateReduction(mlir::Operation *, fir::FirOpBuilder &, mlir::Value,
                      mlir::Value, fir::ConvertOp * = nullptr);
 void removeStoreOp(mlir::Operation *, mlir::Value);
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_OPENMP_H

flang/include/flang/Lower/SymbolMap.h

public:
 
   std::optional<fir::FortranVariableOpInterface>
   lookupVariableDefinition(semantics::SymbolRef sym) {
     if (auto symBox = lookupSymbol(sym))
       return symBox.getIfFortranVariableOpInterface();
     return std::nullopt;
   }
 
+  llvm::DenseMap<const semantics::Symbol *, SymbolBox>::const_iterator
+  scope_begin() const {
+    return symbolMapStack.back().begin();
+  }
+
+  llvm::DenseMap<const semantics::Symbol *, SymbolBox>::const_iterator
+  scope_end() const {
+    return symbolMapStack.back().end();
+  }
+
 private:
   /// Add `symbol` to the current map and bind a `box`.
   void makeSym(semantics::SymbolRef symRef, const SymbolBox &box,
                bool force = false) {
     const auto *sym = &symRef.get().GetUltimate();
     if (force)
       symbolMapStack.back().erase(sym);
     assert(box && "cannot add an undefined symbol box");

flang/lib/Evaluate/tools.cpp

if (auto fromType{expr.GetType()}) {
     }
   }
   return std::nullopt;
 }
 
 bool IsAllocatableOrPointerObject(
     const Expr<SomeType> &expr, FoldingContext &context) {
   const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
-  return (sym && semantics::IsAllocatableOrPointer(*sym)) ||
+  return (sym && semantics::IsAllocatableOrPointer(sym->GetUltimate())) ||
       evaluate::IsObjectPointer(expr, context);
 }
 
 bool IsAllocatableDesignator(const Expr<SomeType> &expr) {
   // Allocatable sub-objects are not themselves allocatable (9.5.3.1 NOTE 2).
   if (const semantics::Symbol *
       sym{UnwrapWholeSymbolOrComponentOrCoarrayRef(expr)}) {
     return semantics::IsAllocatable(sym->GetUltimate());

flang/lib/Lower/Bridge.cpp

 //===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/Allocatable.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/Coarray.h"
 #include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertType.h"
public:
 
   bool createHostAssociateVarClone(
       const Fortran::semantics::Symbol &sym) override final {
     mlir::Location loc = genLocation(sym.name());
     mlir::Type symType = genType(sym);
     const auto *details = sym.detailsIf<Fortran::semantics::HostAssocDetails>();
     assert(details && "No host-association found");
     const Fortran::semantics::Symbol &hsym = details->symbol();
+    mlir::Type hSymType = genType(hsym);
     Fortran::lower::SymbolBox hsb = lookupSymbol(hsym);
 
     auto allocate = [&](llvm::ArrayRef<mlir::Value> shape,
                         llvm::ArrayRef<mlir::Value> typeParams) -> mlir::Value {
       mlir::Value allocVal = builder->allocateLocal(
-          loc, symType, mangleName(sym), toStringRef(sym.GetUltimate().name()),
+          loc,
+          Fortran::semantics::IsAllocatableOrPointer(hsym.GetUltimate())
+              ? hSymType
+              : symType,
+          mangleName(sym), toStringRef(sym.GetUltimate().name()),
           /*pinned=*/true, shape, typeParams,
           sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET));
       return allocVal;
     };
 
-    fir::ExtendedValue hexv = getExtendedValue(hsb);
+    fir::ExtendedValue hexv = symBoxToExtendedValue(hsb);
     fir::ExtendedValue exv = hexv.match(
         [&](const fir::BoxValue &box) -> fir::ExtendedValue {
           const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
           if (type && type->IsPolymorphic())
             TODO(loc, "create polymorphic host associated copy");
           // Create a contiguous temp with the same shape and length as
           // the original variable described by a fir.box.
           llvm::SmallVector<mlir::Value> extents =
               fir::factory::getExtents(loc, *builder, hexv);
           if (box.isDerivedWithLenParameters())
             TODO(loc, "get length parameters from derived type BoxValue");
           if (box.isCharacter()) {
             mlir::Value len = fir::factory::readCharLen(*builder, loc, box);
             mlir::Value temp = allocate(extents, {len});
             return fir::CharArrayBoxValue{temp, len, extents};
           }
           return fir::ArrayBoxValue{allocate(extents, {}), extents};
         },
         [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
           // Allocate storage for a pointer/allocatble descriptor.
           // No shape/lengths to be passed to the alloca.
-          return fir::MutableBoxValue(allocate({}, {}),
-                                      box.nonDeferredLenParams(), {});
+          return fir::MutableBoxValue(allocate({}, {}), {}, {});
         },
         [&](const auto &) -> fir::ExtendedValue {
           mlir::Value temp =
               allocate(fir::factory::getExtents(loc, *builder, hexv),
                        fir::factory::getTypeParams(loc, *builder, hexv));
           return fir::substBase(hexv, temp);
         });
 
     // Replace all uses of the original with the clone/copy,
     // esepcially for loop bounds (that uses the variable being privatised)
     // since loop bounds use old values that need to be fixed by using the
     // new copied value.
     // Not able to use replaceAllUsesWith() because uses outside
     // the loop body should not use the clone.
     // FIXME: Call privatization before the loop operation.
     mlir::Region &curRegion = getFirOpBuilder().getRegion();
     mlir::Value oldVal = fir::getBase(hexv);
     mlir::Value cloneVal = fir::getBase(exv);
     for (auto &oper : curRegion.getOps()) {
       for (unsigned int ii = 0; ii < oper.getNumOperands(); ++ii) {
         if (oper.getOperand(ii) == oldVal) {
           oper.setOperand(ii, cloneVal);
         }
       }
     }
+
+    // Initialise cloned allocatable
+    hexv.match(
+        [&](const fir::MutableBoxValue &box) -> void {
+          // Do not process pointers
+          if (Fortran::semantics::IsPointer(sym.GetUltimate())) {
+            return;
+          }
+          // Allocate storage for a pointer/allocatble descriptor.
+          // No shape/lengths to be passed to the alloca.
+          const auto new_box = exv.getBoxOf<fir::MutableBoxValue>();
+
+          // allocate if allocated
+          mlir::Value isAllocated =
+              fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc, box);
+          auto if_builder = builder->genIfThenElse(loc, isAllocated);
+          if_builder.genThen([&]() {
+            std::string name = mangleName(sym) + ".alloc";
+            if (auto seqTy = symType.dyn_cast<fir::SequenceType>()) {
+              fir::ExtendedValue read = fir::factory::genMutableBoxRead(
+                  *builder, loc, box, /*mayBePolymorphic=*/false);
+              auto read_box = read.getBoxOf<fir::ArrayBoxValue>();
+              fir::factory::genInlinedAllocation(
+                  *builder, loc, *new_box, read_box->getLBounds(),
+                  read_box->getExtents(),
+                  /*lenParams=*/std::nullopt, name,
+                  /*mustBeHeap=*/true);
+            } else {
+              fir::factory::genInlinedAllocation(
+                  *builder, loc, *new_box,
+                  new_box->getMutableProperties().lbounds,
+                  new_box->getMutableProperties().extents,
+                  /*lenParams=*/std::nullopt, name,
+                  /*mustBeHeap=*/true);
+            }
+          });
+          if_builder.genElse([&]() {
+            // nullify box
+            auto empty = fir::factory::createUnallocatedBox(
+                *builder, loc, new_box->getBoxTy(),
+                new_box->nonDeferredLenParams(), {});
+            builder->create<fir::StoreOp>(loc, empty, new_box->getAddr());
+          });
+          if_builder.end();
+        },
+        [&](const auto &) -> void {
+          // Do nothing
+        });
+
     return bindIfNewSymbol(sym, exv);
   }
 
+  void createHostAssociateVarCloneDealloc(
+      const Fortran::semantics::Symbol &sym) override final {
+    mlir::Location loc = genLocation(sym.name());
+    Fortran::lower::SymbolBox hsb = lookupSymbol(sym);
+
+    fir::ExtendedValue hexv = symBoxToExtendedValue(hsb);
+    hexv.match(
+        [&](const fir::MutableBoxValue &new_box) -> void {
+          // Do not process pointers
+          if (Fortran::semantics::IsPointer(sym.GetUltimate())) {
+            return;
+          }
+          // deallocate allocated in createHostAssociateVarClone value
+          mlir::Value needs_dealloc =
+              fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc,
+                                                           new_box);
+          builder->genIfThen(loc, needs_dealloc)
+              .genThen([&]() {
+                Fortran::lower::genDeallocateBox(*this, new_box, loc);
+              })
+              .end();
+        },
+        [&](const auto &) -> void {
+          // Do nothing
+        });
+  }
+
   void copyHostAssociateVar(
       const Fortran::semantics::Symbol &sym,
       mlir::OpBuilder::InsertPoint *copyAssignIP = nullptr) override final {
     // 1) Fetch the original copy of the variable.
     assert(sym.has<Fortran::semantics::HostAssocDetails>() &&
            "No host-association found");
     const Fortran::semantics::Symbol &hsym = sym.GetUltimate();
     Fortran::lower::SymbolBox hsb = lookupOneLevelUpSymbol(hsym);
     assert(hsb && "Host symbol box not found");
-    fir::ExtendedValue hexv = getExtendedValue(hsb);
+    fir::ExtendedValue hexv = symBoxToExtendedValue(hsb);
 
     // 2) Fetch the copied one that will mask the original.
     Fortran::lower::SymbolBox sb = shallowLookupSymbol(sym);
     assert(sb && "Host-associated symbol box not found");
     assert(hsb.getAddr() != sb.getAddr() &&
            "Host and associated symbol boxes are the same");
-    fir::ExtendedValue exv = getExtendedValue(sb);
+    fir::ExtendedValue exv = symBoxToExtendedValue(sb);
 
     // 3) Perform the assignment.
     mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint();
     if (copyAssignIP && copyAssignIP->isSet())
       builder->restoreInsertionPoint(*copyAssignIP);
     else
       builder->setInsertionPointAfter(fir::getBase(exv).getDefiningOp());
 
     fir::ExtendedValue lhs, rhs;
     if (copyAssignIP && copyAssignIP->isSet() &&
         sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) {
       // lastprivate case
       lhs = hexv;
       rhs = exv;
     } else {
       lhs = exv;
       rhs = hexv;
     }
 
     mlir::Location loc = genLocation(sym.name());
     mlir::Type symType = genType(sym);
+
+    if (const auto box = rhs.getBoxOf<fir::MutableBoxValue>()) {
+      const auto new_box = lhs.getBoxOf<fir::MutableBoxValue>();
+      // allocate if allocated
+      mlir::Value isAllocated =
+          fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc, *box);
+      auto if_builder = builder->genIfThenElse(loc, isAllocated);
+      if_builder.genThen([&]() {
+        std::string name = mangleName(sym) + ".alloc";
         if (auto seqTy = symType.dyn_cast<fir::SequenceType>()) {
+          fir::ExtendedValue read = fir::factory::genMutableBoxRead(
+              *builder, loc, *box, /*mayBePolymorphic=*/false);
+          auto read_box = read.getBoxOf<fir::ArrayBoxValue>();
+          fir::factory::genInlinedAllocation(*builder, loc, *new_box,
+                                             read_box->getLBounds(),
+                                             read_box->getExtents(),
+                                             /*lenParams=*/std::nullopt, name,
+                                             /*mustBeHeap=*/true);
+        } else {
+          fir::factory::genInlinedAllocation(
+              *builder, loc, *new_box, new_box->getMutableProperties().lbounds,
+              new_box->getMutableProperties().extents,
+              /*lenParams=*/std::nullopt, name,
+              /*mustBeHeap=*/true);
+        }
+      });
+      if_builder.genElse([&]() {
+        // nullify box
+        auto empty = fir::factory::createUnallocatedBox(
+            *builder, loc, new_box->getBoxTy(), new_box->nonDeferredLenParams(),
+            {});
+        builder->create<fir::StoreOp>(loc, empty, new_box->getAddr());
+      });
+      if_builder.end();
+
+      // and deallocate then
+      mlir::Value needs_dealloc =
+          fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc, *new_box);
+      builder->genIfThen(loc, needs_dealloc)
+          .genThen(
+              [&]() { Fortran::lower::genDeallocateBox(*this, *new_box, loc); })
+          .end();
+    } else if (auto seqTy = symType.dyn_cast<fir::SequenceType>()) {
       Fortran::lower::StatementContext stmtCtx;
       Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols,
                                                 stmtCtx);
       stmtCtx.finalizeAndReset();
     } else if (hexv.getBoxOf<fir::CharBoxValue>()) {
       fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs);
-    } else if (hexv.getBoxOf<fir::MutableBoxValue>()) {
-      TODO(loc, "firstprivatisation of allocatable variables");
     } else {
       auto loadVal = builder->create<fir::LoadOp>(loc, fir::getBase(rhs));
       builder->create<fir::StoreOp>(loc, loadVal, fir::getBase(lhs));
     }
 
     if (copyAssignIP && copyAssignIP->isSet() &&
-        sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate))
+        sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) {
       builder->restoreInsertionPoint(insPt);
     }
+  }
 
   //===--------------------------------------------------------------------===//
   // Utility methods
   //===--------------------------------------------------------------------===//
 
   void collectSymbolSet(
       Fortran::lower::pft::Evaluation &eval,
       llvm::SetVector<const Fortran::semantics::Symbol *> &symbolSet,
private:
   bool mapBlockArgToDummyOrResult(const Fortran::semantics::SymbolRef sym,
                                   mlir::Value val, bool forced = false) {
     if (!forced && lookupSymbol(sym))
       return false;
     localSymbols.addSymbol(sym, val, forced);
     return true;
   }
 
-  fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) {
-    fir::ExtendedValue exv = symBoxToExtendedValue(sb);
-    // Dereference pointers and allocatables.
-    if (const auto *box = exv.getBoxOf<fir::MutableBoxValue>())
-      return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(),
-                                             *box);
-    return exv;
-  }
-
   /// Generate the address of loop variable \p sym.
   /// If \p sym is not mapped yet, allocate local storage for it.
   mlir::Value genLoopVariableAddress(mlir::Location loc,
                                      const Fortran::semantics::Symbol &sym,
                                      bool isUnordered) {
     if (isUnordered || sym.has<Fortran::semantics::HostAssocDetails>() ||
         sym.has<Fortran::semantics::UseDetails>()) {
       if (!shallowLookupSymbol(sym)) {
void genFIR(const Fortran::parser::OpenMPConstruct &omp) {
     }
 
     for (Fortran::lower::pft::Evaluation &e : curEval->getNestedEvaluations())
       genFIR(e);
 
     if (ompLoop)
       genOpenMPReduction(*this, *loopOpClauseList);
 
+    genOpenMPEpilogue(*this, localSymbols, omp);
     localSymbols.popScope();
     builder->restoreInsertionPoint(insertPt);
   }
 
   void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &ompDecl) {
     mlir::OpBuilder::InsertPoint insertPt = builder->saveInsertionPoint();
     genOpenMPDeclarativeConstruct(*this, getEval(), ompDecl);
     for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())

flang/lib/Lower/OpenMP.cpp

void DataSharingProcessor::privatizeSymbol(
   if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate)) {
     fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
     mlir::OpBuilder::InsertPoint firstPrivIP, insPt;
     if (mlir::isa<mlir::omp::SingleOp>(op)) {
       insPt = firOpBuilder.saveInsertionPoint();
       firOpBuilder.setInsertionPointToStart(&op->getRegion(0).front());
       firstPrivIP = firOpBuilder.saveInsertionPoint();
     }
     converter.copyHostAssociateVar(*sym, &firstPrivIP);
     if (mlir::isa<mlir::omp::SingleOp>(op))
       firOpBuilder.restoreInsertionPoint(insPt);
   }
   if (sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate))
     converter.copyHostAssociateVar(*sym, lastPrivIP);
 }
 
 void DataSharingProcessor::collectOmpObjectListSymbol(
     const Fortran::parser::OmpObjectList &ompObjectList,
     llvm::SetVector<const Fortran::semantics::Symbol *> &symbolSet) {
   for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) {
     Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject);
     symbolSet.insert(sym);
   }
createBodyOfOp(Op &op, Fortran::lower::AbstractConverter &converter,
 
   // Reset the insert point to before the terminator.
   resetBeforeTerminator(firOpBuilder, storeOp, block);
 
   // Handle privatization. Do not privatize if this is the outer operation.
   if (clauses && !outerCombined) {
     DataSharingProcessor dsp(op, converter, *clauses, eval);
     bool lastPrivateOp = dsp.process();
     // LastPrivatization, due to introduction of
     // new control flow, changes the insertion point,
     // thus restore it.
     // TODO: Clean up later a bit to avoid this many sets and resets.
     if (lastPrivateOp && !std::is_same_v<Op, omp::SectionOp>)
       resetBeforeTerminator(firOpBuilder, storeOp, block);
   }
 
   if constexpr (std::is_same_v<Op, omp::ParallelOp>) {
     threadPrivatizeVars(converter, eval);
     if (clauses)
std::visit(
           [&](const Fortran::parser::OpenMPCriticalConstruct
                   &criticalConstruct) {
             genOMP(converter, eval, criticalConstruct);
           },
       },
       ompConstruct.u);
 }
 
+void Fortran::lower::genOpenMPEpilogue(
+    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::SymMap &localSymbols,
+    const Fortran::parser::OpenMPConstruct &ompConstruct) {
+  for (auto i = localSymbols.scope_begin(); i != localSymbols.scope_end();
+       ++i) {
+    auto sym = i->first;
+    converter.createHostAssociateVarCloneDealloc(*sym);
+  }
+}
+
 void Fortran::lower::genThreadprivateOp(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::pft::Variable &var) {
   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
   mlir::Location currentLocation = converter.getCurrentLocation();
 
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   mlir::Value symThreadprivateValue;

flang/lib/Semantics/check-call.cpp

 static void CheckProcedureArg(evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc,
     const characteristics::DummyProcedure &dummy, const std::string &dummyName,
     SemanticsContext &context) {
   evaluate::FoldingContext &foldingContext{context.foldingContext()};
   parser::ContextualMessages &messages{foldingContext.messages()};
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
-  const characteristics::Procedure &interface { dummy.procedure.value() };
+  const characteristics::Procedure &interface{dummy.procedure.value()};
   if (const auto *expr{arg.UnwrapExpr()}) {
     bool dummyIsPointer{
         dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
     const auto *argProcDesignator{
         std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
     const auto *argProcSymbol{
         argProcDesignator ? argProcDesignator->GetSymbol() : nullptr};
     if (argProcSymbol) {
static void CheckAssociated(evaluate::ActualArguments &arguments,
     evaluate::FoldingContext &context, const Scope *scope) {
   bool ok{true};
   if (arguments.size() < 2) {
     return;
   }
   if (const auto &pointerArg{arguments[0]}) {
     if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
       const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)};
-      if (pointerSymbol && !IsPointer(*pointerSymbol)) {
+      if (pointerSymbol && !IsPointer(pointerSymbol->GetUltimate())) {
         evaluate::AttachDeclaration(
             context.messages().Say(pointerArg->sourceLocation(),
                 "POINTER= argument of ASSOCIATED() must be a POINTER"_err_en_US),
             *pointerSymbol);
         return;
       }
       if (const auto &targetArg{arguments[1]}) {
         // The standard requires that the POINTER= argument be a valid LHS for

flang/test/Lower/OpenMP/parallel-private-clause.f90

 end subroutine
 
 !FIRDialect: func @_QPprivate_clause_allocatable() {
 !FIRDialect-DAG:  {{.*}} = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = "x", uniq_name = "{{.*}}Ex"}
 !FIRDialect-DAG:  {{.*}} = fir.alloca !fir.heap<i32> {uniq_name = "{{.*}}Ex.addr"}
 !FIRDialect-DAG:  {{.*}} = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x2", uniq_name = "{{.*}}Ex2"}
 !FIRDialect-DAG:  {{.*}} = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "{{.*}}Ex2.addr"}
 !FIRDialect-DAG:  {{.*}} = fir.address_of(@{{.*}}Ex3) : !fir.ref<!fir.box<!fir.heap<i32>>>
-!FIRDialect-DAG:  [[TMP9:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!FIRDialect-DAG:  [[TMP8:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
 
 !FIRDialect:   omp.parallel {
-!FIRDialect-DAG:    [[TMP37:%.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"}
-!FIRDialect-DAG:    [[TMP40:%.*]] = fir.alloca !fir.array<?xi32>, {{.*}} {bindc_name = "x2", pinned, uniq_name = "{{.*}}Ex2"}
-!FIRDialect-DAG:    [[TMP41:%.*]] = fir.alloca i32 {bindc_name = "x3", pinned, uniq_name = "{{.*}}Ex3"}
-!FIRDialect-DAG:    [[TMP42:%.*]] = fir.load [[TMP9]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
-!FIRDialect-DAG:    [[TMP43:%.*]]:3 = fir.box_dims [[TMP42]], {{.*}} : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
-!FIRDialect-DAG:    [[TMP44:%.*]] = fir.alloca !fir.array<?xi32>, [[TMP43]]#1 {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"}
-!FIRDialect-DAG:    [[TMP52:%.*]] = fir.embox [[TMP40]]({{.*}}) : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>>
-!FIRDialect-DAG:    {{.*}} = fir.convert [[TMP52]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
-!FIRDialect-DAG:    [[TMP58:%.*]] = fir.shape_shift [[TMP43]]#0, [[TMP43]]#1 : (index, index) -> !fir.shapeshift<1>
-!FIRDialect-DAG:    [[TMP59:%.*]] = fir.embox [[TMP44]]([[TMP58]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>>
-!FIRDialect-DAG:    {{.*}} = fir.convert [[TMP59]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+!FIRDialect-DAG:    [[TMP35:%.*]] = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"}
+!FIRDialect-DAG:    [[TMP39:%.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x2", pinned, uniq_name = "{{.*}}Ex2"}
+!FIRDialect-DAG:    [[TMP45:%.*]] = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = "x3", pinned, uniq_name = "{{.*}}Ex3"}
+
+!FIRDialect-DAG:    [[TMP51:%.*]] = fir.load [[TMP8]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!FIRDialect-DAG:    [[TMP97:%.*]] = fir.load [[TMP8]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!FIRDialect-DAG:    [[TMP98:%.*]]:3 = fir.box_dims [[TMP97]], {{.*}} : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+!FIRDialect-DAG:    [[TMP50:%.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"}
+
+! FIRDialect-DAG:    [[TMP101:%.*]] = fir.allocmem !fir.array<?xi32>, {{.*}} {fir.must_be_heap = true, uniq_name = "{{.*}}Ex4.alloc"}
+! FIRDialect-DAG:    [[TMP102:%.*]] = fir.shape_shift {{.*}}#0, {{.*}} : (index, index) -> !fir.shapeshift<1>
+! FIRDialect-DAG:    [[TMP103:%.*]] = fir.embox [[TMP101]]([[TMP102]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! FIRDialect-DAG:  fir.store [[TMP103]] to [[TMP50]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+
 
 subroutine private_clause_allocatable()
 
         integer, allocatable :: x, x2(:)
         integer, allocatable, save :: x3, x4(:)
 
         print *, x, x2, x3, x4
 
 !$OMP PARALLEL PRIVATE(x, x2, x3, x4)
         print *, x, x2, x3, x4
 !$OMP END PARALLEL
 
 end subroutine
+
+
+!FIRDialect: func @_QPprivate_clause_real_call_allocatable() {
+!FIRDialect-DAG: {{.*}} = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "x5", uniq_name = "{{.*}}Ex5"}
+!FIRDialect-DAG: {{.*}} = fir.zero_bits !fir.heap<f32>
+!FIRDialect-DAG: {{.*}} = fir.embox %1 : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>>
+!FIRDialect-DAG: fir.store %2 to %0 : !fir.ref<!fir.box<!fir.heap<f32>>>
+!FIRDialect-DAG: omp.parallel   {
+!FIRDialect-DAG:  [[TMP203:%.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "x5", pinned, uniq_name = "{{.*}}Ex5"}
+
+!FIRDialect-DAG: fir.if %7 {
+
+!FIRDialect-DAG:   fir.store %13 to [[TMP203]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+!FIRDialect-DAG: } else {
+
+!FIRDialect-DAG:   fir.store %13 to [[TMP203]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+!FIRDialect-DAG: }
+!FIRDialect-DAG: fir.call @_QFprivate_clause_real_call_allocatablePhelper_private_clause_real_call_allocatable([[TMP203]]) fastmath<contract> : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> ()
+!FIRDialect-DAG: %8 = fir.load [[TMP203]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+!FIRDialect-DAG: fir.if %11 {
+!FIRDialect-DAG:   %12 = fir.load [[TMP203]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+!FIRDialect-DAG:     fir.store %15 to [[TMP203]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+!FIRDialect-DAG:   }
+!FIRDialect-DAG:   omp.terminator
+!FIRDialect-DAG:   }
+!FIRDialect-DAG:   return
+!FIRDialect-DAG: }
+
+
+subroutine private_clause_real_call_allocatable
+        real, allocatable :: x5
+        !$omp parallel private(x5)
+            call helper_private_clause_real_call_allocatable(x5)
+        !$omp end parallel
+    contains
+        subroutine helper_private_clause_real_call_allocatable(x6)
+            real, allocatable :: x6
+            print *, allocated(x6)
+        end subroutine
+end subroutine
+
+
+!FIRDialect: func @_QPincrement_list_items(%arg0: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>> {fir.bindc_name = "head"}) {
+!    %0 = fir.alloca !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>> {bindc_name = "p", uniq_name = "_QFincrement_list_itemsEp"}
+!    %1 = fir.zero_bits !fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>
+!    %2 = fir.embox %1 : (!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>) -> !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>
+!    fir.store %2 to %0 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!FIRDialect:   omp.parallel   {
+!      %3 = fir.alloca !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>> {bindc_name = "p", pinned, uniq_name = "_QFincrement_list_itemsEp"}
+!      %4 = fir.load %0 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!      %5 = fir.box_addr %4 : (!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>) -> !fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>
+!      %6 = fir.convert %5 : (!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>) -> i64
+!      %c0_i64 = arith.constant 0 : i64
+!      %7 = arith.cmpi ne, %6, %c0_i64 : i64
+!      fir.if %7 {
+!        %8 = fir.allocmem !fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}> {fir.must_be_heap = true, uniq_name = "_QFincrement_list_itemsEp.alloc"}
+!        %9 = fir.embox %8 : (!fir.heap<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>) -> !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>
+!        fir.store %9 to %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %10 = fir.address_of(@_QQcl.0c153402d2031df8eb5db28b6eea49b5) : !fir.ref<!fir.char<1,70>>
+!        %c8_i32 = arith.constant 8 : i32
+!        %11 = fir.convert %3 : (!fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>) -> !fir.box<none>
+!        %12 = fir.convert %10 : (!fir.ref<!fir.char<1,70>>) -> !fir.ref<i8>
+!        %13 = fir.call @_FortranAInitialize(%11, %12, %c8_i32) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
+!      } else {
+!        %8 = fir.zero_bits !fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>
+!        %9 = fir.embox %8 : (!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>) -> !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>
+!        fir.store %9 to %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!      }
+!FIRDialect:    omp.single   {
+!        %8 = fir.load %arg0 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %9 = fir.rebox %8 : (!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>) -> !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>
+!        fir.store %9 to %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        cf.br ^bb1
+!      ^bb1:  // 2 preds: ^bb0, ^bb3
+!        %10 = fir.load %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %11 = fir.field_index next, !fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>
+!        %12 = fir.coordinate_of %10, %11 : (!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %13 = fir.load %12 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %14 = fir.rebox %13 : (!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>) -> !fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>
+!        fir.store %14 to %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %15 = fir.load %3 : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>>
+!        %16 = fir.box_addr %15 : (!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>>) -> !fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>
+!        %17 = fir.convert %16 : (!fir.ptr<!fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box<!fir.ptr<!fir.type<_QFincrement_list_itemsTnode>>>}>>) -> i64
+!        %c0_i64_0 = arith.constant 0 : i64
+!        %18 = arith.cmpi ne, %17, %c0_i64_0 : i64
+!        %false = arith.constant false
+!        %19 = arith.cmpi eq, %18, %false : i1
+!        cf.cond_br %19, ^bb2, ^bb3
+!      ^bb2:  // pred: ^bb1
+!        cf.br ^bb4
+!      ^bb3:  // pred: ^bb1
+!        cf.br ^bb1
+!      ^bb4:  // pred: ^bb2
+!FIRDialect:    omp.terminator
+!FIRDialect:    }
+!FIRDialect:  omp.terminator
+!FIRDialect:  }
+!FIRDialect: return
+!FIRDialect:  }
+
+subroutine increment_list_items (head)
+  type node
+     integer :: payload
+     type (node), pointer :: next
+  end type node
+
+  type (node), pointer :: head
+  type (node), pointer :: p
+!$omp parallel private(p)
+!$omp single
+  p => head
+  do
+     p => p%next
+     if ( associated (p) .eqv. .false. ) exit
+  end do
+!$omp end single
+!$omp end parallel
+end subroutine increment_list_items
+
+!FIRDialect:  func.func @_QPparallel_pointer() {
+!FIRDialect-DAG: [[PP0:%.*]]  = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "y1", uniq_name = "{{.*}}Ey1"}
+!FIRDialect-DAG: [[PP1:%.*]]  = fir.alloca !fir.ptr<i32> {uniq_name = "{{.*}}Ey1.addr"}
+!FIRDialect-DAG: [[PP2:%.*]]  = fir.zero_bits !fir.ptr<i32>
+!FIRDialect:     fir.store [[PP2]] to [[PP1]] : !fir.ref<!fir.ptr<i32>>
+!FIRDialect-DAG: [[PP3:%.*]]  = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "y2", uniq_name = "{{.*}}Ey2"}
+!    %4 = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+!    %c0 = arith.constant 0 : index
+!    %5 = fir.shape %c0 : (index) -> !fir.shape<1>
+!    %6 = fir.embox %4(%5) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+!FIRDialect:     fir.store %6 to %3 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+!FIRDialect-DAG: [[PP7:%.*]] = fir.alloca i32 {bindc_name = "z1", fir.target, uniq_name = "{{.*}}Ez1"}
+!    %c10 = arith.constant 10 : index
+!FIRDialect-DAG: [[PP8:%.*]] = fir.alloca !fir.array<10xi32> {bindc_name = "z2", fir.target, uniq_name = "{{.*}}Ez2"}
+!FIRDialect:     omp.parallel   {
+!FIRDialect-DAG:   [[PP9:%.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "y1", pinned, uniq_name = "{{.*}}Ey1"}
+!FIRDialect-DAG:   [[PP10:%.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "y2", pinned, uniq_name = "{{.*}}Ey2"}
+!FIRDialect-DAG:   [[PP11:%.*]] = fir.embox [[PP7]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
+!FIRDialect:       fir.store [[PP11]] to [[PP9]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+!FIRDialect-DAG:   [[PP12:%.*]] = fir.shape %c{{.*}} : (index) -> !fir.shape<1>
+!FIRDialect-DAG:   [[PP13:%.*]] = fir.embox [[PP8]]([[PP12]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+!FIRDialect:       fir.store %13 to [[PP10]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+!FIRDialect:       omp.terminator
+!FIRDialect:     }
+!FIRDialect:   return
+!FIRDialect: }
+
+
+
+subroutine parallel_pointer()
+    integer, pointer :: y1, y2(:)
+    integer, target :: z1, z2(10)
+
+!$omp parallel private(y1, y2)
+  y1=>z1
+  y2=>z2
+!$omp end parallel
+end subroutine parallel_pointer