send_gdb "y\n"
exp_continue
}
- -re "Undefined command.*$gdb_prompt $" {
- send_gdb "quit\n"
+ -re "Undefined command.*$gdb_prompt $" {
+ send_gdb "quit\n"
exp_continue
- }
+ }
-re "DOSEXIT code" { }
default { }
}
# 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."
}
# 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."
}
# 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 {
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
#
# Overridable function. You can override this function in your
# baseboard file.
-#
+#
proc mi_gdb_start { args } {
return [default_mi_gdb_start $args]
}
-re "Delete all breakpoints.*y or 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 }
}
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)"}
}
}
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."
}
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 "Set target to $targetname"
return 0
}
- -re "Connected to.*$mi_gdb_prompt$" {
+ -re "Connected to.*$mi_gdb_prompt$" {
verbose "Set target to $targetname"
return 0
}
# 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 "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 "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 "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
+ }
}
}
# 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
}
-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\[ \]*$" {
"<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"
}
full_buffer {
perror "internal buffer is full."
- fail "$message"
+ fail "$message"
}
timeout {
if ![string match "" $message] then {
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
}
# 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
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\","
}
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
}
fail "$test (timeout)"
return -1
}
- }
+ }
}
# Wait for MI *stopped notification related to an interrupt request to
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\",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\",thread-groups=\\\[\".*\"\\\],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 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\",thread-groups=\\\[\"i1\"\\\],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
}
# 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} {
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
}
-# 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
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\\\]"
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\]+\")?}"
- }
+ 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 ","]
}
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 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"
proc mi_list_array_varobj_children { varname number type testname } {
set t {}
for {set i 0} {$i < $number} {incr i} {
- lappend t [list $varname.$i $i 0 $type]
+ lappend t [list $varname.$i $i 0 $type]
}
mi_list_varobj_children $varname $t $testname
}
set mi_autotest_data {}
set mi_autotest_source $filename
-
+
if { ! [regexp "^/" "$filename"] } then {
set filename "$srcdir/$subdir/$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 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
- }
+ 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 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
}
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
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
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
+ }
+ -re "\\^error,msg=.*" {
+ fail "$test (MI error)"
+ return -1
+ }
+ -re ".*${mi_gdb_prompt}" {
+ fail "$test (failed to resume)"
return -1
- }
- timeout {
+ }
+ timeout {
fail "$test"
return -1
- }
+ }
}
}
# 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]
}
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)"
}
}
}
set line_now 1
foreach c $commands {
- 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.
-
- 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"
- }
-
- # 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 } {
+ 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.
+
+ 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"
+ }
+
+ # 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 } {
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
}
}
projects / binutils-gdb.git / commitdiff