shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
Fixes #151895
This commit is contained in:
Leandro Lupori 2025-08-19 09:25:08 -03:00 committed by GitHub
parent 1217c8226b
commit ddb36a8102
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 45 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
flang/lib/Lower/Allocatable.cpp
View File

@ -490,6 +490,16 @@ private:
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);

35
flang/test/Lower/OpenMP/private-character.f90 Normal file
View File

@ -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