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

[via flang-commits]

Author: Leandro Lupori
Date: 2025-08-19T09:25:08-03:00
New Revision: ddb36a8102a7c841a50a5eeebd8401815fb0ccf7

URL: https://github.com/llvm/llvm-project/commit/ddb36a8102a7c841a50a5eeebd8401815fb0ccf7
DIFF: https://github.com/llvm/llvm-project/commit/ddb36a8102a7c841a50a5eeebd8401815fb0ccf7.diff

LOG: [flang] Preserve dynamic length of characters in ALLOCATE (#152564)

Fixes #151895

Added: 
    flang/test/Lower/OpenMP/private-character.f90

Modified: 
    flang/lib/Lower/Allocatable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index ce9d8944387e1..444b5b6c7c4b1 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -490,6 +490,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