This is the merge of the Itcl3.0 gdbtk development branch into the

trunk.  To build it, you will have to do update -dP in the itcl
directory, and update tcl, tk, tix and libgui as well.

7 files changed, 2067 insertions, 5 deletions

diff --git a/gdb/testsuite/gdb.gdbtk/.Sanitize b/gdb/testsuite/gdb.gdbtk/.Sanitize
index beedc2f9681..f9e6380a6f6 100644
--- a/gdb/testsuite/gdb.gdbtk/.Sanitize
+++ b/gdb/testsuite/gdb.gdbtk/.Sanitize
@@ -26,10 +26,17 @@ Things-to-keep:
 Makefile.in
 browser.exp
 browser.test
+c_variable.c
+c_variable.exp
+c_variable.test
 configure.in
 configure
 console.exp
 console.test
+cpp_variable.cc
+cpp_variable.exp
+cpp_variable.h
+cpp_variable.test
 defs
 simple.c
 stack1.c
diff --git a/gdb/testsuite/gdb.gdbtk/console.test b/gdb/testsuite/gdb.gdbtk/console.test
new file mode 100644
index 00000000000..90c5f12f6a0
--- /dev/null
+++ b/gdb/testsuite/gdb.gdbtk/console.test
@@ -0,0 +1,418 @@
+#   Copyright (C) 1998 Cygnus Solutions
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Keith Seitz (keiths@cygnus.com)
+
+# Read in the standard defs file
+
+if {![gdbtk_read_defs]} {
+  break
+}
+
+global objdir test_ran
+global console text
+set console [ManagedWin::open Console]
+set text [$console get_text]
+
+#####                            #####
+#                                    #
+#  Helper functions for this module  #
+#                                    #
+#####                            #####
+
+# console_command --
+#      Invoke STRING as a command in the console window and
+#      return the result
+proc console_command {string} { 
+  global console text
+
+  # Save current position
+  set line [lindex [split [$text index cmdmark] .] 0]
+  incr line 1
+
+  # Insert and invoke command
+  $text insert end $string
+  $console invoke
+  update
+
+  # Get the result
+  set end [lindex [split [$text index cmdmark] .] 0]
+  incr end -1
+  return [$text get $line.0 [list $end.0 lineend]]
+} 
+
+# get_cmd_line --
+#     Return the command line
+proc get_cmd_line {} {
+  global text
+
+  update
+  set index [$text index cmdmark]
+  return [$text get [list $index linestart] [list $index lineend]]
+}
+
+# clear_command_line --
+#     Clear the command line
+proc clear_command_line {} {
+  global text
+  $text delete {cmdmark + 1 char} insert
+}
+
+#####         #####
+#                 #
+#  CONSOLE TESTS  #
+#                 #
+#####         #####
+
+#
+# Miscellaneous tests
+#
+
+# Test:  console-misc-1
+# Desc:  Change console prompt
+gdbtk_test console-misc-1 {change console prompt} {
+  # Insert the "set prompt" command into the text widget
+  console_command {set prompt (test) }
+
+  $text get {cmdmark linestart} {cmdmark lineend}
+} {(test) }
+if {$test_ran} {
+  console_command {set prompt (gdb) }
+}
+
+#
+# Paste tests
+#
+
+# Test:  console-paste-1
+# Desc:  Paste the X selection into console window
+gdbtk_test console-paste-1 {paste X text} {
+  # This is cheesy, but it works... Create a text widget
+  # which holds the current selection...
+  text .test_text
+  .test_text insert end "this is some pasted text"
+  .test_text tag add sel 1.0 {1.0 lineend}
+
+  event generate $text <<Paste>>
+  get_cmd_line
+} {(gdb) this is some pasted text}
+if {$test_ran} {
+  destroy .test_text
+  clear_command_line
+}
+
+#
+# Test for errors
+#
+
+# Test:  console-error-1
+# Desc:  Check if console window reports internal gdb errors
+gdbtk_test console-error-1 {invoke unknown command} {
+  console_command {this_command_doesn't_exist}
+} {Error: Undefined command: "this".  Try "help".
+}
+
+#
+# History tests
+#
+
+# Test:  console-history-1.1
+# Desc:  Exercise the up-history functionality
+gdbtk_test console-history-1.1 {up history once} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+  event generate $text <Up>
+  get_cmd_line
+} {(gdb) help si}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-1.2
+# Desc:  Exercise the up-history functionality
+gdbtk_test console-history-1.2 {up history twice} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+  event generate $text <Up>
+  event generate $text <Up>
+  get_cmd_line
+} {(gdb) help quit}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-1.3
+# Desc:  Exercise the up-history functionality
+gdbtk_test console-history-1.3 {up history four times} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+
+  for {set i 0} {$i < 4} {incr i} {
+    event generate $text <Up>
+  }
+  get_cmd_line
+} {(gdb) show remotedevice}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-1.4
+# Desc:  Exercise the up-history functionality
+gdbtk_test console-history-1.4 {up fourteen times} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+  for {set i 0} {$i < 14} {incr i} {
+    event generate $text <Up>
+  }
+  get_cmd_line
+} {(gdb) show annotate}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-2.1
+# Desc:  Exercise the down-history functionality
+gdbtk_test console-history-2.1 {down once} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+
+  for {set i 0} {$i < 14} {incr i} {
+    event generate $text <Up>
+  }
+  event generate $text <Down>
+  get_cmd_line
+} {(gdb) show complaints}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-2.2
+# Desc:  Exercise the down-history functionality
+gdbtk_test console-history-2.2 {down twice} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+
+  for {set i 0} {$i < 14} {incr i} {
+    event generate $text <Up>
+  }
+
+  event generate $text <Down>
+  event generate $text <Down>
+  get_cmd_line
+} {(gdb) show confirm}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-2.3
+# Desc:  Exercise the down-history functionality
+gdbtk_test console-history-2.3 {down four times} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+
+  for {set i 0} {$i < 14} {incr i} {
+    event generate $text <Up>
+  }
+
+  for {set i 0} {$i < 4} {incr i} {
+  event generate $text <Down>
+  }
+  get_cmd_line
+} {(gdb) show language}
+if {$test_ran} {
+  clear_command_line
+}
+
+# Test:  console-history-2.4
+# Desc:  Exercise the down-history functionality
+gdbtk_test console-history-2.4 {down infinitely} {
+  # Add some commands into the command buffer
+  console_command {show annotate}
+  console_command {show complaints}
+  console_command {show confirm}
+  console_command {show height}
+  console_command {show language}
+  console_command {show print demangle}
+  console_command {show remotebaud}
+  console_command {show remotebreak}
+  console_command {show remotecache}
+  console_command {show remotedebug}
+  console_command {show remotedevice}
+  console_command {show remotelogbase}
+  console_command {help quit}
+  console_command {help si}
+  for {set i 0} {$i < 14} {incr i} {
+    event generate $text <Up>
+  }
+
+  for {set i 0} {$i < 20} {incr i} {
+    event generate $text <Down>
+  }
+  get_cmd_line
+} {(gdb) }
+if {$test_ran} {
+  clear_command_line
+}
+
+#
+# gdb - gdbtk Interface Tests
+#
+
+# Test:  console-interface-1.1
+# Desc:  Verify that a "file" command in the console window causes
+#        gdb to invoke the pre-/post-add-symbol hooks
+set file_loaded 0
+gdbtk_test console-interface-1.1 {file command goes through hooks} {
+  global TEST1_RESULT TEST2_RESULT
+
+  # This is really ugly, but its the only way to do this...
+  rename gdbtk_tcl_pre_add_symbol pre_add
+  rename gdbtk_tcl_post_add_symbol post_add
+
+  proc gdbtk_tcl_pre_add_symbol {file} {
+    global TEST1_RESULT
+
+    set TEST1_RESULT $file
+    pre_add $file
+  }
+  proc gdbtk_tcl_post_add_symbol {} {
+    global TEST2_RESULT
+
+    set TEST2_RESULT ok
+    post_add
+  }
+
+  # load a file and make sure we went through the pre/post_add_symbol hooks
+  set TEST1_RESULT {}
+  set TEST2_RESULT {}
+  set file [file join $objdir simple]
+  console_command "file $file"
+  if {$TEST1_RESULT != $file} {
+    set result "did not go through gdbtk_tcl_pre_add_symbol ($TEST1_RESULT)"
+  } elseif {$TEST2_RESULT != "ok"} {
+    set result "did not go through gdbtk_tcl_post_add_symbol"
+  } else {
+    set result {}
+    set file_loaded 1
+  }
+
+  set result
+} {}
+if {$test_ran} {
+  rename gdbtk_tcl_pre_add_symbol {}
+  rename gdbtk_tcl_post_add_symbol {}
+  rename pre_add gdbtk_tcl_pre_add_symbol
+  rename post_add gdbtk_tcl_post_add_symbol
+}
+
+#
+#  Exit
+#
+gdbtk_test_done
diff --git a/gdb/testsuite/gdb.gdbtk/cpp_variable.h b/gdb/testsuite/gdb.gdbtk/cpp_variable.h
new file mode 100644
index 00000000000..7abda54d0a8
--- /dev/null
+++ b/gdb/testsuite/gdb.gdbtk/cpp_variable.h
@@ -0,0 +1,54 @@
+struct _foo
+{
+  int a[10];
+  char *p;
+};
+
+class VA
+{
+ public:
+  int va_pub_int;
+  char *va_pub_charp;
+
+ private:
+  int va_priv_int;
+  char *va_priv_charp;
+
+ protected:
+  struct _foo bar;
+};
+
+class VB
+{
+ public:
+  int vb_pub_int;
+
+  int fvb_pub ();
+  virtual int vvb_pub ();
+
+ private:
+  int vb_priv_int;
+  char *vb_priv_charp;
+};
+
+class VC : public VA
+{
+ public:
+  int vc_pub_int;
+
+  int fvc ();
+  virtual int vfvc ();
+};
+
+class V : public VA, public VB, public VC
+{
+ public:
+  int f ();
+  virtual vv ();
+  int v_pub_int;
+  char *v_pub_charp;
+
+ private:
+  int v_priv_int;
+  char *v_priv_charp;
+};
diff --git a/gdb/testsuite/gdb.gdbtk/cpp_variable.test b/gdb/testsuite/gdb.gdbtk/cpp_variable.test
new file mode 100644
index 00000000000..ac5fc9623f5
--- /dev/null
+++ b/gdb/testsuite/gdb.gdbtk/cpp_variable.test
@@ -0,0 +1,476 @@
+#   Copyright (C) 1998 Cygnus Solutions
+#
+# This Program Is Free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Keith Seitz (keiths@cygnus.com)
+
+# Read in the standard defs file
+if {![gdbtk_read_defs]} {
+  break
+}
+
+global objdir test_ran
+global tcl_platform 
+
+# Load in a file
+if {$tcl_platform(platform) == "windows"} {
+  set program [file join $objdir cpp_variable.exe]
+} else {
+  set program [file join $objdir cpp_variable]
+}
+
+# This isn't a test case, since if this fails, we're hosed.
+if {[catch {gdb_cmd "file $program"} t]} {
+  # an error occured loading the file
+  gdbtk_test_error "loading \"$program\": $t"
+}
+
+# The variables that are created are stored in an array called "var".
+
+# proc to tell us which of the variables are changed/out of scope
+proc check_valueChanged {} {
+  global var
+
+  set changed {}
+  set unchanged {}
+  set out {}
+  foreach ind [array names var] {
+    set val [$var($ind) valueChanged]
+    if {$val == "VARIABLE_CHANGED"} {
+	lappend changed $ind
+    } elseif {$val == "VARIABLE_UNCHANGED"} {
+	lappend unchanged $ind
+    } elseif {$val == "VARIABLE_OUT_OF_SCOPE"} {
+	lappend out $ind
+    } else {
+	error "unknown result from valueChanged"
+    }
+  }
+
+  return [list $changed $unchanged $out]
+}
+
+
+# proc to create a variable
+proc create_variable {expr} {
+  global var
+
+  set err [catch {gdb_variable create -expr $expr} v]
+  if {!$err} {
+    set var($expr) $v
+  }
+
+  return $err
+}
+
+# proc to get the children
+# Children are stored in the global "var" as
+# PARENT.child. So for struct _foo {int a; int b} bar;,
+# the children returned are {a b} and var(bar.a) and var(bar.b)
+# map the actual objects to their names.
+proc get_children {parent} {
+  global var
+
+  set kiddies [$var($parent) children]
+  set children {}
+  foreach child $kiddies {
+    set name [lindex [split $child .] end]
+    lappend children $name
+    set var($parent.$name) $child
+  }
+
+  return $children
+}
+
+proc delete_variable {varname} {
+  global var
+
+  if {[info exists var($varname)]} {
+    # This has to be caught, since deleting a parent
+    # will erase all children.
+    $var($varname) delete
+    set vars [array names var $varname*]
+    foreach v $vars {
+      if {[info exists var($v)]} {
+	unset var($v)
+      }
+    }
+  }
+}
+
+# Compare the values of variable V in format FMT
+# with gdb's value.
+proc value {v fmt} {
+  global var
+
+  set value [$var($v) value]
+  set gdb [gdb_cmd "output/$fmt $v"]
+  if {$value == $gdb} {
+    set result ok
+  } else {
+    set result error
+  }
+
+  return $result
+}
+
+proc delete_all_variables {} {
+  global var
+
+  foreach variable [array names var] {
+    delete_variable $variable
+  }
+}
+
+#####            #####
+#                    #
+# Simple Class Tests #
+#                    #
+#####            #####
+
+# run to "do_simple_class_tests"
+gdb_cmd "break do_simple_class_tests"
+gdb_cmd "run"
+
+# Test:  cpp_variable-1.1
+# Desc:  stopped in do_simple_class_tests
+gdbtk_test cpp_variable-1.1 {stopped in main} {
+  lindex [gdb_loc] 1
+} {do_simple_class_tests}
+
+# Test: cpp_variable-1.2
+# Desc: create variable v
+gdbtk_test cpp_variable-1.2 {create variable v} {
+  create_variable v
+} {0}
+
+# Test: cpp_variable-1.3
+# Desc: number of children of v
+gdbtk_test cpp_variable-1.3 {number of children of v} {
+  $var(v) numChildren
+} {7}
+
+# Test: cpp_variable-1.4
+# Desc: children of v
+gdbtk_test cpp_variable-1.4 {children of v} {
+  get_children v
+} {VA VB VC v_pub_int v_pub_charp v_priv_int v_priv_charp}
+
+# Test: cpp_variable-1.5
+# Desc: type of v
+gdbtk_test cpp_variable-1.5 {type of v} {
+  $var(v) type
+} {V *}
+
+# Test: cpp_variable-1.6
+# Desc: format of v
+gdbtk_test cpp_variable-1.6 {format of v} {
+  $var(v) format
+} {natural}
+
+set value [$var(v) value]
+
+# Step over "V *v = new V;"
+gdb_cmd "next"
+
+# Test: cpp_variable-1.7
+# Desc: check value of v changed
+gdbtk_test cpp_variable-1.7 {check value of v changed} {
+  check_valueChanged
+} {{v.v_priv_int v.v_pub_charp v.v_pub_int v v.v_priv_charp} {v.VB v.VC v.VA} {}}
+
+# Test: cpp_variable-1.8
+# Desc: check values of v
+gdbtk_test cpp_variable-1.8 {check values of v} {
+  set new [$var(v) value]
+  expr {$new != $value}
+} {1}
+
+# Test: cpp_variable-1.9
+# Desc: v editable
+gdbtk_test cpp_variable-1.9 {v editable} {
+  $var(v) editable
+} {1}
+
+#####             #####
+#                     #
+# Children of v tests #
+#                     #
+#####             #####
+
+# Test: cpp_variable-2.1
+# Desc: type of v.v_pub_int
+gdbtk_test cpp_variable-2.1 {type of v.v_pub_int} {
+  $var(v.v_pub_int) type
+} {int}
+
+# Test: cpp_variable-2.2
+# Desc: format of v.v_pub_int
+gdbtk_test cpp_variable-2.2 {format of v.v_pub_int} {
+  $var(v.v_pub_int) format
+} {natural}
+
+gdb_cmd "set variable v.v_pub_int=2112"
+
+# Test: cpp_variable-2.3
+# Desc: value of v.v_pub_int changed
+gdbtk_test cpp_variable-2.3 {value of v.v_pub_int changed} {
+  check_valueChanged
+} {v.v_pub_int {v.v_priv_int v.VB v.v_pub_charp v.VC v v.v_priv_charp v.VA} {}}
+
+# Test: cpp_variable-2.4
+# Desc: value of v.v_pub_int
+gdbtk_test cpp_variable-2.4 {value of v.v_pub_int} {
+  $var(v.v_pub_int) value
+} {2112}
+
+# Test: cpp_variable-2.5
+# Desc: changed format of v.v_pub_int
+gdbtk_test cpp_variable-2.5 {changed format of v.v_pub_int} {
+  $var(v.v_pub_int) format octal
+  $var(v.v_pub_int) format
+} {octal}
+
+# Test: cpp_variable-2.6
+# Desc: value of v.v_pub_int with new format
+gdbtk_test cpp_variable-2.6 {value of v.v_pub_int with new format} {
+  $var(v.v_pub_int) value
+} {04100}
+
+# Test: cpp_variable-2.7
+# Desc: change value of v.v_pub_int (decimal)
+gdbtk_test cpp_variable-2.7 {change value of v.v_pub_int (decimal)} {
+  $var(v.v_pub_int) value 3
+  value v.v_pub_int o
+} {ok}
+
+# Test: cpp_variable-2.8
+# Desc: change value of v.v_pub_int (hexadecimal)
+gdbtk_test cpp_variable-2.9 {change value of v.v_pub_int (hexadecimal)} {
+  $var(v.v_pub_int) value 0x21
+  value v.v_pub_int o
+} {ok}
+
+# Test: cpp_variable-2.9
+# Desc: number of children of v_pub_int
+gdbtk_test cpp_variable-2.9 {number of children of v_pub_int} {
+  $var(v.v_pub_int) numChildren
+} {0}
+
+# Test: cpp_variable-2.10
+# Desc: children of v.v_pub_int
+gdbtk_test cpp_variable-2.10 {children of v.v_pub_int} {
+  get_children v.v_pub_int
+} {}
+
+# Test: cpp_variable-2.11
+# Desc: v.v_pub_int editable
+gdbtk_test cpp_variable-2.11 {v.v_pub_int editable} {
+  $var(v.v_pub_int) editable
+} {1}
+
+# Test: cpp_variable-2.21
+# Desc: type of v.v_priv_charp
+gdbtk_test cpp_variable-2.21 {type of v.v_priv_charp} {
+  $var(v.v_priv_charp) type
+} {char *}
+
+# Test: cpp_variable-2.22
+# Desc: format of v.v_priv_charp
+gdbtk_test cpp_variable-2.22 {format of v.v_priv_charp} {
+  $var(v.v_priv_charp) format
+} {natural}
+
+gdb_cmd "set variable v.v_priv_charp=2112"
+
+# Test: cpp_variable-2.23
+# Desc: value of v.v_priv_charp changed
+gdbtk_test cpp_variable-2.23 {value of v.v_priv_charp changed} {
+  check_valueChanged
+} {v.v_priv_charp {v.v_priv_int v.VB v.v_pub_charp v.VC v.v_pub_int v v.VA} {}}
+
+# Test: cpp_variable-2.24
+# Desc: value of v.v_priv_charp
+gdbtk_test cpp_variable-2.24 {value of v.v_priv_charp} {
+  $var(v.v_priv_charp) format hexadecimal
+  $var(v.v_priv_charp) value
+} {0x840}
+
+# Test: cpp_variable-2.25
+# Desc: changed format of v.v_priv_charp
+gdbtk_test cpp_variable-2.25 {changed format of v.v_priv_charp} {
+  $var(v.v_priv_charp) format octal
+  $var(v.v_priv_charp) format
+} {octal}
+
+# Test: cpp_variable-2.26
+# Desc: value of v.v_priv_charp with new format
+gdbtk_test cpp_variable-2.26 {value of v.v_priv_charp with new format} {
+  $var(v.v_priv_charp) value
+} {04100}
+
+# Test: cpp_variable-2.27
+# Desc: change value of v.v_priv_charp (decimal)
+gdbtk_test cpp_variable-2.27 {change value of v.v_priv_charp (decimal)} {
+  $var(v.v_priv_charp) value 3
+  value v.v_priv_charp o
+} {ok}
+
+# Test: cpp_variable-2.28
+# Desc: change value of v.v_priv_charp (hexadecimal)
+gdbtk_test cpp_variable-2.28 {change value of v.v_priv_charp (hexadecimal)} {
+  $var(v.v_priv_charp) value 0x21
+  value v.v_priv_charp o
+} {ok}
+
+# Test: cpp_variable-2.29
+# Desc: number of children of v_priv_charp
+gdbtk_test cpp_variable-2.29 {number of children of v_priv_charp} {
+  $var(v.v_priv_charp) numChildren
+} {0}
+
+# Test: cpp_variable-2.30
+# Desc: children of v.v_priv_charp
+gdbtk_test cpp_variable-2.30 {children of v.v_priv_charp} {
+  get_children v.v_priv_charp
+} {}
+
+# Test: cpp_variable-2.31
+# Desc: v.v_priv_int editable
+gdbtk_test cpp_variable-2.31 {v.v_priv_int editable} {
+  $var(v.v_priv_int) editable
+} {1}
+
+# Test: cpp_variable-2.41
+# Desc: type of v.VA
+gdbtk_test cpp_variable-2.41 {type of v.VA} {
+  $var(v.VA) type
+} {VA}
+
+# Test: cpp_variable-2.42
+# Desc: format of v.VA
+gdbtk_test cpp_variable-2.42 {format of v.VA} {
+  $var(v.VA) format
+} {natural}
+
+# Test: cpp_variable-2.43
+# Desc: value of v.VA changed
+gdbtk_test cpp_variable-2.43 {value of v.VA changed} {
+  check_valueChanged
+} {{} {v.v_priv_int v.VB v.v_pub_charp v.VC v.v_pub_int v v.v_priv_charp v.VA} {}}
+
+# Test: cpp_variable-2.44
+# Desc: value of v.VA
+gdbtk_test cpp_variable-2.44 {value of v.VA} {
+  $var(v.VA) value
+} {{...}}
+
+# Test: cpp_variable-2.45
+# Desc: changed format of v.VA
+gdbtk_test cpp_variable-2.45 {changed format of v.VA} {
+  $var(v.VA) format octal
+  $var(v.VA) format
+} {octal}
+
+# Test: cpp_variable-2.46
+# Desc: value of v.VA with new format
+gdbtk_test cpp_variable-2.46 {value of v.VA with new format} {
+  $var(v.VA) value
+} {{...}}
+
+# Test: cpp_variable-2.47
+# Desc: number of children of VA
+gdbtk_test cpp_variable-2.47 {number of children of VA} {
+  $var(v.VA) numChildren
+} {5}
+
+# Test: cpp_variable-2.48
+# Desc: children of v.VA
+gdbtk_test cpp_variable-2.48 {children of v.VA} {
+  get_children v.VA
+} {va_pub_int va_pub_charp va_priv_int va_priv_charp bar}
+
+# Test: cpp_variable-2.49
+# Desc: v.VA editable
+gdbtk_test cpp_variable-2.49 {v.VA editable} {
+  $var(v.VA) editable
+} {0}
+
+# Test: cpp_variable-2.61
+# Desc: type of v.VB
+gdbtk_test cpp_variable-2.61 {type of v.VB} {
+  $var(v.VB) type
+} {VB}
+
+# Test: cpp_variable-2.62
+# Desc: format of v.VB
+gdbtk_test cpp_variable-2.62 {format of v.VB} {
+  $var(v.VB) format
+} {natural}
+
+# Test: cpp_variable-2.63
+# Desc: value of v.VB changed
+gdbtk_test cpp_variable-2.63 {value of v.VB changed} {
+  check_valueChanged
+} {{} {v.VA.va_pub_int v.v_pub_int v.VA.va_priv_int v.VA.va_pub_charp v.v_priv_int v.v_pub_charp v.VA.va_priv_charp v.VA.bar v v.v_priv_charp v.VA v.VB v.VC} {}}
+
+# Test: cpp_variable-2.64
+ # Desc: value of v.VB
+gdbtk_test cpp_variable-2.64 {value of v.VB} {
+  $var(v.VB) value
+} {{...}}
+
+# Test: cpp_variable-2.65
+# Desc: changed format of v.VB
+gdbtk_test cpp_variable-2.65 {changed format of v.VB} {
+  $var(v.VB) format octal
+  $var(v.VB) format
+} {octal}
+
+# Test: cpp_variable-2.66
+# Desc: value of v.VB with new format
+gdbtk_test cpp_variable-2.66 {value of v.VB with new format} {
+  $var(v.VB) value
+} {{...}}
+
+# Note: The next two tests show whether or not the logic
+# concerning vptr tables is working.
+# Test: cpp_variable-2.67
+# Desc: number of children of VB
+gdbtk_test cpp_variable-2.67 {number of children of VB} {
+  $var(v.VB) numChildren
+} {3}
+
+# Test: cpp_variable-2.68
+# Desc: children of v.VB
+gdbtk_test cpp_variable-2.68 {children of v.VB} {
+  get_children v.VB
+} {vb_pub_int vb_priv_int vb_priv_charp}
+
+# Test: cpp_variable-2.69
+# Desc: v.VB editable
+gdbtk_test cpp_variable-2.69 {v.VB editable} {
+  $var(v.VB) editable
+} {0}
+
+
+#  Exit
+#
+gdbtk_test_done
+
+
diff --git a/gdb/testsuite/gdb.gdbtk/srcwin.exp b/gdb/testsuite/gdb.gdbtk/srcwin.exp
new file mode 100644
index 00000000000..bd4557c8ae7
--- /dev/null
+++ b/gdb/testsuite/gdb.gdbtk/srcwin.exp
@@ -0,0 +1,32 @@
+#
+# Check if we have a display
+#
+if {![info exists ::env(DISPLAY)]} {
+  warning "No DISPLAY -- skipping test"
+} else {
+  if {$tracelevel} {
+    strace $tracelevel
+  }
+
+  #
+  # test source window
+  #
+  set prms_id 0
+  set bug_id 0
+  
+  set testfile "list"
+  set binfile $objdir/$subdir/$testfile
+  set r [gdb_compile "$srcdir/gdb.base/list0.c $srcdir/gdb.base/list1.c" "$binfile" executable debug]
+  if  { $r != "" } {
+    gdb_suppress_entire_file \
+      "Testcase compile failed, so some tests in this file will automatically fail."
+  }
+  
+  # Start with a fresh gdbtk
+  gdb_exit
+  set results [gdbtk_start [file join $srcdir $subdir srcwin.test]]
+  set results [split $results \n]
+
+  # Analyze results
+  gdbtk_analyze_results $results
+}
diff --git a/gdb/testsuite/gdb.gdbtk/srcwin.test b/gdb/testsuite/gdb.gdbtk/srcwin.test
new file mode 100644
index 00000000000..f13d3d0b711
--- /dev/null
+++ b/gdb/testsuite/gdb.gdbtk/srcwin.test
@@ -0,0 +1,858 @@
+#   Copyright (C) 1999 Cygnus Solutions
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb@prep.ai.mit.edu
+
+# This file was written by Martin Hunt (hunt@cygnus.com)
+
+# Read in the standard defs file
+
+if {![gdbtk_read_defs]} {
+  break
+}
+
+global objdir test_ran
+
+
+#####                 #####
+#                         #
+#  SECTION 1: Mode Tests  #
+#                         #
+#####                 #####
+
+# Load the test executable
+if {$tcl_platform(platform) == "windows"} {
+  set file [file join $objdir list.exe]
+} else {
+  set file [file join $objdir list]
+}
+
+# This isn't a test case, since if this fails, we're hosed.
+if {[catch {gdb_cmd "file $file" 1} t]} {
+  # an error occured loading the file
+  gdbtk_test_error "loading \"$file\": $t"
+}
+
+set srcwin [ManagedWin::open SrcWin]
+set stw [$srcwin test_get twin]
+set twin [$stw test_get twin]
+
+# get things started
+gdb_cmd "break main"
+run_executable
+
+# Test: srcwin-1.1
+# Desc: Check for something in source window
+gdbtk_test srcwin-1.1 "source window has contents" {
+  set file1(source) [$twin get 1.0 end]
+  expr {![string compare $file1(source) ""]}
+} {0}
+
+
+# Test: srcwin-1.2
+# Desc: source->assembly mode change
+gdbtk_test srcwin-1.2 "source->assembly mode change" {
+  $srcwin mode "" ASSEMBLY
+  set twin [$stw test_get twin]
+  set file1(assembly) [$twin get 1.0 end]
+  expr {![string compare $file1(source) $file1(assembly)]}
+} {0}
+
+# Test: srcwin-1.3
+# Desc: assembly->mixed mode change
+gdbtk_test srcwin-1.3 "assembly->mixed mode change" {
+  $srcwin mode "" MIXED
+  set twin [$stw test_get twin]
+  set file1(mixed) [$twin get 1.0 end]
+  expr {![string compare $file1(mixed) $file1(assembly)]}
+} {0}
+
+# Test: srcwin-1.4
+# Desc: mixed->src+asm mode change
+gdbtk_test srcwin-1.4 "mixed->src+asm mode change" {
+  $srcwin mode "" SRC+ASM
+  set twin [$stw test_get twin]
+  set bwin [$stw test_get bwin]
+  set s [$twin get 1.0 end]
+  set a [$bwin get 1.0 end]
+  expr {[string compare $a $file1(assembly)] ||
+	[string compare $s $file1(source)] ||
+	![winfo ismapped $bwin]}
+} {0}
+
+# Test: srcwin-1.5
+# Desc: src+asm->source mode change
+gdbtk_test srcwin-1.5 "src+asm->source mode change" {
+  $srcwin mode "" SOURCE
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  set bwin [$stw test_get bwin]
+  expr {[string compare $file1(source) $a] ||
+	[winfo ismapped $bwin]}
+} {0}
+
+# Test: srcwin-1.6
+# Desc: source->mixed mode change
+gdbtk_test srcwin-1.6 "source->mixed mode change" {
+  $srcwin mode "" MIXED
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  string compare $file1(mixed) $a
+} {0}
+
+# Test: srcwin-1.7
+# Desc: mixed->source mode change
+gdbtk_test srcwin-1.7 "mixed->source mode change" {
+  $srcwin mode "" SOURCE
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  string compare $file1(source) $a
+} {0}
+
+# Test: srcwin-1.8
+# Desc: source->src+asm mode change
+gdbtk_test srcwin-1.8 "source->src+asm mode change" {
+  $srcwin mode "" SRC+ASM
+  set twin [$stw test_get twin]
+  set bwin [$stw test_get bwin]
+  set s [$twin get 1.0 end]
+  set a [$bwin get 1.0 end]
+  expr {[string compare $a $file1(assembly)] ||
+	[string compare $s $file1(source)] ||
+	![winfo ismapped $bwin]}
+} {0}
+
+# Test: srcwin-1.9
+# Desc: src+asm->assembly mode change
+gdbtk_test srcwin-1.9 "src+asm->assembly mode change" {
+  $srcwin mode "" ASSEMBLY
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  string compare $file1(assembly) $a
+} {0}
+
+# Test: srcwin-1.10
+# Desc: assembly->src+asm mode change
+gdbtk_test srcwin-1.10 "assembly->src+asm mode change" {
+  $srcwin mode "" SRC+ASM
+  set twin [$stw test_get twin]
+  set bwin [$stw test_get bwin]
+  set s [$twin get 1.0 end]
+  set a [$bwin get 1.0 end]
+  expr {[string compare $a $file1(assembly)] ||
+	[string compare $s $file1(source)] ||
+	![winfo ismapped $bwin]}
+} {0}
+
+# Test: srcwin-1.11
+# Desc: src+asm->mixed mode change
+gdbtk_test srcwin-1.11 "src+asm->mixed mode change" {
+  $srcwin mode "" MIXED
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  set bwin [$stw test_get bwin]
+  expr {[string compare $file1(mixed) $a] ||
+	[winfo ismapped $bwin]}
+} {0}
+
+# Test: srcwin-1.12
+# Desc: mixed->assembly mode change
+gdbtk_test srcwin-1.12 "mixed->assembly mode change" {
+  $srcwin mode "" ASSEMBLY
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  string compare $file1(assembly) $a
+} {0}
+
+# Test: srcwin-1.13
+# Desc: assembly->source mode change
+gdbtk_test srcwin-1.13 "assembly->source mode change" {
+  $srcwin mode "" SOURCE
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  string compare $file1(source) $a
+} {0}
+
+
+#####                       #####
+#                               #
+#  SECTION 2: Basic Operations  #
+#                               #
+#####                       #####
+
+# Test: srcwin-2.1
+# Desc: check contents of filename combobox
+gdbtk_test srcwin-2.1 "check contents of filename combobox" {
+  set statbar [$srcwin test_get _statbar]
+  set names [$statbar.name listget 0 end]
+  set r 0
+  foreach f {list0.c list1.c list0.h} {
+    if {[lsearch $names $f] != -1} {
+      incr r
+    }
+  }
+  set r
+} {3}
+
+# Test: srcwin-2.2
+# Desc: check contents of function combobox
+gdbtk_test srcwin-2.2 "check contents of function combobox" {
+  set names [$statbar.func listget 0 end]
+  set r 0
+  foreach f {main foo unused} {
+    if {[lsearch $names $f] != -1} {
+      incr r
+    }
+  }
+  set r
+} {3}
+
+# Test: srcwin-2.3
+# Desc: goto filename
+gdbtk_test srcwin-2.3 "goto filename" {
+  set func [$srcwin test_get _name 1]
+  $func "" list1.c
+  set twin [$stw test_get twin]
+  set file2(source) [$twin get 1.0 end]
+  expr {![string compare $file1(source) $file2(source)]}
+} {0}
+
+# Test: srcwin-2.4
+# Desc: check contents of function combobox
+gdbtk_test srcwin-2.4 "check contents of function combobox" {
+  set names [$statbar.func listget 0 end]
+  set r 0
+  foreach f {bar long_line oof unused} {
+    if {[lsearch $names $f] != -1} {
+      incr r
+    }
+  }
+  set r
+} {4}
+
+# Test: srcwin-2.5
+# Desc: function combobox entry field should be empty after switching to a new file
+gdbtk_test srcwin-2.5 "function combobox entry field should be empty" {
+  set names [$statbar.func get]
+  string length $names
+} {0}
+
+# Test: srcwin-2.6
+# Desc: goto function
+gdbtk_test srcwin-2.6 "goto function bar" {
+  $srcwin goto_func "" bar
+  set r 0
+
+  # now get a dump of all tags and check that only one line is
+  # marked BROWSE_TAG and no lines are STACK_TAG or PC_TAG.
+
+  # We know that list1.c should have BROWSE_TAG set at index 5.2
+  # for function "bar".  If list1.c is changed or the layout of the source
+  # window is changed, this must be updated.
+  if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+    foreach {k v i} $z {
+      if {$k == "tagon"} {
+	if {$v == "BROWSE_TAG"} {
+	  if {$i == "5.2"} {
+	    incr r
+	  } else {
+	    incr r 5
+	  }
+	}
+	if {$v == "STACK_TAG"} { incr r 10}
+	if {$v == "PC_TAG"} { incr r 100}
+      }
+    }
+  } else {
+    set r -1
+  }
+
+  if {$r == 1} {
+    # things are OK so far, so just verify the function name is displayed
+    # in the combobox entry field.
+    set names [$statbar.func get]
+    if {[string compare $names "bar"]} {set r -2}
+  }
+  set r
+} {1}
+
+# Test: srcwin-2.7
+# Desc: goto function "oof". This tests that the correct line is highlighted
+# with BROWSE_TAG and no other lines are highlighted. It also checks that
+# the combobox has the correct function name in it.  Finally, list1.c
+# has an extremely long line, line 32, that breaks some functions.  We verify 
+# that the GDBtk has the correct line number.
+
+gdbtk_test srcwin-2.7 "goto function oof" {
+  $srcwin goto_func "" oof
+  set r 0
+
+  # now get a dump of all tags and check that only one line is
+  # marked BROWSE_TAG and no lines are STACK_TAG or PC_TAG.
+
+  # We know that list1.c should have BROWSE_TAG set at index 32.2
+  # for function "oof".  If list1.c is changed or the layout of the source
+  # window is changed, this must be updated.
+  if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+    foreach {k v i} $z {
+      if {$k == "tagon"} {
+	if {$v == "BROWSE_TAG"} {
+	  if {$i == "32.2"} {
+	    set line_number [$twin get "$i wordstart" "$i wordend"]
+	    if {$line_number == "32"} {
+	      incr r
+	    } else {
+	      incr r -100
+	    }
+	  } else {
+	    incr r 5
+	  }
+	}
+	if {$v == "STACK_TAG"} {incr r 10}
+	if {$v == "PC_TAG"} {incr r 100}
+      }
+    }
+  } else {
+    set r -1
+  }
+
+  if {$r == 1} {
+    # things are OK so far, so just verify the function name is displayed
+    # in the combobox entry field.
+    set names [$statbar.func get]
+    if {[string compare $names "oof"]} {set r -2}
+  }
+  set r
+} {1}
+
+# Test: srcwin-2.8
+# Desc: This test issues a next command while browsing list1.c.
+# It should display list0.c and highlight the correct line.
+gdbtk_test srcwin-2.8 "step while browsing" {
+  gdb_immediate "next" 1
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list0.c"} {set r -1}
+  if {$func != "main"} {set r -2}
+
+  # check that correct 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}
+
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "11.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-2.9
+# Desc: This test issues a next command while the current
+# PC is ready to call a function.  It should not go into the function and
+# should update the PC highlight correctly.
+gdbtk_test srcwin-2.9 "next" {
+  gdb_immediate "next" 1
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list0.c"} {set r -1}
+  if {$func != "main"} {set r -2}
+
+  # check that correct 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}
+
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "12.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-2.10
+# Desc: This test issues a step command while the current
+# PC is ready to call a function.  It should step into the function.
+gdbtk_test srcwin-2.10 "step" {
+  gdb_immediate "step" 1
+  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}
+
+  # 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}
+
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 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}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-2.11
+# Desc: This test issues a break and a continue
+gdbtk_test srcwin-2.11 "set BP and continue" {
+  gdb_immediate "break oof" 1
+  gdb_immediate "continue" 1
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list1.c"} {set r -1}
+  if {$func != "oof"} {set r -2}
+
+  # check that the correct file is displayed
+  # we must clear the breakpoint first so it doesn't mess up the
+  # comparison...
+  gdb_immediate "clear oof" 1  
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {[string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "32.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+#####                       #####
+#                               #
+#  SECTION 3: Stack Operations  #
+#                               #
+#####                       #####
+
+# Test: srcwin-3.1
+# Desc: This tests "stack up" 
+gdbtk_test srcwin-3.1 "stack up (1)" {
+  $srcwin stack up
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list1.c"} {set r -1}
+  if {$func != "long_line"} {set r -2}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {[string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "32.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "22.2"} {
+	      incr r
+	    } else {
+	      incr r 10
+	    }
+	  }
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {2}
+
+# Test: srcwin-3.2
+# Desc: Another "stack up"  test
+gdbtk_test srcwin-3.2 "stack up (2)" {
+  $srcwin stack up
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list1.c"} {set r -1}
+  if {$func != "bar"} {set r -2}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {[string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "32.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "7.2"} {
+	      incr r
+	    } else {
+	      incr r 10
+	    }
+	  }
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {2}
+
+# Test: srcwin-3.3
+# Desc: Another "stack up"  test
+gdbtk_test srcwin-3.3 "stack up (3)" {
+  $srcwin stack up
+  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}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {![string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "8.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "PC_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-3.4
+# Desc: Another "stack up"  test
+gdbtk_test srcwin-3.4 "stack up (4)" {
+  $srcwin stack up
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list0.c"} {set r -1}
+  if {$func != "main"} {set r -2}
+
+  # check that the correct 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}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "12.2"} {
+	      incr r
+	    } else {
+	      dbug X $i
+	      incr r 5
+	    }
+	  }
+	  if {$v == "PC_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-3.5
+# Desc: "stack up" when we are at the top
+gdbtk_test srcwin-3.5 "stack up when at the top" {
+  $srcwin stack up
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list0.c"} {set r -1}
+  if {$func != "main"} {set r -2}
+
+  # check that the correct 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}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "12.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "PC_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-3.6
+# Desc: "stack down"  test
+gdbtk_test srcwin-3.6 "stack down" {
+  $srcwin stack down
+  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}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {![string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG and STACK_TAG on correct lines
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "STACK_TAG"} {
+	    if {$i == "8.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "PC_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-3.7
+# Desc: "stack bottom"  test
+gdbtk_test srcwin-3.7 "stack bottom" {
+  $srcwin stack bottom
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list1.c"} {set r -1}
+  if {$func != "oof"} {set r -2}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {[string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "32.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# Test: srcwin-3.8
+# Desc: "stack down" when at bottom
+gdbtk_test srcwin-3.8 "stack down when at bottom" {
+  $srcwin stack down
+  set r 0
+  set name [$statbar.name get]
+  set func [$statbar.func get]
+
+  # check contents of name and function comboboxes
+  if {$name != "list1.c"} {set r -1}
+  if {$func != "oof"} {set r -2}
+
+  # check that the correct file is displayed
+  set twin [$stw test_get twin]
+  set a [$twin get 1.0 end]
+  if {[string compare $file2(source) $a]} {set r -3}
+  
+  # check for PC_TAG on correct line
+  if {$r == 0} {
+    if {![catch {set z [$twin dump -tag 1.0 end]}]} {
+      foreach {k v i} $z {
+	if {$k == "tagon"} {
+	  if {$v == "PC_TAG"} {
+	    if {$i == "32.2"} {
+	      incr r
+	    } else {
+	      incr r 5
+	    }
+	  }
+	  if {$v == "STACK_TAG"} {incr r 10}
+	  if {$v == "BROWSE_TAG"} {incr r 100}
+	}
+      }
+    } else {
+      set r -4
+    }
+  }
+  set r
+} {1}
+
+# 4.1 bp, multiple, balloon, etc
+# 5.1 balloon variables
+
+
+gdbtk_test_done
+
+
+# Local variables:
+# mode: tcl
+# End:
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3103f86ed06..b2f3ba9adb6 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -101,7 +101,7 @@ proc gdb_unload {} {
     global gdb_prompt
     send_gdb "file\n"
     gdb_expect 60 {
-	-re "No exec file now\[^\r\n\]*\[\r\n\]" { exp_continue }
+	-re "No executable file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 	-re "No symbol file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 	-re "A program is being debugged already..*Kill it.*y or n. $"\
 	    { send_gdb "y\n"
@@ -406,6 +406,13 @@ proc gdb_test { args } {
 	}
     }
     gdb_expect $tmt {
+	 -re "\\*\\*\\* DOSEXIT code.*" {
+	     if { $message != "" } {
+		 fail "$message";
+	     }
+	     gdb_suppress_entire_file "GDB died";
+	     return -1;
+	 }
 	 -re "Ending remote debugging.*$gdb_prompt$" {
 	    if ![isnative] then {
 		warning "Can`t communicate to remote target."
@@ -827,23 +834,128 @@ proc skip_chill_tests {} {
     return $skip_chill
 }
 
-proc get_compiler_info {binfile} {
+# skip all the tests in the file if you are not on an hppa running hpux target.
+# and you compiled with gcc
+proc skip_hp_tests {gcc_used} {
+  #  if ![info exists do_hp_tests] {
+  #	return 1;
+  #  }
+    eval set skip_hp [expr ![isnative] || ![istarget "hppa*-*-hpux*"] || $gcc_used!=0 ]
+    verbose "Skip hp tests is $skip_hp"
+    return $skip_hp
+}
+
+proc get_compiler_info {binfile args} {
     # Create and source the file that provides information about the compiler
     # used to compile the test case.
+    # Compiler_type can be null or c++. If null we assume c.
     global srcdir
     global subdir
     # These two come from compiler.c.
     global signed_keyword_not_used
     global gcc_compiled
 
-    if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
-	perror "Couldn't make ${binfile}.ci file"
-	return 1;
+    if {![istarget "hppa*-*-hpux*"]} {
+	if { [llength $args] > 0 } {
+	    if {$args == "c++"} {
+	if { [gdb_compile "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci" preprocess {}] != "" } {
+		    perror "Couldn't make ${binfile}.ci file"
+		    return 1;
+		}
+	    }
+	} else {
+	    if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
+		perror "Couldn't make ${binfile}.ci file"
+		return 1;
+	    }
+	}
+    } else {
+	if { [llength $args] > 0 } {
+	    if {$args == "c++"} {
+		if { [eval gdb_preprocess \
+			[list "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci"] \
+			$args] != "" } {
+		    perror "Couldn't make ${binfile}.ci file"
+		    return 1;
+		}
+	    }
+	} else {
+	    if { [eval gdb_preprocess \
+		    [list "${srcdir}/${subdir}/compiler.c" "${binfile}.ci"] \
+		    $args] != "" } {
+		perror "Couldn't make ${binfile}.ci file"
+		return 1;
+	    }
+	}
     }
+    
     source ${binfile}.ci
     return 0;
 }
 
+proc gdb_preprocess {source dest args} {
+    global CC_FOR_TARGET
+    global CXX_FOR_TARGET
+
+    if { [llength $args] == 0 } {
+        set which_compiler "c"
+    } else {
+        if { $args =="c++" } {
+            set which_compiler "c++"
+        } else {
+	    perror "Unknown compiler type supplied to gdb_preprocess"
+	    return 1;
+        }
+    }
+
+    if [info exists CC_FOR_TARGET] {
+	if { $which_compiler == "c"} {
+	    set compiler $CC_FOR_TARGET;
+	}
+    }
+ 
+    if [info exists CXX_FOR_TARGET] {
+	if { $which_compiler == "c++"} {
+	    set compiler $CXX_FOR_TARGET;
+	}
+    }
+
+    if { ![info exists compiler] } {
+        if { $which_compiler == "c" } {
+	    if {[info exists CC]} {
+		set compiler $CC;
+	    }
+	}
+        if { $which_compiler == "c++" } {
+	    if {[info exists CXX]} {
+		set compiler $CXX;
+	    }
+	}
+	if {![info exists compiler]} {
+	    set compiler [board_info [target_info name] compiler];
+	    if { $compiler == "" } {
+		puts "default_target_compile: No compiler to compile with";
+		return "default_target_compile: No compiler to compile with";
+	    }
+	}
+    }
+
+    set cmdline "$compiler -E $source > $dest"
+
+    puts "Invoking $compiler -E $source > $dest"
+    verbose "Invoking $compiler -E $source > $dest"
+    verbose -log "Executing on local host: $cmdline" 2
+    set status [catch "exec ${cmdline}" exec_output]
+
+    set result [prune_warnings $exec_output]
+    regsub "\[\r\n\]*$" "$result" "" result;
+    regsub "^\[\r\n\]*" "$result" "" result;
+    if { $result != "" } {
+        clone_output "gdb compile failed, $result"
+    }
+    return $result;
+}
+
 proc gdb_compile {source dest type options} {
     global GDB_TESTCASE_OPTIONS;
 
@@ -862,6 +974,7 @@ proc gdb_compile {source dest type options} {
     }
     verbose "options are $options"
     verbose "source is $source $dest $type $options"
+
     set result [target_compile $source $dest $type $options];
     regsub "\[\r\n\]*$" "$result" "" result;
     regsub "^\[\r\n\]*" "$result" "" result;
@@ -1154,3 +1267,107 @@ proc gdb_step_for_stub { } {
 	default {}
     }
 }
+
+# start-sanitize-gdbtk
+# From dejagnu:
+# srcdir = testsuite src dir (e.g., devo/gdb/testsuite)
+# objdir = testsuite obj dir (e.g., gdb/testsuite)
+# subdir = subdir of testsuite (e.g., gdb.gdbtk)
+#
+# To gdbtk:
+# env(DEFS)=the "defs" files (e.g., devo/gdb/testsuite/gdb.gdbtk/defs)
+# env(SRCDIR)=directory containing the test code (e.g., *.test)
+# env(OBJDIR)=directory which contains any executables
+#            (e.g., gdb/testsuite/gdb.gdbtk)
+proc gdbtk_start {test} {
+  global verbose
+  global GDB
+  global GDBFLAGS
+  global env srcdir subdir objdir
+
+  gdb_stop_suppressing_tests;
+
+  verbose "Starting $GDB -nx -q --tclcommand=$test"
+
+  set real_test [which $test]
+  if {$real_test == 0} {
+    perror "$test is not found"
+    exit 1
+  }
+
+  if {![is_remote host]} {
+    if { [which $GDB] == 0 } {
+      perror "$GDB does not exist."
+      exit 1
+    }
+  }
+
+  set wd [pwd]
+  cd [file join $srcdir .. gdbtcl2]
+  set env(GDBTK_LIBRARY) [pwd]
+  cd [file join $srcdir .. .. tcl library]
+  set env(TCL_LIBRARY) [pwd]
+  cd [file join $srcdir .. .. tk library]
+  set env(TK_LIBRARY) [pwd]
+  cd [file join $srcdir .. .. tix library]
+  set env(TIX_LIBRARY) [pwd]
+  cd [file join $srcdir .. .. itcl itcl library]
+  set env(ITCL_LIBRARY) [pwd]
+  cd [file join .. $srcdir .. .. libgui library]
+  set env(CYGNUS_GUI_LIBRARY) [pwd]
+  cd $wd
+  cd [file join $srcdir $subdir]
+  set env(DEFS) [file join [pwd] defs]
+  cd $wd
+  cd [file join $objdir $subdir]
+  set env(OBJDIR) [pwd]
+  cd $wd
+  cd $srcdir
+  set env(SRCDIR) [pwd]
+  cd $wd
+  set env(GDBTK_VERBOSE) 1
+  set env(GDBTK_LOGFILE) [file join $objdir gdb.log]
+  set env(GDBTK_TEST_RUNNING) 1
+  set err [catch {exec $GDB -nx -q --tclcommand=$test} res]
+  if { $err } {
+    perror "Execing $GDB failed: $res"
+    exit 1;
+  }
+  return $res
+}
+
+# gdbtk tests call this function to print out the results of the
+# tests. The argument is a proper list of lists of the form:
+# {status name description msg}. All of these things typically
+# come from the testsuite harness.
+proc gdbtk_analyze_results {results} {
+  foreach test $results {
+    set status [lindex $test 0]
+    set name [lindex $test 1]
+    set description [lindex $test 2]
+    set msg [lindex $test 3]
+
+    switch $status {
+      PASS {
+	pass "$description ($name)"
+      }
+
+      FAIL {
+	fail "$description ($name)"
+      }
+
+      ERROR {
+	perror "$name"
+      }
+
+      XFAIL {
+	xfail "$description ($name)"
+      }
+
+      XPASS {
+	xpass "$description ($name)"
+      }
+    }
+  }
+}
+# end-sanitize-gdbtk