mirror of
https://github.com/espressif/binutils-gdb.git
synced 2025-06-23 03:29:47 +08:00
Fix format issues in lib/mi-support.exp
There are some format issues in lib/mi-support.exp, such as using spaces instead of tab and trailing spaces. This patch is to fix them. gdb/testsuite: 2013-11-19 Yao Qi <yao@codesourcery.com> * lib/mi-support.exp: Fix format.
This commit is contained in:
@ -1,3 +1,7 @@
|
||||
2013-11-19 Yao Qi <yao@codesourcery.com>
|
||||
|
||||
* lib/mi-support.exp: Fix format.
|
||||
|
||||
2013-11-19 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* gdb.ada/py_range: New testcase.
|
||||
|
@ -69,10 +69,10 @@ proc mi_uncatched_gdb_exit {} {
|
||||
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 { }
|
||||
}
|
||||
@ -156,9 +156,9 @@ proc default_mi_gdb_start { args } {
|
||||
# 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."
|
||||
}
|
||||
@ -167,9 +167,9 @@ proc default_mi_gdb_start { args } {
|
||||
# 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."
|
||||
}
|
||||
@ -221,9 +221,9 @@ proc default_mi_gdb_start { args } {
|
||||
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
|
||||
@ -254,9 +254,9 @@ proc mi_delete_breakpoints {} {
|
||||
-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 }
|
||||
}
|
||||
@ -295,22 +295,22 @@ proc mi_gdb_reinitialize_dir { subdir } {
|
||||
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)"}
|
||||
}
|
||||
}
|
||||
|
||||
@ -320,7 +320,7 @@ proc mi_gdb_reinitialize_dir { subdir } {
|
||||
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."
|
||||
}
|
||||
@ -342,7 +342,7 @@ proc mi_gdb_target_cmd { targetname serialport } {
|
||||
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"
|
||||
@ -412,47 +412,47 @@ proc mi_gdb_file_cmd { arg } {
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -700,12 +700,12 @@ proc mi_gdb_test { args } {
|
||||
}
|
||||
-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\[ \]*$" {
|
||||
@ -735,12 +735,12 @@ proc mi_gdb_test { args } {
|
||||
"<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"
|
||||
@ -751,7 +751,7 @@ proc mi_gdb_test { args } {
|
||||
}
|
||||
full_buffer {
|
||||
perror "internal buffer is full."
|
||||
fail "$message"
|
||||
fail "$message"
|
||||
}
|
||||
timeout {
|
||||
if ![string match "" $message] then {
|
||||
@ -984,15 +984,15 @@ proc mi_detect_async {} {
|
||||
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
|
||||
}
|
||||
@ -1031,57 +1031,57 @@ proc mi_expect_stop { reason func args file line extra test } {
|
||||
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\","
|
||||
}
|
||||
|
||||
|
||||
@ -1100,12 +1100,12 @@ proc mi_expect_stop { reason func args file line extra test } {
|
||||
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
|
||||
}
|
||||
@ -1221,8 +1221,8 @@ proc mi0_continue_to { bkptno func args file line test } {
|
||||
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 } {
|
||||
@ -1232,38 +1232,38 @@ 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
|
||||
}
|
||||
|
||||
|
||||
@ -1271,23 +1271,23 @@ proc mi_create_floating_varobj { name expression 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.
|
||||
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
|
||||
@ -1298,13 +1298,13 @@ 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\\\]"
|
||||
|
||||
@ -1406,24 +1406,24 @@ proc mi_child_regexp {children add_child} {
|
||||
|
||||
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 ","]
|
||||
}
|
||||
@ -1458,23 +1458,23 @@ proc mi_list_varobj_children { varname children testname } {
|
||||
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"
|
||||
@ -1488,7 +1488,7 @@ proc mi_list_varobj_children_range {varname from to numchildren children testnam
|
||||
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
|
||||
}
|
||||
@ -1526,31 +1526,31 @@ proc mi_prepare_inline_tests { 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 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 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 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 [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_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 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
|
||||
}
|
||||
@ -1571,24 +1571,24 @@ proc mi_get_inline_test {testcase} {
|
||||
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
|
||||
@ -1600,8 +1600,8 @@ 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
|
||||
@ -1615,34 +1615,34 @@ proc mi_send_resuming_command_raw {command test} {
|
||||
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -1678,13 +1678,13 @@ proc 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)"
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1734,46 +1734,46 @@ proc mi_run_inline_test { testcase } {
|
||||
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
|
||||
}
|
||||
}
|
||||
|
||||
|
Reference in New Issue
Block a user