re PR fortran/84141 (Internal error: type_name(): Bad type)

2018-02-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84141
	PR fortran/84155
	* trans-array.c (gfc_array_init_size): Instead of gfc_get_dtype
	use gfc_get_dtype_rank_type.

2018-02-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84141
	PR fortran/84155
	* gfortran.dg/pr84155.f90 : New test.

From-SVN: r257356

gcc/fortran/ChangeLog

@@ -1,3 +1,10 @@
+2018-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84141
+	PR fortran/84155
+	* trans-array.c (gfc_array_init_size): Instead of gfc_get_dtype
+	use gfc_get_dtype_rank_type.
+
 2018-02-01  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR 83975

gcc/fortran/trans-array.c

@@ -5354,8 +5354,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
     }
   else
     {
-      tmp = gfc_conv_descriptor_dtype (descriptor);
+      tmp = gfc_get_dtype_rank_type (rank, gfc_get_element_type (type));
-      gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
+      gfc_add_modify (pblock, gfc_conv_descriptor_dtype (descriptor), tmp);
     }
 
   or_expr = logical_false_node;

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2018-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84141
+	PR fortran/84155
+	* gfortran.dg/pr84155.f90 : New test.
+
 2017-02-02  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gfortran.dg/dec_parameter_1.f (sub1): Remove statement with no effect.

gcc/testsuite/gfortran.dg/pr84155.f90

@@ -0,0 +1,56 @@
+! { dg-do run }
+!
+! Test the fix for PR84155 and PR84141.
+!
+! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+!
+module test_case
+
+  implicit none
+
+  type :: array_t
+     integer, dimension(:), allocatable :: child
+   contains
+     procedure :: write_raw => particle_write_raw
+  end type array_t
+
+  type :: container_t
+     type(array_t), dimension(:), allocatable :: array
+  end type container_t
+
+contains
+
+  subroutine proc ()
+    type(container_t) :: container
+    integer :: unit, check
+    integer, parameter :: ival = 42
+
+    allocate (container%array(1))
+    allocate (container%array(1)%child (1), source = [ival])
+
+    unit = 33
+    open (unit, action="readwrite", form="unformatted", status="scratch")
+    call container%array(1)%write_raw (unit)
+    rewind (unit)
+    read (unit) check
+    close (unit)
+    if (ival .ne. check) call abort
+  end subroutine proc
+
+  subroutine particle_write_raw (array, u)
+    class(array_t), intent(in) :: array
+    integer, intent(in) :: u
+    write (u) array%child
+  end subroutine particle_write_raw
+
+  subroutine particle_read_raw (array)
+    class(array_t), intent(out) :: array
+    allocate (array%child (1))    ! comment this out
+  end subroutine particle_read_raw
+
+end module test_case
+
+program main
+  use test_case
+  call proc ()
+  end program main