OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [char_eoshift_1.f90] - Diff between revs 149 and 154

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 149 Rev 154
! Test eoshift0 for character arrays.
! Test eoshift0 for character arrays.
! { dg-do run }
! { dg-do run }
program main
program main
  implicit none
  implicit none
  integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3
  integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3
  character (len = slen), dimension (n1, n2, n3) :: a
  character (len = slen), dimension (n1, n2, n3) :: a
  character (len = slen) :: filler
  character (len = slen) :: filler
  integer (kind = 1) :: shift1 = 4
  integer (kind = 1) :: shift1 = 4
  integer (kind = 2) :: shift2 = 2
  integer (kind = 2) :: shift2 = 2
  integer (kind = 4) :: shift3 = 3
  integer (kind = 4) :: shift3 = 3
  integer (kind = 8) :: shift4 = 1
  integer (kind = 8) :: shift4 = 1
  integer :: i1, i2, i3
  integer :: i1, i2, i3
  do i3 = 1, n3
  do i3 = 1, n3
    do i2 = 1, n2
    do i2 = 1, n2
      do i1 = 1, n1
      do i1 = 1, n1
        a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3)
        a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3)
      end do
      end do
    end do
    end do
  end do
  end do
  call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo')
  call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo')
  call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo')
  call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo')
  call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo')
  call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo')
  call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo')
  call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo')
  filler = ''
  filler = ''
  call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler)
  call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler)
  call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler)
  call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler)
  call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler)
  call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler)
  call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler)
  call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler)
contains
contains
  subroutine test (b, d1, d2, d3, filler)
  subroutine test (b, d1, d2, d3, filler)
    character (len = slen), dimension (n1, n2, n3) :: b
    character (len = slen), dimension (n1, n2, n3) :: b
    character (len = slen) :: filler
    character (len = slen) :: filler
    integer :: d1, d2, d3
    integer :: d1, d2, d3
    do i3 = 1, n3
    do i3 = 1, n3
      do i2 = 1, n2
      do i2 = 1, n2
        do i1 = 1, n1
        do i1 = 1, n1
          if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then
          if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then
            if (b (i1, i2, i3) .ne. filler) call abort
            if (b (i1, i2, i3) .ne. filler) call abort
          else
          else
            if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort
            if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort
          end if
          end if
        end do
        end do
      end do
      end do
    end do
    end do
  end subroutine test
  end subroutine test
end program main
end program main
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.