From: Bob Manson <manson@cygnus>
Date: Thu, 6 Mar 1997 01:51:44 +0000 (+0000)
Subject: 	* lib/gdb.exp(gdb_run_cmd): Add check for gdb_init_command
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ae7872effe77efb483185aeb4753e3094981baa4;p=binutils-gdb.git

	* 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 55698d41cef..15a1d8faed1 100644
--- 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 4e0920f7227..82bbc77ed74 100644
--- 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 } {
 
 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