Re: [PATCH 18/28] check gdb_python_initialized everywhere

[Tom Tromey <tromey at redhat dot com>]

>>>>> "Tom" == Tom Tromey <tromey@redhat.com> writes:

Tom> While sending out the series I realized I had meant to write a test case
Tom> for this patch but forgot to.  I will hold on to this one until I write
Tom> it.

This required a two-part series.

The first patch just cleans up the existing gdb.gdb tests to remove
duplication and to make it simpler to add new tests here.

The second patch is the actual test case.

Built and regtested on x86-64 Fedora 18.

Tom

>From 7b014fea57c4efd58feed859337e7cbb6e98255b Mon Sep 17 00:00:00 2001
From: Tom Tromey <tromey@redhat.com>
Date: Mon, 22 Apr 2013 11:50:35 -0600
Subject: [PATCH 32/33] consolidate some code in gdb.gdb

This patch consolidates some code in gdb.gdb.  This makes it simpler
to add new self-tests.

	* lib/selftest-support.exp: New file.
	* gdb.gdb/complaints.exp: Load selftest-support.exp.  Use
	do_self_tests.
	(setup_test, find_gdb): Remove.
	* gdb.gdb/observer.exp: Load selftest-support.exp.  Use
	do_self_tests.
	(setup_test, find_gdb): Remove.
	(test_observer): Don't call setup_test.  Remove argument.
	* gdb.gdb/selftest.exp: Load selftest-support.exp.
	(find_gdb): Remove.
	* gdb.gdb/complaints.exp: Load selftest-support.exp.  Use
	do_self_tests.
	(setup_test, find_gdb): Remove.
	(test_with_self): Don't call setup_test.  Remove argument.
---
 gdb/testsuite/gdb.gdb/complaints.exp   | 126 ++---------------------------
 gdb/testsuite/gdb.gdb/observer.exp     | 125 +---------------------------
 gdb/testsuite/gdb.gdb/selftest.exp     |  24 +-----
 gdb/testsuite/gdb.gdb/xfullpath.exp    | 125 +---------------------------
 gdb/testsuite/lib/selftest-support.exp | 144 +++++++++++++++++++++++++++++++++
 5 files changed, 157 insertions(+), 387 deletions(-)
 create mode 100644 gdb/testsuite/lib/selftest-support.exp

diff --git a/gdb/testsuite/gdb.gdb/complaints.exp b/gdb/testsuite/gdb.gdb/complaints.exp
index f298725..932dfd5 100644
--- a/gdb/testsuite/gdb.gdb/complaints.exp
+++ b/gdb/testsuite/gdb.gdb/complaints.exp
@@ -17,6 +17,7 @@
 # derived from xfullpath.exp (written by Joel Brobecker), derived from
 # selftest.exp (written by Rob Savoye).
 
