* mi/mi-interp.c (mi_solib_loaded, mi_solib_unloaded): New.
[deliverable/binutils-gdb.git] / gdb / testsuite / lib / mi-support.exp
index 2fd6b6c83a9ea4ab9c25b26a8f5aa6b03c60f106..f62c2402c96aa17fd1f5d4ac8f9c95de2448b5b3 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright 1999, 2000, 2002, 2003, 2004, 2005, 2007, 2008
+# Copyright 1999, 2000, 2002, 2003, 2004, 2005, 2007, 2008, 2009
 # Free Software Foundation, Inc.
 
 # This program is free software; you can redistribute it and/or modify
@@ -14,9 +14,6 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-# Please email any bugs, comments, and/or additions to this file to:
-# bug-gdb@prep.ai.mit.edu
-
 # This file was based on a file written by Fred Fish. (fnf@cygnus.com)
 
 # Test setup routines that work with the MI interpreter.
@@ -33,6 +30,9 @@ global mi_inferior_tty_name
 
 set MIFLAGS "-i=mi"
 
+set thread_selected_re "=thread-selected,id=\"\[0-9+\]\"\r\n"
+set library_loaded_re "=library-loaded\[^\n\]+\"\r\n"
+
 #
 # mi_gdb_exit -- exit the GDB, killing the target program if necessary
 #
