From f7067ebc9e985465aefd78b173ffdea4ad732588 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 15 Mar 2013 13:06:08 +0100 Subject: [PATCH] re PR fortran/56615 (Wrong code with TRANSFER of arrays of character with stride -1) 2013-03-15 Tobias Burnus PR fortran/56615 * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays if they are not simply contiguous. 2013-03-15 Tobias Burnus PR fortran/56615 * gfortran.dg/transfer_intrinsic_5.f90: New. From-SVN: r196677 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-intrinsic.c | 5 +- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/transfer_intrinsic_5.f90 | 50 +++++++++++++++++++ 4 files changed, 63 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6cf6aa6ca44d..3c14d39e63e9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-03-15 Tobias Burnus + + PR fortran/56615 + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays + if they are not simply contiguous. + 2013-03-13 Paul Thomas PR fortran/56575 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 403aa3068b77..1d55fbe766bc 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4780,9 +4780,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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 46e3bd2ccee1..e6e078069c90 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-03-15 Tobias Burnus + + PR fortran/56615 + * gfortran.dg/transfer_intrinsic_5.f90: New. + 2013-03-14 Jakub Jelinek PR c++/56403 diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 new file mode 100644 index 000000000000..47be585a78a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 @@ -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 -- 2.47.2