This is the mail archive of the
gdb-patches@sources.redhat.com
mailing list for the GDB project.
[patch/testsuite] lib/gdb.exp: native tcl gdb_get_line_number
- From: Michael Chastain <mec dot gnu at mindspring dot com>
- To: gdb-patches at sources dot redhat dot com
- Date: Sun, 08 Aug 2004 12:14:36 -0400
- Subject: [patch/testsuite] lib/gdb.exp: native tcl gdb_get_line_number
Here is the rewrite of gdb_get_line_number.
Tested on:
native i686-pc-linux-gnu, gcc 2.95.3 3.3.4 3.4.1, dwarf-2 and stabs+,
tcl 8.4.6, expect 5.4.1, dejagnu 1.4.4
native i686-pc-linux-gnu, gcc 2.95.3 3.3.4 3.4.1, dwarf-2 and stabs+,
sourceware tcl+expect+dejagnu
native hppa2.0w-hp-hpux11.11, hp ansi c B.11.11.28706.GP and hp ac++ A.03.45,
tcl 8.4.6, expect 5.4.1, dejagnu 1.4.4
I am committing this now.
After this I can start writing patches for gdb.mi/*.exp to call
gdb_get_line_number. I'm open to guidance on how to organize those
patches.
Michael C
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.
Index: gdb.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/lib/gdb.exp,v
retrieving revision 1.52
diff -c -3 -p -r1.52 gdb.exp
*** gdb.exp 14 Jun 2004 15:29:30 -0000 1.52
--- gdb.exp 8 Aug 2004 10:46:24 -0000
*************** proc gdb_step_for_stub { } {
*** 1793,1858 ****
}
}
! ### 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.)
!
! proc gdb_get_line_number {text {file /omitted/}} {
! global gdb_prompt;
! global srcfile;
!
! if {! [string compare $file /omitted/]} {
! set file $srcfile
! }
!
! 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)"
! }
}
! return $result;
}
# gdb_continue_to_end:
--- 1793,1899 ----
}
}
! # 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 "" } } {
! global srcdir
! global subdir
! global srcfile
!
! if { "$file" == "" } then {
! set file "$srcfile"
! }
! if { ! [regexp "^/" "$file"] } then {
! set file "$srcdir/$subdir/$file"
! }
!
! if { [ catch { set fd [open "$file"] } message ] } then {
! perror "$message"
! return -1
! }
!
! 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: