https://gcc.gnu.org/g:5598624357ff22cdf28769550049732f3b7bb000
commit r16-9102-g5598624357ff22cdf28769550049732f3b7bb000 Author: Jerry DeLisle <[email protected]> Date: Fri Jun 5 13:19:58 2026 -0700 fortran: ALLOCATE of parameterized derived-type array initializes only first element gfc_trans_allocate passed expr->rank to gfc_allocate_pdt_comp and gfc_deallocate_pdt_comp for array allocations of parameterized derived types. For an allocate-shape-spec expression (e.g. "allocate(a(n))"), expr->rank is 0 even though the symbol is an array; the rank is carried on the symbol rather than on the allocate expression. With rank 0 the loop that initialises each element's allocatable components ran zero times, so only element zero was initialised. Subsequent accesses to elements 1..N-1 used garbage pointers and crashed. Fix: when se.expr is a GFC array descriptor, take the rank from the descriptor via GFC_TYPE_ARRAY_RANK instead of from expr->rank. Apply the same correction to the CLASS path and to the matching deallocate calls in gfc_trans_deallocate. Assisted-by: Claude Sonnet 4.6 PR fortran/125534 gcc/fortran/ChangeLog: * trans-stmt.cc (gfc_trans_allocate): Use GFC_TYPE_ARRAY_RANK from the GFC descriptor type when se.expr is a descriptor, rather than expr->rank, for the rank passed to gfc_allocate_pdt_comp. Apply the same fix to the CLASS path. (gfc_trans_deallocate): Likewise for gfc_deallocate_pdt_comp. gcc/testsuite/ChangeLog: * gfortran.dg/pdt_array_alloc_1.f90: New test. (cherry picked from commit 5f12403a8ff7d2e8a62703aa33496b514cf6af3e) Diff: --- gcc/fortran/trans-stmt.cc | 30 ++++++++++++++++++++----- gcc/testsuite/gfortran.dg/pdt_array_alloc_1.f90 | 30 +++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 49f8cd8d7ac4..c1b545fa9d1b 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -7695,8 +7695,15 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) param_list = expr->param_list; else param_list = expr->symtree->n.sym->param_list; + /* For array allocations the allocate-shape-spec expression has + rank 0 even though the symbol is an array. Use the rank from + the array descriptor when se.expr is a GFC descriptor so that + gfc_allocate_pdt_comp loops over all elements. */ + int pdt_rank = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) + ? GFC_TYPE_ARRAY_RANK (TREE_TYPE (se.expr)) + : expr->rank); tmp = gfc_allocate_pdt_comp (expr->ts.u.derived, se.expr, - expr->rank, param_list); + pdt_rank, param_list); gfc_add_expr_to_block (&block, tmp); } /* Ditto for CLASS expressions. */ @@ -7708,8 +7715,11 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) param_list = expr->param_list; else param_list = expr->symtree->n.sym->param_list; + int pdt_rank = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) + ? GFC_TYPE_ARRAY_RANK (TREE_TYPE (se.expr)) + : expr->rank); tmp = gfc_allocate_pdt_comp (CLASS_DATA (expr)->ts.u.derived, - se.expr, expr->rank, param_list); + se.expr, pdt_rank, param_list); gfc_add_expr_to_block (&block, tmp); } else if (code->expr3 && code->expr3->mold @@ -7965,10 +7975,20 @@ gfc_trans_deallocate (gfc_code *code) if (expr->ts.type == BT_DERIVED && ((expr->ts.u.derived->attr.pdt_type && param_list) || expr->ts.u.derived->attr.pdt_comp)) - tmp = gfc_deallocate_pdt_comp (expr->ts.u.derived, se.expr, expr->rank); + { + int pdt_rank = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) + ? GFC_TYPE_ARRAY_RANK (TREE_TYPE (se.expr)) + : expr->rank); + tmp = gfc_deallocate_pdt_comp (expr->ts.u.derived, se.expr, pdt_rank); + } else if (IS_CLASS_PDT (expr) && expr->symtree->n.sym->param_list) - tmp = gfc_deallocate_pdt_comp (CLASS_DATA (expr)->ts.u.derived, - se.expr, expr->rank); + { + int pdt_rank = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) + ? GFC_TYPE_ARRAY_RANK (TREE_TYPE (se.expr)) + : expr->rank); + tmp = gfc_deallocate_pdt_comp (CLASS_DATA (expr)->ts.u.derived, + se.expr, pdt_rank); + } if (tmp) gfc_add_expr_to_block (&se.pre, tmp); diff --git a/gcc/testsuite/gfortran.dg/pdt_array_alloc_1.f90 b/gcc/testsuite/gfortran.dg/pdt_array_alloc_1.f90 new file mode 100644 index 000000000000..82e745e9ed46 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_array_alloc_1.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! Test that allocating an array of parameterized derived type initializes +! the allocatable components of ALL elements, not just element 0. +! PR fortran/125534 + +module m + implicit none + integer, parameter :: default_real = kind(0.) + type :: tensor_t(k) + integer, kind :: k = default_real + real(k), allocatable :: values_(:) + end type +end module + +program pdt_array_alloc + use m + implicit none + integer, parameter :: n = 5 + type(tensor_t), allocatable :: a(:) + integer :: i + + allocate(a(n)) + ! Without the fix, only a(1)%values_ was initialized (nullified); + ! a(2)..a(n) had garbage pointers and the assignment below would crash. + do i = 1, n + a(i)%values_ = [real(i), real(i*2)] + end do + + if (any(a(3)%values_ /= [3., 6.])) stop 1 +end program
