* config/vr4300.exp: New file.

	* gdb.*/*.exp: Call gdb_expect instead of expect.

	* lib/gdb.exp(gdb_expect): New function.

1 files changed, 153 insertions, 51 deletions

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 8ca0735..2e33b70 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -97,7 +97,7 @@ proc gdb_unload {} {
     global GDB
     global gdb_prompt
     send_gdb "file\n"
-    expect {
+    gdb_expect {
 	-re "No exec file now.*\r" { exp_continue }
 	-re "No symbol file now.*\r" { exp_continue }
 	-re "A program is being debugged already..*Kill it.*y or n. $"\
@@ -128,24 +128,24 @@ proc delete_breakpoints {} {
     global gdb_spawn_id
 
     send_gdb "delete breakpoints\n"
-    expect {
-	-i $gdb_spawn_id -re ".*Delete all breakpoints.*y or n.*$" {
+    gdb_expect {
+	 -re ".*Delete all breakpoints.*y or n.*$" {
 	    send_gdb "y\n";
 	    exp_continue
 	}
-	-i $gdb_spawn_id -re ".*$gdb_prompt $" { # This happens if there were no breakpoints
+	 -re ".*$gdb_prompt $" { # This happens if there were no breakpoints
 	    }
-	-i $gdb_spawn_id timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
+	 timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
     }
     send_gdb "info breakpoints\n"
-    expect {
-	-i $gdb_spawn_id -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
-	-i $gdb_spawn_id -re ".*$gdb_prompt $" { perror "breakpoints not deleted" ; return }
-	-i $gdb_spawn_id -re "Delete all breakpoints.*or n.*$" {
+    gdb_expect {
+	 -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
+	 -re ".*$gdb_prompt $" { perror "breakpoints not deleted" ; return }
+	 -re "Delete all breakpoints.*or n.*$" {
 	    send_gdb "y\n";
 	    exp_continue
 	}
-	-i $gdb_spawn_id timeout { perror "info breakpoints (timeout)" ; return }
+	 timeout { perror "info breakpoints (timeout)" ; return }
     }
 }
 
@@ -170,7 +170,7 @@ proc gdb_run_cmd {args} {
 	    set start "start";
 	}
 	send_gdb  "jump *$start\n"
-	expect {
+	gdb_expect {
 	    -re "Continuing at \[^\r\n\]*\[\r\n\]" {
 		if ![target_info exists gdb_stub] {
 		    return;
@@ -195,7 +195,7 @@ proc gdb_run_cmd {args} {
 	    timeout { perror "Jump to start() failed (timeout)"; return }
 	}
 	if [target_info exists gdb_stub] {
-	    expect {
+	    gdb_expect {
 		-re ".*$gdb_prompt $" {
 		    send_gdb "continue\n"
 		}
@@ -205,7 +205,7 @@ proc gdb_run_cmd {args} {
     }
     send_gdb "run $args\n"
 # This doesn't work quite right yet.
-    expect {
+    gdb_expect {
 	-re "The program .* has been started already.*y or n. $" {
 	    send_gdb "y\n"
 	    exp_continue
@@ -223,7 +223,7 @@ proc gdb_breakpoint { function } {
 
     send_gdb "break $function\n"
     # The first two regexps are what we get with -g, the third is without -g.
-    expect {
+    gdb_expect {
 	-re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 	-re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 	-re "Breakpoint \[0-9\]* at .*$gdb_prompt $" {}
@@ -256,7 +256,7 @@ proc runto { function } {
     
     # the "at foo.c:36" output we get with -g.
     # the "in func" output we get without -g.
-    expect {
+    gdb_expect {
 	-re "Break.* at .*:$decimal.*$gdb_prompt $" {
 	    return 1
 	}
@@ -293,7 +293,7 @@ proc runto_main {} {
 
     send_gdb "step\n"
     # if use stubs step out of the breakpoint() function.
-    expect {
+    gdb_expect {
 	-re "main.* at .*$gdb_prompt $" {}
 	-re "_start.*$gdb_prompt $" {}
 	timeout { fail "single step at breakpoint() (timeout)" ; return 0 }
@@ -354,8 +354,8 @@ proc gdb_test { args } {
 	}
     }
 
-    expect {
-	-i $gdb_spawn_id -re ".*Ending remote debugging.*$gdb_prompt$" {
+    gdb_expect {
+	 -re ".*Ending remote debugging.*$gdb_prompt$" {
 	    if ![isnative] then {
 		warning "Can`t communicate to remote target."
 	    }
@@ -363,25 +363,25 @@ proc gdb_test { args } {
 	    gdb_start
 	    set result -1
 	}
-	-i $gdb_spawn_id -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
+	 -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
 	    if ![string match "" $message] then {
 		pass "$message"
 	    }
 	    set result 0
 	}
-	-i $gdb_spawn_id -re "(${question_string})$" {
+	 -re "(${question_string})$" {
 	    send_gdb "$response_string\n";
 	    exp_continue;
 	}
-	-i $gdb_spawn_id -re "Undefined command:.*$gdb_prompt" {
+	 -re "Undefined command:.*$gdb_prompt" {
 	    perror "Undefined command \"$command\"."
 	    set result 1
 	}
-	-i $gdb_spawn_id -re "Ambiguous command.*$gdb_prompt $" {
+	 -re "Ambiguous command.*$gdb_prompt $" {
 	    perror "\"$command\" is not a unique command name."
 	    set result 1
 	}
-	-i $gdb_spawn_id -re ".*Program exited with code \[0-9\]+.*$gdb_prompt $" {
+	 -re ".*Program exited with code \[0-9\]+.*$gdb_prompt $" {
 	    if ![string match "" $message] then {
 		set errmsg "$message: the program exited"
 	    } else {
@@ -390,7 +390,7 @@ proc gdb_test { args } {
 	    fail "$errmsg"
 	    return -1
 	}
-	-i $gdb_spawn_id -re "The program is not being run.*$gdb_prompt $" {
+	 -re "The program is not being run.*$gdb_prompt $" {
 	    if ![string match "" $message] then {
 		set errmsg "$message: the program is no longer running"
 	    } else {
@@ -399,30 +399,33 @@ proc gdb_test { args } {
 	    fail "$errmsg"
 	    return -1
 	}
-	-i $gdb_spawn_id -re ".*$gdb_prompt $" {
+	 -re ".*$gdb_prompt $" {
 	    if ![string match "" $message] then {
 		fail "$message"
 	    }
 	    set result 1
 	}
-	-i $gdb_spawn_id "<return>" {
+	 "<return>" {
 	    send_gdb "\n"
 	    perror "Window too small."
 	}
-	-i $gdb_spawn_id -re "\\(y or n\\) " {
+	 -re "\\(y or n\\) " {
 	    send_gdb "n\n"
 	    perror "Got interactive prompt."
 	}
-	-i $gdb_spawn_id eof {
-	    perror "Process no longer exists"
-	    return -1
+	 eof {
+	     perror "Process no longer exists"
+	     if { $message != "" } {
+		 fail "$message"
+	     }
+	     return -1
 	}
-	-i $gdb_spawn_id full_buffer {
+	 full_buffer {
 	    perror "internal buffer is full."
 	}
 	timeout	{
 	    if ![string match "" $message] then {
-		fail "(timeout) $message"
+		fail "$message (timeout)"
 	    }
 	    set result 1
 	}
@@ -451,7 +454,7 @@ proc test_print_reject { args } {
 	send_user "Looking to match \"$expectthis\"\n"
     }
     send_gdb "$sendthis\n"
-    expect {
+    gdb_expect {
 	-re ".*A .* in expression.*\\.*$gdb_prompt $" {
 	    pass "reject $sendthis"
 	    return 1
@@ -527,7 +530,7 @@ proc gdb_test_exact { args } {
 
     # It is most natural to write the pattern argument with only
     # embedded \n's, especially if you are trying to avoid Tcl quoting
-    # problems.  But expect really wants to see \r\n in patterns.  So
+    # problems.  But gdb_expect really wants to see \r\n in patterns.  So
     # transform the pattern here.  First transform \r\n back to \n, in
     # case some users of gdb_test_exact already do the right thing.
     regsub -all "\r\n" $pattern "\n" pattern
@@ -550,13 +553,13 @@ proc gdb_reinitialize_dir { subdir } {
 	return "";
     }
     send_gdb "dir\n"
-    expect {
+    gdb_expect {
 	-re "Reinitialize source path to empty.*y or n. " {
 	    send_gdb "y\n"
-	    expect {
+	    gdb_expect {
 		-re "Source directories searched.*$gdb_prompt $" {
 		    send_gdb "dir $subdir\n"
-		    expect {
+		    gdb_expect {
 			-re "Source directories searched.*$gdb_prompt $" {
 			    verbose "Dir set to $subdir"
 			}
@@ -597,21 +600,21 @@ proc default_gdb_exit {} {
 
     if [is_remote host] {
 	send_gdb "quit\n";
-	expect {
-	    -i $gdb_spawn_id -re ".*and kill it.*y or n. " {
+	gdb_expect {
+	     -re ".*and kill it.*y or n. " {
 		send_gdb "y\n";
 		exp_continue;
 	    }
-	    -i $gdb_spawn_id 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 -i $gdb_spawn_id"
+	catch "close "
 
 	# Omitting this probably would cause strange timing-dependent failures.
-	catch "wait -i $gdb_spawn_id"
+	catch "wait "
     }
 
     remote_close host;
@@ -641,7 +644,7 @@ proc gdb_file_cmd { arg } {
     }
 
     send_gdb "file $arg\n"
-    expect {
+    gdb_expect {
         -re "Reading symbols from.*done.*$gdb_prompt $" {
             verbose "\t\tLoaded $arg into the $GDB"
             return 0
@@ -657,7 +660,7 @@ proc gdb_file_cmd { arg } {
         }
         -re "Load new symbol table from \".*\".*y or n. $" {
             send_gdb "y\n"
-            expect {
+            gdb_expect {
                 -re "Reading symbols from.*done.*$gdb_prompt $" {
                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
                     return 0
@@ -683,7 +686,7 @@ proc gdb_file_cmd { arg } {
         eof {
             # This is an attempt to detect a core dump, but seems not to
             # work.  Perhaps we need to match .* followed by eof, in which
-            # expect does not seem to have a way to do that.
+            # gdb_expect does not seem to have a way to do that.
             perror "couldn't load $arg into $GDB (end of file)."
             return -1
         }
@@ -747,22 +750,23 @@ proc default_gdb_start { } {
     set gdb_spawn_id $shell_id
     set spawn_id $gdb_spawn_id
     # force the height to "unlimited", so no pagers get used
+
     send_gdb "set height 0\n"
-    expect {
-	-i $shell_id -re ".*$gdb_prompt $" { 
+    gdb_expect {
+	-re ".*$gdb_prompt $" { 
 	    verbose "Setting height to 0." 2
 	}
-	-i $shell_id timeout {
+	timeout {
 	    warning "Couldn't set the height to 0"
 	}
     }
     # force the width to "unlimited", so no wraparound occurs
     send_gdb "set width 0\n"
-    expect {
-	-i $shell_id -re ".*$gdb_prompt $" {
+    gdb_expect {
+	-re ".*$gdb_prompt $" {
 	    verbose "Setting width to 0." 2
 	}
-	-i $shell_id timeout {
+	timeout {
 	    warning "Couldn't set the width to 0."
 	}
     }
@@ -839,6 +843,104 @@ proc send_gdb { string } {
     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;
+	}
+    }
+
+    if {$code == 1} {
+	return -code error -errorinfo $errorInfo -errorcode $errorCode $string
+    } elseif {$code == 2} {
+	return -code return $string
+    } elseif {$code == 3} {
+	return
+    } elseif {$code > 4} {
+	return -code $code $string
+    }
+}
+
 proc gdb_start { } {
     default_gdb_start
 }