See attached patch.
Regression tested on x86_64.
OK for mainline and then backport to 16?
Regards,
Jerry
---
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.
PR fortran/125534
Assisted by: Claude Sonnet 4.6
gcc/fortran/ChangeLog:
PR fortran/125534
* 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:
PR fortran/125534
* gfortran.dg/pdt_array_alloc_1.f90: New test.
---From 51e3836f39f884bf1b68866e4fcf12a34716716a Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Fri, 5 Jun 2026 13:19:58 -0700
Subject: [PATCH] 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.
PR fortran/125534
Assisted by: Claude Sonnet 4.6
gcc/fortran/ChangeLog:
PR fortran/125534
* 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:
PR fortran/125534
* gfortran.dg/pdt_array_alloc_1.f90: New test.
---
gcc/fortran/trans-stmt.cc | 30 +++++++++++++++----
.../gfortran.dg/pdt_array_alloc_1.f90 | 30 +++++++++++++++++++
2 files changed, 55 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pdt_array_alloc_1.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 00ddb0629cd..35dcfc1cf29 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 00000000000..82e745e9ed4
--- /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
--
2.54.0
