-# Copyright 1999-2014 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 } {
if {$use_mi_command} {
set run_prefix "220-exec-"
set run_match "220"
- set set_args_cmd "-exec-arguments"
} else {
set run_prefix ""
set run_match ""
- set set_args_cmd "set args"
}
- 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 {
# to better handle RUN.
send_gdb "jump *$start\n"
warning "Using CLI jump command, expect run-to-main FAIL"
- return 0
- }
-
- send_gdb "${set_args_cmd} $args\n"
- gdb_expect {
- -re "$mi_gdb_prompt$" { }
- default {
- perror "settings args failed"
- return -1
+ 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
}
- send_gdb "${run_prefix}run\n"
+ send_gdb "${run_prefix}run $args\n"
gdb_expect {
-re "${run_match}\\^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}" {
}
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$" {
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
fail "$test (inferior not stopped)"
}
timeout {
- fail "$test (unknown output after running)"
+ fail "$test (timeout)"
}
}
return
pass "$test"
}
timeout {
- fail "$test (unknown output after running)"
+ fail "$test (timeout)"
}
}
return
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
}
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\""
#
# All arguments for the breakpoint may be specified using the options
# number, type, disp, enabled, addr, func, file, fullanme, line,
-# thread-groups, times, ignore, script, and original-location.
+# 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 ".*".
parse_args {{number .*} {type .*} {disp .*} {enabled .*} {addr .*}
{func .*} {file .*} {fullname .*} {line .*}
{thread-groups \\\[.*\\\]} {times .*} {ignore 0}
- {script ""} {original-location .*}}
+ {script ""} {original-location .*} {cond ""} {evaluated-by ""}}
set attr_list {}
foreach attr [list number type disp enabled addr func file \
- fullname line thread-groups times] {
+ 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 ","
# 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