Commit | Line | Data |
---|---|---|
88b9d363 | 1 | ! Copyright 2021-2022 Free Software Foundation, Inc. |
7ba155b3 AB |
2 | ! |
3 | ! This program is free software; you can redistribute it and/or modify | |
4 | ! it under the terms of the GNU General Public License as published by | |
5 | ! the Free Software Foundation; either version 3 of the License, or | |
6 | ! (at your option) any later version. | |
7 | ! | |
8 | ! This program is distributed in the hope that it will be useful, | |
9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | ! GNU General Public License for more details. | |
12 | ! | |
13 | ! You should have received a copy of the GNU General Public License | |
14 | ! along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | ! | |
17 | ! Start of test program. | |
18 | ! | |
19 | program test | |
20 | ||
21 | ! Things to perform tests on. | |
22 | integer, target :: array_1d (1:10) = 0 | |
23 | integer, target :: array_2d (1:4, 1:3) = 0 | |
24 | integer :: an_integer = 0 | |
25 | real :: a_real = 0.0 | |
26 | integer, pointer :: array_1d_p (:) => null () | |
27 | integer, pointer :: array_2d_p (:,:) => null () | |
28 | integer, allocatable :: allocatable_array_1d (:) | |
29 | integer, allocatable :: allocatable_array_2d (:,:) | |
30 | ||
31 | ! Loop counters. | |
32 | integer :: s1, s2 | |
33 | ||
34 | ! The start of the tests. | |
35 | call test_size (size (array_1d)) | |
36 | call test_size (size (array_1d, 1)) | |
37 | do s1=1, SIZE (array_1d, 1), 1 | |
38 | call test_size (size (array_1d (1:10:s1))) | |
39 | call test_size (size (array_1d (1:10:s1), 1)) | |
40 | call test_size (size (array_1d (10:1:-s1))) | |
41 | call test_size (size (array_1d (10:1:-s1), 1)) | |
42 | end do | |
43 | ||
44 | do s2=1, SIZE (array_2d, 2), 1 | |
45 | do s1=1, SIZE (array_2d, 1), 1 | |
46 | call test_size (size (array_2d (1:4:s1, 1:3:s2))) | |
47 | call test_size (size (array_2d (4:1:-s1, 1:3:s2))) | |
48 | call test_size (size (array_2d (1:4:s1, 3:1:-s2))) | |
49 | call test_size (size (array_2d (4:1:-s1, 3:1:-s2))) | |
50 | ||
51 | call test_size (size (array_2d (1:4:s1, 1:3:s2), 1)) | |
52 | call test_size (size (array_2d (4:1:-s1, 1:3:s2), 1)) | |
53 | call test_size (size (array_2d (1:4:s1, 3:1:-s2), 1)) | |
54 | call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 1)) | |
55 | ||
56 | call test_size (size (array_2d (1:4:s1, 1:3:s2), 2)) | |
57 | call test_size (size (array_2d (4:1:-s1, 1:3:s2), 2)) | |
58 | call test_size (size (array_2d (1:4:s1, 3:1:-s2), 2)) | |
59 | call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 2)) | |
60 | end do | |
61 | end do | |
62 | ||
63 | allocate (allocatable_array_1d (-10:-5)) | |
64 | call test_size (size (allocatable_array_1d)) | |
65 | do s1=1, SIZE (allocatable_array_1d, 1), 1 | |
66 | call test_size (size (allocatable_array_1d (-10:-5:s1))) | |
67 | call test_size (size (allocatable_array_1d (-5:-10:-s1))) | |
68 | ||
69 | call test_size (size (allocatable_array_1d (-10:-5:s1), 1)) | |
70 | call test_size (size (allocatable_array_1d (-5:-10:-s1), 1)) | |
71 | end do | |
72 | ||
73 | allocate (allocatable_array_2d (-3:3, 8:12)) | |
74 | do s2=1, SIZE (allocatable_array_2d, 2), 1 | |
75 | do s1=1, SIZE (allocatable_array_2d, 1), 1 | |
76 | call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2))) | |
77 | call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2))) | |
78 | call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2))) | |
79 | call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2))) | |
80 | ||
81 | call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2), 1)) | |
82 | call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2), 2)) | |
83 | call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2), 1)) | |
84 | call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2), 2)) | |
85 | end do | |
86 | end do | |
87 | ||
88 | array_1d_p => array_1d | |
89 | call test_size (size (array_1d_p)) | |
90 | call test_size (size (array_1d_p, 1)) | |
91 | ||
92 | array_2d_p => array_2d | |
93 | call test_size (size (array_2d_p)) | |
94 | call test_size (size (array_2d_p, 1)) | |
95 | call test_size (size (array_2d_p, 2)) | |
96 | ||
97 | deallocate (allocatable_array_1d) | |
98 | deallocate (allocatable_array_2d) | |
99 | array_1d_p => null () | |
100 | array_2d_p => null () | |
101 | ||
102 | print *, "" ! Final Breakpoint | |
103 | print *, an_integer | |
104 | print *, a_real | |
105 | print *, associated (array_1d_p) | |
106 | print *, associated (array_2d_p) | |
107 | print *, allocated (allocatable_array_1d) | |
108 | print *, allocated (allocatable_array_2d) | |
109 | ||
110 | contains | |
111 | ||
112 | subroutine test_size (answer) | |
113 | integer :: answer | |
114 | ||
115 | print *,answer ! Test Breakpoint | |
116 | end subroutine test_size | |
117 | ||
118 | end program test |