* config/mips-gdb.exp, config/udi-gdb.exp, config/vx-gdb.exp,

lib/gdb.exp: Replace error proc calls with perror.

gdb/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+Tue May 17 15:04:14 1994  Bill Cox  (bill@rtl.cygnus.com)
+
+	* config/mips-gdb.exp, config/udi-gdb.exp, config/vx-gdb.exp,
+          lib/gdb.exp: Replace error proc calls with perror.
+
 Mon May 16 19:00:50 1994  Stan Shebs  (shebs@andros.cygnus.com)
 
 	* gdb.t00/teststrategy.exp: Reorder so that AIX gdb can print the

gdb/testsuite/config/mips-gdb.exp

@@ -72,8 +72,8 @@ proc gdb_load { arg } {
 	    exp_continue
 	}
 	-re "Reading symbols from.*done..*$prompt $" { }
-	-re "$prompt $" { error "GDB couldn't read file" }
+	-re "$prompt $" { perror "GDB couldn't read file" }
-	timeout { error "(timeout) read symbol file" ; return }
+	timeout { perror "(timeout) read symbol file" ; return }
     }
     send "load $arg\n"
     if $verbose>1 then {
@@ -90,12 +90,12 @@ proc gdb_load { arg } {
 	}
 	-re "$prompt $"     {
 	    if $verbose>1 then {
-		error "GDB couldn't load."
+	 perror "GDB couldn't load."
 	    }
 	}
 	timeout {
 	    if $verbose>1 then {
-		error "Timed out trying to load $arg."
+	 perror "Timed out trying to load $arg."
 	    }
 	}
     }
@@ -138,7 +138,7 @@ proc gdb_start { } {
 		expect {
 		    -i $shell_id -re "<IDT>$" { }
 		    timeout {
-			error "(timeout) board did not come up."; return -1
+		 perror "(timeout) board did not come up."; return -1
 		    }
 		}
 	    }
@@ -146,7 +146,7 @@ proc gdb_start { } {
 	send -i $shell_id "go 0xbfc00000\n"
 	expect {
 	    -i $shell_id -re "<IDT>$" { }
-	    timeout     { error "(timeout) board did not come up."; return -1 }
+	    timeout     { perror "(timeout) board did not come up."; return -1 }
 	}
 	verbose "about to exit kermit"
 	exit_remote_shell $shell_id
@@ -165,8 +165,8 @@ proc gdb_start { } {
 		send_user "$GDB initialized for cross mode\n\n"
 	    }
 	}
-	-re "$prompt $"     { error "GDB never initialized."; return -1 }
+	-re "$prompt $"     { perror "GDB never initialized."; return -1 }
-	timeout             { error "(timeout) GDB never initialized.";
+	timeout             { perror "(timeout) GDB never initialized.";
 			      return -1 }
     }
 
@@ -194,7 +194,7 @@ proc gdb_start { } {
 	    }
 	}
 	timeout { 
-	    error "Couldn't set MIPS target."
+	    perror "Couldn't set MIPS target."
 	    set timeout 10
 	    return -1
 	}
