Commit | Line | Data |
---|---|---|
42a4f53d | 1 | # Copyright 2016-2019 Free Software Foundation, Inc. |
9920b434 BH |
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 | standard_testfile ".f90" | |
17 | load_lib "fortran.exp" | |
18 | ||
5b362f04 | 19 | if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \ |
9920b434 BH |
20 | {debug f90 quiet}] } { |
21 | return -1 | |
22 | } | |
23 | ||
24 | if ![runto_main] { | |
25 | untested "could not run to main" | |
26 | return -1 | |
27 | } | |
28 | ||
29 | # Depending on the compiler being used, the type names can be printed differently. | |
30 | set int [fortran_int4] | |
31 | ||
32 | # Check if not allocated VLA in type does not break | |
33 | # the debugger when accessing it. | |
34 | gdb_breakpoint [gdb_get_line_number "before-allocated"] | |
35 | gdb_continue_to_breakpoint "before-allocated" | |
04d59df6 | 36 | gdb_test "print twov" " = \\\( ivla1 = <not allocated>, ivla2 = <not allocated> \\\)" \ |
9920b434 BH |
37 | "print twov before allocated" |
38 | gdb_test "print twov%ivla1" " = <not allocated>" \ | |
39 | "print twov%ivla1 before allocated" | |
40 | ||
41 | # Check type with one VLA's inside | |
42 | gdb_breakpoint [gdb_get_line_number "onev-filled"] | |
43 | gdb_continue_to_breakpoint "onev-filled" | |
44 | gdb_test "print onev%ivla(5, 11, 23)" " = 1" | |
45 | gdb_test "print onev%ivla(1, 2, 3)" " = 123" | |
46 | gdb_test "print onev%ivla(3, 2, 1)" " = 321" | |
47 | gdb_test "ptype onev" \ | |
48 | [multi_line "type = Type one" \ | |
bc68014d | 49 | "\\s+$int, allocatable :: ivla\\\(11,22,33\\\)" \ |
9920b434 BH |
50 | "End Type one" ] |
51 | ||
52 | # Check type with two VLA's inside | |
53 | gdb_breakpoint [gdb_get_line_number "twov-filled"] | |
54 | gdb_continue_to_breakpoint "twov-filled" | |
55 | gdb_test "print twov%ivla1(5, 11, 23)" " = 1" | |
56 | gdb_test "print twov%ivla1(1, 2, 3)" " = 123" | |
57 | gdb_test "print twov%ivla1(3, 2, 1)" " = 321" | |
58 | gdb_test "ptype twov" \ | |
59 | [multi_line "type = Type two" \ | |
bc68014d AB |
60 | "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \ |
61 | "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \ | |
9920b434 | 62 | "End Type two" ] |
04d59df6 | 63 | gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\ |
3e2e34f8 KB |
64 | \\\( 1, 1, 321, 1, 1\\\)\ |
65 | \\\( 1, 1, 1, 1, 1\\\) .*" | |
9920b434 BH |
66 | |
67 | # Check type with attribute at beginn of type | |
68 | gdb_breakpoint [gdb_get_line_number "threev-filled"] | |
69 | gdb_continue_to_breakpoint "threev-filled" | |
70 | gdb_test "print threev%ivla(1)" " = 1" | |
71 | gdb_test "print threev%ivla(5)" " = 42" | |
72 | gdb_test "print threev%ivla(14)" " = 24" | |
73 | gdb_test "print threev%ivar" " = 3" | |
74 | gdb_test "ptype threev" \ | |
75 | [multi_line "type = Type three" \ | |
76 | "\\s+$int :: ivar" \ | |
bc68014d | 77 | "\\s+$int, allocatable :: ivla\\\(20\\\)" \ |
9920b434 BH |
78 | "End Type three" ] |
79 | ||
80 | # Check type with attribute at end of type | |
81 | gdb_breakpoint [gdb_get_line_number "fourv-filled"] | |
82 | gdb_continue_to_breakpoint "fourv-filled" | |
83 | gdb_test "print fourv%ivla(1)" " = 1" | |
84 | gdb_test "print fourv%ivla(2)" " = 2" | |
85 | gdb_test "print fourv%ivla(7)" " = 7" | |
86 | gdb_test "print fourv%ivla(12)" "no such vector element" | |
87 | gdb_test "print fourv%ivar" " = 3" | |
88 | gdb_test "ptype fourv" \ | |
89 | [multi_line "type = Type four" \ | |
bc68014d | 90 | "\\s+$int, allocatable :: ivla\\\(10\\\)" \ |
9920b434 BH |
91 | "\\s+$int :: ivar" \ |
92 | "End Type four" ] | |
93 | ||
94 | # Check nested types containing a VLA | |
95 | gdb_breakpoint [gdb_get_line_number "fivev-filled"] | |
96 | gdb_continue_to_breakpoint "fivev-filled" | |
97 | gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1" | |
98 | gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123" | |
99 | gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321" | |
100 | gdb_test "ptype fivev" \ | |
101 | [multi_line "type = Type five" \ | |
e188eb36 | 102 | "\\s+Type one :: tone" \ |
9920b434 | 103 | "End Type five" ] |
86d8a848 BH |
104 | gdb_test "ptype fivev%tone" \ |
105 | [multi_line "type = Type one" \ | |
bc68014d | 106 | " $int, allocatable :: ivla\\(10,10,10\\)" \ |
86d8a848 | 107 | "End Type one" ] |
8f07e298 BH |
108 | |
109 | # Check array of types containing a VLA | |
110 | gdb_breakpoint [gdb_get_line_number "fivearr-filled"] | |
111 | gdb_continue_to_breakpoint "fivearr-filled" | |
112 | gdb_test "print fivearr(1)%tone%ivla(1, 2, 3)" " = 1" | |
113 | gdb_test "print fivearr(1)%tone%ivla(2, 2, 10)" "no such vector element" | |
114 | gdb_test "print fivearr(1)%tone%ivla(2, 2, 3)" " = 223" | |
115 | gdb_test "print fivearr(2)%tone%ivla(12, 14, 16)" " = 2" | |
116 | gdb_test "print fivearr(2)%tone%ivla(6, 7, 8)" " = 678" | |
117 | gdb_test "ptype fivearr(1)" \ | |
118 | [multi_line "type = Type five" \ | |
e188eb36 | 119 | "\\s+Type one :: tone" \ |
8f07e298 | 120 | "End Type five" ] |
86d8a848 BH |
121 | gdb_test "ptype fivearr(1)%tone" \ |
122 | [multi_line "type = Type one" \ | |
bc68014d | 123 | " $int, allocatable :: ivla\\(2,4,6\\)" \ |
86d8a848 | 124 | "End Type one" ] |
8f07e298 BH |
125 | gdb_test "ptype fivearr(2)" \ |
126 | [multi_line "type = Type five" \ | |
e188eb36 | 127 | "\\s+Type one :: tone" \ |
8f07e298 | 128 | "End Type five" ] |
86d8a848 BH |
129 | gdb_test "ptype fivearr(2)%tone" \ |
130 | [multi_line "type = Type one" \ | |
bc68014d | 131 | " $int, allocatable :: ivla\\(12,14,16\\)" \ |
86d8a848 | 132 | "End Type one" ] |
8f07e298 BH |
133 | |
134 | # Check allocation status of dynamic array and it's dynamic members | |
135 | gdb_test "ptype fivedynarr" "type = <not allocated>" | |
136 | gdb_test "next" "" | |
137 | gdb_test "ptype fivedynarr(2)" \ | |
138 | [multi_line "type = Type five" \ | |
e188eb36 | 139 | "\\s+Type one :: tone" \ |
8b70175d BH |
140 | "End Type five" ] \ |
141 | "ptype fivedynarr(2), tone is not allocated" | |
86d8a848 BH |
142 | gdb_test "ptype fivedynarr(2)%tone" \ |
143 | [multi_line "type = Type one" \ | |
bc68014d | 144 | " $int, allocatable :: ivla\\(<not allocated>\\)" \ |
86d8a848 BH |
145 | "End Type one" ] \ |
146 | "ptype fivedynarr(2)%tone, not allocated" | |
8f07e298 BH |
147 | |
148 | # Check dynamic array of types containing a VLA | |
149 | gdb_breakpoint [gdb_get_line_number "fivedynarr-filled"] | |
150 | gdb_continue_to_breakpoint "fivedynarr-filled" | |
151 | gdb_test "print fivedynarr(1)%tone%ivla(1, 2, 3)" " = 1" | |
152 | gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 10)" "no such vector element" | |
153 | gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 3)" " = 223" | |
154 | gdb_test "print fivedynarr(2)%tone%ivla(12, 14, 16)" " = 2" | |
155 | gdb_test "print fivedynarr(2)%tone%ivla(6, 7, 8)" " = 678" | |
156 | gdb_test "ptype fivedynarr(1)" \ | |
157 | [multi_line "type = Type five" \ | |
e188eb36 | 158 | "\\s+Type one :: tone" \ |
8f07e298 | 159 | "End Type five" ] |
86d8a848 BH |
160 | gdb_test "ptype fivedynarr(1)%tone" \ |
161 | [multi_line "type = Type one" \ | |
bc68014d | 162 | " $int, allocatable :: ivla\\(2,4,6\\)" \ |
86d8a848 | 163 | "End Type one" ] |
8f07e298 BH |
164 | gdb_test "ptype fivedynarr(2)" \ |
165 | [multi_line "type = Type five" \ | |
e188eb36 | 166 | "\\s+Type one :: tone" \ |
8f07e298 | 167 | "End Type five" ] |
86d8a848 BH |
168 | gdb_test "ptype fivedynarr(2)%tone" \ |
169 | [multi_line "type = Type one" \ | |
bc68014d | 170 | " $int, allocatable :: ivla\\(12,14,16\\)" \ |
86d8a848 | 171 | "End Type one" ] |