mirror of
https://github.com/darlinghq/darling-gdb.git
synced 2025-02-26 12:25:31 +00:00
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:
parent
ecac404d3f
commit
c6fee70509
@ -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>.
|
||||
|
@ -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:
|
||||
|
Loading…
x
Reference in New Issue
Block a user