diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 583fa6fb215a7..307ba6a918777 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -118,8 +118,11 @@ class AbstractConverter { /// For a given symbol which is host-associated, create a clone using /// parameters from the host-associated symbol. + /// The clone is default initialized if its type has any default + /// initialization unless `skipDefaultInit` is set. virtual bool - createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0; + createHostAssociateVarClone(const Fortran::semantics::Symbol &sym, + bool skipDefaultInit) = 0; virtual void createHostAssociateVarCloneDealloc(const Fortran::semantics::Symbol &sym) = 0; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 77003eff190e2..40c1d00dc1c73 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -710,8 +710,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { return bool(shallowLookupSymbol(sym)); } - bool createHostAssociateVarClone( - const Fortran::semantics::Symbol &sym) override final { + bool createHostAssociateVarClone(const Fortran::semantics::Symbol &sym, + bool skipDefaultInit) override final { mlir::Location loc = genLocation(sym.name()); mlir::Type symType = genType(sym); const auto *details = sym.detailsIf(); @@ -768,13 +768,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Initialise cloned allocatable hexv.match( [&](const fir::MutableBoxValue &box) -> void { - // Do not process pointers + const auto new_box = exv.getBoxOf(); if (Fortran::semantics::IsPointer(sym.GetUltimate())) { + // Establish the pointer descriptors. The rank and type code/size + // at least must be set properly for later inquiry of the pointer + // to work, and new pointers are always given disassociated status + // by flang for safety, even if this is not required by the + // language. + auto empty = fir::factory::createUnallocatedBox( + *builder, loc, new_box->getBoxTy(), box.nonDeferredLenParams(), + {}); + builder->create(loc, empty, new_box->getAddr()); return; } - // Allocate storage for a pointer/allocatble descriptor. - // No shape/lengths to be passed to the alloca. - const auto new_box = exv.getBoxOf(); + // Copy allocation status of Allocatables, creating new storage if + // needed. // allocate if allocated mlir::Value isAllocated = @@ -822,7 +830,22 @@ class FirConverter : public Fortran::lower::AbstractConverter { if_builder.end(); }, [&](const auto &) -> void { - // Do nothing + if (skipDefaultInit) + return; + // Initialize local/private derived types with default + // initialization (Fortran 2023 section 11.1.7.5 and OpenMP 5.2 + // section 5.3). Pointer and allocatable components, when allowed, + // also need to be established so that flang runtime can later work + // with them. + if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = + sym.GetType()) + if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = + declTypeSpec->AsDerived()) + if (derivedTypeSpec->HasDefaultInitialization( + /*ignoreAllocatable=*/false, /*ignorePointer=*/false)) { + mlir::Value box = builder->createBox(loc, exv); + fir::runtime::genDerivedTypeInitialize(*builder, loc, box); + } }); return bindIfNewSymbol(sym, exv); @@ -1965,9 +1988,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::semantics::SemanticsContext &semanticsContext = bridge.getSemanticsContext(); for (const Fortran::semantics::Symbol *sym : info.localSymList) - createHostAssociateVarClone(*sym); + createHostAssociateVarClone(*sym, /*skipDefaultInit=*/false); for (const Fortran::semantics::Symbol *sym : info.localInitSymList) { - createHostAssociateVarClone(*sym); + createHostAssociateVarClone(*sym, /*skipDefaultInit=*/true); const auto *hostDetails = sym->detailsIf(); assert(hostDetails && "missing locality spec host symbol"); @@ -1985,6 +2008,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { sym->detailsIf(); copySymbolBinding(hostDetails->symbol(), *sym); } + // Note that allocatable, types with ultimate components, and type + // requiring finalization are forbidden in LOCAL/LOCAL_INIT (F2023 C1130), + // so no clean-up needs to be generated for these entities. } /// Generate FIR for a DO construct. There are six variants: diff --git a/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp b/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp index 709ac402cc702..a1c0e8f417bcd 100644 --- a/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp +++ b/flang/lib/Lower/OpenMP/DataSharingProcessor.cpp @@ -111,14 +111,11 @@ void DataSharingProcessor::insertDeallocs() { } void DataSharingProcessor::cloneSymbol(const semantics::Symbol *sym) { - bool success = converter.createHostAssociateVarClone(*sym); + bool isFirstPrivate = sym->test(semantics::Symbol::Flag::OmpFirstPrivate); + bool success = converter.createHostAssociateVarClone( + *sym, /*skipDefaultInit=*/isFirstPrivate); (void)success; assert(success && "Privatization failed due to existing binding"); - - bool isFirstPrivate = sym->test(semantics::Symbol::Flag::OmpFirstPrivate); - if (!isFirstPrivate && - Fortran::lower::hasDefaultInitialization(sym->GetUltimate())) - Fortran::lower::defaultInitializeAtRuntime(converter, *sym, *symTable); } void DataSharingProcessor::copyFirstPrivateSymbol( diff --git a/flang/test/Lower/OpenMP/delayed-privatization-default-init.f90 b/flang/test/Lower/OpenMP/delayed-privatization-default-init.f90 new file mode 100644 index 0000000000000..0eeebe0afea54 --- /dev/null +++ b/flang/test/Lower/OpenMP/delayed-privatization-default-init.f90 @@ -0,0 +1,47 @@ +! Test delayed privatization for derived types with default initialization. + +! RUN: %flang_fc1 -emit-hlfir -fopenmp -mmlir --openmp-enable-delayed-privatization \ +! RUN: -o - %s 2>&1 | FileCheck %s +! RUN: bbc -emit-hlfir -fopenmp --openmp-enable-delayed-privatization -o - %s 2>&1 |\ +! RUN: FileCheck %s + +subroutine delayed_privatization_default_init + implicit none + type t + integer :: i = 2 + end type + integer :: i, res(4) + type(t) :: a + !$omp parallel private(a) + call do_something(a%i) + !$omp end parallel +end subroutine + +subroutine delayed_privatization_default_init_firstprivate + implicit none + type t + integer :: i = 2 + end type + integer :: i, res(4) + type(t) :: a + !$omp parallel firstprivate(a) + call do_something(a%i) + !$omp end parallel +end subroutine + +! CHECK-LABEL: omp.private {type = firstprivate} @_QFdelayed_privatization_default_init_firstprivateEa_firstprivate_ref_rec__QFdelayed_privatization_default_init_firstprivateTt : !fir.ref> alloc { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref>): +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFdelayed_privatization_default_init_firstprivateTt{i:i32}> {bindc_name = "a", pinned, uniq_name = "_QFdelayed_privatization_default_init_firstprivateEa"} +! CHECK-NEXT: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFdelayed_privatization_default_init_firstprivateEa"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: omp.yield(%[[VAL_9]]#0 : !fir.ref>) +! CHECK: } + +! CHECK-LABEL: omp.private {type = private} @_QFdelayed_privatization_default_initEa_private_ref_rec__QFdelayed_privatization_default_initTt : !fir.ref> alloc { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref>): +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFdelayed_privatization_default_initTt{i:i32}> {bindc_name = "a", pinned, uniq_name = "_QFdelayed_privatization_default_initEa"} +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]],{{.*}} +! CHECK-NEXT: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFdelayed_privatization_default_initEa"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: omp.yield(%[[VAL_9]]#0 : !fir.ref>) +! CHECK: } diff --git a/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 b/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 index 796e4720c8c95..c96b0b49fd530 100644 --- a/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 +++ b/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 @@ -20,6 +20,9 @@ subroutine delayed_privatization_pointer ! CHECK-NEXT: ^bb0(%[[PRIV_ARG:.*]]: [[TYPE]]): ! CHECK-NEXT: %[[PRIV_ALLOC:.*]] = fir.alloca !fir.box> {bindc_name = "var1", pinned, uniq_name = "_QFdelayed_privatization_pointerEvar1"} +! CHECK-NEXT: %[[NULL:.*]] = fir.zero_bits !fir.ptr +! CHECK-NEXT: %[[INIT:.*]] = fir.embox %[[NULL]] : (!fir.ptr) -> !fir.box> +! CHECK-NEXT: fir.store %[[INIT]] to %[[PRIV_ALLOC]] : !fir.ref>> ! CHECK-NEXT: %[[PRIV_DECL:.*]]:2 = hlfir.declare %[[PRIV_ALLOC]] ! CHECK-NEXT: omp.yield(%[[PRIV_DECL]]#0 : [[TYPE]]) diff --git a/flang/test/Lower/OpenMP/private-derived-type.f90 b/flang/test/Lower/OpenMP/private-derived-type.f90 index af9a5b72e7175..9d680cd5d6114 100644 --- a/flang/test/Lower/OpenMP/private-derived-type.f90 +++ b/flang/test/Lower/OpenMP/private-derived-type.f90 @@ -28,14 +28,14 @@ end subroutine s4 ! CHECK: %[[VAL_15:.*]] = fir.call @_FortranAInitialize(%[[VAL_13]], %[[VAL_14]], %[[VAL_12]]) fastmath : (!fir.box, !fir.ref, i32) -> none ! CHECK: omp.parallel { ! CHECK: %[[VAL_23:.*]] = fir.alloca !fir.type<_QFs4Ty3{x:!fir.box>}> {bindc_name = "v", pinned, uniq_name = "_QFs4Ev"} -! CHECK: %[[VAL_24:.*]]:2 = hlfir.declare %[[VAL_23]] {uniq_name = "_QFs4Ev"} : (!fir.ref>}>>) -> (!fir.ref>}>>, !fir.ref>}>>) -! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_24]]#1 : (!fir.ref>}>>) -> !fir.box>}>> +! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_23]] : (!fir.ref>}>>) -> !fir.box>}>> ! CHECK: %[[VAL_26:.*]] = fir.address_of -! CHECK: %[[VAL_27:.*]] = arith.constant 4 : i32 +! CHECK: %[[VAL_27:.*]] = arith.constant 8 : i32 ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_25]] : (!fir.box>}>>) -> !fir.box ! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_26]] : (!fir.ref>) -> !fir.ref ! Check we do call FortranAInitialize on the derived type ! CHECK: %[[VAL_30:.*]] = fir.call @_FortranAInitialize(%[[VAL_28]], %[[VAL_29]], %[[VAL_27]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_24:.*]]:2 = hlfir.declare %[[VAL_23]] {uniq_name = "_QFs4Ev"} : (!fir.ref>}>>) -> (!fir.ref>}>>, !fir.ref>}>>) ! CHECK: omp.wsloop { ! CHECK: } ! CHECK: %[[VAL_39:.*]] = fir.embox %[[VAL_9]]#1 : (!fir.ref>}>>) -> !fir.box>}>> diff --git a/flang/test/Lower/do_concurrent_local_default_init.f90 b/flang/test/Lower/do_concurrent_local_default_init.f90 new file mode 100644 index 0000000000000..1766e0a104ff6 --- /dev/null +++ b/flang/test/Lower/do_concurrent_local_default_init.f90 @@ -0,0 +1,52 @@ +! Test default initialization of DO CONCURRENT LOCAL() entities. +! RUN: bbc -emit-hlfir -I nowhere -o - %s | FileCheck %s + +subroutine test_ptr(p) + interface + pure subroutine takes_ptr(p) + character(*), intent(in), pointer :: p(:) + end subroutine + end interface + character(*), pointer :: p(:) + integer :: i + do concurrent (i=1:10) local(p) + call takes_ptr(p) + end do +end subroutine + +subroutine test_default_init() + type t + integer :: i = 2 + end type + integer :: i, res(4) + type(t) :: a + do concurrent (i=1:4) local(a) + res(i) = a%i + end do + call something(res) +end subroutine +! CHECK-LABEL: func.func @_QPtest_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "p"}) { +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref>>>> +! CHECK: %[[VAL_7:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box>>>) -> index +! CHECK: fir.do_loop +! CHECK: %[[VAL_16:.*]] = fir.alloca !fir.box>>> {bindc_name = "p", pinned, uniq_name = "_QFtest_ptrEp"} +! CHECK: %[[VAL_17:.*]] = fir.zero_bits !fir.ptr>> +! CHECK: %[[VAL_18:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_18]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_17]](%[[VAL_19]]) typeparams %[[VAL_7]] : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> +! CHECK: fir.store %[[VAL_20]] to %[[VAL_16]] : !fir.ref>>>> +! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %[[VAL_16]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_ptrEp"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) +! CHECK: fir.call @_QPtakes_ptr(%[[VAL_21]]#0) proc_attrs fastmath : (!fir.ref>>>>) -> () +! CHECK: } +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func.func @_QPtest_default_init( +! CHECK: fir.do_loop +! CHECK: %[[VAL_26:.*]] = fir.alloca !fir.type<_QFtest_default_initTt{i:i32}> {bindc_name = "a", pinned, uniq_name = "_QFtest_default_initEa"} +! CHECK: %[[VAL_27:.*]] = fir.embox %[[VAL_26]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_27]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_32:.*]] = fir.call @_FortranAInitialize(%[[VAL_30]], {{.*}} +! CHECK: %[[VAL_33:.*]]:2 = hlfir.declare %[[VAL_26]] {uniq_name = "_QFtest_default_initEa"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: }