From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 | 61 ++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 (limited to 'gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90') diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 new file mode 100644 index 000000000..c85edea62 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! +! Test the fix for PR39879, in which gfc gagged on the double +! defined assignment where the rhs had a default initialiser. +! +! Contributed by David Sagan +! +module test_struct + interface assignment (=) + module procedure tao_lat_equal_tao_lat + end interface + type bunch_params_struct + integer n_live_particle + end type + type tao_lattice_struct + type (bunch_params_struct), allocatable :: bunch_params(:) + type (bunch_params_struct), allocatable :: bunch_params2(:) + end type + type tao_universe_struct + type (tao_lattice_struct), pointer :: model, design + character(200), pointer :: descrip => NULL() + end type + type tao_super_universe_struct + type (tao_universe_struct), allocatable :: u(:) + end type + type (tao_super_universe_struct), save, target :: s + contains + subroutine tao_lat_equal_tao_lat (lat1, lat2) + implicit none + type (tao_lattice_struct), intent(inout) :: lat1 + type (tao_lattice_struct), intent(in) :: lat2 + if (allocated(lat2%bunch_params)) then + lat1%bunch_params = lat2%bunch_params + end if + if (allocated(lat2%bunch_params2)) then + lat1%bunch_params2 = lat2%bunch_params2 + end if + end subroutine +end module + +program tao_program + use test_struct + implicit none + type (tao_universe_struct), pointer :: u + integer n, i + allocate (s%u(1)) + u => s%u(1) + allocate (u%design, u%model) + n = 112 + allocate (u%model%bunch_params(0:n), u%design%bunch_params(0:n)) + u%design%bunch_params%n_live_particle = [(i, i = 0, n)] + u%model = u%design + u%model = u%design ! The double assignment was the cause of the ICE + if (.not. allocated (u%model%bunch_params)) call abort + if (any (u%model%bunch_params%n_live_particle .ne. [(i, i = 0, n)])) call abort + Deallocate (u%model%bunch_params, u%design%bunch_params) + deallocate (u%design, u%model) + deallocate (s%u) +end program + +! { dg-final { cleanup-modules "test_struct" } } -- cgit v1.2.3