-# Copyright 1992-2021 Free Software Foundation, Inc.
+# Copyright 1992-2022 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
exit 2
}
+# If GDB is built with ASAN (and because there are leaks), it will output a
+# leak report when exiting as well as exit with a non-zero (failure) status.
+# This can affect tests that are sensitive to what GDB prints on stderr or its
+# exit status. Add `detect_leaks=0` to the ASAN_OPTIONS environment variable
+# (which will affect any spawned sub-process) to avoid this.
+append ::env(ASAN_OPTIONS) ",detect_leaks=0"
+
# List of procs to run in gdb_finish.
set gdb_finish_hooks [list]
load_lib memory.exp
load_lib check-test-names.exp
+# The path to the GDB binary to test.
global GDB
+# The data directory to use for testing. If this is the empty string,
+# then we let GDB use its own configured data directory.
+global GDB_DATA_DIRECTORY
+
# The spawn ID used for I/O interaction with the inferior. For native
# targets, or remote targets that can do I/O through GDB
# (semi-hosting) this will be the same as the host/GDB's spawn ID.
} else {
set GDB [transform gdb]
}
+} else {
+ # If the user specifies GDB on the command line, and doesn't
+ # specify GDB_DATA_DIRECTORY, then assume we're testing an
+ # installed GDB, and let it use its own configured data directory.
+ if ![info exists GDB_DATA_DIRECTORY] {
+ set GDB_DATA_DIRECTORY ""
+ }
}
verbose "using GDB = $GDB" 2
+# The data directory the testing GDB will use. By default, assume
+# we're testing a non-installed GDB in the build directory. Users may
+# also explictly override the -data-directory from the command line.
+if ![info exists GDB_DATA_DIRECTORY] {
+ set GDB_DATA_DIRECTORY "[pwd]/../data-directory"
+}
+verbose "using GDB_DATA_DIRECTORY = $GDB_DATA_DIRECTORY" 2
+
# GDBFLAGS is available for the user to set on the command line.
# E.g. make check RUNTESTFLAGS=GDBFLAGS=mumble
# Testcases may use it to add additional flags, but they must:
}
verbose "using GDBFLAGS = $GDBFLAGS" 2
-# Make the build data directory available to tests.
-set BUILD_DATA_DIRECTORY "[pwd]/../data-directory"
+# Append the -data-directory option to pass to GDB to CMDLINE and
+# return the resulting string. If GDB_DATA_DIRECTORY is empty,
+# nothing is appended.
+proc append_gdb_data_directory_option {cmdline} {
+ global GDB_DATA_DIRECTORY
+
+ if { $GDB_DATA_DIRECTORY != "" } {
+ return "$cmdline -data-directory $GDB_DATA_DIRECTORY"
+ } else {
+ return $cmdline
+ }
+}
# INTERNAL_GDBFLAGS contains flags that the testsuite requires.
+# `-nw' disables any of the windowed interfaces.
+# `-nx' disables ~/.gdbinit, so that it doesn't interfere with the tests.
+# `-iex "set {height,width} 0"' disables pagination.
+# `-data-directory' points to the data directory, usually in the build
+# directory.
global INTERNAL_GDBFLAGS
if ![info exists INTERNAL_GDBFLAGS] {
set INTERNAL_GDBFLAGS \
[join [list \
"-nw" \
"-nx" \
- "-data-directory $BUILD_DATA_DIRECTORY" \
{-iex "set height 0"} \
{-iex "set width 0"}]]
+
+ set INTERNAL_GDBFLAGS [append_gdb_data_directory_option $INTERNAL_GDBFLAGS]
}
# The variable gdb_prompt is a regexp which matches the gdb prompt.
exp_continue
}
-re "$gdb_prompt $" {}
+ -re "A problem internal to GDB has been detected" {
+ perror "Couldn't unload file in $GDB (GDB internal error)."
+ gdb_internal_error_resync
+ return -1
+ }
timeout {
perror "couldn't unload file in $GDB (timeout)."
return -1
-notransfer -re "$gdb_prompt $" {
# There is no more input expected.
}
+ -notransfer -re "A problem internal to GDB has been detected" {
+ # Let caller handle this.
+ }
}
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 qualified.
+# Set a breakpoint using LINESPEC.
+#
+# If there is an additional argument it is a list of options; the supported
+# options are allow-pending, temporary, message, no-message 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
# no-message: turns off printing of fails (and passes, but they're already off)
# message: turns on printing of passes (and fails, but they're already on)
-proc gdb_breakpoint { function args } {
+proc gdb_breakpoint { linespec args } {
global gdb_prompt
global decimal
set print_pass 1
}
- set test_name "setting breakpoint at $function"
+ set test_name "gdb_breakpoint: set breakpoint at $linespec"
- send_gdb "$break_command $function\n"
+ send_gdb "$break_command $linespec\n"
# The first two regexps are what we get with -g, the third is without -g.
gdb_expect 30 {
-re "$break_message \[0-9\]* at .*: file .*, line $decimal.\r\n$gdb_prompt $" {}
#
# If there are additional arguments, pass them to gdb_breakpoint.
# We recognize no-message/message ourselves.
-# The default is no-message.
+#
# no-message is messed up here, like gdb_breakpoint: to preserve
# historical usage fails are always printed by default.
# no-message: turns off printing of fails (and passes, but they're already off)
# message: turns on printing of passes (and fails, but they're already on)
-proc runto { function args } {
+proc runto { linespec args } {
global gdb_prompt
global decimal
delete_breakpoints
- # Default to "no-message".
- set args "no-message $args"
-
set print_pass 0
set print_fail 1
set no_message_loc [lsearch -exact $args no-message]
set print_pass 1
}
- set test_name "running to $function in runto"
+ set test_name "runto: run to $linespec"
# We need to use eval here to pass our varargs args to gdb_breakpoint
# which is also a varargs function.
- # But we also have to be careful because $function may have multiple
+ # But we also have to be careful because $linespec may have multiple
# elements, and we don't want Tcl to move the remaining elements after
- # the first to $args. That is why $function is wrapped in {}.
- if ![eval gdb_breakpoint {$function} $args] {
+ # the first to $args. That is why $linespec is wrapped in {}.
+ if ![eval gdb_breakpoint {$linespec} $args] {
return 0
}
# If you don't want that, use gdb_start_cmd.
proc runto_main { } {
- return [runto main no-message qualified]
+ return [runto main qualified]
}
### Continue, and expect to hit a breakpoint.
set count 0
while {$count < 10} {
gdb_expect {
+ -re "Recursive internal problem\\." {
+ perror "Could not resync from internal error (recursive internal problem)"
+ return 0
+ }
-re "Quit this debugging session\\? \\(y or n\\) $" {
send_gdb "n\n" answer
incr count
perror "Could not resync from internal error (timeout)"
return 0
}
+ eof {
+ perror "Could not resync from internal error (eof)"
+ return 0
+ }
}
}
perror "Could not resync from internal error (resync count exceeded)"
return 0
}
+# Fill in the default prompt if PROMPT_REGEXP is empty.
+proc fill_in_default_prompt {prompt_regexp} {
+ if { "$prompt_regexp" == "" } {
+ return "$::gdb_prompt $"
+ }
+ return $prompt_regexp
+}
# gdb_test_multiple COMMAND MESSAGE [ -prompt PROMPT_REGEXP] [ -lbl ]
# EXPECT_ARGUMENTS
error "Too few arguments to gdb_test_multiple"
}
- if { "$prompt_regexp" == "" } {
- set prompt_regexp "$gdb_prompt $"
- }
+ set prompt_regexp [fill_in_default_prompt $prompt_regexp]
if { $message == "" } {
set message $command
}
-# gdb_test COMMAND PATTERN MESSAGE QUESTION RESPONSE
+# gdb_test [-prompt PROMPT_REGEXP] [-lbl]
+# COMMAND [PATTERN] [MESSAGE] [QUESTION RESPONSE]
# Send a command to gdb; test the result.
#
# COMMAND is the command to execute, send to GDB with send_gdb. If
# omitted, then the pass/fail messages use the command string as the
# message. (If this is the empty string, then sometimes we don't
# call pass or fail at all; I don't understand this at all.)
-# QUESTION is a question GDB may ask in response to COMMAND, like
-# "are you sure?"
-# RESPONSE is the response to send if QUESTION appears.
+# QUESTION is a question GDB should ask in response to COMMAND, like
+# "are you sure?" If this is specified, the test fails if GDB
+# doesn't print the question.
+# RESPONSE is the response to send when QUESTION appears.
+#
+# -prompt PROMPT_REGEXP specifies a regexp matching the expected prompt
+# after the command output. If empty, defaults to "$gdb_prompt $".
+# -lbl specifies that line-by-line matching will be used.
+# -nopass specifies that a PASS should not be issued.
#
# Returns:
# 1 if the test failed,
# 0 if the test passes,
# -1 if there was an internal error.
-#
+#
proc gdb_test { args } {
global gdb_prompt
upvar timeout timeout
- if [llength $args]>2 then {
- set message [lindex $args 2]
- } else {
- set message [lindex $args 0]
+ parse_args {
+ {prompt ""}
+ {lbl}
+ {nopass}
}
- set command [lindex $args 0]
- set pattern [lindex $args 1]
+
+ lassign $args command pattern message question response
+
+ # Can't have a question without a response.
+ if { $question != "" && $response == "" || [llength $args] > 5 } {
+ error "Unexpected arguments: $args"
+ }
+
+ if { $message == "" } {
+ set message $command
+ }
+
+ set prompt [fill_in_default_prompt $prompt]
+
+ set saw_question 0
set user_code {}
lappend user_code {
- -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
- if ![string match "" $message] then {
- pass "$message"
- }
- }
+ -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$prompt" {
+ if { $question != "" & !$saw_question} {
+ fail $message
+ } elseif {!$nopass} {
+ pass $message
+ }
+ }
}
- if { [llength $args] == 5 } {
- set question_string [lindex $args 3]
- set response_string [lindex $args 4]
+ if { $question != "" } {
lappend user_code {
- -re "(${question_string})$" {
- send_gdb "$response_string\n"
+ -re "$question$" {
+ set saw_question 1
+ send_gdb "$response\n"
exp_continue
}
}
- }
+ }
set user_code [join $user_code]
- return [gdb_test_multiple $command $message $user_code]
+
+ set opts {}
+ lappend opts "-prompt" "$prompt"
+ if {$lbl} {
+ lappend opts "-lbl"
+ }
+
+ return [gdb_test_multiple $command $message {*}$opts $user_code]
}
# Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.
}
}
-# gdb_test_no_output COMMAND MESSAGE
+# gdb_test_no_output [-prompt PROMPT_REGEXP] [-nopass] COMMAND [MESSAGE]
# Send a command to GDB and verify that this command generated no output.
#
-# See gdb_test_multiple for a description of the COMMAND and MESSAGE
-# parameters. If MESSAGE is ommitted, then COMMAND will be used as
-# the message. (If MESSAGE is the empty string, then sometimes we do not
-# call pass or fail at all; I don't understand this at all.)
+# See gdb_test for a description of the -prompt, -nopass, COMMAND, and
+# MESSAGE parameters.
proc gdb_test_no_output { args } {
global gdb_prompt
- set command [lindex $args 0]
- if [llength $args]>1 then {
- set message [lindex $args 1]
- } else {
- set message $command
+
+ parse_args {
+ {prompt_re ""}
+ {nopass}
}
+ lassign $args command message
+
+ set prompt_re [fill_in_default_prompt $prompt_re]
+
set command_regex [string_to_regexp $command]
- gdb_test_multiple $command $message {
- -re "^$command_regex\r\n$gdb_prompt $" {
- if ![string match "" $message] then {
- pass "$message"
- }
- }
+ gdb_test_multiple $command $message -prompt $prompt_re {
+ -re "^$command_regex\r\n$prompt_re" {
+ if {!$nopass} {
+ pass $gdb_test_name
+ }
+ }
}
}
}
\f
+# Match output of COMMAND using RE. Read output line-by-line.
+# Report pass/fail with MESSAGE.
+# For a command foo with output:
+# (gdb) foo^M
+# <line1>^M
+# <line2>^M
+# (gdb)
+# the portion matched using RE is:
+# '<line1>^M
+# <line2>^M
+# '
+#
+# Optionally, additional -re-not <regexp> arguments can be specified, to
+# ensure that a regexp is not match by the COMMAND output.
+# Such an additional argument generates an additional PASS/FAIL of the form:
+# PASS: test-case.exp: $message: pattern not matched: <regexp>
+
+proc gdb_test_lines { command message re args } {
+ set re_not [list]
+
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ set arg [lindex $args $i]
+ if { $arg == "-re-not" } {
+ incr i
+ if { [llength $args] == $i } {
+ error "Missing argument for -re-not"
+ break
+ }
+ set arg [lindex $args $i]
+ lappend re_not $arg
+ } else {
+ error "Unhandled argument: $arg"
+ }
+ }
+
+ if { $message == ""} {
+ set message $command
+ }
+
+ set lines ""
+ gdb_test_multiple $command $message {
+ -re "\r\n(\[^\r\n\]*)(?=\r\n)" {
+ set line $expect_out(1,string)
+ if { $lines eq "" } {
+ append lines "$line"
+ } else {
+ append lines "\r\n$line"
+ }
+ exp_continue
+ }
+ -re -wrap "" {
+ append lines "\r\n"
+ }
+ }
+
+ gdb_assert { [regexp $re $lines] } $message
+
+ foreach re $re_not {
+ gdb_assert { ![regexp $re $lines] } "$message: pattern not matched: $re"
+ }
+}
+
# Test that a command gives an error. For pass or fail, return
# a 1 to indicate that more tests can proceed. However a timeout
# is a serious error, generates a special fail message, and causes
remote_close host
}
unset gdb_spawn_id
+ unset ::gdb_tty_name
unset inferior_spawn_id
}
}
}
+# The expect "spawn" function puts the tty name into the spawn_out
+# array; but dejagnu doesn't export this globally. So, we have to
+# wrap spawn with our own function and poke in the built-in spawn
+# so that we can capture this value.
+#
+# If available, the TTY name is saved to the LAST_SPAWN_TTY_NAME global.
+# Otherwise, LAST_SPAWN_TTY_NAME is unset.
+
+proc spawn_capture_tty_name { args } {
+ set result [uplevel builtin_spawn $args]
+ upvar spawn_out spawn_out
+ if { [info exists spawn_out(slave,name)] } {
+ set ::last_spawn_tty_name $spawn_out(slave,name)
+ } else {
+ # If a process is spawned as part of a pipe line (e.g. passing
+ # -leaveopen to the spawn proc) then the spawned process is no
+ # assigned a tty and spawn_out(slave,name) will not be set.
+ # In that case we want to ensure that last_spawn_tty_name is
+ # not set.
+ #
+ # If the previous process spawned was also not assigned a tty
+ # (e.g. multiple processed chained in a pipeline) then
+ # last_spawn_tty_name will already be unset, so, if we don't
+ # use -nocomplain here we would otherwise get an error.
+ unset -nocomplain ::last_spawn_tty_name
+ }
+ return $result
+}
+
+rename spawn builtin_spawn
+rename spawn_capture_tty_name spawn
+
# Default gdb_spawn procedure.
proc default_gdb_spawn { } {
exit 1
}
}
- set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS [host_info gdb_opts]"]
+
+ # Put GDBFLAGS last so that tests can put "--args ..." in it.
+ set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS [host_info gdb_opts] $GDBFLAGS"]
if { $res < 0 || $res == "" } {
perror "Spawning $GDB failed."
return 1
}
set gdb_spawn_id $res
+ set ::gdb_tty_name $::last_spawn_tty_name
return 0
}
-re "\[\r\n\]$gdb_prompt $" {
verbose "GDB initialized."
}
+ -re "\[\r\n\]\033\\\[.2004h$gdb_prompt $" {
+ # This special case detects what happens when GDB is
+ # started with bracketed paste mode enabled. This mode is
+ # usually forced off (see setting of INPUTRC in
+ # default_gdb_init), but for at least one test we turn
+ # bracketed paste mode back on, and then start GDB. In
+ # that case, this case is hit.
+ verbose "GDB initialized."
+ }
-re "$gdb_prompt $" {
perror "GDB never initialized."
unset gdb_spawn_id
# Examine the output of compilation to determine whether compilation
# failed or not. If it failed determine whether it is due to missing
# compiler or due to compiler error. Report pass, fail or unsupported
-# as appropriate
+# as appropriate.
proc gdb_compile_test {src output} {
+ set msg "compilation [file tail $src]"
+
if { $output == "" } {
- pass "compilation [file tail $src]"
- } elseif { [regexp {^[a-zA-Z_0-9]+: Can't find [^ ]+\.$} $output] } {
- unsupported "compilation [file tail $src]"
- } elseif { [regexp {.*: command not found[\r|\n]*$} $output] } {
- unsupported "compilation [file tail $src]"
- } elseif { [regexp {.*: [^\r\n]*compiler not installed[^\r\n]*[\r|\n]*$} $output] } {
- unsupported "compilation [file tail $src]"
- } else {
- verbose -log "compilation failed: $output" 2
- fail "compilation [file tail $src]"
+ pass $msg
+ return
+ }
+
+ if { [regexp {^[a-zA-Z_0-9]+: Can't find [^ ]+\.$} $output]
+ || [regexp {.*: command not found[\r|\n]*$} $output]
+ || [regexp {.*: [^\r\n]*compiler not installed[^\r\n]*[\r|\n]*$} $output] } {
+ unsupported "$msg (missing compiler)"
+ return
}
+
+ set gcc_re ".*: error: unrecognized command line option "
+ set clang_re ".*: error: unsupported option "
+ if { [regexp "(?:$gcc_re|$clang_re)(\[^ \t;\r\n\]*)" $output dummy option]
+ && $option != "" } {
+ unsupported "$msg (unsupported option $option)"
+ return
+ }
+
+ # Unclassified compilation failure, be more verbose.
+ verbose -log "compilation failed: $output" 2
+ fail "$msg"
}
# Return a 1 for configurations for which we don't even want to try to
# PROMPT_REGEXP is the expected prompt.
proc skip_python_tests_prompt { prompt_regexp } {
- global gdb_py_is_py3k
-
gdb_test_multiple "python print ('test')" "verify python support" \
-prompt "$prompt_regexp" {
-re "not supported.*$prompt_regexp" {
-re "$prompt_regexp" {}
}
- gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" \
- -prompt "$prompt_regexp" {
- -re "3.*$prompt_regexp" {
- set gdb_py_is_py3k 1
- }
- -re ".*$prompt_regexp" {
- set gdb_py_is_py3k 0
- }
- }
-
return 0
}
proc $name $arguments [list with_test_prefix $name $body]
}
+# Return an id corresponding to the test prefix stored in $pf_prefix, which
+# is more suitable for use in a file name.
+# F.i., for a pf_prefix:
+# gdb.dwarf2/dw2-lines.exp: \
+# cv=5: cdw=64: lv=5: ldw=64: string_form=line_strp:
+# return an id:
+# cv-5-cdw-32-lv-5-ldw-64-string_form-line_strp
+
+proc prefix_id {} {
+ global pf_prefix
+ set id $pf_prefix
+
+ # Strip ".exp: " prefix.
+ set id [regsub {.*\.exp: } $id {}]
+
+ # Strip colon suffix.
+ set id [regsub {:$} $id {}]
+
+ # Strip spaces.
+ set id [regsub -all { } $id {}]
+
+ # Replace colons, equal signs.
+ set id [regsub -all \[:=\] $id -]
+
+ return $id
+}
# 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.
}
}
- gdb_test_no_output "set target-charset $target_charset" ""
+ gdb_test_no_output -nopass "set target-charset $target_charset"
set code [catch {uplevel 1 $body} result]
- gdb_test_no_output "set target-charset $saved" ""
+ gdb_test_no_output -nopass "set target-charset $saved"
if {$code == 1} {
global errorInfo errorCode
}
}
+# Return 1 if memory tagging is supported at runtime, otherwise return 0.
+
+gdb_caching_proc supports_memtag {
+ global gdb_prompt
+
+ gdb_test_multiple "memory-tag check" "" {
+ -re "Memory tagging not supported or disabled by the current architecture\..*$gdb_prompt $" {
+ return 0
+ }
+ -re "Argument required \\(address or pointer\\).*$gdb_prompt $" {
+ return 1
+ }
+ }
+ return 0
+}
+
# Return 1 if the target supports hardware single stepping.
proc can_hardware_single_step {} {
if { [istarget "arm*-*-*"] || [istarget "mips*-*-*"]
|| [istarget "tic6x-*-*"] || [istarget "sparc*-*-linux*"]
- || [istarget "nios2-*-*"] } {
+ || [istarget "nios2-*-*"] || [istarget "riscv*-*-linux*"] } {
return 0
}
if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"]
|| [istarget "arm*-*-linux*"] || [istarget "powerpc-*-linux*"]
|| [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"]
- || [istarget "aarch64*-*-linux*"] } {
+ || [istarget "aarch64*-*-linux*"] || [istarget "loongarch*-*-linux*"] } {
return 1
}
}
# Make sure we have a compiler that understands altivec.
- if [get_compiler_info] {
- warning "Could not get compiler info"
- return 1
- }
if [test_compiler_info gcc*] {
set compile_flags "additional_flags=-maltivec"
} elseif [test_compiler_info xlc*] {
return $skip_vmx_tests
}
+# Run a test on the power target to see if it supports ISA 3.1 instructions
+gdb_caching_proc skip_power_isa_3_1_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_power_isa_3_1_tests"
+
+ # Compile a test program containing ISA 3.1 instructions.
+ set src {
+ int main() {
+ asm volatile ("pnop"); // marker
+ asm volatile ("nop");
+ return 0;
+ }
+ }
+
+ if {![gdb_simple_compile $me $src executable ]} {
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$obj"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "\n$me Power ISA 3.1 hardware not detected"
+ set skip_power_isa_3_1_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "\n$me: Power ISA 3.1 hardware detected"
+ set skip_power_isa_3_1_tests 0
+ }
+ default {
+ warning "\n$me: default case taken"
+ set skip_power_isa_3_1_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_power_isa_3_1_tests" 2
+ return $skip_power_isa_3_1_tests
+}
+
# Run a test on the target to see if it supports vmx hardware. Return 0 if so,
# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
}
# Make sure we have a compiler that understands altivec.
- if [get_compiler_info] {
- warning "Could not get compiler info"
- return 1
- }
if [test_compiler_info gcc*] {
set compile_flags "additional_flags=-mvsx"
} elseif [test_compiler_info xlc*] {
return $skip_avx512bf16_tests
}
+# Run a test on the target to see if it supports avx512fp16. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+gdb_caching_proc skip_avx512fp16_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_avx512fp16_tests"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support avx512fp16, returning 1" 2
+ return 1
+ }
+
+ # Compile a test program.
+ set src {
+ int main() {
+ asm volatile ("vcvtps2phx %xmm1, %xmm0");
+ return 0;
+ }
+ }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$obj"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "$me: avx512fp16 hardware not detected."
+ set skip_avx512fp16_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "$me: avx512fp16 hardware detected."
+ set skip_avx512fp16_tests 0
+ }
+ default {
+ warning "\n$me: default case taken."
+ set skip_avx512fp16_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_avx512fp16_tests" 2
+ return $skip_avx512fp16_tests
+}
+
# Run a test on the target to see if it supports btrace hardware. Return 0 if so,
# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
# backtraces. Requires get_compiler_info and get_debug_format.
proc skip_inline_frame_tests {} {
- # GDB only recognizes inlining information in DWARF 2 (DWARF 3).
- if { ! [test_debug_format "DWARF 2"] } {
+ # GDB only recognizes inlining information in DWARF.
+ if { ! [test_debug_format "DWARF \[0-9\]"] } {
return 1
}
# inlined functions. Requires get_compiler_info and get_debug_format.
proc skip_inline_var_tests {} {
- # GDB only recognizes inlining information in DWARF 2 (DWARF 3).
- if { ! [test_debug_format "DWARF 2"] } {
+ # GDB only recognizes inlining information in DWARF.
+ if { ! [test_debug_format "DWARF \[0-9\]"] } {
return 1
}
}
# These targets support hardware watchpoints natively
+ # Note, not all Power 9 processors support hardware watchpoints due to a HW
+ # bug. Use has_hw_wp_support to check do a runtime check for hardware
+ # watchpoint support on Powerpc.
if { [istarget "i?86-*-*"]
|| [istarget "x86_64-*-*"]
|| [istarget "ia64-*-*"]
|| [istarget "arm*-*-*"]
|| [istarget "aarch64*-*-*"]
- || [istarget "powerpc*-*-linux*"]
+ || ([istarget "powerpc*-*-linux*"] && [has_hw_wp_support])
|| [istarget "s390*-*-*"] } {
return 0
}
# is a regexp that will match the output of "maint print target-stack" if
# the target in question is currently pushed. PROMPT_REGEXP is a regexp
# matching the expected prompt after the command output.
+#
+# NOTE: GDB must be running BEFORE this procedure is called!
proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } {
+ global gdb_spawn_id
+
+ # Throw a Tcl error if gdb isn't already started.
+ if {![info exists gdb_spawn_id]} {
+ error "gdb_is_target_1 called with no running gdb instance"
+ }
+
set test "probe for target ${target_name}"
gdb_test_multiple "maint print target-stack" $test \
-prompt "$prompt_regexp" {
}
# Helper for gdb_is_target_remote where the expected prompt is variable.
+#
+# NOTE: GDB must be running BEFORE this procedure is called!
proc gdb_is_target_remote_prompt { prompt_regexp } {
- return [gdb_is_target_1 "remote" ".*emote serial target in gdb-specific protocol.*" $prompt_regexp]
+ return [gdb_is_target_1 "remote" ".*emote target using gdb-specific protocol.*" $prompt_regexp]
}
# Check whether we're testing with the remote or extended-remote
# targets.
+#
+# NOTE: GDB must be running BEFORE this procedure is called!
proc gdb_is_target_remote { } {
global gdb_prompt
}
# Check whether we're testing with the native target.
+#
+# NOTE: GDB must be running BEFORE this procedure is called!
proc gdb_is_target_native { } {
global gdb_prompt
#
# -- chastain 2004-01-06
-proc get_compiler_info {{arg ""}} {
- # For compiler.c and compiler.cc
+proc get_compiler_info {{language "c"}} {
+ # For compiler.c, compiler.cc and compiler.F90.
global srcdir
# I am going to play with the log to keep noise out.
global outdir
global tool
- # These come from compiler.c or compiler.cc
+ # These come from compiler.c, compiler.cc or compiler.F90.
global compiler_info
# Legacy global data symbols.
}
# Choose which file to preprocess.
- set ifile "${srcdir}/lib/compiler.c"
- if { $arg == "c++" } {
+ if { $language == "c++" } {
set ifile "${srcdir}/lib/compiler.cc"
+ } elseif { $language == "f90" } {
+ set ifile "${srcdir}/lib/compiler.F90"
+ } elseif { $language == "c" } {
+ set ifile "${srcdir}/lib/compiler.c"
+ } else {
+ perror "Unable to fetch compiler version for language: $language"
+ return -1
}
# Run $ifile through the right preprocessor.
# We have to use -E and -o together, despite the comments
# above, because of how DejaGnu handles remote host testing.
set ppout "$outdir/compiler.i"
- gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet getting_compiler_info]
+ gdb_compile "${ifile}" "$ppout" preprocess [list "$language" quiet getting_compiler_info]
set file [open $ppout r]
set cppout [read $file]
close $file
} else {
- set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet getting_compiler_info] ]
+ set cppout [ gdb_compile "${ifile}" "" preprocess [list "$language" quiet getting_compiler_info] ]
}
eval log_file $saved_log
# eval this line
verbose "get_compiler_info: $cppline" 2
eval "$cppline"
+ } elseif { [ regexp "flang.*warning.*'-fdiagnostics-color=never'" "$cppline"] } {
+ # Both flang preprocessors (llvm flang and classic flang) print a
+ # warning for the unused -fdiagnostics-color=never, so we skip this
+ # output line here.
} else {
# unknown line
verbose -log "get_compiler_info: $cppline"
# Otherwise the argument is a glob-style expression to match against
# compiler_info.
-proc test_compiler_info { {compiler ""} } {
+proc test_compiler_info { {compiler ""} {language "c"} } {
global compiler_info
- get_compiler_info
+ get_compiler_info $language
# If no arg, return the compiler_info string.
if [string match "" $compiler] {
return [string match $compiler $compiler_info]
}
+# Return the gcc major version, or -1.
+# For gcc 4.8.5, the major version is 4.8.
+# For gcc 7.5.0, the major version 7.
+
+proc gcc_major_version { } {
+ global decimal
+ if { ![test_compiler_info "gcc-*"] } {
+ return -1
+ }
+ set res [regexp gcc-($decimal)-($decimal)- [test_compiler_info] \
+ dummy_var major minor]
+ if { $res != 1 } {
+ return -1
+ }
+ if { $major >= 5} {
+ return $major
+ }
+ return $major.$minor
+}
+
proc current_target_name { } {
global target_info
if [info exists target_info(target,name)] {
# - nowarnings: Inhibit all compiler warnings.
# - pie: Force creation of PIE executables.
# - nopie: Prevent creation of PIE executables.
+# - macros: Add the required compiler flag to include macro information in
+# debug information
+# - text_segment=addr: Tell the linker to place the text segment at ADDR.
#
# And here are some of the not too obscure options understood by DejaGnu that
# influence the compilation:
# - ldflags=flag: Add FLAG to the linker flags.
# - incdir=path: Add PATH to the searched include directories.
# - libdir=path: Add PATH to the linker searched directories.
-# - ada, c++, f77, f90, go, rust: Compile the file as Ada, C++,
-# Fortran 77, Fortran 90, Go or Rust.
+# - ada, c++, f90, go, rust: Compile the file as Ada, C++,
+# Fortran 90, Go or Rust.
# - debug: Build with debug information.
# - optimize: Build with optimization.
set outdir [file dirname $dest]
+ # If this is set, calling test_compiler_info will cause recursion.
+ if { [lsearch -exact $options getting_compiler_info] == -1 } {
+ set getting_compiler_info false
+ } else {
+ set getting_compiler_info true
+ }
+
# Add platform-specific options if a shared library was specified using
# "shlib=librarypath" in OPTIONS.
set new_options {}
# default, unless you pass -Wno-unknown-warning-option as well.
# We do that here, so that individual testcases don't have to
# worry about it.
- if {[lsearch -exact $options getting_compiler_info] == -1
+ if {!$getting_compiler_info
&& [lsearch -exact $options rust] == -1
&& [lsearch -exact $options ada] == -1
- && [lsearch -exact $options f77] == -1
&& [lsearch -exact $options f90] == -1
&& [lsearch -exact $options go] == -1
&& [test_compiler_info "clang-*"]} {
# Treating .c input files as C++ is deprecated in Clang, so
# explicitly force C++ language.
- if { [lsearch -exact $options getting_compiler_info] == -1
+ if { !$getting_compiler_info
&& [lsearch -exact $options c++] != -1
&& [string match *.c $source] != 0 } {
}
# Place (and look for) Fortran `.mod` files in the output
- # directory for this specific test.
- if {[lsearch -exact $options f77] != -1 \
- || [lsearch -exact $options f90] != -1 } {
+ # directory for this specific test. For Intel compilers the -J
+ # option is not supported so instead use the -module flag.
+ # Additionally, Intel compilers need the -debug-parameters flag set to
+ # emit debug info for all parameters in modules.
+ if { !$getting_compiler_info && [lsearch -exact $options f90] != -1 } {
# Fortran compile.
set mod_path [standard_output_file ""]
- lappend new_options "additional_flags=-J${mod_path}"
+ if { [test_compiler_info {gfortran-*} f90] } {
+ lappend new_options "additional_flags=-J${mod_path}"
+ } elseif { [test_compiler_info {ifort-*} f90]
+ || [test_compiler_info {ifx-*} f90] } {
+ lappend new_options "additional_flags=-module ${mod_path}"
+ lappend new_options "additional_flags=-debug-parameters all"
+ }
}
set shlib_found 0
set shlib_load 0
- set getting_compiler_info 0
foreach opt $options {
if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
&& $type == "executable"} {
} elseif { $opt == "shlib_load" && $type == "executable" } {
set shlib_load 1
} elseif { $opt == "getting_compiler_info" } {
- # If this is set, calling test_compiler_info will cause recursion.
- set getting_compiler_info 1
+ # Ignore this setting here as it has been handled earlier in this
+ # procedure. Do not append it to new_options as this will cause
+ # recursion.
+ } elseif {[regexp "^text_segment=(.*)" $opt dummy_var addr]} {
+ if { [linker_supports_Ttext_segment_flag] } {
+ # For GNU ld.
+ lappend new_options "ldflags=-Wl,-Ttext-segment=$addr"
+ } elseif { [linker_supports_image_base_flag] } {
+ # For LLVM's lld.
+ lappend new_options "ldflags=-Wl,--image-base=$addr"
+ } elseif { [linker_supports_Ttext_flag] } {
+ # For old GNU gold versions.
+ lappend new_options "ldflags=-Wl,-Ttext=$addr"
+ } else {
+ error "Don't know how to handle text_segment option."
+ }
} else {
lappend new_options $opt
}
# DWARF line numbering.
# See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88432
# This option defaults to on for Debian/Ubuntu.
- if { $getting_compiler_info == 0
+ if { !$getting_compiler_info
&& [test_compiler_info {gcc-*-*}]
&& !([test_compiler_info {gcc-[0-3]-*}]
|| [test_compiler_info {gcc-4-0-*}])
lappend options "$flag"
}
+ set macros [lsearch -exact $options macros]
+ if {$macros != -1} {
+ if { [test_compiler_info "clang-*"] } {
+ set flag "additional_flags=-fdebug-macro"
+ } else {
+ set flag "additional_flags=-g3"
+ }
+
+ set options [lreplace $options $macros $macros $flag]
+ }
+
if { $type == "executable" } {
if { ([istarget "*-*-mingw*"]
|| [istarget "*-*-*djgpp"]
}
if {[lsearch $options quiet] < 0} {
- # We shall update this on a per language basis, to avoid
- # changing the entire testsuite in one go.
- if {[lsearch $options f77] >= 0} {
- gdb_compile_test $source $result
- } elseif { $result != "" } {
+ if { $result != "" } {
clone_output "gdb compile failed, $result"
}
}
set ada 1
}
- set info_options ""
if { [lsearch -exact $options "c++"] >= 0 } {
set info_options "c++"
- }
- if [get_compiler_info ${info_options}] {
- return -1
+ } elseif { [lsearch -exact $options "f90"] >= 0 } {
+ set info_options "f90"
+ } else {
+ set info_options "c"
}
- switch -glob [test_compiler_info] {
+ switch -glob [test_compiler_info "" ${info_options}] {
"xlc-*" {
lappend obj_options "additional_flags=-qpic"
}
# back the pid of the program. On remote boards, that would give
# us instead the PID of e.g., the ssh client, etc.
if [is_remote target] then {
+ verbose -log "can't spawn for attach (target is remote)"
return 0
}
# stub-like, where GDB finds the program already started on
# initial connection.
if {[target_info exists use_gdb_stub]} {
+ verbose -log "can't spawn for attach (target is stub)"
return 0
}
return 1
}
-# Kill a progress previously started with spawn_wait_for_attach, and
-# reap its wait status. PROC_SPAWN_ID is the spawn id associated with
-# the process.
+# Centralize the failure checking of "attach" command.
+# Return 0 if attach failed, otherwise return 1.
-proc kill_wait_spawned_process { proc_spawn_id } {
- set pid [exp_pid -i $proc_spawn_id]
+proc gdb_attach { testpid args } {
+ parse_args {
+ {pattern ""}
+ }
+
+ if { [llength $args] != 0 } {
+ error "Unexpected arguments: $args"
+ }
+
+ gdb_test_multiple "attach $testpid" "attach" {
+ -re -wrap "Attaching to.*ptrace: Operation not permitted\\." {
+ unsupported "$gdb_test_name (Operation not permitted)"
+ return 0
+ }
+ -re -wrap "$pattern" {
+ pass $gdb_test_name
+ return 1
+ }
+ }
+
+ return 0
+}
+
+# Start gdb with "--pid $TESTPID" on the command line and wait for the prompt.
+# Return 1 if GDB managed to start and attach to the process, 0 otherwise.
+
+proc_with_prefix gdb_spawn_attach_cmdline { testpid } {
+ if ![can_spawn_for_attach] {
+ # The caller should have checked can_spawn_for_attach itself
+ # before getting here.
+ error "can't spawn for attach with this target/board"
+ }
+
+ set test "start gdb with --pid"
+ set res [gdb_spawn_with_cmdline_opts "-quiet --pid=$testpid"]
+ if { $res != 0 } {
+ fail $test
+ return 0
+ }
+
+ gdb_test_multiple "" "$test" {
+ -re -wrap "ptrace: Operation not permitted\\." {
+ unsupported "$gdb_test_name (operation not permitted)"
+ return 0
+ }
+ -re -wrap "ptrace: No such process\\." {
+ fail "$gdb_test_name (no such process)"
+ return 0
+ }
+ -re -wrap "Attaching to process $testpid\r\n.*" {
+ pass $gdb_test_name
+ }
+ }
+
+ # Check that we actually attached to a process, in case the
+ # error message is not caught by the patterns above.
+ gdb_test_multiple "info thread" "" {
+ -re -wrap "No threads\\." {
+ fail "$gdb_test_name (no thread)"
+ }
+ -re -wrap "Id.*" {
+ pass $gdb_test_name
+ return 1
+ }
+ }
+
+ return 0
+}
+
+# Kill a progress previously started with spawn_wait_for_attach, and
+# reap its wait status. PROC_SPAWN_ID is the spawn id associated with
+# the process.
+
+proc kill_wait_spawned_process { proc_spawn_id } {
+ set pid [exp_pid -i $proc_spawn_id]
verbose -log "killing ${pid}"
remote_exec build "kill -9 ${pid}"
perror "Did not manage to set complaints"
} else {
# Set complaints.
- gdb_test_no_output "set complaints $n" ""
+ gdb_test_no_output -nopass "set complaints $n"
}
set code [catch {uplevel 1 $body} result]
# Restore saved setting of complaints.
if { $save != "" } {
- gdb_test_no_output "set complaints $save" ""
+ gdb_test_no_output -nopass "set complaints $save"
}
if {$code == 1} {
}
# Verify that there were no complaints.
- set re "^Reading symbols from \[^\r\n\]*\r\n$gdb_prompt $"
+ set re \
+ [multi_line \
+ "^(Reading symbols from \[^\r\n\]*" \
+ ")+(Expanding full symbols from \[^\r\n\]*" \
+ ")?$gdb_prompt $"]
gdb_assert {[regexp $re $gdb_file_cmd_msg]} "No complaints"
}
# tests.
setenv TERM "dumb"
+ # If DEBUGINFOD_URLS is set, gdb will try to download sources and
+ # debug info for f.i. system libraries. Prevent this.
+ unset -nocomplain ::env(DEBUGINFOD_URLS)
+
# Ensure that GDBHISTFILE and GDBHISTSIZE are removed from the
# environment, we don't want these modifications to the history
# settings.
if { $res != 0 } {
return -1
}
- set res [regexp -line {^[ \t]*Type:[ \t]*DYN \(Shared object file\)$} \
+ set res [regexp -line {^[ \t]*Type:[ \t]*DYN \((Position-Independent Executable|Shared object) file\)$} \
$output]
if { $res == 1 } {
return 1
set binfile [standard_output_file $executable]
- set info_options ""
- if { [lsearch -exact $options "c++"] >= 0 } {
- set info_options "c++"
- }
- if [get_compiler_info ${info_options}] {
- return -1
- }
-
set func gdb_compile
set func_index [lsearch -regexp $options {^(pthreads|shlib|shlib_pthreads|openmp)$}]
if {$func_index != -1} {
return "little"
}
+# Get the target's default endianness and return it.
+gdb_caching_proc target_endianness {
+ global gdb_prompt
+
+ set me "target_endianness"
+
+ set src { int main() { return 0; } }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 0
+ }
+
+ clean_restart $obj
+ if ![runto_main] {
+ return 0
+ }
+ set res [get_endianness]
+
+ gdb_exit
+ remote_file build delete $obj
+
+ return $res
+}
+
# 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 [regexp -- "-gsplit-dwarf" $debug_flags]
}
-# Search the caller's ARGS list and set variables according to the list of
-# valid options described by ARGSET.
+# Search LISTNAME in uplevel LEVEL caller and set variables according to the
+# list of valid options with prefix PREFIX described by ARGSET.
#
# The first member of each one- or two-element list in ARGSET defines the
# name of a variable that will be added to the caller's scope.
#
# If two elements are given, the second element is the default value of
# the variable. This is then overwritten if the option exists in ARGS.
+# If EVAL, then subst is called on the value, which allows variables
+# to be used.
#
# Any parse_args elements in (the caller's) ARGS will be removed, leaving
# any optional components.
-
+#
# Example:
# proc myproc {foo args} {
-# parse_args {{bar} {baz "abc"} {qux}}
+# parse_list args 1 {{bar} {baz "abc"} {qux}} "-" false
# # ...
# }
# myproc ABC -bar -baz DEF peanut butter
# foo (=ABC), bar (=1), baz (=DEF), and qux (=0)
# args will be the list {peanut butter}
-proc parse_args { argset } {
- upvar args args
+proc parse_list { level listname argset prefix eval } {
+ upvar $level $listname args
foreach argument $argset {
- if {[llength $argument] == 1} {
- # No default specified, so we assume that we should set
- # the value to 1 if the arg is present and 0 if it's not.
- # It is assumed that no value is given with the argument.
- set result [lsearch -exact $args "-$argument"]
- if {$result != -1} then {
- uplevel 1 [list set $argument 1]
- set args [lreplace $args $result $result]
- } else {
- uplevel 1 [list set $argument 0]
- }
- } elseif {[llength $argument] == 2} {
- # There are two items in the argument. The second is a
- # default value to use if the item is not present.
- # Otherwise, the variable is set to whatever is provided
- # after the item in the args.
- set arg [lindex $argument 0]
- set result [lsearch -exact $args "-[lindex $arg 0]"]
- if {$result != -1} then {
- uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
- set args [lreplace $args $result [expr $result+1]]
- } else {
- uplevel 1 [list set $arg [lindex $argument 1]]
- }
- } else {
- error "Badly formatted argument \"$argument\" in argument set"
- }
+ if {[llength $argument] == 1} {
+ # Normalize argument, strip leading/trailing whitespace.
+ # Allows us to treat {foo} and { foo } the same.
+ set argument [string trim $argument]
+
+ # No default specified, so we assume that we should set
+ # the value to 1 if the arg is present and 0 if it's not.
+ # It is assumed that no value is given with the argument.
+ set pattern "$prefix$argument"
+ set result [lsearch -exact $args $pattern]
+
+ if {$result != -1} then {
+ set value 1
+ set args [lreplace $args $result $result]
+ } else {
+ set value 0
+ }
+ uplevel $level [list set $argument $value]
+ } elseif {[llength $argument] == 2} {
+ # There are two items in the argument. The second is a
+ # default value to use if the item is not present.
+ # Otherwise, the variable is set to whatever is provided
+ # after the item in the args.
+ set arg [lindex $argument 0]
+ set pattern "$prefix[lindex $arg 0]"
+ set result [lsearch -exact $args $pattern]
+
+ if {$result != -1} then {
+ set value [lindex $args [expr $result+1]]
+ if { $eval } {
+ set value [uplevel [expr $level + 1] [list subst $value]]
+ }
+ set args [lreplace $args $result [expr $result+1]]
+ } else {
+ set value [lindex $argument 1]
+ if { $eval } {
+ set value [uplevel $level [list subst $value]]
+ }
+ }
+ uplevel $level [list set $arg $value]
+ } else {
+ error "Badly formatted argument \"$argument\" in argument set"
+ }
}
+}
+
+# Search the caller's args variable and set variables according to the list of
+# valid options described by ARGSET.
+
+proc parse_args { argset } {
+ parse_list 2 args $argset "-" false
# The remaining args should be checked to see that they match the
# number of items expected to be passed into the procedure...
}
+# Process the caller's options variable and set variables according
+# to the list of valid options described by OPTIONSET.
+
+proc parse_options { optionset } {
+ parse_list 2 options $optionset "" true
+
+ # Require no remaining options.
+ upvar 1 options options
+ if { [llength $options] != 0 } {
+ error "Options left unparsed: $options"
+ }
+}
+
# Capture the output of COMMAND in a string ignoring PREFIX (a regexp);
# return that string.
# being.
proc multi_line { args } {
+ if { [llength $args] == 1 } {
+ set hint "forgot {*} before list argument?"
+ error "multi_line called with one argument ($hint)"
+ }
return [join $args "\r\n"]
}
}
# First ensure logging is off.
- send_gdb "set logging off\n"
+ send_gdb "set logging enabled off\n"
set debugfile [standard_output_file gdb.debug]
send_gdb "set logging file $debugfile\n"
}
# Now that everything is set, enable logging.
- send_gdb "set logging on\n"
+ send_gdb "set logging enabled on\n"
gdb_expect 10 {
-re "Copying output to $debugfile.*Redirecting debug output to $debugfile.*$gdb_prompt $" {}
timeout { warning "Couldn't set logging file" }
}
}
-# Does the compiler support CTF debug output using '-gt' compiler
+# Does the compiler support CTF debug output using '-gctf' compiler
# flag? If not then we should skip these tests. We should also
# skip them if libctf was explicitly disabled.
int main () {
return 0;
}
- } executable "additional_flags=-gt"]
+ } executable "additional_flags=-gctf"]
return [expr {!$can_ctf}]
}
} else {
set re ""
}
+
+ set readnow_p 0
+ # Given the listing from the following command can be very verbose, match
+ # the patterns line-by-line. This prevents timeouts from waiting for
+ # too much data to come at once.
set cmd "maint print objfiles $re"
- gdb_test_multiple $cmd "" {
- -re -wrap "\r\n.gdb_index: faked for \"readnow\"\r\n.*" {
- return 1
+ gdb_test_multiple $cmd "" -lbl {
+ -re "\r\n.gdb_index: faked for \"readnow\"" {
+ # Record the we've seen the above pattern.
+ set readnow_p 1
+ exp_continue
}
-re -wrap "" {
- return 0
+ # We don't care about any other input.
}
}
- return 0
+ return $readnow_p
+}
+
+# Return index name if symbols were read in using an index.
+# Otherwise, return "".
+
+proc have_index { objfile } {
+
+ set res ""
+ set cmd "maint print objfiles $objfile"
+ gdb_test_multiple $cmd "" -lbl {
+ -re "\r\n.gdb_index: faked for \"readnow\"" {
+ set res ""
+ exp_continue
+ }
+ -re "\r\n.gdb_index:" {
+ set res "gdb_index"
+ exp_continue
+ }
+ -re "\r\n.debug_names:" {
+ set res "debug_names"
+ exp_continue
+ }
+ -re -wrap "" {
+ # We don't care about any other input.
+ }
+ }
+
+ return $res
}
# Return 1 if partial symbols are available. Otherwise, return 0.
# Add a .gdb_index section to PROGRAM.
# PROGRAM is assumed to be the output of standard_output_file.
# Returns the 0 if there is a failure, otherwise 1.
+#
+# STYLE controls which style of index to add, if needed. The empty
+# string (the default) means .gdb_index; "-dwarf-5" means .debug_names.
-proc add_gdb_index { program } {
- global srcdir GDB env BUILD_DATA_DIRECTORY
+proc add_gdb_index { program {style ""} } {
+ global srcdir GDB env
set contrib_dir "$srcdir/../contrib"
- set env(GDB) "$GDB --data-directory=$BUILD_DATA_DIRECTORY"
- set result [catch "exec $contrib_dir/gdb-add-index.sh $program" output]
+ set env(GDB) [append_gdb_data_directory_option $GDB]
+ set result [catch "exec $contrib_dir/gdb-add-index.sh $style $program" output]
if { $result != 0 } {
verbose -log "result is $result"
verbose -log "output is $output"
# (.gdb_index/.debug_names). Gdb doesn't support building an index from a
# program already using one. Return 1 if a .gdb_index was added, return 0
# if it already contained an index, and -1 if an error occurred.
+#
+# STYLE controls which style of index to add, if needed. The empty
+# string (the default) means .gdb_index; "-dwarf-5" means .debug_names.
+
+proc ensure_gdb_index { binfile {style ""} } {
+ global decimal
-proc ensure_gdb_index { binfile } {
set testfile [file tail $binfile]
set test "check if index present"
- gdb_test_multiple "mt print objfiles ${testfile}" $test {
- -re -wrap "gdb_index.*" {
- return 0
+ set has_index 0
+ set has_readnow 0
+ gdb_test_multiple "mt print objfiles ${testfile}" $test -lbl {
+ -re "\r\n\\.gdb_index: version ${decimal}(?=\r\n)" {
+ set has_index 1
+ gdb_test_lines "" $gdb_test_name ".*"
}
- -re -wrap "debug_names.*" {
- return 0
+ -re "\r\n\\.debug_names: exists(?=\r\n)" {
+ set has_index 1
+ gdb_test_lines "" $gdb_test_name ".*"
}
- -re -wrap "Psymtabs.*" {
- if { [add_gdb_index $binfile] != "1" } {
- return -1
- }
- return 1
+ -re "\r\n(Cooked index in use|Psymtabs)(?=\r\n)" {
+ gdb_test_lines "" $gdb_test_name ".*"
+ }
+ -re ".gdb_index: faked for \"readnow\"" {
+ set has_readnow 1
+ gdb_test_lines "" $gdb_test_name ".*"
}
+ -re -wrap "" {
+ fail $gdb_test_name
+ }
+ }
+
+ if { $has_index } {
+ return 0
}
+
+ if { $has_readnow } {
+ return -1
+ }
+
+ if { [add_gdb_index $binfile $style] == "1" } {
+ return 1
+ }
+
return -1
}
# the override
# So, we use this more elaborate but cleaner mechanism.
- # Save the old proc.
- set old_args [info args $name]
- set old_body [info body $name]
+ # Save the old proc, if it exists.
+ if { [info procs $name] != "" } {
+ set old_args [info args $name]
+ set old_body [info body $name]
+ set existed true
+ } else {
+ set existed false
+ }
# Install the override.
set new_args [info args $override]
# Execute body.
set code [catch {uplevel 1 $body} result]
- # Restore old proc.
- eval proc $name {$old_args} {$old_body}
+ # Restore old proc if it existed on entry, else delete it.
+ if { $existed } {
+ eval proc $name {$old_args} {$old_body}
+ } else {
+ rename $name ""
+ }
# Return as appropriate.
if { $code == 1 } {
# finalization function.
proc tuiterm_env { } {
load_lib tuiterm.exp
-
- # Do initialization.
- tuiterm_env_init
-
- # Schedule finalization.
- global gdb_finish_hooks
- lappend gdb_finish_hooks tuiterm_env_finish
}
# Dejagnu has a version of note, but usage is not allowed outside of dejagnu.
return [gdb_simple_compile $me $src executable $flags]
}
+# Return 1 if linker supports -Ttext-segment, otherwise return 0.
+gdb_caching_proc linker_supports_Ttext_segment_flag {
+ set me "linker_supports_Ttext_segment_flag"
+ set flags additional_flags="-Wl,-Ttext-segment=0x7000000"
+ set src { int main() { return 0; } }
+ return [gdb_simple_compile $me $src executable $flags]
+}
+
+# Return 1 if linker supports -Ttext, otherwise return 0.
+gdb_caching_proc linker_supports_Ttext_flag {
+ set me "linker_supports_Ttext_flag"
+ set flags additional_flags="-Wl,-Ttext=0x7000000"
+ set src { int main() { return 0; } }
+ return [gdb_simple_compile $me $src executable $flags]
+}
+
+# Return 1 if linker supports --image-base, otherwise 0.
+gdb_caching_proc linker_supports_image_base_flag {
+ set me "linker_supports_image_base_flag"
+ set flags additional_flags="-Wl,--image-base=0x7000000"
+ set src { int main() { return 0; } }
+ return [gdb_simple_compile $me $src executable $flags]
+}
+
+
# Return 1 if compiler supports scalar_storage_order attribute, otherwise
# return 0.
gdb_caching_proc supports_scalar_storage_order_attribute {
remote_file build delete $obj
+ if { $status == 0 } {
+ verbose "$me: returning $status" 2
+ return $status
+ }
+
+ # Compile program with -mmpx -fcheck-pointer-bounds, try to trigger
+ # 'No MPX support', in other words, see if kernel supports mpx.
+ set src { int main (void) { return 0; } }
+ set comp_flags {}
+ append comp_flags " additional_flags=-mmpx"
+ append comp_flags " additional_flags=-fcheck-pointer-bounds"
+ if {![gdb_simple_compile $me-2 $src executable $comp_flags]} {
+ return 0
+ }
+
+ set result [remote_exec target $obj]
+ set status [lindex $result 0]
+ set output [lindex $result 1]
+ set status [expr ($status == 0) \
+ && ![string equal $output "No MPX support\r\n"]]
+
+ remote_file build delete $obj
+
verbose "$me: returning $status" 2
return $status
}
+# Return 1 if target supports avx, otherwise return 0.
+gdb_caching_proc have_avx {
+ global srcdir
+
+ set me "have_avx"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support avx, returning 0" 2
+ return 0
+ }
+
+ # Compile a test program.
+ set src {
+ #include "nat/x86-cpuid.h"
+
+ int main() {
+ unsigned int eax, ebx, ecx, edx;
+
+ if (!x86_cpuid (1, &eax, &ebx, &ecx, &edx))
+ return 0;
+
+ if ((ecx & (bit_AVX | bit_OSXSAVE)) == (bit_AVX | bit_OSXSAVE))
+ return 1;
+ else
+ return 0;
+ }
+ }
+ set compile_flags "incdir=${srcdir}/.."
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
+ return 0
+ }
+
+ set result [remote_exec target $obj]
+ set status [lindex $result 0]
+ set output [lindex $result 1]
+ if { $output != "" } {
+ set status 0
+ }
+
+ remote_file build delete $obj
+
+ verbose "$me: returning $status" 2
+ return $status
+}
+
+# Called as either:
+# - require EXPR VAL
+# - require EXPR OP VAL
+# In the first case, OP is ==.
+#
+# Require EXPR OP VAL, where EXPR is evaluated in caller context. If not,
+# return in the caller's context.
+
+proc require { fn arg1 {arg2 ""} } {
+ if { $arg2 == "" } {
+ set op ==
+ set val $arg1
+ } else {
+ set op $arg1
+ set val $arg2
+ }
+ set res [uplevel 1 $fn]
+ if { [expr $res $op $val] } {
+ return
+ }
+
+ switch "$fn $op $val" {
+ "gdb_skip_xml_test == 0" { set msg "missing xml support" }
+ "ensure_gdb_index $binfile != -1" -
+ "ensure_gdb_index $binfile -dwarf-5 != -1" {
+ set msg "Couldn't ensure index in binfile"
+ }
+ "use_gdb_stub == 0" {
+ set msg "Remote stub used"
+ }
+ default { set msg "$fn != $val" }
+ }
+
+ untested $msg
+ return -code return 0
+}
+
+# Wait up to ::TIMEOUT seconds for file PATH to exist on the target system.
+# Return 1 if it does exist, 0 otherwise.
+
+proc target_file_exists_with_timeout { path } {
+ for {set i 0} {$i < $::timeout} {incr i} {
+ if { [remote_file target exists $path] } {
+ return 1
+ }
+
+ sleep 1
+ }
+
+ return 0
+}
+
+gdb_caching_proc has_hw_wp_support {
+ # Power 9, proc rev 2.2 does not support HW watchpoints due to HW bug.
+ # Need to use a runtime test to determine if the Power processor has
+ # support for HW watchpoints.
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set compile_flags {debug nowarnings quiet}
+ set me "has_hw_wp_support"
+
+ # Compile a test program to test if HW watchpoints are supported
+ set src {
+ int main (void) {
+ volatile int local;
+ local = 1;
+ if (local == 1)
+ return 1;
+ return 0;
+ }
+ }
+
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
+ return 0
+ }
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$obj"
+
+ if ![runto_main] {
+ set has_hw_wp_support 0
+ return $has_hw_wp_support
+ }
+
+ # The goal is to determine if HW watchpoints are available in general.
+ # Use "watch" and then check if gdb responds with hardware watch point.
+ set test "watch local"
+
+ gdb_test_multiple $test "Check for HW watchpoint support" {
+ -re ".*Hardware watchpoint.*" {
+ # HW watchpoint supported by platform
+ verbose -log "\n$me: Hardware watchpoint detected"
+ set has_hw_wp_support 1
+ }
+ -re ".*$gdb_prompt $" {
+ set has_hw_wp_support 0
+ verbose -log "\n$me: Default, hardware watchpoint not deteced"
+ }
+ }
+
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $has_hw_wp_support" 2
+ return $has_hw_wp_support
+}
+
+# Return a list of all the accepted values of the set command SET_CMD.
+
+proc get_set_option_choices {set_cmd} {
+ global gdb_prompt
+
+ set values {}
+
+ set test "complete $set_cmd"
+ gdb_test_multiple "complete $set_cmd " "$test" {
+ -re "$set_cmd (\[^\r\n\]+)\r\n" {
+ lappend values $expect_out(1,string)
+ exp_continue
+ }
+ -re "$gdb_prompt " {
+ pass $test
+ }
+ }
+ return $values
+}
+
+# Return the compiler that can generate 32-bit ARM executables. Used
+# when testing biarch support on Aarch64. If ARM_CC_FOR_TARGET is
+# set, use that. If not, try a few common compiler names, making sure
+# that the executable they produce can run.
+
+gdb_caching_proc arm_cc_for_target {
+ if {[info exists ARM_CC_FOR_TARGET]} {
+ # If the user specified the compiler explicitly, then don't
+ # check whether the resulting binary runs outside GDB. Assume
+ # that it does, and if it turns out it doesn't, then the user
+ # should get loud FAILs, instead of UNSUPPORTED.
+ return $ARM_CC_FOR_TARGET
+ }
+
+ # Fallback to a few common compiler names. Also confirm the
+ # produced binary actually runs on the system before declaring
+ # we've found the right compiler.
+
+ if [istarget "*-linux*-*"] {
+ set compilers {
+ arm-linux-gnueabi-gcc
+ arm-none-linux-gnueabi-gcc
+ arm-linux-gnueabihf-gcc
+ }
+ } else {
+ set compilers {}
+ }
+
+ foreach compiler $compilers {
+ if {![is_remote host] && [which $compiler] == 0} {
+ # Avoid "default_target_compile: Can't find
+ # $compiler." warning issued from gdb_compile.
+ continue
+ }
+
+ set src { int main() { return 0; } }
+ if {[gdb_simple_compile aarch64-32bit \
+ $src \
+ executable [list compiler=$compiler]]} {
+
+ set result [remote_exec target $obj]
+ set status [lindex $result 0]
+ set output [lindex $result 1]
+
+ file delete $obj
+
+ if { $output == "" && $status == 0} {
+ return $compiler
+ }
+ }
+ }
+
+ return ""
+}
+
# Always load compatibility stuff.
load_lib future.exp
projects / binutils-gdb.git / blobdiff