[flang][OpenMP] Handle fixed length charaters in delayed privatization

[ergawy]

We currently handle sequences of fixed-length arrays properly by not emitting length parameters for embox ops inside the omp.private op. However, we do not handle the scalar case. This PR extends getLengthParameters defined in PrivateReductionUtils.cpp to handle such cases.

Fixes issue reported in #125732.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-openmp

Author: Kareem Ergawy (ergawy)

Changes

We currently handle sequences of fixed-length arrays properly by not emitting length parameters for embox ops inside the omp.private op. However, we do not handle the scalar case. This PR extends getLengthParameters defined in PrivateReductionUtils.cpp to handle such cases.

Fixes issue reported in #125732.

---

Full diff: https://github.com/llvm/llvm-project/pull/126704.diff

4 Files Affected:

• (modified) flang/include/flang/Optimizer/Dialect/FIRType.h (+4)
• (modified) flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp (+13-5)
• (modified) flang/lib/Optimizer/Dialect/FIRType.cpp (+9)
• (modified) flang/test/Lower/OpenMP/parallel-private-clause-str.f90 (+16)

diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index e19fcde8d0e648c..52832f6cd85280b 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -276,6 +276,10 @@ inline mlir::Type unwrapPassByRefType(mlir::Type t) {
   return t;
 }
 
+/// Unwrap either a reference or a boxed reference type, returning the
+/// (possibly)-boxed and referenced type.
+mlir::Type unwrapRefOrBoxedRefType(mlir::Type ty);
+
 /// Unwrap either a sequence or a boxed sequence type, returning the element
 /// type of the sequence type.
 /// e.g.,
diff --git a/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp b/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp
index 951293b133677d3..9a7379064e511ee 100644
--- a/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp
+++ b/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp
@@ -197,12 +197,20 @@ static void getLengthParameters(fir::FirOpBuilder &builder, mlir::Location loc,
   // The verifier for EmboxOp doesn't allow length parameters when the the
   // character already has static LEN. genLengthParameters may still return them
   // in this case.
-  mlir::Type unwrappedType =
-      fir::unwrapRefType(fir::unwrapSeqOrBoxedSeqType(moldArg.getType()));
-  if (auto strTy = mlir::dyn_cast<fir::CharacterType>(unwrappedType)) {
-    if (strTy.hasConstantLen())
+  auto strTy = [&]() -> fir::CharacterType {
+      if (auto result = mlir::dyn_cast<fir::CharacterType>(
+              fir::unwrapRefOrBoxedRefType(moldArg.getType())))
+        return result;
+
+      if (auto result = mlir::dyn_cast<fir::CharacterType>(fir::unwrapRefType(
+              fir::unwrapSeqOrBoxedSeqType(moldArg.getType()))))
+        return result;
+
+      return nullptr;
+  }();
+
+  if (strTy && strTy.hasConstantLen())
       lenParams.resize(0);
-  }
 }
 
 static bool
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 67d918cc0f41c47..1684319bfae425e 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -426,6 +426,15 @@ mlir::Type unwrapAllRefAndSeqType(mlir::Type ty) {
   }
 }
 
+mlir::Type unwrapRefOrBoxedRefType(mlir::Type ty) {
+    mlir::Type eleTy;
+
+    if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(ty))
+      eleTy = boxTy.getEleTy();
+
+    return unwrapRefType(eleTy);
+}
+
 mlir::Type unwrapSeqOrBoxedSeqType(mlir::Type ty) {
   if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(ty))
     return seqTy.getEleTy();
diff --git a/flang/test/Lower/OpenMP/parallel-private-clause-str.f90 b/flang/test/Lower/OpenMP/parallel-private-clause-str.f90
index 44cb08e029aa11e..d8403fbbaa51082 100644
--- a/flang/test/Lower/OpenMP/parallel-private-clause-str.f90
+++ b/flang/test/Lower/OpenMP/parallel-private-clause-str.f90
@@ -8,6 +8,14 @@
 ! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 \
 ! RUN: | FileCheck %s
 
+!CHECK:  omp.private {type = private} @{{.*}}test_allocatable_fixed_len_stringEfixed_len_str{{.*}} init {
+!CHECK:    fir.if {{.*}} {
+!CHECK:      fir.embox %{{[^[:space:]]+}} : {{.*}}
+!CHECK:    } else {
+!CHECK:      fir.embox %{{[^[:space:]]+}} : {{.*}}
+!CHECK:    }
+!CHECK:  }
+
 !CHECK:  omp.private {type = private} @[[STR_ARR_PRIVATIZER:_QFtest_allocatable_string_arrayEc_private_box_heap_Uxc8xU]] : [[TYPE:.*]] init {
 !CHECK:  ^bb0(%[[ORIG_REF:.*]]: !fir.ref<[[TYPE]]>, %[[C_PVT_BOX_REF:.*]]: !fir.ref<[[TYPE]]>):
 !CHECK:      %{{.*}} = fir.load %[[ORIG_REF]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
@@ -73,3 +81,11 @@ subroutine test_allocatable_string_array(n)
   !$omp parallel private(c)
   !$omp end parallel
 end subroutine
+
+subroutine test_allocatable_fixed_len_string()
+  character(42), allocatable :: fixed_len_str
+  !$omp parallel do private(fixed_len_str)
+  do i = 1,10
+  end do
+  !$omp end parallel do
+end subroutine

[github-actions]

✅ With the latest revision this PR passed the C/C++ code formatter.

[jeanPerier]

Thanks for fixing this!
I think a fir::getFortranElementType helper would be more useful in general than the one added in this patch, see comment inline.

[jeanPerier]

Thank you!