OSDN Git Service

2005-07-07 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, 9999, 99, 1)
15    if (any (a .ne. 99)) call abort
16
17    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
18    a = eoshift (a, -2, dim = 2)
19    if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
20       call abort
21
22    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
23    a = eoshift (a, -9999, 99, 1)
24    if (any (a .ne. 99)) call abort
25
26    ! Array shift and scalar bound.
27    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
28    a = eoshift (a, (/1, 0, -1/), 99, 1)
29    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 99, 7, 8/), (/3, 3/)))) &
30       call abort
31
32    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
33    a = eoshift (a, (/9999, 0, -9999/), 99, 1)
34    if (any (a .ne. reshape ((/99, 99, 99, 4, 5, 6, 99, 99, 99/), (/3, 3/)))) &
35       call abort
36
37    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
38    a = eoshift (a, (/2, -2, 0/), dim = 2)
39    if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
40       call abort
41
42    ! Scalar shift and array bound.
43    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
44    a = eoshift (a, 1, (/99, -1, 42/), 1)
45    if (any (a .ne. reshape ((/2, 3, 99, 5, 6, -1, 8, 9, 42/), (/3, 3/)))) &
46       call abort
47
48    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
49    a = eoshift (a, 9999, (/99, -1, 42/), 1)
50    if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
51         (/3, 3/)))) call abort
52
53    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
54    a = eoshift (a, -9999, (/99, -1, 42/), 1)
55    if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
56         (/3, 3/)))) call abort
57
58    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
59    a = eoshift (a, -2, (/99, -1, 42/), 2)
60    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
61       call abort
62
63    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
64    bo = (/99, -1, 42/)
65    a = eoshift (a, -2, bo, 2)
66    if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
67       call abort
68
69    ! Array shift and array bound.
70    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
71    a = eoshift (a, (/1, 0, -1/), (/99, -1, 42/), 1)
72    if (any (a .ne. reshape ((/2, 3, 99, 4, 5, 6, 42, 7, 8/), (/3, 3/)))) &
73       call abort
74
75    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
76    a = eoshift (a, (/2, -2, 0/), (/99, -1, 42/), 2)
77    if (any (a .ne. reshape ((/7, -1, 3, 99, -1, 6, 99, 2, 9/), (/3, 3/)))) &
78       call abort
79
80    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
81    sh = (/ 3, -1, -3 /)
82    bo = (/-999, -99, -9 /)
83    a = eoshift(a, shift=sh, boundary=bo)
84    if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
85         shape(a)))) call abort
86
87    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
88    a = eoshift (a, (/9999, -9999, 0/), (/99, -1, 42/), 2)
89    if (any (a .ne. reshape ((/99, -1, 3, 99, -1, 6, 99, -1, 9/), (/3, 3/)))) &
90       call abort
91
92    ! Test arrays > rank 2
93    b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
94    b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
95    b = eoshift (b, 1, 99, 1)
96    if (any (b(:, :, 1) .ne. reshape ((/2, 3, 99, 5, 6, 99, 8, 9, 99/), (/3, 3/)))) &
97       call abort
98    if (any (b(:, :, 2) .ne. reshape ((/12, 13, 99, 15, 16, 99, 18, 19, 99/), (/3, 3/)))) &
99       call abort
100
101    ! TODO: Test array sections
102 end program