@@ -203,13 +203,13 @@ proc gdb_start { } {
 }
 
 expect_after {
-    "<return>"		   { send "\n"; error "Window too small." }
+    "<return>"		   { send "\n"; perror "Window too small." }
-    -re "\(y or n\) " 	   { send "n\n"; error "Got interactive prompt." }
+    -re "\(y or n\) " 	   { send "n\n"; perror "Got interactive prompt." }
-    buffer_full		   { error "internal buffer is full." }
+    buffer_full		   { perror "internal buffer is full." }
-    eof			   { error "eof -- pty is hosed." }
+    eof			   { perror "eof -- pty is hosed." }
-    timeout			   { error "timeout." }
+    timeout			   { perror "timeout." }
-    "virtual memory exhausted" { error "virtual memory exhausted." }
+    "virtual memory exhausted" { perror "virtual memory exhausted." }
-    "Undefined command"	   { error "send string probably wrong." }
+    "Undefined command"	   { perror "send string probably wrong." }
 }
 
 proc gdb_exit { } {

gdb/testsuite/config/udi-gdb.exp

@@ -65,14 +65,14 @@ proc gdb_target_udi { } {
 	    warning "$expect_out(buffer)"
 	}
 	-re "TIP-ipc ERROR,.*failed:" {
-	    error "$expect_out(buffer)"
+	    perror "$expect_out(buffer)"
 	}
 	-re "A program is being debugged already.  Kill it\? \(y or n\)" {
 	    send "y\n"
 	    exp_continue
 	}
 	timeout { 
-	    error "Couldn't set target for UDI."
+	    perror "Couldn't set target for UDI."
 	    cleanup
 	    exit $exit_status
 	}
@@ -119,11 +119,11 @@ proc gdb_start { } {
 	    verbose "$GDB initialized for cross mode\n"
 	}
 	-re "$prompt $" {
-	    error "GDB never initialized."
+	    perror "GDB never initialized."
 	    return -1
 	}
 	timeout {
-	    error "(timeout) GDB never initialized."    
+	    perror "(timeout) GDB never initialized."    
 	    return -1
 	}
     }

gdb/testsuite/config/vx-gdb.exp

@@ -54,7 +54,7 @@ proc gdb_load { arg } {
     set result 0
 
     if [vxworks_ld $shell_id $arg]<0 then {
-	error "Couldn't load $arg"
+ perror "Couldn't load $arg"
 	return -1
     }
 
@@ -78,7 +78,7 @@ proc gdb_start { } {
     # get a connection to the board
     set shell_id [ eval $connectmode "$targetname" ]
     if $shell_id<0 then {
-	error "Couldn't connect to $targetname."
+ perror "Couldn't connect to $targetname."
 	return -1
     }
     verbose "Spawn id for remote shell is $shell_id"
@@ -94,11 +94,11 @@ proc gdb_start { } {
 		verbose "\nVxWorks has closed the shell"
 		}
 	    -i $shell_id eof {
-		error "(eof) never disconnected from VxWorks shell."
+	 perror "(eof) never disconnected from VxWorks shell."
 		return -1
 	    }
 	    -i $shell_id timeout {
-		error "(timeout) never disconnected from VxWorks shell."
+	 perror "(timeout) never disconnected from VxWorks shell."
 		return -1
 	    }
 	}
@@ -123,14 +123,14 @@ proc spawn_vxgdb { } {
 	if {[which $GDB] != 0} then {
 	    spawn $GDB $GDBFLAGS
 	} else {
-            error "$GDB does not exist."
+            perror "$GDB does not exist."
             exit 1
         }
     } else {
         if {[which $GDB] != 0} then {
 	    spawn $GDB
         } else {
-            error "$GDB does not exist."
+            perror "$GDB does not exist."
             exit 1
         }
     }
@@ -139,11 +139,11 @@ proc spawn_vxgdb { } {
 	    verbose "$GDB initialized for cross mode to Vxworks\n"
 	}
 	-re "$prompt $" {
-	    error "GDB never initialized."
+	    perror "GDB never initialized."
 	    return -1
 	}
 	timeout {
-	    error "(timeout) GDB never initialized."
+	    perror "(timeout) GDB never initialized."
 	    return -1
 	}
     }
@@ -168,11 +168,11 @@ proc spawn_vxgdb { } {
 	    verbose "Set target to $targetname" 1
 	}
 	-re "net_connect: RPC: Program not registered.*$" {
-	    error "Couldn't set GDB to target $targetname."
+	    perror "Couldn't set GDB to target $targetname."
 	    exit 1
 	}
 	timeout { 
-	    error "Couldn't set target for vxworks."
+	    perror "Couldn't set target for vxworks."
 	    set timeout 10
 	    return -1
 	}
