1999-01-29 Martin Hunt <hunt@cygnus.com>

* 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

@@ -1,3 +1,12 @@
+1999-01-29  Martin Hunt  <hunt@cygnus.com>
+
+        * 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  <jingham@cygnus.com>
 
 	* gdbtk-wrapper.c: Missed a couple of places where FILE->GDB_FILE

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. */
+          /* pc on the stack, so what happens is the next instruction */
-          /* FIXME */
+	  /* 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,
+      /* find_pc_function will fail if there are only minimal symbols */
-                                Tcl_NewStringObj ("", -1));
+      /* 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 */
+  /* line number */
-  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line));
-  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
+ /* 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;
 }
 

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
 
   /*

gdb/testsuite/gdb.gdbtk/ChangeLog-gdbtk

@@ -0,0 +1,19 @@
+1999-01-29  Martin Hunt  <hunt@cygnus.com>
+
+	* 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:
+	

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:

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]
+  set file3(source) [$twin get 1.0 end]
-  if {![string compare $file1(source) $a]} {set r -3}
+  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
-# 5.1 balloon variables
 
+# 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}
+
+# 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: