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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 88b514d014b0774227c74099a8e10c94f69fff2e..ec9fbaa734b0bcaf93116a3484f0ad1904d81351 100644 (file)
--- 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 83e3acf9eea90444f2f1a2236613c1fd5c90e10a..a2bb2a78ee7fe4dbc052a9e474ab7f903c33880f 100644 (file)
--- 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 80618676c90bebf4cc08fa75d9848b9a277bbabb..caf8f6d1e2f72bfc455f3e672a1b08b29e9cf3c7 100644 (file)
--- 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 (file)
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