[flang-commits] [flang] [flang] fix private pointers and default initialized variables (PR #118494)
via flang-commits
flang-commits at lists.llvm.org
Tue Dec 3 06:59:35 PST 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-openmp
Author: None (jeanPerier)
<details>
<summary>Changes</summary>
Both OpenMP privatization and DO CONCURRENT LOCAL lowering was incorrect for pointers and derived type with default initialization.
For pointers, the descriptor was not established with the rank/type code/element size, leading to undefined behavior if any inquiry was made to it prior to a pointer assignment (and if/when using the runtime for pointer assignments, the descriptor must have been established).
For derived type with default initialization, the copies were not default initialized.
---
Full diff: https://github.com/llvm/llvm-project/pull/118494.diff
4 Files Affected:
- (modified) flang/lib/Lower/Bridge.cpp (+29-5)
- (added) flang/test/Lower/OpenMP/delayed-privatization-default-init.f90 (+27)
- (modified) flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 (+3)
- (added) flang/test/Lower/do_concurrent_local_default_init.f90 (+52)
``````````diff
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 77003eff190e26..d6a2a15d5d84ba 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -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<fir::MutableBoxValue>();
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 diassociated 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<fir::StoreOp>(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<fir::MutableBoxValue>();
+ // Copy allocation status of Allocatables, creating new storage if
+ // needed.
// allocate if allocated
mlir::Value isAllocated =
@@ -822,7 +830,20 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if_builder.end();
},
[&](const auto &) -> void {
- // Do nothing
+ // 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);
@@ -1985,6 +2006,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
sym->detailsIf<Fortran::semantics::HostAssocDetails>();
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/test/Lower/OpenMP/delayed-privatization-default-init.f90 b/flang/test/Lower/OpenMP/delayed-privatization-default-init.f90
new file mode 100644
index 00000000000000..9574bade413bb1
--- /dev/null
+++ b/flang/test/Lower/OpenMP/delayed-privatization-default-init.f90
@@ -0,0 +1,27 @@
+! 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 firstprivate(a)
+ call do_something(a%i)
+ !$omp end parallel
+end subroutine
+! CHECK-LABEL: omp.private {type = firstprivate} @_QFdelayed_privatization_default_initEa_firstprivate_ref_rec__QFdelayed_privatization_default_initTt : !fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>> alloc {
+! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>):
+! 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.type<_QFdelayed_privatization_default_initTt{i:i32}>>) -> !fir.box<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>) -> !fir.box<none>
+! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]],{{.*}}
+! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFdelayed_privatization_default_initEa"} : (!fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>) -> (!fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>, !fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>)
+! CHECK: omp.yield(%[[VAL_9]]#0 : !fir.ref<!fir.type<_QFdelayed_privatization_default_initTt{i:i32}>>)
+! CHECK: }
diff --git a/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90 b/flang/test/Lower/OpenMP/delayed-privatization-pointer.f90
index 796e4720c8c954..c96b0b49fd5307 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<!fir.ptr<i32>> {bindc_name = "var1", pinned, uniq_name = "_QFdelayed_privatization_pointerEvar1"}
+! CHECK-NEXT: %[[NULL:.*]] = fir.zero_bits !fir.ptr<i32>
+! CHECK-NEXT: %[[INIT:.*]] = fir.embox %[[NULL]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK-NEXT: fir.store %[[INIT]] to %[[PRIV_ALLOC]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
! CHECK-NEXT: %[[PRIV_DECL:.*]]:2 = hlfir.declare %[[PRIV_ALLOC]]
! CHECK-NEXT: omp.yield(%[[PRIV_DECL]]#0 : [[TYPE]])
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 00000000000000..16d95071776514
--- /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(p)
+ type t
+ integer :: i = 2
+ end type
+ integer :: i, res(4)
+ type(t) :: a
+ do concurrent (i=1:4) local(a)
+ res = a%i
+ end do
+ call something(res)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_ptr(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "p"}) {
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+! CHECK: %[[VAL_7:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
+! CHECK: fir.do_loop
+! CHECK: %[[VAL_16:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {bindc_name = "p", pinned, uniq_name = "_QFtest_ptrEp"}
+! CHECK: %[[VAL_17:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,?>>>
+! 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.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+! CHECK: fir.store %[[VAL_20]] to %[[VAL_16]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %[[VAL_16]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptrEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>)
+! CHECK: fir.call @_QPtakes_ptr(%[[VAL_21]]#0) proc_attrs<pure> fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()
+! 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.type<_QFtest_default_initTt{i:i32}>>) -> !fir.box<!fir.type<_QFtest_default_initTt{i:i32}>>
+! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_27]] : (!fir.box<!fir.type<_QFtest_default_initTt{i:i32}>>) -> !fir.box<none>
+! CHECK: %[[VAL_32:.*]] = fir.call @_FortranAInitialize(%[[VAL_30]], {{.*}}
+! CHECK: %[[VAL_33:.*]]:2 = hlfir.declare %[[VAL_26]] {uniq_name = "_QFtest_default_initEa"} : (!fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>) -> (!fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>, !fir.ref<!fir.type<_QFtest_default_initTt{i:i32}>>)
+! CHECK: }
``````````
</details>
https://github.com/llvm/llvm-project/pull/118494
More information about the flang-commits
mailing list