GDB 7.6.50

gdb/testsuite/lib/mi-support.exp

-# Copyright 1999-2000, 2002-2005, 2007-2012 Free Software Foundation,
-# Inc.
+# Copyright 1999-2013 Free Software Foundation, Inc.
 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 3 of the License, or
 # (at your option) any later version.
 #
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
@@ skipping 26 matching lines @@
 # mi_gdb_exit -- exit the GDB, killing the target program if necessary
 #
 proc mi_gdb_exit {} {
     catch mi_uncatched_gdb_exit
 }
 
 proc mi_uncatched_gdb_exit {} {
     global GDB
     global INTERNAL_GDBFLAGS GDBFLAGS
     global verbose
-    global gdb_spawn_id;
+    global gdb_spawn_id
     global gdb_prompt
     global mi_gdb_prompt
     global MIFLAGS
 
-    gdb_stop_suppressing_tests;
+    gdb_stop_suppressing_tests
 
     if { [info procs sid_exit] != "" } {
         sid_exit
     }
 
     if ![info exists gdb_spawn_id] {
-        return;
+        return
     }
 
     verbose "Quitting $GDB $INTERNAL_GDBFLAGS $GDBFLAGS $MIFLAGS"
 
     if { [is_remote host] && [board_info host exists fileid] } {
-        send_gdb "999-gdb-exit\n";
+        send_gdb "999-gdb-exit\n"
         gdb_expect 10 {
             -re "y or n" {
-                send_gdb "y\n";
-                exp_continue;
+                send_gdb "y\n"
+                exp_continue
             }
-            -re "Undefined command.*$gdb_prompt $" {
-                send_gdb "quit\n"
-                exp_continue;
-            }
+            -re "Undefined command.*$gdb_prompt $" {
+                send_gdb "quit\n"
+                exp_continue
+            }
             -re "DOSEXIT code" { }
             default { }
         }
     }
 
     if ![is_remote host] {
-        remote_close host;
+        remote_close host
     }
     unset gdb_spawn_id
 }
 
 #
 # default_mi_gdb_start [INFERIOR_PTY] -- start gdb running, default procedure
 #
 # INFERIOR_PTY should be set to separate-inferior-tty to have the inferior work 
 # with it's own PTY. If set to same-inferior-tty, the inferior shares GDB's PTY. 
 # The default value is same-inferior-tty.
 #
 # When running over NFS, particularly if running many simultaneous
 # tests on different hosts all using the same server, things can
 # get really slow.  Give gdb at least 3 minutes to start up.
 #
 proc default_mi_gdb_start { args } {
     global verbose use_gdb_stub
     global GDB
     global INTERNAL_GDBFLAGS GDBFLAGS
     global gdb_prompt
     global mi_gdb_prompt
     global timeout
-    global gdb_spawn_id;
+    global gdb_spawn_id
     global MIFLAGS
 
-    gdb_stop_suppressing_tests;
+    gdb_stop_suppressing_tests
     set inferior_pty no-tty
 
     # Set the default value, it may be overriden later by specific testfile.
     set use_gdb_stub [target_info exists use_gdb_stub]
 
     if { [llength $args] == 1} {
         set inferior_pty [lindex $args 0]
     }
 
     set separate_inferior_pty [string match $inferior_pty separate-inferior-tty]
 
     # Start SID.
     if { [info procs sid_start] != "" } {
         verbose "Spawning SID"
         sid_start
     }
 
     verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS $MIFLAGS"
 
     if [info exists gdb_spawn_id] {
-        return 0;
+        return 0
     }
 
     if ![is_remote host] {
         if { [which $GDB] == 0 } then {
             perror "$GDB does not exist."
             exit 1
         }
     }
 
     # Create the new PTY for the inferior process.
     if { $separate_inferior_pty } {
         spawn -pty
         global mi_inferior_spawn_id
         global mi_inferior_tty_name
         set mi_inferior_spawn_id $spawn_id
         set mi_inferior_tty_name $spawn_out(slave,name)
     }
 
-    set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS $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;
+        return 1
     }
     gdb_expect {
         -re "~\"GNU.*\r\n~\".*$mi_gdb_prompt$" {
             # We have a new format mi startup prompt.  If we are
             # running mi1, then this is an error as we should be
             # using the old-style prompt.
             if { $MIFLAGS == "-i=mi1" } {
-                perror "(mi startup) Got unexpected new mi prompt."
-                remote_close host;
-                return -1;
+                perror "(mi startup) Got unexpected new mi prompt."
+                remote_close host
+                return -1
             }
             verbose "GDB initialized."
         }
         -re "\[^~\].*$mi_gdb_prompt$" {
             # We have an old format mi startup prompt.  If we are
             # not running mi1, then this is an error as we should be
             # using the new-style prompt.
             if { $MIFLAGS != "-i=mi1" } {
-                perror "(mi startup) Got unexpected old mi prompt."
-                remote_close host;
-                return -1;
+                perror "(mi startup) Got unexpected old mi prompt."
+                remote_close host
+                return -1
             }
             verbose "GDB initialized."
         }
         -re ".*unrecognized option.*for a complete list of options." {
             untested "Skip mi tests (not compiled with mi support)."
-            remote_close host;
-            return -1;
+            remote_close host
+            return -1
         }
         -re ".*Interpreter `mi' unrecognized." {
             untested "Skip mi tests (not compiled with mi support)."
-            remote_close host;
-            return -1;
+            remote_close host
+            return -1
         }
         timeout {
             perror "(timeout) GDB never initialized after 10 seconds."
-            remote_close host;
+            remote_close host
             return -1
         }
     }
-    set gdb_spawn_id -1;
+    set gdb_spawn_id -1
 
     # FIXME: mi output does not go through pagers, so these can be removed.
     # force the height to "unlimited", so no pagers get used
     send_gdb "100-gdb-set height 0\n"
     gdb_expect 10 {
-        -re ".*100-gdb-set height 0\r\n100\\\^done\r\n$mi_gdb_prompt$" { 
+        -re ".*100-gdb-set height 0\r\n100\\\^done\r\n$mi_gdb_prompt$" {
             verbose "Setting height to 0." 2
         }
         timeout {
             warning "Couldn't set the height to 0"
         }
     }
     # force the width to "unlimited", so no wraparound occurs
     send_gdb "101-gdb-set width 0\n"
     gdb_expect 10 {
         -re ".*101-gdb-set width 0\r\n101\\\^done\r\n$mi_gdb_prompt$" {
             verbose "Setting width to 0." 2
         }
         timeout {
             warning "Couldn't set the width to 0."
         }
     }
     # If allowing the inferior to have its own PTY then assign the inferior
     # its own terminal device here.
     if { $separate_inferior_pty } {
         send_gdb "102-inferior-tty-set $mi_inferior_tty_name\n"
         gdb_expect 10 {
             -re ".*102\\\^done\r\n$mi_gdb_prompt$" {
                 verbose "redirect inferior output to new terminal device."
             }
             timeout {
-                warning "Couldn't redirect inferior output." 2
+                warning "Couldn't redirect inferior output." 2
             }
-        }
+        }
     }
 
     mi_detect_async
 
