summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.fortran-torture/execute/arrayarg.f90
blob: b588d050b695a320395e612fcec1ec7206af4521 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
! Program to test arrays
! The program outputs a series of numbers.
! Two digit numbers beginning with 0, 1, 2 or 3 is a normal.
! Three digit numbers starting with 4 indicate an error.
! Using 1D arrays isn't a sufficient test, the first dimension is often
! handled specially.

! Fixed size parameter
subroutine f1 (a)
   implicit none
   integer, dimension (5, 8) :: a

   if (a(1, 1) .ne. 42) call abort

   if (a(5, 8) .ne. 43) call abort
end subroutine


program testprog
   implicit none
   integer, dimension(3:7, 4:11) :: a
   a(:,:) = 0
   a(3, 4) = 42
   a(7, 11) = 43
   call test(a)
contains
subroutine test (parm)
   implicit none
   ! parameter
   integer, dimension(2:, 3:) :: parm
   ! Known size arry
   integer, dimension(5, 8) :: a
   ! Known size array with different bounds
   integer, dimension(4:8, 3:10) :: b
   ! Unknown size arrays
   integer, dimension(:, :), allocatable :: c, d, e
   ! Vectors
   integer, dimension(5) :: v1
   integer, dimension(10, 10) :: v2
   integer n
   external f1

   ! Same size
   allocate (c(5,8))
   ! Same size, different bounds
   allocate (d(11:15, 12:19))
   ! A larger array
   allocate (e(15, 24))
   a(:,:) = 0
   b(:,:) = 0
   c(:,:) = 0
   d(:,:) = 0
   a(1,1) = 42
   b(4, 3) = 42
   c(1,1) = 42
   d(11,12) = 42
   a(5, 8) = 43
   b(8, 10) = 43
   c(5, 8) = 43
   d(15, 19) = 43

   v2(:, :) = 0
   do n=1,5
     v1(n) = n
   end do

   v2 (3, 1::2) = v1 (5:1:-1)
   v1 = v1 + 1

   if (v1(1) .ne. 2) call abort
   if (v2(3, 3) .ne. 4) call abort

   ! Passing whole arrays
   call f1 (a)
   call f1 (b)
   call f1 (c)
   call f2 (a)
   call f2 (b)
   call f2 (c)
   ! passing expressions
   a(1,1) = 41
   a(5,8) = 42
   call f1(a+1)
   call f2(a+1)
   a(1,1) = 42
   a(5,8) = 43
   call f1 ((a + b) / 2)
   call f2 ((a + b) / 2)
   ! Passing whole arrays as sections
   call f1 (a(:,:))
   call f1 (b(:,:))
   call f1 (c(:,:))
   call f2 (a(:,:))
   call f2 (b(:,:))
   call f2 (c(:,:))
   ! Passing sections
   e(:,:) = 0
   e(2, 3) = 42
   e(6, 10) = 43
   n = 3
   call f1 (e(2:6, n:10))
   call f2 (e(2:6, n:10))
   ! Vector subscripts
   ! v1= index plus one, v2(3, ::2) = reverse of index
   e(:,:) = 0
   e(2, 3) = 42
   e(6, 10) = 43
   call f1 (e(v1, n:10))
   call f2 (e(v1, n:10))
   ! Double vector subscript
   e(:,:) = 0
   e(6, 3) = 42
   e(2, 10) = 43
   !These are not resolved properly
   call f1 (e(v1(v2(3, ::2)), n:10))
   call f2 (e(v1(v2(3, ::2)), n:10))
   ! non-contiguous sections
   e(:,:) = 0
   e(1, 1) = 42
   e(13, 22) = 43
   n = 3
   call f1 (e(1:15:3, 1:24:3))
   call f2 (e(::3, ::n))
   ! non-contiguous sections with bounds
   e(:,:) = 0
   e(3, 4) = 42
   e(11, 18) = 43
   n = 19
   call f1 (e(3:11:2, 4:n:2))
   call f2 (e(3:11:2, 4:n:2))

   ! Passing a dummy variable
   call f1 (parm)
   call f2 (parm)
end subroutine
! Assumed shape parameter
subroutine f2 (a)
   integer, dimension (1:, 1:) :: a

   if (a(1, 1) .ne. 42) call abort

   if (a(5, 8) .ne. 43) call abort
end subroutine
end program