diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -144,7 +144,7 @@ return symbol.attrs().test(Attr::ALLOCATABLE); } inline bool IsAllocatableOrPointer(const Symbol &symbol) { - return IsPointer(symbol) || IsAllocatable(symbol); + return IsPointer(symbol.GetUltimate()) || IsAllocatable(symbol.GetUltimate()); } inline bool IsNamedConstant(const Symbol &symbol) { return symbol.attrs().test(Attr::PARAMETER); 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,12 +569,15 @@ 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) ? hSymType : symType, + mangleName(sym), toStringRef(sym.GetUltimate().name()), /*pinned=*/true, shape, typeParams, sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET)); return allocVal; @@ -603,7 +606,8 @@ // Allocate storage for a pointer/allocatble descriptor. // No shape/lengths to be passed to the alloca. return fir::MutableBoxValue(allocate({}, {}), - box.nonDeferredLenParams(), {}); + box.nonDeferredLenParams(), + box.getMutableProperties()); }, [&](const auto &) -> fir::ExtendedValue { mlir::Value temp = @@ -629,6 +633,7 @@ } } } + return bindIfNewSymbol(sym, exv); } @@ -652,10 +657,11 @@ // 3) Perform the assignment. mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint(); - if (copyAssignIP && copyAssignIP->isSet()) + if (copyAssignIP && copyAssignIP->isSet()) { builder->restoreInsertionPoint(*copyAssignIP); - else + } else { builder->setInsertionPointAfter(fir::getBase(exv).getDefiningOp()); + } fir::ExtendedValue lhs, rhs; if (copyAssignIP && copyAssignIP->isSet() && @@ -670,23 +676,68 @@ 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(); + + // set insertion point inbetween + builder->setInsertionPointAfter(if_builder.getIfOp()); + } 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)); + auto op = builder->create(loc, loadVal, fir::getBase(lhs)); + builder->setInsertionPointAfter(op); } if (copyAssignIP && copyAssignIP->isSet() && - sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) + sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) { builder->restoreInsertionPoint(insPt); + } } //===--------------------------------------------------------------------===// @@ -938,9 +989,9 @@ 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); + // if (const auto *box = exv.getBoxOf()) + // return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(), + // *box); return exv; } 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 @@ -129,7 +129,8 @@ bool success = converter.createHostAssociateVarClone(*sym); (void)success; assert(success && "Privatization failed due to existing binding"); - if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate)) { + if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate) || + sym->test(Fortran::semantics::Symbol::Flag::OmpPrivate)) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::OpBuilder::InsertPoint firstPrivIP, insPt; if (mlir::isa(op)) { @@ -138,11 +139,13 @@ firstPrivIP = firOpBuilder.saveInsertionPoint(); } converter.copyHostAssociateVar(*sym, &firstPrivIP); - if (mlir::isa(op)) + if (mlir::isa(op)) { firOpBuilder.restoreInsertionPoint(insPt); + } } - if (sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) + if (sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) { converter.copyHostAssociateVar(*sym, lastPrivIP); + } } void DataSharingProcessor::collectOmpObjectListSymbol( 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()