-    return 0;
+    return 0
 }
 
 #
 # Overridable function. You can override this function in your
 # baseboard file.
-# 
+#
 proc mi_gdb_start { args } {
   return [default_mi_gdb_start $args]
 }
 
 # Many of the tests depend on setting breakpoints at various places and
 # running until that breakpoint is reached.  At times, we want to start
 # with a clean-slate with respect to breakpoints, so this utility proc 
 # lets us do this without duplicating this code everywhere.
 #
 
 proc mi_delete_breakpoints {} {
     global mi_gdb_prompt
 
 # FIXME: The mi operation won't accept a prompt back and will use the 'all' arg
     send_gdb "102-break-delete\n"
     gdb_expect 30 {
          -re "Delete all breakpoints.*y or n.*$" {
-            send_gdb "y\n";
+            send_gdb "y\n"
             exp_continue
-         }
+         }
          -re "102-break-delete\r\n102\\\^done\r\n$mi_gdb_prompt$" {
-            # This happens if there were no breakpoints
+             # This happens if there were no breakpoints
          }
          timeout { perror "Delete all breakpoints in mi_delete_breakpoints (timeout)" ; return }
     }
 
 # The correct output is not "No breakpoints or watchpoints." but an
 # empty BreakpointTable. Also, a query is not acceptable with mi.
     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=\\\[\\\]\}\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.*$" {
-            warning "Unexpected prompt for breakpoints deletion";
-            send_gdb "y\n";
+            warning "Unexpected prompt for breakpoints deletion"
+            send_gdb "y\n"
             exp_continue
         }
          timeout { perror "-break-list (timeout)" ; return }
     }
 }
 
 proc mi_gdb_reinitialize_dir { subdir } {
     global mi_gdb_prompt
     global MIFLAGS
 
     global suppress_flag
     if { $suppress_flag } {
         return
     }
 
     if [is_remote host] {
-        return "";
+        return ""
     }
 
     if { $MIFLAGS == "-i=mi1" } {
       send_gdb "104-environment-directory\n"
       gdb_expect 60 {
         -re ".*Reinitialize source path to empty.*y or n. " {
-            warning "Got confirmation prompt for dir reinitialization."
+            warning "Got confirmation prompt for dir reinitialization."
             send_gdb "y\n"
             gdb_expect 60 {
                 -re "$mi_gdb_prompt$" {}
-                timeout {error "Dir reinitialization failed (timeout)"}
+                timeout {error "Dir reinitialization failed (timeout)"}
             }
         }
         -re "$mi_gdb_prompt$" {}
-        timeout {error "Dir reinitialization failed (timeout)"}
+          timeout {error "Dir reinitialization failed (timeout)"}
       }
     } else {
-      send_gdb "104-environment-directory -r\n"
-      gdb_expect 60 {
-        -re "104\\\^done,source-path=.*\r\n$mi_gdb_prompt$" {}
-        -re "$mi_gdb_prompt$" {}
-        timeout {error "Dir reinitialization failed (timeout)"}
+        send_gdb "104-environment-directory -r\n"
+        gdb_expect 60 {
+            -re "104\\\^done,source-path=.*\r\n$mi_gdb_prompt$" {}
+            -re "$mi_gdb_prompt$" {}
+            timeout {error "Dir reinitialization failed (timeout)"}
       }
     }
 
     send_gdb "105-environment-directory $subdir\n"
     gdb_expect 60 {
         -re "Source directories searched.*$mi_gdb_prompt$" {
             verbose "Dir set to $subdir"
         }
         -re "105\\\^done.*\r\n$mi_gdb_prompt$" {
-            # FIXME: We return just the prompt for now.
+            # FIXME: We return just the prompt for now.
             verbose "Dir set to $subdir"
             # perror "Dir \"$subdir\" failed."
         }
     }
 }
 
 # Send GDB the "target" command.
 # FIXME: Some of these patterns are not appropriate for MI.  Based on
 # config/monitor.exp:gdb_target_command.
 proc mi_gdb_target_cmd { targetname serialport } {
     global mi_gdb_prompt
 
     set serialport_re [string_to_regexp $serialport]
     for {set i 1} {$i <= 3} {incr i} {
         send_gdb "47-target-select $targetname $serialport\n"
         gdb_expect 60 {
             -re "47\\^connected.*$mi_gdb_prompt" {
-                verbose "Set target to $targetname";
-                return 0;
+                verbose "Set target to $targetname"
+                return 0
             }
             -re "unknown host.*$mi_gdb_prompt" {
-                verbose "Couldn't look up $serialport"
+                verbose "Couldn't look up $serialport"
             }
             -re "Couldn't establish connection to remote.*$mi_gdb_prompt$" {
-                verbose "Connection failed";
+                verbose "Connection failed"
             }
             -re "Remote MIPS debugging.*$mi_gdb_prompt$" {
-                verbose "Set target to $targetname";
-                return 0;
+                verbose "Set target to $targetname"
+                return 0
             }
             -re "Remote debugging using .*$serialport_re.*$mi_gdb_prompt$" {
-                verbose "Set target to $targetname";
-                return 0;
+                verbose "Set target to $targetname"
+                return 0
             }
             -re "Remote target $targetname connected to.*$mi_gdb_prompt$" {
-                verbose "Set target to $targetname";
-                return 0;
+                verbose "Set target to $targetname"
+                return 0
             }
-            -re "Connected to.*$mi_gdb_prompt$" { 
-                verbose "Set target to $targetname";
-                return 0;
+            -re "Connected to.*$mi_gdb_prompt$" {
+                verbose "Set target to $targetname"
+                return 0
             }
             -re "Ending remote.*$mi_gdb_prompt$" { }
             -re "Connection refused.*$mi_gdb_prompt$" {
                 verbose "Connection refused by remote target.  Pausing, and trying again."
                 sleep 5
                 continue
             }
             -re "Non-stop mode requested, but remote does not support non-stop.*$mi_gdb_prompt" {
                 unsupported "Non-stop mode not supported"
                 return 1
             }
             -re "Timeout reading from remote system.*$mi_gdb_prompt$" {
-                verbose "Got timeout error from gdb.";
+                verbose "Got timeout error from gdb."
             }
             timeout {
-                send_gdb "";
+                send_gdb ""
                 break
             }
         }
     }
     return 1
 }
 
 #
 # load a file into the debugger (file command only).
 # return a -1 if anything goes wrong.
 #
 proc mi_gdb_file_cmd { arg } {
     global verbose
     global loadpath
     global loadfile
     global GDB
     global mi_gdb_prompt
     global last_loaded_file
     upvar timeout timeout
 
     set last_loaded_file $arg
 
     if [is_remote host] {
-        set arg [remote_download host $arg];
+        set arg [remote_download host $arg]
         if { $arg == "" } {
             error "download failed"
-            return -1;
+            return -1
         }
     }
 
 # FIXME: Several of these patterns are only acceptable for console
 # output.  Queries are an error for mi.
     send_gdb "105-file-exec-and-symbols $arg\n"
     gdb_expect 120 {
-        -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
-            verbose "\t\tLoaded $arg into the $GDB"
-            return 0
-        }
-        -re "has no symbol-table.*$mi_gdb_prompt$" {
-            perror "$arg wasn't compiled with \"-g\""
-            return -1
-        }
-        -re "Load new symbol table from \".*\".*y or n. $" {
-            send_gdb "y\n"
-            gdb_expect 120 {
-                -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
-                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
-                    # All OK
-                }
-                timeout {
-                    perror "(timeout) Couldn't load $arg, other program already loaded."
-                    return -1
-                }
-            }
+        -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
+            verbose "\t\tLoaded $arg into the $GDB"
+            return 0
         }
-        -re "No such file or directory.*$mi_gdb_prompt$" {
-            perror "($arg) No such file or directory\n"
-            return -1
-        }
-        -re "105-file-exec-and-symbols .*\r\n105\\\^done\r\n$mi_gdb_prompt$" {
-            # We (MI) are just giving the prompt back for now, instead of giving
+        -re "has no symbol-table.*$mi_gdb_prompt$" {
+            perror "$arg wasn't compiled with \"-g\""
+            return -1
+        }
+        -re "Load new symbol table from \".*\".*y or n. $" {
+            send_gdb "y\n"
+            gdb_expect 120 {
+                -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
+                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
+                    # All OK
+                }
+                timeout {
+                    perror "(timeout) Couldn't load $arg, other program already loaded."
+                    return -1
+                }
+            }
+        }
+        -re "No such file or directory.*$mi_gdb_prompt$" {
+            perror "($arg) No such file or directory\n"
+            return -1
+        }
+        -re "105-file-exec-and-symbols .*\r\n105\\\^done\r\n$mi_gdb_prompt$" {
+            # We (MI) are just giving the prompt back for now, instead of giving
             # some acknowledgement.
             return 0
         }
-        timeout {
-            perror "couldn't load $arg into $GDB (timed out)."
-            return -1
-        }
+        timeout {
+            perror "couldn't load $arg into $GDB (timed out)."
+            return -1
+        }
         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
-            # gdb_expect does not seem to have a way to do that.
-            perror "couldn't load $arg into $GDB (end of file)."
-            return -1
-        }
+            # This is an attempt to detect a core dump, but seems not to
+            # work.  Perhaps we need to match .* followed by eof, in which
+            # gdb_expect does not seem to have a way to do that.
+            perror "couldn't load $arg into $GDB (end of file)."
+            return -1
+        }
     }
 }
 
 #
 # connect to the target and download a file, if necessary.
 # return a -1 if anything goes wrong.
 #
 proc mi_gdb_target_load { } {
     global verbose
     global loadpath
@@ skipping 90 matching lines @@
     return 0
 }
 
 # mi_gdb_test COMMAND PATTERN MESSAGE [IPATTERN] -- send a command to gdb; 
 #   test the result.
 #
 # COMMAND is the command to execute, send to GDB with send_gdb.  If
 #   this is the null string no command is sent.
 # PATTERN is the pattern to match for a PASS, and must NOT include
 #   the \r\n sequence immediately before the gdb prompt.
