This is the mail archive of the gdb-patches@sources.redhat.com mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: [RFA] gdbtk testsuite enhancements - infrastructure


We have previously discussed this with Keith in the Insight list.

If nobody objects, Keith will make this change.

Fernando


Keith Seitz wrote:
> 
> Hi,
> 
> I have completed a bunch of work to enhance the gdbtk (aka Insight)
> testsuite. This patch adds functionality to gdb's dejagnu testsuite
> infrastructure to better support gui testing. Specifically, it
> incorporates the ability to run the tests off-screen if Xvfb is installed.
> 
> Executive summary of how it will all affect the average gdb contributor:
> If env variable GDB_DISPLAY is set, it will run gdbtk tests using that
> display. If GDB_DISPLAY is not set, testsuite will attempt to run Xvfb for
> testsing. If Xvfb is not found, tests are skipped.
> 
> So, to test on unix, either set GDB_DISPLAY=$DISPLAY (and don't touch
> anything) or put Xvfb in your path. On Cygwin, you must set GDB_DISPLAY
> (to anything) to run the tests.
> 
> There are accompanying gdb.gdbtk/*.exp changes to accompany this. See
> follow-up.
> 
> Keith
> 
> testsuite/ChangeLog:
> 2001-05-07  Keith Seitz  <keiths@cygnus.com>
> 
>         * lib/gdb.exp (gdbtk_initialize_display): New proc which will
>         set up the display for testing.
>         (gdbtk_start): Convert all paths to paths that tcl will like.
>         Export target information to environment.
>         (_gdbtk_xvfb_init): New proc to start Xvfb if available and
>         necessary.
>         (_gdbtk_xvfb_exit): New proc to kill Xvfb if necessary.
>         (to_tcl_path): New proc to convert a given pathname into
>         a path acceptible as an argument to a tcl command.
>         (_gdbtk_export_target_info): New proc to export target info
>         into the environment for gdbtk testing.
>         (gdbtk_done): New proc to signal end-of-test.
> 
> Patch:
> Index: gdb/testsuite/lib/gdb.exp
> ===================================================================
> RCS file: /cvs/src/src/gdb/testsuite/lib/gdb.exp,v
> retrieving revision 1.7
> diff -u -r1.7 gdb.exp
> --- gdb/testsuite/lib/gdb.exp   2001/03/06 08:22:01     1.7
> +++ gdb/testsuite/lib/gdb.exp   2001/05/07 15:53:17
> @@ -1599,6 +1599,30 @@
>    }
>  }
> 
> +# 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)
> @@ -1632,34 +1656,34 @@
>      }
>    }
> 
> -
>    set wd [pwd]
> +
> +  # Find absolute path to test
> +  set test [to_tcl_path -abs $test]
> +
> +  # Set environment variables for tcl libraries and such
>    cd $srcdir
>    set abs_srcdir [pwd]
> -  cd [file join $abs_srcdir .. gdbtk library]
> -  set env(GDBTK_LIBRARY) [pwd]
> -  cd [file join $abs_srcdir .. .. tcl library]
> -  set env(TCL_LIBRARY) [pwd]
> -  cd [file join $abs_srcdir .. .. tk library]
> -  set env(TK_LIBRARY) [pwd]
> -  cd [file join $abs_srcdir .. .. tix library]
> -  set env(TIX_LIBRARY) [pwd]
> -  cd [file join $abs_srcdir .. .. itcl itcl library]
> -  set env(ITCL_LIBRARY) [pwd]
> -  cd [file join .. $abs_srcdir .. .. libgui library]
> -  set env(CYGNUS_GUI_LIBRARY) [pwd]
> -  cd $wd
> -  cd [file join $abs_srcdir $subdir]
> -  set env(DEFS) [file join [pwd] defs]
> +  set env(GDBTK_LIBRARY) [to_tcl_path -abs [file join $abs_srcdir .. gdbtk library]]
> +  set env(TCL_LIBRARY) [to_tcl_path -abs [file join $abs_srcdir .. .. tcl library]]
> +  set env(TK_LIBRARY) [to_tcl_path -abs [file join $abs_srcdir .. .. tk library]]
> +  set env(TIX_LIBRARY) [to_tcl_path -abs [file join $abs_srcdir .. .. tix library]]
> +  set env(ITCL_LIBRARY) [to_tcl_path -abs [file join $abs_srcdir .. .. itcl itcl library]]
> +  set env(CYGNUS_GUI_LIBRARY) [to_tcl_path -abs [file join .. $abs_srcdir .. .. libgui library]]
> +  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) [file join $objdir gdb.log]
> -  set env(GDBTK_TEST_RUNNING) 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"
> @@ -1668,6 +1692,149 @@
>    return $res
>  }
> 
> +# Start xvfb when using it.
> +# The precedence is:
> +#   1. If GDB_DISPLAY is set, 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)]} {
> +    set env(DISPLAY) $env(GDB_DISPLAY)
> +  } 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 derived 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
> @@ -1700,6 +1867,16 @@
>         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
>    }
>  }

-- 
Fernando Nasser
Red Hat Canada Ltd.                     E-Mail:  fnasser@redhat.com
2323 Yonge Street, Suite #300
Toronto, Ontario   M4P 2C9


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]