The issue is a regression which exists since GCC 4.4. The fix is rather
obvious (see also PR).
Build and regtested on x86-64-gnu-linux.
OK for the trunk and the two maintained branches, 4.6 and 4.7?
Tobias
2013-03-15 Tobias Burnus <bur...@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 <bur...@net-b.de>
PR fortran/56615
* gfortran.dg/transfer_intrinsic_5.f90: New.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 83e3acf..7905503 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/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
