2004-08-08 Michael Chastain <mec.gnu@mindspring.com>

* lib/gdb.exp (gdb_get_line_number): Rewrite with native tcl
	rather than asking gdb to search.
This commit is contained in:
Michael Chastain 2004-08-08 16:16:42 +00:00
parent ecac404d3f
commit c6fee70509
2 changed files with 101 additions and 55 deletions

View File

@ -1,3 +1,8 @@
2004-08-08 Michael Chastain <mec.gnu@mindspring.com>
* lib/gdb.exp (gdb_get_line_number): Rewrite with native tcl
rather than asking gdb to search.
2004-08-05 Michael Chastain <mec.gnu@mindspring.com>
* gdb.base/gcore.c: Include <string.h>.

View File

@ -1793,66 +1793,107 @@ proc gdb_step_for_stub { } {
}
}
### gdb_get_line_number TEXT [FILE]
###
### Search the source file FILE, and return the line number of a line
### containing TEXT. Use this function instead of hard-coding line
### numbers into your test script.
###
### Specifically, this function uses GDB's "search" command to search
### FILE for the first line containing TEXT, and returns its line
### number. Thus, FILE must be a source file, compiled into the
### executable you are running. If omitted, FILE defaults to the
### value of the global variable `srcfile'; most test scripts set
### `srcfile' appropriately at the top anyway.
###
### Use this function to keep your test scripts independent of the
### exact line numbering of the source file. Don't write:
###
### send_gdb "break 20"
###
### This means that if anyone ever edits your test's source file,
### your test could break. Instead, put a comment like this on the
### source file line you want to break at:
###
### /* breakpoint spot: frotz.exp: test name */
###
### and then write, in your test script (which we assume is named
### frotz.exp):
###
### send_gdb "break [gdb_get_line_number "frotz.exp: test name"]\n"
###
### (Yes, Tcl knows how to handle the nested quotes and brackets.
### Try this:
### $ tclsh
### % puts "foo [lindex "bar baz" 1]"
### foo baz
### %
### Tcl is quite clever, for a little stringy language.)
# gdb_get_line_number TEXT [FILE]
#
# Search the source file FILE, and return the line number of the
# first line containing TEXT. If no match is found, return -1.
#
# TEXT is a string literal, not a regular expression.
#
# The default value of FILE is "$srcdir/$subdir/$srcfile". If FILE is
# specified, and does not start with "/", then it is assumed to be in
# "$srcdir/$subdir". This is awkward, and can be fixed in the future,
# by changing the callers and the interface at the same time.
# In particular: gdb.base/break.exp, gdb.base/condbreak.exp,
# gdb.base/ena-dis-br.exp.
#
# Use this function to keep your test scripts independent of the
# exact line numbering of the source file. Don't write:
#
# send_gdb "break 20"
#
# This means that if anyone ever edits your test's source file,
# your test could break. Instead, put a comment like this on the
# source file line you want to break at:
#
# /* breakpoint spot: frotz.exp: test name */
#
# and then write, in your test script (which we assume is named
# frotz.exp):
#
# send_gdb "break [gdb_get_line_number "frotz.exp: test name"]\n"
#
# (Yes, Tcl knows how to handle the nested quotes and brackets.
# Try this:
# $ tclsh
# % puts "foo [lindex "bar baz" 1]"
# foo baz
# %
# Tcl is quite clever, for a little stringy language.)
#
# ===
#
# The previous implementation of this procedure used the gdb search command.
# This version is different:
#
# . It works with MI, and it also works when gdb is not running.
#
# . It operates on the build machine, not the host machine.
#
# . For now, this implementation fakes a current directory of
# $srcdir/$subdir to be compatible with the old implementation.
# This will go away eventually and some callers will need to
# be changed.
#
# . The TEXT argument is literal text and matches literally,
# not a regular expression as it was before.
#
# . State changes in gdb, such as changing the current file
# and setting $_, no longer happen.
#
# After a bit of time we can forget about the differences from the
# old implementation.
#
# --chastain 2004-08-05
proc gdb_get_line_number {text {file /omitted/}} {
global gdb_prompt;
global srcfile;
proc gdb_get_line_number { text { file "" } } {
global srcdir
global subdir
global srcfile
if {! [string compare $file /omitted/]} {
set file $srcfile
if { "$file" == "" } then {
set file "$srcfile"
}
if { ! [regexp "^/" "$file"] } then {
set file "$srcdir/$subdir/$file"
}
set result -1;
gdb_test "list ${file}:1,1" ".*" ""
send_gdb "search ${text}\n"
gdb_expect {
-re "\[\r\n\]+(\[0-9\]+)\[ \t\].*${text}.*$gdb_prompt $" {
set result $expect_out(1,string)
}
-re ".*$gdb_prompt $" {
fail "find line number containing \"${text}\""
}
timeout {
fail "find line number containing \"${text}\" (timeout)"
}
if { [ catch { set fd [open "$file"] } message ] } then {
perror "$message"
return -1
}
return $result;
set found -1
for { set line 1 } { 1 } { incr line } {
if { [ catch { set nchar [gets "$fd" body] } message ] } then {
perror "$message"
return -1
}
if { $nchar < 0 } then {
break
}
if { [string first "$text" "$body"] >= 0 } then {
set found $line
break
}
}
if { [ catch { close "$fd" } message ] } then {
perror "$message"
return -1
}
return $found
}
# gdb_continue_to_end: