-# Copyright 1999-2013 Free Software Foundation, Inc.
+# Copyright 1999-2016 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
# Test setup routines that work with the MI interpreter.
+load_lib gdb-utils.exp
+
# The variable mi_gdb_prompt is a regexp which matches the gdb mi prompt.
# Set it if it is not already set.
global mi_gdb_prompt
set mi_gdb_prompt "\[(\]gdb\[)\] \r\n"
}
-global mi_inferior_spawn_id
global mi_inferior_tty_name
set MIFLAGS "-i=mi"
global gdb_prompt
global mi_gdb_prompt
global timeout
- global gdb_spawn_id
+ global gdb_spawn_id inferior_spawn_id
global MIFLAGS
gdb_stop_suppressing_tests
}
}
- # 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]"]
if { $res < 0 || $res == "" } {
perror "Spawning $GDB failed."
return -1
}
}
- set gdb_spawn_id -1
+ set gdb_spawn_id $res
# FIXME: mi output does not go through pagers, so these can be removed.
# force the height to "unlimited", so no pagers get used
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.
+
+ # Create the new PTY for the inferior process.
if { $separate_inferior_pty } {
+ spawn -pty
+ global mi_inferior_tty_name
+ set inferior_spawn_id $spawn_id
+ set mi_inferior_tty_name $spawn_out(slave,name)
+
send_gdb "102-inferior-tty-set $mi_inferior_tty_name\n"
gdb_expect 10 {
-re ".*102\\\^done\r\n$mi_gdb_prompt$" {
}
}
+ if {![info exists inferior_spawn_id]} {
+ set inferior_spawn_id $gdb_spawn_id
+ }
+
mi_detect_async
return 0
if { [info procs gdbserver_gdb_load] != "" } {
mi_gdb_test "kill" ".*" ""
- set res [gdbserver_gdb_load]
+ if { [catch gdbserver_gdb_load res] == 1 } {
+ perror $res
+ return -1
+ }
set protocol [lindex $res 0]
set gdbport [lindex $res 1]
if { $result == 0 } {
if [ info exists ipattern ] {
if { ![target_info exists gdb,noinferiorio] } {
- 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
- }
+ global gdb_spawn_id inferior_spawn_id
+
+ set sid "$inferior_spawn_id $gdb_spawn_id"
+ gdb_expect {
+ -i "$sid" -re "$ipattern" {
+ pass "$message inferior output"
}
- } 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
- }
+ timeout {
+ fail "$message inferior output (timeout)"
+ set result 1
}
}
} else {
return $result
}
+# Collect output sent to the console output stream until UNTIL is
+# seen. UNTIL is a regular expression. MESSAGE is the message to be
+# printed in case of timeout.
+
+proc mi_gdb_expect_cli_output {until message} {
+
+ set output ""
+ gdb_expect {
+ -re "~\"(\[^\r\n\]+)\"\r\n" {
+ append output $expect_out(1,string)
+ exp_continue
+ }
+ -notransfer -re "$until" {
+ # Done
+ }
+ timeout {
+ fail "$message (timeout)"
+ return ""
+ }
+ }
+
+ return $output
+}
+
#
# MI run command. (A modified version of gdb_run_cmd)
#
# In patterns, the newline sequence ``\r\n'' is matched explicitly as
# ``.*$'' could swallow up output that we attempt to match elsewhere.
+# Send the command to run the test program.
+#
+# If USE_MI_COMMAND is true, the "-exec-run" command is used.
+# Otherwise, the "run" (CLI) command is used. If the global USE_GDB_STUB is
+# true, -exec-continue and continue are used instead of their run counterparts.
+#
+# ARGS is passed as argument to the command used to run the test program.
+# Beware that arguments to "-exec-run" do not have the same semantics as
+# arguments to the "run" command, so USE_MI_COMMAND influences the meaning
+# of ARGS. If USE_MI_COMMAND is true, they are arguments to -exec-run.
+# If USE_MI_COMMAND is false, they are effectively arguments passed
+# to the test program. If the global USE_GDB_STUB is true, ARGS is not used.
proc mi_run_cmd_full {use_mi_command args} {
global suppress_flag
if { $suppress_flag } {
set run_match ""
}
- if [target_info exists gdb_init_command] {
- send_gdb "[target_info gdb_init_command]\n"
+ foreach command [gdb_init_commands] {
+ send_gdb "$command\n"
gdb_expect 30 {
-re "$mi_gdb_prompt$" { }
default {
send_gdb "${run_prefix}continue\n"
gdb_expect 60 {
-re "${run_match}\\^running\[\r\n\]+\\*running,thread-id=\"\[^\"\]+\"\r\n$mi_gdb_prompt" {}
+ -re "${run_match}\\^error.*$mi_gdb_prompt" {return -1}
default {}
}
return 0
# to better handle RUN.
send_gdb "jump *$start\n"
warning "Using CLI jump command, expect run-to-main FAIL"
+ gdb_expect {
+ -re "${run_match}&\"jump \\*${start}\\n\"\[\r\n\]+~\"Continuing at 0x\[0-9A-Fa-f\]+\\n.\"\[\r\n\]+\^running\[\r\n\]+\\*running,thread-id=\"\[^\"\]+\"\r\n${mi_gdb_prompt}" {}
+ }
return 0
}
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\]*\",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]+}
- }
+ set bp [mi_make_breakpoint -type breakpoint -disp del \
+ -func $func\(\\\(.*\\\)\)?]
+ mi_gdb_test "200-break-insert -t $func" "200\\^done,$bp" \
+ "breakpoint at $func"
if {$run_or_continue == "run"} {
if { [mi_run_cmd] < 0 } {
global async
global mi_gdb_prompt
- send_gdb "show target-async\n"
+ send_gdb "show mi-async\n"
gdb_expect {
- -re ".*Controlling the inferior in asynchronous mode is on...*$mi_gdb_prompt$" {
+ -re "asynchronous mode is on...*$mi_gdb_prompt$" {
set async 1
}
-re ".*$mi_gdb_prompt$" {
global thread_selected_re
global breakpoint_re
+ set any "\[^\n\]*"
+
set after_stopped ""
set after_reason ""
if { [llength $extra] == 2 } {
pass "$test"
}
timeout {
- fail "$test (unknown output after running)"
+ fail "$test (timeout)"
}
}
return
}
-re ".*$mi_gdb_prompt$" {fail "continue to end (2)"}
timeout {
- fail "$test (unknown output after running)"
+ fail "$test (timeout)"
+ }
+ }
+ return
+ }
+ if { $reason == "exited" } {
+ gdb_expect {
+ -re "\\*stopped,reason=\"exited\",exit-code=\"\[0-7\]+\"\r\n$prompt_re" {
+ pass "$test"
+ }
+ -re ".*$mi_gdb_prompt$" {
+ fail "$test (inferior not stopped)"
+ }
+ timeout {
+ fail "$test (timeout)"
+ }
+ }
+ return
+ }
+
+ if { $reason == "solib-event" } {
+ set pattern "\\*stopped,reason=\"solib-event\",thread-id=\"$decimal\",stopped-threads=$any\r\n($thread_selected_re|$breakpoint_re)*$prompt_re"
+ verbose -log "mi_expect_stop: expecting: $pattern"
+ gdb_expect {
+ -re "$pattern" {
+ pass "$test"
+ }
+ timeout {
+ fail "$test (timeout)"
}
}
return
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" {
set prompt_re "$mi_gdb_prompt$"
}
- set r "reason=\"signal-received\",signal-name=\"0\",signal-meaning=\"Signal 0\""
-
+ set r_nonstop "reason=\"signal-received\",signal-name=\"0\",signal-meaning=\"Signal 0\""
+ set r_allstop "reason=\"signal-received\",signal-name=\"SIGINT\",signal-meaning=\"Interrupt\""
+ set r "(${r_nonstop}|${r_allstop})"
set any "\[^\n\]*"
# A signal can land anywhere, just ignore the location
"$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\",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
-}
-
-proc mi_list_breakpoints { expected test } {
- set fullname ".*"
+# Creates a breakpoint and checks the reported fields are as expected.
+# This procedure takes the same options as mi_make_breakpoint and
+# returns the breakpoint regexp from that procedure.
- 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\",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
+proc mi_create_breakpoint {location test args} {
+ set bp [eval mi_make_breakpoint $args]
+ mi_gdb_test "222-break-insert $location" "222\\^done,$bp" $test
+ return $bp
}
# Creates varobj named NAME for EXPRESSION.
# 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
}
}
foreach file $args {
- gdb_download [shlib_target_file $file]
+ gdb_remote_download target [shlib_target_file $file]
}
# Even if the target supplies full paths for shared libraries,
mi_gdb_test "set solib-search-path [file dirname [lindex $args 0]]" "\^done" ""
}
-proc mi_reverse_list { list } {
- if { [llength $list] <= 1 } {
- return $list
- }
- set tail [lrange $list 1 [llength $list]]
- set rtail [mi_reverse_list $tail]
- lappend rtail [lindex $list 0]
- return $rtail
-}
-
-proc mi_check_thread_states { xstates test } {
+proc mi_check_thread_states { states test } {
global expect_out
- set states [mi_reverse_list $xstates]
set pattern ".*\\^done,threads=\\\["
foreach s $states {
set pattern "${pattern}(.*)state=\"$s\""
mi_varobj_tree_test_children_callback}} {
::varobj_tree::walk_tree $language $tree $callback
}
+
+# Build a list of key-value pairs given by the list ATTR_LIST. Flatten
+# this list using the optional JOINER, a comma by default.
+#
+# The list must contain an even number of elements, which are the key-value
+# pairs. Each value will be surrounded by quotes, according to the grammar,
+# except if the value starts with \[ or \{, when the quotes will be omitted.
+#
+# Example: mi_build_kv_pairs {a b c d e f g \[.*\]}
+# returns a=\"b\",c=\"d\",e=\"f\",g=\[.*\]
+proc mi_build_kv_pairs {attr_list {joiner ,}} {
+ set l {}
+ foreach {var value} $attr_list {
+ if {[string range $value 0 1] == "\\\["
+ || [string range $value 0 1] == "\\\{"} {
+ lappend l "$var=$value"
+ } else {
+ lappend l "$var=\"$value\""
+ }
+ }
+ return "[join $l $joiner]"
+}
+
+# Construct a breakpoint regexp. This may be used to test the output of
+# -break-insert, -dprintf-insert, or -break-info.
+#
+# All arguments for the breakpoint may be specified using the options
+# number, type, disp, enabled, addr, func, file, fullanme, line,
+# thread-groups, cond, evaluated-by, times, ignore, script,
+# and original-location.
+#
+# Only if -script and -ignore are given will they appear in the output.
+# Otherwise, this procedure will skip them using ".*".
+#
+# Example: mi_make_breakpoint -number 2 -file ".*/myfile.c" -line 3
+# will return the breakpoint:
+# bkpt={number="2",type=".*",disp=".*",enabled=".*",addr=".*",func=".*",
+# file=".*/myfile.c",fullname=".*",line="3",thread-groups=\[.*\],
+# times="0".*original-location=".*"}
+
+proc mi_make_breakpoint {args} {
+ parse_args {{number .*} {type .*} {disp .*} {enabled .*} {addr .*}
+ {func .*} {file .*} {fullname .*} {line .*}
+ {thread-groups \\\[.*\\\]} {times .*} {ignore 0}
+ {script ""} {original-location .*} {cond ""} {evaluated-by ""}}
+
+ set attr_list {}
+ foreach attr [list number type disp enabled addr func file \
+ fullname line thread-groups] {
+ lappend attr_list $attr [set $attr]
+ }
+
+ set result "bkpt={[mi_build_kv_pairs $attr_list]"
+
+ # There are always exceptions.
+
+ # If COND is not preset, do not output it.
+ if {[string length $cond] > 0} {
+ append result ","
+ append result [mi_build_kv_pairs [list "cond" $cond]]
+
+ # When running on a remote, GDB may output who is evaluating
+ # breakpoint conditions.
+ if {[string length ${evaluated-by}] > 0} {
+ append result [mi_build_kv_pairs \
+ [list "evaluated-by" ${evaluated-by}]]
+ } else {
+ append result {(,evaluated-by=".*")?}
+ }
+ }
+
+ append result ","
+ append result [mi_build_kv_pairs [list "times" $times]]
+
+ # If SCRIPT and IGNORE are not present, do not output them.
+ if {$ignore != 0} {
+ append result ","
+ append result [mi_build_kv_pairs [list "ignore" $ignore]]
+ append result ","
+ }
+ if {[string length $script] > 0} {
+ append result ","
+ append result [mi_build_kv_pairs [list "script" $script]]
+ append result ","
+ } else {
+ # Allow anything up until the next "official"/required attribute.
+ # This pattern skips over script/ignore if matches on those
+ # were not specifically required by the caller.
+ append result ".*"
+ }
+ append result [mi_build_kv_pairs \
+ [list "original-location" ${original-location}]]
+ append result "}"
+ return $result
+}
+
+# Build a breakpoint table regexp given the list of breakpoints in `bp_list',
+# constructed by mi_make_breakpoint.
+#
+# Example: Construct a breakpoint table where the only attributes we
+# test for are the existence of three breakpoints numbered 1, 2, and 3.
+#
+# set bps {}
+# lappend bps [mi_make_breakpoint -number 1]
+# lappend bps [mi_make_breakpoint -number 2]
+# lappned bps [mi_make_breakpoint -number 3]
+# mi_make_breakpoint_table $bps
+# will return (abbreviated for clarity):
+# BreakpointTable={nr_rows="3",nr_cols="6",hdr=[{width=".*",...} ...],
+# body=[bkpt={number="1",...},bkpt={number="2",...},bkpt={number="3",...}]}
+
+proc mi_make_breakpoint_table {bp_list} {
+ # Build header -- assume a standard header for all breakpoint tables.
+ set hl {}
+ foreach {nm hdr} [list number Num type Type disp Disp enabled Enb \
+ addr Address what What] {
+ # The elements here are the MI table headers, which have the
+ # format:
+ # {width="7",alignment="-1",col_name="number",colhdr="Num"}
+ lappend hl "{[mi_build_kv_pairs [list width .* alignment .* \
+ col_name $nm colhdr $hdr]]}"
+ }
+ set header "hdr=\\\[[join $hl ,]\\\]"
+
+ # The caller has implicitly supplied the number of columns and rows.
+ set nc [llength $hl]
+ set nr [llength $bp_list]
+
+ # Build body -- mi_make_breakpoint has done most of the work.
+ set body "body=\\\[[join $bp_list ,]\\\]"
+
+ # Assemble the final regexp.
+ return "BreakpointTable={nr_rows=\"$nr\",nr_cols=\"$nc\",$header,$body}"
+}
+
+# Return a 1 for configurations that do not support Python scripting.
+# Note: This also sets various globals that specify which version of Python
+# is in use. See skip_python_tests_prompt.
+
+proc mi_skip_python_tests {} {
+ global mi_gdb_prompt
+ return [skip_python_tests_prompt "$mi_gdb_prompt$"]
+}
+
+# Check whether we're testing with the remote or extended-remote
+# targets.
+
+proc mi_is_target_remote {} {
+ global mi_gdb_prompt
+
+ return [gdb_is_target_remote_prompt "$mi_gdb_prompt"]
+}
projects / deliverable / binutils-gdb.git / blobdiff