[flang-commits] [flang] [flang] Preserve dynamic length of characters in ALLOCATE (PR #152564)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

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

Author: Leandro Lupori (luporl)

<details>
<summary>Changes</summary>

Fixes #<!-- -->151895


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


2 Files Affected:

- (modified) flang/lib/Lower/Allocatable.cpp (+10) 
- (added) flang/test/Lower/OpenMP/private-character.f90 (+35) 


``````````diff
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 15cd9770b35ba..90e79dca29491 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -484,6 +484,16 @@ class AllocateStmtHelper {
       return;
     }
 
+    // Preserve characters' dynamic length.
+    if (lenParams.empty() && box.isCharacter() &&
+        !box.hasNonDeferredLenParams()) {
+      auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy());
+      if (charTy && charTy.hasDynamicLen()) {
+        fir::ExtendedValue exv{box};
+        lenParams.push_back(fir::factory::readCharLen(builder, loc, exv));
+      }
+    }
+
     // Generate a sequence of runtime calls.
     errorManager.genStatCheck(builder, loc);
     genAllocateObjectInit(box, allocatorIdx);
diff --git a/flang/test/Lower/OpenMP/private-character.f90 b/flang/test/Lower/OpenMP/private-character.f90
new file mode 100644
index 0000000000000..3f0a5bb81cc38
--- /dev/null
+++ b/flang/test/Lower/OpenMP/private-character.f90
@@ -0,0 +1,35 @@
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+!CHECK-LABEL: func @_QPtest_dynlen_char_ptr
+!CHECK:         omp.parallel private(@{{.*}} %{{.*}}#0 -> %[[A:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) {
+!CHECK:           %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_dynlen_char_ptrEa"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
+!CHECK:           %[[A_VAL:.*]] = fir.load %[[A_DECL]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+!CHECK:           %[[LEN:.*]] = fir.box_elesize %[[A_VAL]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+!CHECK:           %[[A_BOX_NONE:.*]] = fir.convert %[[A_DECL]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+!CHECK:           %[[LEN_I64:.*]] = fir.convert %[[LEN]] : (index) -> i64
+!CHECK:           fir.call @_FortranAPointerNullifyCharacter(%[[A_BOX_NONE]], %[[LEN_I64]], {{.*}})
+subroutine test_dynlen_char_ptr(i)
+  character(i), pointer :: a
+
+  !$omp parallel private(a)
+    allocate(a)
+    a = "abc"
+  !$omp end parallel
+end subroutine
+
+!CHECK-LABEL: func @_QPtest_dynlen_char_ptr_array
+!CHECK:         omp.parallel private(@{{.*}} %{{.*}}#0 -> %[[A:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) {
+!CHECK:           %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_dynlen_char_ptr_arrayEa"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>)
+!CHECK:           %[[A_VAL:.*]] = fir.load %[[A_DECL]]#0
+!CHECK:           %[[LEN:.*]] = fir.box_elesize %[[A_VAL]]
+!CHECK:           %[[A_BOX_NONE:.*]] = fir.convert %[[A_DECL]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
+!CHECK:           %[[LEN_I64:.*]] = fir.convert %[[LEN]] : (index) -> i64
+!CHECK:           fir.call @_FortranAPointerNullifyCharacter(%[[A_BOX_NONE]], %[[LEN_I64]], {{.*}})
+subroutine test_dynlen_char_ptr_array(i)
+  character(i), pointer :: a(:)
+
+  !$omp parallel private(a)
+    allocate(a(i))
+    a = "abc"
+  !$omp end parallel
+end subroutine

``````````

</details>


https://github.com/llvm/llvm-project/pull/152564