2002-05-15 Nick Clifton <nickc@cambridge.redhat.com>

[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index b36211ff559a257625871df1b92172e88d019a24..d9285e86945032c5ed5fbee4b9e0c3839e0e1082 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -440,9 +440,9 @@ proc gdb_test { args } {
                # we need to set -notransfer expect option so that
                # command output is not lost for pattern matching
                # - guo
-               gdb_expect -notransfer 2 {
-                   -re "\[\r\n\]" { }
-                   timeout { }
+               gdb_expect 2 {
+                   -notransfer -re "\[\r\n\]" { verbose "partial: match" 3 }
+                   timeout { verbose "partial: timeout" 3 }
                }
                set string [string range "$string" [expr $foo + 1] end];
            } else {
@@ -520,6 +520,15 @@ proc gdb_test { args } {
            }
            fail "$errmsg"
            return -1
+       }
+        -re "EXIT code \[0-9\r\n\]+Program exited normally.*$gdb_prompt $" {
+           if ![string match "" $message] then {
+               set errmsg "$message: the program exited"
+           } else {
+               set errmsg "$command: the program exited"
+           }
+           fail "$errmsg"
+           return -1
        }
         -re "The program is not being run.*$gdb_prompt $" {
            if ![string match "" $message] then {
@@ -618,6 +627,14 @@ proc test_print_reject { args } {
            pass "reject $sendthis"
            return 1
        }
+        -re "Unmatched single quote.*$gdb_prompt $" {
+            pass "reject $sendthis"
+            return 1
+        }
+        -re "A character constant must contain at least one character.*$gdb_prompt $" {
+            pass "reject $sendthis"
+            return 1
+        }
        -re "$expectthis.*$gdb_prompt $" {
            pass "reject $sendthis"
            return 1
@@ -1092,8 +1109,33 @@ proc gdb_preprocess {source dest args} {
     return $result;
 }
 
+set gdb_wrapper_initialized 0
+
+proc gdb_wrapper_init { args } {
+    global gdb_wrapper_initialized;
+    global gdb_wrapper_file;
+    global gdb_wrapper_flags;
+
+    if { $gdb_wrapper_initialized == 1 } { return; }
+
+    if {[target_info exists needs_status_wrapper] && \
+           [target_info needs_status_wrapper] != "0"} {
+       set result [build_wrapper "testglue.o"];
+       if { $result != "" } {
+           set gdb_wrapper_file [lindex $result 0];
+           set gdb_wrapper_flags [lindex $result 1];
+       } else {
+           warning "Status wrapper failed to build."
+       }
+    }
+    set gdb_wrapper_initialized 1
+}
+
 proc gdb_compile {source dest type options} {
     global GDB_TESTCASE_OPTIONS;
+    global gdb_wrapper_file;
+    global gdb_wrapper_flags;
+    global gdb_wrapper_initialized;
 
     if [target_info exists gdb_stub] {
        set options2 { "additional_flags=-Dusestubs" }
@@ -1111,6 +1153,15 @@ proc gdb_compile {source dest type options} {
     verbose "options are $options"
     verbose "source is $source $dest $type $options"
 
+    if { $gdb_wrapper_initialized == 0 } { gdb_wrapper_init }
+
+    if {[target_info exists needs_status_wrapper] && \
+           [target_info needs_status_wrapper] != "0" && \
+           [info exists gdb_wrapper_file]} {
+       lappend options "libs=${gdb_wrapper_file}"
+       lappend options "ldflags=${gdb_wrapper_flags}"
+    }
+
     set result [target_compile $source $dest $type $options];
     regsub "\[\r\n\]*$" "$result" "" result;
     regsub "^\[\r\n\]*" "$result" "" result;
@@ -1132,20 +1183,6 @@ proc send_gdb { string } {
 #
 
 proc gdb_expect { args } {
-    # allow -notransfer expect flag specification,
-    # used by gdb_test routine for multi-line commands.
-    # packed with gtimeout when fed to remote_expect routine,
-    # which is a hack but due to what looks like a res and orig
-    # parsing problem in remote_expect routine (dejagnu/lib/remote.exp):
-    # what's fed into res is not removed from orig.
-    # - guo
-    if { [lindex $args 0] == "-notransfer" } {
-       set notransfer -notransfer;
-       set args [lrange $args 1 end];
-    } else {
-       set notransfer "";
-    }
-
     if { [llength $args] == 2  && [lindex $args 0] != "-re" } {
        set gtimeout [lindex $args 0];
        set expcode [list [lindex $args 1]];
@@ -1186,7 +1223,7 @@ proc gdb_expect { args } {
        }
     }
     set code [catch \
-       {uplevel remote_expect host "$gtimeout $notransfer" $expcode} string];
+       {uplevel remote_expect host $gtimeout $expcode} string];
     if [info exists old_val] {
        set remote_suppress_flag $old_val;
     } else {
@@ -1352,8 +1389,14 @@ proc gdb_continue { function } {
 }
 
 proc default_gdb_init { args } {
+    global gdb_wrapper_initialized
+    
     gdb_clear_suppressed;
 
+    # Make sure that the wrapper is rebuilt
+    # with the appropriate multilib option.
+    set gdb_wrapper_initialized 0
+    
     # 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
@@ -1584,7 +1627,7 @@ proc gdb_continue_to_end {mssg} {
     # Don't bother to check the output of the program, that may be
     # extremely tough for some remote systems.
     gdb_test "continue"\
-      "Continuing.\[\r\n0-9\]+Program exited normally\\..*"\
+      "Continuing.\[\r\n0-9\]+(... EXIT code 0\[\r\n\]+|)Program exited normally\\..*"\
       "continue until exit at $mssg"
   }
 }