1! { dg-do run } 2! 3! Test the fix for PR39879, in which gfc gagged on the double 4! defined assignment where the rhs had a default initialiser. 5! 6! Contributed by David Sagan <david.sagan@gmail.com> 7! 8module test_struct 9 interface assignment (=) 10 module procedure tao_lat_equal_tao_lat 11 end interface 12 type bunch_params_struct 13 integer n_live_particle 14 end type 15 type tao_lattice_struct 16 type (bunch_params_struct), allocatable :: bunch_params(:) 17 type (bunch_params_struct), allocatable :: bunch_params2(:) 18 end type 19 type tao_universe_struct 20 type (tao_lattice_struct), pointer :: model, design 21 character(200), pointer :: descrip => NULL() 22 end type 23 type tao_super_universe_struct 24 type (tao_universe_struct), allocatable :: u(:) 25 end type 26 type (tao_super_universe_struct), save, target :: s 27 contains 28 subroutine tao_lat_equal_tao_lat (lat1, lat2) 29 implicit none 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 34 end if 35 if (allocated(lat2%bunch_params2)) then 36 lat1%bunch_params2 = lat2%bunch_params2 37 end if 38 end subroutine 39end module 40 41program tao_program 42 use test_struct 43 implicit none 44 type (tao_universe_struct), pointer :: u 45 integer n, i 46 allocate (s%u(1)) 47 u => s%u(1) 48 allocate (u%design, u%model) 49 n = 112 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)] 52 u%model = u%design 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) 58 deallocate (s%u) 59end program 60