OSDN Git Service

2005-06-28 Thomas Koenig <Thomas.Koenig@online.de>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.fortran-torture / execute / intrinsic_eoshift.f90
1 ! Program to test the eoshift intrinsic
2 program intrinsic_eoshift
3    integer, dimension(3, 3) :: a
4    integer, dimension(3, 3, 2) :: b
5    integer, dimension(3) :: bo, sh
6
7    ! Scalar shift and scalar bound.
8    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
9    a = eoshift (a, 1, 99, 1)
10    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
11       call abort
12
13    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
14    a = eoshift (a, -2, dim = 2)
15    if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
16       call abort
17
18    ! Array shift and scalar bound.
19    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
20    a = eoshift (a, (/1, 0, -1/), 99, 1)
21    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 99, 7, 8/), (/3, 3/)))) &
22       call abort
23
24    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
25    a = eoshift (a, (/2, -2, 0/), dim = 2)
26    if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
27       call abort
28
29    ! Scalar shift and array bound.
30    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
31    a = eoshift (a, 1, (/99, -1, 42/), 1)
32    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, -1, 8, 9, 42/), (/3, 3/)))) &
33       call abort
34
35    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
36    a = eoshift (a, -2, (/99, -1, 42/), 2)
37    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
38       call abort
39
40    ! Array shift and array bound.
41    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
42    a = eoshift (a, (/1, 0, -1/), (/99, -1, 42/), 1)
43    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 42, 7, 8/), (/3, 3/)))) &
44       call abort
45
46    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
47    a = eoshift (a, (/2, -2, 0/), (/99, -1, 42/), 2)
48    if (any (a .ne. reshape ((/7, -1, 3, 99, -1, 6, 99, 2, 9/), (/3, 3/)))) &
49       call abort
50
51    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
52    sh = (/ 3, -1, -3 /)
53    bo = (/-999, -99, -9 /)
54    a = eoshift(a, shift=sh, boundary=bo)
55    if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
56         shape(a)))) call abort
57
58    ! Test arrays > rank 2
59    b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
60    b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
61    b = eoshift (b, 1, 99, 1)
62    if (any (b(:, :, 1) .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
63       call abort
64    if (any (b(:, :, 2) .ne. reshape ((/12, 13, 99, 15, 16, 99, 18, 19, 99/), (/3, 3/)))) &
65       call abort
66
67    ! TODO: Test array sections
68 end program