xref: /netbsd-src/external/gpl3/gdb.old/dist/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 (revision f8cf1a9151c7af1cb0bd8b09c13c66bca599c027)
1! Copyright 2020-2023 Free Software Foundation, Inc.
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!
19program test
20  integer, dimension (1:10,1:11) :: array
21  character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz"
22
23  call fill_array_2d (array)
24
25  ! GDB catches this final breakpoint to indicate the end of the test.
26  print *, "" ! Stop Here
27
28  print *, array
29  print *, str
30
31  ! GDB catches this final breakpoint to indicate the end of the test.
32  print *, "" ! Final Breakpoint.
33
34contains
35
36  ! Fill a 1D array with a unique positive integer in each element.
37  subroutine fill_array_1d (array)
38    integer, dimension (:) :: array
39    integer :: counter
40
41    counter = 1
42    do j=LBOUND (array, 1), UBOUND (array, 1), 1
43       array (j) = counter
44       counter = counter + 1
45    end do
46  end subroutine fill_array_1d
47
48  ! Fill a 2D array with a unique positive integer in each element.
49  subroutine fill_array_2d (array)
50    integer, dimension (:,:) :: array
51    integer :: counter
52
53    counter = 1
54    do i=LBOUND (array, 2), UBOUND (array, 2), 1
55       do j=LBOUND (array, 1), UBOUND (array, 1), 1
56          array (j,i) = counter
57          counter = counter + 1
58       end do
59    end do
60  end subroutine fill_array_2d
61
62  ! Fill a 3D array with a unique positive integer in each element.
63  subroutine fill_array_3d (array)
64    integer, dimension (:,:,:) :: array
65    integer :: counter
66
67    counter = 1
68    do i=LBOUND (array, 3), UBOUND (array, 3), 1
69       do j=LBOUND (array, 2), UBOUND (array, 2), 1
70          do k=LBOUND (array, 1), UBOUND (array, 1), 1
71             array (k, j,i) = counter
72             counter = counter + 1
73          end do
74       end do
75    end do
76  end subroutine fill_array_3d
77
78  ! Fill a 4D array with a unique positive integer in each element.
79  subroutine fill_array_4d (array)
80    integer, dimension (:,:,:,:) :: array
81    integer :: counter
82
83    counter = 1
84    do i=LBOUND (array, 4), UBOUND (array, 4), 1
85       do j=LBOUND (array, 3), UBOUND (array, 3), 1
86          do k=LBOUND (array, 2), UBOUND (array, 2), 1
87             do l=LBOUND (array, 1), UBOUND (array, 1), 1
88                array (l, k, j,i) = counter
89                counter = counter + 1
90             end do
91          end do
92       end do
93    end do
94    print *, ""
95  end subroutine fill_array_4d
96end program test
97