[RFA] gdbtk testsuite enhancements - script changes

[Keith Seitz <keiths at cygnus dot com>]

Hi,

This is the promised second part of the new testsuite enhancements. This
is all the changes to gdbtk's testsuite files to support the new features.

Keith

testsuite/gdb.gdbtk/ChangeLog:
2001-05-03  Keith Seitz  <keiths@cygnus.com>

        * defs: Fix typo setting _test(verbose).
        (gdbtk_test_file): New proc to load executables into gdbtk.
        (gdbtk_test_run): New proc to run executables on gdbtk.
        * browser.exp: Don't check if DISPLAY is set: let
        gdbtk_initialize_display do it all for us.
        Call gdbtk_done when finished with tests.
        * c_variable.exp: Ditto.
        * console.exp: Ditto.
        * cpp_variable.exp: Ditto.
        Only run tests if c++ is supported in the configuration.
        * srcwin.exp: Ditto the DISPLAY stuff.
        Accumulate all test results for the end and report them then.

        * list0.c, list1.c, list0.h: New files. Grabbed from gdb.base.
        * srcwin.exp: Use these local files instead of those in gdb.base.

Patch:
Index: gdb/testsuite/gdb.gdbtk/defs
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/defs,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 defs
--- gdb/testsuite/gdb.gdbtk/defs	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/defs	2001/05/07 16:21:11
@@ -1,10 +1,11 @@
 # This file contains support code for the gdbtk test suite.
