git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/52151 (Segfault with realloc on assignment and RESHAPE to unallocated LHS) 

2012-02-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52151
        * trans-expr.c (fcncall_realloc_result): Set also the stride.

2012-02-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52151
        * gfortran.dg/realloc_on_assign_12.f90: New.

From-SVN: r184016
This commit is contained in:
Tobias Burnus 2012-02-08 20:40:23 +01:00 committed by Tobias Burnus
parent 9d465faf92
commit 5d24176e5e
4 changed files with 112 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2012-02-08 Tobias Burnus <burnus@net-b.de>
PR fortran/52151
* trans-expr.c (fcncall_realloc_result): Set also the stride.
2012-02-07 Tobias Burnus <burnus@net-b.de>
PR fortran/51514

13
gcc/fortran/trans-expr.c
View File

@ -6370,16 +6370,15 @@ fcncall_realloc_result (gfc_se *se, int rank)
gfc_conv_descriptor_ubound_set (&se->post, desc,
gfc_rank_cst[n], tmp);
/* Accumulate the offset. */
tmp = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[n]);
/* Set stride and accumulate the offset. */
tmp = gfc_conv_descriptor_stride_get (res_desc, gfc_rank_cst[n]);
gfc_conv_descriptor_stride_set (&se->post, desc,
gfc_rank_cst[n], tmp);
tmp = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
lbound, tmp);
gfc_array_index_type, lbound, tmp);
offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offset, tmp);
gfc_array_index_type, offset, tmp);
offset = gfc_evaluate_now (offset, &se->post);
}
gfc_conv_descriptor_offset_set (&se->post, desc, offset);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2012-02-08 Tobias Burnus <burnus@net-b.de>
PR fortran/52151
* gfortran.dg/realloc_on_assign_12.f90: New.
2012-02-08 Richard Guenther <rguenther@suse.de>
PR rtl-optimization/52170

96
gcc/testsuite/gfortran.dg/realloc_on_assign_12.f90 Normal file
View File

@ -0,0 +1,96 @@
! { dg-do run }
!
! PR fortran/52151
!
! Check that the bounds/shape/strides are correctly set
! for (re)alloc on assignment, if the LHS is either not
! allocated or has the wrong shape. This test is for
! code which is only invoked for libgfortran intrinsic
! such as RESHAPE.
!
! Based on the example of PR 52117 by Steven Hirshman
!
PROGRAM RESHAPEIT
call unalloc ()
call wrong_shape ()
contains
subroutine unalloc ()
INTEGER, PARAMETER :: n1=2, n2=2, n3=2
INTEGER :: m1, m2, m3, lc
REAL, ALLOCATABLE :: A(:,:), B(:,:,:)
REAL :: val
ALLOCATE (A(n1,n2*n3))
! << B is not allocated
val = 0
lc = 0
DO m3=1,n3
DO m2=1,n2
lc = lc+1
DO m1=1,n1
val = val+1
A(m1, lc) = val
END DO
END DO
END DO
B = RESHAPE(A, [n1,n2,n3])
if (any (shape (B) /= [n1,n2,n3])) call abort ()
if (any (ubound (B) /= [n1,n2,n3])) call abort ()
if (any (lbound (B) /= [1,1,1])) call abort ()
lc = 0
DO m3=1,n3
DO m2=1,n2
lc = lc+1
DO m1=1,n1
! PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3)
if (A(m1,lc) /= B(m1,m2,m3)) call abort ()
END DO
END DO
END DO
DEALLOCATE(A, B)
end subroutine unalloc
subroutine wrong_shape ()
INTEGER, PARAMETER :: n1=2, n2=2, n3=2
INTEGER :: m1, m2, m3, lc
REAL, ALLOCATABLE :: A(:,:), B(:,:,:)
REAL :: val
ALLOCATE (A(n1,n2*n3))
ALLOCATE (B(1,1,1)) ! << shape differs from RHS
val = 0
lc = 0
DO m3=1,n3
DO m2=1,n2
lc = lc+1
DO m1=1,n1
val = val+1
A(m1, lc) = val
END DO
END DO
END DO
B = RESHAPE(A, [n1,n2,n3])
if (any (shape (B) /= [n1,n2,n3])) call abort ()
if (any (ubound (B) /= [n1,n2,n3])) call abort ()
if (any (lbound (B) /= [1,1,1])) call abort ()
lc = 0
DO m3=1,n3
DO m2=1,n2
lc = lc+1
DO m1=1,n1
! PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3)
if (A(m1,lc) /= B(m1,m2,m3)) call abort ()
END DO
END DO
END DO
DEALLOCATE(A, B)
end subroutine wrong_shape
END PROGRAM RESHAPEIT