https://gcc.gnu.org/g:9decb8a07ac764f2a39885b2a5905515f188da06
commit r17-2269-g9decb8a07ac764f2a39885b2a5905515f188da06 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: --- gcc/fortran/trans-array.cc | 2 ++ gcc/testsuite/gfortran.dg/allocate_with_mold_6.f90 | 36 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/allocate_with_mold_7.f90 | 36 ++++++++++++++++++++++ 3 files changed, 74 insertions(+) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 6de5e5419e5a..871a83207f38 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 000000000000..be86511293cf --- /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 000000000000..fe8086ae573d --- /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
