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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [char_eoshift_4.f90] - Blame information for rev 827

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

Line No. Rev Author Line
1 149 jeremybenn
! Test eoshift3 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), 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
  filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15
  filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
16
 
17
  shift1 (1, :) = (/ 1, 3, 2, 2 /)
18
  shift1 (2, :) = (/ 2, 1, 1, 3 /)
19
  shift2 = shift1
20
  shift3 = shift1
21
  shift4 = shift1
22
 
23
  do i3 = 1, n3
24
    do i2 = 1, n2
25
      do i1 = 1, n1
26
        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
27
      end do
28
    end do
29
  end do
30
 
31
  call test (eoshift (a, shift1, filler, 2), .true.)
32
  call test (eoshift (a, shift2, filler, 2), .true.)
33
  call test (eoshift (a, shift3, filler, 2), .true.)
34
  call test (eoshift (a, shift4, filler, 2), .true.)
35
 
36
  call test (eoshift (a, shift1, dim = 2), .false.)
37
  call test (eoshift (a, shift2, dim = 2), .false.)
38
  call test (eoshift (a, shift3, dim = 2), .false.)
39
  call test (eoshift (a, shift4, dim = 2), .false.)
40
contains
41
  subroutine test (b, has_filler)
42
    character (len = slen), dimension (n1, n2, n3) :: b
43
    logical :: has_filler
44
    integer :: i2p
45
 
46
    do i3 = 1, n3
47
      do i2 = 1, n2
48
        do i1 = 1, n1
49
          i2p = i2 + shift1 (i1, i3)
50
          if (i2p .le. n2) then
51
            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
52
          else if (has_filler) then
53
            if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
54
          else
55
            if (b (i1, i2, i3) .ne. '') call abort
56
          end if
57
        end do
58
      end do
59
    end do
60
  end subroutine test
61
end program main

powered by: WebSVN 2.1.0

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