xref: /netbsd-src/external/gpl3/gdb.old/dist/gdb/testsuite/gdb.fortran/array-slices.f90 (revision d16b7486a53dcb8072b60ec6fcb4373a2d0c27b7)
1! Copyright 2019-2020 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
16subroutine show (message, array)
17  character (len=*) :: message
18  integer, dimension (:,:) :: array
19
20  print *, message
21  do i=LBOUND (array, 2), UBOUND (array, 2), 1
22     do j=LBOUND (array, 1), UBOUND (array, 1), 1
23        write(*, fmt="(i4)", advance="no") array (j, i)
24     end do
25     print *, ""
26 end do
27 print *, array
28 print *, ""
29
30end subroutine show
31
32program test
33
34  interface
35     subroutine show (message, array)
36       character (len=*) :: message
37       integer, dimension(:,:) :: array
38     end subroutine show
39  end interface
40
41  integer, dimension (1:10,1:10) :: array
42  integer, allocatable :: other (:, :)
43
44  allocate (other (-5:4, -2:7))
45
46  do i=LBOUND (array, 2), UBOUND (array, 2), 1
47     do j=LBOUND (array, 1), UBOUND (array, 1), 1
48        array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
49     end do
50  end do
51
52  do i=LBOUND (other, 2), UBOUND (other, 2), 1
53     do j=LBOUND (other, 1), UBOUND (other, 1), 1
54        other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
55     end do
56  end do
57
58  call show ("array", array)
59  call show ("array (1:5,1:5)", array (1:5,1:5))
60  call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
61  call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
62  call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
63
64  call show ("other", other)
65  call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
66  call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
67
68  deallocate (other)
69  print *, "" ! Final Breakpoint.
70end program test
71