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

diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index e19fcde8d0e64..1e637895d8e99 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -276,6 +276,13 @@ inline mlir::Type unwrapPassByRefType(mlir::Type t) {
   return t;
 }
 
+/// Extracts the innermost type, T, **potentially** wrapped inside:
+///   <fir.[ref|ptr|heap] <fir.[ref|ptr|heap|box] <fir.array<T>>>
+///
+/// Any element absent from the above pattern does not affect the returned
+/// value: T.
+mlir::Type getFortranElementType(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 951293b133677..fe08d59c0ef75 100644
--- a/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp
+++ b/flang/lib/Lower/OpenMP/PrivateReductionUtils.cpp
@@ -194,15 +194,11 @@ static void getLengthParameters(fir::FirOpBuilder &builder, mlir::Location loc,
   if (lenParams.empty())
     return;
 
-  // 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 = mlir::dyn_cast<fir::CharacterType>(
+      fir::getFortranElementType(moldArg.getType()));
+
+  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 67d918cc0f41c..49f0e53fa113d 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -426,6 +426,11 @@ mlir::Type unwrapAllRefAndSeqType(mlir::Type ty) {
   }
 }
 
+mlir::Type getFortranElementType(mlir::Type ty) {
+  return fir::unwrapSequenceType(
+      fir::unwrapPassByRefType(fir::unwrapRefType(ty)));
+}
+
 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 44cb08e029aa1..d8403fbbaa510 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