]>
Commit | Line | Data |
---|---|---|
f1717362 | 1 | # Copyright (C) 2009-2016 Free Software Foundation, Inc. |
54338c02 | 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 GCC; see the file COPYING3. If not see | |
15 | # <http://www.gnu.org/licenses/>. | |
16 | ||
17 | global gdb_tests | |
18 | set gdb_tests {} | |
19 | ||
20 | # Scan a file for markers and fill in the gdb_marker array for that | |
21 | # file. Any error in this script is simply thrown; errors here are | |
22 | # programming errors in the test suite itself and should not be | |
23 | # caught. | |
24 | proc scan_gdb_markers {filename} { | |
25 | global gdb_markers | |
26 | ||
27 | if {[info exists gdb_markers($filename,-)]} { | |
28 | return | |
29 | } | |
30 | ||
31 | set fd [open $filename] | |
32 | set lineno 1 | |
33 | while {! [eof $fd]} { | |
34 | set line [gets $fd] | |
35 | if {[regexp -- "Mark (\[a-zA-Z0-9\]+)" $line ignore marker]} { | |
36 | set gdb_markers($filename,$marker) $lineno | |
37 | } | |
38 | incr lineno | |
39 | } | |
40 | close $fd | |
41 | ||
42 | set gdb_markers($filename,-) {} | |
43 | } | |
44 | ||
45 | # Find a marker in a source file, and return the marker's line number. | |
46 | proc get_line_number {filename marker} { | |
47 | global gdb_markers | |
48 | ||
49 | scan_gdb_markers $filename | |
50 | return $gdb_markers($filename,$marker) | |
51 | } | |
52 | ||
53 | # Make note of a gdb test. A test consists of a variable name and an | |
54 | # expected result. | |
55 | proc note-test {var result} { | |
56 | global gdb_tests | |
57 | ||
cd587d4d | 58 | lappend gdb_tests $var $result 0 |
59 | } | |
60 | ||
61 | # A test that uses a regular expression. This is like note-test, but | |
62 | # the result is a regular expression that is matched against the | |
63 | # output. | |
64 | proc regexp-test {var result} { | |
65 | global gdb_tests | |
66 | ||
67 | lappend gdb_tests $var $result 1 | |
54338c02 | 68 | } |
69 | ||
0ed3336a | 70 | # A test of 'whatis'. This tests a type rather than a variable. |
71 | proc whatis-test {var result} { | |
72 | global gdb_tests | |
73 | ||
74 | lappend gdb_tests $var $result whatis | |
75 | } | |
76 | ||
54338c02 | 77 | # Utility for testing variable values using gdb, invoked via dg-final. |
cd587d4d | 78 | # Tests all tests indicated by note-test and regexp-test. |
54338c02 | 79 | # |
80 | # Argument 0 is the marker on which to put a breakpoint | |
81 | # Argument 2 handles expected failures and the like | |
3ef8d391 | 82 | proc gdb-test { marker {selector {}} {load_xmethods 0} } { |
54338c02 | 83 | if { ![isnative] || [is_remote target] } { return } |
84 | ||
85 | if {[string length $selector] > 0} { | |
86 | switch [dg-process-target $selector] { | |
87 | "S" { } | |
88 | "N" { return } | |
89 | "F" { setup_xfail "*-*-*" } | |
90 | "P" { } | |
91 | } | |
92 | } | |
93 | ||
b0a6074c | 94 | set do_whatis_tests [gdb_batch_check "python print(gdb.type_printers)" \ |
0ed3336a | 95 | "\\\[\\\]"] |
96 | if {!$do_whatis_tests} { | |
97 | send_log "skipping 'whatis' tests - gdb too old" | |
98 | } | |
99 | ||
54338c02 | 100 | # This assumes that we are three frames down from dg-test, and that |
101 | # it still stores the filename of the testcase in a local variable "name". | |
102 | # A cleaner solution would require a new DejaGnu release. | |
103 | upvar 2 name testcase | |
104 | upvar 2 prog prog | |
105 | ||
106 | set line [get_line_number $prog $marker] | |
107 | ||
108 | set gdb_name $::env(GUALITY_GDB_NAME) | |
109 | set testname "$testcase" | |
110 | set output_file "[file rootname [file tail $prog]].exe" | |
111 | set cmd_file "[file rootname [file tail $prog]].gdb" | |
112 | ||
113 | global srcdir | |
3ef8d391 | 114 | set printer_code [file join $srcdir .. python libstdcxx v6 printers.py] |
115 | set xmethod_code [file join $srcdir .. python libstdcxx v6 xmethods.py] | |
54338c02 | 116 | |
117 | global gdb_tests | |
118 | ||
119 | set fd [open $cmd_file "w"] | |
a2611b62 | 120 | # We don't want the system copy of the pretty-printers loaded |
121 | puts $fd "set auto-load no" | |
122 | # Now that we've disabled auto-load, it's safe to set the target file | |
123 | puts $fd "file ./$output_file" | |
124 | # Load & register *our* copy of the pretty-printers | |
3ef8d391 | 125 | puts $fd "source $printer_code" |
54338c02 | 126 | puts $fd "python register_libstdcxx_printers(None)" |
3ef8d391 | 127 | if { $load_xmethods } { |
128 | # Load a& register xmethods. | |
129 | puts $fd "source $xmethod_code" | |
130 | puts $fd "python register_libstdcxx_xmethods(None)" | |
131 | } | |
a2611b62 | 132 | # And start the program |
54338c02 | 133 | puts $fd "break $line" |
134 | puts $fd "run" | |
a2611b62 | 135 | # So we can verify that we're using the right libs ... |
136 | puts $fd "info share" | |
54338c02 | 137 | |
138 | set count 0 | |
0ed3336a | 139 | foreach {var result kind} $gdb_tests { |
54338c02 | 140 | incr count |
141 | set gdb_var($count) $var | |
142 | set gdb_expected($count) $result | |
0ed3336a | 143 | if {$kind == "whatis"} { |
144 | if {$do_whatis_tests} { | |
145 | set gdb_is_type($count) 1 | |
146 | set gdb_command($count) "whatis $var" | |
147 | } else { | |
148 | unsupported "$testname" | |
149 | close $fd | |
150 | return | |
151 | } | |
152 | } else { | |
153 | set gdb_is_type($count) 0 | |
154 | set gdb_is_regexp($count) $kind | |
155 | set gdb_command($count) "print $var" | |
156 | } | |
157 | puts $fd $gdb_command($count) | |
54338c02 | 158 | } |
159 | set gdb_tests {} | |
160 | ||
161 | puts $fd "quit" | |
162 | close $fd | |
163 | ||
a2611b62 | 164 | set res [remote_spawn target "$gdb_name -nx -nw -quiet -batch -x $cmd_file "] |
54338c02 | 165 | if { $res < 0 || $res == "" } { |
166 | unsupported "$testname" | |
167 | return | |
168 | } | |
169 | ||
0ed3336a | 170 | set test_counter 0 |
54338c02 | 171 | remote_expect target [timeout_value] { |
0ed3336a | 172 | -re {^(type|\$([0-9]+)) = ([^\n\r]*)[\n\r]+} { |
cd587d4d | 173 | send_log "got: $expect_out(buffer)" |
174 | ||
0ed3336a | 175 | incr test_counter |
176 | set first $expect_out(3,string) | |
177 | ||
178 | if {$gdb_is_type($test_counter)} { | |
179 | if {$expect_out(1,string) != "type"} { | |
180 | error "gdb failure" | |
181 | } | |
182 | set match [expr {![string compare $first \ | |
183 | $gdb_expected($test_counter)]}] | |
184 | } elseif {$gdb_is_regexp($test_counter)} { | |
185 | set match [regexp -- $gdb_expected($test_counter) $first] | |
cd587d4d | 186 | } else { |
0ed3336a | 187 | set match [expr {![string compare $first \ |
188 | $gdb_expected($test_counter)]}] | |
cd587d4d | 189 | } |
190 | ||
191 | if {$match} { | |
0ed3336a | 192 | pass "$testname $gdb_command($test_counter)" |
54338c02 | 193 | } else { |
0ed3336a | 194 | fail "$testname $gdb_command($test_counter)" |
54338c02 | 195 | verbose " got =>$first<=" |
0ed3336a | 196 | verbose "expected =>$gdb_expected($test_counter)<=" |
54338c02 | 197 | } |
198 | ||
0ed3336a | 199 | if {$test_counter == $count} { |
54338c02 | 200 | remote_close target |
201 | return | |
202 | } else { | |
203 | exp_continue | |
204 | } | |
205 | } | |
206 | ||
207 | -re {Python scripting is not supported in this copy of GDB.[\n\r]+} { | |
208 | unsupported "$testname" | |
209 | remote_close target | |
210 | return | |
211 | } | |
212 | ||
213 | -re {^[^$][^\n\r]*[\n\r]+} { | |
cd587d4d | 214 | send_log "skipping: $expect_out(buffer)" |
54338c02 | 215 | exp_continue |
216 | } | |
217 | ||
218 | timeout { | |
219 | unsupported "$testname" | |
220 | remote_close target | |
221 | return | |
222 | } | |
223 | } | |
224 | ||
225 | remote_close target | |
226 | unsupported "$testname" | |
227 | return | |
228 | } | |
229 | ||
0ed3336a | 230 | # Invoke gdb with a command and pattern-match the output. |
231 | proc gdb_batch_check {command pattern} { | |
54338c02 | 232 | set gdb_name $::env(GUALITY_GDB_NAME) |
0ed3336a | 233 | set cmd "$gdb_name -nw -nx -quiet -batch -ex \"$command\"" |
54338c02 | 234 | send_log "Spawning: $cmd\n" |
d84e7fa1 | 235 | if [catch { set res [remote_spawn target "$cmd"] } ] { |
236 | return 0 | |
237 | } | |
54338c02 | 238 | if { $res < 0 || $res == "" } { |
239 | return 0 | |
240 | } | |
241 | ||
242 | remote_expect target [timeout_value] { | |
0ed3336a | 243 | -re $pattern { |
54338c02 | 244 | return 1 |
245 | } | |
246 | ||
247 | -re {^[^\n\r]*[\n\r]+} { | |
248 | verbose "skipping: $expect_out(buffer)" | |
249 | exp_continue | |
250 | } | |
251 | ||
252 | timeout { | |
253 | remote_close target | |
254 | return 0 | |
255 | } | |
256 | } | |
257 | ||
258 | remote_close target | |
259 | return 0 | |
260 | } | |
0ed3336a | 261 | |
262 | # Check for a new-enough version of gdb. The pretty-printer tests | |
263 | # require gdb 7.3, but we don't want to test versions, so instead we | |
264 | # check for the python "lookup_global_symbol" method, which is in 7.3 | |
265 | # but not earlier versions. | |
266 | # Return 1 if the version is ok, 0 otherwise. | |
267 | proc gdb_version_check {} { | |
b0a6074c | 268 | return [gdb_batch_check "python print(gdb.lookup_global_symbol)" \ |
0ed3336a | 269 | "<built-in function lookup_global_symbol>"] |
270 | } | |
3ef8d391 | 271 | |
272 | # Check for a version of gdb which supports xmethod tests. It is done | |
273 | # in a manner similar to the check for a version of gdb which supports the | |
274 | # pretty-printer tests below. | |
275 | proc gdb_version_check_xmethods {} { | |
276 | return [gdb_batch_check \ | |
277 | "python import gdb.xmethod; print(gdb.xmethod.XMethod)" \ | |
278 | "<class 'gdb\\.xmethod\\.XMethod'>"] | |
279 | } |