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

Subversion Repositories openrisc

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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! Test eoshift1 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) :: filler
8
  integer (kind = 1), dimension (n1, n3) :: shift1
9
  integer (kind = 2), dimension (n1, n3) :: shift2
10
  integer (kind = 4), dimension (n1, n3) :: shift3
11
  integer (kind = 8), dimension (n1, n3) :: shift4
12
  integer :: i1, i2, i3
13
 
14
  shift1 (1, :) = (/ 1, 3, 2, 2 /)
15
  shift1 (2, :) = (/ 2, 1, 1, 3 /)
16
  shift2 = shift1
17
  shift3 = shift1
18
  shift4 = shift1
19
 
20
  do i3 = 1, n3
21
    do i2 = 1, n2
22
      do i1 = 1, n1
23
        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
24
      end do
25
    end do
26
  end do
27
 
28
  call test (eoshift (a, shift1, 'foo', 2), 'foo')
29
  call test (eoshift (a, shift2, 'foo', 2), 'foo')
30
  call test (eoshift (a, shift3, 'foo', 2), 'foo')
31
  call test (eoshift (a, shift4, 'foo', 2), 'foo')
32
 
33
  filler = ''
34
  call test (eoshift (a, shift1, dim = 2), filler)
35
  call test (eoshift (a, shift2, dim = 2), filler)
36
  call test (eoshift (a, shift3, dim = 2), filler)
37
  call test (eoshift (a, shift4, dim = 2), filler)
38
contains
39
  subroutine test (b, filler)
40
    character (len = slen), dimension (n1, n2, n3) :: b
41
    character (len = slen) :: filler
42
    integer :: i2p
43
 
44
    do i3 = 1, n3
45
      do i2 = 1, n2
46
        do i1 = 1, n1
47
          i2p = i2 + shift1 (i1, i3)
48
          if (i2p .gt. n2) then
49
            if (b (i1, i2, i3) .ne. filler) call abort
50
          else
51
            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
52
          end if
53
        end do
54
      end do
55
    end do
56
  end subroutine test
57
end program main

powered by: WebSVN 2.1.0

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