1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
# Copyright 2003-2018 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# Find a pathname to a file that we would execute if the shell was asked
# to run $arg using the current PATH.
proc find_gdb { arg } {
# If the arg directly specifies an existing executable file, then
# simply use it.
if [file executable $arg] then {
return $arg
}
set result [which $arg]
if [string match "/" [ string range $result 0 0 ]] then {
return $result
}
# If everything fails, just return the unqualified pathname as default
# and hope for best.
return $arg
}
# A helper proc that sets up for self-testing.
# EXECUTABLE is the gdb to use.
# FUNCTION is the function to break in, either captured_main
# or captured_command_loop.
proc selftest_setup { executable function } {
global gdb_prompt
global timeout
global INTERNAL_GDBFLAGS
# load yourself into the debugger
# This can take a relatively long time, particularly for testing where
# the executable is being accessed over a network, or where gdb does not
# support partial symbols for a particular target and has to load the
# entire symbol table. Set the timeout to 10 minutes, which should be
# adequate for most environments (it *has* timed out with 5 min on a
# SPARCstation SLC under moderate load, so this isn't unreasonable).
# After gdb is started, set the timeout to 30 seconds for the duration
# of this test, and then back to the original value.
set oldtimeout $timeout
set timeout 600
verbose "Timeout is now $timeout seconds" 2
global gdb_file_cmd_debug_info
set gdb_file_cmd_debug_info "unset"
set result [gdb_load $executable]
set timeout $oldtimeout
verbose "Timeout is now $timeout seconds" 2
if { $result != 0 } then {
return -1
}
if { $gdb_file_cmd_debug_info != "debug" } then {
untested "no debug information, skipping testcase."
return -1
}
# Set a breakpoint at main
gdb_test "break $function" \
"Breakpoint.*at.* file.*, line.*" \
"breakpoint in $function"
# run yourself
# It may take a very long time for the inferior gdb to start (lynx),
# so we bump it back up for the duration of this command.
set timeout 600
set description "run until breakpoint at $function"
gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" {
-re "Starting program.*Breakpoint \[0-9\]+,.*$function \\(.*\\).* at .*main.c:.*$gdb_prompt $" {
pass "$description"
}
-re "Starting program.*Breakpoint \[0-9\]+,.*$function \\(.*\\).*$gdb_prompt $" {
xfail "$description (line numbers scrambled?)"
}
-re "vfork: No more processes.*$gdb_prompt $" {
fail "$description (out of virtual memory)"
set timeout $oldtimeout
verbose "Timeout is now $timeout seconds" 2
return -1
}
-re ".*$gdb_prompt $" {
fail "$description"
set timeout $oldtimeout
verbose "Timeout is now $timeout seconds" 2
return -1
}
}
set timeout $oldtimeout
verbose "Timeout is now $timeout seconds" 2
return 0
}
# A simple way to run some self-tests.
proc do_self_tests {function body} {
global GDB tool
# Are we testing with a remote board? In that case, the target
# won't have access to the GDB's auxilliary data files
# (data-directory, etc.). It's simpler to just skip.
if [is_remote target] {
return
}
# ... or seemingly testing with a cross debugger? Likely GDB
# wouldn't be able to debug itself then...
if ![isnative] {
return
}
# ... or with a stub-like server? I.e., gdbserver + "target
# remote"? In that case we won't be able to pass command line
# arguments to GDB, and selftest_setup wants to do exactly that.
if [use_gdb_stub] {
return
}
# Run the test with self. Copy the file executable file in case
# this OS doesn't like to edit its own text space.
set GDB_FULLPATH [find_gdb $GDB]
if {[is_remote host]} {
set xgdb x$tool
} else {
set xgdb [standard_output_file x$tool]
}
# Remove any old copy lying around.
remote_file host delete $xgdb
gdb_start
set file [remote_download host $GDB_FULLPATH $xgdb]
set result [selftest_setup $file $function]
if {$result == 0} then {
set result [uplevel $body]
}
gdb_exit
catch "remote_file host delete $file"
if {$result < 0} then {
warning "Couldn't test self"
}
}
|
