gcc/testsuite/gfortran.dg/char_eoshift_3.f90

   1 ! Test eoshift2 for character arrays.
   2 ! { dg-do run }
   3 program main
   4   implicit none
   5   integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
   6   character (len = slen), dimension (n1, n2, n3) :: a
   7   character (len = slen), dimension (n1, n3) :: filler
   8   integer (kind = 1) :: shift1 = 4
   9   integer (kind = 2) :: shift2 = 2
  10   integer (kind = 4) :: shift3 = 3
  11   integer (kind = 8) :: shift4 = 1
  12   integer :: i1, i2, i3
  13
  14   filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
  15   filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
  16
  17   do i3 = 1, n3
  18     do i2 = 1, n2
  19       do i1 = 1, n1
  20         a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
  21       end do
  22     end do
  23   end do
  24
  25   call test (eoshift (a, shift1, filler, 2), int (shift1), .true.)
  26   call test (eoshift (a, shift2, filler, 2), int (shift2), .true.)
  27   call test (eoshift (a, shift3, filler, 2), int (shift3), .true.)
  28   call test (eoshift (a, shift4, filler, 2), int (shift4), .true.)
  29
  30   call test (eoshift (a, shift1, dim = 2), int (shift1), .false.)
  31   call test (eoshift (a, shift2, dim = 2), int (shift2), .false.)
  32   call test (eoshift (a, shift3, dim = 2), int (shift3), .false.)
  33   call test (eoshift (a, shift4, dim = 2), int (shift4), .false.)
  34 contains
  35   subroutine test (b, d2, has_filler)
  36     character (len = slen), dimension (n1, n2, n3) :: b
  37     logical :: has_filler
  38     integer :: d2
  39
  40     do i3 = 1, n3
  41       do i2 = 1, n2
  42         do i1 = 1, n1
  43           if (i2 + d2 .le. n2) then
  44             if (b (i1, i2, i3) .ne. a (i1, i2 + d2, i3)) STOP 1
  45           else if (has_filler) then
  46             if (b (i1, i2, i3) .ne. filler (i1, i3)) STOP 2
  47           else
  48             if (b (i1, i2, i3) .ne. '') STOP 3
  49           end if
  50         end do
  51       end do
  52     end do
  53   end subroutine test
  54 end program main