gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90

   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