From 40a7f1e93a368e0d5711d3804f740f619a7d36c3 Mon Sep 17 00:00:00 2001 From: Martin Hunt Date: Fri, 29 Jan 1999 08:56:14 +0000 Subject: 1999-01-29 Martin Hunt * gdbtk.c (gdbtk_init): Create tcl warp_pointer command for use with testing. * gdbtk-cmds.c (gdb_loc): Fix for case where there are only minimal symbols. Also make gdb_loc return the shared library the location is in, if it is in one. --- gdb/ChangeLog-gdbtk | 9 ++ gdb/gdbtk-cmds.c | 43 +++-- gdb/gdbtk.c | 4 + gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk | 19 +++ gdb/testsuite/gdb.gdbtk/srcwin.exp | 15 ++ gdb/testsuite/gdb.gdbtk/srcwin.test | 269 +++++++++++++++++++++++++++++++- 6 files changed, 346 insertions(+), 13 deletions(-) create mode 100644 gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk (limited to 'gdb') diff --git a/gdb/ChangeLog-gdbtk b/gdb/ChangeLog-gdbtk index 5d01308..84ec468 100644 --- a/gdb/ChangeLog-gdbtk +++ b/gdb/ChangeLog-gdbtk @@ -1,3 +1,12 @@ +1999-01-29 Martin Hunt + + * gdbtk.c (gdbtk_init): Create tcl warp_pointer command + for use with testing. + + * gdbtk-cmds.c (gdb_loc): Fix for case where there are only + minimal symbols. Also make gdb_loc return the shared library + the location is in, if it is in one. + 1999-01-27 James Ingham * gdbtk-wrapper.c: Missed a couple of places where FILE->GDB_FILE diff --git a/gdb/gdbtk-cmds.c b/gdb/gdbtk-cmds.c index 8c13f36..19311c6 100644 --- a/gdb/gdbtk-cmds.c +++ b/gdb/gdbtk-cmds.c @@ -2361,7 +2361,7 @@ gdb_loc (clientData, interp, objc, objv) char *filename; struct symtab_and_line sal; struct symbol *sym; - char *fname; + char *funcname, *fname; CORE_ADDR pc; if (objc == 1) @@ -2372,8 +2372,8 @@ gdb_loc (clientData, interp, objc, objv) /* For a graphical debugger we really want to highlight the */ /* assembly line that called the next function on the stack. */ /* Many architectures have the next instruction saved as the */ - /* pc on the stack, so what happens is the next instruction is hughlighted. */ - /* FIXME */ + /* pc on the stack, so what happens is the next instruction */ + /* is highlighted. FIXME */ pc = selected_frame->pc; sal = find_pc_line (selected_frame->pc, selected_frame->next != NULL @@ -2432,19 +2432,44 @@ gdb_loc (clientData, interp, objc, objv) } else { - Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, - Tcl_NewStringObj ("", -1)); + /* find_pc_function will fail if there are only minimal symbols */ + /* so do this instead... */ + find_pc_partial_function (pc, &funcname, NULL, NULL); + /* we try cplus demangling; a guess really */ + fname = cplus_demangle (funcname, 0); + if (fname) + { + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewStringObj (fname, -1)); + free (fname); + } + else + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewStringObj (funcname, -1)); } - + filename = symtab_to_filename (sal.symtab); if (filename == NULL) filename = ""; + /* file name */ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewStringObj (filename, -1)); - Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line)); /* line number */ - sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */ - sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */ + /* line number */ + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line)); + /* PC in current frame */ + sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); + /* Real PC */ + sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); + + /* shared library */ +#ifdef PC_SOLIB + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewStringObj (PC_SOLIB(pc), -1)); +#else + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewStringObj ("", -1)); +#endif return TCL_OK; } diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index 6b975cd..61075fb 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -493,6 +493,10 @@ gdbtk_init ( argv0 ) /* Path conversion functions. */ if (ide_create_cygwin_path_command (gdbtk_interp) != TCL_OK) error ("cygwin path command initialization failed"); +#else + /* for now, this testing function is Unix only */ + if (cyg_create_warp_pointer_command (gdbtk_interp) != TCL_OK) + error ("warp_pointer command initialization failed"); #endif /* diff --git a/gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk b/gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk new file mode 100644 index 0000000..9162d41 --- /dev/null +++ b/gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk @@ -0,0 +1,19 @@ +1999-01-29 Martin Hunt + + * srcwin.exp: Add srcwin2.test, which are basically the same + tests as srcwin.test, but run with a missing source file. + + * srcwin2.test: New file. + + * srcwin.test: Add tests for setting breakpoints in the source window, + testing BP balloons, variable balloons, and mixed-mode disassembly + of include files. + + +Local Variables: +mode: change-log +left-margin: 8 +fill-column: 74 +version-control: never +End: + \ No newline at end of file diff --git a/gdb/testsuite/gdb.gdbtk/srcwin.exp b/gdb/testsuite/gdb.gdbtk/srcwin.exp index bd4557c..c919fe6 100644 --- a/gdb/testsuite/gdb.gdbtk/srcwin.exp +++ b/gdb/testsuite/gdb.gdbtk/srcwin.exp @@ -26,7 +26,22 @@ if {![info exists ::env(DISPLAY)]} { gdb_exit set results [gdbtk_start [file join $srcdir $subdir srcwin.test]] set results [split $results \n] + # Analyze results + gdbtk_analyze_results $results + # move file with "main" out of the way + file rename $srcdir/gdb.base/list0.c $srcdir/gdb.base/list0.c.save + # run slightly different set of tests + gdb_exit + set results [gdbtk_start [file join $srcdir $subdir srcwin2.test]] + set results [split $results \n] + #restore file + file rename $srcdir/gdb.base/list0.c.save $srcdir/gdb.base/list0.c # Analyze results gdbtk_analyze_results $results } + +# Local variables: +# mode: tcl +# change-log-default-name: "ChangeLog-gdbtk" +# End: diff --git a/gdb/testsuite/gdb.gdbtk/srcwin.test b/gdb/testsuite/gdb.gdbtk/srcwin.test index f13d3d0..05bba72 100644 --- a/gdb/testsuite/gdb.gdbtk/srcwin.test +++ b/gdb/testsuite/gdb.gdbtk/srcwin.test @@ -25,7 +25,24 @@ if {![gdbtk_read_defs]} { break } -global objdir test_ran +global objdir srcdir + + +# move the pointer to the center of the bbox relative to $win +proc move_mouse_to {win bbox} { + set x [expr [lindex $bbox 0] + [lindex $bbox 2] / 2] + set y [expr [lindex $bbox 1] + [lindex $bbox 3] / 2] + warp_pointer . [winfo rootx $win] [winfo rooty $win] + + set nx 0 + set ny 0 + + while {$nx != $x || $ny != $y} { + if {$nx < $x} {incr nx} + if {$ny < $y} {incr ny} + warp_pointer $win $x $y + } +} ##### ##### @@ -437,8 +454,8 @@ gdbtk_test srcwin-2.10 "step" { # check that a new file is displayed set twin [$stw test_get twin] - set a [$twin get 1.0 end] - if {![string compare $file1(source) $a]} {set r -3} + set file3(source) [$twin get 1.0 end] + if {![string compare $file1(source) $file3(source)]} {set r -3} # check for PC_TAG on correct line if {$r == 0} { @@ -847,12 +864,256 @@ gdbtk_test srcwin-3.8 "stack down when at bottom" { } {1} # 4.1 bp, multiple, balloon, etc + +# Test: srcwin-4.1 +# Desc: Set BP in another file. Tests bp and cache functions +gdbtk_test srcwin-4.1 "set BP in another file" { + gdb_immediate "break foo" 1 + $srcwin goto_func "" foo + set r 0 + set name [$statbar.name get] + set func [$statbar.func get] + + # check contents of name and function comboboxes + if {$name != "list0.h"} {set r -1} + if {$func != "foo"} {set r -2} + + set twin [$stw test_get twin] + + # check for BROWSE_TAG and BP image on correct line + if {$r == 0} { + if {![catch {set z [$twin dump 1.0 end]}]} { + foreach {k v i} $z { + if {$k == "tagon"} { + if {$v == "BROWSE_TAG"} { + if {$i == "8.2"} { + incr r + } else { + incr r 5 + } + } + if {$v == "STACK_TAG"} {incr r 10} + if {$v == "PC_TAG"} {incr r 100} + } elseif {$k == "image"} { + if {$i == "8.0"} { + incr r + } else { + set r -200 + } + } + } + } else { + set r -4 + } + } + + if {$r == 2} { + # clear BP and compare with previous contents. This should succeed, + gdb_immediate "clear foo" 1 + set a [$twin get 1.0 end] + if {[string compare $file3(source) $a]} {set r -3} + } + + set r +} {2} + +# Test: srcwin-4.2 +# Desc: Test temporary BP +gdbtk_test srcwin-4.2 "temporary BP" { + set r 0 + if {[catch {gdb_immediate "tbreak foo" 1} msg]} { + set r -500 + } + set name [$statbar.name get] + set func [$statbar.func get] + + # check contents of name and function comboboxes + if {$name != "list0.h"} {set r -1} + if {$func != "foo"} {set r -2} + + set twin [$stw test_get twin] + + # check for BROWSE_TAG and BP image on correct line + if {$r == 0} { + if {![catch {set z [$twin dump 1.0 end]}]} { + foreach {k v i} $z { + if {$k == "tagon"} { + if {$v == "BROWSE_TAG"} { + if {$i == "8.2"} { + incr r + } else { + incr r 5 + } + } + if {$v == "STACK_TAG"} {incr r 10} + if {$v == "PC_TAG"} {incr r 100} + } elseif {$k == "image"} { + if {$i == "8.0"} { + incr r + } else { + set r -200 + } + } + } + } else { + set r -4 + } + } + + gdb_immediate "continue" 1 + + # now check for PC_TAG and no image + if {$r == 2} { + if {![catch {set z [$twin dump 1.0 end]}]} { + foreach {k v i} $z { + if {$k == "tagon"} { + if {$v == "PC_TAG"} { + if {$i == "8.2"} { + incr r + } else { + incr r 5 + } + } + if {$v == "STACK_TAG"} {incr r 10} + if {$v == "BROWSE_TAG"} {incr r 100} + } elseif {$k == "image"} { + set r -200 + } + } + } else { + set r -4 + } + } + + set r +} {3} + +# Test: srcwin-4.3 +# Desc: Test BP balloons +gdbtk_test srcwin-4.3 "BP Balloons" { + # move pointer out of the way + warp_pointer . 0 0 + set r 0 + gdb_immediate "break 10" 1 + gdb_immediate "tbreak 10" 1 + + set twin [$stw test_get twin] + + # check for BROWSE_TAG and BP image on correct line + if {$r == 0} { + if {![catch {set z [$twin dump 1.0 end]}]} { + foreach {k v i} $z { + if {$k == "tagon"} { + if {$v == "PC_TAG"} { + if {$i == "8.2"} { + incr r + } else { + incr r 5 + } + } + if {$v == "STACK_TAG"} {incr r 10} + if {$v == "BROWSE_TAG"} {incr r 100} + } elseif {$k == "image"} { + if {$i == "10.0"} { + incr r + # we found the bp image, now we will test the bp balloon messages + set balloon [winfo toplevel [namespace tail $srcwin]].__balloon + # shouldn't be mapped yet + if {[winfo ismapped $balloon]} { + set r -3000 + break + } + move_mouse_to $twin [$twin bbox $i] + #wait a second for the balloon message to appear + sleep 1 + if {![winfo ismapped $balloon]} { + set r -4000 + break + } + # read the contents of the balloon and parse it into lines + set a [split [$balloon.label cget -text] \n] + set i 0 + # foreach line parse it and check the type and make sure it is enabled + foreach line $a { + if {[lindex $line 0] == "breakpoint"} {continue} + incr i + set enabled [lindex $line 0] + set bptype [lindex $line 2] + switch $i { + 1 { + if {$bptype != "donttouch"} {set r -1000} + } + 2 { + if {$bptype != "delete"} {set r -2000} + } + } + } + } else { + set r -200 + } + } + } + } else { + set r -4 + } + } + set r +} {2} + # 5.1 balloon variables +# Test: srcwin-5.1 +# Desc: variable balloon test +gdbtk_test srcwin-5.1 "variable balloon test" { + # move pointer out of the way + warp_pointer . 0 0 + set r 0 + set twin [$stw test_get twin] + + # move pointer to variable "x" and check balloon + set index [string first "x++" [$twin get 10.0 10.end]] + move_mouse_to $twin [$twin bbox 10.$index] + sleep 1 + if {[winfo ismapped $balloon]} { + if {![string compare "x=2" [$balloon.label cget -text]]} {incr r} + gdb_immediate "continue" 1 + if {![string compare "x=4" [$balloon.label cget -text]]} {incr r} + } else { + set r -1 + } + set r +} {2} -gdbtk_test_done +# 6.1 mixed mode disassembly of include file +# Test: srcwin-6.1 +# Desc: Some versions of GDBtk can't do mixed-mode disassembly of a function +# that is in an include file. +gdbtk_test srcwin-6.1 "mixed mode disassembly of include file" { + set r 0 + $srcwin mode "" MIXED + # check contents of name and function comboboxes + set name [$statbar.name get] + set func [$statbar.func get] + if {$name != "list0.h"} {set r -1} + if {$func != "foo"} {set r -2} + + # check contents of source window + set twin [$stw test_get twin] + set text [$twin get 1.0 end] + # Is it correct? I don't know. Guess we look for some pieces of source... + if {[string first "static void" $text] != -1 && + [string first "foo (x)" $text] != -1 && + [string first "bar (x++);" $text] != -1} { + set r 1 + } + + set r +} {1} + +gdbtk_test_done # Local variables: # mode: tcl +# change-log-default-name: "ChangeLog-gdbtk" # End: -- cgit v1.1