Skip to content

Commit d0ef94b

Browse files
kiranchandramohankiranchandramohan
committed
Revert "Revert "[Flang][OpenMP] Fix to support privatisation of alloc strings (#71204)""
This reverts commit ba116ff. This relands #71204 with a fix in the test.
1 parent 011f25a commit d0ef94b

File tree

2 files changed

+80
-10
lines changed

2 files changed

+80
-10
lines changed

‎flang/lib/Lower/Bridge.cpp

Lines changed: 19 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -677,18 +677,27 @@ class FirConverter : public Fortran::lower::AbstractConverter {
677677
if (auto seqTy = symType.dyn_cast<fir::SequenceType>()) {
678678
fir::ExtendedValue read = fir::factory::genMutableBoxRead(
679679
*builder, loc, box, /*mayBePolymorphic=*/false);
680-
auto read_box = read.getBoxOf<fir::ArrayBoxValue>();
681-
fir::factory::genInlinedAllocation(
682-
*builder, loc, *new_box, read_box->getLBounds(),
683-
read_box->getExtents(),
684-
/*lenParams=*/std::nullopt, name,
685-
/*mustBeHeap=*/true);
680+
if (auto read_arr_box = read.getBoxOf<fir::ArrayBoxValue>()) {
681+
fir::factory::genInlinedAllocation(
682+
*builder, loc, *new_box, read_arr_box->getLBounds(),
683+
read_arr_box->getExtents(),
684+
/*lenParams=*/std::nullopt, name,
685+
/*mustBeHeap=*/true);
686+
} else if (auto read_char_arr_box =
687+
read.getBoxOf<fir::CharArrayBoxValue>()) {
688+
fir::factory::genInlinedAllocation(
689+
*builder, loc, *new_box, read_char_arr_box->getLBounds(),
690+
read_char_arr_box->getExtents(),
691+
read_char_arr_box->getLen(), name,
692+
/*mustBeHeap=*/true);
693+
} else {
694+
TODO(loc, "Unhandled allocatable box type");
695+
}
686696
} else {
687697
fir::factory::genInlinedAllocation(
688-
*builder, loc, *new_box,
689-
new_box->getMutableProperties().lbounds,
690-
new_box->getMutableProperties().extents,
691-
/*lenParams=*/std::nullopt, name,
698+
*builder, loc, *new_box, box.getMutableProperties().lbounds,
699+
box.getMutableProperties().extents,
700+
box.nonDeferredLenParams(), name,
692701
/*mustBeHeap=*/true);
693702
}
694703
});

