diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -101,6 +101,9 @@ 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; diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h --- a/flang/include/flang/Lower/OpenMP.h +++ b/flang/include/flang/Lower/OpenMP.h @@ -13,6 +13,7 @@ #ifndef FORTRAN_LOWER_OPENMP_H #define FORTRAN_LOWER_OPENMP_H +#include "flang/Lower/SymbolMap.h" #include namespace mlir { @@ -44,6 +45,8 @@ 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); diff --git a/flang/include/flang/Lower/SymbolMap.h b/flang/include/flang/Lower/SymbolMap.h --- a/flang/include/flang/Lower/SymbolMap.h +++ b/flang/include/flang/Lower/SymbolMap.h @@ -315,6 +315,16 @@ return std::nullopt; } + llvm::DenseMap::const_iterator + scope_begin() const { + return symbolMapStack.back().begin(); + } + + llvm::DenseMap::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, diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1158,7 +1158,7 @@ bool IsAllocatableOrPointerObject( const Expr &expr, FoldingContext &context) { const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)}; - return (sym && semantics::IsAllocatableOrPointer(*sym)) || + return (sym && semantics::IsAllocatableOrPointer(sym->GetUltimate())) || evaluate::IsObjectPointer(expr, context); } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -569,18 +569,23 @@ const auto *details = sym.detailsIf(); 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 shape, llvm::ArrayRef 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(); @@ -602,8 +607,7 @@ [&](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 = @@ -612,9 +616,84 @@ 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(); + + // 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::ExtendedValue read = fir::factory::genMutableBoxRead( + *builder, loc, box, /*mayBePolymorphic=*/false); + auto read_box = read.getBoxOf(); + 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(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 { @@ -624,14 +703,14 @@ 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(); @@ -653,23 +732,64 @@ mlir::Location loc = genLocation(sym.name()); mlir::Type symType = genType(sym); - if (auto seqTy = symType.dyn_cast()) { + + if (const auto box = rhs.getBoxOf()) { + const auto new_box = lhs.getBoxOf(); + // 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::ExtendedValue read = fir::factory::genMutableBoxRead( + *builder, loc, *box, /*mayBePolymorphic=*/false); + auto read_box = read.getBoxOf(); + 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(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()) { Fortran::lower::StatementContext stmtCtx; Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols, stmtCtx); stmtCtx.finalizeAndReset(); } else if (hexv.getBoxOf()) { fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs); - } else if (hexv.getBoxOf()) { - TODO(loc, "firstprivatisation of allocatable variables"); } else { auto loadVal = builder->create(loc, fir::getBase(rhs)); builder->create(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); + } } //===--------------------------------------------------------------------===// @@ -918,15 +1038,6 @@ return true; } - fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) { - fir::ExtendedValue exv = symBoxToExtendedValue(sb); - // Dereference pointers and allocatables. - if (const auto *box = exv.getBoxOf()) - 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, @@ -2199,6 +2310,7 @@ if (ompLoop) genOpenMPReduction(*this, *loopOpClauseList); + genOpenMPEpilogue(*this, localSymbols, omp); localSymbols.popScope(); builder->restoreInsertionPoint(insertPt); } diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -2455,6 +2455,17 @@ 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) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -1056,7 +1056,7 @@ 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), diff --git a/flang/test/Lower/OpenMP/parallel-private-clause.f90 b/flang/test/Lower/OpenMP/parallel-private-clause.f90 --- a/flang/test/Lower/OpenMP/parallel-private-clause.f90 +++ b/flang/test/Lower/OpenMP/parallel-private-clause.f90 @@ -106,20 +106,23 @@ !FIRDialect-DAG: {{.*}} = fir.alloca !fir.box>> {bindc_name = "x2", uniq_name = "{{.*}}Ex2"} !FIRDialect-DAG: {{.*}} = fir.alloca !fir.heap> {uniq_name = "{{.*}}Ex2.addr"} !FIRDialect-DAG: {{.*}} = fir.address_of(@{{.*}}Ex3) : !fir.ref>> -!FIRDialect-DAG: [[TMP9:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref>>> +!FIRDialect-DAG: [[TMP8:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref>>> !FIRDialect: omp.parallel { -!FIRDialect-DAG: [[TMP37:%.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"} -!FIRDialect-DAG: [[TMP40:%.*]] = fir.alloca !fir.array, {{.*}} {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>>> -!FIRDialect-DAG: [[TMP43:%.*]]:3 = fir.box_dims [[TMP42]], {{.*}} : (!fir.box>>, index) -> (index, index, index) -!FIRDialect-DAG: [[TMP44:%.*]] = fir.alloca !fir.array, [[TMP43]]#1 {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"} -!FIRDialect-DAG: [[TMP52:%.*]] = fir.embox [[TMP40]]({{.*}}) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box> -!FIRDialect-DAG: {{.*}} = fir.convert [[TMP52]] : (!fir.box>) -> !fir.box -!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.shapeshift<1>) -> !fir.box> -!FIRDialect-DAG: {{.*}} = fir.convert [[TMP59]] : (!fir.box>) -> !fir.box +!FIRDialect-DAG: [[TMP35:%.*]] = fir.alloca !fir.box> {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"} +!FIRDialect-DAG: [[TMP39:%.*]] = fir.alloca !fir.box>> {bindc_name = "x2", pinned, uniq_name = "{{.*}}Ex2"} +!FIRDialect-DAG: [[TMP45:%.*]] = fir.alloca !fir.box> {bindc_name = "x3", pinned, uniq_name = "{{.*}}Ex3"} + +!FIRDialect-DAG: [[TMP51:%.*]] = fir.load [[TMP8]] : !fir.ref>>> +!FIRDialect-DAG: [[TMP97:%.*]] = fir.load [[TMP8]] : !fir.ref>>> +!FIRDialect-DAG: [[TMP98:%.*]]:3 = fir.box_dims [[TMP97]], {{.*}} : (!fir.box>>, index) -> (index, index, index) +!FIRDialect-DAG: [[TMP50:%.*]] = fir.alloca !fir.box>> {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"} + +! FIRDialect-DAG: [[TMP101:%.*]] = fir.allocmem !fir.array, {{.*}} {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.shapeshift<1>) -> !fir.box>> +! FIRDialect-DAG: fir.store [[TMP103]] to [[TMP50]] : !fir.ref>>> + subroutine private_clause_allocatable() @@ -133,3 +136,162 @@ !$OMP END PARALLEL end subroutine + + +!FIRDialect: func @_QPprivate_clause_real_call_allocatable() { +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.box> {bindc_name = "x5", uniq_name = "{{.*}}Ex5"} +!FIRDialect-DAG: {{.*}} = fir.zero_bits !fir.heap +!FIRDialect-DAG: {{.*}} = fir.embox %1 : (!fir.heap) -> !fir.box> +!FIRDialect-DAG: fir.store %2 to %0 : !fir.ref>> +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: [[TMP203:%.*]] = fir.alloca !fir.box> {bindc_name = "x5", pinned, uniq_name = "{{.*}}Ex5"} + +!FIRDialect-DAG: fir.if %7 { + +!FIRDialect-DAG: fir.store %13 to [[TMP203]] : !fir.ref>> +!FIRDialect-DAG: } else { + +!FIRDialect-DAG: fir.store %13 to [[TMP203]] : !fir.ref>> +!FIRDialect-DAG: } +!FIRDialect-DAG: fir.call @_QFprivate_clause_real_call_allocatablePhelper_private_clause_real_call_allocatable([[TMP203]]) fastmath : (!fir.ref>>) -> () +!FIRDialect-DAG: %8 = fir.load [[TMP203]] : !fir.ref>> + +!FIRDialect-DAG: fir.if %11 { +!FIRDialect-DAG: %12 = fir.load [[TMP203]] : !fir.ref>> + +!FIRDialect-DAG: fir.store %15 to [[TMP203]] : !fir.ref>> +!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.bindc_name = "head"}) { +! %0 = fir.alloca !fir.box>>}>>> {bindc_name = "p", uniq_name = "_QFincrement_list_itemsEp"} +! %1 = fir.zero_bits !fir.ptr>>}>> +! %2 = fir.embox %1 : (!fir.ptr>>}>>) -> !fir.box>>}>>> +! fir.store %2 to %0 : !fir.ref>>}>>>> +!FIRDialect: omp.parallel { +! %3 = fir.alloca !fir.box>>}>>> {bindc_name = "p", pinned, uniq_name = "_QFincrement_list_itemsEp"} +! %4 = fir.load %0 : !fir.ref>>}>>>> +! %5 = fir.box_addr %4 : (!fir.box>>}>>>) -> !fir.ptr>>}>> +! %6 = fir.convert %5 : (!fir.ptr>>}>>) -> 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.must_be_heap = true, uniq_name = "_QFincrement_list_itemsEp.alloc"} +! %9 = fir.embox %8 : (!fir.heap>>}>>) -> !fir.box>>}>>> +! fir.store %9 to %3 : !fir.ref>>}>>>> +! %10 = fir.address_of(@_QQcl.0c153402d2031df8eb5db28b6eea49b5) : !fir.ref> +! %c8_i32 = arith.constant 8 : i32 +! %11 = fir.convert %3 : (!fir.ref>>}>>>>) -> !fir.box +! %12 = fir.convert %10 : (!fir.ref>) -> !fir.ref +! %13 = fir.call @_FortranAInitialize(%11, %12, %c8_i32) fastmath : (!fir.box, !fir.ref, i32) -> none +! } else { +! %8 = fir.zero_bits !fir.ptr>>}>> +! %9 = fir.embox %8 : (!fir.ptr>>}>>) -> !fir.box>>}>>> +! fir.store %9 to %3 : !fir.ref>>}>>>> +! } +!FIRDialect: omp.single { +! %8 = fir.load %arg0 : !fir.ref>>}>>>> +! %9 = fir.rebox %8 : (!fir.box>>}>>>) -> !fir.box>>}>>> +! fir.store %9 to %3 : !fir.ref>>}>>>> +! cf.br ^bb1 +! ^bb1: // 2 preds: ^bb0, ^bb3 +! %10 = fir.load %3 : !fir.ref>>}>>>> +! %11 = fir.field_index next, !fir.type<_QFincrement_list_itemsTnode{payload:i32,next:!fir.box>>}> +! %12 = fir.coordinate_of %10, %11 : (!fir.box>>}>>>, !fir.field) -> !fir.ref>>}>>>> +! %13 = fir.load %12 : !fir.ref>>}>>>> +! %14 = fir.rebox %13 : (!fir.box>>}>>>) -> !fir.box>>}>>> +! fir.store %14 to %3 : !fir.ref>>}>>>> +! %15 = fir.load %3 : !fir.ref>>}>>>> +! %16 = fir.box_addr %15 : (!fir.box>>}>>>) -> !fir.ptr>>}>> +! %17 = fir.convert %16 : (!fir.ptr>>}>>) -> 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> {bindc_name = "y1", uniq_name = "{{.*}}Ey1"} +!FIRDialect-DAG: [[PP1:%.*]] = fir.alloca !fir.ptr {uniq_name = "{{.*}}Ey1.addr"} +!FIRDialect-DAG: [[PP2:%.*]] = fir.zero_bits !fir.ptr +!FIRDialect: fir.store [[PP2]] to [[PP1]] : !fir.ref> +!FIRDialect-DAG: [[PP3:%.*]] = fir.alloca !fir.box>> {bindc_name = "y2", uniq_name = "{{.*}}Ey2"} +! %4 = fir.zero_bits !fir.ptr> +! %c0 = arith.constant 0 : index +! %5 = fir.shape %c0 : (index) -> !fir.shape<1> +! %6 = fir.embox %4(%5) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> +!FIRDialect: fir.store %6 to %3 : !fir.ref>>> +!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> {bindc_name = "y1", pinned, uniq_name = "{{.*}}Ey1"} +!FIRDialect-DAG: [[PP10:%.*]] = fir.alloca !fir.box>> {bindc_name = "y2", pinned, uniq_name = "{{.*}}Ey2"} +!FIRDialect-DAG: [[PP11:%.*]] = fir.embox [[PP7]] : (!fir.ref) -> !fir.box> +!FIRDialect: fir.store [[PP11]] to [[PP9]] : !fir.ref>> +!FIRDialect-DAG: [[PP12:%.*]] = fir.shape %c{{.*}} : (index) -> !fir.shape<1> +!FIRDialect-DAG: [[PP13:%.*]] = fir.embox [[PP8]]([[PP12]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> +!FIRDialect: fir.store %13 to [[PP10]] : !fir.ref>>> +!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