From 2c536ce7b6a3a75ef4b43e94e1575122e3a962ca Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 3 Feb 2018 14:06:44 +0000 Subject: [PATCH] re PR fortran/84141 (Internal error: type_name(): Bad type) 2018-02-03 Paul Thomas 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 PR fortran/84141 PR fortran/84155 * gfortran.dg/pr84155.f90 : New test. From-SVN: r257356 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-array.c | 4 +- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/pr84155.f90 | 56 +++++++++++++++++++++++++++ 4 files changed, 71 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr84155.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d5a6e2641de..da86c839859 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-02-03 Paul Thomas + + 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 PR 83975 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 40703419d51..c845befb5d0 100644 --- 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 7251e223f4e..1c34494b982 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-02-03 Paul Thomas + + PR fortran/84141 + PR fortran/84155 + * gfortran.dg/pr84155.f90 : New test. + 2017-02-02 Uros Bizjak * 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 index 00000000000..fe87b6c2ca7 --- /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 +! +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 -- 2.30.2