-# Copyright 1992-2020 Free Software Foundation, Inc.
+# Copyright 1992-2021 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
# INTERNAL_GDBFLAGS contains flags that the testsuite requires.
global INTERNAL_GDBFLAGS
if ![info exists INTERNAL_GDBFLAGS] {
- set INTERNAL_GDBFLAGS "-nw -nx -data-directory $BUILD_DATA_DIRECTORY"
+ set INTERNAL_GDBFLAGS \
+ [join [list \
+ "-nw" \
+ "-nx" \
+ "-data-directory $BUILD_DATA_DIRECTORY" \
+ {-iex "set height 0"} \
+ {-iex "set width 0"}]]
}
# The variable gdb_prompt is a regexp which matches the gdb prompt.
# 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, passfail and qualified.
+# 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
return 0
}
eof {
+ perror "GDB process no longer exists"
+ global gdb_spawn_id
+ set wait_status [wait -i $gdb_spawn_id]
+ verbose -log "GDB process exited with wait status $wait_status"
if { $print_fail } {
fail "$test_name (eof)"
}
return 0
}
-re ".*A problem internal to GDB has been detected" {
- if { $print_fail } {
- fail "$test_name (GDB internal error)"
- }
+ # Always emit a FAIL if we encounter an internal error: internal
+ # errors are never expected.
+ fail "$test_name (GDB internal error)"
gdb_internal_error_resync
return 0
}
# If you don't want that, use gdb_start_cmd.
proc runto_main { } {
- return [runto main no-message]
+ return [runto main no-message qualified]
}
### Continue, and expect to hit a breakpoint.
}
-# gdb_test_multiple COMMAND MESSAGE [ -promp PROMPT_REGEXP] [ -lbl ]
+# gdb_test_multiple COMMAND MESSAGE [ -prompt PROMPT_REGEXP] [ -lbl ]
# EXPECT_ARGUMENTS
# Send a command to gdb; test the result.
#
if { $foo < [expr $len - 1] } {
set str [string range "$string" 0 $foo]
if { [send_gdb "$str"] != "" } {
- global suppress_flag
-
- if { ! $suppress_flag } {
- perror "Couldn't send $command to GDB."
- }
- fail "$message"
- return $result
+ perror "Couldn't send $command to GDB."
}
# since we're checking if each line of the multi-line
# command are 'accepted' by GDB here,
}
if { "$string" != "" } {
if { [send_gdb "$string"] != "" } {
- global suppress_flag
-
- if { ! $suppress_flag } {
- perror "Couldn't send $command to GDB."
- }
- fail "$message"
- return $result
+ perror "Couldn't send $command to GDB."
}
}
}
+ drain_gdbserver_output
+
set code $early_processed_code
append code {
-re ".*A problem internal to GDB has been detected" {
if { $message != "" } {
fail "$message"
}
- gdb_suppress_entire_file "GDB died"
set result -1
}
}
return $result
}
+# Usage: gdb_test_multiline NAME INPUT RESULT {INPUT RESULT} ...
+# Run a test named NAME, consisting of multiple lines of input.
+# After each input line INPUT, search for result line RESULT.
+# Succeed if all results are seen; fail otherwise.
+
+proc gdb_test_multiline { name args } {
+ global gdb_prompt
+ set inputnr 0
+ foreach {input result} $args {
+ incr inputnr
+ if {[gdb_test_multiple $input "$name: input $inputnr: $input" {
+ -re "\[\r\n\]*($result)\[\r\n\]+($gdb_prompt | *>)$" {
+ pass $gdb_test_name
+ }
+ }]} {
+ return 1
+ }
+ }
+ return 0
+}
+
+
# gdb_test COMMAND PATTERN MESSAGE QUESTION RESPONSE
# Send a command to gdb; test the result.
#
# EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are
# processed in order, and all must be present in the output.
#
+# The -prompt switch can be used to override the prompt expected at the end of
+# the output sequence.
+#
# It is unnecessary to specify ".*" at the beginning or end of any regexp,
# there is an implicit ".*" between each element of EXPECTED_OUTPUT_LIST.
# There is also an implicit ".*" between the last regexp and the gdb prompt.
# 0 if the test passes,
# -1 if there was an internal error.
-proc gdb_test_sequence { command test_name expected_output_list } {
+proc gdb_test_sequence { args } {
global gdb_prompt
+
+ parse_args {{prompt ""}}
+
+ if { $prompt == "" } {
+ set prompt "$gdb_prompt $"
+ }
+
+ if { [llength $args] != 3 } {
+ error "Unexpected # of arguments, expecting: COMMAND TEST_NAME EXPECTED_OUTPUT_LIST"
+ }
+
+ lassign $args command test_name expected_output_list
+
if { $test_name == "" } {
set test_name $command
}
+
lappend expected_output_list ""; # implicit ".*" before gdb prompt
+
if { $command != "" } {
send_gdb "$command\n"
}
- return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list]
+
+ return [gdb_expect_list $test_name $prompt $expected_output_list]
}
\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
+# '
+
+proc gdb_test_lines { command message re } {
+ set found 0
+ set idx 0
+ 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
+}
+
# 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
return $res
}
+# Wrapper around gdb_test_multiple to be used when testing expression
+# evaluation while 'set debug expression 1' is in effect.
+# Looks for some patterns that indicates the expression was rejected.
+#
+# CMD is the command to execute, which should include an expression
+# that GDB will need to parse.
+#
+# OUTPUT is the expected output pattern.
+#
+# TESTNAME is the name to be used for the test, defaults to CMD if not
+# given.
+proc gdb_test_debug_expr { cmd output {testname "" }} {
+ global gdb_prompt
+
+ if { ${testname} == "" } {
+ set testname $cmd
+ }
+
+ gdb_test_multiple $cmd $testname {
+ -re ".*Invalid expression.*\r\n$gdb_prompt $" {
+ fail $gdb_test_name
+ }
+ -re ".*\[\r\n\]$output\r\n$gdb_prompt $" {
+ pass $gdb_test_name
+ }
+ }
+}
+
# get_print_expr_at_depths EXP OUTPUTS
#
# Used for testing 'set print max-depth'. Prints the expression EXP
set message $condition
}
- set res [uplevel 1 expr $condition]
- if {!$res} {
+ set code [catch {uplevel 1 expr $condition} res]
+ if {$code == 1} {
+ # If code is 1 (TCL_ERROR), it means evaluation failed and res contains
+ # an error message. Print the error message, and set res to 0 since we
+ # want to return a boolean.
+ warning "While evaluating expression in gdb_assert: $res"
+ unresolved $message
+ set res 0
+ } elseif { !$res } {
fail $message
} else {
pass $message
global gdb_spawn_id inferior_spawn_id
global inotify_log_file
- gdb_stop_suppressing_tests
-
if ![info exists gdb_spawn_id] {
return
}
remote_close host
}
unset gdb_spawn_id
+ unset ::gdb_tty_name
unset inferior_spawn_id
}
# compiled in
# fail file was not loaded
#
+# This procedure also set the global variable GDB_FILE_CMD_MSG to the
+# output of the file command in case of success.
+#
# I tried returning this information as part of the return value,
# but ran into a mess because of the many re-implementations of
# gdb_load in config/*.exp.
global GDB
global last_loaded_file
+ # GCC for Windows target may create foo.exe given "-o foo".
+ if { ![file exists $arg] && [file exists "$arg.exe"] } {
+ set arg "$arg.exe"
+ }
+
# Save this for the benefit of gdbserver-support.exp.
set last_loaded_file $arg
# Set whether debug info was found.
# Default to "fail".
- global gdb_file_cmd_debug_info
+ global gdb_file_cmd_debug_info gdb_file_cmd_msg
set gdb_file_cmd_debug_info "fail"
if [is_remote host] {
set new_symbol_table 0
set basename [file tail $arg]
gdb_expect 120 {
- -re "Reading symbols from.*LZMA support was disabled.*$gdb_prompt $" {
+ -re "(Reading symbols from.*LZMA support was disabled.*$gdb_prompt $)" {
verbose "\t\tLoaded $arg into $GDB; .gnu_debugdata found but no LZMA available"
+ set gdb_file_cmd_msg $expect_out(1,string)
set gdb_file_cmd_debug_info "lzma"
return 0
}
- -re "Reading symbols from.*no debugging symbols found.*$gdb_prompt $" {
+ -re "(Reading symbols from.*no debugging symbols found.*$gdb_prompt $)" {
verbose "\t\tLoaded $arg into $GDB with no debugging symbols"
+ set gdb_file_cmd_msg $expect_out(1,string)
set gdb_file_cmd_debug_info "nodebug"
return 0
}
- -re "Reading symbols from.*$gdb_prompt $" {
+ -re "(Reading symbols from.*$gdb_prompt $)" {
verbose "\t\tLoaded $arg into $GDB"
+ set gdb_file_cmd_msg $expect_out(1,string)
set gdb_file_cmd_debug_info "debug"
return 0
}
}
}
+# 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] } {
+ set ::last_spawn_tty_name $spawn_out(slave,name)
+ } else {
+ unset ::last_spawn_tty_name
+ }
+ return $result
+}
+
+rename spawn builtin_spawn
+rename spawn_capture_tty_name spawn
+
# Default gdb_spawn procedure.
proc default_gdb_spawn { } {
global INTERNAL_GDBFLAGS GDBFLAGS
global gdb_spawn_id
- gdb_stop_suppressing_tests
-
# Set the default value, it may be overriden later by specific testfile.
#
# Use `set_board_info use_gdb_stub' for the board file to flag the inferior
}
set gdb_spawn_id $res
+ set ::gdb_tty_name $::last_spawn_tty_name
return 0
}
# 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
# Return a 1 for configurations for which don't have both C++ and the STL.
proc skip_stl_tests {} {
- # Symbian supports the C++ language, but the STL is missing
- # (both headers and libraries).
- if { [istarget "arm*-*-symbianelf*"] } {
- return 1
- }
-
return [skip_cplus_tests]
}
# Return 1 to skip Rust tests, 0 to try them.
proc skip_rust_tests {} {
- return [expr {![isnative]}]
+ if { ![isnative] } {
+ return 1
+ }
+
+ # The rust compiler does not support "-m32", skip.
+ global board board_info
+ set board [target_info name]
+ if {[board_info $board exists multilib_flags]} {
+ foreach flag [board_info $board multilib_flags] {
+ if { $flag == "-m32" } {
+ return 1
+ }
+ }
+ }
+
+ return 0
}
# Return a 1 for configurations that do not support Python scripting.
if {([istarget *-*-linux*]
|| [istarget *-*-*bsd*]
|| [istarget *-*-solaris2*]
- || [istarget arm*-*-symbianelf*]
|| [istarget *-*-mingw*]
|| [istarget *-*-cygwin*]
|| [istarget *-*-pe*])} {
}
}
+# As save_vars, but for variables stored in the board_info for the
+# target board.
+#
+# Usage example:
+#
+# save_target_board_info { multilib_flags } {
+# global board
+# set board [target_info name]
+# unset_board_info multilib_flags
+# set_board_info multilib_flags "$multilib_flags"
+# ...
+# }
+
+proc save_target_board_info { vars body } {
+ global board board_info
+ set board [target_info name]
+
+ array set saved_target_board_info { }
+ set unset_target_board_info { }
+
+ foreach var $vars {
+ if { [info exists board_info($board,$var)] } {
+ set saved_target_board_info($var) [board_info $board $var]
+ } else {
+ lappend unset_target_board_info $var
+ }
+ }
+
+ set code [catch {uplevel 1 $body} result]
+
+ foreach {var value} [array get saved_target_board_info] {
+ unset_board_info $var
+ set_board_info $var $value
+ }
+
+ foreach var $unset_target_board_info {
+ unset_board_info $var
+ }
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
# Run tests in BODY with the current working directory (CWD) set to
# DIR. When BODY is finished, restore the original CWD. Return the
# result of BODY.
}
}
+# 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 {} {
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.
return $skip_tsx_tests
}
+# Run a test on the target to see if it supports avx512bf16. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+gdb_caching_proc skip_avx512bf16_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_avx512bf16_tests"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support avx512bf16, returning 1" 2
+ return 1
+ }
+
+ # Compile a test program.
+ set src {
+ int main() {
+ asm volatile ("vcvtne2ps2bf16 %xmm0, %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: avx512bf16 hardware not detected."
+ set skip_avx512bf16_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "$me: avx512bf16 hardware detected."
+ set skip_avx512bf16_tests 0
+ }
+ default {
+ warning "\n$me: default case taken."
+ set skip_avx512bf16_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_avx512bf16_tests" 2
+ return $skip_avx512bf16_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.
# This is the preferred way of checking use_gdb_stub, since it allows to check
# the value before the gdb has been spawned and it will return the correct value
# even when it was overriden by the test.
+#
+# Note that stub targets are not able to spawn new inferiors. Use this
+# check for skipping respective tests.
proc use_gdb_stub {} {
global use_gdb_stub
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 compiler_info
+ global decimal
+ if { ![test_compiler_info "gcc-*"] } {
+ return -1
+ }
+ set res [regexp gcc-($decimal)-($decimal)- $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)] {
set gdb_wrapper_initialized 0
set gdb_wrapper_target ""
+set gdb_wrapper_file ""
+set gdb_wrapper_flags ""
proc gdb_wrapper_init { args } {
global gdb_wrapper_initialized
global gdb_wrapper_flags
global gdb_wrapper_target
- # If the wrapper is initialized but the wrapper file cannot be
- # found anymore, the wrapper file must be built again.
- if { $gdb_wrapper_initialized == 1 && \
- [info exists gdb_wrapper_file] && \
- ![file exists $gdb_wrapper_file] } {
- verbose "reinitializing the wrapper"
- set gdb_wrapper_initialized 0
- }
-
if { $gdb_wrapper_initialized == 1 } { return; }
if {[target_info exists needs_status_wrapper] && \
[target_info needs_status_wrapper] != "0"} {
- set result [build_wrapper [standard_output_file "testglue.o"]]
+ set result [build_wrapper "testglue.o"]
if { $result != "" } {
set gdb_wrapper_file [lindex $result 0]
+ if ![is_remote host] {
+ set gdb_wrapper_file [file join [pwd] $gdb_wrapper_file]
+ }
set gdb_wrapper_flags [lindex $result 1]
} else {
warning "Status wrapper failed to build."
}
+ } else {
+ set gdb_wrapper_file ""
+ set gdb_wrapper_flags ""
}
+ verbose "set gdb_wrapper_file = $gdb_wrapper_file"
set gdb_wrapper_initialized 1
set gdb_wrapper_target [current_target_name]
}
# - 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: Compile the file as Ada, C++ or Fortran.
+# - ada, c++, f77, f90, go, rust: Compile the file as Ada, C++,
+# Fortran 77, Fortran 90, Go or Rust.
# - debug: Build with debug information.
# - optimize: Build with optimization.
global GDB_TESTCASE_OPTIONS
global gdb_wrapper_file
global gdb_wrapper_flags
- global gdb_wrapper_initialized
global srcdir
global objdir
global gdb_saved_set_unbuffered_mode_obj
set new_options [universal_compile_options]
}
+ # Some C/C++ testcases unconditionally pass -Wno-foo as additional
+ # options to disable some warning. That is OK with GCC, because
+ # by design, GCC accepts any -Wno-foo option, even if it doesn't
+ # support -Wfoo. Clang however warns about unknown -Wno-foo by
+ # 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
+ && [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-*"]} {
+ lappend new_options "additional_flags=-Wno-unknown-warning-option"
+ }
+
+ # Treating .c input files as C++ is deprecated in Clang, so
+ # explicitly force C++ language.
+ if { [lsearch -exact $options getting_compiler_info] == -1
+ && [lsearch -exact $options c++] != -1
+ && [string match *.c $source] != 0 } {
+
+ # gdb_compile cannot handle this combination of options, the
+ # result is a command like "clang -x c++ foo.c bar.so -o baz"
+ # which tells Clang to treat bar.so as C++. The solution is
+ # to call gdb_compile twice--once to compile, once to link--
+ # either directly, or via build_executable_from_specs.
+ if { [lsearch $options shlib=*] != -1 } {
+ error "incompatible gdb_compile options"
+ }
+
+ if {[test_compiler_info "clang-*"]} {
+ lappend new_options early_flags=-x\ c++
+ }
+ }
+
# 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 } {
# Fortran compile.
set mod_path [standard_output_file ""]
- lappend new_options "additional_flags=-J${mod_path}"
+ if [test_compiler_info "gcc-*"] {
+ lappend new_options "additional_flags=-J${mod_path}"
+ }
}
set shlib_found 0
# Do not need anything.
} elseif { [istarget *-*-freebsd*] || [istarget *-*-openbsd*] } {
lappend new_options "ldflags=-Wl,-rpath,${outdir}"
- } elseif { [istarget arm*-*-symbianelf*] } {
- if { $shlib_load } {
- lappend new_options "libs=-ldl"
- }
} else {
if { $shlib_load } {
lappend new_options "libs=-ldl"
if {[target_info exists needs_status_wrapper] && \
[target_info needs_status_wrapper] != "0" && \
- [info exists gdb_wrapper_file]} {
+ $gdb_wrapper_file != "" } {
lappend options "libs=${gdb_wrapper_file}"
lappend options "ldflags=${gdb_wrapper_flags}"
}
lappend options "$flag"
}
- # Replace the "nopie" option with the appropriate linker flag to disable
- # PIE executables. There are no compiler flags for this option.
+ # Replace the "nopie" option with the appropriate compiler and linker
+ # flags to disable PIE executables.
set nopie [lsearch -exact $options nopie]
if {$nopie != -1} {
if [target_info exists gdb,nopie_flag] {
- set flag "ldflags=[target_info gdb,nopie_flag]"
+ set flag "additional_flags=[target_info gdb,nopie_flag]"
} else {
- set flag "ldflags=-no-pie"
+ set flag "additional_flags=-fno-pie"
}
set options [lreplace $options $nopie $nopie $flag]
+
+ if [target_info exists gdb,nopie_ldflag] {
+ set flag "ldflags=[target_info gdb,nopie_ldflag]"
+ } else {
+ set flag "ldflags=-no-pie"
+ }
+ lappend options "$flag"
}
if { $type == "executable" } {
# Build a shared library from SOURCES.
-proc gdb_compile_shlib {sources dest options} {
+proc gdb_compile_shlib_1 {sources dest options} {
set obj_options $options
+ set ada 0
+ if { [lsearch -exact $options "ada"] >= 0 } {
+ set ada 1
+ }
+
set info_options ""
if { [lsearch -exact $options "c++"] >= 0 } {
set info_options "c++"
lappend obj_options "additional_flags=-qpic"
}
"clang-*" {
- if { !([istarget "*-*-cygwin*"]
- || [istarget "*-*-mingw*"]) } {
+ if { [istarget "*-*-cygwin*"]
+ || [istarget "*-*-mingw*"] } {
+ lappend obj_options "additional_flags=-fPIC"
+ } else {
lappend obj_options "additional_flags=-fpic"
}
}
"gcc-*" {
- if { !([istarget "powerpc*-*-aix*"]
+ if { [istarget "powerpc*-*-aix*"]
|| [istarget "rs6000*-*-aix*"]
|| [istarget "*-*-cygwin*"]
|| [istarget "*-*-mingw*"]
- || [istarget "*-*-pe*"]) } {
+ || [istarget "*-*-pe*"] } {
+ lappend obj_options "additional_flags=-fPIC"
+ } else {
lappend obj_options "additional_flags=-fpic"
}
}
}
default {
# don't know what the compiler is...
+ lappend obj_options "additional_flags=-fPIC"
}
}
set outdir [file dirname $dest]
set objects ""
foreach source $sources {
- set sourcebase [file tail $source]
if {[file extension $source] == ".o"} {
# Already a .o file.
lappend objects $source
- } elseif {[gdb_compile $source "${outdir}/${sourcebase}.o" object \
- $obj_options] != ""} {
- return -1
+ continue
+ }
+
+ set sourcebase [file tail $source]
+
+ if { $ada } {
+ # Gnatmake doesn't like object name foo.adb.o, use foo.o.
+ set sourcebase [file rootname $sourcebase]
+ }
+ set object ${outdir}/${sourcebase}.o
+
+ if { $ada } {
+ # Use gdb_compile_ada_1 instead of gdb_compile_ada to avoid the
+ # PASS message.
+ if {[gdb_compile_ada_1 $source $object object \
+ $obj_options] != ""} {
+ return -1
+ }
} else {
- lappend objects ${outdir}/${sourcebase}.o
+ if {[gdb_compile $source $object object \
+ $obj_options] != ""} {
+ return -1
+ }
}
+
+ lappend objects $object
}
set link_options $options
+ if { $ada } {
+ # If we try to use gnatmake for the link, it will interpret the
+ # object file as an .adb file. Remove ada from the options to
+ # avoid it.
+ set idx [lsearch $link_options "ada"]
+ set link_options [lreplace $link_options $idx $idx]
+ }
if [test_compiler_info "xlc-*"] {
lappend link_options "additional_flags=-qmkshrobj"
} else {
return ""
}
+# Build a shared library from SOURCES. Ignore target boards PIE-related
+# multilib_flags.
+
+proc gdb_compile_shlib {sources dest options} {
+ global board
+
+ # Ignore PIE-related setting in multilib_flags.
+ set board [target_info name]
+ set multilib_flags_orig [board_info $board multilib_flags]
+ set multilib_flags ""
+ foreach op $multilib_flags_orig {
+ if { $op == "-pie" || $op == "-no-pie" \
+ || $op == "-fPIE" || $op == "-fno-PIE"} {
+ } else {
+ append multilib_flags " $op"
+ }
+ }
+
+ save_target_board_info { multilib_flags } {
+ unset_board_info multilib_flags
+ set_board_info multilib_flags "$multilib_flags"
+ set result [gdb_compile_shlib_1 $sources $dest $options]
+ }
+
+ return $result
+}
+
# This is just like gdb_compile_shlib, above, except that it tries compiling
# against several different thread libraries, to see which one this
# system has.
set why_msg "missing runtime threads library"
}
{^$} {
- pass "successfully compiled posix threads test case"
+ pass "successfully compiled posix threads shlib test case"
set built_binfile 1
break
}
# For options for TYPE see gdb_stdin_log_write
proc send_gdb { string {type standard}} {
- global suppress_flag
- if { $suppress_flag } {
- return "suppressed"
- }
gdb_stdin_log_write $string $type
return [remote_send host "$string"]
}
set tmt [get_largest_timeout]
}
- global suppress_flag
- global remote_suppress_flag
- if [info exists remote_suppress_flag] {
- set old_val $remote_suppress_flag
- }
- if [info exists suppress_flag] {
- if { $suppress_flag } {
- set remote_suppress_flag 1
- }
- }
set code [catch \
{uplevel remote_expect host $tmt $expcode} string]
- if [info exists old_val] {
- set remote_suppress_flag $old_val
- } else {
- if [info exists remote_suppress_flag] {
- unset remote_suppress_flag
- }
- }
if {$code == 1} {
global errorInfo errorCode
proc gdb_expect_list {test sentinel list} {
global gdb_prompt
- global suppress_flag
set index 0
set ok 1
- if { $suppress_flag } {
- set ok 0
- unresolved "${test}"
- }
+
while { ${index} < [llength ${list}] } {
set pattern [lindex ${list} ${index}]
set index [expr ${index} + 1]
}
}
-#
-#
-proc gdb_suppress_entire_file { reason } {
- global suppress_flag
-
- warning "$reason\n"
- set suppress_flag -1
-}
-
-#
-# Set suppress_flag, which will cause all subsequent calls to send_gdb and
-# gdb_expect to fail immediately (until the next call to
-# gdb_stop_suppressing_tests).
-#
-proc gdb_suppress_tests { args } {
- global suppress_flag
-
- return; # fnf - disable pending review of results where
- # testsuite ran better without this
- incr suppress_flag
-
- if { $suppress_flag == 1 } {
- if { [llength $args] > 0 } {
- warning "[lindex $args 0]\n"
- } else {
- warning "Because of previous failure, all subsequent tests in this group will automatically fail.\n"
- }
- }
-}
-
-#
-# Clear suppress_flag.
-#
-proc gdb_stop_suppressing_tests { } {
- global suppress_flag
-
- if [info exists suppress_flag] {
- if { $suppress_flag > 0 } {
- set suppress_flag 0
- clone_output "Tests restarted.\n"
- }
- } else {
- set suppress_flag 0
- }
-}
-
-proc gdb_clear_suppressed { } {
- global suppress_flag
-
- set suppress_flag 0
-}
-
# Spawn the gdb process.
#
# This doesn't expect any output or do any other initialization,
return 0
}
+#
+# with_complaints -- Execute BODY and set complaints temporary to N for the
+# duration.
+#
+proc with_complaints { n body } {
+ global decimal
+
+ # Save current setting of complaints.
+ set save ""
+ set show_complaints_re \
+ "Max number of complaints about incorrect symbols is ($decimal)\\."
+ gdb_test_multiple "show complaints" "" {
+ -re -wrap $show_complaints_re {
+ set save $expect_out(1,string)
+ }
+ }
+
+ if { $save == "" } {
+ perror "Did not manage to set complaints"
+ } else {
+ # Set complaints.
+ gdb_test_no_output "set complaints $n" ""
+ }
+
+ set code [catch {uplevel 1 $body} result]
+
+ # Restore saved setting of complaints.
+ if { $save != "" } {
+ gdb_test_no_output "set complaints $save" ""
+ }
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
+#
+# gdb_load_no_complaints -- As gdb_load, but in addition verifies that
+# loading caused no symbol reading complaints.
+#
+proc gdb_load_no_complaints { arg } {
+ global gdb_prompt gdb_file_cmd_msg decimal
+
+ # Temporarily set complaint to a small non-zero number.
+ with_complaints 5 {
+ gdb_load $arg
+ }
+
+ # Verify that there were no complaints.
+ set re "^Reading symbols from \[^\r\n\]*\r\n$gdb_prompt $"
+ gdb_assert {[regexp $re $gdb_file_cmd_msg]} "No complaints"
+}
+
# gdb_reload -- load a file into the target. Called before "running",
# either the first time or after already starting the program once,
# for remote targets. Most files that override gdb_load should now
setenv LC_CTYPE C
setenv LANG C
- # Don't let a .inputrc file or an existing setting of INPUTRC mess up
- # the test results. Even if /dev/null doesn't exist on the particular
- # platform, the readline library will use the default setting just by
- # failing to open the file. OTOH, opening /dev/null successfully will
- # also result in the default settings being used since nothing will be
- # read from this file.
- setenv INPUTRC "/dev/null"
+ # Don't let a .inputrc file or an existing setting of INPUTRC mess
+ # up the test results. Certain tests (style tests and TUI tests)
+ # want to set the terminal to a non-"dumb" value, and for those we
+ # want to disable bracketed paste mode. Versions of Readline
+ # before 8.0 will not understand this and will issue a warning.
+ # We tried using a $if to guard it, but Readline 8.1 had a bug in
+ # its version-comparison code that prevented this for working.
+ setenv INPUTRC [cached_file inputrc "set enable-bracketed-paste off"]
# This disables style output, which would interfere with many
# 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.
unset -nocomplain ::env(GDBHISTFILE)
unset -nocomplain ::env(GDBHISTSIZE)
+ # Ensure that XDG_CONFIG_HOME is not set. Some tests setup a fake
+ # home directory in order to test loading settings from gdbinit.
+ # If XDG_CONFIG_HOME is set then GDB will load a gdbinit from
+ # there (if one is present) rather than the home directory setup
+ # in the test.
+ unset -nocomplain ::env(XDG_CONFIG_HOME)
+
# Initialize GDB's pty with a fixed size, to make sure we avoid pagination
# during startup. See "man expect" for details about stty_init.
global stty_init
set cleanfiles {}
- gdb_clear_suppressed
-
set gdb_test_file_name [file rootname [file tail $test_file_name]]
# Make sure that the wrapper is rebuilt
rename ::unknown ::dejagnu_unknown
proc unknown { args } {
# Use tcl's unknown.
+ set cmd [lindex $args 0]
+ unresolved "testcase aborted due to invalid command name: $cmd"
return [uplevel 1 ::gdb_tcl_unknown $args]
}
}
proc standard_output_file_with_gdb_instance {basename} {
global gdb_instances
- set count [expr $gdb_instances - 1 ]
+ set count $gdb_instances
if {$count == 0} {
return [standard_output_file $basename]
# Without any arguments, the .exp file's base name is used to
# compute the source file name. The ".c" extension is added in this case.
# If ARGS is not empty, each entry is a source file specification.
-# If the specification starts with a ".", it is treated as a suffix
+# If the specification starts with a "." or "-", it is treated as a suffix
# to append to the .exp file's base name.
# If the specification is the empty string, it is treated as if it
# were ".c".
# Handle an extension.
if {$arg == ""} {
set arg $testfile.c
- } elseif {[string range $arg 0 0] == "."} {
- set arg $testfile$arg
+ } else {
+ set first [string range $arg 0 0]
+ if { $first == "." || $first == "-" } {
+ set arg $testfile$arg
+ }
}
set $varname $arg
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
gdb_load "$exe"
# Set breakpoint on main.
- gdb_test_multiple "break main" "break main" {
+ gdb_test_multiple "break -q main" "break -q main" {
-re "Breakpoint.*${gdb_prompt} $" {
}
-re "${gdb_prompt} $" {
|| [istarget *-*-cygwin*] || [istarget *-*-mingw32*]
|| [istarget *-*-*djgpp*] || [istarget *-*-go32*]
|| [istarget *-wince-pe] || [istarget *-*-mingw32ce*]
- || [istarget *-*-symbianelf*]
|| [istarget *-*-osf*]
|| [istarget *-*-dicos*]
|| [istarget *-*-nto*]
return 0
} else {
verbose -log "run_on_host failed: $output"
- fail $test
+ if { $output == "spawn failed" } {
+ unsupported $test
+ } else {
+ fail $test
+ }
return -1
}
}
# 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"]
}
}
}
- #Write to the log
+ # Write to the log and make sure the output is there, even in case
+ # of crash.
puts -nonewline $in_file "$message"
+ flush $in_file
}
# Write the command line used to invocate gdb to the cmd file.
}
# Does the compiler support CTF debug output using '-gt' compiler
-# flag? If not then we should skip these tests.
+# flag? If not then we should skip these tests. We should also
+# skip them if libctf was explicitly disabled.
gdb_caching_proc skip_ctf_tests {
- return ![gdb_can_simple_compile ctfdebug {
+ global enable_libctf
+
+ if {$enable_libctf eq "no"} {
+ return 1
+ }
+
+ set can_ctf [gdb_can_simple_compile ctfdebug {
int main () {
return 0;
}
} executable "additional_flags=-gt"]
+
+ return [expr {!$can_ctf}]
}
# Return 1 if compiler supports -gstatement-frontiers. Otherwise,
# Return 1 if symbols were read in using -readnow. Otherwise, return 0.
-proc readnow { } {
- set cmd "maint print objfiles"
- gdb_test_multiple $cmd "" {
- -re -wrap "\r\n.gdb_index: faked for \"readnow\"\r\n.*" {
- return 1
+proc readnow { args } {
+ if { [llength $args] == 1 } {
+ set re [lindex $args 0]
+ } 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 "" -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 } {
+proc add_gdb_index { program {style ""} } {
global srcdir GDB env BUILD_DATA_DIRECTORY
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 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 } {
+proc ensure_gdb_index { binfile {style ""} } {
set testfile [file tail $binfile]
set test "check if index present"
gdb_test_multiple "mt print objfiles ${testfile}" $test {
return 0
}
-re -wrap "Psymtabs.*" {
- if { [add_gdb_index $binfile] != "1" } {
+ if { [add_gdb_index $binfile $style] != "1" } {
return -1
}
return 1
# finalization function.
proc tuiterm_env { } {
load_lib tuiterm.exp
+}
- # Do initialization.
- tuiterm_env_init
+# Dejagnu has a version of note, but usage is not allowed outside of dejagnu.
+# Define a local version.
+proc gdb_note { message } {
+ verbose -- "NOTE: $message" 0
+}
- # Schedule finalization.
- global gdb_finish_hooks
- lappend gdb_finish_hooks tuiterm_env_finish
+# Return 1 if compiler supports -fuse-ld=gold, otherwise return 0.
+gdb_caching_proc have_fuse_ld_gold {
+ set me "have_fuse_ld_gold"
+ set flags "additional_flags=-fuse-ld=gold"
+ 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 {
+ set me "supports_scalar_storage_order_attribute"
+ set src {
+ #include <string.h>
+ struct sle {
+ int v;
+ } __attribute__((scalar_storage_order("little-endian")));
+ struct sbe {
+ int v;
+ } __attribute__((scalar_storage_order("big-endian")));
+ struct sle sle;
+ struct sbe sbe;
+ int main () {
+ sle.v = sbe.v = 0x11223344;
+ int same = memcmp (&sle, &sbe, sizeof (int)) == 0;
+ int sso = !same;
+ return sso;
+ }
+ }
+ if { ![gdb_simple_compile $me $src executable ""] } {
+ return 0
+ }
+
+ set result [remote_exec target $obj]
+ set status [lindex $result 0]
+ set output [lindex $result 1]
+ if { $output != "" } {
+ return 0
+ }
+
+ return $status
+}
+
+# Return 1 if compiler supports __GNUC__, otherwise return 0.
+gdb_caching_proc supports_gnuc {
+ set me "supports_gnuc"
+ set src {
+ #ifndef __GNUC__
+ #error "No gnuc"
+ #endif
+ }
+ return [gdb_simple_compile $me $src object ""]
+}
+
+# Return 1 if target supports mpx, otherwise return 0.
+gdb_caching_proc have_mpx {
+ global srcdir
+
+ set me "have_mpx"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support mpx, 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 (!__get_cpuid (1, &eax, &ebx, &ecx, &edx))
+ return 0;
+
+ if ((ecx & bit_OSXSAVE) == bit_OSXSAVE)
+ {
+ if (__get_cpuid_max (0, (void *)0) < 7)
+ return 0;
+
+ __cpuid_count (7, 0, eax, ebx, ecx, edx);
+
+ if ((ebx & bit_MPX) == bit_MPX)
+ return 1;
+
+ }
+ 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
+}
+
+# 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
}
# Always load compatibility stuff.
load_lib future.exp
+
+proc drain_gdbserver_output { } {
+ if { [info exists ::server_spawn_id] } {
+ #puts "gonna expect"
+ gdb_expect {
+ -i "$::server_spawn_id"
+ -timeout 0
+
+ -re ".+" {
+ exp_continue
+ #puts "consumed: $expect_out(buffer)"
+ }
+
+
+ }
+ #puts "expected"
+ }
+}