@@ -42,7 +42,7 @@ proc mi_gdb_exit {} {
 
 proc mi_uncatched_gdb_exit {} {
     global GDB
-    global GDBFLAGS
+    global INTERNAL_GDBFLAGS GDBFLAGS
     global verbose
     global gdb_spawn_id;
     global gdb_prompt
@@ -59,7 +59,7 @@ proc mi_uncatched_gdb_exit {} {
        return;
     }
 
-    verbose "Quitting $GDB $GDBFLAGS $MIFLAGS"
+    verbose "Quitting $GDB $INTERNAL_GDBFLAGS $GDBFLAGS $MIFLAGS"
 
     if { [is_remote host] && [board_info host exists fileid] } {
        send_gdb "999-gdb-exit\n";
@@ -97,7 +97,7 @@ proc mi_uncatched_gdb_exit {} {
 proc default_mi_gdb_start { args } {
     global verbose
     global GDB
-    global GDBFLAGS
+    global INTERNAL_GDBFLAGS GDBFLAGS
     global gdb_prompt
     global mi_gdb_prompt
     global timeout
@@ -119,7 +119,7 @@ proc default_mi_gdb_start { args } {
        sid_start
     }
 
-    verbose "Spawning $GDB -nw $GDBFLAGS $MIFLAGS"
+    verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS $MIFLAGS"
 
     if [info exists gdb_spawn_id] {
        return 0;
@@ -141,7 +141,7 @@ proc default_mi_gdb_start { args } {
        set mi_inferior_tty_name $spawn_out(slave,name)
     }
 
-    set res [remote_spawn host "$GDB -nw $GDBFLAGS $MIFLAGS [host_info gdb_opts]"];
+    set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS $MIFLAGS [host_info gdb_opts]"];
     if { $res < 0 || $res == "" } {
        perror "Spawning $GDB failed."
        return 1;
@@ -169,11 +169,6 @@ proc default_mi_gdb_start { args } {
            }
            verbose "GDB initialized."
        }
-       -re ".*$gdb_prompt $" {
-           untested "Skip mi tests (got non-mi prompt)."
-           remote_close host;
-           return -1;
-       }
        -re ".*unrecognized option.*for a complete list of options." {
            untested "Skip mi tests (not compiled with mi support)."
            remote_close host;
@@ -227,6 +222,8 @@ proc default_mi_gdb_start { args } {
        }
     }
 
+    detect_async
+
     return 0;
 }
 
@@ -265,7 +262,7 @@ proc mi_delete_breakpoints {} {
     send_gdb "103-break-list\n"
     gdb_expect 30 {
         -re "103-break-list\r\n103\\\^done,BreakpointTable=\{\}\r\n$mi_gdb_prompt$" {}
-        -re "103-break-list\r\n103\\\^done,BreakpointTable=\{nr_rows=\".\",nr_cols=\".\",hdr=\\\[\{width=\".*\",alignment=\".*\",col_name=\"number\",colhdr=\"Num\"\}.*colhdr=\"Type\".*colhdr=\"Disp\".*colhdr=\"Enb\".*colhdr=\"Address\".*colhdr=\"What\".*\\\],body=\\\[\\\]\}" {}
+        -re "103-break-list\r\n103\\\^done,BreakpointTable=\{nr_rows=\".\",nr_cols=\".\",hdr=\\\[\{width=\".*\",alignment=\".*\",col_name=\"number\",colhdr=\"Num\"\}.*colhdr=\"Type\".*colhdr=\"Disp\".*colhdr=\"Enb\".*colhdr=\"Address\".*colhdr=\"What\".*\\\],body=\\\[\\\]\}\r\n$mi_gdb_prompt$" {}
         -re "103-break-list\r\n103\\\^doneNo breakpoints or watchpoints.\r\n\r\n$mi_gdb_prompt$" {warning "Unexpected console text received"}
         -re "$mi_gdb_prompt$" { perror "Breakpoints not deleted" ; return }
         -re "Delete all breakpoints.*or n.*$" {
@@ -643,6 +640,7 @@ proc mi_gdb_test { args } {
            set tmt 60;
        }
     }
+    verbose -log "Expecting: ^($string_regex\[\r\n\]+)?($pattern\[\r\n\]+$mi_gdb_prompt\[ \]*)"
     gdb_expect $tmt {
         -re "\\*\\*\\* DOSEXIT code.*" {
             if { $message != "" } {
@@ -780,6 +778,8 @@ proc mi_run_cmd {args} {
        return -1
     }
     global mi_gdb_prompt
+    global thread_selected_re
+    global library_loaded_re
 
     if [target_info exists gdb_init_command] {
        send_gdb "[target_info gdb_init_command]\n";
@@ -800,7 +800,7 @@ proc mi_run_cmd {args} {
        if [target_info exists gdb,do_reload_on_run] {
            send_gdb "220-exec-continue\n";
            gdb_expect 60 {
-               -re "220\\^running\[\r\n\]+$mi_gdb_prompt$" {}
+               -re "220\\^running\[\r\n\]+\\*running,thread-id=\"\[^\"\]+\"\r\n$mi_gdb_prompt" {}
                default {}
            }
            return;
@@ -821,7 +821,7 @@ proc mi_run_cmd {args} {
 
     send_gdb "220-exec-run $args\n"
     gdb_expect {
-       -re "220\\^running\r\n${mi_gdb_prompt}" {
+       -re "220\\^running\r\n(\\*running,thread-id=\"\[^\"\]+\"\r\n|=thread-created,id=\"1\",group-id=\"\[0-9\]+\"\r\n)*(${library_loaded_re})*(${thread_selected_re})?${mi_gdb_prompt}" {
        }
        timeout {
            perror "Unable to start target"
@@ -911,6 +911,28 @@ proc mi_step { test } {
   return [mi_step_to {.*} {.*} {.*} {.*} $test]
 }
 
+set async "unknown"
+
+proc detect_async {} {
+    global async
+    global mi_gdb_prompt
+
+    send_gdb "show target-async\n"
+        
+    gdb_expect {
+        -re ".*Controlling the inferior in asynchronous mode is on...*$mi_gdb_prompt$" {
+            set async 1
+        }
+        -re ".*$mi_gdb_prompt$" {
+            set async 0
+        }
+        timeout {
+            set async 0
+        }
+    }
+    return $async
+}
+
 # Wait for MI *stopped notification to appear.
 # The REASON, FUNC, ARGS, FILE and LINE are regular expressions
 # to match against whatever is output in *stopped.  ARGS should
@@ -926,13 +948,18 @@ proc mi_step { test } {
 # When we fail to match output at all, -1 is returned.  Otherwise,
 # the line at which we stop is returned.  This is useful when exact
 # line is not possible to specify for some reason -- one can pass
-# the .* regexp for line, and then check the line programmatically.
+# the .* or "\[0-9\]*" regexps for line, and then check the line
+# programmatically.
+#
+# Do not pass .* for any argument if you are expecting more than one stop.
 proc mi_expect_stop { reason func args file line extra test } {
 
     global mi_gdb_prompt
     global hex
     global decimal
     global fullname_syntax
+    global async
+    global thread_selected_re
 
     set after_stopped ""
     set after_reason ""
@@ -944,10 +971,28 @@ proc mi_expect_stop { reason func args file line extra test } {
         set after_stopped [lindex $extra 0]
     }
 
+    if {$async} {
+        set prompt_re ""
+    } else {
+        set prompt_re "$mi_gdb_prompt$"
+    }
+
+    if { $reason == "really-no-reason" } {
+        gdb_expect {
+          -re "\\*stopped\r\n$prompt_re" {
+            pass "$test"
+          }
+          timeout {
+              fail "$test (unknown output after running)"
+          }
+        }
+        return
+    }
+    
     if { $reason == "exited-normally" } {
 
         gdb_expect {
-          -re "220\\*stopped,reason=\"exited-normally\"\r\n$mi_gdb_prompt$" {
+          -re "\\*stopped,reason=\"exited-normally\"\r\n$prompt_re" {
             pass "$test"
           }
           -re ".*$mi_gdb_prompt$" {fail "continue to end (2)"}
@@ -973,17 +1018,21 @@ proc mi_expect_stop { reason func args file line extra test } {
 
     set a $after_reason
 
-    verbose -log "mi_expect_stop: expecting: .*220\\*stopped,${r}${a}${bn}thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"$func\",args=$args,file=\".*$file\",fullname=\"${fullname_syntax}$file\",line=\"$line\"\}$after_stopped\r\n$mi_gdb_prompt$"
+    set any "\[^\n\]*"
+
+    verbose -log "mi_expect_stop: expecting: \\*stopped,${r}${a}${bn}frame=\{addr=\"$hex\",func=\"$func\",args=$args,file=\"$any$file\",fullname=\"${fullname_syntax}$file\",line=\"$line\"\}$after_stopped,thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re)?$prompt_re"
     gdb_expect {
-       -re ".*220\\*stopped,${r}${a}${bn}thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"$func\",args=$args,file=\".*$file\",fullname=\"${fullname_syntax}$file\",line=\"($line)\"\}$after_stopped\r\n$mi_gdb_prompt$" {
+       -re "\\*stopped,${r}${a}${bn}frame=\{addr=\"$hex\",func=\"$func\",args=$args,file=\"$any$file\",fullname=\"${fullname_syntax}$file\",line=\"($line)\"\}$after_stopped,thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re)?$prompt_re" {
            pass "$test"
             return $expect_out(2,string)
        }
-       -re ".*220\\*stopped,${r}${a}${bn}thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\[\\\[\{\].*\[\\\]\}\],file=\".*\",fullname=\"${fullname_syntax}.*\",line=\"\[0-9\]*\"\}.*\r\n$mi_gdb_prompt$" {
+       -re "\\*stopped,${r}${a}${bn}frame=\{addr=\"$hex\",func=\"$any\",args=\[\\\[\{\]$any\[\\\]\}\],file=\"$any\",fullname=\"${fullname_syntax}$any\",line=\"\[0-9\]*\"\}thread-id=\"$decimal\",stopped-threads=$any\r\n$prompt_re" {
+            verbose -log "got $expect_out(buffer)"
            fail "$test (stopped at wrong place)"
            return -1
        }
-       -re ".*\r\n${mi_gdb_prompt}$" {
+       -re ".*\r\n$mi_gdb_prompt$" {
+            verbose -log "got $expect_out(buffer)"
            fail "$test (unknown output after running)"
            return -1
        }
@@ -994,6 +1043,42 @@ proc mi_expect_stop { reason func args file line extra test } {
     }    
 }
 
+# Wait for MI *stopped notification related to an interrupt request to
+# appear.
+proc mi_expect_interrupt { test } {
+    global mi_gdb_prompt
+    global decimal
+    global async
+
+    if {$async} {
+       set prompt_re ""
+    } else {
+       set prompt_re "$mi_gdb_prompt$"
+    }
+
+    set r "reason=\"signal-received\",signal-name=\"0\",signal-meaning=\"Signal 0\""
+
+    set any "\[^\n\]*"
+
+    # A signal can land anywhere, just ignore the location
+    verbose -log "mi_expect_interrupt: expecting: \\*stopped,${r}$any\r\n$prompt_re"
+    gdb_expect {
+       -re "\\*stopped,${r}$any\r\n$prompt_re" {
+           pass "$test"
+           return 0;
+       }
+       -re ".*\r\n$mi_gdb_prompt$" {
+           verbose -log "got $expect_out(buffer)"
+           fail "$test (unknown output after running)"
+           return -1
+       }
+       timeout {
+           fail "$test (timeout)"
+           return -1
+       }
+    }
+}
+
 # cmd should not include the number or newline (i.e. "exec-step 3", not
 # "220-exec-step 3\n"
 
@@ -1348,18 +1433,31 @@ proc mi_tbreak {location} {
 # Send COMMAND that must be a command that resumes
 # the inferiour (run/continue/next/etc) and consumes
 # the "^running" output from it.
-proc mi_send_resuming_command {command test} {
+proc mi_send_resuming_command_raw {command test} {
 
     global mi_gdb_prompt
+    global thread_selected_re
+    global library_loaded_re
 
-    send_gdb "220-$command\n"
+    send_gdb "$command\n"
     gdb_expect {
-        -re "220\\^running\r\n${mi_gdb_prompt}" {
+        -re "\\^running\r\n\\*running,thread-id=\"\[^\"\]+\"\r\n($library_loaded_re)*($thread_selected_re)?${mi_gdb_prompt}" {
+            # Note that lack of 'pass' call here -- this works around limitation
+            # in DejaGNU xfail mechanism. mi-until.exp has this:
+            #
+            #     setup_kfail gdb/2104 "*-*-*"
+            #     mi_execute_to ...
+            # 
+            # and mi_execute_to uses mi_send_resuming_command.  If we use 'pass' here,
+            # it will reset kfail, so when the actual test fails, it will be flagged
+            # as real failure.
+           return 0
         }
         -re ".*${mi_gdb_prompt}" {
             fail "$test (failed to resume)"
+           return -1
         }
-        -re "220\\^error,msg=.*" {
+        -re "\\^error,msg=.*" {
             fail "$test (MI error)"
             return -1
         }
@@ -1370,6 +1468,10 @@ proc mi_send_resuming_command {command test} {
     }
 }
 
+proc mi_send_resuming_command {command test} {
+    mi_send_resuming_command_raw -$command $test
+}
+
 # Helper to mi_run_inline_test below.
 # Sets a temporary breakpoint at LOCATION and runs
 # the program using COMMAND.  When the program is stopped
@@ -1388,12 +1490,19 @@ proc mi_continue_to_line {location test} {
 proc mi_get_stop_line {test} {
 
   global mi_gdb_prompt
+  global async
+
+  if {$async} {
+      set prompt_re ""
+  } else {
+      set prompt_re "$mi_gdb_prompt$"
+  }
 
   gdb_expect {
-      -re ".*line=\"(.*)\".*\r\n$mi_gdb_prompt$" {
+      -re ".*line=\"(\[0-9\]*)\".*\r\n$prompt_re" {
           return $expect_out(1,string)
       }
-      -re ".*$mi_gdb_prompt$" {
+      -re ".*$mi_gdb_prompt" {
           fail "wait for stop ($test)"
       }
       timeout {
@@ -1477,8 +1586,10 @@ proc mi_run_inline_test { testcase } {
         # the state after the statement is executed.
 
         # Single-step past the line.
-        mi_send_resuming_command "exec-next" "$testcase: step over $line"
-        set line_now [mi_get_stop_line "$testcase: step over $line"]
+        if { [mi_send_resuming_command "exec-next" "$testcase: step over $line"] != 0 } {
+           return -1
+       }
+       set line_now [mi_get_stop_line "$testcase: step over $line"]
 
         # We probably want to use 'uplevel' so that statements
         # have direct access to global variables that the
@@ -1487,3 +1598,175 @@ proc mi_run_inline_test { testcase } {
         eval $statements
     }
 }
+
+proc get_mi_thread_list {name} {
+  global expect_out
+
+  # MI will return a list of thread ids:
+  #
+  # -thread-list-ids
+  # ^done,thread-ids=[thread-id="1",thread-id="2",...],number-of-threads="N"
+  # (gdb)
+  mi_gdb_test "-thread-list-ids" \
+    {.*\^done,thread-ids={(thread-id="[0-9]+"(,)?)+},current-thread-id="[0-9]+",number-of-threads="[0-9]+"} \
+    "-thread_list_ids ($name)"
+
+  set output {}
+  if {[info exists expect_out(buffer)]} {
+    set output $expect_out(buffer)
+  }
+
+  set thread_list {}
+  if {![regexp {thread-ids=\{(thread-id="[0-9]+"(,)?)*\}} $output threads]} {
+    fail "finding threads in MI output ($name)"
+  } else {
+    pass "finding threads in MI output ($name)"
+
+    # Make list of console threads
+    set start [expr {[string first \{ $threads] + 1}]
+    set end   [expr {[string first \} $threads] - 1}]
+    set threads [string range $threads $start $end]
+    foreach thread [split $threads ,] {
+      if {[scan $thread {thread-id="%d"} num]} {
+       lappend thread_list $num
+      }
+    }
+  }
+
+  return $thread_list
+}
+
+# Check that MI and the console know of the same threads.
+# Appends NAME to all test names.
+proc check_mi_and_console_threads {name} {
+  global expect_out
+
+  mi_gdb_test "-thread-list-ids" \
+    {.*\^done,thread-ids={(thread-id="[0-9]+"(,)*)+},current-thread-id="[0-9]+",number-of-threads="[0-9]+"} \
+    "-thread-list-ids ($name)"
+  set mi_output {}
+  if {[info exists expect_out(buffer)]} {
+    set mi_output $expect_out(buffer)
+  }
+
+  # GDB will return a list of thread ids and some more info:
+  #
+  # (gdb) 
+  # -interpreter-exec console "info threads"
+  # ~"  4 Thread 2051 (LWP 7734)  0x401166b1 in __libc_nanosleep () at __libc_nanosleep:-1"
+  # ~"  3 Thread 1026 (LWP 7733)   () at __libc_nanosleep:-1"
+  # ~"  2 Thread 2049 (LWP 7732)  0x401411f8 in __poll (fds=0x804bb24, nfds=1, timeout=2000) at ../sysdeps/unix/sysv/linux/poll.c:63"
+  # ~"* 1 Thread 1024 (LWP 7731)  main (argc=1, argv=0xbfffdd94) at ../../../src/gdb/testsuite/gdb.mi/pthreads.c:160"
+  # FIXME: kseitz/2002-09-05: Don't use the hack-cli method.
+  mi_gdb_test "info threads" \
+    {.*(~".*"[\r\n]*)+.*} \
+    "info threads ($name)"
+  set console_output {}
+  if {[info exists expect_out(buffer)]} {
+    set console_output $expect_out(buffer)
+  }
+
+  # Make a list of all known threads to console (gdb's thread IDs)
+  set console_thread_list {}
+  foreach line [split $console_output \n] {
+    if {[string index $line 0] == "~"} {
+      # This is a line from the console; trim off "~", " ", "*", and "\""
+      set line [string trim $line ~\ \"\*]
+      if {[scan $line "%d" id] == 1} {
+       lappend console_thread_list $id
+      }
+    }
+  }
+
+  # Now find the result string from MI
+  set mi_result ""
+  foreach line [split $mi_output \n] {
+    if {[string range $line 0 4] == "^done"} {
+      set mi_result $line
+    }
+  }
+  if {$mi_result == ""} {
+    fail "finding MI result string ($name)"
+  } else {
+    pass "finding MI result string ($name)"
+  }
+
+  # Finally, extract the thread ids and compare them to the console
+  set num_mi_threads_str ""
+  if {![regexp {number-of-threads="[0-9]+"} $mi_result num_mi_threads_str]} {
+    fail "finding number of threads in MI output ($name)"
+  } else {
+    pass "finding number of threads in MI output ($name)"
+
+    # Extract the number of threads from the MI result
+    if {![scan $num_mi_threads_str {number-of-threads="%d"} num_mi_threads]} {
+      fail "got number of threads from MI ($name)"
+    } else {
+      pass "got number of threads from MI ($name)"
+
+      # Check if MI and console have same number of threads
+      if {$num_mi_threads != [llength $console_thread_list]} {
+       fail "console and MI have same number of threads ($name)"
+      } else {
+       pass "console and MI have same number of threads ($name)"
+
+       # Get MI thread list
+       set mi_thread_list [get_mi_thread_list $name]
+
+       # Check if MI and console have the same threads
+       set fails 0
+       foreach ct [lsort $console_thread_list] mt [lsort $mi_thread_list] {
+         if {$ct != $mt} {
+           incr fails
+         }
+       }
+       if {$fails > 0} {
+         fail "MI and console have same threads ($name)"
+
+         # Send a list of failures to the log
+         send_log "Console has thread ids: $console_thread_list\n"
+         send_log "MI has thread ids: $mi_thread_list\n"
+       } else {
+         pass "MI and console have same threads ($name)"
+       }
+      }
+    }
+  }
+}
+
+proc mi_load_shlibs { args } {
+    if {![is_remote target]} {
+       return
+    }
+
+    foreach file $args {
+       gdb_download $file
+    }
+
+    # Even if the target supplies full paths for shared libraries,
+    # they may not be paths for this system.
+    mi_gdb_test "set solib-search-path [file dirname [lindex $args 0]]" "\^done" ""
+}
+
+proc mi_reverse_list { list } {
+    if { [llength $list] <= 1 } {
+       return $list
+    }
+    set tail [lrange $list 1 [llength $list]]
+    set rtail [mi_reverse_list $tail]
+    lappend rtail [lindex $list 0]
+    return $rtail
+}
+
+proc mi_check_thread_states { xstates test } {
+    global expect_out
+    set states [mi_reverse_list $xstates]
+    set pattern "\\^done,threads=\\\["
+    foreach s $states {
+       set pattern "${pattern}(.*)state=\"$s\""
+    }
+    set pattern "$pattern\\\}\\\].*"
+
+    verbose -log "expecting: $pattern"
+    mi_gdb_test "-thread-info" $pattern $test
+}
This page took 0.031018 seconds and 4 git commands to generate.