‎flang/test/Lower/OpenMP/parallel-private-clause-str.f90

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
! This test checks lowering of OpenMP parallel Directive with
2+
! `PRIVATE` clause present for strings
3+
4+
! REQUIRES: shell
5+
! RUN: bbc -fopenmp -emit-hlfir %s -o - | FileCheck %s
6+
!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s
7+
8+
!CHECK: func.func @_QPtest_allocatable_string(%{{.*}}: !fir.ref<i32> {fir.bindc_name = "n"}) {
9+
!CHECK: %[[C_BOX_REF:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {bindc_name = "c", uniq_name = "_QFtest_allocatable_stringEc"}
10+
!CHECK: %[[C_DECL:.*]]:2 = hlfir.declare %[[C_BOX_REF]] typeparams %{{.*}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_allocatable_stringEc"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>, i32) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>)
11+
!CHECK: omp.parallel {
12+
!CHECK: %[[C_PVT_BOX_REF:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {bindc_name = "c", pinned, uniq_name = "_QFtest_allocatable_stringEc"}
13+
!CHECK: %[[C_BOX:.*]] = fir.load %[[C_DECL]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
14+
!CHECK: fir.if %{{.*}} {
15+
!CHECK: %[[C_PVT_MEM:.*]] = fir.allocmem !fir.char<1,?>(%{{.*}} : index) {fir.must_be_heap = true, uniq_name = "_QFtest_allocatable_stringEc.alloc"}
16+
!CHECK: %[[C_PVT_BOX:.*]] = fir.embox %[[C_PVT_MEM]] typeparams %{{.*}} : (!fir.heap<!fir.char<1,?>>, index) -> !fir.box<!fir.heap<!fir.char<1,?>>>
17+
!CHECK: fir.store %[[C_PVT_BOX]] to %[[C_PVT_BOX_REF]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
18+
!CHECK: }
19+
!CHECK: %[[C_PVT_DECL:.*]]:2 = hlfir.declare %[[C_PVT_BOX_REF]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_allocatable_stringEc"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>)
20+
!CHECK: fir.if %{{.*}} {
21+
!CHECK: %[[C_PVT_BOX:.*]] = fir.load %[[C_PVT_DECL]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
22+
!CHECK: %[[C_PVT_BOX_ADDR:.*]] = fir.box_addr %[[C_PVT_BOX]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
23+
!CHECK: fir.freemem %[[C_PVT_BOX_ADDR]] : !fir.heap<!fir.char<1,?>>
24+
!CHECK: }
25+
!CHECK: omp.terminator
26+
!CHECK: }
27+
subroutine test_allocatable_string(n)
28+
character(n), allocatable :: c
29+
!$omp parallel private(c)
30+
!$omp end parallel
31+
end subroutine
32+
33+
!CHECK: func.func @_QPtest_allocatable_string_array(%{{.*}}: !fir.ref<i32> {fir.bindc_name = "n"}) {
34+
!CHECK: %0:2 = hlfir.declare %arg0 {uniq_name = "_QFtest_allocatable_string_arrayEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
35+
!CHECK: %[[C_BOX_REF:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {bindc_name = "c", uniq_name = "_QFtest_allocatable_string_arrayEc"}
36+
!CHECK: %[[C_BOX:.*]] = fir.embox %{{.*}}(%{{.*}}) typeparams %{{.*}} : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, i32) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
37+
!CHECK: fir.store %[[C_BOX]] to %[[C_BOX_REF]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
38+
!CHECK: %[[C_DECL:.*]]:2 = hlfir.declare %[[C_BOX_REF]] typeparams %{{.*}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_allocatable_string_arrayEc"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, i32) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>)
39+
!CHECK: omp.parallel {
40+
!CHECK: %[[C_PVT_BOX_REF:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {bindc_name = "c", pinned, uniq_name = "_QFtest_allocatable_string_arrayEc"}
41+
!CHECK: %{{.*}} = fir.load %[[C_DECL]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
42+
!CHECK: fir.if %{{.*}} {
43+
!CHECK: %[[C_PVT_ALLOC:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%{{.*}} : index), %{{.*}} {fir.must_be_heap = true, uniq_name = "_QFtest_allocatable_string_arrayEc.alloc"}
44+
!CHECK: %[[C_PVT_BOX:.*]] = fir.embox %[[C_PVT_ALLOC]](%{{.*}}) typeparams %{{.*}} : (!fir.heap<!fir.array<?x!fir.char<1,?>>>, !fir.shapeshift<1>, index) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
45+
!CHECK: fir.store %[[C_PVT_BOX]] to %[[C_PVT_BOX_REF]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
46+
!CHECK: }
47+
!CHECK: %[[C_PVT_DECL:.*]]:2 = hlfir.declare %[[C_PVT_BOX_REF]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_allocatable_string_arrayEc"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>)
48+
!CHECK: %{{.*}} = fir.load %[[C_PVT_DECL]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
49+
!CHECK: fir.if %{{.*}} {
50+
!CHECK: %[[C_PVT_BOX:.*]] = fir.load %[[C_PVT_DECL]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
51+
!CHECK: %[[C_PVT_ADDR:.*]] = fir.box_addr %[[C_PVT_BOX]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
52+
!CHECK: fir.freemem %[[C_PVT_ADDR]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
53+
!CHECK: }
54+
!CHECK: omp.terminator
55+
!CHECK: }
56+
57+
subroutine test_allocatable_string_array(n)
58+
character(n), allocatable :: c(:)
59+
!$omp parallel private(c)
60+
!$omp end parallel
61+
end subroutine

0 commit comments

Comments
 (0)