|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! PR fortran/56615
|
|
|
4 !
|
|
|
5 ! Contributed by Harald Anlauf
|
|
|
6 !
|
|
|
7 !
|
|
|
8 program gfcbug
|
|
|
9 implicit none
|
|
|
10 integer, parameter :: n = 8
|
|
|
11 integer :: i
|
|
|
12 character(len=1), dimension(n) :: a, b
|
|
|
13 character(len=n) :: s, t
|
|
|
14 character(len=n/2) :: u
|
|
|
15
|
|
|
16 do i = 1, n
|
|
|
17 a(i) = achar (i-1 + iachar("a"))
|
|
|
18 end do
|
|
|
19 ! print *, "# Forward:"
|
|
|
20 ! print *, "a=", a
|
|
|
21 s = transfer (a, s)
|
|
|
22 ! print *, "s=", s
|
|
|
23 call cmp (a, s)
|
|
|
24 ! print *, " stride = +2:"
|
|
|
25 do i = 1, n/2
|
|
|
26 u(i:i) = a(2*i-1)
|
|
|
27 end do
|
|
|
28 ! print *, "u=", u
|
|
|
29 call cmp (a(1:n:2), u)
|
|
|
30 ! print *
|
|
|
31 ! print *, "# Backward:"
|
|
|
32 b = a(n:1:-1)
|
|
|
33 ! print *, "b=", b
|
|
|
34 t = transfer (b, t)
|
|
|
35 ! print *, "t=", t
|
|
|
36 call cmp (b, t)
|
|
|
37 ! print *, " stride = -1:"
|
|
|
38 call cmp (a(n:1:-1), t)
|
|
|
39 contains
|
|
|
40 subroutine cmp (b, s)
|
|
|
41 character(len=1), dimension(:), intent(in) :: b
|
|
|
42 character(len=*), intent(in) :: s
|
|
|
43 character(len=size(b)) :: c
|
|
|
44 c = transfer (b, c)
|
|
|
45 if (c /= s) then
|
|
|
46 print *, "c=", c, " ", merge (" ok","BUG!", c == s)
|
|
|
47 call abort ()
|
|
|
48 end if
|
|
|
49 end subroutine cmp
|
|
|
50 end program gfcbug
|
