X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Ftestsuite%2Flib%2Fgdb.exp;h=25d370ebb52832af97287a3b9e1d807d35960bd4;hb=2e62ab400ff96334c92e5acf0a462cb9dc0d19a7;hp=5659906c0b9e590762aff6f74d97cdd81fb9a727;hpb=3d3389010c00504602656ba6f16c6b91ade75243;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 5659906c0b..25d370ebb5 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -1,4 +1,4 @@ -# Copyright 1992-2015 Free Software Foundation, Inc. +# Copyright 1992-2019 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 @@ -28,6 +28,7 @@ if {$tool == ""} { load_lib libgloss.exp load_lib cache.exp load_lib gdb-utils.exp +load_lib memory.exp global GDB @@ -81,7 +82,8 @@ if ![info exists gdb_prompt] then { } # A regexp that matches the pagination prompt. -set pagination_prompt [string_to_regexp "---Type to continue, or q to quit---"] +set pagination_prompt \ + "--Type for more, q to quit, c to continue without paging--" # The variable fullname_syntax_POSIX is a regexp which matches a POSIX # absolute path ie. /foo/ @@ -117,6 +119,10 @@ set octal "\[0-7\]+" set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)" +# A regular expression that matches a value history number. +# E.g., $1, $2, etc. +set valnum_re "\\\$$decimal" + ### Only procedures should come after this point. # @@ -221,6 +227,19 @@ proc delete_breakpoints {} { } } +# Returns true iff the target supports using the "run" command. + +proc target_can_use_run_cmd {} { + if [target_info exists use_gdb_stub] { + # In this case, when we connect, the inferior is already + # running. + return 0 + } + + # Assume yes. + return 1 +} + # Generic run command. # # The second pattern below matches up to the first newline *only*. @@ -365,9 +384,46 @@ proc gdb_start_cmd {args} { return -1 } +# Generic starti command. Return 0 if we could start the program, -1 +# if we could not. +# +# N.B. This function does not wait for gdb to return to the prompt, +# that is the caller's responsibility. + +proc gdb_starti_cmd {args} { + global gdb_prompt use_gdb_stub + + foreach command [gdb_init_commands] { + send_gdb "$command\n" + gdb_expect 30 { + -re "$gdb_prompt $" { } + default { + perror "gdb_init_command for target failed" + return -1 + } + } + } + + if $use_gdb_stub { + return -1 + } + + send_gdb "starti $args\n" + gdb_expect 60 { + -re "The program .* has been started already.*y or n. $" { + send_gdb "y\n" + exp_continue + } + -re "Starting program: \[^\r\n\]*" { + return 0 + } + } + return -1 +} + # Set a breakpoint at FUNCTION. If there is an additional argument it is # a list of options; the supported options are allow-pending, temporary, -# message, no-message, and passfail. +# message, no-message, passfail and qualified. # The result is 1 for success, 0 for failure. # # Note: The handling of message vs no-message is messed up, but it's based @@ -392,6 +448,10 @@ proc gdb_breakpoint { function args } { set break_message "Temporary breakpoint" } + if {[lsearch -exact $args qualified] != -1} { + append break_command " -qualified" + } + set print_pass 0 set print_fail 1 set no_message_loc [lsearch -exact $args no-message] @@ -519,7 +579,7 @@ proc runto { function args } { } -re "The target does not support running in non-stop mode.\r\n$gdb_prompt $" { if { $print_fail } { - unsupported "Non-stop mode not supported" + unsupported "non-stop mode not supported" } return 0 } @@ -846,10 +906,13 @@ proc gdb_test_multiple { command message user_code } { } } append code $processed_code + + # Reset the spawn id, in case the processed code used -i. append code { - # Reset the spawn id, in case the processed code used -i. -i "$gdb_spawn_id" + } + append code { -re "Ending remote debugging.*$gdb_prompt $" { if ![isnative] then { warning "Can`t communicate to remote target." @@ -920,7 +983,20 @@ proc gdb_test_multiple { command message user_code } { set result -1 } - # Patterns below apply to any spawn id specified. + -i $gdb_spawn_id + eof { + perror "GDB process no longer exists" + set wait_status [wait -i $gdb_spawn_id] + verbose -log "GDB process exited with wait status $wait_status" + if { $message != "" } { + fail "$message" + } + return -1 + } + } + + # Now patterns that apply to any spawn id specified. + append code { -i $any_spawn_id eof { perror "Process no longer exists" @@ -942,6 +1018,20 @@ proc gdb_test_multiple { command message user_code } { } } + # remote_expect calls the eof section if there is an error on the + # expect call. We already have eof sections above, and we don't + # want them to get called in that situation. Since the last eof + # section becomes the error section, here we define another eof + # section, but with an empty spawn_id list, so that it won't ever + # match. + append code { + -i "" eof { + # This comment is here because the eof section must not be + # the empty string, otherwise remote_expect won't realize + # it exists. + } + } + set result 0 set code [catch {gdb_expect $code} string] if {$code == 1} { @@ -959,7 +1049,9 @@ proc gdb_test_multiple { command message user_code } { # COMMAND is the command to execute, send to GDB with send_gdb. If # this is the null string no command is sent. # PATTERN is the pattern to match for a PASS, and must NOT include -# the \r\n sequence immediately before the gdb prompt. +# the \r\n sequence immediately before the gdb prompt. This argument +# may be omitted to just match the prompt, ignoring whatever output +# precedes it. # MESSAGE is an optional message to be printed. If this is # omitted, then the pass/fail messages use the command string as the # message. (If this is the empty string, then sometimes we don't @@ -974,9 +1066,7 @@ proc gdb_test_multiple { command message user_code } { # -1 if there was an internal error. # proc gdb_test { args } { - global verbose global gdb_prompt - global GDB upvar timeout timeout if [llength $args]>2 then { @@ -995,7 +1085,7 @@ proc gdb_test { args } { } return [gdb_test_multiple $command $message { - -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" { + -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" { if ![string match "" $message] then { pass "$message" } @@ -1038,7 +1128,8 @@ proc gdb_test_no_output { args } { # This is useful when the sequence is long and contains ".*", a single # regexp to match the entire output can get a timeout much easier. # -# COMMAND is the command to send. +# COMMAND is the command to execute, send to GDB with send_gdb. If +# this is the null string no command is sent. # TEST_NAME is passed to pass/fail. COMMAND is used if TEST_NAME is "". # EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are # processed in order, and all must be present in the output. @@ -1061,7 +1152,9 @@ proc gdb_test_sequence { command test_name expected_output_list } { set test_name $command } lappend expected_output_list ""; # implicit ".*" before gdb prompt - send_gdb "$command\n" + if { $command != "" } { + send_gdb "$command\n" + } return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list] } @@ -1297,6 +1390,36 @@ proc gdb_test_stdio {command inferior_pattern {gdb_pattern ""} {message ""}} { return $res } +# get_print_expr_at_depths EXP OUTPUTS +# +# Used for testing 'set print max-depth'. Prints the expression EXP +# with 'set print max-depth' set to various depths. OUTPUTS is a list +# of `n` different patterns to match at each of the depths from 0 to +# (`n` - 1). +# +# This proc does one final check with the max-depth set to 'unlimited' +# which is tested against the last pattern in the OUTPUTS list. The +# OUTPUTS list is therefore required to match every depth from 0 to a +# depth where the whole of EXP is printed with no ellipsis. +# +# This proc leaves the 'set print max-depth' set to 'unlimited'. +proc gdb_print_expr_at_depths {exp outputs} { + for { set depth 0 } { $depth <= [llength $outputs] } { incr depth } { + if { $depth == [llength $outputs] } { + set expected_result [lindex $outputs [expr [llength $outputs] - 1]] + set depth_string "unlimited" + } else { + set expected_result [lindex $outputs $depth] + set depth_string $depth + } + + with_test_prefix "exp='$exp': depth=${depth_string}" { + gdb_test_no_output "set print max-depth ${depth_string}" + gdb_test "p $exp" "$expected_result" + } + } +} + # Issue a PASS and return true if evaluating CONDITION in the caller's @@ -1359,7 +1482,7 @@ proc default_gdb_exit {} { global GDB global INTERNAL_GDBFLAGS GDBFLAGS global verbose - global gdb_spawn_id + global gdb_spawn_id inferior_spawn_id global inotify_log_file gdb_stop_suppressing_tests @@ -1400,6 +1523,7 @@ proc default_gdb_exit {} { remote_close host } unset gdb_spawn_id + unset inferior_spawn_id } # Load a file into the debugger. @@ -1459,17 +1583,17 @@ proc gdb_file_cmd { arg } { send_gdb "file $arg\n" gdb_expect 120 { - -re "Reading symbols from.*LZMA support was disabled.*done.*$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_debug_info "lzma" return 0 } - -re "Reading symbols from.*no debugging symbols found.*done.*$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_debug_info "nodebug" return 0 } - -re "Reading symbols from.*done.*$gdb_prompt $" { + -re "Reading symbols from.*$gdb_prompt $" { verbose "\t\tLoaded $arg into $GDB" set gdb_file_cmd_debug_info "debug" return 0 @@ -1477,7 +1601,7 @@ proc gdb_file_cmd { arg } { -re "Load new symbol table from \".*\".*y or n. $" { send_gdb "y\n" gdb_expect 120 { - -re "Reading symbols from.*done.*$gdb_prompt $" { + -re "Reading symbols from.*$gdb_prompt $" { verbose "\t\tLoaded $arg with new symbol table into $GDB" set gdb_file_cmd_debug_info "debug" return 0 @@ -1563,7 +1687,7 @@ proc default_gdb_spawn { } { # Default gdb_start procedure. proc default_gdb_start { } { - global gdb_prompt pagination_prompt + global gdb_prompt global gdb_spawn_id global inferior_spawn_id @@ -1584,29 +1708,20 @@ proc default_gdb_start { } { # When running over NFS, particularly if running many simultaneous # tests on different hosts all using the same server, things can # get really slow. Give gdb at least 3 minutes to start up. - set loop_again 1 - while { $loop_again } { - set loop_again 0 - gdb_expect 360 { - -re "$pagination_prompt" { - verbose "Hit pagination during startup. Pressing enter to continue." - send_gdb "\n" - set loop_again 1 - } - -re "\[\r\n\]$gdb_prompt $" { - verbose "GDB initialized." - } - -re "$gdb_prompt $" { - perror "GDB never initialized." - unset gdb_spawn_id - return -1 - } - timeout { - perror "(timeout) GDB never initialized after 10 seconds." - remote_close host - unset gdb_spawn_id - return -1 - } + gdb_expect 360 { + -re "\[\r\n\]$gdb_prompt $" { + verbose "GDB initialized." + } + -re "$gdb_prompt $" { + perror "GDB never initialized." + unset gdb_spawn_id + return -1 + } + timeout { + perror "(timeout) GDB never initialized after 10 seconds." + remote_close host + unset gdb_spawn_id + return -1 } } @@ -1721,56 +1836,52 @@ proc skip_go_tests {} { return 0 } -# Return a 1 if I don't even want to try to test java. - -proc skip_java_tests {} { - return 0 -} - # Return a 1 if I don't even want to try to test D. proc skip_d_tests {} { return 0 } +# Return 1 to skip Rust tests, 0 to try them. +proc skip_rust_tests {} { + return [expr {![isnative]}] +} + # Return a 1 for configurations that do not support Python scripting. +# PROMPT_REGEXP is the expected prompt. -proc skip_python_tests {} { - global gdb_prompt +proc skip_python_tests_prompt { prompt_regexp } { global gdb_py_is_py3k - global gdb_py_is_py24 gdb_test_multiple "python print ('test')" "verify python support" { - -re "not supported.*$gdb_prompt $" { + -re "not supported.*$prompt_regexp" { unsupported "Python support is disabled." return 1 } - -re "$gdb_prompt $" {} + -re "$prompt_regexp" {} } - set gdb_py_is_py24 0 gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" { - -re "3.*$gdb_prompt $" { + -re "3.*$prompt_regexp" { set gdb_py_is_py3k 1 } - -re ".*$gdb_prompt $" { + -re ".*$prompt_regexp" { set gdb_py_is_py3k 0 } } - if { $gdb_py_is_py3k == 0 } { - gdb_test_multiple "python print (sys.version_info\[1\])" "check if python 2.4" { - -re "\[45\].*$gdb_prompt $" { - set gdb_py_is_py24 1 - } - -re ".*$gdb_prompt $" { - set gdb_py_is_py24 0 - } - } - } return 0 } +# Return a 1 for configurations that do not support Python scripting. +# Note: This also sets various globals that specify which version of Python +# is in use. See skip_python_tests_prompt. + +proc skip_python_tests {} { + global gdb_prompt + return [skip_python_tests_prompt "$gdb_prompt $"] +} + # Return a 1 if we should skip shared library tests. proc skip_shlib_tests {} { @@ -1897,6 +2008,117 @@ proc with_test_prefix { prefix body } { } } +# Wrapper for foreach that calls with_test_prefix on each iteration, +# including the iterator's name and current value in the prefix. + +proc foreach_with_prefix {var list body} { + upvar 1 $var myvar + foreach myvar $list { + with_test_prefix "$var=$myvar" { + uplevel 1 $body + } + } +} + +# Like TCL's native proc, but defines a procedure that wraps its body +# within 'with_test_prefix "$proc_name" { ... }'. +proc proc_with_prefix {name arguments body} { + # Define the advertised proc. + proc $name $arguments [list with_test_prefix $name $body] +} + + +# Run BODY in the context of the caller. After BODY is run, the variables +# listed in VARS will be reset to the values they had before BODY was run. +# +# This is useful for providing a scope in which it is safe to temporarily +# modify global variables, e.g. +# +# global INTERNAL_GDBFLAGS +# global env +# +# set foo GDBHISTSIZE +# +# save_vars { INTERNAL_GDBFLAGS env($foo) env(HOME) } { +# append INTERNAL_GDBFLAGS " -nx" +# unset -nocomplain env(GDBHISTSIZE) +# gdb_start +# gdb_test ... +# } +# +# Here, although INTERNAL_GDBFLAGS, env(GDBHISTSIZE) and env(HOME) may be +# modified inside BODY, this proc guarantees that the modifications will be +# undone after BODY finishes executing. + +proc save_vars { vars body } { + array set saved_scalars { } + array set saved_arrays { } + set unset_vars { } + + foreach var $vars { + # First evaluate VAR in the context of the caller in case the variable + # name may be a not-yet-interpolated string like env($foo) + set var [uplevel 1 list $var] + + if [uplevel 1 [list info exists $var]] { + if [uplevel 1 [list array exists $var]] { + set saved_arrays($var) [uplevel 1 [list array get $var]] + } else { + set saved_scalars($var) [uplevel 1 [list set $var]] + } + } else { + lappend unset_vars $var + } + } + + set code [catch {uplevel 1 $body} result] + + foreach {var value} [array get saved_scalars] { + uplevel 1 [list set $var $value] + } + + foreach {var value} [array get saved_arrays] { + uplevel 1 [list unset $var] + uplevel 1 [list array set $var $value] + } + + foreach var $unset_vars { + uplevel 1 [list unset -nocomplain $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. +# +# This procedure doesn't check if DIR is a valid directory, so you +# have to make sure of that. + +proc with_cwd { dir body } { + set saved_dir [pwd] + verbose -log "Switching to directory $dir (saved CWD: $saved_dir)." + cd $dir + + set code [catch {uplevel 1 $body} result] + + verbose -log "Switching back to $saved_dir." + cd $saved_dir + + if {$code == 1} { + global errorInfo errorCode + return -code $code -errorinfo $errorInfo -errorcode $errorCode $result + } else { + return -code $code $result + } +} + # Run tests in BODY with GDB prompt and variable $gdb_prompt set to # PROMPT. When BODY is finished, restore GDB prompt and variable # $gdb_prompt. @@ -1981,6 +2203,56 @@ proc with_target_charset { target_charset body } { } } +# Switch the default spawn id to SPAWN_ID, so that gdb_test, +# mi_gdb_test etc. default to using it. + +proc switch_gdb_spawn_id {spawn_id} { + global gdb_spawn_id + global board board_info + + set gdb_spawn_id $spawn_id + set board [host_info name] + set board_info($board,fileid) $spawn_id +} + +# Clear the default spawn id. + +proc clear_gdb_spawn_id {} { + global gdb_spawn_id + global board board_info + + unset -nocomplain gdb_spawn_id + set board [host_info name] + unset -nocomplain board_info($board,fileid) +} + +# Run BODY with SPAWN_ID as current spawn id. + +proc with_spawn_id { spawn_id body } { + global gdb_spawn_id + + if [info exists gdb_spawn_id] { + set saved_spawn_id $gdb_spawn_id + } + + switch_gdb_spawn_id $spawn_id + + set code [catch {uplevel 1 $body} result] + + if [info exists saved_spawn_id] { + switch_gdb_spawn_id $saved_spawn_id + } else { + clear_gdb_spawn_id + } + + if {$code == 1} { + global errorInfo errorCode + return -code $code -errorinfo $errorInfo -errorcode $errorCode $result + } else { + return -code $code $result + } +} + # Select the largest timeout from all the timeouts: # - the local "timeout" variable of the scope two levels above, # - the global "timeout" variable, @@ -2032,35 +2304,23 @@ proc with_timeout_factor { factor body } { # Return 1 if _Complex types are supported, otherwise, return 0. gdb_caching_proc support_complex_tests { - # Set up, compile, and execute a test program containing _Complex types. - # Include the current process ID in the file names to prevent conflicts - # with invocations for multiple testsuites. - set src [standard_temp_file complex[pid].c] - set exe [standard_temp_file complex[pid].x] - gdb_produce_source $src { + if { [gdb_skip_float_test] } { + # If floating point is not supported, _Complex is not + # supported. + return 0 + } + + # Compile a test program containing _Complex types. + + return [gdb_can_simple_compile complex { int main() { _Complex float cf; _Complex double cd; _Complex long double cld; return 0; } - } - - verbose "compiling testfile $src" 2 - set compile_flags {debug nowarnings quiet} - set lines [gdb_compile $src $exe executable $compile_flags] - file delete $src - file delete $exe - - if ![string match "" $lines] then { - verbose "testfile compilation failed, returning 0" 2 - set result 0 - } else { - set result 1 - } - - return $result + } executable] } # Return 1 if GDB can get a type for siginfo from the target, otherwise @@ -2074,15 +2334,10 @@ proc supports_get_siginfo_type {} { } } -# Return 1 if target hardware or OS supports single stepping to signal -# handler, otherwise, return 0. +# Return 1 if the target supports hardware single stepping. -proc can_single_step_to_signal_handler {} { +proc can_hardware_single_step {} { - # Targets don't have hardware single step. On these targets, when - # a signal is delivered during software single step, gdb is unable - # to determine the next instruction addresses, because start of signal - # handler is one of them. if { [istarget "arm*-*-*"] || [istarget "mips*-*-*"] || [istarget "tic6x-*-*"] || [istarget "sparc*-*-linux*"] || [istarget "nios2-*-*"] } { @@ -2092,6 +2347,17 @@ proc can_single_step_to_signal_handler {} { return 1 } +# Return 1 if target hardware or OS supports single stepping to signal +# handler, otherwise, return 0. + +proc can_single_step_to_signal_handler {} { + # Targets don't have hardware single step. On these targets, when + # a signal is delivered during software single step, gdb is unable + # to determine the next instruction addresses, because start of signal + # handler is one of them. + return [can_hardware_single_step] +} + # Return 1 if target supports process record, otherwise return 0. proc supports_process_record {} { @@ -2103,7 +2369,8 @@ proc supports_process_record {} { if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] || [istarget "aarch64*-*-linux*"] - || [istarget "powerpc*-*-linux*"] } { + || [istarget "powerpc*-*-linux*"] + || [istarget "s390*-*-linux*"] } { return 1 } @@ -2121,7 +2388,8 @@ proc supports_reverse {} { if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] || [istarget "aarch64*-*-linux*"] - || [istarget "powerpc*-*-linux*"] } { + || [istarget "powerpc*-*-linux*"] + || [istarget "s390*-*-linux*"] } { return 1 } @@ -2147,21 +2415,9 @@ proc readline_is_used { } { gdb_caching_proc is_elf_target { set me "is_elf_target" - set src [standard_temp_file is_elf_target[pid].c] - set obj [standard_temp_file is_elf_target[pid].o] - - gdb_produce_source $src { - int foo () {return 0;} - } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - - file delete $src - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 + set src { int foo () {return 0;} } + if {![gdb_simple_compile elf_target $src]} { + return 0 } set fp_obj [open $obj "r"] @@ -2214,86 +2470,32 @@ proc gdb_produce_source { name sources } { # This cannot be decided simply from looking at the target string, # as it might depend on externally passed compiler options like -m64. gdb_caching_proc is_ilp32_target { - set me "is_ilp32_target" - - set src [standard_temp_file ilp32[pid].c] - set obj [standard_temp_file ilp32[pid].o] - - gdb_produce_source $src { + return [gdb_can_simple_compile is_ilp32_target { int dummy[sizeof (int) == 4 && sizeof (void *) == 4 && sizeof (long) == 4 ? 1 : -1]; - } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - file delete $src - file delete $obj - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 - } - - verbose "$me: returning 1" 2 - return 1 + }] } # Return 1 if target is LP64. # This cannot be decided simply from looking at the target string, # as it might depend on externally passed compiler options like -m64. gdb_caching_proc is_lp64_target { - set me "is_lp64_target" - - set src [standard_temp_file lp64[pid].c] - set obj [standard_temp_file lp64[pid].o] - - gdb_produce_source $src { + return [gdb_can_simple_compile is_lp64_target { int dummy[sizeof (int) == 4 && sizeof (void *) == 8 && sizeof (long) == 8 ? 1 : -1]; - } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - file delete $src - file delete $obj - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 - } - - verbose "$me: returning 1" 2 - return 1 + }] } # Return 1 if target has 64 bit addresses. # This cannot be decided simply from looking at the target string, # as it might depend on externally passed compiler options like -m64. gdb_caching_proc is_64_target { - set me "is_64_target" - - set src [standard_temp_file is64[pid].c] - set obj [standard_temp_file is64[pid].o] - - gdb_produce_source $src { + return [gdb_can_simple_compile is_64_target { int function(void) { return 3; } int dummy[sizeof (&function) == 8 ? 1 : -1]; - } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - file delete $src - file delete $obj - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 - } - - verbose "$me: returning 1" 2 - return 1 + }] } # Return 1 if target has x86_64 registers - either amd64 or x32. @@ -2304,30 +2506,14 @@ gdb_caching_proc is_amd64_regs_target { return 0 } - set me "is_amd64_regs_target" + return [gdb_can_simple_compile is_amd64_regs_target { + int main (void) { + asm ("incq %rax"); + asm ("incq %r15"); - set src [standard_temp_file reg64[pid].s] - set obj [standard_temp_file reg64[pid].o] - - set list {} - foreach reg \ - {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} { - lappend list "\tincq %$reg" + return 0; } - gdb_produce_source $src [join $list \n] - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - file delete $src - file delete $obj - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 - } - - verbose "$me: returning 1" 2 - return 1 + }] } # Return 1 if this target is an x86 or x86-64 with -m32. @@ -2349,30 +2535,13 @@ gdb_caching_proc is_aarch32_target { return 0 } - set me "is_aarch32_target" - - set src [standard_temp_file aarch32[pid].s] - set obj [standard_temp_file aarch32[pid].o] - set list {} foreach reg \ {r0 r1 r2 r3} { lappend list "\tmov $reg, $reg" } - gdb_produce_source $src [join $list \n] - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $obj object {quiet}] - file delete $src - file delete $obj - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 0" 2 - return 0 - } - - verbose "$me: returning 1" 2 - return 1 + return [gdb_can_simple_compile aarch32 [join $list \n]] } # Return 1 if this target is an aarch64, either lp64 or ilp32. @@ -2390,7 +2559,8 @@ proc support_displaced_stepping {} { if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] || [istarget "arm*-*-linux*"] || [istarget "powerpc-*-linux*"] - || [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"] } { + || [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"] + || [istarget "aarch64*-*-linux*"] } { return 1 } @@ -2412,27 +2582,21 @@ gdb_caching_proc skip_altivec_tests { } # Make sure we have a compiler that understands altivec. - set compile_flags {debug nowarnings} if [get_compiler_info] { warning "Could not get compiler info" return 1 } if [test_compiler_info gcc*] { - set compile_flags "$compile_flags additional_flags=-maltivec" + set compile_flags "additional_flags=-maltivec" } elseif [test_compiler_info xlc*] { - set compile_flags "$compile_flags additional_flags=-qaltivec" + set compile_flags "additional_flags=-qaltivec" } else { verbose "Could not compile with altivec support, returning 1" 2 return 1 } - # Set up, compile, and execute a test program containing VMX instructions. - # Include the current process ID in the file names to prevent conflicts - # with invocations for multiple testsuites. - set src [standard_temp_file vmx[pid].c] - set exe [standard_temp_file vmx[pid].x] - - gdb_produce_source $src { + # Compile a test program containing VMX instructions. + set src { int main() { #ifdef __MACH__ asm volatile ("vor v0,v0,v0"); @@ -2442,22 +2606,16 @@ gdb_caching_proc skip_altivec_tests { return 0; } } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $exe executable $compile_flags] - file delete $src - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 1" 2 + if {![gdb_simple_compile $me $src executable $compile_flags]} { return 1 } - # No error message, compilation succeeded so now run it via gdb. + # Compilation succeeded so now run it via gdb. gdb_exit gdb_start gdb_reinitialize_dir $srcdir/$subdir - gdb_load "$exe" + gdb_load "$obj" gdb_run_cmd gdb_expect { -re ".*Illegal instruction.*${gdb_prompt} $" { @@ -2474,7 +2632,7 @@ gdb_caching_proc skip_altivec_tests { } } gdb_exit - remote_file build delete $exe + remote_file build delete $obj verbose "$me: returning $skip_vmx_tests" 2 return $skip_vmx_tests @@ -2496,24 +2654,21 @@ gdb_caching_proc skip_vsx_tests { } # Make sure we have a compiler that understands altivec. - set compile_flags {debug nowarnings quiet} if [get_compiler_info] { warning "Could not get compiler info" return 1 } if [test_compiler_info gcc*] { - set compile_flags "$compile_flags additional_flags=-mvsx" + set compile_flags "additional_flags=-mvsx" } elseif [test_compiler_info xlc*] { - set compile_flags "$compile_flags additional_flags=-qasm=gcc" + set compile_flags "additional_flags=-qasm=gcc" } else { verbose "Could not compile with vsx support, returning 1" 2 return 1 } - set src [standard_temp_file vsx[pid].c] - set exe [standard_temp_file vsx[pid].x] - - gdb_produce_source $src { + # Compile a test program containing VSX instructions. + set src { int main() { double a[2] = { 1.0, 2.0 }; #ifdef __MACH__ @@ -2524,13 +2679,7 @@ gdb_caching_proc skip_vsx_tests { return 0; } } - - verbose "$me: compiling testfile $src" 2 - set lines [gdb_compile $src $exe executable $compile_flags] - file delete $src - - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 1" 2 + if {![gdb_simple_compile $me $src executable $compile_flags]} { return 1 } @@ -2539,7 +2688,7 @@ gdb_caching_proc skip_vsx_tests { gdb_exit gdb_start gdb_reinitialize_dir $srcdir/$subdir - gdb_load "$exe" + gdb_load "$obj" gdb_run_cmd gdb_expect { -re ".*Illegal instruction.*${gdb_prompt} $" { @@ -2556,12 +2705,61 @@ gdb_caching_proc skip_vsx_tests { } } gdb_exit - remote_file build delete $exe + remote_file build delete $obj verbose "$me: returning $skip_vsx_tests" 2 return $skip_vsx_tests } +# Run a test on the target to see if it supports TSX hardware. Return 0 if so, +# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite. + +gdb_caching_proc skip_tsx_tests { + global srcdir subdir gdb_prompt inferior_exited_re + + set me "skip_tsx_tests" + + # Compile a test program. + set src { + int main() { + asm volatile ("xbegin .L0"); + asm volatile ("xend"); + asm volatile (".L0: 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 "$me: TSX hardware not detected." + set skip_tsx_tests 1 + } + -re ".*$inferior_exited_re normally.*${gdb_prompt} $" { + verbose -log "$me: TSX hardware detected." + set skip_tsx_tests 0 + } + default { + warning "\n$me: default case taken." + set skip_tsx_tests 1 + } + } + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $skip_tsx_tests" 2 + return $skip_tsx_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. @@ -2574,40 +2772,75 @@ gdb_caching_proc skip_btrace_tests { return 1 } - # Set up, compile, and execute a test program. - # Include the current process ID in the file names to prevent conflicts - # with invocations for multiple testsuites. - set src [standard_temp_file btrace[pid].c] - set exe [standard_temp_file btrace[pid].x] + # Compile a test program. + set src { int main() { return 0; } } + if {![gdb_simple_compile $me $src executable]} { + return 0 + } - gdb_produce_source $src { - int main(void) { return 0; } + # No error message, compilation succeeded so now run it via gdb. + + gdb_exit + gdb_start + gdb_reinitialize_dir $srcdir/$subdir + gdb_load $obj + if ![runto_main] { + return 1 + } + # In case of an unexpected output, we return 2 as a fail value. + set skip_btrace_tests 2 + gdb_test_multiple "record btrace" "check btrace support" { + -re "You can't do that when your target is.*\r\n$gdb_prompt $" { + set skip_btrace_tests 1 + } + -re "Target does not support branch tracing.*\r\n$gdb_prompt $" { + set skip_btrace_tests 1 + } + -re "Could not enable branch tracing.*\r\n$gdb_prompt $" { + set skip_btrace_tests 1 + } + -re "^record btrace\r\n$gdb_prompt $" { + set skip_btrace_tests 0 + } } + gdb_exit + remote_file build delete $obj - verbose "$me: compiling testfile $src" 2 - set compile_flags {debug nowarnings quiet} - set lines [gdb_compile $src $exe executable $compile_flags] + verbose "$me: returning $skip_btrace_tests" 2 + return $skip_btrace_tests +} - if ![string match "" $lines] then { - verbose "$me: testfile compilation failed, returning 1" 2 - file delete $src +# Run a test on the target to see if it supports btrace pt hardware. +# Return 0 if so, 1 if it does not. Based on 'check_vmx_hw_available' +# from the GCC testsuite. + +gdb_caching_proc skip_btrace_pt_tests { + global srcdir subdir gdb_prompt inferior_exited_re + + set me "skip_btrace_tests" + if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } { + verbose "$me: target does not support btrace, returning 1" 2 return 1 } + # Compile a test program. + set src { int main() { return 0; } } + if {![gdb_simple_compile $me $src executable]} { + return 0 + } + # No error message, compilation succeeded so now run it via gdb. gdb_exit gdb_start gdb_reinitialize_dir $srcdir/$subdir - gdb_load $exe + gdb_load $obj if ![runto_main] { - file delete $src return 1 } - file delete $src # In case of an unexpected output, we return 2 as a fail value. set skip_btrace_tests 2 - gdb_test_multiple "record btrace" "check btrace support" { + gdb_test_multiple "record btrace pt" "check btrace pt support" { -re "You can't do that when your target is.*\r\n$gdb_prompt $" { set skip_btrace_tests 1 } @@ -2617,24 +2850,100 @@ gdb_caching_proc skip_btrace_tests { -re "Could not enable branch tracing.*\r\n$gdb_prompt $" { set skip_btrace_tests 1 } - -re "^record btrace\r\n$gdb_prompt $" { + -re "support was disabled at compile time.*\r\n$gdb_prompt $" { + set skip_btrace_tests 1 + } + -re "^record btrace pt\r\n$gdb_prompt $" { set skip_btrace_tests 0 } } gdb_exit - remote_file build delete $exe + remote_file build delete $obj verbose "$me: returning $skip_btrace_tests" 2 return $skip_btrace_tests } -# Skip all the tests in the file if you are not on an hppa running -# hpux target. +# Run a test on the target to see if it supports Aarch64 SVE hardware. +# Return 0 if so, 1 if it does not. Note this causes a restart of GDB. -proc skip_hp_tests {} { - eval set skip_hp [ expr ![isnative] || ![istarget "hppa*-*-hpux*"] ] - verbose "Skip hp tests is $skip_hp" - return $skip_hp +gdb_caching_proc skip_aarch64_sve_tests { + global srcdir subdir gdb_prompt inferior_exited_re + + set me "skip_aarch64_sve_tests" + + if { ![is_aarch64_target]} { + return 1 + } + + set compile_flags "{additional_flags=-march=armv8-a+sve}" + + # Compile a test program containing SVE instructions. + set src { + int main() { + asm volatile ("ptrue p0.b"); + return 0; + } + } + if {![gdb_simple_compile $me $src executable $compile_flags]} { + return 1 + } + + # Compilation succeeded so now run it via gdb. + clean_restart $obj + gdb_run_cmd + gdb_expect { + -re ".*Illegal instruction.*${gdb_prompt} $" { + verbose -log "\n$me sve hardware not detected" + set skip_sve_tests 1 + } + -re ".*$inferior_exited_re normally.*${gdb_prompt} $" { + verbose -log "\n$me: sve hardware detected" + set skip_sve_tests 0 + } + default { + warning "\n$me: default case taken" + set skip_sve_tests 1 + } + } + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $skip_sve_tests" 2 + return $skip_sve_tests +} + + +# A helper that compiles a test case to see if __int128 is supported. +proc gdb_int128_helper {lang} { + return [gdb_can_simple_compile "i128-for-$lang" { + __int128 x; + int main() { return 0; } + } executable $lang] +} + +# Return true if the C compiler understands the __int128 type. +gdb_caching_proc has_int128_c { + return [gdb_int128_helper c] +} + +# Return true if the C++ compiler understands the __int128 type. +gdb_caching_proc has_int128_cxx { + return [gdb_int128_helper c++] +} + +# Return true if the IFUNC feature is unsupported. +gdb_caching_proc skip_ifunc_tests { + if [gdb_can_simple_compile ifunc { + extern void f_ (); + typedef void F (void); + F* g (void) { return &f_; } + void f () __attribute__ ((ifunc ("g"))); + } object] { + return 0 + } else { + return 1 + } } # Return whether we should skip tests for showing inlined functions in @@ -2682,7 +2991,8 @@ proc skip_hw_breakpoint_tests {} { || [istarget "x86_64-*-*"] || [istarget "ia64-*-*"] || [istarget "arm*-*-*"] - || [istarget "aarch64*-*-*"]} { + || [istarget "aarch64*-*-*"] + || [istarget "s390*-*-*"] } { return 0 } @@ -2811,25 +3121,69 @@ proc skip_compile_feature_tests {} { return $result } -# Check whether we're testing with the remote or extended-remote -# targets. - -proc gdb_is_target_remote {} { - global gdb_prompt +# Helper for gdb_is_target_* procs. TARGET_NAME is the name of the target +# we're looking for (used to build the test name). TARGET_STACK_REGEXP +# 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. - set test "probe for target remote" +proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } { + set test "probe for target ${target_name}" gdb_test_multiple "maint print target-stack" $test { - -re ".*emote serial target in gdb-specific protocol.*$gdb_prompt $" { + -re "${target_stack_regexp}${prompt_regexp}" { pass $test return 1 } - -re "$gdb_prompt $" { + -re "$prompt_regexp" { pass $test } } return 0 } +# Helper for gdb_is_target_remote where the expected prompt is variable. + +proc gdb_is_target_remote_prompt { prompt_regexp } { + return [gdb_is_target_1 "remote" ".*emote serial target in gdb-specific protocol.*" $prompt_regexp] +} + +# Check whether we're testing with the remote or extended-remote +# targets. + +proc gdb_is_target_remote { } { + global gdb_prompt + + return [gdb_is_target_remote_prompt "$gdb_prompt $"] +} + +# Check whether we're testing with the native target. + +proc gdb_is_target_native { } { + global gdb_prompt + + return [gdb_is_target_1 "native" ".*native \\(Native process\\).*" "$gdb_prompt $"] +} + +# Return the effective value of use_gdb_stub. +# +# If the use_gdb_stub global has been set (it is set when the gdb process is +# spawned), return that. Otherwise, return the value of the use_gdb_stub +# property from the board file. +# +# 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. + +proc use_gdb_stub {} { + global use_gdb_stub + + if [info exists use_gdb_stub] { + return $use_gdb_stub + } + + return [target_info exists use_gdb_stub] +} + # Return 1 if the current remote target is an instance of our GDBserver, 0 # otherwise. Return -1 if there was an error and we can't tell. @@ -2837,7 +3191,7 @@ gdb_caching_proc target_is_gdbserver { global gdb_prompt set is_gdbserver -1 - set test "Probing for GDBserver" + set test "probing for GDBserver" gdb_test_multiple "monitor help" $test { -re "The following monitor commands are supported.*Quit GDBserver.*$gdb_prompt $" { @@ -2864,8 +3218,6 @@ if [info exists compiler_info] { } set gcc_compiled 0 -set hp_cc_compiler 0 -set hp_aCC_compiler 0 # Figure out what compiler I am using. # The result is cached so only the first invocation runs the compiler. @@ -2932,8 +3284,6 @@ proc get_compiler_info {{arg ""}} { # Legacy global data symbols. global gcc_compiled - global hp_cc_compiler - global hp_aCC_compiler if [info exists compiler_info] { # Already computed. @@ -2954,12 +3304,12 @@ proc get_compiler_info {{arg ""}} { # 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] + gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" 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] ] + set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet getting_compiler_info] ] } eval log_file $saved_log @@ -2993,16 +3343,8 @@ proc get_compiler_info {{arg ""}} { } # Set the legacy symbols. - set gcc_compiled 0 - set hp_cc_compiler 0 - set hp_aCC_compiler 0 - if { [regexp "^gcc-1-" "$compiler_info" ] } { set gcc_compiled 1 } - if { [regexp "^gcc-2-" "$compiler_info" ] } { set gcc_compiled 2 } - if { [regexp "^gcc-3-" "$compiler_info" ] } { set gcc_compiled 3 } - if { [regexp "^gcc-4-" "$compiler_info" ] } { set gcc_compiled 4 } - if { [regexp "^gcc-5-" "$compiler_info" ] } { set gcc_compiled 5 } - if { [regexp "^hpcc-" "$compiler_info" ] } { set hp_cc_compiler 1 } - if { [regexp "^hpacc-" "$compiler_info" ] } { set hp_aCC_compiler 1 } + set gcc_compiled 0 + regexp "^gcc-(\[0-9\]+)-" "$compiler_info" matchall gcc_compiled # Log what happened. verbose -log "get_compiler_info: $compiler_info" @@ -3012,13 +3354,6 @@ proc get_compiler_info {{arg ""}} { uplevel \#0 { set true 1 } uplevel \#0 { set false 0 } - # Use of aCC results in boolean results being displayed as - # "true" or "false" - if { $hp_aCC_compiler } { - uplevel \#0 { set true true } - uplevel \#0 { set false false } - } - return 0 } @@ -3073,10 +3408,125 @@ proc gdb_wrapper_init { args } { set gdb_wrapper_target [current_target_name] } +# Determine options that we always want to pass to the compiler. +gdb_caching_proc universal_compile_options { + set me "universal_compile_options" + set options {} + + set src [standard_temp_file ccopts[pid].c] + set obj [standard_temp_file ccopts[pid].o] + + gdb_produce_source $src { + int foo(void) { return 0; } + } + + # Try an option for disabling colored diagnostics. Some compilers + # yield colored diagnostics by default (when run from a tty) unless + # such an option is specified. + set opt "additional_flags=-fdiagnostics-color=never" + set lines [target_compile $src $obj object [list "quiet" $opt]] + if [string match "" $lines] then { + # Seems to have worked; use the option. + lappend options $opt + } + file delete $src + file delete $obj + + verbose "$me: returning $options" 2 + return $options +} + +# Compile the code in $code to a file based on $name, using the flags +# $compile_flag as well as debug, nowarning and quiet. +# Return 1 if code can be compiled +# Leave the file name of the resulting object in the upvar object. + +proc gdb_simple_compile {name code {type object} {compile_flags {}} {object obj}} { + upvar $object obj + + switch -regexp -- $type { + "executable" { + set postfix "x" + } + "object" { + set postfix "o" + } + "preprocess" { + set postfix "i" + } + "assembly" { + set postfix "s" + } + } + set src [standard_temp_file $name-[pid].c] + set obj [standard_temp_file $name-[pid].$postfix] + set compile_flags [concat $compile_flags {debug nowarnings quiet}] + + gdb_produce_source $src $code + + verbose "$name: compiling testfile $src" 2 + set lines [gdb_compile $src $obj $type $compile_flags] + + file delete $src + + if ![string match "" $lines] then { + verbose "$name: compilation failed, returning 0" 2 + return 0 + } + return 1 +} + +# Compile the code in $code to a file based on $name, using the flags +# $compile_flag as well as debug, nowarning and quiet. +# Return 1 if code can be compiled +# Delete all created files and objects. + +proc gdb_can_simple_compile {name code {type object} {compile_flags ""}} { + set ret [gdb_simple_compile $name $code $type $compile_flags temp_obj] + file delete $temp_obj + return $ret +} + # Some targets need to always link a special object in. Save its path here. global gdb_saved_set_unbuffered_mode_obj set gdb_saved_set_unbuffered_mode_obj "" +# Compile source files specified by SOURCE into a binary of type TYPE at path +# DEST. gdb_compile is implemented using DejaGnu's target_compile, so the type +# parameter and most options are passed directly to it. +# +# The type can be one of the following: +# +# - object: Compile into an object file. +# - executable: Compile and link into an executable. +# - preprocess: Preprocess the source files. +# - assembly: Generate assembly listing. +# +# The following options are understood and processed by gdb_compile: +# +# - shlib=so_path: Add SO_PATH to the sources, and enable some target-specific +# quirks to be able to use shared libraries. +# - shlib_load: Link with appropriate libraries to allow the test to +# dynamically load libraries at runtime. For example, on Linux, this adds +# -ldl so that the test can use dlopen. +# - nowarnings: Inhibit all compiler warnings. +# - pie: Force creation of PIE executables. +# - nopie: Prevent creation of PIE executables. +# +# And here are some of the not too obscure options understood by DejaGnu that +# influence the compilation: +# +# - additional_flags=flag: Add FLAG to the compiler flags. +# - libs=library: Add LIBRARY to the libraries passed to the linker. The +# argument can be a file, in which case it's added to the sources, or a +# linker flag. +# - 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. +# - debug: Build with debug information. +# - optimize: Build with optimization. + proc gdb_compile {source dest type options} { global GDB_TESTCASE_OPTIONS global gdb_wrapper_file @@ -3090,11 +3540,18 @@ proc gdb_compile {source dest type options} { # Add platform-specific options if a shared library was specified using # "shlib=librarypath" in OPTIONS. - set new_options "" + set new_options {} + if {[lsearch -exact $options rust] != -1} { + # -fdiagnostics-color is not a rustcc option. + } else { + set new_options [universal_compile_options] + } set shlib_found 0 set shlib_load 0 + set getting_compiler_info 0 foreach opt $options { - if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] { + if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name] + && $type == "executable"} { if [test_compiler_info "xlc-*"] { # IBM xlc compiler doesn't accept shared library named other # than .so: use "-Wl," to bypass this @@ -3120,23 +3577,36 @@ proc gdb_compile {source dest type options} { lappend new_options "early_flags=-Wl,--no-as-needed" } } - } elseif { $opt == "shlib_load" } { + } 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 } else { lappend new_options $opt } } - # We typically link to shared libraries using an absolute path, and - # that's how they are found at runtime. If we are going to - # dynamically load one by basename, we must specify rpath. If we - # are using a remote host, DejaGNU will link to the shared library - # using a relative path, so again we must specify an rpath. - if { $shlib_load || ($shlib_found && [is_remote target]) } { + # Ensure stack protector is disabled for GCC, as this causes problems with + # 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 + && [test_compiler_info {gcc-*-*}] + && !([test_compiler_info {gcc-[0-3]-*}] + || [test_compiler_info {gcc-4-0-*}]) + && [lsearch -exact $options rust] == -1} { + # Put it at the front to not override any user-provided value. + lappend new_options "early_flags=-fno-stack-protector" + } + + # Because we link with libraries using their basename, we may need + # (depending on the platform) to set a special rpath value, to allow + # the executable to find the libraries it depends on. + if { $shlib_load || $shlib_found } { if { ([istarget "*-*-mingw*"] || [istarget *-*-cygwin*] - || [istarget *-*-pe*] - || [istarget hppa*-*-hpux*])} { + || [istarget *-*-pe*]) } { # Do not need anything. } elseif { [istarget *-*-freebsd*] || [istarget *-*-openbsd*] } { lappend new_options "ldflags=-Wl,-rpath,${outdir}" @@ -3180,6 +3650,43 @@ proc gdb_compile {source dest type options} { set options [lreplace $options $nowarnings $nowarnings $flag] } + # Replace the "pie" option with the appropriate compiler and linker flags + # to enable PIE executables. + set pie [lsearch -exact $options pie] + if {$pie != -1} { + if [target_info exists gdb,pie_flag] { + set flag "additional_flags=[target_info gdb,pie_flag]" + } else { + # For safety, use fPIE rather than fpie. On AArch64, m68k, PowerPC + # and SPARC, fpie can cause compile errors due to the GOT exceeding + # a maximum size. On other architectures the two flags are + # identical (see the GCC manual). Note Debian9 and Ubuntu16.10 + # onwards default GCC to using fPIE. If you do require fpie, then + # it can be set using the pie_flag. + set flag "additional_flags=-fPIE" + } + set options [lreplace $options $pie $pie $flag] + + if [target_info exists gdb,pie_ldflag] { + set flag "ldflags=[target_info gdb,pie_ldflag]" + } else { + set flag "ldflags=-pie" + } + lappend options "$flag" + } + + # Replace the "nopie" option with the appropriate linker flag to disable + # PIE executables. There are no compiler flags for this option. + set nopie [lsearch -exact $options nopie] + if {$nopie != -1} { + if [target_info exists gdb,nopie_flag] { + set flag "ldflags=[target_info gdb,nopie_flag]" + } else { + set flag "ldflags=-no-pie" + } + set options [lreplace $options $nopie $nopie $flag] + } + if { $type == "executable" } { if { ([istarget "*-*-mingw*"] || [istarget "*-*-*djgpp"] @@ -3277,7 +3784,7 @@ proc gdb_compile_pthreads {source dest type options} { } } if {!$built_binfile} { - unsupported "Couldn't compile [file tail $source]: ${why_msg}" + unsupported "couldn't compile [file tail $source]: ${why_msg}" return -1 } } @@ -3314,15 +3821,11 @@ proc gdb_compile_shlib {sources dest options} { lappend obj_options "additional_flags=-fpic" } } + "icc-*" { + lappend obj_options "additional_flags=-fpic" + } default { - switch -glob [istarget] { - "hppa*-hp-hpux*" { - lappend obj_options "additional_flags=+z" - } - default { - # don't know what the compiler is... - } - } + # don't know what the compiler is... } } @@ -3336,49 +3839,48 @@ proc gdb_compile_shlib {sources dest options} { lappend objects ${outdir}/${sourcebase}.o } - if [istarget "hppa*-*-hpux*"] { - remote_exec build "ld -b ${objects} -o ${dest}" + set link_options $options + if [test_compiler_info "xlc-*"] { + lappend link_options "additional_flags=-qmkshrobj" } else { - set link_options $options - if [test_compiler_info "xlc-*"] { - lappend link_options "additional_flags=-qmkshrobj" - } else { - lappend link_options "additional_flags=-shared" - - if { ([istarget "*-*-mingw*"] - || [istarget *-*-cygwin*] - || [istarget *-*-pe*]) } { - if { [is_remote host] } { - set name [file tail ${dest}] - } else { - set name ${dest} - } - lappend link_options "additional_flags=-Wl,--out-implib,${name}.a" - } elseif [is_remote target] { - # By default, we do not set the soname. This causes the linker - # on ELF systems to create a DT_NEEDED entry in the executable - # refering to the full path name of the library. This is a - # problem in remote testing if the library is in a different - # directory there. To fix this, we set a soname of just the - # base filename for the library, and add an appropriate -rpath - # to the main executable (in gdb_compile). - set destbase [file tail $dest] - lappend link_options "additional_flags=-Wl,-soname,$destbase" - } - } - if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} { - return -1 - } - if { [is_remote host] - && ([istarget "*-*-mingw*"] - || [istarget *-*-cygwin*] - || [istarget *-*-pe*]) } { - set dest_tail_name [file tail ${dest}] - remote_upload host $dest_tail_name.a ${dest}.a - remote_file host delete $dest_tail_name.a + lappend link_options "additional_flags=-shared" + + if { ([istarget "*-*-mingw*"] + || [istarget *-*-cygwin*] + || [istarget *-*-pe*]) } { + if { [is_remote host] } { + set name [file tail ${dest}] + } else { + set name ${dest} + } + lappend link_options "additional_flags=-Wl,--out-implib,${name}.a" + } else { + # Set the soname of the library. This causes the linker on ELF + # systems to create the DT_NEEDED entry in the executable referring + # to the soname of the library, and not its absolute path. This + # (using the absolute path) would be problem when testing on a + # remote target. + # + # In conjunction with setting the soname, we add the special + # rpath=$ORIGIN value when building the executable, so that it's + # able to find the library in its own directory. + set destbase [file tail $dest] + lappend link_options "additional_flags=-Wl,-soname,$destbase" } } - return "" + if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} { + return -1 + } + if { [is_remote host] + && ([istarget "*-*-mingw*"] + || [istarget *-*-cygwin*] + || [istarget *-*-pe*]) } { + set dest_tail_name [file tail ${dest}] + remote_upload host $dest_tail_name.a ${dest}.a + remote_file host delete $dest_tail_name.a + } + + return "" } # This is just like gdb_compile_shlib, above, except that it tries compiling @@ -3411,7 +3913,7 @@ proc gdb_compile_shlib_pthreads {sources dest options} { } } if {!$built_binfile} { - unsupported "Couldn't compile $sources: ${why_msg}" + unsupported "couldn't compile $sources: ${why_msg}" return -1 } } @@ -3451,7 +3953,7 @@ proc gdb_compile_objc {source dest type options} { } } if {!$built_binfile} { - unsupported "Couldn't compile [file tail $source]: ${why_msg}" + unsupported "couldn't compile [file tail $source]: ${why_msg}" return -1 } } @@ -3952,52 +4454,73 @@ proc gdb_touch_execfile { binfile } { } } -# Like remote_download but provides a gdb-specific behavior. If DEST -# is "host", and the host is not remote, and TOFILE is not specified, -# then the [file tail] of FROMFILE is passed through -# standard_output_file to compute the destination. +# Like remote_download but provides a gdb-specific behavior. +# +# If the destination board is remote, the local file FROMFILE is transferred as +# usual with remote_download to TOFILE on the remote board. The destination +# filename is added to the CLEANFILES global, so it can be cleaned up at the +# end of the test. +# +# If the destination board is local, the destination path TOFILE is passed +# through standard_output_file, and FROMFILE is copied there. +# +# In both cases, if TOFILE is omitted, it defaults to the [file tail] of +# FROMFILE. proc gdb_remote_download {dest fromfile {tofile {}}} { - if {$dest == "host" && ![is_remote host] && $tofile == ""} { - set tofile [standard_output_file [file tail $fromfile]] + # If TOFILE is not given, default to the same filename as FROMFILE. + if {[string length $tofile] == 0} { + set tofile [file tail $fromfile] } - if { $tofile == "" } { - return [remote_download $dest $fromfile] + if {[is_remote $dest]} { + # When the DEST is remote, we simply send the file to DEST. + global cleanfiles + + set destname [remote_download $dest $fromfile $tofile] + lappend cleanfiles $destname + + return $destname } else { - return [remote_download $dest $fromfile $tofile] - } -} + # When the DEST is local, we copy the file to the test directory (where + # the executable is). + # + # Note that we pass TOFILE through standard_output_file, regardless of + # whether it is absolute or relative, because we don't want the tests + # to be able to write outside their standard output directory. -# gdb_download -# -# Copy a file to the remote target and return its target filename. -# Schedule the file to be deleted at the end of this test. + set tofile [standard_output_file $tofile] -proc gdb_download { filename } { - global cleanfiles + file copy -force $fromfile $tofile - set destname [remote_download target $filename] - lappend cleanfiles $destname - return $destname + return $tofile + } } -# gdb_load_shlibs LIB... +# gdb_load_shlib LIB... # -# Copy the listed libraries to the target. +# Copy the listed library to the target. -proc gdb_load_shlibs { args } { - if {![is_remote target]} { - return +proc gdb_load_shlib { file } { + global gdb_spawn_id + + if ![info exists gdb_spawn_id] { + perror "gdb_load_shlib: GDB is not running" } - foreach file $args { - gdb_download [shlib_target_file $file] + set dest [gdb_remote_download target [shlib_target_file $file]] + + if {[is_remote target]} { + # If the target is remote, we need to tell gdb where to find the + # libraries. + # + # We could set this even when not testing remotely, but a user + # generally won't set it unless necessary. In order to make the tests + # more like the real-life scenarios, we don't set it for local testing. + gdb_test "set solib-search-path [file dirname $file]" "" "" } - # Even if the target supplies full paths for shared libraries, - # they may not be paths for this system. - gdb_test "set solib-search-path [file dirname [lindex $args 0]]" "" "" + return $dest } # @@ -4086,7 +4609,7 @@ proc default_gdb_init { test_file_name } { proc make_gdb_parallel_path { args } { global GDB_PARALLEL objdir set joiner [list "file" "join" $objdir] - if { $GDB_PARALLEL != "yes" } { + if { [info exists GDB_PARALLEL] && $GDB_PARALLEL != "yes" } { lappend joiner $GDB_PARALLEL } set joiner [concat $joiner $args] @@ -4098,27 +4621,22 @@ proc make_gdb_parallel_path { args } { # the directory is returned. proc standard_output_file {basename} { - global objdir subdir gdb_test_file_name GDB_PARALLEL + global objdir subdir gdb_test_file_name - if {[info exists GDB_PARALLEL]} { - set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name] - file mkdir $dir - return [file join $dir $basename] - } else { - return [file join $objdir $subdir $basename] - } + set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name] + file mkdir $dir + return [file join $dir $basename] } # Return the name of a file in our standard temporary directory. proc standard_temp_file {basename} { - global objdir GDB_PARALLEL - - if {[info exists GDB_PARALLEL]} { - return [make_gdb_parallel_path temp $basename] - } else { - return $basename - } + # Since a particular runtest invocation is only executing a single test + # file at any given time, we can use the runtest pid to build the + # path of the temp directory. + set dir [make_gdb_parallel_path temp [pid]] + file mkdir $dir + return [file join $dir $basename] } # Set 'testfile', 'srcfile', and 'binfile'. @@ -4285,10 +4803,14 @@ proc gdb_init { test_file_name } { # read from this file. setenv INPUTRC "/dev/null" - # The gdb.base/readline.exp arrow key test relies on the standard VT100 - # bindings, so make sure that an appropriate terminal is selected. - # The same bug doesn't show up if we use ^P / ^N instead. - setenv TERM "vt100" + # This disables style output, which would interfere with many + # tests. + setenv TERM "dumb" + + # 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 stty_init "rows 25 cols 80" # Some tests (for example gdb.base/maint.exp) shell out from gdb to use # grep. Clear GREP_OPTIONS to make the behavior predictable, @@ -4580,14 +5102,102 @@ proc rerun_to_main {} { } } -# Print a message and return true if a test should be skipped -# due to lack of floating point suport. +# Return true if a test should be skipped due to lack of floating +# point support or GDB can't fetch the contents from floating point +# registers. -proc gdb_skip_float_test { msg } { +gdb_caching_proc gdb_skip_float_test { if [target_info exists gdb,skip_float_tests] { - verbose "Skipping test '$msg': no float tests." return 1 } + + # There is an ARM kernel ptrace bug that hardware VFP registers + # are not updated after GDB ptrace set VFP registers. The bug + # was introduced by kernel commit 8130b9d7b9d858aa04ce67805e8951e3cb6e9b2f + # in 2012 and is fixed in e2dfb4b880146bfd4b6aa8e138c0205407cebbaf + # in May 2016. In other words, kernels older than 4.6.3, 4.4.14, + # 4.1.27, 3.18.36, and 3.14.73 have this bug. + # This kernel bug is detected by check how does GDB change the + # program result by changing one VFP register. + if { [istarget "arm*-*-linux*"] } { + + set compile_flags {debug nowarnings } + + # Set up, compile, and execute a test program having VFP + # operations. + set src [standard_temp_file arm_vfp[pid].c] + set exe [standard_temp_file arm_vfp[pid].x] + + gdb_produce_source $src { + int main() { + double d = 4.0; + int ret; + + asm ("vldr d0, [%0]" : : "r" (&d)); + asm ("vldr d1, [%0]" : : "r" (&d)); + asm (".global break_here\n" + "break_here:"); + asm ("vcmp.f64 d0, d1\n" + "vmrs APSR_nzcv, fpscr\n" + "bne L_value_different\n" + "movs %0, #0\n" + "b L_end\n" + "L_value_different:\n" + "movs %0, #1\n" + "L_end:\n" : "=r" (ret) :); + + /* Return $d0 != $d1. */ + return ret; + } + } + + verbose "compiling testfile $src" 2 + set lines [gdb_compile $src $exe executable $compile_flags] + file delete $src + + if ![string match "" $lines] then { + verbose "testfile compilation failed, returning 1" 2 + return 0 + } + + # No error message, compilation succeeded so now run it via gdb. + # Run the test up to 5 times to detect whether ptrace can + # correctly update VFP registers or not. + set skip_vfp_test 0 + for {set i 0} {$i < 5} {incr i} { + global gdb_prompt srcdir subdir + + gdb_exit + gdb_start + gdb_reinitialize_dir $srcdir/$subdir + gdb_load "$exe" + + runto_main + gdb_test "break *break_here" + gdb_continue_to_breakpoint "break_here" + + # Modify $d0 to a different value, so the exit code should + # be 1. + gdb_test "set \$d0 = 5.0" + + set test "continue to exit" + gdb_test_multiple "continue" "$test" { + -re "exited with code 01.*$gdb_prompt $" { + } + -re "exited normally.*$gdb_prompt $" { + # However, the exit code is 0. That means something + # wrong in setting VFP registers. + set skip_vfp_test 1 + break + } + } + } + + gdb_exit + remote_file build delete $exe + + return $skip_vfp_test + } return 0 } @@ -4611,9 +5221,14 @@ proc gdb_skip_bogus_test { msg } { # NOTE: This must be called while gdb is *not* running. gdb_caching_proc gdb_skip_xml_test { + global gdb_spawn_id global gdb_prompt global srcdir + if { [info exists gdb_spawn_id] } { + error "GDB must not be running in gdb_skip_xml_tests." + } + set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"] gdb_start @@ -4633,18 +5248,13 @@ gdb_caching_proc gdb_skip_xml_test { gdb_caching_proc gdb_has_argv0 { set result 0 - # Set up, compile, and execute a test program to check whether - # argv[0] is available. - set src [standard_temp_file has_argv0[pid].c] - set exe [standard_temp_file has_argv0[pid].x] - - gdb_produce_source $src { + # Compile and execute a test program to check whether argv[0] is available. + gdb_simple_compile has_argv0 { int main (int argc, char **argv) { return 0; } - } + } executable - gdb_compile $src $exe executable {debug} # Helper proc. proc gdb_has_argv0_1 { exe } { @@ -4675,31 +5285,50 @@ gdb_caching_proc gdb_has_argv0 { } } + set old_elements "200" + set test "show print elements" + gdb_test_multiple $test $test { + -re "Limit on string chars or array elements to print is (\[^\r\n\]+)\\.\r\n$gdb_prompt $" { + set old_elements $expect_out(1,string) + } + } + set old_repeats "200" + set test "show print repeats" + gdb_test_multiple $test $test { + -re "Threshold for repeated print elements is (\[^\r\n\]+)\\.\r\n$gdb_prompt $" { + set old_repeats $expect_out(1,string) + } + } + gdb_test_no_output "set print elements unlimited" "" + gdb_test_no_output "set print repeats unlimited" "" + + set retval 0 # Check whether argc is 1. gdb_test_multiple "p argc" "p argc" { -re " = 1\r\n${gdb_prompt} $" { gdb_test_multiple "p argv\[0\]" "p argv\[0\]" { -re " = $hex \".*[file tail $exe]\"\r\n${gdb_prompt} $" { - return 1 + set retval 1 } -re "${gdb_prompt} $" { - return 0 } } } -re "${gdb_prompt} $" { - return 0 } } - return 0 + + gdb_test_no_output "set print elements $old_elements" "" + gdb_test_no_output "set print repeats $old_repeats" "" + + return $retval } - set result [gdb_has_argv0_1 $exe] + set result [gdb_has_argv0_1 $obj] gdb_exit - file delete $src - file delete $exe + file delete $obj if { !$result && ([istarget *-*-linux*] @@ -4715,7 +5344,6 @@ gdb_caching_proc gdb_has_argv0 { || [istarget *-wince-pe] || [istarget *-*-mingw32ce*] || [istarget *-*-symbianelf*] || [istarget *-*-osf*] - || [istarget *-*-hpux*] || [istarget *-*-dicos*] || [istarget *-*-nto*] || [istarget *-*-*vms*] @@ -4975,6 +5603,16 @@ proc build_executable_from_specs {testname executable options args} { } } set ret [$func $sources_path "${binfile}" $options] + } elseif {[lsearch -exact $options rust] != -1} { + set sources_path {} + foreach {s local_options} $args { + if { [regexp "^/" "$s"] } then { + lappend sources_path "$s" + } else { + lappend sources_path "$srcdir/$subdir/$s" + } + } + set ret [gdb_compile_rust $sources_path "${binfile}" $options] } else { set objects {} set i 0 @@ -5070,15 +5708,23 @@ proc prepare_for_testing { testname executable {sources ""} {options {debug}}} { return 0 } -proc get_valueof { fmt exp default } { +# Retrieve the value of EXP in the inferior, represented in format +# specified in FMT (using "printFMT"). DEFAULT is used as fallback if +# print fails. TEST is the test message to use. It can be omitted, +# in which case a test message is built from EXP. + +proc get_valueof { fmt exp default {test ""} } { global gdb_prompt - set test "get valueof \"${exp}\"" + if {$test == "" } { + set test "get valueof \"${exp}\"" + } + set val ${default} gdb_test_multiple "print${fmt} ${exp}" "$test" { - -re "\\$\[0-9\]* = (.*)\[\r\n\]*$gdb_prompt $" { + -re "\\$\[0-9\]* = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" { set val $expect_out(1,string) - pass "$test ($val)" + pass "$test" } timeout { fail "$test (timeout)" @@ -5087,15 +5733,23 @@ proc get_valueof { fmt exp default } { return ${val} } -proc get_integer_valueof { exp default } { +# Retrieve the value of EXP in the inferior, as a signed decimal value +# (using "print /d"). DEFAULT is used as fallback if print fails. +# TEST is the test message to use. It can be omitted, in which case +# a test message is built from EXP. + +proc get_integer_valueof { exp default {test ""} } { global gdb_prompt - set test "get integer valueof \"${exp}\"" + if {$test == ""} { + set test "get integer valueof \"${exp}\"" + } + set val ${default} gdb_test_multiple "print /d ${exp}" "$test" { -re "\\$\[0-9\]* = (\[-\]*\[0-9\]*).*$gdb_prompt $" { set val $expect_out(1,string) - pass "$test ($val)" + pass "$test" } timeout { fail "$test (timeout)" @@ -5104,25 +5758,34 @@ proc get_integer_valueof { exp default } { return ${val} } -proc get_hexadecimal_valueof { exp default } { +# Retrieve the value of EXP in the inferior, as an hexadecimal value +# (using "print /x"). DEFAULT is used as fallback if print fails. +# TEST is the test message to use. It can be omitted, in which case +# a test message is built from EXP. + +proc get_hexadecimal_valueof { exp default {test ""} } { global gdb_prompt - send_gdb "print /x ${exp}\n" - set test "get hexadecimal valueof \"${exp}\"" - gdb_expect { + + if {$test == ""} { + set test "get hexadecimal valueof \"${exp}\"" + } + + set val ${default} + gdb_test_multiple "print /x ${exp}" $test { -re "\\$\[0-9\]* = (0x\[0-9a-zA-Z\]+).*$gdb_prompt $" { set val $expect_out(1,string) pass "$test" } - timeout { - set val ${default} - fail "$test (timeout)" - } } return ${val} } -proc get_sizeof { type default } { - return [get_integer_valueof "sizeof (${type})" $default] +# Retrieve the size of TYPE in the inferior, as a decimal value. DEFAULT +# is used as fallback if print fails. TEST is the test message to use. +# It can be omitted, in which case a test message is 'sizeof (TYPE)'. + +proc get_sizeof { type default {test ""} } { + return [get_integer_valueof "sizeof (${type})" $default $test] } proc get_target_charset { } { @@ -5142,6 +5805,46 @@ proc get_target_charset { } { return "UTF-8" } +# Get the address of VAR. + +proc get_var_address { var } { + global gdb_prompt hex + + # Match output like: + # $1 = (int *) 0x0 + # $5 = (int (*)()) 0 + # $6 = (int (*)()) 0x24 + + gdb_test_multiple "print &${var}" "get address of ${var}" { + -re "\\\$\[0-9\]+ = \\(.*\\) (0|$hex)( <${var}>)?\[\r\n\]+${gdb_prompt} $" + { + pass "get address of ${var}" + if { $expect_out(1,string) == "0" } { + return "0x0" + } else { + return $expect_out(1,string) + } + } + } + return "" +} + +# Return the frame number for the currently selected frame +proc get_current_frame_number {{test_name ""}} { + global gdb_prompt + + if { $test_name == "" } { + set test_name "get current frame number" + } + set frame_num -1 + gdb_test_multiple "frame" $test_name { + -re "#(\[0-9\]+) .*$gdb_prompt $" { + set frame_num $expect_out(1,string) + } + } + return $frame_num +} + # Get the current value for remotetimeout and return it. proc get_remotetimeout { } { global gdb_prompt @@ -5169,6 +5872,19 @@ proc set_remotetimeout { timeout } { } } +# Get the target's current endianness and return it. +proc get_endianness { } { + global gdb_prompt + + gdb_test_multiple "show endian" "determine endianness" { + -re ".* (little|big) endian.*\r\n$gdb_prompt $" { + # Pass silently. + return $expect_out(1,string) + } + } + return "little" +} + # ROOT and FULL are file names. Returns the relative path from ROOT # to FULL. Note that FULL must be in a subdirectory of ROOT. # For example, given ROOT = /usr/bin and FULL = /usr/bin/ls, this @@ -5314,18 +6030,141 @@ proc core_find {binfile {deletefiles {}} {arg ""}} { return $destcore } -# gdb_target_symbol_prefix_flags returns a string that can be added -# to gdb_compile options to define SYMBOL_PREFIX macro value -# symbol_prefix_flags returns a string that can be added -# for targets that use underscore as symbol prefix. -# TODO: find out automatically if the target needs this. +# gdb_target_symbol_prefix compiles a test program and then examines +# the output from objdump to determine the prefix (such as underscore) +# for linker symbol prefixes. + +gdb_caching_proc gdb_target_symbol_prefix { + # Compile a simple test program... + set src { int main() { return 0; } } + if {![gdb_simple_compile target_symbol_prefix $src executable]} { + return 0 + } + + set prefix "" + + set objdump_program [gdb_find_objdump] + set result [catch "exec $objdump_program --syms $obj" output] + + if { $result == 0 \ + && ![regexp -lineanchor \ + { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } { + verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2 + } + + file delete $obj + + return $prefix +} + +# Return 1 if target supports scheduler locking, otherwise return 0. + +gdb_caching_proc target_supports_scheduler_locking { + global gdb_prompt + + set me "gdb_target_supports_scheduler_locking" + + set src { int main() { return 0; } } + if {![gdb_simple_compile $me $src executable]} { + return 0 + } + + clean_restart $obj + if ![runto_main] { + return 0 + } + + set supports_schedule_locking -1 + set current_schedule_locking_mode "" + + set test "reading current scheduler-locking mode" + gdb_test_multiple "show scheduler-locking" $test { + -re "Mode for locking scheduler during execution is \"(\[\^\"\]*)\".*$gdb_prompt" { + set current_schedule_locking_mode $expect_out(1,string) + } + -re "$gdb_prompt $" { + set supports_schedule_locking 0 + } + timeout { + set supports_schedule_locking 0 + } + } + + if { $supports_schedule_locking == -1 } { + set test "checking for scheduler-locking support" + gdb_test_multiple "set scheduler-locking $current_schedule_locking_mode" $test { + -re "Target '\[^'\]+' cannot support this command\..*$gdb_prompt $" { + set supports_schedule_locking 0 + } + -re "$gdb_prompt $" { + set supports_schedule_locking 1 + } + timeout { + set supports_schedule_locking 0 + } + } + } + + if { $supports_schedule_locking == -1 } { + set supports_schedule_locking 0 + } + + gdb_exit + remote_file build delete $obj + verbose "$me: returning $supports_schedule_locking" 2 + return $supports_schedule_locking +} + +# gdb_target_symbol returns the provided symbol with the correct prefix +# prepended. (See gdb_target_symbol_prefix, above.) + +proc gdb_target_symbol { symbol } { + set prefix [gdb_target_symbol_prefix] + return "${prefix}${symbol}" +} + +# gdb_target_symbol_prefix_flags_asm returns a string that can be +# added to gdb_compile options to define the C-preprocessor macro +# SYMBOL_PREFIX with a value that can be prepended to symbols +# for targets which require a prefix, such as underscore. +# +# This version (_asm) defines the prefix without double quotes +# surrounding the prefix. It is used to define the macro +# SYMBOL_PREFIX for assembly language files. Another version, below, +# is used for symbols in inline assembler in C/C++ files. +# +# The lack of quotes in this version (_asm) makes it possible to +# define supporting macros in the .S file. (The version which +# uses quotes for the prefix won't work for such files since it's +# impossible to define a quote-stripping macro in C.) +# +# It's possible to use this version (_asm) for C/C++ source files too, +# but a string is usually required in such files; providing a version +# (no _asm) which encloses the prefix with double quotes makes it +# somewhat easier to define the supporting macros in the test case. + +proc gdb_target_symbol_prefix_flags_asm {} { + set prefix [gdb_target_symbol_prefix] + if {$prefix ne ""} { + return "additional_flags=-DSYMBOL_PREFIX=$prefix" + } else { + return ""; + } +} + +# gdb_target_symbol_prefix_flags returns the same string as +# gdb_target_symbol_prefix_flags_asm, above, but with the prefix +# enclosed in double quotes if there is a prefix. +# +# See the comment for gdb_target_symbol_prefix_flags_asm for an +# extended discussion. proc gdb_target_symbol_prefix_flags {} { - if { [istarget "i?86-*-cygwin*"] || [istarget "i?86-*-mingw*"] - || [istarget "*-*-msdosdjgpp*"] || [istarget "*-*-go32*"] } { - return "additional_flags=-DSYMBOL_PREFIX=\"_\"" + set prefix [gdb_target_symbol_prefix] + if {$prefix ne ""} { + return "additional_flags=-DSYMBOL_PREFIX=\"$prefix\"" } else { - return "" + return ""; } } @@ -5428,14 +6267,16 @@ proc parse_args { argset } { # number of items expected to be passed into the procedure... } -# Capture the output of COMMAND in a string ignoring PREFIX; return that string. +# Capture the output of COMMAND in a string ignoring PREFIX (a regexp); +# return that string. + proc capture_command_output { command prefix } { global gdb_prompt global expect_out set output_string "" gdb_test_multiple "$command" "capture_command_output for $command" { - -re "${command}\[\r\n\]+${prefix}(.*)\[\r\n\]+$gdb_prompt $" { + -re "[string_to_regexp ${command}]\[\r\n\]+${prefix}(.*)\[\r\n\]+$gdb_prompt $" { set output_string $expect_out(1,string) } } @@ -5453,5 +6294,110 @@ proc multi_line { args } { return [join $args "\r\n"] } +# Similar to the above, but while multi_line is meant to be used to +# match GDB output, this one is meant to be used to build strings to +# send as GDB input. + +proc multi_line_input { args } { + return [join $args "\n"] +} + +# Return the version of the DejaGnu framework. +# +# The return value is a list containing the major, minor and patch version +# numbers. If the version does not contain a minor or patch number, they will +# be set to 0. For example: +# +# 1.6 -> {1 6 0} +# 1.6.1 -> {1 6 1} +# 2 -> {2 0 0} + +proc dejagnu_version { } { + # The frame_version variable is defined by DejaGnu, in runtest.exp. + global frame_version + + verbose -log "DejaGnu version: $frame_version" + verbose -log "Expect version: [exp_version]" + verbose -log "Tcl version: [info tclversion]" + + set dg_ver [split $frame_version .] + + while { [llength $dg_ver] < 3 } { + lappend dg_ver 0 + } + + return $dg_ver +} + +# Define user-defined command COMMAND using the COMMAND_LIST as the +# command's definition. The terminating "end" is added automatically. + +proc gdb_define_cmd {command command_list} { + global gdb_prompt + + set input [multi_line_input {*}$command_list "end"] + set test "define $command" + + gdb_test_multiple "define $command" $test { + -re "End with" { + gdb_test_multiple $input $test { + -re "\r\n$gdb_prompt " { + } + } + } + } +} + +# Override the 'cd' builtin with a version that ensures that the +# log file keeps pointing at the same file. We need this because +# unfortunately the path to the log file is recorded using an +# relative path name, and, we sometimes need to close/reopen the log +# after changing the current directory. See get_compiler_info. + +rename cd builtin_cd + +proc cd { dir } { + + # Get the existing log file flags. + set log_file_info [log_file -info] + + # Split the flags into args and file name. + set log_file_flags "" + set log_file_file "" + foreach arg [ split "$log_file_info" " "] { + if [string match "-*" $arg] { + lappend log_file_flags $arg + } else { + lappend log_file_file $arg + } + } + + # If there was an existing file, ensure it is an absolute path, and then + # reset logging. + if { $log_file_file != "" } { + set log_file_file [file normalize $log_file_file] + log_file + log_file $log_file_flags "$log_file_file" + } + + # Call the builtin version of cd. + builtin_cd $dir +} + +# Return a list of all languages supported by GDB, suitable for use in +# 'set language NAME'. This doesn't include either the 'local' or +# 'auto' keywords. +proc gdb_supported_languages {} { + return [list c objective-c c++ d go fortran modula-2 asm pascal \ + opencl rust minimal ada] +} + +# Check if debugging is enabled for gdbserver. + +proc gdbserver_debug_enabled { } { + # Always disabled for GDB only setups. + return 0 +} + # Always load compatibility stuff. load_lib future.exp