OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/56615 (Wrong code with TRANSFER of arrays of character with stride -1) 

2013-03-15  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56615
        * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays
        if they are not simply contiguous.

2013-03-15  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56615
        * gfortran.dg/transfer_intrinsic_5.f90: New.

From-SVN: r196676
This commit is contained in:
Tobias Burnus 2013-03-15 13:05:45 +01:00 committed by Tobias Burnus
parent d682fb25e2
commit 548ea77d24
4 changed files with 63 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2013-03-15 Tobias Burnus <burnus@net-b.de>
PR fortran/56615
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays
if they are not simply contiguous.
2013-03-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56575

5
gcc/fortran/trans-intrinsic.c
View File

@ -5412,9 +5412,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
source = gfc_conv_descriptor_data_get (argse.expr);
source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
/* Repack the source if not a full variable array. */
if (arg->expr->expr_type == EXPR_VARIABLE
&& arg->expr->ref->u.ar.type != AR_FULL)
/* Repack the source if not simply contiguous. */
if (!gfc_is_simply_contiguous (arg->expr, false))
{
tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-03-15 Tobias Burnus <burnus@net-b.de>
PR fortran/56615
* gfortran.dg/transfer_intrinsic_5.f90: New.
2013-03-14 Jakub Jelinek <jakub@redhat.com>
PR c++/56403

50
gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 Normal file
View File

@ -0,0 +1,50 @@
! { dg-do run }
!
! PR fortran/56615
!
! Contributed by Harald Anlauf
!
!
program gfcbug
implicit none
integer, parameter :: n = 8
integer :: i
character(len=1), dimension(n) :: a, b
character(len=n) :: s, t
character(len=n/2) :: u
do i = 1, n
a(i) = achar (i-1 + iachar("a"))
end do
! print *, "# Forward:"
! print *, "a=", a
s = transfer (a, s)
! print *, "s=", s
call cmp (a, s)
! print *, " stride = +2:"
do i = 1, n/2
u(i:i) = a(2*i-1)
end do
! print *, "u=", u
call cmp (a(1:n:2), u)
! print *
! print *, "# Backward:"
b = a(n:1:-1)
! print *, "b=", b
t = transfer (b, t)
! print *, "t=", t
call cmp (b, t)
! print *, " stride = -1:"
call cmp (a(n:1:-1), t)
contains
subroutine cmp (b, s)
character(len=1), dimension(:), intent(in) :: b
character(len=*), intent(in) :: s
character(len=size(b)) :: c
c = transfer (b, c)
if (c /= s) then
print *, "c=", c, " ", merge (" ok","BUG!", c == s)
call abort ()
end if
end subroutine cmp
end program gfcbug