@@ -189,13 +189,13 @@ proc gdb_exit { } {
 }
 
 #expect_after {
-#    "<return>"		   { send "\n"; error "Window too small." }
+#    "<return>"		   { send "\n"; perror "Window too small." }
-#    -re "\(y or n\) " 	   { send "n\n"; error "Got interactive prompt." }
+#    -re "\(y or n\) " 	   { send "n\n"; perror "Got interactive prompt." }
-#    buffer_full		   { error "internal buffer is full." }
+#    buffer_full		   { perror "internal buffer is full." }
-#    eof			   { error "eof -- pty is hosed." }
+#    eof			   { perror "eof -- pty is hosed." }
-#    timeout			   { error "timeout." }
+#    timeout			   { perror "timeout." }
-#    "virtual memory exhausted" { error "virtual memory exhausted." }
+#    "virtual memory exhausted" { perror "virtual memory exhausted." }
-#    "Undefined command"	   { error "send string probably wrong." }
+#    "Undefined command"	   { perror "send string probably wrong." }
 #}
 
 gdb_start

gdb/testsuite/lib/gdb.exp

@@ -33,6 +33,12 @@ if ![info exists GDBFLAGS] then {
     set GDBFLAGS ""
 }
 
+# set the prompt if it doesn't exist
+global prompt
+if ![info exists prompt] then {
+    set prompt "\[(\]gdb\[)\]"
+}
+
 #
 # gdb_version -- extract and print the version number of gcc
 #
@@ -94,13 +100,13 @@ proc delete_breakpoints {} {
 	}
 	-re "y\r\n$prompt $" {}
 	-re ".*$prompt $" { perror "Delete all breakpoints" ; return }
-	timeout { error "Delete all breakpoints (timeout)" ; return }
+	timeout { perror "Delete all breakpoints (timeout)" ; return }
     }
     send "info breakpoints\n"
     expect {
 	-re "No breakpoints or watchpoints..*$prompt $" {}
 	-re ".*$prompt $" { perror "breakpoints not deleted" ; return }
-	timeout { error "info breakpoints (timeout)" ; return }
+	timeout { perror "info breakpoints (timeout)" ; return }
     }
 }
 
@@ -295,32 +301,12 @@ proc default_gdb_exit {} {
     # This used to be 1 for unix-gdb.exp
     set timeout 5
 
-    catch "send \"quit\n\"" result
+    # We used to try to send "quit" to GDB, and wait for it to die.
-    # If the process has gone away (e.g. gdb dumped core), deal with it.
+    # Dealing with all the cases and errors got pretty hairy.  Just close it, 
-    if [string match "write\[(\]+spawn_id=\[0-9)\]+:" $result] then {
+    # that is simpler.
-	catch "close"
+    close
-	# FIXME:  Shouldn't we call "wait" too?
-	return -1
-    }
-    # FIXME: What is this catch statement doing here?  Won't it prevent us
-    # from getting errors that we'd rather see?
-	expect {
-	    eof { 
-		verbose "Got EOF from $GDB" 2
-	    }
-	    timeout { 
-		verbose "Got TIMEOUT from $GDB" 2
-	    }
-	    -re "The program is running.  Quit anyway.*y or n. $" {
-		send "y\n"
-		verbose "Killing program being debugged" 2
-	    }
-    }
 
-    # Before this was here sometimes "uit" would get sent to the next GDB
+    # Omitting this probably would cause strange timing-dependent failures.
-    # (assuming this is immediately followed by gdb_start), which would
-    # cause a loss of syncronization (i.e. all the stuff that swallows a
-    # prompt would swallow the wrong one).
     wait
 }
 
@@ -381,7 +367,7 @@ oaded."
             # 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.
-            error "couldn't load $arg into $GDB (end of file)."
+            perror "couldn't load $arg into $GDB (end of file)."
             return -1
         }
     }