GDB 7.6.50

gdb/testsuite/lib/selftest-support.exp

Index: gdb/testsuite/lib/selftest-support.exp
diff --git a/gdb/testsuite/gdb.gdb/xfullpath.exp b/gdb/testsuite/lib/selftest-support.exp
similarity index 54%
copy from gdb/testsuite/gdb.gdb/xfullpath.exp
copy to gdb/testsuite/lib/selftest-support.exp
index 0ebf824687b8903e1aa5d23bc7a88b3d9aea2172..98a83aa88622f9c050863f2d0651c30abc5f1717 100644
--- a/gdb/testsuite/gdb.gdb/xfullpath.exp
+++ b/gdb/testsuite/lib/selftest-support.exp
@@ -1,4 +1,4 @@
-# Copyright 2002-2004, 2007-2012 Free Software Foundation, Inc.
+# 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
@@ -13,18 +13,38 @@
 # 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 Joel Brobecker. (brobecker@gnat.com), derived
-# from selftest.exp, written by Rob Savoye.
+# 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
+    }
 
-# are we on a target board
-if { [is_remote target] || ![isnative] } then {
-    return
+    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
 }
 
-proc setup_test { executable } {
+# 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
@@ -57,21 +77,21 @@ proc setup_test { executable } {
     }
 
     # Set a breakpoint at main
-    gdb_test "break captured_main" \
+    gdb_test "break $function" \
             "Breakpoint.*at.* file.*, line.*" \
-            "breakpoint in captured_main"
+            "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 captured_main"
-    gdb_test_multiple "run -nw" "$description" {
-        -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" {
+    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\]+,.*captured_main .data.*$gdb_prompt $" {
+        -re "Starting program.*Breakpoint \[0-9\]+,.*$function .data.*$gdb_prompt $" {
             xfail "$description (line numbers scrambled?)"
         }
         -re "vfork: No more processes.*$gdb_prompt $" {
@@ -94,90 +114,42 @@ proc setup_test { executable } {
     return 0
 }
 
-proc test_with_self { executable } {
-
-    set setup_result [setup_test $executable]
-    if {$setup_result <0} then {
-        return -1
-    }
-
-    # A file which contains a directory prefix
-    gdb_test "print xfullpath (\"./xfullpath.exp\")" \
-             ".\[0-9\]+ =.*\".*/xfullpath.exp\"" \
-             "A filename with ./ as the directory prefix"
-
-    # A file which contains a directory prefix
-    gdb_test "print xfullpath (\"../../defs.h\")" \
-             ".\[0-9\]+ =.*\".*/defs.h\"" \
-             "A filename with ../ in the directory prefix"
-
-    # A one-character filename
-    gdb_test "print xfullpath (\"./a\")" \
-             ".\[0-9\]+ =.*\".*/a\"" \
-             "A one-char filename in the current directory"
-          
-    # A file in the root directory
-    gdb_test "print xfullpath (\"/root_file_which_should_exist\")" \
-             ".\[0-9\]+ =.*\"/root_file_which_should_exist\"" \
-             "A filename in the root directory"
-          
-    # A file which does not have a directory prefix
-    gdb_test "print xfullpath (\"xfullpath.exp\")" \
-             ".\[0-9\]+ =.*\"xfullpath.exp\"" \
-             "A filename without any directory prefix"
-
-    # A one-char filename without any directory prefix
-    gdb_test "print xfullpath (\"a\")" \
-             ".\[0-9\]+ =.*\"a\"" \
-             "A one-char filename without any directory prefix"
-
-    # An empty filename
-    gdb_test "print xfullpath (\"\")" \
-             ".\[0-9\]+ =.*\"\"" \
-             "An empty filename"
-
-    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 } {
+# A simple way to run some self-tests.
 
-    # If the arg directly specifies an existing executable file, then
-    # simply use it.
+proc do_self_tests {function body} {
+    global GDB tool
 
-    if [file executable $arg] then {
-	return $arg
+    # Are we on a target board.
+    if { [is_remote target] || ![isnative] } then {
+	return
     }
 
-    set result [which $arg]
-    if [string match "/" [ string range $result 0 0 ]] then {
-	return $result
-    }
+    # Run the test with self.  Copy the file executable file in case
+    # this OS doesn't like to edit its own text space.
 
-    # If everything fails, just return the unqualified pathname as default
-    # and hope for best.
+    set GDB_FULLPATH [find_gdb $GDB]
 
-    return $arg
-}
+    if {[is_remote host]} {
+	set xgdb x$tool
+    } else {
+	set xgdb [standard_output_file x$tool]
+    }
 
-# Run the test with self.
-# Copy the file executable file in case this OS doesn't like to edit its own
-# text space.
+    # Remove any old copy lying around.
+    remote_file host delete $xgdb
 
-set GDB_FULLPATH [find_gdb $GDB]
+    gdb_start
+    set file [remote_download host $GDB_FULLPATH $xgdb]
 
-# Remove any old copy lying around.
-remote_file host delete x$tool
+    set result [selftest_setup $file $function]
+    if {$result == 0} then {
+	set result [uplevel $body]
+    }
 
-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";
+    gdb_exit
+    catch "remote_file host delete $file"
 
-if {$result <0} then {
-    warning "Couldn't test self"
-    return -1
+    if {$result < 0} then {
+	warning "Couldn't test self"
+    }
 }