-# MESSAGE is the message to be printed.  (If this is the empty string, 
-#   then sometimes we don't call pass or fail at all; I don't 
+# MESSAGE is the message to be printed.  (If this is the empty string,
+#   then sometimes we don't call pass or fail at all; I don't
 #   understand this at all.)
 # IPATTERN is the pattern to match for the inferior's output.  This parameter
-#   is optional.  If present, it will produce a PASS if the match is 
+#   is optional.  If present, it will produce a PASS if the match is
 #   successful, and a FAIL if unsuccessful.
 #
 # Returns:
 #    1 if the test failed,
 #    0 if the test passes,
 #   -1 if there was an internal error.
-#  
+#
 proc mi_gdb_test { args } {
     global verbose
     global mi_gdb_prompt
     global GDB expect_out
     global inferior_exited_re async
     upvar timeout timeout
 
     set command [lindex $args 0]
     set pattern [lindex $args 1]
     set message [lindex $args 2]
 
     if [llength $args]==4 {
         set ipattern [lindex $args 3]
     }
 
     if [llength $args]==5 {
-        set question_string [lindex $args 3];
-        set response_string [lindex $args 4];
+        set question_string [lindex $args 3]
+        set response_string [lindex $args 4]
     } else {
         set question_string "^FOOBAR$"
     }
 
     if $verbose>2 then {
         send_user "Sending \"$command\" to gdb\n"
         send_user "Looking to match \"$pattern\"\n"
         send_user "Message is \"$message\"\n"
     }
 
     set result -1
-    set string "${command}\n";
+    set string "${command}\n"
     set string_regex [string_to_regexp $command]
 
     if { $command != "" } {
         while { "$string" != "" } {
-            set foo [string first "\n" "$string"];
-            set len [string length "$string"];
+            set foo [string first "\n" "$string"]
+            set len [string length "$string"]
             if { $foo < [expr $len - 1] } {
-                set str [string range "$string" 0 $foo];
+                set str [string range "$string" 0 $foo]
                 if { [send_gdb "$str"] != "" } {
-                    global suppress_flag;
+                    global suppress_flag
 
                     if { ! $suppress_flag } {
-                        perror "Couldn't send $command to GDB.";
+                        perror "Couldn't send $command to GDB."
                     }
-                    fail "$message";
-                    return $result;
+                    fail "$message"
+                    return $result
                 }
                 gdb_expect 2 {
                     -re "\[\r\n\]" { }
                     timeout { }
                 }
-                set string [string range "$string" [expr $foo + 1] end];
+                set string [string range "$string" [expr $foo + 1] end]
             } else {
-                break;
+                break
             }
         }
         if { "$string" != "" } {
             if { [send_gdb "$string"] != "" } {
-                global suppress_flag;
+                global suppress_flag
 
                 if { ! $suppress_flag } {
-                    perror "Couldn't send $command to GDB.";
+                    perror "Couldn't send $command to GDB."
                 }
-                fail "$message";
-                return $result;
+                fail "$message"
+                return $result
             }
         }
     }
 
     if [info exists timeout] {
-        set tmt $timeout;
+        set tmt $timeout
     } else {
-        global timeout;
+        global timeout
         if [info exists timeout] {
-            set tmt $timeout;
+            set tmt $timeout
         } else {
-            set tmt 60;
+            set tmt 60
         }
     }
     if {$async} {
         # With $prompt_re "" there may come arbitrary asynchronous response
         # from the previous command, before or after $string_regex.
         set string_regex ".*"
     }
     verbose -log "Expecting: ^($string_regex\[\r\n\]+)?($pattern\[\r\n\]+$mi_gdb_prompt\[ \]*)"
     gdb_expect $tmt {
          -re "\\*\\*\\* DOSEXIT code.*" {
              if { $message != "" } {
-                 fail "$message";
+                 fail "$message"
              }
-             gdb_suppress_entire_file "GDB died";
-             return -1;
+             gdb_suppress_entire_file "GDB died"
+             return -1
          }
          -re "Ending remote debugging.*$mi_gdb_prompt\[ \]*$" {
             if ![isnative] then {
                 warning "Can`t communicate to remote target."
             }
             gdb_exit
             gdb_start
             set result -1
         }
          -re "^($string_regex\[\r\n\]+)?($pattern\[\r\n\]+$mi_gdb_prompt\[ \]*)" {
             # At this point, $expect_out(1,string) is the MI input command.
             # and $expect_out(2,string) is the MI output command.
             # If $expect_out(1,string) is "", then there was no MI input command here.
 
             # NOTE, there is no trailing anchor because with GDB/MI, 
             # asynchronous responses can happen at any point, causing more 
             # data to be available.  Normally an anchor is used to make 
             # sure the end of the output is matched, however, $mi_gdb_prompt 
             # is just as good of an anchor since mi_gdb_test is meant to 
             # match a single mi output command.  If a second GDB/MI output 
             # response is sent, it will be in the buffer for the next 
             # time mi_gdb_test is called.
             if ![string match "" $message] then {
                 pass "$message"
             }
             set result 0
         }
          -re "(${question_string})$" {
-            send_gdb "$response_string\n";
-            exp_continue;
+            send_gdb "$response_string\n"
+            exp_continue
         }
          -re "Undefined.* command:.*$mi_gdb_prompt\[ \]*$" {
             perror "Undefined command \"$command\"."
-            fail "$message"
+             fail "$message"
             set result 1
         }
          -re "Ambiguous command.*$mi_gdb_prompt\[ \]*$" {
             perror "\"$command\" is not a unique command name."
-            fail "$message"
+             fail "$message"
             set result 1
         }
          -re "$inferior_exited_re with code \[0-9\]+.*$mi_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.*$mi_gdb_prompt\[ \]*$" {
             if ![string match "" $message] then {
                 set errmsg "$message (the program is no longer running)"
             } else {
                 set errmsg "$command (the program is no longer running)"
             }
             fail "$errmsg"
             return -1
         }
          -re ".*$mi_gdb_prompt\[ \]*$" {
             if ![string match "" $message] then {
                 fail "$message"
             }
             set result 1
         }
          "<return>" {
             send_gdb "\n"
             perror "Window too small."
-            fail "$message"
+             fail "$message"
         }
          -re "\\(y or n\\) " {
             send_gdb "n\n"
             perror "Got interactive prompt."
-            fail "$message"
+             fail "$message"
         }
          eof {
              perror "Process no longer exists"
              if { $message != "" } {
                  fail "$message"
              }
              return -1
         }
          full_buffer {
             perror "internal buffer is full."
-            fail "$message"
+             fail "$message"
         }
         timeout {
             if ![string match "" $message] then {
                 fail "$message (timeout)"
             }
             set result 1
         }
     }
 
     # If the GDB output matched, compare the inferior output.
     if { $result == 0 } {
         if [ info exists ipattern ] {
             if { ![target_info exists gdb,noinferiorio] } {
-                global mi_inferior_spawn_id
-                expect {
-                    -i $mi_inferior_spawn_id -re "$ipattern" {
-                        pass "$message inferior output"
+                if { [target_info gdb_protocol] == "remote"
+                    || [target_info gdb_protocol] == "extended-remote"
+                    || [target_info protocol] == "sim"} {
+
+                    gdb_expect {
+                        -re "$ipattern" {
+                            pass "$message inferior output"
+                        }
+                        timeout {
+                            fail "$message inferior output (timeout)"
+                            set result 1
+                        }
                     }
-                    timeout {
-                        fail "$message inferior output (timeout)"
-                        set result 1
+                } else {
+                    global mi_inferior_spawn_id
+                    expect {
+                        -i $mi_inferior_spawn_id -re "$ipattern" {
+                            pass "$message inferior output"
+                        }
+                        timeout {
+                            fail "$message inferior output (timeout)"
+                            set result 1
+                        }
                     }
                 }
             } else {
                 unsupported "$message inferior output"
             }
-        }
+        }
     }
 
     return $result
 }
 
 #
 # MI run command.  (A modified version of gdb_run_cmd)
 #
 
 # In patterns, the newline sequence ``\r\n'' is matched explicitly as
@@ skipping 10 matching lines @@
 
     if {$use_mi_command} {
         set run_prefix "220-exec-"
         set run_match "220"
     } else {
         set run_prefix ""
         set run_match ""
     }
 
     if [target_info exists gdb_init_command] {
-        send_gdb "[target_info gdb_init_command]\n";
+        send_gdb "[target_info gdb_init_command]\n"
         gdb_expect 30 {
             -re "$mi_gdb_prompt$" { }
             default {
-                perror "gdb_init_command for target failed";
-                return -1;
+                perror "gdb_init_command for target failed"
+                return -1
             }
         }
     }
 
     if { [mi_gdb_target_load] < 0 } {
         return -1
     }
 
     if $use_gdb_stub {
         if [target_info exists gdb,do_reload_on_run] {
-            send_gdb "${run_prefix}continue\n";
+            send_gdb "${run_prefix}continue\n"
             gdb_expect 60 {
                 -re "${run_match}\\^running\[\r\n\]+\\*running,thread-id=\"\[^\"\]+\"\r\n$mi_gdb_prompt" {}
                 default {}
             }
-            return 0;
+            return 0
         }
 
         if [target_info exists gdb,start_symbol] {
-            set start [target_info gdb,start_symbol];
+            set start [target_info gdb,start_symbol]
         } else {
-            set start "start";
+            set start "start"
         }
 
         # HACK: Should either use 000-jump or fix the target code
         # to better handle RUN.
         send_gdb  "jump *$start\n"
         warning "Using CLI jump command, expect run-to-main FAIL"
         return 0
     }
 
     send_gdb "${run_prefix}run $args\n"
@@ skipping 65 matching lines @@
   global suppress_flag
   if { $suppress_flag } {
     return -1
   }
 
   global mi_gdb_prompt expect_out
   global hex decimal fullname_syntax
 
   set test "mi runto $func"
   mi_gdb_test "200-break-insert -t $func" \
-    "200\\^done,bkpt=\{number=\"\[0-9\]+\",type=\"breakpoint\",disp=\"del\",enabled=\"y\",addr=\"$hex\",func=\"$func\(\\\(.*\\\)\)?\",file=\".*\",line=\"\[0-9\]*\",times=\"0\",original-location=\".*\"\}" \
+    "200\\^done,bkpt=\{number=\"\[0-9\]+\",type=\"breakpoint\",disp=\"del\",enabled=\"y\",addr=\"$hex\",func=\"$func\(\\\(.*\\\)\)?\",file=\".*\",line=\"\[0-9\]*\",thread-groups=\\\[\"i1\"\\\],times=\"0\",original-location=\".*\"\}" \
     "breakpoint at $func"
 
   if {![regexp {number="[0-9]+"} $expect_out(buffer) str]
       || ![scan $str {number="%d"} bkptno]} {
     set bkptno {[0-9]+}
   }
 
   if {$run_or_continue == "run"} {
       if { [mi_run_cmd] < 0 } {
           return -1
@@ skipping 24 matching lines @@
   return [mi_step_to {.*} {.*} {.*} {.*} $test]
 }
 
 set async "unknown"
 
 proc mi_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
-        }
+        -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.  FILE may also match
 # filename of a file without debug info.  ARGS should not include [] the
 # list of argument is enclosed in, and other regular expressions should
 # not include quotes.
 # If EXTRA is a list of one element, it's the regular expression
 # for output expected right after *stopped, and before GDB prompt.
 # If EXTRA is a list of two elements, the first element is for
 # output right after *stopped, and the second element is output
 # right after reason field.  The regex after reason should not include
 # the comma separating it from the following fields.
-# 
+#
 # When we fail to match output at all, -1 is returned.  If FILE does
 # match and the target system has no debug info for FILE return 0.
 # 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 .* 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
     global breakpoint_re
 
     set after_stopped ""
     set after_reason ""
     if { [llength $extra] == 2 } {
-        set after_stopped [lindex $extra 0]
-        set after_reason [lindex $extra 1]
-        set after_reason "${after_reason},"
+        set after_stopped [lindex $extra 0]
+        set after_reason [lindex $extra 1]
+        set after_reason "${after_reason},"
     } elseif { [llength $extra] == 1 } {
-        set after_stopped [lindex $extra 0]
+        set after_stopped [lindex $extra 0]
     }
 
     if {$async} {
-        set prompt_re ""
+        set prompt_re ""
     } else {
-        set prompt_re "$mi_gdb_prompt$"
+        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
+        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 "\\*stopped,reason=\"exited-normally\"\r\n$prompt_re" {
-            pass "$test"
-          }
-          -re ".*$mi_gdb_prompt$" {fail "continue to end (2)"}
-          timeout {
-              fail "$test (unknown output after running)"
-          }
-        }
-        return
+        gdb_expect {
+            -re "\\*stopped,reason=\"exited-normally\"\r\n$prompt_re" {
+                pass "$test"
+            }
+            -re ".*$mi_gdb_prompt$" {fail "continue to end (2)"}
+            timeout {
+                fail "$test (unknown output after running)"
+            }
+        }
+        return
     }
 
     set args "\\\[$args\\\]"
 
     set bn ""
     if { $reason == "breakpoint-hit" } {
-        set bn {bkptno="[0-9]+",}
+        set bn {bkptno="[0-9]+",}
     } elseif { $reason == "solib-event" } {
         set bn ".*"
     }
 
     set r ""
     if { $reason != "" } {
-        set r "reason=\"$reason\","
+        set r "reason=\"$reason\","
     }
 
 
     set a $after_reason
 
     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\"|from=\"$file\")\}$after_stopped,thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re|$breakpoint_re)*$prompt_re"
     gdb_expect {
         -re "\\*stopped,${r}${a}${bn}frame=\{addr=\"$hex\",func=\"$func\",args=$args,(?:file=\"$any$file\",fullname=\"${fullname_syntax}$file\",line=\"($line)\"|from=\"$file\")\}$after_stopped,thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re|$breakpoint_re)*$prompt_re" {
             pass "$test"
             if {[array names expect_out "2,string"] != ""} {
                 return $expect_out(2,string)
             }
             # No debug info available but $file does match.
             return 0
         }
         -re "\\*stopped,${r}${a}${bn}frame=\{addr=\"$hex\",func=\"$any\",args=\[\\\[\{\]$any\[\\\]\}\],file=\"$any\",fullname=\"${fullname_syntax}$any\",line=\"\[0-9\]*\"\}$after_stopped,thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re|$breakpoint_re)*$prompt_re" {
-            verbose -log "got $expect_out(buffer)"
+            verbose -log "got $expect_out(buffer)"
             fail "$test (stopped at wrong place)"
             return -1
         }
         -re ".*\r\n$mi_gdb_prompt$" {
-            verbose -log "got $expect_out(buffer)"
+            verbose -log "got $expect_out(buffer)"
             fail "$test (unknown output after running)"
             return -1
         }
         timeout {
             fail "$test (timeout)"
             return -1
         }
-    }    
+    }
 }
 
 # 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;
