diff options
author | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
---|---|---|
committer | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
commit | 1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch) | |
tree | c607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 | |
parent | 283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff) | |
download | toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2 toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip |
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 new file mode 100644 index 000000000..808a2898c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 @@ -0,0 +1,59 @@ +! { 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 <david.sagan@gmail.com> +! +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 |