diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2018-02-03 14:06:44 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2018-02-03 14:06:44 +0000 |
commit | 2c536ce7b6a3a75ef4b43e94e1575122e3a962ca (patch) | |
tree | e186f448e47b52bfebd5c24a395b7ddecade22b5 | |
parent | d97aee74162a861e8930f353323d615d092076a3 (diff) | |
download | gcc-2c536ce7b6a3a75ef4b43e94e1575122e3a962ca.zip gcc-2c536ce7b6a3a75ef4b43e94e1575122e3a962ca.tar.gz gcc-2c536ce7b6a3a75ef4b43e94e1575122e3a962ca.tar.bz2 |
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
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 4 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr84155.f90 | 56 |
4 files changed, 71 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d5a6e26..da86c83 100644 --- 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 4070341..c845bef 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 7251e22..1c34494 100644 --- 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 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 |