[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.

717–721

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

746

This is probably not needed.

749–752

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

166–177

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

178–180

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

749–752

The flang code style diverges unfortunately.

[clementval]

flang/lib/Lower/Bridge.cpp

749–752

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

717–721

reverted

746

Removed

749–752

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

flang/lib/Lower/OpenMP.cpp

166–177

reverted

178–180

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

725–727

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

725–727

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/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);
         });
 
+    // 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 (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)) {

flang/lib/Lower/OpenMP.cpp

class DataSharingProcessor {
   void privatize();
   void defaultPrivatize();
   void copyLastPrivatize(mlir::Operation *op);
   void insertLastPrivateCompare(mlir::Operation *op);
   void cloneSymbol(const Fortran::semantics::Symbol *sym);
   void copyFirstPrivateSymbol(const Fortran::semantics::Symbol *sym);
   void copyLastPrivateSymbol(const Fortran::semantics::Symbol *sym,
                              mlir::OpBuilder::InsertPoint *lastPrivIP);
+  void insertDeallocs();
 
 public:
   DataSharingProcessor(Fortran::lower::AbstractConverter &converter,
                        const Fortran::parser::OmpClauseList &opClauseList,
                        Fortran::lower::pft::Evaluation &eval)
       : hasLastPrivateOp(false), converter(converter),
         firOpBuilder(converter.getFirOpBuilder()), opClauseList(opClauseList),
         eval(eval) {}
   // Privatisation is split into two steps.
   // Step1 performs cloning of all privatisation clauses and copying for
   // firstprivates. Step1 is performed at the place where process/processStep1
   // is called. This is usually inside the Operation corresponding to the OpenMP
   // construct, for looping constructs this is just before the Operation. The
   // split into two steps was performed basically to be able to call
   // privatisation for looping constructs before the operation is created since
-  // the bounds of the MLIR OpenMP operation can be privatised. Step2 performs
-  // the copying for lastprivates. Step2 requires knowledge of the MLIR
-  // operation to insert the last private update.
-  bool process(mlir::Operation *op);
+  // the bounds of the MLIR OpenMP operation can be privatised.
+  // Step2 performs the copying for lastprivates and requires knowledge of the
+  // MLIR operation to insert the last private update. Step2 adds
+  // dealocation code as well.
   void processStep1();
-  bool processStep2(mlir::Operation *op);
+  void processStep2(mlir::Operation *op, bool is_loop);
 };
 
-bool DataSharingProcessor::process(mlir::Operation *op) {
-  processStep1();
-  assert(op && "Current MLIR operation not set");
-  return processStep2(op);
-}
-
 void DataSharingProcessor::processStep1() {
   collectSymbolsForPrivatization();
   collectDefaultSymbols();
   privatize();
   defaultPrivatize();
   insertBarrier();
 }
 
