re PR fortran/39879 (double free or corruption abort with gfortran)
2009-05-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/39879 * trans_expr.c (gfc_conv_procedure_call): Deep copy a derived type parentheses argument if it is a variable with allocatable components. 2009-05-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/39879 * gfortran.dg/alloc_comp_assign_10.f90: New test. From-SVN: r147336
This commit is contained in:
parent
c1b3bc6727
commit
bfdcb9ad09
|
@ -1,3 +1,11 @@
|
|||
2009-05-10 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
Backport from mainline:
|
||||
PR fortran/39879
|
||||
* trans_expr.c (gfc_conv_procedure_call): Deep copy a derived
|
||||
type parentheses argument if it is a variable with allocatable
|
||||
components.
|
||||
|
||||
2009-04-22 Ulrich Weigand <Ulrich.Weigand@de.ibm.com>
|
||||
|
||||
Backport from mainline:
|
||||
|
|
|
@ -2782,7 +2782,18 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
|
|||
break;
|
||||
}
|
||||
|
||||
if (e->expr_type == EXPR_OP
|
||||
&& e->value.op.op == INTRINSIC_PARENTHESES
|
||||
&& e->value.op.op1->expr_type == EXPR_VARIABLE)
|
||||
{
|
||||
tree local_tmp;
|
||||
local_tmp = gfc_evaluate_now (tmp, &se->pre);
|
||||
local_tmp = gfc_copy_alloc_comp (e->ts.derived, local_tmp, tmp, parm_rank);
|
||||
gfc_add_expr_to_block (&se->post, local_tmp);
|
||||
}
|
||||
|
||||
tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
|
||||
|
||||
gfc_add_expr_to_block (&se->post, tmp);
|
||||
}
|
||||
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2009-05-10 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
Backport from mainline:
|
||||
PR fortran/39879
|
||||
* gfortran.dg/alloc_comp_assign_10.f90: New test.
|
||||
|
||||
2009-04-10 David Billinghurst <billingd@gcc.gnu.org>
|
||||
|
||||
PR fortran/38956
|
||||
|
|
|
@ -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 <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
|
||||
|
||||
! { dg-final { cleanup-modules "test_struct" } }
|
Loading…
Reference in New Issue