gomp-20050608-branch/gcc/testsuite/gfortran.dg/char_cshift_1.f90

   1 ! Test cshift0 for character arrays.
   2 ! { dg-do run }
   3 program main
   4   implicit none
   5   integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3
   6   character (len = slen), dimension (n1, n2, n3) :: a
   7   integer (kind = 1) :: shift1 = 3
   8   integer (kind = 2) :: shift2 = 4
   9   integer (kind = 4) :: shift3 = 5
  10   integer (kind = 8) :: shift4 = 6
  11   integer :: i1, i2, i3
  12
  13   do i3 = 1, n3
  14     do i2 = 1, n2
  15       do i1 = 1, n1
  16         a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3)
  17       end do
  18     end do
  19   end do
  20
  21   call test (cshift (a, shift1, 1), int (shift1), 0, 0)
  22   call test (cshift (a, shift2, 2), 0, int (shift2), 0)
  23   call test (cshift (a, shift3, 3), 0, 0, int (shift3))
  24   call test (cshift (a, shift4, 3), 0, 0, int (shift4))
  25 contains
  26   subroutine test (b, d1, d2, d3)
  27     character (len = slen), dimension (n1, n2, n3) :: b
  28     integer :: d1, d2, d3
  29
  30     do i3 = 1, n3
  31       do i2 = 1, n2
  32         do i1 = 1, n1
  33           if (b (i1, i2, i3) .ne. a (mod (d1 + i1 - 1, n1) + 1, &
  34                                      mod (d2 + i2 - 1, n2) + 1, &
  35                                      mod (d3 + i3 - 1, n3) + 1)) call abort
  36         end do
  37       end do
  38     end do
  39   end subroutine test
  40 end program main