gcc/testsuite/gfortran.dg/char_cshift_2.f90

   1 ! Test cshift1 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), dimension (2, 4) :: shift1
   8   integer (kind = 2), dimension (2, 4) :: shift2
   9   integer (kind = 4), dimension (2, 4) :: shift3
  10   integer (kind = 8), dimension (2, 4) :: shift4
  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   shift1 (1, :) = (/ 4, 11, 19, 20 /)
  22   shift1 (2, :) = (/ 55, 5, 1, 2 /)
  23   shift2 = shift1
  24   shift3 = shift1
  25   shift4 = shift1
  26
  27   call test (cshift (a, shift1, 2))
  28   call test (cshift (a, shift2, 2))
  29   call test (cshift (a, shift3, 2))
  30   call test (cshift (a, shift4, 2))
  31 contains
  32   subroutine test (b)
  33     character (len = slen), dimension (n1, n2, n3) :: b
  34     integer :: i2p
  35
  36     do i3 = 1, n3
  37       do i2 = 1, n2
  38         do i1 = 1, n1
  39           i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1
  40           if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
  41         end do
  42       end do
  43     end do
  44   end subroutine test
  45 end program main