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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [char_eoshift_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! Test eoshift0 for character arrays.
2
! { dg-do run }
3
program main
4
  implicit none
5
  integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3
6
  character (len = slen), dimension (n1, n2, n3) :: a
7
  character (len = slen) :: 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
  do i3 = 1, n3
15
    do i2 = 1, n2
16
      do i1 = 1, n1
17
        a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3)
18
      end do
19
    end do
20
  end do
21
 
22
  call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo')
23
  call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo')
24
  call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo')
25
  call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo')
26
 
27
  filler = ''
28
  call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler)
29
  call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler)
30
  call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler)
31
  call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler)
32
contains
33
  subroutine test (b, d1, d2, d3, filler)
34
    character (len = slen), dimension (n1, n2, n3) :: b
35
    character (len = slen) :: filler
36
    integer :: d1, d2, d3
37
 
38
    do i3 = 1, n3
39
      do i2 = 1, n2
40
        do i1 = 1, n1
41
          if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then
42
            if (b (i1, i2, i3) .ne. filler) call abort
43
          else
44
            if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort
45
          end if
46
        end do
47
      end do
48
    end do
49
  end subroutine test
50
end program main

powered by: WebSVN 2.1.0

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