1! { dg-do run } 2! 3! PR fortran/56615 4! 5! Contributed by Harald Anlauf 6! 7! 8program 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) 39contains 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 STOP 1 48 end if 49 end subroutine cmp 50end program gfcbug 51