-bool DataSharingProcessor::processStep2(mlir::Operation *op) {
+void DataSharingProcessor::processStep2(mlir::Operation *op, bool is_loop) {
   insPt = firOpBuilder.saveInsertionPoint();
   copyLastPrivatize(op);
   firOpBuilder.restoreInsertionPoint(insPt);
-  return hasLastPrivateOp;
+
+  if (is_loop) {
+    // push deallocs out of the loop
+    firOpBuilder.setInsertionPointAfter(op);
+    insertDeallocs();
+  } else {
+    // insert dummy instruction to mark the insertion position
+    mlir::Value undefMarker = firOpBuilder.create<fir::UndefOp>(
+        op->getLoc(), firOpBuilder.getIndexType());
+    insertDeallocs();
+    firOpBuilder.setInsertionPointAfter(undefMarker.getDefiningOp());
+  }
+}
+
+void DataSharingProcessor::insertDeallocs() {
+  for (auto sym : privatizedSymbols)
+    if (Fortran::semantics::IsAllocatable(sym->GetUltimate())) {
+      converter.createHostAssociateVarCloneDealloc(*sym);
+    }
 }
 
 void DataSharingProcessor::cloneSymbol(const Fortran::semantics::Symbol *sym) {
   // Privatization for symbols which are pre-determined (like loop index
   // variables) happen separately, for everything else privatize here.
   if (sym->test(Fortran::semantics::Symbol::Flag::OmpPreDetermined))
     return;
   bool success = converter.createHostAssociateVarClone(*sym);
   (void)success;
   assert(success && "Privatization failed due to existing binding");
 }
 
 void DataSharingProcessor::copyFirstPrivateSymbol(
     const Fortran::semantics::Symbol *sym) {
   if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate))
     converter.copyHostAssociateVar(*sym);
 }
 
 void DataSharingProcessor::copyLastPrivateSymbol(
     const Fortran::semantics::Symbol *sym,
     [[maybe_unused]] mlir::OpBuilder::InsertPoint *lastPrivIP) {
   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,
   // Insert the terminator.
   if constexpr (std::is_same_v<Op, omp::WsLoopOp> ||
                 std::is_same_v<Op, omp::SimdLoopOp>) {
     mlir::ValueRange results;
     firOpBuilder.create<mlir::omp::YieldOp>(loc, results);
   } else {
     firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
   }
-
   // 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) {
-    bool lastPrivateOp = false;
+    constexpr bool is_loop = std::is_same_v<Op, omp::WsLoopOp> ||
+                             std::is_same_v<Op, omp::SimdLoopOp>;
     if (!dsp) {
-      dsp = new DataSharingProcessor(converter, *clauses, eval);
-      lastPrivateOp = dsp->process(op);
-      delete dsp;
-    } else {
-      lastPrivateOp = dsp->processStep2(op);
-    }
-    // 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);
+      DataSharingProcessor proc(converter, *clauses, eval);
+      proc.processStep1();
+      proc.processStep2(op, is_loop);
+    } else {
+      dsp->processStep2(op, is_loop);
+    }
+
+    if (storeOp)
+      firOpBuilder.setInsertionPointAfter(storeOp);
   }
 
   if constexpr (std::is_same_v<Op, omp::ParallelOp>) {
     threadPrivatizeVars(converter, eval);
     if (clauses)
       genCopyinClause(converter, *clauses);
   }
 }
 