+load_lib selftest-support.exp
 
 # are we on a target board
 if { [is_remote target] || ![isnative] } then {
@@ -28,79 +29,6 @@ if [target_info exists gdb,noinferiorio] {
     return
 }
 
-proc setup_test { executable } {
-    global gdb_prompt
-    global timeout
-    global INTERNAL_GDBFLAGS
-
-    # load yourself into the debugger
-    # This can take a relatively long time, particularly for testing where
-    # the executable is being accessed over a network, or where gdb does not
-    # support partial symbols for a particular target and has to load the
-    # entire symbol table.  Set the timeout to 10 minutes, which should be
-    # adequate for most environments (it *has* timed out with 5 min on a
-    # SPARCstation SLC under moderate load, so this isn't unreasonable).
-    # After gdb is started, set the timeout to 30 seconds for the duration
-    # of this test, and then back to the original value.
-
-    set oldtimeout $timeout
-    set timeout 600
-    verbose "Timeout is now $timeout seconds" 2
-
-    global gdb_file_cmd_debug_info
-    set gdb_file_cmd_debug_info "unset"
-
-    set result [gdb_load $executable]
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    if { $result != 0 } then {
-	return -1
-    }
-
-    if { $gdb_file_cmd_debug_info != "debug" } then {
-	untested "No debug information, skipping testcase."
-	return -1
-    }
-
-    # Set a breakpoint at main
-    gdb_test "break captured_command_loop" \
-            "Breakpoint.*at.* file.*, line.*" \
-            "breakpoint in captured_command_loop"
-
-    # run yourself
-    # It may take a very long time for the inferior gdb to start (lynx),
-    # so we bump it back up for the duration of this command.
-    set timeout 600
-
-    set description "run until breakpoint at captured_command_loop"
-    gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" {
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.* at .*main.c:.*$gdb_prompt $" {
-            pass "$description"
-        }
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.*$gdb_prompt $" {
-            xfail "$description (line numbers scrambled?)"
-        }
-        -re "vfork: No more processes.*$gdb_prompt $" {
-            fail "$description (out of virtual memory)"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-        -re ".*$gdb_prompt $" {
-            fail "$description"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-    }
-
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    return 0
-}
-
 proc test_initial_complaints { } {
 
     global gdb_prompt
@@ -221,51 +149,9 @@ proc test_empty_complaints { } {
     return 0
 }
 
-# Find a pathname to a file that we would execute if the shell was asked
-# to run $arg using the current PATH.
-
-proc find_gdb { arg } {
-
-    # If the arg directly specifies an existing executable file, then
-    # simply use it.
-
-    if [file executable $arg] then {
-	return $arg
-    }
-
-    set result [which $arg]
-    if [string match "/" [ string range $result 0 0 ]] then {
-	return $result
-    }
-
-    # If everything fails, just return the unqualified pathname as default
-    # and hope for best.
-
-    return $arg
-}
-
-# Run the test with self.
-# Copy the file executable file in case this OS doesn't like to edit its own
-# text space.
-
-set GDB_FULLPATH [find_gdb $GDB]
-
-# Remove any old copy lying around.
-remote_file host delete x$tool
-
-gdb_start
-
-set file [remote_download host $GDB_FULLPATH x$tool]
-
-set setup_result [setup_test $file ]
-if {$setup_result <0} then {
-    return -1
+do_self_tests captured_command_loop {
+    test_initial_complaints
+    test_serial_complaints
+    test_short_complaints
+    test_empty_complaints
 }
-
-test_initial_complaints
-test_serial_complaints
-test_short_complaints
-test_empty_complaints
-
-gdb_exit;
-catch "remote_file host delete $file";
diff --git a/gdb/testsuite/gdb.gdb/observer.exp b/gdb/testsuite/gdb.gdb/observer.exp
index 9397146..32030d8 100644
--- a/gdb/testsuite/gdb.gdb/observer.exp
+++ b/gdb/testsuite/gdb.gdb/observer.exp
@@ -16,85 +16,13 @@
 # This file was written by Joel Brobecker (brobecker@gnat.com), derived
 # from xfullpath.exp.
 
+load_lib selftest-support.exp
 
 # are we on a target board
 if { [is_remote target] || ![isnative] } then {
     return
 }
 
-proc setup_test { executable } {
-    global gdb_prompt
-    global timeout
-    global INTERNAL_GDBFLAGS
-
-    # load yourself into the debugger
-    # This can take a relatively long time, particularly for testing where
-    # the executable is being accessed over a network, or where gdb does not
-    # support partial symbols for a particular target and has to load the
-    # entire symbol table.  Set the timeout to 10 minutes, which should be
-    # adequate for most environments (it *has* timed out with 5 min on a
-    # SPARCstation SLC under moderate load, so this isn't unreasonable).
-    # After gdb is started, set the timeout to 30 seconds for the duration
-    # of this test, and then back to the original value.
-
-    set oldtimeout $timeout
-    set timeout 600
-    verbose "Timeout is now $timeout seconds" 2
-
-    global gdb_file_cmd_debug_info
-    set gdb_file_cmd_debug_info "unset"
-
-    set result [gdb_load $executable]
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    if { $result != 0 } then {
-	return -1
-    }
-
-    if { $gdb_file_cmd_debug_info != "debug" } then {
-	untested "No debug information, skipping testcase."
-	return -1
-    }
-
-    # Set a breakpoint at main
-    gdb_test "break captured_main" \
-            "Breakpoint.*at.* file.*, line.*" \
-            "breakpoint in captured_main"
-
-    # run yourself
-    # It may take a very long time for the inferior gdb to start (lynx),
-    # so we bump it back up for the duration of this command.
-    set timeout 600
-
-    set description "run until breakpoint at captured_main"
-    gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" {
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" {
-            pass "$description"
-        }
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" {
-            xfail "$description (line numbers scrambled?)"
-        }
-        -re "vfork: No more processes.*$gdb_prompt $" {
-            fail "$description (out of virtual memory)"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-        -re ".*$gdb_prompt $" {
-            fail "$description"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-    }
-
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    return 0
-}
-
 proc attach_first_observer { message } {
     gdb_test_no_output "set \$first_obs = observer_attach_test_notification (&observer_test_first_notification_function)" \
 	"$message; attach first observer"
@@ -160,13 +88,7 @@ proc test_notifications { first second third message args } {
     check_counters $first $second $third $message
 }
 
-proc test_observer { executable } {
-
-    set setup_result [setup_test $executable]
-    if {$setup_result <0} then {
-        return -1
-    }
-
+proc test_observer {} {
     # First, try sending a notification without any observer attached.
     test_notifications 0 0 0 "no observer attached"
 
@@ -223,45 +145,4 @@ proc test_observer { executable } {
     return 0
 }
 
-# Find a pathname to a file that we would execute if the shell was asked
-# to run $arg using the current PATH.
-
-proc find_gdb { arg } {
-
-    # If the arg directly specifies an existing executable file, then
-    # simply use it.
-
-    if [file executable $arg] then {
-	return $arg
-    }
-
-    set result [which $arg]
-    if [string match "/" [ string range $result 0 0 ]] then {
-	return $result
-    }
-
-    # If everything fails, just return the unqualified pathname as default
-    # and hope for best.
-
-    return $arg
-}
-
-# Run the test with self.
-# Copy the file executable file in case this OS doesn't like to edit its own
-# text space.
-
-set GDB_FULLPATH [find_gdb $GDB]
-
-# Remove any old copy lying around.
-remote_file host delete x$tool
-
-gdb_start
-set file [remote_download host $GDB_FULLPATH x$tool]
-set result [test_observer $file];
-gdb_exit;
-catch "remote_file host delete $file";
-
-if {$result <0} then {
-    warning "Couldn't test self"
-    return -1
-}
+do_self_tests captured_main test_observer
diff --git a/gdb/testsuite/gdb.gdb/selftest.exp b/gdb/testsuite/gdb.gdb/selftest.exp
index 55e13cf..b3350fa 100644
--- a/gdb/testsuite/gdb.gdb/selftest.exp
+++ b/gdb/testsuite/gdb.gdb/selftest.exp
@@ -15,6 +15,7 @@
 
 # This file was written by Rob Savoye. (rob@cygnus.com)
 
+load_lib selftest-support.exp
 
 # are we on a target board
 if { [is_remote target] || ![isnative] } then {
@@ -468,29 +469,6 @@ proc test_with_self { executable } {
     return 0
 }
 
-# Find a pathname to a file that we would execute if the shell was asked
-# to run $arg using the current PATH.
-
-proc find_gdb { arg } {
-
-    # If the arg directly specifies an existing executable file, then
-    # simply use it.
-
-    if [file executable $arg] then {
-	return $arg
-    }
-
-    set result [which $arg]
-    if [string match "/" [ string range $result 0 0 ]] then {
-	return $result
-    }
-
-    # If everything fails, just return the unqualified pathname as default
-    # and hope for best.
-
-    return $arg
-}
-
 # Run the test with self.
 # Copy the file executable file in case this OS doesn't like to edit its own
 # text space.
diff --git a/gdb/testsuite/gdb.gdb/xfullpath.exp b/gdb/testsuite/gdb.gdb/xfullpath.exp
index 9516a4f..5bc01c6 100644
--- a/gdb/testsuite/gdb.gdb/xfullpath.exp
+++ b/gdb/testsuite/gdb.gdb/xfullpath.exp
@@ -16,92 +16,14 @@
 # This file was written by Joel Brobecker. (brobecker@gnat.com), derived
 # from selftest.exp, written by Rob Savoye.
 
+load_lib selftest-support.exp
 
 # are we on a target board
 if { [is_remote target] || ![isnative] } then {
     return
 }
 
-proc setup_test { executable } {
-    global gdb_prompt
-    global timeout
-    global INTERNAL_GDBFLAGS
-
-    # load yourself into the debugger
-    # This can take a relatively long time, particularly for testing where
-    # the executable is being accessed over a network, or where gdb does not
-    # support partial symbols for a particular target and has to load the
-    # entire symbol table.  Set the timeout to 10 minutes, which should be
-    # adequate for most environments (it *has* timed out with 5 min on a
-    # SPARCstation SLC under moderate load, so this isn't unreasonable).
-    # After gdb is started, set the timeout to 30 seconds for the duration
-    # of this test, and then back to the original value.
-
-    set oldtimeout $timeout
-    set timeout 600
-    verbose "Timeout is now $timeout seconds" 2
-
-    global gdb_file_cmd_debug_info
-    set gdb_file_cmd_debug_info "unset"
-
-    set result [gdb_load $executable]
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    if { $result != 0 } then {
-	return -1
-    }
-
-    if { $gdb_file_cmd_debug_info != "debug" } then {
-	untested "No debug information, skipping testcase."
-	return -1
-    }
-
-    # Set a breakpoint at main
-    gdb_test "break captured_main" \
-            "Breakpoint.*at.* file.*, line.*" \
-            "breakpoint in captured_main"
-
-    # run yourself
-    # It may take a very long time for the inferior gdb to start (lynx),
-    # so we bump it back up for the duration of this command.
-    set timeout 600
-
-    set description "run until breakpoint at captured_main"
-    gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" {
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" {
-            pass "$description"
-        }
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" {
-            xfail "$description (line numbers scrambled?)"
-        }
-        -re "vfork: No more processes.*$gdb_prompt $" {
-            fail "$description (out of virtual memory)"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-        -re ".*$gdb_prompt $" {
-            fail "$description"
-            set timeout $oldtimeout
-            verbose "Timeout is now $timeout seconds" 2
-            return -1
-        }
-    }
-
-    set timeout $oldtimeout
-    verbose "Timeout is now $timeout seconds" 2
-
-    return 0
-}
-
-proc test_with_self { executable } {
-
-    set setup_result [setup_test $executable]
-    if {$setup_result <0} then {
-        return -1
-    }
-
+proc test_with_self {} {
     # A file which contains a directory prefix
     gdb_test "print gdb_realpath (\"./xfullpath.exp\")" \
              ".\[0-9\]+ =.*\".*/xfullpath.exp\"" \
@@ -140,45 +62,4 @@ proc test_with_self { executable } {
     return 0
 }
 
-# Find a pathname to a file that we would execute if the shell was asked
-# to run $arg using the current PATH.
-
-proc find_gdb { arg } {
-
-    # If the arg directly specifies an existing executable file, then
-    # simply use it.
-
-    if [file executable $arg] then {
-	return $arg
-    }
-
-    set result [which $arg]
-    if [string match "/" [ string range $result 0 0 ]] then {
-	return $result
-    }
-
-    # If everything fails, just return the unqualified pathname as default
-    # and hope for best.
-
-    return $arg
-}
-
-# Run the test with self.
-# Copy the file executable file in case this OS doesn't like to edit its own
-# text space.
-
-set GDB_FULLPATH [find_gdb $GDB]
-
-# Remove any old copy lying around.
-remote_file host delete x$tool
-
-gdb_start
-set file [remote_download host $GDB_FULLPATH x$tool]
-set result [test_with_self $file];
-gdb_exit;
-catch "remote_file host delete $file";
-
-if {$result <0} then {
-    warning "Couldn't test self"
-    return -1
-}
+do_self_tests captured_main test_with_self
diff --git a/gdb/testsuite/lib/selftest-support.exp b/gdb/testsuite/lib/selftest-support.exp
new file mode 100644
index 0000000..c375849
--- /dev/null
+++ b/gdb/testsuite/lib/selftest-support.exp
@@ -0,0 +1,144 @@
+# Copyright 2003-2013 Free Software Foundation, Inc.
+
+# 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 3 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, see <http://www.gnu.org/licenses/>.
+
+# Find a pathname to a file that we would execute if the shell was asked
+# to run $arg using the current PATH.
+
+proc find_gdb { arg } {
+
+    # If the arg directly specifies an existing executable file, then
+    # simply use it.
+
+    if [file executable $arg] then {
+	return $arg
+    }
+
+    set result [which $arg]
+    if [string match "/" [ string range $result 0 0 ]] then {
+	return $result
+    }
+
+    # If everything fails, just return the unqualified pathname as default
+    # and hope for best.
+
+    return $arg
+}
+
+# A helper proc that sets up for self-testing.
+# EXECUTABLE is the gdb to use.
+# FUNCTION is the function to break in, either captured_main
+# or captured_command_loop.
+
+proc selftest_setup { executable function } {
+    global gdb_prompt
+    global timeout
+    global INTERNAL_GDBFLAGS
+
+    # load yourself into the debugger
+    # This can take a relatively long time, particularly for testing where
+    # the executable is being accessed over a network, or where gdb does not
+    # support partial symbols for a particular target and has to load the
+    # entire symbol table.  Set the timeout to 10 minutes, which should be
+    # adequate for most environments (it *has* timed out with 5 min on a
+    # SPARCstation SLC under moderate load, so this isn't unreasonable).
+    # After gdb is started, set the timeout to 30 seconds for the duration
+    # of this test, and then back to the original value.
+
+    set oldtimeout $timeout
+    set timeout 600
+    verbose "Timeout is now $timeout seconds" 2
+
+    global gdb_file_cmd_debug_info
+    set gdb_file_cmd_debug_info "unset"
+
+    set result [gdb_load $executable]
+    set timeout $oldtimeout
+    verbose "Timeout is now $timeout seconds" 2
+
+    if { $result != 0 } then {
+	return -1
+    }
+
+    if { $gdb_file_cmd_debug_info != "debug" } then {
+	untested "No debug information, skipping testcase."
+	return -1
+    }
+
+    # Set a breakpoint at main
+    gdb_test "break $function" \
+            "Breakpoint.*at.* file.*, line.*" \
+            "breakpoint in $function"
+
+    # run yourself
+    # It may take a very long time for the inferior gdb to start (lynx),
+    # so we bump it back up for the duration of this command.
+    set timeout 600
+
+    set description "run until breakpoint at $function"
+    gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" {
+        -re "Starting program.*Breakpoint \[0-9\]+,.*$function .data.* at .*main.c:.*$gdb_prompt $" {
+            pass "$description"
+        }
+        -re "Starting program.*Breakpoint \[0-9\]+,.*$function .data.*$gdb_prompt $" {
+            xfail "$description (line numbers scrambled?)"
+        }
+        -re "vfork: No more processes.*$gdb_prompt $" {
+            fail "$description (out of virtual memory)"
+            set timeout $oldtimeout
+            verbose "Timeout is now $timeout seconds" 2
+            return -1
+        }
+        -re ".*$gdb_prompt $" {
+            fail "$description"
+            set timeout $oldtimeout
+            verbose "Timeout is now $timeout seconds" 2
+            return -1
+        }
+    }
+
+    set timeout $oldtimeout
+    verbose "Timeout is now $timeout seconds" 2
+
+    return 0
+}
+
+# A simple way to run some self-tests.
+
+proc do_self_tests {function body} {
+    global GDB tool
+
+    # Run the test with self.  Copy the file executable file in case
+    # this OS doesn't like to edit its own text space.
+
+    set GDB_FULLPATH [find_gdb $GDB]
+
+    # Remove any old copy lying around.
+    remote_file host delete x$tool
+
+    gdb_start
+    set file [remote_download host $GDB_FULLPATH x$tool]
+
+    set result [selftest_setup $file $function]
+    if {$result == 0} then {
+	set result [uplevel $body]
+    }
+
+    gdb_exit
+    catch "remote_file host delete $file"
+
+    if {$result < 0} then {
+	warning "Couldn't test self"
+    }
+}
-- 
1.8.1.4

>From 97555d151da89029f17b7e55bc62ff99ff77a545 Mon Sep 17 00:00:00 2001
From: Tom Tromey <tromey@redhat.com>
Date: Mon, 22 Apr 2013 12:11:11 -0600
Subject: [PATCH 33/33] add gdb_python_initialized test case

	* gdb.gdb/python-selftest.exp: New file.
---
 gdb/testsuite/gdb.gdb/python-selftest.exp | 34 +++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)
 create mode 100644 gdb/testsuite/gdb.gdb/python-selftest.exp

diff --git a/gdb/testsuite/gdb.gdb/python-selftest.exp b/gdb/testsuite/gdb.gdb/python-selftest.exp
new file mode 100644
index 0000000..71d5b61
--- /dev/null
+++ b/gdb/testsuite/gdb.gdb/python-selftest.exp
@@ -0,0 +1,34 @@
+# Copyright 2013 Free Software Foundation, Inc.
+
+# 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 3 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, see <http://www.gnu.org/licenses/>.
+
+# This file was written by Andrew Cagney (cagney at redhat dot com),
+# derived from xfullpath.exp (written by Joel Brobecker), derived from
+# selftest.exp (written by Rob Savoye).
+
+load_lib selftest-support.exp
+load_lib gdb-python.exp
+
+proc selftest_python {} {
+    if {[skip_python_tests]} {
+	return -1
+    }
+
+    gdb_test_no_output "set variable gdb_python_initialized = 0"
+    gdb_test "call catch_command_errors(execute_command, \"python print 5\", 0, RETURN_MASK_ALL)" \
+	"Python not initialized.* = 0"
+    return 0
+}
+
+do_self_tests captured_command_loop selftest_python
-- 
1.8.1.4