-# Copyright 1992-2016 Free Software Foundation, Inc.
+# Copyright 1992-2018 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
load_lib libgloss.exp
load_lib cache.exp
load_lib gdb-utils.exp
+load_lib memory.exp
global GDB
set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)"
+# A regular expression that matches a value history number.
+# E.g., $1, $2, etc.
+set valnum_re "\\\$$decimal"
+
### Only procedures should come after this point.
#
}
}
+# Returns true iff the target supports using the "run" command.
+
+proc target_can_use_run_cmd {} {
+ if [target_info exists use_gdb_stub] {
+ # In this case, when we connect, the inferior is already
+ # running.
+ return 0
+ }
+
+ # Assume yes.
+ return 1
+}
+
# Generic run command.
#
# The second pattern below matches up to the first newline *only*.
return -1
}
+# Generic starti command. Return 0 if we could start the program, -1
+# if we could not.
+#
+# N.B. This function does not wait for gdb to return to the prompt,
+# that is the caller's responsibility.
+
+proc gdb_starti_cmd {args} {
+ global gdb_prompt use_gdb_stub
+
+ foreach command [gdb_init_commands] {
+ send_gdb "$command\n"
+ gdb_expect 30 {
+ -re "$gdb_prompt $" { }
+ default {
+ perror "gdb_init_command for target failed"
+ return -1
+ }
+ }
+ }
+
+ if $use_gdb_stub {
+ return -1
+ }
+
+ send_gdb "starti $args\n"
+ gdb_expect 60 {
+ -re "The program .* has been started already.*y or n. $" {
+ send_gdb "y\n"
+ exp_continue
+ }
+ -re "Starting program: \[^\r\n\]*" {
+ return 0
+ }
+ }
+ return -1
+}
+
# Set a breakpoint at FUNCTION. If there is an additional argument it is
# a list of options; the supported options are allow-pending, temporary,
-# message, no-message, and passfail.
+# message, no-message, passfail and qualified.
# The result is 1 for success, 0 for failure.
#
# Note: The handling of message vs no-message is messed up, but it's based
set break_message "Temporary breakpoint"
}
+ if {[lsearch -exact $args qualified] != -1} {
+ append break_command " -qualified"
+ }
+
set print_pass 0
set print_fail 1
set no_message_loc [lsearch -exact $args no-message]
}
-re "The target does not support running in non-stop mode.\r\n$gdb_prompt $" {
if { $print_fail } {
- unsupported "Non-stop mode not supported"
+ unsupported "non-stop mode not supported"
}
return 0
}
}
return [gdb_test_multiple $command $message {
- -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
+ -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
if ![string match "" $message] then {
pass "$message"
}
# This is useful when the sequence is long and contains ".*", a single
# regexp to match the entire output can get a timeout much easier.
#
-# COMMAND is the command to send.
+# COMMAND is the command to execute, send to GDB with send_gdb. If
+# this is the null string no command is sent.
# TEST_NAME is passed to pass/fail. COMMAND is used if TEST_NAME is "".
# EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are
# processed in order, and all must be present in the output.
set test_name $command
}
lappend expected_output_list ""; # implicit ".*" before gdb prompt
- send_gdb "$command\n"
+ if { $command != "" } {
+ send_gdb "$command\n"
+ }
return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list]
}
return 0
}
-# Return a 1 if I don't even want to try to test java.
-
-proc skip_java_tests {} {
- return 0
-}
-
# Return a 1 if I don't even want to try to test D.
proc skip_d_tests {} {
}
}
+# Like TCL's native proc, but defines a procedure that wraps its body
+# within 'with_test_prefix "$proc_name" { ... }'.
+proc proc_with_prefix {name arguments body} {
+ # Define the advertised proc.
+ proc $name $arguments [list with_test_prefix $name $body]
+}
+
+
# Run BODY in the context of the caller. After BODY is run, the variables
# listed in VARS will be reset to the values they had before BODY was run.
#
# Return 1 if _Complex types are supported, otherwise, return 0.
gdb_caching_proc support_complex_tests {
+
+ if { [gdb_skip_float_test] } {
+ # If floating point is not supported, _Complex is not
+ # supported.
+ return 0
+ }
+
# Set up, compile, and execute a test program containing _Complex types.
# Include the current process ID in the file names to prevent conflicts
# with invocations for multiple testsuites.
global gdb_prompt
set is_gdbserver -1
- set test "Probing for GDBserver"
+ set test "probing for GDBserver"
gdb_test_multiple "monitor help" $test {
-re "The following monitor commands are supported.*Quit GDBserver.*$gdb_prompt $" {
}
# Set the legacy symbols.
- set gcc_compiled 0
- if { [regexp "^gcc-1-" "$compiler_info" ] } { set gcc_compiled 1 }
- if { [regexp "^gcc-2-" "$compiler_info" ] } { set gcc_compiled 2 }
- if { [regexp "^gcc-3-" "$compiler_info" ] } { set gcc_compiled 3 }
- if { [regexp "^gcc-4-" "$compiler_info" ] } { set gcc_compiled 4 }
- if { [regexp "^gcc-5-" "$compiler_info" ] } { set gcc_compiled 5 }
+ set gcc_compiled 0
+ regexp "^gcc-(\[0-9\]+)-" "$compiler_info" matchall gcc_compiled
# Log what happened.
verbose -log "get_compiler_info: $compiler_info"
set gdb_wrapper_target [current_target_name]
}
+# Determine options that we always want to pass to the compiler.
+gdb_caching_proc universal_compile_options {
+ set me "universal_compile_options"
+ set options {}
+
+ set src [standard_temp_file ccopts[pid].c]
+ set obj [standard_temp_file ccopts[pid].o]
+
+ gdb_produce_source $src {
+ int foo(void) { return 0; }
+ }
+
+ # Try an option for disabling colored diagnostics. Some compilers
+ # yield colored diagnostics by default (when run from a tty) unless
+ # such an option is specified.
+ set opt "additional_flags=-fdiagnostics-color=never"
+ set lines [target_compile $src $obj object [list "quiet" $opt]]
+ if [string match "" $lines] then {
+ # Seems to have worked; use the option.
+ lappend options $opt
+ }
+ file delete $src
+ file delete $obj
+
+ verbose "$me: returning $options" 2
+ return $options
+}
+
# Some targets need to always link a special object in. Save its path here.
global gdb_saved_set_unbuffered_mode_obj
set gdb_saved_set_unbuffered_mode_obj ""
# Add platform-specific options if a shared library was specified using
# "shlib=librarypath" in OPTIONS.
- set new_options ""
+ if {[lsearch -exact $options rust] != -1} {
+ # -fdiagnostics-color is not a rustcc option.
+ } else {
+ set new_options [universal_compile_options]
+ }
+ set new_options {}
set shlib_found 0
set shlib_load 0
foreach opt $options {
- if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
+ if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
+ && $type == "executable"} {
if [test_compiler_info "xlc-*"] {
# IBM xlc compiler doesn't accept shared library named other
# than .so: use "-Wl," to bypass this
lappend new_options "early_flags=-Wl,--no-as-needed"
}
}
- } elseif { $opt == "shlib_load" } {
+ } elseif { $opt == "shlib_load" && $type == "executable" } {
set shlib_load 1
} else {
lappend new_options $opt
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+ unsupported "couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile $sources: ${why_msg}"
+ unsupported "couldn't compile $sources: ${why_msg}"
return -1
}
}
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+ unsupported "couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
# NOTE: This must be called while gdb is *not* running.
gdb_caching_proc gdb_skip_xml_test {
+ global gdb_spawn_id
global gdb_prompt
global srcdir
+ if { [info exists gdb_spawn_id] } {
+ error "GDB must not be running in gdb_skip_xml_tests."
+ }
+
set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"]
gdb_start
return 0
}
-proc get_valueof { fmt exp default } {
+# Retrieve the value of EXP in the inferior, represented in format
+# specified in FMT (using "printFMT"). DEFAULT is used as fallback if
+# print fails. TEST is the test message to use. It can be omitted,
+# in which case a test message is built from EXP.
+
+proc get_valueof { fmt exp default {test ""} } {
global gdb_prompt
- set test "get valueof \"${exp}\""
+ if {$test == "" } {
+ set test "get valueof \"${exp}\""
+ }
+
set val ${default}
gdb_test_multiple "print${fmt} ${exp}" "$test" {
- -re "\\$\[0-9\]* = (.*)\[\r\n\]*$gdb_prompt $" {
+ -re "\\$\[0-9\]* = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" {
set val $expect_out(1,string)
pass "$test ($val)"
}
return ${val}
}
-proc get_integer_valueof { exp default } {
+# Retrieve the value of EXP in the inferior, as a signed decimal value
+# (using "print /d"). DEFAULT is used as fallback if print fails.
+# TEST is the test message to use. It can be omitted, in which case
+# a test message is built from EXP.
+
+proc get_integer_valueof { exp default {test ""} } {
global gdb_prompt
- set test "get integer valueof \"${exp}\""
+ if {$test == ""} {
+ set test "get integer valueof \"${exp}\""
+ }
+
set val ${default}
gdb_test_multiple "print /d ${exp}" "$test" {
-re "\\$\[0-9\]* = (\[-\]*\[0-9\]*).*$gdb_prompt $" {
set val $expect_out(1,string)
- pass "$test ($val)"
+ pass "$test"
}
timeout {
fail "$test (timeout)"
# Retrieve the value of EXP in the inferior, as an hexadecimal value
# (using "print /x"). DEFAULT is used as fallback if print fails.
-# TEST is the test message to use. If can be ommitted, in which case
+# TEST is the test message to use. It can be omitted, in which case
# a test message is built from EXP.
proc get_hexadecimal_valueof { exp default {test ""} } {
return ${val}
}
-proc get_sizeof { type default } {
- return [get_integer_valueof "sizeof (${type})" $default]
+# Retrieve the size of TYPE in the inferior, as a decimal value. DEFAULT
+# is used as fallback if print fails. TEST is the test message to use.
+# It can be omitted, in which case a test message is 'sizeof (TYPE)'.
+
+proc get_sizeof { type default {test ""} } {
+ return [get_integer_valueof "sizeof (${type})" $default $test]
}
proc get_target_charset { } {
return "UTF-8"
}
+# Get the address of VAR.
+
+proc get_var_address { var } {
+ global gdb_prompt hex
+
+ # Match output like:
+ # $1 = (int *) 0x0
+ # $5 = (int (*)()) 0
+ # $6 = (int (*)()) 0x24 <function_bar>
+
+ gdb_test_multiple "print &${var}" "get address of ${var}" {
+ -re "\\\$\[0-9\]+ = \\(.*\\) (0|$hex)( <${var}>)?\[\r\n\]+${gdb_prompt} $"
+ {
+ pass "get address of ${var}"
+ if { $expect_out(1,string) == "0" } {
+ return "0x0"
+ } else {
+ return $expect_out(1,string)
+ }
+ }
+ }
+ return ""
+}
+
# Get the current value for remotetimeout and return it.
proc get_remotetimeout { } {
global gdb_prompt
}
}
+# Get the target's current endianness and return it.
+proc get_endianness { } {
+ global gdb_prompt
+
+ gdb_test_multiple "show endian" "determine endianness" {
+ -re ".* (little|big) endian.*\r\n$gdb_prompt $" {
+ # Pass silently.
+ return $expect_out(1,string)
+ }
+ }
+ return "little"
+}
+
# ROOT and FULL are file names. Returns the relative path from ROOT
# to FULL. Note that FULL must be in a subdirectory of ROOT.
# For example, given ROOT = /usr/bin and FULL = /usr/bin/ls, this
return [join $args "\r\n"]
}
+# Similar to the above, but while multi_line is meant to be used to
+# match GDB output, this one is meant to be used to build strings to
+# send as GDB input.
+
+proc multi_line_input { args } {
+ return [join $args "\n"]
+}
+
+# Return the version of the DejaGnu framework.
+#
+# The return value is a list containing the major, minor and patch version
+# numbers. If the version does not contain a minor or patch number, they will
+# be set to 0. For example:
+#
+# 1.6 -> {1 6 0}
+# 1.6.1 -> {1 6 1}
+# 2 -> {2 0 0}
+
+proc dejagnu_version { } {
+ # The frame_version variable is defined by DejaGnu, in runtest.exp.
+ global frame_version
+
+ verbose -log "DejaGnu version: $frame_version"
+ verbose -log "Expect version: [exp_version]"
+ verbose -log "Tcl version: [info tclversion]"
+
+ set dg_ver [split $frame_version .]
+
+ while { [llength $dg_ver] < 3 } {
+ lappend dg_ver 0
+ }
+
+ return $dg_ver
+}
+
+# Define user-defined command COMMAND using the COMMAND_LIST as the
+# command's definition. The terminating "end" is added automatically.
+
+proc gdb_define_cmd {command command_list} {
+ global gdb_prompt
+
+ set input [multi_line_input {*}$command_list "end"]
+ set test "define $command"
+
+ gdb_test_multiple "define $command" $test {
+ -re "End with" {
+ gdb_test_multiple $input $test {
+ -re "\r\n$gdb_prompt " {
+ }
+ }
+ }
+ }
+}
+
# Always load compatibility stuff.
load_lib future.exp