aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.base/dbx.exp
blob: 30b77e19cd8d680aaa3b42f6409a256ed4915fad (plain)
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
# Copyright 1998-2021 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/>.  */


standard_testfile average.c sum.c

if {[build_executable $testfile.exp $testfile \
	 [list $srcfile $srcfile2] debug] == -1} {
    untested "failed to compile"
    return -1
}

#
# start gdb -- start gdb running, default procedure
#
proc dbx_gdb_start { } {
    global prompt
    global timeout
    global gdb_spawn_id

    save_vars { GDBFLAGS } {
	append GDBFLAGS " -dbx"

	set res [gdb_spawn]
	if { $res != 0} {
	    return $res
	}
    }

    set oldtimeout $timeout
    set timeout [expr "$timeout + 60"]
    gdb_expect {
        -re ".*\r\n$gdb_prompt $" {
            verbose "GDB initialized."
        }
        -re "$prompt $" {
            perror "GDB never initialized."
	    unset gdb_spawn_id
            return -1
        }
        timeout         {
            perror "(timeout) GDB never initialized."
	    unset gdb_spawn_id
            return -1
        }
    }
    set timeout $oldtimeout
    # force the height to "unlimited", so no pagers get used
    send_gdb "set height 0\n"
    gdb_expect {
        -re ".*$prompt $" {
            verbose "Setting height to 0." 2
        }
        timeout {
            warning "Couldn't set the height to 0."
        }
    }
    # force the width to "unlimited", so no wraparound occurs
    send_gdb "set width 0\n"
    gdb_expect {
        -re ".*$prompt $" {
            verbose "Setting width to 0." 2
        }
        timeout {
            warning "Couldn't set the width to 0."
        }
    }
}


proc dbx_reinitialize_dir { subdir } {
    global gdb_prompt

   send_gdb "use\n"
    gdb_expect {
        -re "Reinitialize source path to empty.*y or n. " {
            send_gdb "y\n"
            gdb_expect {
                -re "Source directories searched.*$gdb_prompt $" {
                    send_gdb "use $subdir\n"
                    gdb_expect {
                        -re "Source directories searched.*$gdb_prompt $" {
                            verbose "Dir set to $subdir"
                        }
                        -re ".*$gdb_prompt $" {
                            perror "Dir \"$subdir\" failed."
                        }
                    }
                }
                -re ".*$gdb_prompt $" {
                    perror "Dir \"$subdir\" failed."
                }
            }
        }
        -re ".*$gdb_prompt $" {
            perror "Dir \"$subdir\" failed."
        }
    }
}

# In "testsuite/config/unix-gdb.exp", the routine "gdb_load"
# is defined as "gdb_file_cmd".  The binding of "gdb_file_cmd"
# is done at invocation time.  Before this file is processed,
# it binds to the definition in "testsuite/lib/gdb.exp"; after
# this file is processed, it binds to this definition.
# TCL lets us overrides a previous routine definition without a
# warning (isn't that special?).
#
# This means that tests before use "file" to load a target, and
# tests afterwards use the pair "symbol-file" "exec-file".
#
# I'm leaving it as it is for now because at the moment it
# is the only test we have of the use of the combination of
# "symbol-file" and "exec-file" to load a debugging target (the
# other definition uses "file". 
#
# Symbol-file and exec-file should be tested explicitly, not
# as a side effect of running a particular test (in this case,
# "testsuite/gdb.compat/dbx.exp").
#
# CM: Renamed the procedure so it does not override the orginal file name.
#     Having the test suite change behavior depending on the tests run makes
#     it extremely difficult to reproduce errors. I've also added a
#     "dbx_gdb_load" procedure.  This and only this test will call these
#     procedures now. I also added an "expect" to the "send exec-file" line.
#     The "expect" waits for a prompt to appear. Otherwise, if the tests run
#     too quickly, the caller could send another command before the prompt
#     of this command returns, causing the test to get out of sync and fail
#     seemingly randomly or only on a loaded system.
#
# Problem is, though, that the testsuite config files can override the definition of
# gdb_load (without notice, as was mentioned above). Unfortunately, the gdb_load proc
# that was copied into this test was a copy of the unix native version.
#
# The real problem that we're attempting to solve is how to load an exec and symbol
# file into gdb for a dbx session. So why not just override gdb_file_cmd with the
# right sequence of events, allowing gdb_load to do its normal thing? This way
# remotes and simulators will work, too.
#

