[flang][Lower] get ultimate symbol when querying if pointer or alloca…

…table (#99528) This fixes a bug in OpenMP privatisation. The privatised variables are created as though they are host associated clones of the original variables. These privatised variables do not contain the allocatable attribute themselves and so we need to check if the ultimate symbol is allocatable. Having or not having this flag influences whether lowering determines that this is a whole allocatable assignment, which then causes hlfir.assign not to get the realloc flag, which cases the allocatable not to be allocated when it is assigned to (leading to a segfault running the newly added test). I also did the same for pointer variables because I would imagine they could experience the same issue. There is no fallout on tests outside of OpenMP, and the gfortran test suite still passes, so I think this doesn't break host other kinds of host associated symbols.
llvm · Jul 19, 2024 · a56f37d · a56f37d
1 parent 9ba5244
commit a56f37d
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 9 deletions.
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
@@ -1104,14 +1104,14 @@ void Fortran::lower::associateMutableBox(
 bool Fortran::lower::isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
   if (const Fortran::semantics::Symbol *sym =
           Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr))
-    return Fortran::semantics::IsAllocatable(*sym);
+    return Fortran::semantics::IsAllocatable(sym->GetUltimate());
   return false;
 }
 
 bool Fortran::lower::isWholePointer(const Fortran::lower::SomeExpr &expr) {
   if (const Fortran::semantics::Symbol *sym =
           Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr))
-    return Fortran::semantics::IsPointer(*sym);
+    return Fortran::semantics::IsPointer(sym->GetUltimate());
   return false;
 }
 

diff --git a/flang/test/Lower/OpenMP/firstprivate-allocatable.f90 b/flang/test/Lower/OpenMP/firstprivate-allocatable.f90
@@ -0,0 +1,25 @@
+! RUN: bbc -emit-hlfir -fopenmp -o - %s | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s | FileCheck %s
+
+program firstprivateallocatable
+  Integer, Allocatable :: a,u
+  a = 137
+
+  !$omp parallel firstprivate(a,u)
+  u = a**2
+  !$omp end parallel
+end program
+
+
+! CHECK-LABEL:   func.func @_QQmain()
+! [...]
+! CHECK:           omp.parallel {
+! [...]
+! CHECK:             %[[VAL_50:.*]] = arith.constant 2 : i32
+! CHECK:             %[[VAL_51:.*]] = math.ipowi %{{.*}}, %[[VAL_50]] : i32
+! this is what we are really checking: the hlfir.assign must have realloc so that
+! u is allocated when the assignment occurs
+! CHECK:             hlfir.assign %[[VAL_51]] to %{{.*}}#0 realloc : i32, !fir.ref<!fir.box<!fir.heap<i32>>>
+! [...]
+! CHECK:             omp.terminator
+! CHECK:           }
diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90
@@ -244,8 +244,7 @@ program reduce15
 ! CHECK:                   %[[VAL_85:.*]] = arith.select %[[VAL_84]], %[[VAL_76]], %[[VAL_83]] : i32
 ! CHECK:                   hlfir.yield_element %[[VAL_85]] : i32
 ! CHECK:                 }
-! CHECK:                 %[[VAL_86:.*]] = fir.load %[[VAL_62]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
-! CHECK:                 hlfir.assign %[[VAL_68]] to %[[VAL_86]] : !hlfir.expr<?xi32>, !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK:                 hlfir.assign %[[VAL_68]] to %[[VAL_62]]#0 realloc : !hlfir.expr<?xi32>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
 ! CHECK:                 hlfir.destroy %[[VAL_68]] : !hlfir.expr<?xi32>
 ! CHECK:                 omp.yield
 ! CHECK:               }
@@ -288,8 +287,7 @@ program reduce15
 ! CHECK:                   %[[VAL_117:.*]] = arith.select %[[VAL_116]], %[[VAL_108]], %[[VAL_115]] : i32
 ! CHECK:                   hlfir.yield_element %[[VAL_117]] : i32
 ! CHECK:                 }
-! CHECK:                 %[[VAL_118:.*]] = fir.load %[[VAL_94]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
-! CHECK:                 hlfir.assign %[[VAL_100]] to %[[VAL_118]] : !hlfir.expr<?xi32>, !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK:                 hlfir.assign %[[VAL_100]] to %[[VAL_94]]#0 realloc : !hlfir.expr<?xi32>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
 ! CHECK:                 hlfir.destroy %[[VAL_100]] : !hlfir.expr<?xi32>
 ! CHECK:                 omp.yield
 ! CHECK:               }

diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-allocatable.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-allocatable.f90
@@ -85,9 +85,7 @@ program reduce
 ! CHECK:                 %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14]] {fortran_attrs = {{.*}}<allocatable>, uniq_name = "_QFEr"} : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<!fir.box<!fir.heap<i32>>>)
 ! CHECK:                 fir.store %[[VAL_15]] to %[[VAL_10]]#1 : !fir.ref<i32>
 ! CHECK:                 %[[VAL_17:.*]] = fir.load %[[VAL_10]]#0 : !fir.ref<i32>
-! CHECK:                 %[[VAL_18:.*]] = fir.load %[[VAL_16]]#0 : !fir.ref<!fir.box<!fir.heap<i32>>>
-! CHECK:                 %[[VAL_19:.*]] = fir.box_addr %[[VAL_18]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
-! CHECK:                 hlfir.assign %[[VAL_17]] to %[[VAL_19]] : i32, !fir.heap<i32>
+! CHECK:                 hlfir.assign %[[VAL_17]] to %[[VAL_16]]#0 realloc : i32, !fir.ref<!fir.box<!fir.heap<i32>>>
 ! CHECK:                 omp.yield
 ! CHECK:               }
 ! CHECK:               omp.terminator