* lib/gdb.exp: Move all insight-related functionality into

	separate file.
	* lib/insight-support.exp: New file.

2 files changed, 293 insertions, 280 deletions

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 47b148c..3d1ef71 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1603,286 +1603,6 @@ proc rerun_to_main {} {
   }
 }
 
-# Initializes the display for gdbtk testing.
-# Returns 1 if tests should run, 0 otherwise.
-proc gdbtk_initialize_display {} {
-  global _using_windows
-
-  # This is hacky, but, we don't have much choice. When running
-  # expect under Windows, tcl_platform(platform) is "unix".
-  if {![info exists _using_windows]} {
-    set _using_windows [expr {![catch {exec cygpath --help}]}]
-  }
-
-  if {![_gdbtk_xvfb_init]} {
-    if {$_using_windows} {
-      untested "No GDB_DISPLAY -- skipping tests"
-    } else {
-      untested "No GDB_DISPLAY or Xvfb -- skipping tests"
-    }
-
-    return 0
-  }
-
-  return 1
-}
-
-# 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]
-
-  # Find absolute path to test
-  set test [to_tcl_path -abs $test]
-
-  # Set some environment variables
-  cd $srcdir
-  set abs_srcdir [pwd]
-  set env(DEFS) [to_tcl_path -abs [file join $abs_srcdir $subdir defs]]
-
-  cd $wd
-  cd [file join $objdir $subdir]
-  set env(OBJDIR) [pwd]
-  cd $wd
-
-  # Set info about target into env
-  _gdbtk_export_target_info
-
-  set env(SRCDIR) $abs_srcdir
-  set env(GDBTK_VERBOSE) 1
-  set env(GDBTK_LOGFILE) [to_tcl_path [file join $objdir gdb.log]]
-
-  set err [catch {exec $GDB -nx -q --tclcommand=$test} res]
-  if { $err } {
-    perror "Execing $GDB failed: $res"
-    exit 1;
-  }
-  return $res
-}
-
-# Start xvfb when using it.
-# The precedence is:
-#   1. If GDB_DISPLAY is set (and not ""), use it
-#   2. If Xvfb exists, use it (not on cygwin)
-#   3. Skip tests
-proc _gdbtk_xvfb_init {} {
-  global env spawn_id _xvfb_spawn_id _using_windows
-
-  if {[info exists env(GDB_DISPLAY)]} {
-    if {$env(GDB_DISPLAY) != ""} {
-      set env(DISPLAY) $env(GDB_DISPLAY)
-    } else {
-      # Suppress tests
-      return 0
-    }
-  } elseif {!$_using_windows && [which Xvfb] != 0} {
-    set screen ":[getpid]"
-    set pid [spawn  Xvfb $screen]
-    set _xvfb_spawn_id $spawn_id
-    set env(DISPLAY) $screen
-  } else {
-    # No Xvfb found -- skip test
-    return 0
-  }
-
-  return 1
-}
-
-# Kill xvfb
-proc _gdbtk_xvfb_exit {} {
-  global objdir subdir env _xvfb_spawn_id
-
-  if {[info exists _xvfb_spawn_id]} {
-    exec kill [exp_pid -i $_xvfb_spawn_id]
-    wait -i $_xvfb_spawn_id
-  }
-}
-
-# help proc for setting tcl-style paths from unix-style paths
-# pass "-abs" to make it an absolute path
-proc to_tcl_path {unix_path {arg {}}} {
-  global _using_windows
-
-  if {[string compare $unix_path "-abs"] == 0} {
-    set unix_path $arg
-    set wd [pwd]
-    cd [file dirname $unix_path]
-    set dirname [pwd]
-    set unix_name [file join $dirname [file tail $unix_path]]
-    cd $wd
-  }
-
-  if {$_using_windows} {
-    set unix_path [exec cygpath -aw $unix_path]
-    set unix_path [join [split $unix_path \\] /]
-  }
-
-  return $unix_path
-}
-  
-# Set information about the target into the environment
-# variable TARGET_INFO. This array will contain a list
-# of commands that are necessary to run a target.
-#
-# This is mostly devined from how dejagnu works, what
-# procs are defined, and analyzing unix.exp, monitor.exp,
-# and sim.exp.
-#
-# Array elements exported:
-# Index   Meaning
-# -----   -------
-# init    list of target/board initialization commands
-# target  target command for target/board
-# load    load command for target/board
-# run     run command for target_board
-proc _gdbtk_export_target_info {} {
-  global env
-
-  # Figure out what "target class" the testsuite is using,
-  # i.e., sim, monitor, native
-  if {[string compare [info proc gdb_target_monitor] gdb_target_monitor] == 0} {
-    # Using a monitor/remote target
-    set target monitor
-  } elseif {[string compare [info proc gdb_target_sim] gdb_target_sim] == 0} {
-    # Using a simulator target
-    set target simulator
-  } else {
-    # Assume native
-    set target native
-  }
-
-  # Now setup the array to be exported.
-  set info(init) {}
-  set info(target) {}
-  set info(load) {}
-  set info(run) {}
-
-  switch $target {
-    simulator {
-      set opts "[target_info gdb,target_sim_options]"
-      set info(target) "target sim $opts"
-      set info(load) "load"
-      set info(run) "run"
-    }
-
-    monitor {
-      # Setup options for the connection
-      if {[target_info exists baud]} {
-	lappend info(init) "set remotebaud [target_info baud]"
-      }
-      if {[target_info exists binarydownload]} {
-	lappend info(init) "set remotebinarydownload [target_info binarydownload]"
-      }
-      if {[target_info exists disable_x_packet]} {
-	lappend info(init) "set remote X-packet disable"
-      }
-      if {[target_info exists disable_z_packet]} {
-	lappend info(init) "set remote Z-packet disable"
-      }
-
-      # Get target name and connection info
-      if {[target_info exists gdb_protocol]} {
-	set targetname "[target_info gdb_protocol]"
-      } else {
-	set targetname "not_specified"
-      }
-      if {[target_info exists gdb_serial]} {
-	set serialport "[target_info gdb_serial]"
-      } elseif {[target_info exists netport]} {
-	set serialport "[target_info netport]"
-      } else {
-	set serialport "[target_info serial]"
-      }
-
-      set info(target) "target $targetname $serialport"
-      set info(load) "load"
-      set info(run) "continue"
-    }
-
-    native {
-      set info(run) "run"
-    }
-  }
-
-  # Export the array to the environment
-  set env(TARGET_INFO) [array get info]
-}
-
-# 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)"
-      }
-    }
-  }
-}
-
-proc gdbtk_done {{results {}}} {
-  global _xvfb_spawn_id
-  gdbtk_analyze_results $results
-
-  # Kill off xvfb if using it
-  if {[info exists _xvfb_spawn_id]} {
-    _gdbtk_xvfb_exit
-  }
-}
-
 # Print a message and return true if a test should be skipped
 # due to lack of floating point suport.
 