+            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
         }
@@ skipping 60 matching lines @@
         "$test"
 }
 
 proc mi0_continue_to { bkptno func args file line test } {
     mi0_execute_to "exec-continue" "breakpoint-hit\",bkptno=\"$bkptno" \
         "$func" "$args" "$file" "$line" "" "$test"
 }
 
 # Creates a breakpoint and checks the reported fields are as expected
 proc mi_create_breakpoint { location number disp func file line address test } {
-    verbose -log "Expecting: 222\\^done,bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\"$file\",fullname=\".*\",line=\"$line\",times=\"0\",original-location=\".*\"\}"
+    verbose -log "Expecting: 222\\^done,bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\"$file\",fullname=\".*\",line=\"$line\",thread-groups=\\\[\".*\"\\\],times=\"0\",original-location=\".*\"\}"
     mi_gdb_test "222-break-insert $location" \
-        "222\\^done,bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\"$file\",fullname=\".*\",line=\"$line\",times=\"0\",original-location=\".*\"\}" \
-        $test
+        "222\\^done,bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\"$file\",fullname=\".*\",line=\"$line\",thread-groups=\\\[\".*\"\\\],times=\"0\",original-location=\".*\"\}" \
+        $test
 }
 
 proc mi_list_breakpoints { expected test } {
     set fullname ".*"
 
     set body ""
     set first 1
 
     foreach item $expected {
-        if {$first == 0} {
-            set body "$body,"
-            set first 0
-        }
-        set number [lindex $item 0]
-        set disp [lindex $item 1]
-        set func [lindex $item 2]
-        set file [lindex $item 3]
-        set line [lindex $item 4]
-        set address [lindex $item 5]
-        set body "${body}bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\".*$file\",${fullname},line=\"$line\",times=\"0\",original-location=\".*\"\}"
-        set first 0
+        if {$first == 0} {
+            set body "$body,"
+            set first 0
+        }
+        set number [lindex $item 0]
+        set disp [lindex $item 1]
+        set func [lindex $item 2]
+        set file [lindex $item 3]
+        set line [lindex $item 4]
+        set address [lindex $item 5]
+        set body "${body}bkpt=\{number=\"$number\",type=\"breakpoint\",disp=\"$disp\",enabled=\"y\",addr=\"$address\",func=\"$func\",file=\".*$file\",${fullname},line=\"$line\",thread-groups=\\\[\"i1\"\\\],times=\"0\",original-location=\".*\"\}"
+        set first 0
     }
 
     verbose -log "Expecting: 666\\\^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=\\\[$body\\\]\}"
     mi_gdb_test "666-break-list" \
-        "666\\\^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=\\\[$body\\\]\}" \
-        $test
+        "666\\\^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=\\\[$body\\\]\}" \
+        $test
 }
 
 # Creates varobj named NAME for EXPRESSION.
 # Name cannot be "-".
 proc mi_create_varobj { name expression testname } {
     mi_gdb_test "-var-create $name * $expression" \
-        "\\^done,name=\"$name\",numchild=\"\[0-9\]+\",value=\".*\",type=.*,has_more=\"0\"" \
-        $testname
+        "\\^done,name=\"$name\",numchild=\"\[0-9\]+\",value=\".*\",type=.*,has_more=\"0\"" \
+        $testname
 }
 
 proc mi_create_floating_varobj { name expression testname } {
     mi_gdb_test "-var-create $name @ $expression" \
-        "\\^done,name=\"$name\",numchild=\"\(-1\|\[0-9\]+\)\",value=\".*\",type=.*" \
-        $testname
+        "\\^done,name=\"$name\",numchild=\"\(-1\|\[0-9\]+\)\",value=\".*\",type=.*" \
+        $testname
 }
 
 
 # Same as mi_create_varobj, but also checks the reported type
 # of the varobj.
 proc mi_create_varobj_checked { name expression type testname } {
     mi_gdb_test "-var-create $name * $expression" \
-        "\\^done,name=\"$name\",numchild=\"\[0-9\]+\",value=\".*\",type=\"$type\".*" \
-        $testname
+        "\\^done,name=\"$name\",numchild=\"\[0-9\]+\",value=\".*\",type=\"$type\".*" \
+        $testname
 }
 
 # Same as mi_create_floating_varobj, but assumes the test is creating
 # a dynamic varobj that has children, so the value must be "{...}".
