]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/testsuite/gdb.fortran/shape.f90
Update copyright year range in header of all files managed by GDB
[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.fortran / shape.f90
CommitLineData
1d506c26 1! Copyright 2021-2024 Free Software Foundation, Inc.
eef32f59
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!
19program 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 call test_shape (shape (array_1d))
32 call test_shape (shape (array_2d))
33 call test_shape (shape (an_integer))
34 call test_shape (shape (a_real))
35
36 call test_shape (shape (array_1d (1:10:2)))
37 call test_shape (shape (array_1d (1:10:3)))
38
39 call test_shape (shape (array_2d (4:1:-1, 3:1:-1)))
40 call test_shape (shape (array_2d (4:1:-1, 1:3:2)))
41
42 allocate (allocatable_array_1d (-10:-5))
43 allocate (allocatable_array_2d (-3:3, 8:12))
44
45 call test_shape (shape (allocatable_array_1d))
46 call test_shape (shape (allocatable_array_2d))
47
48 call test_shape (shape (allocatable_array_2d (-2, 10:12)))
49
50 array_1d_p => array_1d
51 array_2d_p => array_2d
52
53 call test_shape (shape (array_1d_p))
54 call test_shape (shape (array_2d_p))
55
56 deallocate (allocatable_array_1d)
57 deallocate (allocatable_array_2d)
58 array_1d_p => null ()
59 array_2d_p => null ()
60
61 print *, "" ! Final Breakpoint
62 print *, an_integer
63 print *, a_real
64 print *, associated (array_1d_p)
65 print *, associated (array_2d_p)
66 print *, allocated (allocatable_array_1d)
67 print *, allocated (allocatable_array_2d)
68
69contains
70
71 subroutine test_shape (answer)
72 integer, dimension (:) :: answer
73
74 print *,answer ! Test Breakpoint
75 end subroutine test_shape
76
77end program test