[flang-commits] [flang] [flang][OpenMP] Handle fixed length `charater`s in delayed privatization (PR #126704)

[Kareem Ergawy via flang-commits]

https://github.com/ergawy updated https://github.com/llvm/llvm-project/pull/126704

>From dd9335c605ae1128f7b7aa305e00fae37e38668a Mon Sep 17 00:00:00 2001
From: ergawy <kareem.ergawy at amd.com>
Date: Tue, 11 Feb 2025 03:22:34 -0600
Subject: [PATCH] [flang][OpenMP] Handle fixed length `charater`s in delayed
 privatization

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.
---
 .../include/flang/Optimizer/Dialect/FIRType.h |  4 ++++
 .../Lower/OpenMP/PrivateReductionUtils.cpp    | 20 +++++++++++++------
 flang/lib/Optimizer/Dialect/FIRType.cpp       |  9 +++++++++
 .../OpenMP/parallel-private-clause-str.f90    | 16 +++++++++++++++
 4 files changed, 43 insertions(+), 6 deletions(-)

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..ed89861a52cb849 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())
-      lenParams.resize(0);
-  }
+  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..0a30d4beeb69a08 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