flang/lib/Semantics/check-call.cpp

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.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"}) {
+!FIRDialect:    {{%.*}} = 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"}
+!FIRDialect:    omp.parallel   {
+!FIRDialect:      {{%.*}} = 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"}
+!FIRDialect:      omp.single   {
+
+!FIRDialect:         omp.terminator
+!FIRDialect:       omp.terminator
+!FIRDialect:    return
+
+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"}
+
+!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"}
+
+!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
+
+
+!FIRDialect-LABEL: func @_QPsimple_loop_1()
+subroutine simple_loop_1
+  integer :: i
+  real, allocatable :: r;
+  ! FIRDialect:  omp.parallel
+  !$OMP PARALLEL PRIVATE(r)
+  ! FIRDialect:     %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned}
+
+  ! FIRDialect:     [[R:%.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"}
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+  ! FIRDialect:     %[[WS_LB:.*]] = arith.constant 1 : i32
+  ! FIRDialect:     %[[WS_UB:.*]] = arith.constant 9 : i32
+  ! FIRDialect:     %[[WS_STEP:.*]] = arith.constant 1 : i32
+
+  ! FIRDialect:     omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]])
+  !$OMP DO
+  do i=1, 9
+  ! FIRDialect:     fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref<i32>
+  ! FIRDialect:     %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref<i32>
+  ! FIRDialect:     fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1
+    print*, i
+  end do
+  ! FIRDialect:     omp.yield
+  ! FIRDialect:     {{%.*}} = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.if {{%.*}} {
+  ! FIRDialect:     [[LD:%.*]] = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+  ! FIRDialect:     fir.freemem [[AD]] : !fir.heap<f32>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  !$OMP END DO
+  ! FIRDialect:  omp.terminator
+  !$OMP END PARALLEL
+end subroutine
+
+!FIRDialect-LABEL: func @_QPsimple_loop_2()
+subroutine simple_loop_2
+  integer :: i
+  real, allocatable :: r;
+  ! FIRDialect:  omp.parallel
+  !$OMP PARALLEL
+  ! FIRDialect:     %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned}
+
+  ! FIRDialect:     [[R:%.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"}
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+  ! FIRDialect:     %[[WS_LB:.*]] = arith.constant 1 : i32
+  ! FIRDialect:     %[[WS_UB:.*]] = arith.constant 9 : i32
+  ! FIRDialect:     %[[WS_STEP:.*]] = arith.constant 1 : i32
+
+  ! FIRDialect:     omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]])
+  !$OMP DO PRIVATE(r)
+  do i=1, 9
+  ! FIRDialect:     fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref<i32>
+  ! FIRDialect:     %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref<i32>
+  ! FIRDialect:     fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1
+    print*, i
+  end do
+  ! FIRDialect:     omp.yield
+  ! FIRDialect:     {{%.*}} = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.if {{%.*}} {
+  ! FIRDialect:     [[LD:%.*]] = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+  ! FIRDialect:     fir.freemem [[AD]] : !fir.heap<f32>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  !$OMP END DO
+  ! FIRDialect:  omp.terminator
+  !$OMP END PARALLEL
+end subroutine
+
+!FIRDialect-LABEL: func @_QPsimple_loop_3()
+subroutine simple_loop_3
+  integer :: i
+  real, allocatable :: r;
+  ! FIRDialect:  omp.parallel
+  ! FIRDialect:     %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned}
+
+  ! FIRDialect:     [[R:%.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"}
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+  ! FIRDialect:     %[[WS_LB:.*]] = arith.constant 1 : i32
+  ! FIRDialect:     %[[WS_UB:.*]] = arith.constant 9 : i32
+  ! FIRDialect:     %[[WS_STEP:.*]] = arith.constant 1 : i32
+
+  ! FIRDialect:     omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]])
+  !$OMP PARALLEL DO PRIVATE(r)
+  do i=1, 9
+  ! FIRDialect:     fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref<i32>
+  ! FIRDialect:     %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref<i32>
+  ! FIRDialect:     fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1
+    print*, i
+  end do
+  ! FIRDialect:     omp.yield
+  ! FIRDialect:     {{%.*}} = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.if {{%.*}} {
+  ! FIRDialect:     [[LD:%.*]] = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+  ! FIRDialect:     fir.freemem [[AD]] : !fir.heap<f32>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  !$OMP END PARALLEL DO
+  ! FIRDialect:  omp.terminator
+end subroutine
+
+!CHECK-LABEL: func @_QPsimd_loop_1()
+subroutine simd_loop_1
+  integer :: i
+  real, allocatable :: r;
+  ! IRDialect:     [[R:%.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"}
+  ! IRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! IRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+
+  ! FIRDialect:     %[[LB:.*]] = arith.constant 1 : i32
+  ! FIRDialect:     %[[UB:.*]] = arith.constant 9 : i32
+  ! FIRDialect:     %[[STEP:.*]] = arith.constant 1 : i32
+
+  ! FIRDialect: omp.simdloop for (%[[I:.*]]) : i32 = (%[[LB]]) to (%[[UB]]) inclusive step (%[[STEP]]) {
+  !$OMP SIMD PRIVATE(r)
+  do i=1, 9
+  ! FIRDialect:     fir.store %[[I]] to %[[LOCAL:.*]] : !fir.ref<i32>
+  ! FIRDialect:     %[[LOAD_IV:.*]] = fir.load %[[LOCAL]] : !fir.ref<i32>
+  ! FIRDialect:     fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1
+    print*, i
+  end do
+  !$OMP END SIMD
+  ! FIRDialect:     omp.yield
+  ! FIRDialect:     {{%.*}} = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     fir.if {{%.*}} {
+  ! FIRDialect:     [[LD:%.*]] = fir.load [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+  ! FIRDialect:     [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+  ! FIRDialect:     fir.freemem [[AD]] : !fir.heap<f32>
+  ! FIRDialect:     fir.store {{%.*}} to [[R]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+end subroutine