[patch/testsuite] lib/gdb.exp: native tcl gdb_get_line_number

[Michael Chastain <mec dot gnu at mindspring dot com>]

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: