* lib/gdb.exp(gdb_run_cmd): Add check for gdb_init_command

	target feature.

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 55698d41cef366f644318777472c18c65444ae1f..15a1d8faed104411a9cd058c64cff4a3ec89ff9a 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+Wed Mar  5 00:00:43 1997  Bob Manson  <manson@charmed.cygnus.com>
+
+       * lib/gdb.exp(gdb_run_cmd): Add check for gdb_init_command
+       target feature.
+
+       * config/monitor.exp(gdb_load): Check for a failure when loading,
+       and reboot the board if necessary.
+
+       * gdb.base/setvar.exp(test_set): Handle multiple prints within
+       a set of tests. Remove print.* from the patterns being checked.
+
 Mon Mar  3 11:57:43 1997  Bob Manson  <manson@charmed.cygnus.com>
 
        * gdb.base/a1-selftest.exp: Use send_gdb consistently. Don't

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 4e0920f7227796f5ab529e72478dd4a28274e99c..82bbc77ed74781f1860f0f57751b85cf30e420af 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -125,7 +125,6 @@ proc gdb_unload {} {
 
 proc delete_breakpoints {} {
     global gdb_prompt
-    global gdb_spawn_id
 
     send_gdb "delete breakpoints\n"
     gdb_expect {
@@ -159,9 +158,17 @@ proc delete_breakpoints {} {
 #
 proc gdb_run_cmd {args} {
     global gdb_prompt
-    global gdb_spawn_id
 
-    set spawn_id $gdb_spawn_id
+    if [target_info exists gdb_init_command] {
+       send_gdb "[target_info gdb_init_command]\n";
+       gdb_expect {
+           -re ".*$gdb_prompt $" { }
+           default {
+               perror "gdb_init_command for target failed";
+               return;
+           }
+       }
+    }
 
     if [target_info exists use_gdb_stub] {
        if [target_info exists gdb,start_symbol] {
@@ -210,16 +217,13 @@ proc gdb_run_cmd {args} {
            send_gdb "y\n"
            exp_continue
        }
-       -re "Starting program: \[^\n\]*" {}
+       -re "Starting program: \[^\r\n\]*" {}
     }
 }
 
 proc gdb_breakpoint { function } {
     global gdb_prompt
     global decimal
-    global gdb_spawn_id
-
-    set spawn_id $gdb_spawn_id
 
     send_gdb "break $function\n"
     # The first two regexps are what we get with -g, the third is without -g.
@@ -242,9 +246,6 @@ proc gdb_breakpoint { function } {
 proc runto { function } {
     global gdb_prompt
     global decimal
-    global gdb_spawn_id
-
-    set spawn_id $gdb_spawn_id
 
     delete_breakpoints
 
@@ -323,7 +324,6 @@ proc gdb_test { args } {
     global GDB
     global expect_out
     upvar timeout timeout
-    global gdb_spawn_id;
 
     if [llength $args]>2 then {
        set message [lindex $args 2]
@@ -349,7 +349,11 @@ proc gdb_test { args } {
     set result -1
     if ![string match $command ""] {
        if { [send_gdb "$command\n"] != "" } {
-           perror "Couldn't send $command to GDB.";
+           global suppress_flag;
+
+           if { ! $suppress_flag } {
+               perror "Couldn't send $command to GDB.";
+           }
            fail "$message";
            return $result;
        }
@@ -547,8 +551,6 @@ proc gdb_test_exact { args } {
 \f
 proc gdb_reinitialize_dir { subdir } {
     global gdb_prompt
-    global gdb_spawn_id
-    set spawn_id $gdb_spawn_id
 
     if [is_remote host] {
        return "";
@@ -587,7 +589,9 @@ proc default_gdb_exit {} {
     global GDB
     global GDBFLAGS
     global verbose
-    global gdb_spawn_id
+    global gdb_spawn_id;
+
+    gdb_stop_suppressing_tests;
 
     if ![info exists gdb_spawn_id] {
        return;
@@ -606,16 +610,8 @@ proc default_gdb_exit {} {
                send_gdb "y\n";
                exp_continue;
            }
-            timeout { }
+           timeout { }
        }
-    } else {
-       # We used to try to send_gdb "quit" to GDB, and wait for it to die.
-       # Dealing with all the cases and errors got pretty hairy.  Just close it, 
-       # that is simpler.
-       catch "close "
-
-       # Omitting this probably would cause strange timing-dependent failures.
-       catch "wait "
     }
 
     remote_close host;
@@ -633,8 +629,6 @@ proc gdb_file_cmd { arg } {
     global GDB
     global gdb_prompt
     upvar timeout timeout
-    global gdb_spawn_id
-    set spawn_id $gdb_spawn_id
 
     if [is_remote host] {
        set arg [remote_download host $arg];
@@ -707,49 +701,52 @@ proc default_gdb_start { } {
     global GDBFLAGS
     global gdb_prompt
     global timeout
-    global gdb_spawn_id
-    global spawn_id
+    global gdb_spawn_id;
+
+    gdb_stop_suppressing_tests;
+
     verbose "Spawning $GDB -nw $GDBFLAGS"
 
     if [info exists gdb_spawn_id] {
+       foo;
        return 0;
     }
 
     set oldtimeout $timeout
     set timeout [expr "$timeout + 180"]
     if [is_remote host] {
-       set shell_id [remote_spawn host "$GDB -nw $GDBFLAGS --command gdbinit"]
+       set res [remote_spawn host "$GDB -nw $GDBFLAGS --command gdbinit"];
     } else {
        if { [which $GDB] == 0 } then {
            perror "$GDB does not exist."
            exit 1
        }
 
-       set shell_id [remote_spawn host "$GDB -nw $GDBFLAGS"]
+       set res [remote_spawn host "$GDB -nw $GDBFLAGS"];
+    }
+    if { $res < 0 || $res == "" } {
+       bar
     }
-    verbose $shell_id
     set timeout 10
-    expect {
-       -i $shell_id -re ".*\[\r\n\]$gdb_prompt $" {
+    gdb_expect {
+       -re ".*\[\r\n\]$gdb_prompt $" {
            verbose "GDB initialized."
        }
-       -i $shell_id -re "$gdb_prompt $"        {
+       -re "$gdb_prompt $"     {
            perror "GDB never initialized."
            set timeout $oldtimeout
            verbose "Timeout restored to $timeout seconds" 2
            return -1
        }
-       -i $shell_id timeout            {
+       timeout {
+
            perror "(timeout) GDB never initialized after $timeout seconds."
-           set timeout $oldtimeout
-           verbose "Timeout restored to $timeout seconds" 2
            return -1
        }
     }
     set timeout $oldtimeout
     verbose "Timeout restored to $timeout seconds" 2
-    set gdb_spawn_id $shell_id
-    set spawn_id $gdb_spawn_id
+    set gdb_spawn_id -1;
     # force the height to "unlimited", so no pagers get used
 
     send_gdb "set height 0\n"
@@ -841,95 +838,18 @@ proc gdb_compile {source dest type options} {
 }
 
 proc send_gdb { string } {
+    global suppress_flag;
+    if { $suppress_flag } {
+       return "suppressed";
+    }
     return [remote_send host "$string"];
 }
 
 #
-# Basically the same as TCL expect, but with a big difference: it will
-# call the eof/timeout/default section if there is an error in the
-# expect call.
-# Also adds a -i $gdb_spawn_id to each expect statement.
 #
 
 proc gdb_expect { args } {
-    global gdb_spawn_id;
-    global errorInfo errorCode;
-
-    if { [llength $args] == 1 } {
-       set args "[lindex $args 0]";
-    }
-
-    set res {}
-    set got_re 0;
-    set need_append 1;
-    
-    set orig "$args";
-
-    set error_sect "";
-    set save_next 0;
-
-    for { set i 0; } { $i < [llength $args] } { incr i ; }  {
-       if { $need_append } {
-           append res "\n-i $gdb_spawn_id ";
-           set need_append 0;
-       }
-
-       set x "[lrange $args $i $i]";
-       regsub "^\n*\[  \]*" "$x" "" x;
-
-       if { $x == "-i" || $x == "-timeout" || $x == "-ex" } {
-           append res "$x ";
-           set next [expr ${i}+1];
-           append res "[lrange $args $next $next]";
-           incr i;
-           continue;
-       }
-       if { $x == "-n" || $x == "-notransfer" || $x == "-nocase" || $x == "-indices" } {
-           append res "${x} ";
-           continue;
-       }
-       if { $x == "-re" } {
-           append res "${x} ";
-           set next [expr ${i}+1];
-           set y [lrange $args $next $next];
-           append res "${y} ";
-           set got_re 1;
-           incr i;
-           continue;
-       }
-       if { $got_re } {
-           set need_append 1;
-           append res "$x ";
-           set got_re 0;
-           if { $save_next } {
-               set save_next 0;
-               set error_sect [lindex $args $i];
-           }
-       } else {
-           if { ${x} == "eof" } {
-               set save_next 1;
-           } elseif { ${x} == "default" || ${x} == "timeout" } {
-               if { $error_sect == "" } {
-                   set save_next 1;
-               }
-           }
-           append res "${x} ";
-           set got_re 1;
-       }
-    }
-
-    set body "expect [list $res]";
-
-    set code [catch {uplevel $body} string];
-
-    if {$code == 1} {
-       if { $error_sect != "" } {
-           set code [catch {uplevel $error_sect} string];
-       } else {
-           perror "uh, gdb_expect statement without a default case?!";
-           return;
-       }
-    }
+    set code [catch {uplevel remote_expect host $args} string];
 
     if {$code == 1} {
        return -code error -errorinfo $errorInfo -errorcode $errorCode $string
@@ -942,6 +862,26 @@ proc gdb_expect { args } {
     }
 }
 
+#
+# Set suppress_flag, which will cause all subsequent calls to send_gdb and
+# gdb_expect to fail immediately (until the next call to 
+# gdb_stop_suppressing_tests).
+#
+proc gdb_suppress_tests { } {
+    global suppress_flag;
+
+    incr suppress_flag;
+}
+
+#
+# Clear suppress_flag.
+#
+proc gdb_stop_suppressing_tests { } {
+    global suppress_flag;
+
+    set suppress_flag 0;
+}
+
 proc gdb_start { } {
     default_gdb_start
 }
@@ -965,6 +905,12 @@ proc gdb_continue { function } {
 }
 
 proc gdb_init { args } {
+    gdb_stop_suppressing_tests;
+
+    # Uh, this is lame. Really, really, really lame. But there's this *one*
+    # testcase that will fail in random places if we don't increase this.
+    match_max -d 20000
+
     if { [llength $args] > 0 } {
        global pf_prefix