-proc mi_create_dynamic_varobj {name expression testname} {
+# The "has_more" attribute is checked.
+proc mi_create_dynamic_varobj {name expression has_more testname} {
     mi_gdb_test "-var-create $name @ $expression" \
-        "\\^done,name=\"$name\",numchild=\"\(-1\|\[0-9\]+\)\",value=\"{\\.\\.\\.}\",type=.*" \
-        $testname
+        "\\^done,name=\"$name\",numchild=\"0\",value=\"{\\.\\.\\.}\",type=.*,has_more=\"${has_more}\"" \
+        $testname
 }
 
-# Deletes the specified NAME. 
+# Deletes the specified NAME.
 proc mi_delete_varobj { name testname } {
     mi_gdb_test "-var-delete $name" \
-        "\\^done,ndeleted=.*" \
-        $testname
+        "\\^done,ndeleted=.*" \
+        $testname
 }
 
 # Updates varobj named NAME and checks that all varobjs in EXPECTED
 # are reported as updated, and no other varobj is updated.
 # Assumes that no varobj is out of scope and that no varobj changes
 # types.
 proc mi_varobj_update { name expected testname } {
     set er "\\^done,changelist=\\\["
     set first 1
     foreach item $expected {
-        set v "{name=\"$item\",in_scope=\"true\",type_changed=\"false\",has_more=\".\"}"
-        if {$first == 1} {
-            set er "$er$v"
-            set first 0
-        } else {
-            set er "$er,$v"
-        }
+        set v "{name=\"$item\",in_scope=\"true\",type_changed=\"false\",has_more=\".\"}"
+        if {$first == 1} {
+            set er "$er$v"
+            set first 0
+        } else {
+            set er "$er,$v"
+        }
     }
     set er "$er\\\]"
 
     verbose -log "Expecting: $er" 2
     mi_gdb_test "-var-update $name" $er $testname
 }
 
 proc mi_varobj_update_with_child_type_change { name child_name new_type new_children testname } {
     set v "{name=\"$child_name\",in_scope=\"true\",type_changed=\"true\",new_type=\"$new_type\",new_num_children=\"$new_children\",has_more=\".\"}"
     set er "\\^done,changelist=\\\[$v\\\]"
@@ skipping 72 matching lines @@
 
     mi_gdb_test "-var-evaluate-expression $name" \
         "\\^done,value=\"$value\"" \
         $testname
 }
 
 # Helper proc which constructs a child regexp for
 # mi_list_varobj_children and mi_varobj_update_dynamic.
 proc mi_child_regexp {children add_child} {
     set children_exp {}
-    set whatever "\"\[^\"\]+\""
 
     if {$add_child} {
         set pre "child="
     } else {
         set pre ""
     }
 
     foreach item $children {
 
-        set name [lindex $item 0]
-        set exp [lindex $item  1]
-        set numchild [lindex $item 2]
-        if {[llength $item] == 5} {
-            set type [lindex $item 3]
-            set value [lindex $item 4]
+        set name [lindex $item 0]
+        set exp [lindex $item  1]
+        set numchild [lindex $item 2]
+        if {[llength $item] == 5} {
+            set type [lindex $item 3]
+            set value [lindex $item 4]
 
-            lappend children_exp\
-                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",value=\"$value\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
-        } elseif {[llength $item] == 4} {
-            set type [lindex $item 3]
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",value=\"$value\",type=\"$type\"(,thread-id=\"\[0-9\]+\")?}"
+        } elseif {[llength $item] == 4} {
+            set type [lindex $item 3]
 
-            lappend children_exp\
-                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
-        } else {
-            lappend children_exp\
-                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\"(,thread-id=\"\[0-9\]+\")?}"
-        }
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",type=\"$type\"(,thread-id=\"\[0-9\]+\")?}"
+        } else {
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\"(,thread-id=\"\[0-9\]+\")?}"
+        }
     }
     return [join $children_exp ","]
 }
 
 # Check the results of the:
 #
 #   -var-list-children VARNAME
 #
 # command.  The CHILDREN parement should be a list of lists.
 # Each inner list can have either 3 or 4 elements, describing
@@ skipping 14 matching lines @@
 proc mi_list_varobj_children { varname children testname } {
     mi_list_varobj_children_range $varname "" "" [llength $children] $children \
       $testname
 }
 
 # Like mi_list_varobj_children, but sets a subrange.  NUMCHILDREN is
 # the total number of children.
 proc mi_list_varobj_children_range {varname from to numchildren children testname} {
     set options ""
     if {[llength $varname] == 2} {
-        set options [lindex $varname 1]
-        set varname [lindex $varname 0]
+        set options [lindex $varname 1]
+        set varname [lindex $varname 0]
     }
 
-    set whatever "\"\[^\"\]+\""
-
     set children_exp_j [mi_child_regexp $children 1]
     if {$numchildren} {
-        set expected "\\^done,numchild=\".*\",children=\\\[$children_exp_j.*\\\]"
+        set expected "\\^done,numchild=\".*\",children=\\\[$children_exp_j.*\\\]"
     } {
-        set expected "\\^done,numchild=\"0\""
+        set expected "\\^done,numchild=\"0\""
     }
 
     if {"$to" == ""} {
-        append expected ",has_more=\"0\""
+        append expected ",has_more=\"0\""
     } elseif {$to >= 0 && $numchildren > $to} {
-        append expected ",has_more=\"1\""
+        append expected ",has_more=\"1\""
     } else {
-        append expected ",has_more=\"0\""
+        append expected ",has_more=\"0\""
     }
 
     verbose -log "Expecting: $expected"
 
     mi_gdb_test "-var-list-children $options $varname $from $to" \
       $expected $testname
 }
 
 # Verifies that variable object VARNAME has NUMBER children,
 # where each one is named $VARNAME.<index-of-child> and has type TYPE.
 proc mi_list_array_varobj_children { varname number type testname } {
+    mi_list_array_varobj_children_with_index $varname $number 0 $type $testname
+}
+
+# Same as mi_list_array_varobj_children, but allowing to pass a start index
+# for an array.
+proc mi_list_array_varobj_children_with_index { varname number start_index \
+  type testname } {
     set t {}
+    set index $start_index
     for {set i 0} {$i < $number} {incr i} {
-        lappend t [list $varname.$i $i 0 $type]
+        lappend t [list $varname.$index $index 0 $type]
+        incr index
     }
     mi_list_varobj_children $varname $t $testname
 }
 
 # A list of two-element lists.  First element of each list is
 # a Tcl statement, and the second element is the line
 # number of source C file where the statement originates.
 set mi_autotest_data ""
 # The name of the source file for autotesting.
 set mi_autotest_source ""
 
 proc count_newlines { string } {
     return [regexp -all "\n" $string]
 }
 
 # Prepares for running inline tests in FILENAME.
 # See comments for mi_run_inline_test for detailed
 # explanation of the idea and syntax.
 proc mi_prepare_inline_tests { filename } {
 
     global srcdir
     global subdir
     global mi_autotest_source
     global mi_autotest_data
 
     set mi_autotest_data {}
 
     set mi_autotest_source $filename
-    
+
     if { ! [regexp "^/" "$filename"] } then {
         set filename "$srcdir/$subdir/$filename"
     }
 
     set chan [open $filename]
     set content [read $chan]
     set line_number 1
     while {1} {
-        set start [string first "/*:" $content]
-        if {$start != -1} {
-            set end [string first ":*/" $content]
-            if {$end == -1} {
-                error "Unterminated special comment in $filename"
-            }
-            
-            set prefix [string range $content 0 $start]
-            set prefix_newlines [count_newlines $prefix]
-            
-            set line_number [expr $line_number+$prefix_newlines]
-            set comment_line $line_number
+        set start [string first "/*:" $content]
+        if {$start != -1} {
+            set end [string first ":*/" $content]
+            if {$end == -1} {
+                error "Unterminated special comment in $filename"
+            }
 
-            set comment [string range $content [expr $start+3] [expr $end-1]]
+            set prefix [string range $content 0 $start]
+            set prefix_newlines [count_newlines $prefix]
 
-            set comment_newlines [count_newlines $comment]
-            set line_number [expr $line_number+$comment_newlines]
-            
-            set comment [string trim $comment]
-            set content [string range $content [expr $end+3] \
-                             [string length $content]]
-            lappend mi_autotest_data [list $comment $comment_line]
-        } else {        
-           break
-        }        
+            set line_number [expr $line_number+$prefix_newlines]
+            set comment_line $line_number
+
+            set comment [string range $content [expr $start+3] [expr $end-1]]
+
+            set comment_newlines [count_newlines $comment]
+            set line_number [expr $line_number+$comment_newlines]
+
+            set comment [string trim $comment]
+            set content [string range $content [expr $end+3] \
+                             [string length $content]]
+            lappend mi_autotest_data [list $comment $comment_line]
+        } else {
+            break
+        }
     }
     close $chan
 }
 
 # Helper to mi_run_inline_test below.
 # Return the list of all (statement,line_number) lists
 # that comprise TESTCASE.  The begin and end markers
 # are not included.
 proc mi_get_inline_test {testcase} {
 
     global mi_gdb_prompt
     global mi_autotest_data
     global mi_autotest_source
 
     set result {}
 
     set seen_begin 0
     set seen_end 0
     foreach l $mi_autotest_data {
 
-        set comment [lindex $l 0]
+        set comment [lindex $l 0]
 
-        if {$comment == "BEGIN: $testcase"} {
-            set seen_begin 1
-        } elseif {$comment == "END: $testcase"} {
-            set seen_end 1
-            break
-        } elseif {$seen_begin==1} {
-            lappend result $l
-        }
+        if {$comment == "BEGIN: $testcase"} {
+            set seen_begin 1
+        } elseif {$comment == "END: $testcase"} {
+            set seen_end 1
+            break
+        } elseif {$seen_begin==1} {
+            lappend result $l
+        }
     }
 
     if {$seen_begin == 0} {
-        error "Autotest $testcase not found" 
+        error "Autotest $testcase not found"
     }
 
     if {$seen_begin == 1 && $seen_end == 0} {
-        error "Missing end marker for test $testcase"
+        error "Missing end marker for test $testcase"
     }
 
     return $result
 }
 
 # Sets temporary breakpoint at LOCATION.
 proc mi_tbreak {location} {
 
     global mi_gdb_prompt
 
     mi_gdb_test "-break-insert -t $location" \
-        {\^done,bkpt=.*} \
-        "run to $location (set breakpoint)"    
+        {\^done,bkpt=.*} \
+        "run to $location (set breakpoint)"
 }
 
 # Send COMMAND that must be a command that resumes
 # the inferior (run/continue/next/etc) and consumes
 # the "^running" output from it.
 proc mi_send_resuming_command_raw {command test} {
 
     global mi_gdb_prompt
     global thread_selected_re
     global library_loaded_re
 
     send_gdb "$command\n"
     gdb_expect {
-        -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.
+        -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 "\\^error,msg=\"Displaced stepping is only supported in ARM mode\".*" {
-            unsupported "$test (Thumb mode)"
-            return -1
-        }
-        -re "\\^error,msg=.*" {
-            fail "$test (MI error)"
-            return -1
-        }
-        -re ".*${mi_gdb_prompt}" {
-            fail "$test (failed to resume)"
+        }
+        -re "\\^error,msg=\"Displaced stepping is only supported in ARM mode\".*" {
+            unsupported "$test (Thumb mode)"
             return -1
-        }
-        timeout {
+        }
+        -re "\\^error,msg=.*" {
+            fail "$test (MI error)"
+            return -1
+        }
+        -re ".*${mi_gdb_prompt}" {
+            fail "$test (failed to resume)"
+            return -1
+        }
+        timeout {
             fail "$test"
             return -1
-        }
+        }
     }
 }
 
 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
 # returns the line at which it.  Returns -1 if line cannot
 # be determined.
 # Does not check that the line is the same as requested.
 # The caller can check itself if required.
 proc mi_continue_to_line {location test} {
 
-    mi_tbreak $location   
+    mi_tbreak $location
     mi_send_resuming_command "exec-continue" "run to $location (exec-continue)"
     return [mi_get_stop_line $test]
 }
 
 # Wait until gdb prints the current line.
 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=\"(\[0-9\]*)\".*\r\n$prompt_re" {
-          return $expect_out(1,string)
+          return $expect_out(1,string)
       }
       -re ".*$mi_gdb_prompt" {
-          fail "wait for stop ($test)"
+          fail "wait for stop ($test)"
       }
       timeout {
-          fail "wait for stop ($test)"
+          fail "wait for stop ($test)"
       }
   }
 }
 
 # Run a MI test embedded in comments in a C file.
 # The C file should contain special comments in the following
 # three forms:
 #
 #    /*: BEGIN: testname :*/
 #    /*:  <Tcl statements> :*/