+# Copyright 2001 Red Hat, Inc.
 #
 # Based on the Tcl testsuite support code, portions of this file
 # are Copyright (c) 1990-1994 The Regents of the University of California and
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 #
-global srcdir _test env srcdir objdir
+global _test env srcdir objdir

 if {![info exists srcdir]} {
   if {[info exists env(SRCDIR)]} {
@@ -30,7 +31,7 @@
   if {[info exists env(GDBTK_VERBOSE)]} {
     set _test(verbose) $env(GDBTK_VERBOSE)
   } else {
-    set _test(verbose)
+    set _test(verbose) 0
   }
 }
 if {![info exists _test(tests)]} {
@@ -54,6 +55,81 @@
 # all windows at some place on the screen so that the system's
 # window manager does not interfere. This is reset in gdbtk_test_done.
 set env(GDBTK_TEST_RUNNING) 1
+
+# The gdb "file" command to use for gdbtk testing
+# NOTE: This proc appends ".exe" to all windows' programs
+proc gdbtk_test_file {filename} {
+  global tcl_platform
+
+  if {$tcl_platform(platform) == "windows"} {
+    append filename ".exe"
+  }
+
+  set err [catch {gdb_cmd "file $filename" 1} text]
+  if {$err} {
+    error $text
+  }
+
+  return $text
+}
+
+proc gdbtk_test_run {{prog_args {}}} {
+  global env
+
+  # Get the target_info array from the testsuite
+  array set target_info $env(TARGET_INFO)
+
+  # We get the target ready by:
+  # 1. Run all init commands
+  # 2. Issue target command
+  # 3. Issue load command
+  # 4. Issue run command
+  foreach cmd $target_info(init) {
+    set err [catch {gdb_cmd $cmd 0} txt]
+    if {$err} {
+      _report_error "Target initialization command \"$cmd\" failed: $txt"
+      return 0
+    }
+  }
+
+  if {$target_info(target) != ""} {
+    set err [catch {gdb_cmd $target_info(target) 0} txt]
+    if {$err} {
+      _report_error "Failed to connect to target: $txt"
+      return 0
+    }
+  }
+
+  if {$target_info(load) != ""} {
+    set err [catch {gdb_cmd $target_info(load) 0} txt]
+    if {$err} {
+      _report_error "Failed to load: $txt"
+      return 0
+    }
+  }
+
+  if {$target_info(run) != ""} {
+    set err [catch {gdb_cmd $target_info(run) 0} txt]
+    if {$err} {
+      _report_error "Could not run target with \"$target_info(run)\": $txt"
+      return 0
+    }
+  }
+
+  return 1
+}
+
+proc _report_error {msg} {
+  global _test
+
+  if {[info exists _tesst(interactive)] && $_test(interactive)} {
+    # Dialog
+    tk_messageBox -message $msg -icon error -type ok
+  } else {
+    # to stderr
+    puts stderr $msg
+  }
+}

 proc gdbtk_print_verbose {status name description script code answer} {
   global _test
Index: gdb/testsuite/gdb.gdbtk/browser.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/browser.exp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 browser.exp
--- gdb/testsuite/gdb.gdbtk/browser.exp	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/browser.exp	2001/05/07 16:21:19
@@ -1,16 +1,22 @@
+# Copyright 1998, 1999, 2001 Red Hat, Inc.
 #
-# Check if we have a display
+# 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.
 #
-if {![info exists ::env(DISPLAY)]} {
-  untested "No DISPLAY -- skipping test"
-} else {
+# 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.

+if {[gdbtk_initialize_display]} {
   if {$tracelevel} {
     strace $tracelevel
   }

   #
-  # test console window
+  # test browser window
   #
   set prms_id 0
   set bug_id 0
@@ -29,5 +35,5 @@
   set results [split $results \n]

   # Analyze results
-  gdbtk_analyze_results $results
+  gdbtk_done $results
 }
Index: gdb/testsuite/gdb.gdbtk/console.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/console.exp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 console.exp
--- gdb/testsuite/gdb.gdbtk/console.exp	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/console.exp	2001/05/07 16:21:26
@@ -1,10 +1,16 @@
+# Copyright 1998, 1999, 2001 Red Hat, Inc.
 #
-# Check if we have a display
+# 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.
 #
-if {![info exists ::env(DISPLAY)]} {
-  untested "No DISPLAY -- skipping test"
-} else {
+# 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.

+if {[gdbtk_initialize_display]} {
   if {$tracelevel} {
     strace $tracelevel
   }
@@ -30,5 +36,5 @@
   set results [split $results \n]

   # Analyze results
-  gdbtk_analyze_results $results
+  gdbtk_done $results
 }
Index: gdb/testsuite/gdb.gdbtk/cpp_variable.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/cpp_variable.exp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 cpp_variable.exp
--- gdb/testsuite/gdb.gdbtk/cpp_variable.exp	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/cpp_variable.exp	2001/05/07 16:21:32
@@ -1,34 +1,46 @@
+# Copyright 1999, 2001 Red Hat, Inc.
 #
-# Check if we have a display
+# 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.
 #
-if {![info exists ::env(DISPLAY)]} {
-  untested "No DISPLAY -- skipping test"
-} else {
+# 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.

+if {[gdbtk_initialize_display]} {
   if {$tracelevel} {
     strace $tracelevel
   }

-  #
-  # test variable API
-  #
-  set prms_id 0
-  set bug_id 0
+  set results {}
+  if {[skip_cplus_tests]} {
+    # Target doesn't have c++ support
+    verbose "No C++ support -- skipping test"
+  } else {
+    #
+    # test variable API
+    #
+    set prms_id 0
+    set bug_id 0

-  set testfile "cpp_variable"
-  set srcfile ${testfile}.cc
-  set binfile ${objdir}/${subdir}/${testfile}
-  set r [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug c++}]
-  if  { $r != "" } {
-    gdb_suppress_entire_file \
-      "Testcase compile failed, so some tests in this file will automatically fail."
-  }
+    set testfile "cpp_variable"
+    set srcfile ${testfile}.cc
+    set binfile ${objdir}/${subdir}/${testfile}
+    set r [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug c++}]
+    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 ${testfile}.test]]
-  set results [split $results \n]
+    # Start with a fresh gdbtk
+    gdb_exit
+    set results [gdbtk_start [file join $srcdir $subdir ${testfile}.test]]
+    set results [split $results \n]
+  }

   # Analyze results
-  gdbtk_analyze_results $results
+  gdbtk_done $results
 }
Index: gdb/testsuite/gdb.gdbtk/c_variable.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/c_variable.exp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 c_variable.exp
--- gdb/testsuite/gdb.gdbtk/c_variable.exp	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/c_variable.exp	2001/05/07 16:21:36
@@ -1,10 +1,16 @@
+# Copyright 1999, 2001 Red Hat, Inc.
 #
-# Check if we have a display
+# 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.
 #
-if {![info exists ::env(DISPLAY)]} {
-  untested "No DISPLAY -- skipping test"
-} else {
+# 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.

+if {[gdbtk_initialize_display]} {
   if {$tracelevel} {
     strace $tracelevel
   }
@@ -30,5 +36,5 @@
   set results [split $results \n]

   # Analyze results
-  gdbtk_analyze_results $results
+  gdbtk_done $results
 }
Index: gdb/testsuite/gdb.gdbtk/srcwin.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.gdbtk/srcwin.exp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 srcwin.exp
--- gdb/testsuite/gdb.gdbtk/srcwin.exp	2000/02/07 00:19:45	1.1.1.1
+++ gdb/testsuite/gdb.gdbtk/srcwin.exp	2001/05/07 16:21:45
@@ -1,9 +1,16 @@
+# Copyright 1999, 2001 Red Hat, Inc.
 #
-# Check if we have a display
+# 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.
 #
-if {![info exists ::env(DISPLAY)]} {
-  untested "No DISPLAY -- skipping test"
-} else {
+# 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.
+
+if {[gdbtk_initialize_display]} {
   if {$tracelevel} {
     strace $tracelevel
   }
@@ -15,32 +22,38 @@
   set bug_id 0

   set testfile "list"
+  set s1 "$srcdir/$subdir/list0.c"
+  set sources "$s1 $srcdir/$subdir/list1.c"
   set binfile $objdir/$subdir/$testfile
-  set r [gdb_compile "$srcdir/gdb.base/list0.c $srcdir/gdb.base/list1.c" "$binfile" executable debug]
+  if {[file exists $s1.save]} {
+    catch {file delete $s1}
+    file rename $s1.save $s1
+  }
+  set r [gdb_compile $sources "$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
+  set all_results $results

   # move file with "main" out of the way
-  file rename $srcdir/gdb.base/list0.c $srcdir/gdb.base/list0.c.save
+  file rename $s1 $s1.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
+  set all_results [concat $all_results $results]
+
+  # restore file
+  file rename $s1.save $s1

-  set r [gdb_compile "$srcdir/gdb.base/list0.c $srcdir/gdb.base/list1.c" "$binfile" executable ""]
+  set r [gdb_compile $sources "$binfile" executable ""]
   if  { $r != "" } {
     gdb_suppress_entire_file \
       "Testcase compile failed, so some tests in this file will automatically fail."
@@ -49,11 +62,8 @@
   gdb_exit
   set results [gdbtk_start [file join $srcdir $subdir srcwin3.test]]
   set results [split $results \n]
+  set all_results [concat $all_results $results]
+
   # Analyze results
-  gdbtk_analyze_results $results
+  gdbtk_done $all_results
 }
-
-# Local variables:
-# mode: tcl
-# change-log-default-name: "ChangeLog-gdbtk"
-# End: