-# Copyright 1999, 2000, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+# Copyright 1999, 2000, 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010
# Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
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$" {
+ -re "47\\^connected.*$mi_gdb_prompt" {
verbose "Set target to $targetname";
return 0;
}
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.";
}
global loadfile
global GDB
global mi_gdb_prompt
- upvar timeout timeout
+
+ if [target_info exists gdb_load_timeout] {
+ set loadtimeout [target_info gdb_load_timeout]
+ } else {
+ set loadtimeout 1600
+ }
if { [info procs gdbserver_gdb_load] != "" } {
mi_gdb_test "kill" ".*" ""
-re ".*$mi_gdb_prompt$"
}
send_target_sid
- gdb_expect 60 {
+ gdb_expect $loadtimeout {
-re "\\^done.*$mi_gdb_prompt$" {
}
timeout {
- perror "Unable to connect to SID target"
+ perror "Unable to connect to SID target (timeout)"
return -1
}
}
send_gdb "48-target-download\n"
- gdb_expect 10 {
+ gdb_expect $loadtimeout {
-re "48\\^done.*$mi_gdb_prompt$" {
}
timeout {
- perror "Unable to download to SID target"
+ perror "Unable to download to SID target (timeout)"
return -1
}
}
} elseif { [target_info protocol] == "sim" } {
# For the simulator, just connect to it directly.
send_gdb "47-target-select sim\n"
- gdb_expect 10 {
+ gdb_expect $loadtimeout {
-re "47\\^connected.*$mi_gdb_prompt$" {
}
timeout {
- perror "Unable to select sim target"
+ perror "Unable to select sim target (timeout)"
return -1
}
}
send_gdb "48-target-download\n"
- gdb_expect 10 {
+ gdb_expect $loadtimeout {
-re "48\\^done.*$mi_gdb_prompt$" {
}
timeout {
- perror "Unable to download to sim target"
+ perror "Unable to download to sim target (timeout)"
return -1
}
}
return -1
}
send_gdb "48-target-download\n"
- gdb_expect 10 {
+ gdb_expect $loadtimeout {
-re "48\\^done.*$mi_gdb_prompt$" {
}
timeout {
- perror "Unable to download to remote target"
+ perror "Unable to download to remote target (timeout)"
return -1
}
}
-re "$mi_gdb_prompt$" { }
default {
perror "gdb_init_command for target failed";
- return;
+ return -1;
}
}
}
if { [mi_gdb_target_load] < 0 } {
- return
+ return -1
}
if [target_info exists use_gdb_stub] {
-re "220\\^running\[\r\n\]+\\*running,thread-id=\"\[^\"\]+\"\r\n$mi_gdb_prompt" {}
default {}
}
- return;
+ return 0;
}
if [target_info exists gdb,start_symbol] {
# to better handle RUN.
send_gdb "jump *$start\n"
warning "Using CLI jump command, expect run-to-main FAIL"
- return
+ return 0
}
send_gdb "220-exec-run $args\n"
gdb_expect {
-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}" {
}
+ -re "\\^error,msg=\"The target does not support running in non-stop mode.\"" {
+ unsupported "Non-stop mode not supported"
+ return -1
+ }
timeout {
perror "Unable to start target"
- return
+ return -1
}
}
# NOTE: Shortly after this there will be a ``000*stopped,...(gdb)''
+
+ return 0
}
#
}
if {$run_or_continue == "run"} {
- mi_run_cmd
+ if { [mi_run_cmd] < 0 } {
+ return -1
+ }
} else {
mi_send_resuming_command "exec-continue" "$test"
}
}
proc mi_runto {func} {
- mi_runto_helper $func "run"
+ return [mi_runto_helper $func "run"]
}
# Next to the next statement
pass "$test"
return $expect_out(2,string)
}
- -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" {
+ -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$prompt_re" {
verbose -log "got $expect_out(buffer)"
fail "$test (stopped at wrong place)"
return -1
set body ""
set first 1
- foreach item $children {
+ foreach item $expected {
if {$first == 0} {
set body "$body,"
+ set first 0
}
- set number disp func file line address
set number [lindex $item 0]
set disp [lindex $item 1]
set func [lindex $item 2]
- set line [lindex $item 3]
- set address [lindex $item 4]
- 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 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
}
- verbose -log "Expecint: 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\\\]\}" \
+ 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
# 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=.*" \
+ "\\^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=\"\[0-9\]+\",value=\".*\",type=.*" \
+ "\\^done,name=\"$name\",numchild=\"\(-1\|\[0-9\]+\)\",value=\".*\",type=.*" \
$testname
}
$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} {
+ mi_gdb_test "-var-create $name @ $expression" \
+ "\\^done,name=\"$name\",numchild=\"\(-1\|\[0-9\]+\)\",value=\"{\\.\\.\\.}\",type=.*" \
+ $testname
+}
+
# Deletes the specified NAME.
proc mi_delete_varobj { name testname } {
mi_gdb_test "-var-delete $name" \
set er "\\^done,changelist=\\\["
set first 1
foreach item $expected {
- set v "{name=\"$item\",in_scope=\"true\",type_changed=\"false\"}"
+ set v "{name=\"$item\",in_scope=\"true\",type_changed=\"false\",has_more=\".\"}"
if {$first == 1} {
set er "$er$v"
set first 0
}
proc mi_varobj_update_with_type_change { name new_type new_children testname } {
- set v "{name=\"$name\",in_scope=\"true\",type_changed=\"true\",new_type=\"$new_type\",new_num_children=\"$new_children\"}"
+ set v "{name=\"$name\",in_scope=\"true\",type_changed=\"true\",new_type=\"$new_type\",new_num_children=\"$new_children\",has_more=\".\"}"
set er "\\^done,changelist=\\\[$v\\\]"
verbose -log "Expecting: $er"
mi_gdb_test "-var-update $name" $er $testname
}
+# A helper that turns a key/value list into a regular expression
+# matching some MI output.
+proc mi_varobj_update_kv_helper {list} {
+ set first 1
+ set rx ""
+ foreach {key value} $list {
+ if {!$first} {
+ append rx ,
+ }
+ set first 0
+ if {$key == "new_children"} {
+ append rx "$key=\\\[$value\\\]"
+ } else {
+ append rx "$key=\"$value\""
+ }
+ }
+ return $rx
+}
+
+# A helper for mi_varobj_update_dynamic that computes a match
+# expression given a child list.
+proc mi_varobj_update_dynamic_helper {children} {
+ set crx ""
+
+ set first 1
+ foreach child $children {
+ if {!$first} {
+ append crx ,
+ }
+ set first 0
+ append crx "{"
+ append crx [mi_varobj_update_kv_helper $child]
+ append crx "}"
+ }
+
+ return $crx
+}
+
+# Update a dynamic varobj named NAME. CHILDREN is a list of children
+# that have been updated; NEW_CHILDREN is a list of children that were
+# added to the primary varobj. Each child is a list of key/value
+# pairs that are expected. SELF is a key/value list holding
+# information about the varobj itself. TESTNAME is the name of the
+# test.
+proc mi_varobj_update_dynamic {name testname self children new_children} {
+ if {[llength $new_children]} {
+ set newrx [mi_varobj_update_dynamic_helper $new_children]
+ lappend self new_children $newrx
+ }
+ set selfrx [mi_varobj_update_kv_helper $self]
+ set crx [mi_varobj_update_dynamic_helper $children]
+
+ set er "\\^done,changelist=\\\[\{name=\"$name\",in_scope=\"true\""
+ append er ",$selfrx\}"
+ if {"$crx" != ""} {
+ append er ",$crx"
+ }
+ append er "\\\]"
+
+ verbose -log "Expecting: $er"
+ mi_gdb_test "-var-update $name" $er $testname
+}
+
proc mi_check_varobj_value { name value testname } {
mi_gdb_test "-var-evaluate-expression $name" \
$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]
+
+ 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\]+\")?}"
+ }
+ }
+ return [join $children_exp ","]
+}
+
# Check the results of the:
#
# -var-list-children VARNAME
# have no value.
#
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 numchildren [llength $children]
- set children_exp {}
set whatever "\"\[^\"\]+\""
- 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]
-
- lappend children_exp\
- "child={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\
- "child={name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
- } else {
- lappend children_exp\
- "child={name=\"$name\",exp=\"$exp\",numchild=\"$numchild\"(,thread-id=\"\[0-9\]+\")?}"
- }
- }
- set children_exp_j [join $children_exp ","]
+ set children_exp_j [mi_child_regexp $children 1]
if {$numchildren} {
set expected "\\^done,numchild=\".*\",children=\\\[$children_exp_j.*\\\]"
} {
set expected "\\^done,numchild=\"0\""
}
+ if {"$to" == ""} {
+ append expected ",has_more=\"0\""
+ } elseif {$to >= 0 && $numchildren > $to} {
+ append expected ",has_more=\"1\""
+ } else {
+ append expected ",has_more=\"0\""
+ }
+
verbose -log "Expecting: $expected"
- mi_gdb_test "-var-list-children $options $varname" $expected $testname
+ mi_gdb_test "-var-list-children $options $varname $from $to" \
+ $expected $testname
}
# Verifies that variable object VARNAME has NUMBER children,
# as real failure.
return 0
}
- -re ".*${mi_gdb_prompt}" {
- fail "$test (failed to resume)"
- return -1
+ -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)"
+ return -1
+ }
timeout {
fail "$test"
return -1
}
}
+# Download shared libraries to the target.
proc mi_load_shlibs { args } {
if {![is_remote target]} {
return
}
foreach file $args {
- gdb_download $file
+ gdb_download [shlib_target_file $file]
}
# Even if the target supplies full paths for shared libraries,
proc mi_check_thread_states { xstates test } {
global expect_out
set states [mi_reverse_list $xstates]
- set pattern "\\^done,threads=\\\["
+ set pattern ".*\\^done,threads=\\\["
foreach s $states {
set pattern "${pattern}(.*)state=\"$s\""
}
- set pattern "$pattern\\\}\\\].*"
+ set pattern "${pattern}(,core=\"\[0-9\]*\")?\\\}\\\].*"
verbose -log "expecting: $pattern"
mi_gdb_test "-thread-info" $pattern $test
}
+
+# Return a list of MI features supported by this gdb.
+proc mi_get_features {} {
+ global expect_out mi_gdb_prompt
+
+ send_gdb "-list-features\n"
+
+ gdb_expect {
+ -re "\\^done,features=\\\[(.*)\\\]\r\n$mi_gdb_prompt$" {
+ regsub -all -- \" $expect_out(1,string) "" features
+ return [split $features ,]
+ }
+ -re ".*\r\n$mi_gdb_prompt$" {
+ verbose -log "got $expect_out(buffer)"
+ return ""
+ }
+ timeout {
+ verbose -log "timeout in mi_gdb_prompt"
+ return ""
+ }
+ }
+}
projects / deliverable / binutils-gdb.git / blobdiff