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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn 
! Test cshift1 for character arrays.
2 
! { dg-do run }
3 
program main
4 
  implicit none
5 
  integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3
6 
  character (len = slen), dimension (n1, n2, n3) :: a
7 
  integer (kind = 1), dimension (2, 4) :: shift1
8 
  integer (kind = 2), dimension (2, 4) :: shift2
9 
  integer (kind = 4), dimension (2, 4) :: shift3
10 
  integer (kind = 8), dimension (2, 4) :: shift4
11 
  integer :: i1, i2, i3
12 
 
13 
  do i3 = 1, n3
14 
    do i2 = 1, n2
15 
      do i1 = 1, n1
16 
        a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3)
17 
      end do
18 
    end do
19 
  end do
20 
 
21 
  shift1 (1, :) = (/ 4, 11, 19, 20 /)
22 
  shift1 (2, :) = (/ 55, 5, 1, 2 /)
23 
  shift2 = shift1
24 
  shift3 = shift1
25 
  shift4 = shift1
26 
 
27 
  call test (cshift (a, shift1, 2))
28 
  call test (cshift (a, shift2, 2))
29 
  call test (cshift (a, shift3, 2))
30 
  call test (cshift (a, shift4, 2))
31 
contains
32 
  subroutine test (b)
33 
    character (len = slen), dimension (n1, n2, n3) :: b
34 
    integer :: i2p
35 
 
36 
    do i3 = 1, n3
37 
      do i2 = 1, n2
38 
        do i1 = 1, n1
39 
          i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1
40 
          if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
41 
        end do
42 
      end do
43 
    end do
44 
  end subroutine test
45 
end program main

powered by: WebSVN 2.1.0

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