@@ skipping 29 matching lines @@
     global decimal
     global fullname_syntax
     global mi_autotest_source
 
     set commands [mi_get_inline_test $testcase]
 
     set first 1
     set line_now 1
 
     foreach c $commands {
-        set statements [lindex $c 0]
-        set line [lindex $c 1]
-        set line [expr $line-1]
+        set statements [lindex $c 0]
+        set line [lindex $c 1]
+        set line [expr $line-1]
 
-        # We want gdb to be stopped at the expression immediately
-        # before the comment.  If this is the first comment, the
-        # program is either not started yet or is in some random place,
-        # so we run it.  For further comments, we might be already
-        # standing at the right line. If not continue till the
-        # right line.
+        # We want gdb to be stopped at the expression immediately
+        # before the comment.  If this is the first comment, the
+        # program is either not started yet or is in some random place,
+        # so we run it.  For further comments, we might be already
+        # standing at the right line. If not continue till the
+        # right line.
 
-        if {$first==1} {
-            # Start the program afresh.
-            mi_tbreak "$mi_autotest_source:$line"
-            mi_run_cmd
-            set line_now [mi_get_stop_line "$testcase: step to $line"]
-            set first 0
-        } elseif {$line_now!=$line} {
-            set line_now [mi_continue_to_line "$mi_autotest_source:$line" "continue to $line"]
-        }
+        if {$first==1} {
+            # Start the program afresh.
+            mi_tbreak "$mi_autotest_source:$line"
+            mi_run_cmd
+            set line_now [mi_get_stop_line "$testcase: step to $line"]
+            set first 0
+        } elseif {$line_now!=$line} {
+            set line_now [mi_continue_to_line "$mi_autotest_source:$line" "continue to $line"]
+        }
 
-        if {$line_now!=$line} {
-            fail "$testcase: go to line $line"
-        }
+        if {$line_now!=$line} {
+            fail "$testcase: go to line $line"
+        }
 
-        # We're not at the statement right above the comment.
-        # Execute that statement so that the comment can test
-        # the state after the statement is executed.
+        # We're not at the statement right above the comment.
+        # Execute that statement so that the comment can test
+        # the state after the statement is executed.
 
-        # Single-step past the line.
-        if { [mi_send_resuming_command "exec-next" "$testcase: step over $line"] != 0 } {
+        # Single-step past the 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
-        # main 'exp' file has set up.  But it's not yet clear,
-        # will need more experience to be sure.
-        eval $statements
+        # We probably want to use 'uplevel' so that statements
+        # have direct access to global variables that the
+        # main 'exp' file has set up.  But it's not yet clear,
+        # will need more experience to be sure.
+        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"
@@ skipping 477 matching lines @@
       incr field_idx
     }
 
     return $children_list
   }
 
   # The main procedure to call the given CALLBACK on the elements of the
   # given varobj TREE.  See detailed explanation above.
   proc walk_tree {language tree callback} {
     global root
+    variable _root_idx
 
     if {[llength $tree] < 3} {
       error "tree does not contain enough elements"
     }
 
+    set _root_idx 0
+
     # Create root node and process the tree.
     array set root [list language $language]
     array set root [list obj_name "root"]
     array set root [list display_name "root"]
     array set root [list type "root"]
     array set root [list path_expr "root"]
     array set root [list parent "root"]
     array set root [list children [get_tree_children root $tree]]
 
     # Walk the tree
@@ skipping 30 matching lines @@
   ::varobj_tree::test_children_callback $variable
 }
 
 # Walk the variable object tree given by TREE, calling the specified
 # CALLBACK.  By default this uses mi_varobj_tree_test_children_callback.
 proc mi_walk_varobj_tree {language tree \
                               {callback \
                                    mi_varobj_tree_test_children_callback}} {
   ::varobj_tree::walk_tree $language $tree $callback
 }