procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Paul Thomas 2018-02-03 14:06:44 +00:00
parent d97aee7416
commit 2c536ce7b6
4 changed files with 71 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -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

4
gcc/fortran/trans-array.c
View file

@ -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;

6
gcc/testsuite/ChangeLog
View file

@ -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.

56
gcc/testsuite/gfortran.dg/pr84155.f90 Normal file
View file

@ -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