re PR fortran/57354 (Wrong run-time assignment of allocatable array of derived type with allocatable component)

2013-12-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57354
	* trans-array.c (gfc_conv_resolve_dependencies): For other than
	SS_SECTION, do a dependency check if the lhs is liable to be
	reallocated.

2013-12-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57354
	* gfortran.dg/realloc_on_assign_23.f90 : New test

From-SVN: r205567
This commit is contained in:
Paul Thomas 2013-12-01 11:50:20 +00:00
parent d700518bbd
commit 343ab49260
4 changed files with 53 additions and 3 deletions

View File

@ -1,3 +1,10 @@
2013-12-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57354
* trans-array.c (gfc_conv_resolve_dependencies): For other than
SS_SECTION, do a dependency check if the lhs is liable to be
reallocated.
2013-12-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/58410

View File

@ -4335,11 +4335,19 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
{
if (ss->info->type != GFC_SS_SECTION)
continue;
ss_expr = ss->info->expr;
if (ss->info->type != GFC_SS_SECTION)
{
if (gfc_option.flag_realloc_lhs
&& dest_expr != ss_expr
&& gfc_is_reallocatable_lhs (dest_expr)
&& ss_expr->rank)
nDepend = gfc_check_dependency (dest_expr, ss_expr, true);
continue;
}
if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym)
{
if (gfc_could_be_alias (dest, ss)

View File

@ -1,3 +1,8 @@
2013-12-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57354
* gfortran.dg/realloc_on_assign_23.f90 : New test
2013-12-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34547

View File

@ -0,0 +1,30 @@
! { dg-do run }
!
! PR fortran/57354
!
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
!
type t
integer,allocatable :: i
end type
type(t) :: e
type(t), allocatable :: a(:)
integer :: chksum = 0
do i=1,3 ! Was 100 in original
e%i = i
chksum = chksum + i
if (.not.allocated(a)) then
a = [e]
else
call foo
end if
end do
if (sum ([(a(i)%i, i=1,size(a))]) .ne. chksum) call abort
contains
subroutine foo
a = [a, e]
end subroutine
end