proc local_gdb_file_cmd {arg} {
    global loadpath
    global loadfile
    global GDB
    global gdb_prompt
    global spawn_id
    upvar timeout timeout
    global last_loaded_file

    set last_loaded_file $arg

    if [is_remote host] {
        set arg [remote_download host $arg]
        if { $arg == "" } {
            error "download failed"
            return -1
        }
    }

    send_gdb "symbol-file $arg\n"
    gdb_expect {
        -re "Reading symbols from.*$gdb_prompt $" {
            verbose "\t\tLoaded $arg into the $GDB"
            send_gdb "exec-file $arg\n" 
            gdb_expect {
	        -re "A program is being debugged already.*Kill it.*y or n. $" {
	            send_gdb "y\n"
	                verbose "\t\tKilling previous program being debugged"
	            exp_continue
	        }
                -re ".*$gdb_prompt $" {
                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
                    return 0
                }
                timeout {
                    perror "(timeout) Couldn't load $arg"
                    return -1
                }
            }
            return 0
        }
        -re "has no symbol-table.*$gdb_prompt $" {
            perror "$arg wasn't compiled with \"-g\""
            return -1
        }
        -re "Load new symbol table from \".*\".*y or n. $" {
            send_gdb "y\n"
	    exp_continue
        }
        -re ".*No such file or directory.*$gdb_prompt $" {
            perror "($arg) No such file or directory\n"
            return -1
        }
        -re "$gdb_prompt $" {
            perror "couldn't load $arg into $GDB."
            return -1
            }
        timeout {
            perror "couldn't load $arg into $GDB (timed out)."
            return -1
        }
        eof {
            # This is an attempt to detect a core dump, but seems not to
            # work.  Perhaps we need to match .* followed by eof, in which
            # expect does not seem to have a way to do that.
            perror "couldn't load $arg into $GDB (end of file)."
            return -1
        }
    }
}

#
#test_breakpoints
#
proc test_breakpoints { } {
    set stop_line [gdb_get_line_number "stop-in-main"]
    gdb_test "stop in main" "Breakpoint.*at.*: file.*average\.c, line $stop_line\."
    gdb_test "status" "Num.*Type.*Disp.*Enb.*Address.*What\r\n1\[ \r\]+breakpoint\[ \r\]+keep y.*in main at.*average\.c:$stop_line.*"
    set stop_line [gdb_get_line_number "stop-at-call"]
    gdb_test "stop at average.c:$stop_line" "Breakpoint.*at.*: file.*average\.c, line $stop_line.*"
    gdb_test "stop in average.c:$stop_line" "Usage: stop in <function . address>"
    gdb_test "stop at main" "Usage: stop at LINE"
}

#
#test_assign
#
proc test_assign { } {
    global decimal
    global gdb_prompt

    gdb_run_cmd
    set test "running to main"
    gdb_test_multiple "" $test {
        -re "Break.* at .*:$decimal.*$gdb_prompt $" {
	    pass $test
	}
        -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in .*$gdb_prompt $" {
	    pass $test
	}
    }
    send_gdb "assign first=1\n"
    gdb_expect {
      -re "No symbol \"first\" in current context.*$" { fail "assign first" }
      -re "$gdb_prompt $" { pass "assign first" }
      timeout { fail "assign first (timeout)" }
    }
    gdb_test "print first" ".1 = 1"
}

#
#test_whereis
#
proc test_whereis { } {
    gdb_test "whereis my_list" "All variables matching regular expression \"my_list\":\r\n\r\nFile.*average\.c:\r\n.*\tstatic int my_list\\\[10\\\];"
}

#
#test_func
#
proc test_func { } {
    global decimal
    global srcfile2
    gdb_test "cont" ".*" "cont 1"
    gdb_test "step" ".*"
    gdb_test "func sum" "'sum' not within current stack frame\."
    set stop_line [gdb_get_line_number "stop-in-sum" $srcfile2]
    gdb_test "stop in sum" "Breakpoint.*at.*: file.*sum\.c, line $stop_line\."
    gdb_test "cont" ".*" "cont 2"
    gdb_test "func print_average" ".*in print_average.*\\(list=.*, low=0, high=6\\).*at.*average\.c:${decimal}\r\n${decimal}\[ \t\]+total = sum\\(list, low, high\\);"
}

# Start with a fresh gdb.

gdb_exit

with_override gdb_file_cmd local_gdb_file_cmd {
    save_vars GDBFLAGS {
	set GDBFLAGS "$GDBFLAGS --dbx"

	gdb_start
	dbx_reinitialize_dir $srcdir/$subdir
	gdb_load ${binfile}

	test_breakpoints
	test_assign
	test_whereis
	gdb_test "file average.c:1" "1\[ \t\]+/. This is a sample program.*"
	test_func

	#exit and cleanup
	gdb_exit
    }
}

return 0