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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d5a6e2641de35e83fcb7824868f24b485149eaef..da86c839859cc5b8b0bf5cdf9761bb47c796f7ed 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 40703419d51119a49695de514af25bea149fc67c..c845befb5d01b91e8086d93b4b2dab7939551c59 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/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);
-      gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
+      tmp = gfc_get_dtype_rank_type (rank, gfc_get_element_type (type));
+      gfc_add_modify (pblock, gfc_conv_descriptor_dtype (descriptor), tmp);
     }
 
   or_expr = logical_false_node;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7251e223f4ee70365e53aaef8afec5304a039df0..1c34494b9829ecf536881d348810e1176662c881 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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.

diff --git a/gcc/testsuite/gfortran.dg/pr84155.f90 b/gcc/testsuite/gfortran.dg/pr84155.f90
new file mode 100644 (file)
index 0000000..fe87b6c
--- /dev/null
+++ b/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