3 ! Test the fix for PR39879, in which gfc gagged on the double
4 ! defined assignment where the rhs had a default initialiser.
6 ! Contributed by David Sagan <david.sagan@gmail.com>
9 interface assignment (=)
10 module procedure tao_lat_equal_tao_lat
12 type bunch_params_struct
13 integer n_live_particle
15 type tao_lattice_struct
16 type (bunch_params_struct), allocatable :: bunch_params(:)
17 type (bunch_params_struct), allocatable :: bunch_params2(:)
19 type tao_universe_struct
20 type (tao_lattice_struct), pointer :: model, design
21 character(200), pointer :: descrip => NULL()
23 type tao_super_universe_struct
24 type (tao_universe_struct), allocatable :: u(:)
26 type (tao_super_universe_struct), save, target :: s
28 subroutine tao_lat_equal_tao_lat (lat1, lat2)
30 type (tao_lattice_struct), intent(inout) :: lat1
31 type (tao_lattice_struct), intent(in) :: lat2
32 if (allocated(lat2%bunch_params)) then
33 lat1%bunch_params = lat2%bunch_params
35 if (allocated(lat2%bunch_params2)) then
36 lat1%bunch_params2 = lat2%bunch_params2
44 type (tao_universe_struct), pointer :: u
48 allocate (u%design, u%model)
50 allocate (u%model%bunch_params(0:n), u%design%bunch_params(0:n))
51 u%design%bunch_params%n_live_particle = [(i, i = 0, n)]
53 u%model = u%design ! The double assignment was the cause of the ICE
54 if (.not. allocated (u%model%bunch_params)) call abort
55 if (any (u%model%bunch_params%n_live_particle .ne. [(i, i = 0, n)])) call abort
56 Deallocate (u%model%bunch_params, u%design%bunch_params)
57 deallocate (u%design, u%model)
61 ! { dg-final { cleanup-modules "test_struct" } }