The attached patch is simple and obvious. Andrew sent me the use case off-list.
I will commit this later this afternoon if no objections.
Regression tested on x86_64.
Thanks Andrew for the example. Two new testcases added.
Regards,
Jerry
---
fortran: Fix derived type rank not set for allocate mold
When mold was being used in the allocate of an array within
a derived type, the rank was not getting set.
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_array_init_size): Set the rank for the
dtype.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_mold_6.f90: New test.
* gfortran.dg/allocate_with_mold_7.f90: New test.
---commit 2ddbdf9d3c8c812b3fb2b705b912a113e939f135
Author: Jerry DeLisle <[email protected]>
Date: Wed Jul 8 08:52:25 2026 -0700
fortran: Fix derived type rank not set for allocate mold
When mold was being used in the allocate of an array within
a derived type, the rank was not getting set.
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_array_init_size): Set the rank for the
dtype.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_mold_6.f90: New test.
* gfortran.dg/allocate_with_mold_7.f90: New test.
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 11cf2ba2e86..df8ec279231 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6069,6 +6069,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
&& expr3 && expr3->ts.type != BT_CLASS
&& expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
{
+ tmp = gfc_conv_descriptor_dtype (descriptor);
+ gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
tmp = gfc_conv_descriptor_elem_len (descriptor);
gfc_add_modify (pblock, tmp,
fold_convert (TREE_TYPE (tmp), expr3_elem_size));
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_6.f90 b/gcc/testsuite/gfortran.dg/allocate_with_mold_6.f90
new file mode 100644
index 00000000000..be86511293c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_6.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! Test case contributed by Andrew Benson <[email protected]>
+
+module m
+ implicit none
+ type :: t
+ integer :: i
+ end type t
+ type :: container
+ class(t), allocatable :: arr(:)
+ end type container
+ type(t) :: scalar_mold
+contains
+ subroutine get_rank (x, r)
+ class(*), intent(in) :: x(..)
+ integer, intent(out) :: r
+ r = rank (x)
+ end subroutine get_rank
+end module m
+
+program main
+ use m
+ implicit none
+ type(container), pointer :: c
+ integer :: r
+
+ allocate (c)
+ allocate (c%arr(1), mold = scalar_mold)
+
+ ! Check the rank
+ call get_rank (c%arr, r)
+ if (r /= 1) stop 1
+
+ deallocate (c)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_7.f90 b/gcc/testsuite/gfortran.dg/allocate_with_mold_7.f90
new file mode 100644
index 00000000000..fe8086ae573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_7.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+module m
+ implicit none
+ type :: container
+ class(*), allocatable :: arr(:)
+ end type container
+contains
+ subroutine get_rank (x, r)
+ class(*), intent(in) :: x(..)
+ integer, intent(out) :: r
+ r = rank (x)
+ end subroutine get_rank
+end module m
+
+program main
+ use m
+ implicit none
+ type(container), pointer :: c
+ integer(1), allocatable :: junk(:)
+ integer :: r
+
+ allocate (c)
+ allocate (c%arr(3), mold = 7)
+
+ call get_rank (c%arr, r)
+ if (r /= 1) stop 1
+
+ select type (y => c%arr)
+ type is (integer)
+ class default
+ stop 2
+ end select
+
+ deallocate (c)
+end program main