diff --git a/gdb/testsuite/lib/insight-support.exp b/gdb/testsuite/lib/insight-support.exp
new file mode 100644
index 0000000..2520f83
--- /dev/null
+++ b/gdb/testsuite/lib/insight-support.exp
@@ -0,0 +1,293 @@
+# GDB Testsuite Support for Insight.
+#
+# Copyright 2001 Red Hat, Inc.
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License (GPL) 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.
+
+# Initializes the display for gdbtk testing.
+# Returns 1 if tests should run, 0 otherwise.
+proc gdbtk_initialize_display {} {
+  global _using_windows
+
+  # This is hacky, but, we don't have much choice. When running
+  # expect under Windows, tcl_platform(platform) is "unix".
+  if {![info exists _using_windows]} {
+    set _using_windows [expr {![catch {exec cygpath --help}]}]
+  }
+
+  if {![_gdbtk_xvfb_init]} {
+    if {$_using_windows} {
+      untested "No GDB_DISPLAY -- skipping tests"
+    } else {
+      untested "No GDB_DISPLAY or Xvfb -- skipping tests"
+    }
+
+    return 0
+  }
+
+  return 1
+}
+
+# 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]
+
+  # Find absolute path to test
+  set test [to_tcl_path -abs $test]
+
+  # Set some environment variables
+  cd $srcdir
+  set abs_srcdir [pwd]
+  set env(DEFS) [to_tcl_path -abs [file join $abs_srcdir $subdir defs]]
+
+  cd $wd
+  cd [file join $objdir $subdir]
+  set env(OBJDIR) [pwd]
+  cd $wd
+
+  # Set info about target into env
+  _gdbtk_export_target_info
+
+  set env(SRCDIR) $abs_srcdir
+  set env(GDBTK_VERBOSE) 1
+  set env(GDBTK_LOGFILE) [to_tcl_path [file join $objdir gdb.log]]
+
+  set err [catch {exec $GDB -nx -q --tclcommand=$test} res]
+  if { $err } {
+    perror "Execing $GDB failed: $res"
+    exit 1;
+  }
+  return $res
+}
+
+# Start xvfb when using it.
+# The precedence is:
+#   1. If GDB_DISPLAY is set (and not ""), use it
+#   2. If Xvfb exists, use it (not on cygwin)
+#   3. Skip tests
+proc _gdbtk_xvfb_init {} {
+  global env spawn_id _xvfb_spawn_id _using_windows
+
+  if {[info exists env(GDB_DISPLAY)]} {
+    if {$env(GDB_DISPLAY) != ""} {
+      set env(DISPLAY) $env(GDB_DISPLAY)
+    } else {
+      # Suppress tests
+      return 0
+    }
+  } elseif {!$_using_windows && [which Xvfb] != 0} {
+    set screen ":[getpid]"
+    set pid [spawn  Xvfb $screen]
+    set _xvfb_spawn_id $spawn_id
+    set env(DISPLAY) $screen
+  } else {
+    # No Xvfb found -- skip test
+    return 0
+  }
+
+  return 1
+}
+
+# Kill xvfb
+proc _gdbtk_xvfb_exit {} {
+  global objdir subdir env _xvfb_spawn_id
+
+  if {[info exists _xvfb_spawn_id]} {
+    exec kill [exp_pid -i $_xvfb_spawn_id]
+    wait -i $_xvfb_spawn_id
+  }
+}
+
+# help proc for setting tcl-style paths from unix-style paths
+# pass "-abs" to make it an absolute path
+proc to_tcl_path {unix_path {arg {}}} {
+  global _using_windows
+
+  if {[string compare $unix_path "-abs"] == 0} {
+    set unix_path $arg
+    set wd [pwd]
+    cd [file dirname $unix_path]
+    set dirname [pwd]
+    set unix_name [file join $dirname [file tail $unix_path]]
+    cd $wd
+  }
+
+  if {$_using_windows} {
+    set unix_path [exec cygpath -aw $unix_path]
+    set unix_path [join [split $unix_path \\] /]
+  }
+
+  return $unix_path
+}
+  
+# Set information about the target into the environment
+# variable TARGET_INFO. This array will contain a list
+# of commands that are necessary to run a target.
+#
+# This is mostly devined from how dejagnu works, what
+# procs are defined, and analyzing unix.exp, monitor.exp,
+# and sim.exp.
+#
+# Array elements exported:
+# Index   Meaning
+# -----   -------
+# init    list of target/board initialization commands
+# target  target command for target/board
+# load    load command for target/board
+# run     run command for target_board
+proc _gdbtk_export_target_info {} {
+  global env
+
+  # Figure out what "target class" the testsuite is using,
+  # i.e., sim, monitor, native
+  if {[string compare [info proc gdb_target_monitor] gdb_target_monitor] == 0} {
+    # Using a monitor/remote target
+    set target monitor
+  } elseif {[string compare [info proc gdb_target_sim] gdb_target_sim] == 0} {
+    # Using a simulator target
+    set target simulator
+  } else {
+    # Assume native
+    set target native
+  }
+
+  # Now setup the array to be exported.
+  set info(init) {}
+  set info(target) {}
+  set info(load) {}
+  set info(run) {}
+
+  switch $target {
+    simulator {
+      set opts "[target_info gdb,target_sim_options]"
+      set info(target) "target sim $opts"
+      set info(load) "load"
+      set info(run) "run"
+    }
+
+    monitor {
+      # Setup options for the connection
+      if {[target_info exists baud]} {
+	lappend info(init) "set remotebaud [target_info baud]"
+      }
+      if {[target_info exists binarydownload]} {
+	lappend info(init) "set remotebinarydownload [target_info binarydownload]"
+      }
+      if {[target_info exists disable_x_packet]} {
+	lappend info(init) "set remote X-packet disable"
+      }
+      if {[target_info exists disable_z_packet]} {
+	lappend info(init) "set remote Z-packet disable"
+      }
+
+      # Get target name and connection info
+      if {[target_info exists gdb_protocol]} {
+	set targetname "[target_info gdb_protocol]"
+      } else {
+	set targetname "not_specified"
+      }
+      if {[target_info exists gdb_serial]} {
+	set serialport "[target_info gdb_serial]"
+      } elseif {[target_info exists netport]} {
+	set serialport "[target_info netport]"
+      } else {
+	set serialport "[target_info serial]"
+      }
+
+      set info(target) "target $targetname $serialport"
+      set info(load) "load"
+      set info(run) "continue"
+    }
+
+    native {
+      set info(run) "run"
+    }
+  }
+
+  # Export the array to the environment
+  set env(TARGET_INFO) [array get info]
+}
+
+# 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)"
+      }
+    }
+  }
+}
+
+proc gdbtk_done {{results {}}} {
+  global _xvfb_spawn_id
+  gdbtk_analyze_results $results
+
+  # Kill off xvfb if using it
+  if {[info exists _xvfb_spawn_id]} {
+    _gdbtk_xvfb_exit
+  }
+}