summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f9050
1 files changed, 50 insertions, 0 deletions
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 000000000..47be585a7
--- /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