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 6de5e5419e5aa5461f5ee6381e834e540d4e39a3..871a83207f38c2da45cc827508a2b6be76085b47 100644 (file)
--- 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 (file)
index 0000000..be86511
--- /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 <abensonca@gmail.com>
+
+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 (file)
index 0000000..fe8086a
--- /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