diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-03-15 11:09:39 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-03-15 11:09:39 +0100 |
| commit | 4b4a1012fb1503d06f519666fbee982c64cadb15 (patch) | |
| tree | da9cb6491f2ed2650356886678edfddc2f61ee0b | |
| parent | 83c214a83559727f5215fcc9b293e14f427730b8 (diff) | |
| download | gcc-4b4a1012fb1503d06f519666fbee982c64cadb15.zip gcc-4b4a1012fb1503d06f519666fbee982c64cadb15.tar.gz gcc-4b4a1012fb1503d06f519666fbee982c64cadb15.tar.bz2 | |
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: r196675
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 5 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 | 50 |
4 files changed, 63 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 88b514d..ec9fbaa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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-11 Tobias Burnus <burnus@net-b.de> * gfortran.texi (STRUCTURE and RECORD): State more clearly how diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 83e3acf..a2bb2a7 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5435,9 +5435,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 8061867..caf8f6d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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-15 Kai Tietz <ktietz@redhat.com> * gcc.target/i386/movti.c: Don't test for x64 mingw. 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 0000000..47be585 --- /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 |