diff options
Diffstat (limited to 'gdb/testsuite/lib')
62 files changed, 1753 insertions, 557 deletions
diff --git a/gdb/testsuite/lib/aarch64-scalable.exp b/gdb/testsuite/lib/aarch64-scalable.exp index 2ba7d15..c9f2463 100644 --- a/gdb/testsuite/lib/aarch64-scalable.exp +++ b/gdb/testsuite/lib/aarch64-scalable.exp @@ -1,4 +1,4 @@ -# Copyright 2023-2024 Free Software Foundation, Inc. +# Copyright 2023-2025 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 diff --git a/gdb/testsuite/lib/aarch64-test-sme.c b/gdb/testsuite/lib/aarch64-test-sme.c index 2925b48..c5d7a8a 100644 --- a/gdb/testsuite/lib/aarch64-test-sme.c +++ b/gdb/testsuite/lib/aarch64-test-sme.c @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2023-2024 Free Software Foundation, Inc. + Copyright 2023-2025 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 diff --git a/gdb/testsuite/lib/aarch64-test-sve.c b/gdb/testsuite/lib/aarch64-test-sve.c index d558a40..3eed754 100644 --- a/gdb/testsuite/lib/aarch64-test-sve.c +++ b/gdb/testsuite/lib/aarch64-test-sve.c @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2023-2024 Free Software Foundation, Inc. + Copyright 2023-2025 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 diff --git a/gdb/testsuite/lib/aarch64.exp b/gdb/testsuite/lib/aarch64.exp index 602120a..ef64489 100644 --- a/gdb/testsuite/lib/aarch64.exp +++ b/gdb/testsuite/lib/aarch64.exp @@ -1,4 +1,4 @@ -# Copyright 2023-2024 Free Software Foundation, Inc. +# Copyright 2023-2025 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 diff --git a/gdb/testsuite/lib/ada.exp b/gdb/testsuite/lib/ada.exp index 1bc0dc1..37bed85 100644 --- a/gdb/testsuite/lib/ada.exp +++ b/gdb/testsuite/lib/ada.exp @@ -1,4 +1,4 @@ -# Copyright 2004-2024 Free Software Foundation, Inc. +# Copyright 2004-2025 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 @@ -13,6 +13,35 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see <http://www.gnu.org/licenses/>. +# A wrapper for foreach_with_prefix that applies suitable +# -fgnat-encodings arguments to a command line. SCENARIO_ARG is the +# name of a loop variable that will hold the scenario currently being +# evaluated. FLAGS_ARG will be set to the appropriate compiler flags +# (if any) for this scenario. LIST is the list of desired scenarios +# to run, and BODY is what actually does the work. + +proc foreach_gnat_encoding {scenario_arg flags_arg list body} { + # gnat-llvm does not understand -fgnat-encodings at all. However, + # some tests examine the precise setting of the scenario -- so + # pretend we support minimal. What is going on here is that for + # gnat-llvm, there are no "GNAT encodings", only minimal + # encodings, aka, real DWARF. + set has_flag [ada_minimal_encodings] + if {!$has_flag} { + set list minimal + } + + upvar 1 $scenario_arg scenario + upvar 1 $flags_arg flags + foreach_with_prefix scenario $list { + set flags {} + if {$scenario != "none" && $has_flag} { + lappend flags additional_flags=-fgnat-encodings=$scenario + } + uplevel 1 $body + } +} + # Call target_compile with SOURCE DEST TYPE and OPTIONS as argument, # after having temporarily changed the current working directory to # BUILDDIR. @@ -148,25 +177,20 @@ proc find_ada_tool {tool} { return $result } -# Return 1 if gnatmake is at least version $MAJOR.x.x +# Compare the GNAT version against L2 using version_compare. If the +# compiler does not appear to be GCC, this will always return false. -proc gnatmake_version_at_least { major } { +proc gnat_version_compare {op l2} { set gnatmake [find_gnatmake] set gnatmake [lindex [split $gnatmake] 0] if {[catch {exec $gnatmake --version} output]} { return 0 } - if { [regexp {GNATMAKE ([^ .]+).([^ .]+).([^ .]+)} $output \ - match gnatmake_major gnatmake_minor gnatmake_micro] } { - if { $gnatmake_major >= $major } { - return 1 - } else { - return 0 - } + if {![regexp {GNATMAKE ([0-9]+(\.[0-9]+)*)} $output match version]} { + return 0 } - # Unknown, return 1 - return 1 + return [version_compare [split $version .] $op $l2] } # Return 1 if the GNAT runtime appears to have debug info. @@ -231,3 +255,50 @@ gdb_caching_proc gnat_runtime_has_debug_info {} { gdb_caching_proc shared_gnat_runtime_has_debug_info {} { return [gnat_runtime_has_debug_info_1 1] } + +# A helper that writes an Ada source file, then tries to compile it +# with the given compiler options (a list like one accepted by +# gdb_compile_ada). Returns 1 if the flags are supported, 0 +# otherwise. +proc ada_simple_compile {name options} { + set src [standard_temp_file $name.adb] + set dest [standard_temp_file $name.x] + set f [open $src w] + puts $f "procedure $name is" + puts $f "begin" + puts $f " null;" + puts $f "end $name;" + close $f + + # Note that we create an executable here. For -fvar-tracking, at + # least, the option is supported and ignored by llvm-gnatmake -- + # but then is passed to clang during further compilation, and this + # fails. So to detect it we can't just stop with a .o file. + set output [gdb_compile_ada_1 $src $dest executable $options] + return [expr {[gdb_compile_test_nofail $output] == 1}] +} + +# Return 1 if GNAT supports -fvar-tracking. +gdb_caching_proc ada_fvar_tracking {} { + return [ada_simple_compile fvar_tracking additional_flags=-fvar-tracking] +} + +# Return 1 if GNAT supports the minimal encodings option. +gdb_caching_proc ada_minimal_encodings {} { + return [ada_simple_compile minimal_encodings \ + additional_flags=-fgnat-encodings=minimal] +} + +# Return 1 if GNAT supports -Og. +gdb_caching_proc ada_og {} { + return [ada_simple_compile gnat_og additional_flags=-Og] +} + +# Return 1 if GNAT can link with -shared. +gdb_caching_proc ada_shared_link {} { + return [ada_simple_compile ada_shared_link { + additional_flags=-bargs + additional_flags=-shared + additional_flags=-margs + }] +} diff --git a/gdb/testsuite/lib/append_gdb_boards_dir.exp b/gdb/testsuite/lib/append_gdb_boards_dir.exp index 4aedba9..fadb372 100644 --- a/gdb/testsuite/lib/append_gdb_boards_dir.exp +++ b/gdb/testsuite/lib/append_gdb_boards_dir.exp @@ -1,4 +1,4 @@ -# Copyright 2012-2024 Free Software Foundation, Inc. +# Copyright 2012-2025 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 diff --git a/gdb/testsuite/lib/attributes.h b/gdb/testsuite/lib/attributes.h index 5dabd03..626c226 100644 --- a/gdb/testsuite/lib/attributes.h +++ b/gdb/testsuite/lib/attributes.h @@ -1,6 +1,6 @@ /* This file is part of GDB, the GNU debugger. - Copyright (C) 2020-2024 Free Software Foundation, Inc. + Copyright (C) 2020-2025 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 diff --git a/gdb/testsuite/lib/build-piece.exp b/gdb/testsuite/lib/build-piece.exp index 879fbf3..7de1f51 100644 --- a/gdb/testsuite/lib/build-piece.exp +++ b/gdb/testsuite/lib/build-piece.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2014-2024 Free Software Foundation, Inc. +# Copyright (C) 2014-2025 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 diff --git a/gdb/testsuite/lib/cache.exp b/gdb/testsuite/lib/cache.exp index 8066734..6ca3f18 100644 --- a/gdb/testsuite/lib/cache.exp +++ b/gdb/testsuite/lib/cache.exp @@ -1,4 +1,4 @@ -# Copyright 2012-2024 Free Software Foundation, Inc. +# Copyright 2012-2025 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 @@ -46,12 +46,81 @@ proc gdb_do_cache_wrap {real_name args} { return $result } +# Global written to by gdb_exit_called proc. Is set to true to +# indicate that a caching proc has called gdb_exit. + +set gdb_exit_called false + +# This proc is called via TCL's trace mechanism whenever gdb_exit is +# called during the execution of a caching proc. This sets the global +# flag to indicate that gdb_exit has been called. + +proc gdb_exit_called { args } { + set ::gdb_exit_called true +} + +# While calling the implementation of a caching proc, that +# implementation might itself call additional caching procs. We need +# to track all of the nested caching procs that are called and we do +# that in this list which is a list containing the names of any nested +# caching procs that are called. + +set gdb_nested_caching_proc_calls {} + +# Called before returning from gdb_do_cache. NAME is the name of the +# caching proc that was called. +# +# When DO_EXIT is true then this proc should call gdb_exit before +# returning, otherwise gdb_exit is not called. +# +# ALSO_CALLED is a list of the names all the nested caching procs that +# the proc NAME called. This proc appends NAME as well as everything +# in ALSO_CALLED to the global GDB_NESTED_CACHING_PROC_CALLS, this +# aids in tracking recursive caching proc calls. + +proc gdb_cache_maybe_gdb_exit { name do_exit also_called } { + + # Record all the procs that have been called, but only if the exit + # trace is in place (this is done in gdb_do_cache) and indicates + # that we are in data gathering mode. + if { [info exists ::gdb_exit_trace_in_place] } { + set ::gdb_nested_caching_proc_calls \ + [list {*}$::gdb_nested_caching_proc_calls $name {*}$also_called] + } + + # The cache 'exit' entry will be true if this caching proc, or any + # caching proc that is recursively called from this caching proc, + # called exit. + if { !$do_exit } { + return + } + + # To track if this proc has been called for NAME we create a + # global variable. In gdb_cleanup_globals (see gdb.exp) this + # global will be deleted when the test has finished. + set global_name __${name}__cached_gdb_exit_called + if { ![info exists ::${global_name}] } { + gdb_exit + verbose -log "gdb_caching_proc $name caused gdb_exit to be called" + set ::${global_name} true + verbose -log " gdb_caching_proc $name marked as called" + + foreach other_name $also_called { + verbose -log " gdb_caching_proc $other_name marked as called" + set global_name __${other_name}__cached_gdb_exit_called + set ::${global_name} true + } + } +} + # A helper for gdb_caching_proc that handles the caching. proc gdb_do_cache {name args} { global gdb_data_cache objdir global GDB_PARALLEL + verbose -log "gdb_do_cache: $name ( $args )" + # Normally, if we have a cached value, we skip computation and return # the cached value. If set to 1, instead don't skip computation and # verify against the cached value. @@ -70,11 +139,14 @@ proc gdb_do_cache {name args} { set cache_name [file join [target_info name] $name {*}$args] set is_cached 0 - if {[info exists gdb_data_cache($cache_name)]} { - set cached $gdb_data_cache($cache_name) - verbose "$name: returning '$cached' from cache" 2 + if {[info exists gdb_data_cache(${cache_name},value)]} { + set cached_value $gdb_data_cache(${cache_name},value) + set cached_exit $gdb_data_cache(${cache_name},exit) + set cached_also_called $gdb_data_cache(${cache_name},also_called) + verbose "$name: returning '$cached_value' from cache" 2 if { $cache_verify == 0 } { - return $cached + gdb_cache_maybe_gdb_exit $name $cached_exit $cached_also_called + return $cached_value } set is_cached 1 } @@ -83,37 +155,135 @@ proc gdb_do_cache {name args} { set cache_filename [make_gdb_parallel_path cache $cache_name] if {[file exists $cache_filename]} { set fd [open $cache_filename] - set gdb_data_cache($cache_name) [read -nonewline $fd] + set content [split [read -nonewline $fd] \n] close $fd - set cached $gdb_data_cache($cache_name) - verbose "$name: returning '$cached' from file cache" 2 + set gdb_data_cache(${cache_name},value) [lindex $content 0] + set gdb_data_cache(${cache_name},exit) [lindex $content 1] + set gdb_data_cache(${cache_name},also_called) [lindex $content 2] + set cached_value $gdb_data_cache(${cache_name},value) + set cached_exit $gdb_data_cache(${cache_name},exit) + set cached_also_called $gdb_data_cache(${cache_name},also_called) + verbose "$name: returning '$cached_value' from file cache" 2 if { $cache_verify == 0 } { - return $cached + gdb_cache_maybe_gdb_exit $name $cached_exit $cached_also_called + return $cached_value } set is_cached 1 } } + # Add a trace hook to gdb_exit. In the case of recursive calls to + # gdb_do_cache we only want to install the trace hook once, so we + # set a global to indicate that the trace is in place. + # + # We also set a local flag to indicate that this is the scope in + # which the debug trace needs to be removed. + if { ![info exists ::gdb_exit_trace_in_place] } { + trace add execution gdb_exit enter gdb_exit_called + set ::gdb_exit_trace_in_place true + set gdb_exit_trace_created true + } else { + set gdb_exit_trace_created false + } + + # As above, we need to consider recursive calls into gdb_do_cache. + # Store the old value of gdb_exit_called global and then set the + # flag to false. Initially gdb_exit_called is always false, but + # for recursive calls to gdb_do_cache we can't know the state of + # gdb_exit_called. + # + # Before starting a recursive gdb_do_cache call we need + # gdb_exit_called to be false, that way the inner call can know if + # it invoked gdb_exit or not. + # + # Once the recursive call completes, if it did call gdb_exit then + # the outer, parent call to gdb_do_cache should also be considered + # as having called gdb_exit. + set old_gdb_exit_called $::gdb_exit_called + set ::gdb_exit_called false + + # As with the exit tracking above we also need to track any nested + # caching procs that this proc might call. To do this we backup + # the current global list of nested caching proc calls and reset + # the global back ot the empty list. As nested caching procs are + # called their names are added to the global list, see + # gdb_cache_maybe_gdb_exit for where this is done. + set old_gdb_nested_caching_proc_calls $::gdb_nested_caching_proc_calls + set ::gdb_nested_caching_proc_calls {} + set real_name gdb_real__$name - set gdb_data_cache($cache_name) [gdb_do_cache_wrap $real_name {*}$args] + set gdb_data_cache(${cache_name},value) [gdb_do_cache_wrap $real_name {*}$args] + set gdb_data_cache(${cache_name},exit) $::gdb_exit_called + set gdb_data_cache(${cache_name},also_called) \ + [lsort -unique $::gdb_nested_caching_proc_calls] + + # Now that the actual implementation of this caching proc has been + # executed the gdb_nested_caching_proc_calls global will contain + # the names of any nested caching procs that were called. We + # append this new set of names onto the set of names we backed up + # above. + set ::gdb_nested_caching_proc_calls \ + [list {*}$old_gdb_nested_caching_proc_calls \ + {*}$::gdb_nested_caching_proc_calls] + + # See comment above where OLD_GDB_EXIT_CALLED is set: if + # GDB_EXIT_CALLED was previously true then this is a recursive + # call and the outer caching proc set the global true, so restore + # the true value now. + if { $old_gdb_exit_called } { + set ::gdb_exit_called true + } + + # See comment above where GDB_EXIT_TRACE_CREATED is set: this is + # the frame in which the trace was installed. This must be the + # outer caching proc call (if an recursion occurred). + if { $gdb_exit_trace_created } { + trace remove execution gdb_exit enter gdb_exit_called + unset ::gdb_exit_trace_in_place + set ::gdb_exit_called false + set ::gdb_nested_caching_proc_calls {} + } + + # If a value being stored in the cache contains a newline then + # when we try to read the value back from an on-disk cache file + # we'll interpret the second line of the value as the ',exit' value. + if { [regexp "\[\r\n\]" $gdb_data_cache(${cache_name},value)] } { + set computed_value $gdb_data_cache(${cache_name},value) + error "Newline found in value for $cache_name: $computed_value" + } + if { $cache_verify == 1 && $is_cached == 1 } { - set computed $gdb_data_cache($cache_name) - if { $cached != $computed } { - error [join [list "Inconsistent results for $cache_name:" - "cached: $cached vs. computed: $computed"]] + set computed_value $gdb_data_cache(${cache_name},value) + set computed_exit $gdb_data_cache(${cache_name},exit) + set computed_also_called $gdb_data_cache(${cache_name},also_called) + if { $cached_value != $computed_value } { + error [join [list "Inconsistent value results for $cache_name:" + "cached: $cached_value vs. computed: $computed_value"]] + } + if { $cached_exit != $computed_exit } { + error [join [list "Inconsistent exit results for $cache_name:" + "cached: $cached_exit vs. computed: $computed_exit"]] + } + if { $cached_also_called != $computed_also_called } { + error [join [list "Inconsistent also_called results for $cache_name:" + "cached: $cached_also_called vs. computed: $computed_also_called"]] } } if {[info exists GDB_PARALLEL]} { - verbose "$name: returning '$gdb_data_cache($cache_name)' and writing file" 2 + verbose "$name: returning '$gdb_data_cache(${cache_name},value)' and writing file" 2 file mkdir [file dirname $cache_filename] # Make sure to write the results file atomically. set fd [open $cache_filename.[pid] w] - puts $fd $gdb_data_cache($cache_name) + puts $fd $gdb_data_cache(${cache_name},value) + puts $fd $gdb_data_cache(${cache_name},exit) + puts $fd $gdb_data_cache(${cache_name},also_called) close $fd file rename -force -- $cache_filename.[pid] $cache_filename } - return $gdb_data_cache($cache_name) + gdb_cache_maybe_gdb_exit $name $gdb_data_cache(${cache_name},exit) \ + $gdb_data_cache(${cache_name},also_called) + return $gdb_data_cache(${cache_name},value) } # Define a new proc named NAME, with optional args ARGS. BODY is the body of diff --git a/gdb/testsuite/lib/check-test-names.exp b/gdb/testsuite/lib/check-test-names.exp index 8f86f31..049addd 100644 --- a/gdb/testsuite/lib/check-test-names.exp +++ b/gdb/testsuite/lib/check-test-names.exp @@ -1,4 +1,4 @@ -# Copyright 2020-2024 Free Software Foundation, Inc. +# Copyright 2020-2025 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 @@ -64,6 +64,16 @@ namespace eval ::CheckTestNames { proc _check_duplicates { message } { variable all_test_names + # Remove test-case prefix, including the space separator. + set prefix [string_to_regexp "$::subdir/$::gdb_test_file_name.exp: "] + set message [regsub ^$prefix $message ""] + + # Remove the "extra information" part. + set message [regsub { \([^()]*\)$} $message ""] + + # Add back the test-case prefix. + set message "${prefix}$message" + # Initialise a count, or increment the count for this test name. if {![info exists all_test_names($message)]} { set all_test_names($message) 0 diff --git a/gdb/testsuite/lib/cl_util.c b/gdb/testsuite/lib/cl_util.c index 048346b..e5eb369 100644 --- a/gdb/testsuite/lib/cl_util.c +++ b/gdb/testsuite/lib/cl_util.c @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2010-2024 Free Software Foundation, Inc. + Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/cl_util.h b/gdb/testsuite/lib/cl_util.h index 3d03c84..6034518 100644 --- a/gdb/testsuite/lib/cl_util.h +++ b/gdb/testsuite/lib/cl_util.h @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2010-2024 Free Software Foundation, Inc. + Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/compile-support.exp b/gdb/testsuite/lib/compile-support.exp index aa8aaf3..dd0b9a9 100644 --- a/gdb/testsuite/lib/compile-support.exp +++ b/gdb/testsuite/lib/compile-support.exp @@ -1,4 +1,4 @@ -# Copyright 2015-2024 Free Software Foundation, Inc. +# Copyright 2015-2025 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 @@ -45,6 +45,9 @@ proc _do_check_compile {expr} { # This appears to be a bug in the compiler plugin. set result "apparent compiler plugin bug" } + -re "This command is not supported." { + set result "compiler disabled at configure time" + } -re "\r\n$gdb_prompt $" { } } diff --git a/gdb/testsuite/lib/compiler.F90 b/gdb/testsuite/lib/compiler.F90 index 07f9852..b92b9c6 100644 --- a/gdb/testsuite/lib/compiler.F90 +++ b/gdb/testsuite/lib/compiler.F90 @@ -1,4 +1,4 @@ -/* Copyright 2022-2024 Free Software Foundation, Inc. +/* Copyright 2022-2025 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 diff --git a/gdb/testsuite/lib/compiler.c b/gdb/testsuite/lib/compiler.c index 0749435..e457fba 100644 --- a/gdb/testsuite/lib/compiler.c +++ b/gdb/testsuite/lib/compiler.c @@ -1,6 +1,6 @@ /* This test file is part of GDB, the GNU debugger. - Copyright 1995-2024 Free Software Foundation, Inc. + Copyright 1995-2025 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 diff --git a/gdb/testsuite/lib/compiler.cc b/gdb/testsuite/lib/compiler.cc index aa46228..ee2280f 100755 --- a/gdb/testsuite/lib/compiler.cc +++ b/gdb/testsuite/lib/compiler.cc @@ -1,6 +1,6 @@ /* This test file is part of GDB, the GNU debugger. - Copyright 1995-2024 Free Software Foundation, Inc. + Copyright 1995-2025 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 diff --git a/gdb/testsuite/lib/completion-support.exp b/gdb/testsuite/lib/completion-support.exp index 5f0f619..15f59e6 100644 --- a/gdb/testsuite/lib/completion-support.exp +++ b/gdb/testsuite/lib/completion-support.exp @@ -1,4 +1,4 @@ -# Copyright 2017-2024 Free Software Foundation, Inc. +# Copyright 2017-2025 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 diff --git a/gdb/testsuite/lib/cp-support.exp b/gdb/testsuite/lib/cp-support.exp index d883309..40351c6 100644 --- a/gdb/testsuite/lib/cp-support.exp +++ b/gdb/testsuite/lib/cp-support.exp @@ -1,6 +1,6 @@ # This test code is part of GDB, the GNU debugger. -# Copyright 2003-2024 Free Software Foundation, Inc. +# Copyright 2003-2025 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 diff --git a/gdb/testsuite/lib/d-support.exp b/gdb/testsuite/lib/d-support.exp index 3edb664..717d88b 100644 --- a/gdb/testsuite/lib/d-support.exp +++ b/gdb/testsuite/lib/d-support.exp @@ -1,4 +1,4 @@ -# Copyright 2014-2024 Free Software Foundation, Inc. +# Copyright 2014-2025 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 diff --git a/gdb/testsuite/lib/dap-support.exp b/gdb/testsuite/lib/dap-support.exp index 61355b5..d61b1c4 100644 --- a/gdb/testsuite/lib/dap-support.exp +++ b/gdb/testsuite/lib/dap-support.exp @@ -1,4 +1,4 @@ -# Copyright 2022-2024 Free Software Foundation, Inc. +# Copyright 2022-2025 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 @@ -248,10 +248,10 @@ proc dap_request_and_response {command {obj {}}} { return [dap_read_response $command $seq] } -# Like dap_request_and_response, but also checks that the response -# indicates success. NAME is used to issue a test result. -proc dap_check_request_and_response {name command {obj {}}} { - set response_and_events [dap_request_and_response $command $obj] +# Wait for a response to the given request, and issue a pass/fail. +# Returns the response and events like dap_request_and_response. +proc dap_check_response {name cmd request} { + set response_and_events [dap_read_response $cmd $request] set response [lindex $response_and_events 0] if {[dict get $response success] != "true"} { verbose "request failure: $response" @@ -262,26 +262,35 @@ proc dap_check_request_and_response {name command {obj {}}} { return $response_and_events } +# Like dap_request_and_response, but also checks that the response +# indicates success. NAME is used to issue a test result. +proc dap_check_request_and_response {name command {obj {}}} { + set seq [dap_send_request $command $obj] + return [dap_check_response $name $command $seq] +} + # Start gdb, send a DAP initialization request and return the # response. This approach lets the caller check the feature list, if # desired. Returns the empty string on failure. NAME is used as the -# test name. -proc dap_initialize {{name "initialize"}} { +# test name. EXTRA are other settings to pass via the "initialize" +# request. +proc dap_initialize {{name "initialize"} {extra ""}} { if {[dap_gdb_start]} { return "" } return [dap_check_request_and_response $name initialize \ - {o clientID [s "gdb testsuite"] \ - supportsVariableType [l true] \ - supportsVariablePaging [l true] \ - supportsMemoryReferences [l true]}] + [format {o clientID [s "gdb testsuite"] \ + supportsVariableType [l true] \ + supportsVariablePaging [l true] \ + supportsMemoryReferences [l true] \ + %s} \ + $extra]] } # Send a launch request specifying FILE as the program to use for the -# inferior. Returns the empty string on failure, or the response -# object from the launch request. If specified, ARGS is a dictionary -# of key-value pairs, each passed to the launch request. Valid keys -# are: +# inferior. Returns the request ID. If specified, ARGS is a +# dictionary of key-value pairs, each passed to the launch request. +# Valid keys are: # # * arguments - value is a list of strings passed as command-line # arguments to the inferior @@ -334,12 +343,12 @@ proc dap_launch {file {args {}}} { } } - return [dap_check_request_and_response "startup - launch" launch $params] + return [dap_send_request launch $params] } # Start gdb, send a DAP initialize request, and then an attach request # specifying PID as the inferior process ID. Returns the empty string -# on failure, or the response object from the attach request. +# on failure, or the attach request sequence ID. proc dap_attach {pid {prog ""}} { if {[dap_initialize "startup - initialize"] == ""} { return "" @@ -350,18 +359,17 @@ proc dap_attach {pid {prog ""}} { append args [format { program [s %s]} $prog] } - return [dap_check_request_and_response "startup - attach" attach $args] + return [dap_send_request attach $args] } # Start gdb, send a DAP initialize request, and then an attach request # specifying TARGET as the remote target. Returns the empty string on -# failure, or the response object from the attach request. +# failure, or the attach request sequence ID. proc dap_target_remote {target} { if {[dap_initialize "startup - initialize"] == ""} { return "" } - return [dap_check_request_and_response "startup - target" attach \ - [format {o target [s %s]} $target]] + return [dap_send_request attach [format {o target [s %s]} $target]] } # Read the most recent DAP log file and check it for exceptions. diff --git a/gdb/testsuite/lib/data-structures.exp b/gdb/testsuite/lib/data-structures.exp index 461a11c..ccf7e81 100644 --- a/gdb/testsuite/lib/data-structures.exp +++ b/gdb/testsuite/lib/data-structures.exp @@ -1,4 +1,4 @@ -# Copyright 2017-2024 Free Software Foundation, Inc. +# Copyright 2017-2025 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 diff --git a/gdb/testsuite/lib/debuginfod-support.exp b/gdb/testsuite/lib/debuginfod-support.exp index 0096448..674888a 100644 --- a/gdb/testsuite/lib/debuginfod-support.exp +++ b/gdb/testsuite/lib/debuginfod-support.exp @@ -1,4 +1,4 @@ -# Copyright 2020-2024 Free Software Foundation, Inc. +# Copyright 2020-2025 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 diff --git a/gdb/testsuite/lib/dg-add-core-file-count.sh b/gdb/testsuite/lib/dg-add-core-file-count.sh index b4cb6b9..115cf51 100755 --- a/gdb/testsuite/lib/dg-add-core-file-count.sh +++ b/gdb/testsuite/lib/dg-add-core-file-count.sh @@ -1,6 +1,6 @@ #!/bin/sh -# Copyright (C) 2022-2024 Free Software Foundation, Inc. +# Copyright (C) 2022-2025 Free Software Foundation, Inc. # This file is part of GDB. diff --git a/gdb/testsuite/lib/dtrace.exp b/gdb/testsuite/lib/dtrace.exp index fb6204f..d558aba 100644 --- a/gdb/testsuite/lib/dtrace.exp +++ b/gdb/testsuite/lib/dtrace.exp @@ -1,4 +1,4 @@ -# Copyright 2014-2024 Free Software Foundation, Inc. +# Copyright 2014-2025 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 diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index 995cdca..3a182c2 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -1,4 +1,4 @@ -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 @@ -678,6 +678,11 @@ namespace eval Dwarf { } } close $fd + + variable _constants + + # Add DW_FORM_strx_id as alias of DW_FORM_strx. + _process_one_constant DW_FORM_strx_id $_constants(DW_FORM_strx) } proc _quote {string} { @@ -823,6 +828,12 @@ namespace eval Dwarf { DW_FORM_indirect - DW_FORM_exprloc - + # Generate a DW_FORM_str index, but assume generation of .debug_str and + # .debug_str_offsets is taken care of elsewhere. + DW_FORM_strx_id { + _op .uleb128 $value + } + DW_FORM_strx - DW_FORM_strx1 - DW_FORM_strx2 - @@ -887,6 +898,10 @@ namespace eval Dwarf { DW_AT_GNU_addr_base { return DW_FORM_sec_offset } + DW_AT_decl_file - + DW_AT_decl_line { + return DW_FORM_udata + } } return "" } @@ -1057,7 +1072,10 @@ namespace eval Dwarf { } proc _section {name {flags ""} {type ""}} { - if {$flags == "" && $type == ""} { + if {$name == ".debug_str"} { + # Hard-code this because it's always desirable. + _emit " .section $name, \"MS\", %progbits, 1" + } elseif {$flags == "" && $type == ""} { _emit " .section $name" } elseif {$type == ""} { _emit " .section $name, \"$flags\"" @@ -1240,7 +1258,6 @@ namespace eval Dwarf { # used, as indicated in the header of the section where the location # description is found. # - # (FIXME should use 'info complete' here.) # Each list's first element is the opcode, either short or long # forms are accepted. # FIXME argument handling @@ -1248,9 +1265,18 @@ namespace eval Dwarf { proc _location { body dwarf_version addr_size offset_size } { variable _constants + set collected_lines "" foreach line [split $body \n] { # Ignore blank lines, and allow embedded comments. - if {[lindex $line 0] == "" || [regexp -- {^[ \t]*#} $line]} { + if { [regexp -- {^[ \t]*$} $line] || [regexp -- {^[ \t]*#} $line] } { + continue + } + if { $collected_lines != "" } { + set line "$collected_lines\n$line" + set collected_lines "" + } + if { ! [info complete $line] } { + set collected_lines $line continue } set opcode [_map_name [lindex $line 0] _OP] @@ -1336,6 +1362,17 @@ namespace eval Dwarf { _op .2byte $argvec(label) } + DW_OP_entry_value { + _get_args $line $opcode body + set l1 [new_label "expr_start"] + set l2 [new_label "expr_end"] + _op .uleb128 "$l2 - $l1" "expression" + define_label $l1 + _location $argvec(body) $dwarf_version $addr_size \ + $offset_size + define_label $l2 + } + DW_OP_implicit_value { set l1 [new_label "value_start"] set l2 [new_label "value_end"] @@ -1437,6 +1474,17 @@ namespace eval Dwarf { # default = default # fission 0|1 - boolean indicating if generating Fission debug info # default = 0 + # dwo_id - The value to use as the dwo_id field of skeleton and + # split_compile unit headers. May only be used with DWARF + # version 5. + # + # If a dwo_id value is specified (is non-zero), this unit is + # assumed to be part of a skeleton/split_unit pair. The unit + # type will be chosen according to the `fission` value. + # + # When using DWARF version 5 and fission is non-zero, it is + # mandatory to provide a non-zero dwo_id value. + # default = 0 # label <label> # - string indicating label to be defined at the start # of the CU header. @@ -1459,6 +1507,7 @@ namespace eval Dwarf { set _cu_version 4 set _cu_addr_size default set _cu_is_fission 0 + set dwo_id 0 set section ".debug_info" set _abbrev_section ".debug_abbrev" set label "" @@ -1470,6 +1519,7 @@ namespace eval Dwarf { version { set _cu_version $value } addr_size { set _cu_addr_size $value } fission { set _cu_is_fission $value } + dwo_id { set dwo_id $value } label { set label $value } default { error "unknown option $name" } } @@ -1520,12 +1570,42 @@ namespace eval Dwarf { # The CU header for DWARF 4 and 5 are slightly different. if { $_cu_version == 5 } { - _op .byte 0x1 "DW_UT_compile" + # The presence of a DWO_ID indicates that we generate a skeleton + # or split_compile unit. + if { $dwo_id != 0 } { + if { $_cu_is_fission } { + set unit_type_name "DW_UT_split_compile" + } else { + set unit_type_name "DW_UT_skeleton" + } + } else { + set unit_type_name "DW_UT_compile" + } + + _op .byte $_constants($unit_type_name) $unit_type_name _op .byte $_cu_addr_size "Pointer size" _op_offset $_cu_offset_size $my_abbrevs Abbrevs + + # Output DWO ID, if specified. + if { $dwo_id != 0 } { + _op .8byte $dwo_id "DWO_ID" + } else { + # To help catch user errors: if the caller asked to put this + # unit in the DWO file but didn't provide a DWO ID, it is likely + # an error. + if { $_cu_is_fission } { + error "DWO ID not specified for DWARF 5 split compile" + } + } } else { _op_offset $_cu_offset_size $my_abbrevs Abbrevs _op .byte $_cu_addr_size "Pointer size" + + # For DWARF versions < 5, the DWO ID is not in the unit header, + # so it makes not sense to specify one. + if { $dwo_id != 0 } { + error "DWO ID specified for DWARF < 5 unit" + } } _defer_output $_abbrev_section { @@ -1602,7 +1682,7 @@ namespace eval Dwarf { } if { $_cu_is_fission } { set section "$section.dwo" - set _abbrev_section "$section.dwo" + set _abbrev_section "$_abbrev_section.dwo" } _section $section @@ -2644,25 +2724,25 @@ namespace eval Dwarf { set _line_address_update 0 variable _line_program_terminated set _line_program_terminated 0 - _op .byte 1 + _op .byte 1 DW_LNS_copy } proc DW_LNS_negate_stmt {} { variable _line_program_terminated set _line_program_terminated 0 - _op .byte 6 + _op .byte 6 DW_LNS_negate_stmt } proc DW_LNS_set_prologue_end {} { variable _line_program_terminated set _line_program_terminated 0 - _op .byte 0x0a + _op .byte 0x0a DW_LNS_set_prologue_end } proc DW_LNS_set_epilogue_begin {} { variable _line_program_terminated set _line_program_terminated 0 - _op .byte 0x0b + _op .byte 0x0b DW_LNS_set_epilogue_begin } proc DW_LNS_advance_pc {offset} { @@ -2670,7 +2750,7 @@ namespace eval Dwarf { set _line_program_terminated 0 variable _line_address_update set _line_address_update 1 - _op .byte 2 + _op .byte 2 DW_LNS_advance_pc _op .uleb128 ${offset} } @@ -2678,7 +2758,7 @@ namespace eval Dwarf { variable _line_program_terminated set _line_program_terminated 0 variable _line - _op .byte 3 + _op .byte 3 DW_LNS_advance_line _op .sleb128 ${offset} set _line [expr $_line + $offset] } @@ -2701,7 +2781,7 @@ namespace eval Dwarf { proc DW_LNS_set_file {num} { variable _line_program_terminated set _line_program_terminated 0 - _op .byte 4 + _op .byte 4 DW_LNS_set_file _op .sleb128 ${num} } @@ -2755,8 +2835,11 @@ namespace eval Dwarf { set addr_op .4byte } - _op $addr_op $arange_start "Address range start$comment" - _op $addr_op $arange_length "Address range length$comment" + # Do not emit address ranges when the Address size is set to 0. + if { $_addr_size > 0 } { + _op $addr_op $arange_start "Address range start$comment" + _op $addr_op $arange_length "Address range length$comment" + } } # Emit a DWARF .debug_aranges unit. @@ -2771,7 +2854,7 @@ namespace eval Dwarf { # section_version n # - section version number to emit # default = 2 - # seg_size n - the size of the adress selector in bytes: 0, 4, or 8 + # seg_size n - the size of the address selector in bytes: 0, 4, or 8 # default = 0 # # LABEL is the label of the corresponding CU. @@ -2793,6 +2876,7 @@ namespace eval Dwarf { { cu_is_64 0 } { section_version 2 } { seg_size 0 } + { addr_zero false } } set _seg_size $seg_size @@ -2802,6 +2886,10 @@ namespace eval Dwarf { set _addr_size 4 } + if { $addr_zero } { + set _addr_size 0 + } + # Switch to .debug_aranges section. _section .debug_aranges @@ -2849,6 +2937,9 @@ namespace eval Dwarf { # Padding. set tuple_size [expr 2 * $_addr_size + $_seg_size] + if {$tuple_size == 0} { + set tuple_size 1 + } while { 1 } { if { [expr $offset % $tuple_size] == 0 } { break @@ -2991,27 +3082,52 @@ namespace eval Dwarf { } } + # Emit a .debug_sup section with the given file name and build-id. + # The buildid should be represented as a hexadecimal string, like + # "ffeeddcc". + proc debug_sup {is_sup filename buildid} { + _defer_output .debug_sup { + # The version. + _op .2byte 0x5 + # Supplementary marker. + _op .byte $is_sup + _op .ascii [_quote $filename] + set len [expr {[string length $buildid] / 2}] + _op .uleb128 $len + foreach {a b} [split $buildid {}] { + _op .byte 0x$a$b + } + } + } + proc _note {type name hexdata} { set namelen [expr [string length $name] + 1] + set datalen [expr [string length $hexdata] / 2] # Name size. _op .4byte $namelen # Data size. - _op .4byte [expr [string length $hexdata] / 2] + _op .4byte $datalen # Type. _op .4byte $type # The name. _op .ascii [_quote $name] - # Alignment. + # Alignment (to 4-byte boundary). set align 2 set total [expr {($namelen + (1 << $align) - 1) & -(1 << $align)}] for {set i $namelen} {$i < $total} {incr i} { - _op .byte 0 + _op .byte 0 padding } # The data. foreach {a b} [split $hexdata {}] { _op .byte 0x$a$b } + # Alignment (to 4-byte boundary). + set align 2 + set total [expr {($datalen + (1 << $align) - 1) & -(1 << $align)}] + for {set i $datalen} {$i < $total} {incr i} { + _op .byte 0 padding + } } # Emit a note section holding the given build-id. @@ -3108,10 +3224,11 @@ namespace eval Dwarf { } variable _debug_names set _debug_names [] - proc _debug_names_name { name tag cu hash } { + proc _debug_names_name { name tag cu hash {extra {}} } { variable _debug_names declare_labels entry_pool_offset - lappend _debug_names [list $name $tag $cu $hash $entry_pool_offset] + lappend _debug_names [list $name $tag $cu $hash $extra \ + $entry_pool_offset] } with_override Dwarf::cu Dwarf::_debug_names_cu { with_override Dwarf::tu Dwarf::_debug_names_tu { @@ -3174,14 +3291,13 @@ namespace eval Dwarf { # Hash Lookup Table - array of hashes. foreach idx $_debug_names { - set name [lindex $idx 0] - set hash [lindex $idx 3] + lassign $idx name tag cu hash extra label _op .4byte $hash "hash: $name" } # Name Table - array of string offsets. foreach idx $_debug_names { - set name [lindex $idx 0] + lassign $idx name tag cu hash extra label variable _strings if {![info exists _strings($name)]} { @@ -3198,8 +3314,7 @@ namespace eval Dwarf { # Name Table - array of entry offsets. set base_label "" foreach idx $_debug_names { - set name [lindex $idx 0] - set label [lindex $idx 4] + lassign $idx name tag cu hash extra label if { [string equal $base_label ""]} { set base_label $label } @@ -3212,31 +3327,42 @@ namespace eval Dwarf { set abbrev 1 variable _constants foreach idx $_debug_names { - set name [lindex $idx 0] - set tag [lindex $idx 1] - set cu [lindex $idx 2] + lassign $idx name tag cu hash extra label if { [regexp "^CU-($decimal)$" $cu dummy cu_index] } { - set attr_name compile_unit - set attr_val 1 + set attr_name DW_IDX_compile_unit } elseif { [regexp "^TU-($decimal)$" $cu dummy cu_index] } { - set attr_name type_unit - set attr_val 2 + set attr_name DW_IDX_type_unit } else { set cu_index [lsearch -exact $_debug_names_cus $cu] if { $cu_index == -1 } { - set attr_name type_unit - set attr_val 2 + set attr_name DW_IDX_type_unit } else { - set attr_name compile_unit - set attr_val 1 + set attr_name DW_IDX_compile_unit } } - _op .byte $abbrev "abbrev $abbrev" + _op .uleb128 $abbrev "abbrev $abbrev" _op .uleb128 $_constants(DW_TAG_$tag) "DW_TAG_$tag" - _op .byte $attr_val "DW_IDX_$attr_name (attribute)" - _op .byte 0x0f "DW_FORM_udata (form)" + _op .uleb128 $_constants($attr_name) \ + "$attr_name (attribute)" + _op .uleb128 0x0f "DW_FORM_udata (form)" + foreach word $extra { + if {$word == "static"} { + _op .uleb128 $_constants(DW_IDX_GNU_internal) \ + "DW_IDX_GNU_internal" + _op .uleb128 $_constants(DW_FORM_flag_present) \ + "DW_FORM_flag_present" + } elseif {[string match DW_LANG_* $word]} { + _op .uleb128 $_constants(DW_IDX_GNU_language) \ + "DW_IDX_GNU_language" + _op .uleb128 $_constants(DW_FORM_implicit_const) \ + "DW_FORM_flag_present" + _op .sleb128 $_constants($word) $word + } else { + error "unrecognized extra keyword $word" + } + } _op .byte 0 "abbrev terminator (attribute)" _op .byte 0 "abbrev terminator (form)" incr abbrev @@ -3247,9 +3373,7 @@ namespace eval Dwarf { # Entry Pool set abbrev 1 foreach idx $_debug_names { - set name [lindex $idx 0] - set cu [lindex $idx 2] - set label [lindex $idx 4] + lassign $idx name tag cu hash extra label if { [regexp "^CU-($decimal)$" $cu dummy cu_index] } { set comment "$name: CU index" @@ -3275,6 +3399,58 @@ namespace eval Dwarf { debug_names_end: } + # Add the strings in ARGS to the .debug_str section, and create a + # .debug_str_offsets section pointing to those strings. + # Current options are: + # dwo 0|1 - boolean indicating if the sections have the dwo suffix. + # default = 0 (no .dwo suffix) + # base_offset label + # - generate label, to be used in DW_AT_str_offsets_base. + # default = "" (don't generate a label). + proc debug_str_offsets { options args } { + parse_options { + { dwo 0 } + { base_offset "" } + } + + if { $dwo } { + _section .debug_str.dwo + } else { + _section .debug_str + } + + set num 0 + foreach arg $args { + set str_label [_compute_label "str_${num}"] + define_label $str_label + _op .asciz \"$arg\" ".debug_str_offsets string $num" + incr num + } + + declare_labels debug_str_offsets_start debug_str_offsets_end + set initial_length "$debug_str_offsets_end - $debug_str_offsets_start" + + if { $dwo } { + _section .debug_str_offsets.dwo + } else { + _section .debug_str_offsets + } + _op .4byte $initial_length "Initial_length" + debug_str_offsets_start: + _op .2byte 0x5 "version" + _op .2byte 0x0 "padding" + if { $base_offset != "" } { + $base_offset: + } + set num 0 + foreach arg $args { + set str_label [_compute_label "str_${num}"] + _op .4byte $str_label "string $num" + incr num + } + debug_str_offsets_end: + } + # The top-level interface to the DWARF assembler. # OPTIONS is a list with an even number of elements containing # option-name and option-value pairs. diff --git a/gdb/testsuite/lib/fortran.exp b/gdb/testsuite/lib/fortran.exp index cddcc3a..6f2bbd8 100644 --- a/gdb/testsuite/lib/fortran.exp +++ b/gdb/testsuite/lib/fortran.exp @@ -1,6 +1,6 @@ # This test code is part of GDB, the GNU debugger. -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/future.exp b/gdb/testsuite/lib/future.exp index 62913cb..161c31c 100644 --- a/gdb/testsuite/lib/future.exp +++ b/gdb/testsuite/lib/future.exp @@ -1,4 +1,4 @@ -# Copyright 2004-2024 Free Software Foundation, Inc. +# Copyright 2004-2025 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 diff --git a/gdb/testsuite/lib/gdb-guile.exp b/gdb/testsuite/lib/gdb-guile.exp index 412dd56..776dbc6 100644 --- a/gdb/testsuite/lib/gdb-guile.exp +++ b/gdb/testsuite/lib/gdb-guile.exp @@ -1,4 +1,4 @@ -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/gdb-python.exp b/gdb/testsuite/lib/gdb-python.exp index e27d5c1..e026c1b 100644 --- a/gdb/testsuite/lib/gdb-python.exp +++ b/gdb/testsuite/lib/gdb-python.exp @@ -1,4 +1,4 @@ -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 @@ -22,6 +22,7 @@ proc gdb_py_test_silent_cmd { cmd name report_pass } { global gdb_prompt gdb_test_multiple $cmd $name { + -re "Error occurred in Python:.*$gdb_prompt $" { fail $name } -re "Traceback.*$gdb_prompt $" { fail $name } -re "$gdb_prompt $" { if $report_pass { pass $name } } } @@ -76,3 +77,24 @@ proc gdb_py_module_available { name } { return ${available} } + +# Run a memory leak test within the Python script FILENAME. This proc +# checks that the required Python modules are available, sets up the +# syspath so that the helper module can be found (in the same +# directory as FILENAME), then loads FILENAME to run the test. +proc gdb_py_run_memory_leak_test { filename testname } { + if { ![gdb_py_module_available "tracemalloc"] } { + unsupported "$testname (tracemalloc module not available)" + } + + gdb_test_no_output -nopass "python import sys" + gdb_test_no_output -nopass \ + "python sys.path.insert(0, \"[file dirname $filename]\")" \ + "setup sys.path" + + set pyfile [gdb_remote_download host ${filename}] + + # Source the Python script, this runs the test, and either prints + # PASS, or throws an exception. + gdb_test "source ${pyfile}" "^PASS" $testname +} diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp index 95c53d0..fe2cfca 100644 --- a/gdb/testsuite/lib/gdb-utils.exp +++ b/gdb/testsuite/lib/gdb-utils.exp @@ -1,4 +1,4 @@ -# Copyright 2014-2024 Free Software Foundation, Inc. +# Copyright 2014-2025 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 @@ -38,6 +38,14 @@ proc string_to_regexp {str} { return $result } +# Convenience function that calls string_to_regexp for each arg, and +# joins the results using "\r\n". + +proc multi_line_string_to_regexp { args } { + set res [lmap arg $args {string_to_regexp $arg}] + return [multi_line {*}$res] +} + # Given a list of strings, adds backslashes as needed to each string to # create a regexp that will match the string, and join the result. @@ -56,21 +64,27 @@ proc string_list_to_regexp { args } { # STYLE can either be the payload part of an ANSI terminal sequence, # or a shorthand for one of the gdb standard styles: "file", -# "function", "variable", or "address". +# "function", "variable", "address", etc. proc style {str style} { + set fg 39 + set bg 49 + set intensity 22 + set reverse 27 switch -exact -- $style { - title { set style 1 } - file { set style 32 } - function { set style 33 } - highlight { set style 31 } - variable { set style 36 } - address { set style 34 } - metadata { set style 2 } - version { set style "35;1" } + title { set intensity 1 } + command { set intensity 1 } + file { set fg 32 } + function { set fg 33 } + highlight { set fg 31 } + variable { set fg 36 } + address { set fg 34 } + metadata { set intensity 2 } + version { set fg 35; set intensity 1 } + line-number { set intensity 2 } none { return $str } } - return "\033\\\[${style}m${str}\033\\\[m" + return "\033\\\[${fg};${bg};${intensity};${reverse}m${str}\033\\\[m" } # gdb_get_bp_addr num @@ -102,14 +116,34 @@ proc gdb_get_bp_addr { num } { } # Compare the version numbers in L1 to those in L2 using OP, and -# return 1 if the comparison is true. OP can be "<", "<=", or "==". -# It is ok if the lengths of the lists differ. +# return 1 if the comparison is true. OP can be "<", "<=", ">", ">=", +# or "==". +# It is ok if the lengths of the lists differ, but note that we have +# "{1} < {1 0}" instead of "{1} == {1 0}". See also +# gdb.testsuite/version-compare.exp. proc version_compare { l1 op l2 } { switch -exact $op { "==" - "<=" - "<" {} + + ">=" { + # a >= b => b <= a + set x $l2 + set l2 $l1 + set l1 $x + set op "<=" + } + + ">" { + # a > b => b < a + set x $l2 + set l2 $l1 + set l1 $x + set op "<" + } + default { error "unsupported op: $op" } } diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index dfe19c9..777d64d 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -1,4 +1,4 @@ -# Copyright 1992-2024 Free Software Foundation, Inc. +# Copyright 1992-2025 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 @@ -45,9 +45,9 @@ proc cond_wrap { cond wrap body } { } } -# Helper function for set_sanitizer/set_sanitizer_default. +# Helper function for append_environment/append_environment_default. -proc set_sanitizer_1 { env_var var_id val default} { +proc append_environment_1 { env_var var_id val default} { global env if { ![info exists env($env_var) ] @@ -70,17 +70,17 @@ proc set_sanitizer_1 { env_var var_id val default} { # Add VAR_ID=VAL to ENV_VAR. -proc set_sanitizer { env_var var_id val } { - set_sanitizer_1 $env_var $var_id $val 0 +proc append_environment { env_var var_id val } { + append_environment_1 $env_var $var_id $val 0 } # Add VAR_ID=VAL to ENV_VAR, unless ENV_VAR already contains a VAR_ID setting. -proc set_sanitizer_default { env_var var_id val } { - set_sanitizer_1 $env_var $var_id $val 1 +proc append_environment_default { env_var var_id val } { + append_environment_1 $env_var $var_id $val 1 } -set_sanitizer_default TSAN_OPTIONS suppressions \ +append_environment_default TSAN_OPTIONS suppressions \ $srcdir/../tsan-suppressions.txt # When using ThreadSanitizer we may run into the case that a race is detected, @@ -89,14 +89,14 @@ set_sanitizer_default TSAN_OPTIONS suppressions \ # Try to prevent this by setting history_size to the maximum (7) by default. # See also the ThreadSanitizer docs ( # https://github.com/google/sanitizers/wiki/ThreadSanitizerFlags ). -set_sanitizer_default TSAN_OPTIONS history_size 7 +append_environment_default TSAN_OPTIONS history_size 7 # If GDB is built with ASAN (and because there are leaks), it will output a # leak report when exiting as well as exit with a non-zero (failure) status. # This can affect tests that are sensitive to what GDB prints on stderr or its # exit status. Add `detect_leaks=0` to the ASAN_OPTIONS environment variable # (which will affect any spawned sub-process) to avoid this. -set_sanitizer_default ASAN_OPTIONS detect_leaks 0 +append_environment_default ASAN_OPTIONS detect_leaks 0 # List of procs to run in gdb_finish. set gdb_finish_hooks [list] @@ -200,6 +200,23 @@ if ![info exists GDB_DATA_DIRECTORY] { } verbose "using GDB_DATA_DIRECTORY = $GDB_DATA_DIRECTORY" 2 +# The path to the GCORE script to test. +global GCORE +if {![info exists GCORE]} { + set GCORE [file join [file dirname $GDB] [transform gcore]] +} +verbose "using GCORE = $GCORE" 2 + +# Return 0 if the gcore scipt is missing. +proc has_gcore_script {} { + global GCORE + if {$GCORE == ""} { + return 0 + } else { + return 1 + } +} + # GDBFLAGS is available for the user to set on the command line. # E.g. make check RUNTESTFLAGS=GDBFLAGS=mumble # Testcases may use it to add additional flags, but they must: @@ -252,6 +269,13 @@ if ![info exists INTERNAL_GDBFLAGS] { } set INTERNAL_GDBFLAGS [append_gdb_data_directory_option $INTERNAL_GDBFLAGS] + + # Handle the case that "interactive-mode auto" reports off. + append INTERNAL_GDBFLAGS { -iex "set interactive-mode on"} + + if { [ishost "*-*-mingw*"] } { + append INTERNAL_GDBFLAGS { -iex "maint set console-translation-mode binary"} + } } # The variable gdb_prompt is a regexp which matches the gdb prompt. @@ -733,19 +757,24 @@ proc gdb_breakpoint { linespec args } { # single quoted C++ function specifier. # # If there are additional arguments, pass them to gdb_breakpoint. -# We recognize no-message/message ourselves. +# We recognize no-message/message ourselves as well as no-delete-brekpoints. # # no-message is messed up here, like gdb_breakpoint: to preserve # historical usage fails are always printed by default. # no-message: turns off printing of fails (and passes, but they're already off) # message: turns on printing of passes (and fails, but they're already on) +# +# The 'no-delete-brekpoints' option stops this proc from deleting all +# breakpoints. proc runto { linespec args } { global gdb_prompt global bkptno_numopt_re global decimal - delete_breakpoints + if {[lsearch -exact $args no-delete-breakpoints] == -1} { + delete_breakpoints + } set print_pass 0 set print_fail 1 @@ -769,7 +798,7 @@ proc runto { linespec args } { # the "at foo.c:36" output we get with -g. # the "in func" output we get without -g. gdb_expect { - -re "(?:Break|Temporary break).* at .*:$decimal.*$gdb_prompt $" { + -re "(?:Break|Temporary break).* at .*:.*$decimal.*$gdb_prompt $" { if { $print_pass } { pass $test_name } @@ -821,11 +850,11 @@ proc runto { linespec args } { # Ask gdb to run until we hit a breakpoint at main. # -# N.B. This function deletes all existing breakpoints. -# If you don't want that, use gdb_start_cmd. +# N.B. By default this function deletes all existing breakpoints. If +# you don't want that then pass the 'no-delete-breakpoints' argument. -proc runto_main { } { - return [runto main qualified] +proc runto_main { args } { + return [runto main qualified {*}$args] } ### Continue, and expect to hit a breakpoint. @@ -965,6 +994,31 @@ proc fill_in_default_prompt {prompt_regexp with_anchor} { return $prompt_regexp } +# Generate message from COMMAND. +# +# This is not trivial in the case that the command contains parentheses. +# Trailing text between parentheses prefixed with a space is interpreted as +# extra information, and not as part of the test name [1]. Consequently, +# "PASS: print (1)" and "PASS: print (2)" count as duplicates. +# +# We fix this here by using "PASS: gdb-command<print (1)>" and +# "PASS: gdb-command<print (2)>". +# +# A trivial way to fix this in a test-case is by using gdb_test "print(1)", +# which produces the nicer-looking "PASS: print(1)". +# +# [1] https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Do_not_use_.22tail_parentheses.22_on_test_messages + +proc command_to_message { command } { + set message $command + + if { [regexp { \(([^()]*)\)$} $message] } { + set message gdb-command<$message> + } + + return $message +} + # gdb_test_multiple COMMAND MESSAGE [ -prompt PROMPT_REGEXP] [ -lbl ] # EXPECT_ARGUMENTS # Send a command to gdb; test the result. @@ -975,7 +1029,14 @@ proc fill_in_default_prompt {prompt_regexp with_anchor} { # if one of them matches. If MESSAGE is empty COMMAND will be used. # -prompt PROMPT_REGEXP specifies a regexp matching the expected prompt # after the command output. If empty, defaults to "$gdb_prompt $". -# -lbl specifies that line-by-line matching will be used. +# -no-prompt-anchor specifies that if the default prompt regexp is used, it +# should not be anchored at the end of the buffer. This means that the +# pattern can match even if there is stuff output after the prompt. Does not +# have any effect if -prompt is specified. +# -lbl specifies that line-by-line matching will be used. This means +# that lines from GDB not matched by any pattern will be consumed from +# the output buffer. This helps avoid buffer overflows and timeouts +# when testing verbose commands. # EXPECT_ARGUMENTS will be fed to expect in addition to the standard # patterns. Pattern elements will be evaluated in the caller's # context; action elements will be executed in the caller's context. @@ -1073,7 +1134,9 @@ proc gdb_test_multiple { command message args } { global any_spawn_id set line_by_line 0 + set lbl_anchor_re "" set prompt_regexp "" + set prompt_anchor 1 for {set i 0} {$i < [llength $args]} {incr i} { set arg [lindex $args $i] if { $arg == "-prompt" } { @@ -1081,6 +1144,9 @@ proc gdb_test_multiple { command message args } { set prompt_regexp [lindex $args $i] } elseif { $arg == "-lbl" } { set line_by_line 1 + set lbl_anchor_re "^" + } elseif { $arg == "-no-prompt-anchor" } { + set prompt_anchor 0 } else { set user_code $arg break @@ -1092,10 +1158,10 @@ proc gdb_test_multiple { command message args } { error "Too few arguments to gdb_test_multiple" } - set prompt_regexp [fill_in_default_prompt $prompt_regexp true] + set prompt_regexp [fill_in_default_prompt $prompt_regexp $prompt_anchor] if { $message == "" } { - set message $command + set message [command_to_message $command] } if [string match "*\[\r\n\]" $command] { @@ -1337,7 +1403,7 @@ proc gdb_test_multiple { command message args } { fail "$errmsg" set result -1 } - -re "\r\n$prompt_regexp" { + -re "${lbl_anchor_re}\r\n$prompt_regexp" { if {![string match "" $message]} { fail "$message" } @@ -1471,7 +1537,6 @@ proc gdb_test_multiline { name args } { return 0 } - # gdb_test [-prompt PROMPT_REGEXP] [-lbl] # COMMAND [PATTERN] [MESSAGE] [QUESTION RESPONSE] # Send a command to gdb; test the result. @@ -1513,7 +1578,7 @@ proc gdb_test { args } { global gdb_prompt upvar timeout timeout - parse_args { + parse_some_args { {prompt ""} {no-prompt-anchor} {lbl} @@ -1521,7 +1586,8 @@ proc gdb_test { args } { {nonl} } - lassign $args command pattern message question response + set args [lassign $args command pattern message question response] + check_no_args_left # Can't have a question without a response. if { $question != "" && $response == "" || [llength $args] > 5 } { @@ -1529,7 +1595,7 @@ proc gdb_test { args } { } if { $message == "" } { - set message $command + set message [command_to_message $command] } set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]] @@ -1656,6 +1722,16 @@ if { [tcl_version_at_least 8 6] == 0 } { return $res } + + # ::tcl_platform(pathSeparator) was added in 8.6. + switch $::tcl_platform(platform) { + windows { + set ::tcl_platform(pathSeparator) ; + } + default { + set ::tcl_platform(pathSeparator) : + } + } } if { [tcl_version_at_least 8 6 2] == 0 } { @@ -1685,13 +1761,14 @@ if { [tcl_version_at_least 8 6 2] == 0 } { proc gdb_test_no_output { args } { global gdb_prompt - parse_args { + parse_some_args { {prompt ""} {no-prompt-anchor} {nopass} } - lassign $args command message + set args [lassign $args command message] + check_no_args_left set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]] @@ -1733,7 +1810,7 @@ proc gdb_test_no_output { args } { proc gdb_test_sequence { args } { global gdb_prompt - parse_args {{prompt ""}} + parse_some_args {{prompt ""}} if { $prompt == "" } { set prompt "$gdb_prompt $" @@ -1759,6 +1836,55 @@ proc gdb_test_sequence { args } { } +# Issue COMMAND, and return corresponding output lines. Helper function for +# gdb_get_lines_no_pass and gdb_get_lines. + +proc gdb_get_lines_1 { command message } { + set no_pass [string equal $message ""] + set lines "" + set ok 0 + 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" + set ok 1 + if { ! $no_pass } { + pass $gdb_test_name + } + } + } + + if { ! $ok } { + return "" + } + + return $lines +} + +# Issue COMMAND, and return corresponding output lines. Don't generate a pass. + +proc gdb_get_lines_no_pass { command } { + gdb_get_lines_1 $command "" +} + +# Issue COMMAND, and return corresponding output lines. Generate a pass. + +proc gdb_get_lines { command {message ""} } { + if { $message == "" } { + set message [command_to_message $command] + } + + gdb_get_lines_1 $command $message +} + # Match output of COMMAND using RE. Read output line-by-line. # Report pass/fail with MESSAGE. # For a command foo with output: @@ -1795,25 +1921,10 @@ proc gdb_test_lines { command message re args } { } 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" - } + set message [command_to_message $command] } + set lines [gdb_get_lines_no_pass $command] gdb_assert { [regexp $re $lines] } $message foreach re $re_not { @@ -2012,7 +2123,7 @@ proc gdb_test_stdio {command inferior_pattern {gdb_pattern ""} {message ""}} { global gdb_prompt if {$message == ""} { - set message $command + set message [command_to_message $command] } set inferior_matched 0 @@ -2146,8 +2257,10 @@ proc gdb_reinitialize_dir { subdir } { } send_gdb "dir\n" gdb_expect 60 { - -re "Reinitialize source path to empty.*y or n. " { - send_gdb "y\n" answer + -re "Reinitialize source path to empty.*y or n.(\\\s.answered Y; input not from terminal.)?" { + if {![info exists expect_out(1,string)]} { + send_gdb "y\n" answer + } gdb_expect 60 { -re "Source directories searched.*$gdb_prompt $" { send_gdb "dir $subdir\n" @@ -2200,7 +2313,8 @@ proc default_gdb_exit {} { } } - if { [is_remote host] && [board_info host exists fileid] } { + if { ([is_remote host] && [board_info host exists fileid]) + || [istarget *-*-mingw*] } { send_gdb "quit\n" gdb_expect 10 { -re "y or n" { @@ -2213,7 +2327,9 @@ proc default_gdb_exit {} { } if ![is_remote host] { - remote_close host + if {[catch { remote_close host } message]} { + warning "closing gdb failed with: $message" + } } unset gdb_spawn_id unset ::gdb_tty_name @@ -2390,7 +2506,7 @@ proc default_gdb_spawn { } { global INTERNAL_GDBFLAGS GDBFLAGS global gdb_spawn_id - # Set the default value, it may be overriden later by specific testfile. + # Set the default value, it may be overridden later by specific testfile. # # Use `set_board_info use_gdb_stub' for the board file to flag the inferior # is already started after connecting and run/attach are not supported. @@ -2476,6 +2592,17 @@ proc default_gdb_start { } { # Output with -q, and bracketed paste mode enabled, see above. verbose "GDB initialized." } + -re "^\033\\\[6n$gdb_prompt $" { + # With MSYS2 and TERM={xterm,ansi}, I get: + # + # builtin_spawn gdb -q ... + # ^[[6n(gdb) + # + # We set TERM to dumb by default to avoid this, but some + # test-cases set TERM to xterm or ansi, in which case we get this + # output. + verbose "GDB initialized." + } -re "$gdb_prompt $" { perror "GDB never initialized." unset gdb_spawn_id @@ -2540,35 +2667,58 @@ proc gdb_interact { } { # 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. Return 1 for pass, 0 for fail, +# -1 for unsupported (missing compiler), and -2 for unsupported (bad +# option) -- but do not issue a pass/fail directly. + +proc gdb_compile_test_nofail {output} { + if { $output == "" } { + return 1 + } + + 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] } { + return -1 + } + + 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 != "" } { + return -2 + } + + # Unclassified compilation failure, be more verbose. + verbose -log "compilation failed: $output" 2 + 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. proc gdb_compile_test {src output} { set msg "compilation [file tail $src]" - if { $output == "" } { + set result [gdb_compile_test_nofail $output] + if {$result == 1} { 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] } { + if {$result == -1} { 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 != "" } { + if {$result == -2} { unsupported "$msg (unsupported option $option)" return } - # Unclassified compilation failure, be more verbose. - verbose -log "compilation failed: $output" 2 - fail "$msg" + fail $msg } # Return a 1 for configurations for which we want to try to test C++. @@ -2675,6 +2825,12 @@ gdb_caching_proc allow_python_tests {} { return [expr {[string first "--with-python" $output] != -1}] } +# Return a 1 if GDB was configured to support compile commands. +gdb_caching_proc allow_compile_tests {} { + set output [remote_exec host $::GDB "$::INTERNAL_GDBFLAGS -ex \"compile int x = 1\" -batch"] + return [expr {[string first "The program must be running" $output] != -1}] +} + # Return a 1 for configurations that use system readline rather than the # in-repo copy. @@ -3522,13 +3678,62 @@ gdb_caching_proc supports_memtag {} { return 0 } +# Return 1 if catch syscall is supported, otherwise return 0. + +gdb_caching_proc supports_catch_syscall {} { + set me "supports_catch_syscall" + + # Compile a test program. + set src { + int main() { + return 0; + } + } + if {![gdb_simple_compile $me $src executable]} { + verbose -log "$me: failed to compile" + 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] } { + verbose -log "$me: failed to run to main" + return 0 + } + + # To make sure we test both setting and inserting the catchpoint. + gdb_test_no_output "set breakpoint always-inserted on" + + set res 0 + set re_yes \ + [string_to_regexp \ + "Catchpoint 2 (any syscall)"] + gdb_test_multiple "catch syscall" "" { + -re -wrap ^$re_yes { + set res 1 + } + -re -wrap "" { + } + } + + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $res" 2 + return $res +} + # Return 1 if the target supports hardware single stepping. proc can_hardware_single_step {} { if { [istarget "arm*-*-*"] || [istarget "mips*-*-*"] || [istarget "tic6x-*-*"] || [istarget "sparc*-*-linux*"] - || [istarget "nios2-*-*"] || [istarget "riscv*-*-linux*"] } { + || [istarget "riscv*-*-linux*"] } { return 0 } @@ -3557,6 +3762,7 @@ proc supports_process_record {} { if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] || [istarget "aarch64*-*-linux*"] + || [istarget "loongarch*-*-linux*"] || [istarget "powerpc*-*-linux*"] || [istarget "s390*-*-linux*"] } { return 1 @@ -3576,8 +3782,10 @@ proc supports_reverse {} { if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] || [istarget "aarch64*-*-linux*"] + || [istarget "loongarch*-*-linux*"] || [istarget "powerpc*-*-linux*"] - || [istarget "s390*-*-linux*"] } { + || [istarget "s390*-*-linux*"] + || [istarget "riscv*-*-*"] } { return 1 } @@ -3599,6 +3807,34 @@ proc readline_is_used { } { } } +# Return true if readline has support for the EOF flag. + +proc readline_supports_eof_flag { } { + gdb_test_multiple "show configuration" "" { + -re -wrap "\r\nGNU Readline library version: ($::decimal)\\.($::decimal)\\s+\\((internal|system)\\)" { + set major $expect_out(1,string) + set minor $expect_out(2,string) + set type $expect_out(3,string) + + # The internal readline was patched with EOF support ahead + # of this landing in upstream readline. + if { $type eq "internal" } { + return true + } + + # The EOF flag support was added in readline 8.2. + if { $major > 8 || $major == 8 && $minor >= 2 } { + return true + } + + return false + } + -re ".*$::gdb_prompt $" { + return false + } + } +} + # Return 1 if target is ELF. gdb_caching_proc is_elf_target {} { set me "is_elf_target" @@ -3728,13 +3964,16 @@ gdb_caching_proc is_aarch32_target {} { return 0 } - set list {} - foreach reg \ - {r0 r1 r2 r3} { - lappend list "\tmov $reg, $reg" - } + return [gdb_can_simple_compile aarch32 { + int main (void) { + asm ("\tmov r0, r0"); + asm ("\tmov r1, r1"); + asm ("\tmov r2, r2"); + asm ("\tmov r3, r3"); - return [gdb_can_simple_compile aarch32 [join $list \n]] + return 0; + } + }] } # Return 1 if this target is an aarch64, either lp64 or ilp32. @@ -4154,6 +4393,70 @@ gdb_caching_proc allow_avx512fp16_tests {} { return $allow_avx512fp16_tests } +# Run a test on the target to see if it supports LAM 57. Return 1 if so, +# 0 if it does not. Based on the arch_prctl() handle ARCH_ENABLE_TAGGED_ADDR +# to enable LAM which fails if the hardware or the OS does not support LAM. + +gdb_caching_proc allow_lam_tests {} { + global gdb_prompt inferior_exited_re + + set me "allow_lam_tests" + if { ![istarget "x86_64-*-*"] } { + verbose "$me: target does not support LAM, returning 1" 2 + return 0 + } + + # Compile a test program. + set src { + #define _GNU_SOURCE + #include <unistd.h> + #include <sys/syscall.h> + #include <assert.h> + #include <errno.h> + #include <asm/prctl.h> + + int configure_lam () + { + errno = 0; + syscall (SYS_arch_prctl, ARCH_ENABLE_TAGGED_ADDR, 6); + assert_perror (errno); + return errno; + } + + int + main () { return configure_lam (); } + } + + if {![gdb_simple_compile $me $src executable ""]} { + return 0 + } + # No error message, compilation succeeded so now run it via gdb. + + set allow_lam_tests 0 + clean_restart $obj + gdb_run_cmd + gdb_expect { + -re ".*$inferior_exited_re with code.*${gdb_prompt} $" { + verbose -log "$me: LAM support not detected." + } + -re ".*Program received signal SIGABRT, Aborted.*${gdb_prompt} $" { + verbose -log "$me: LAM support not detected." + } + -re ".*$inferior_exited_re normally.*${gdb_prompt} $" { + verbose -log "$me: LAM support detected." + set allow_lam_tests 1 + } + default { + warning "\n$me: default case taken." + } + } + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $allow_lam_tests" 2 + return $allow_lam_tests +} + # Run a test on the target to see if it supports btrace hardware. Return 1 if so, # 0 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite. @@ -4258,6 +4561,135 @@ gdb_caching_proc allow_btrace_pt_tests {} { return $allow_btrace_pt_tests } +# Run a test on the target to see if it supports ptwrite instructions and +# if GDB can decode ptwrite events. Return 1 if so, 0 if it does not. + +gdb_caching_proc allow_btrace_ptw_tests {} { + global srcdir subdir gdb_prompt inferior_exited_re decimal + + require allow_btrace_pt_tests + set me "allow_btrace_ptw_tests" + + set src { + #include <immintrin.h> + + int + main () + { + _ptwrite32 (0x42); + return 0; + } + } + + set compile_flags "additional_flags=-mptwrite" + if {![gdb_simple_compile $me $src executable $compile_flags]} { + return 0 + } + + gdb_exit + gdb_start + gdb_reinitialize_dir $srcdir/$subdir + gdb_load "$obj" + if ![runto_main] { + return 1 + } + + gdb_test_no_output "record btrace pt" "$me: record btrace pt" + + set allow_btrace_ptw_tests 0 + gdb_test_multiple "next" "$me: next" { + -re -wrap ".*Illegal instruction.*" { + verbose -log "$me: ptwrite instruction support not detected." + } + -re -wrap ".*$inferior_exited_re normally.*" { + verbose -log "$me: ptwrite support not detected." + } + -re -wrap "$decimal.*(at|in|return 0).*" { + set allow_btrace_ptw_tests 1 + } + } + + if { $allow_btrace_ptw_tests == 1 } { + # Show the func-call-history to get the packet trace. + gdb_test "record function-call-history" ".*" + + gdb_test_multiple "maintenance btrace packet-history 0,1000" \ + "$me: check decoding support" { + -re "ptw" { + verbose -log "$me: ptwrite decoding support detected." + set allow_btrace_ptw_tests 1 + } + -re -wrap "" { + verbose -log "$me: ptwrite decoding support not detected." + set allow_btrace_ptw_tests 0 + } + } + } + + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $allow_btrace_ptw_tests" 2 + return $allow_btrace_ptw_tests +} + + +# Run a test on the target to see if GDB supports event tracing on it. +# Return 1 if so, 0 if it does not. + +gdb_caching_proc allow_btrace_pt_event_trace_tests {} { + global srcdir subdir + set me "allow_btrace_pt_event_trace_tests" + require allow_btrace_pt_tests + + set src { + int + main () + { + return 0; + } + } + + if {![gdb_simple_compile $me $src executable]} { + return 0 + } + + gdb_exit + gdb_start + gdb_reinitialize_dir $srcdir/$subdir + gdb_load "$obj" + if ![runto_main] { + return 0 + } + + set allow_event_trace_tests 0 + gdb_test_multiple "set record btrace pt event-tracing on" "$me: first check" { + -re -wrap "Event-tracing is not supported by GDB." { + } + -re -wrap "" { + set allow_event_trace_tests 1 + } + } + + if { $allow_event_trace_tests == 1 } { + gdb_test_multiple "record btrace pt" "$me: check OS support" { + -re -wrap "^" { + } + -re -wrap "" { + verbose -log "$me: Target doesn't support event tracing." + set allow_event_trace_tests 0 + } + } + } + + gdb_exit + remote_file build delete $obj + + verbose "$me: returning $allow_event_trace_tests" 2 + return $allow_event_trace_tests +} + + # Run a test on the target to see if it supports Aarch64 SVE hardware. # Return 1 if so, 0 if it does not. Note this causes a restart of GDB. @@ -4681,6 +5113,40 @@ proc skip_inline_var_tests {} { return 0 } +# Return whether we allow running fork-related testcases. Targets +# that don't even have any concept of fork will just fail to compile +# the testcases and skip the tests that way if this returns true for +# them. Unix targets that do have a fork system call, but don't +# support intercepting forks will want to return false here, otherwise +# the testcases that exercise fork may hit a number of long cascading +# time out sequences. + +proc allow_fork_tests {} { + if {[istarget "*-*-cygwin*"] || [istarget "*-*-mingw*"]} { + return 0 + } + + return 1 +} + +# Return whether we allow running testcases that want to debug +# multiple inferiors with the same target. Not all targets support +# this. Note that some tests add a second inferior but never start +# it. Those tests should not be skipped due to this proc returning +# false. + +proc allow_multi_inferior_tests {} { + if {[istarget "*-*-cygwin*"] || [istarget "*-*-mingw*"]} { + return 0 + } + + if {[use_gdb_stub]} { + return 0 + } + + return 1 +} + # Return a 1 if we should run tests that require hardware breakpoints proc allow_hw_breakpoint_tests {} { @@ -4796,7 +5262,8 @@ proc skip_unwinder_tests {} { proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } { set supported 0 - gdb_test_multiple "info probe" "check for stap probe in libstdc++" \ + gdb_test_multiple "info probes stap libstdcxx" \ + "check for stap probe in libstdc++" \ -prompt "$prompt_regexp" { -re ".*libstdcxx.*catch.*\r\n$prompt_regexp" { set supported 1 @@ -4867,7 +5334,7 @@ proc is_any_target {args} { # # 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. +# even when it was overridden by the test. # # Note that stub targets are not able to spawn new inferiors. Use this # check for skipping respective tests. @@ -5363,6 +5830,7 @@ proc quote_for_host { args } { # - no-build-id: Ensure the final binary does not include a build-id. # - column-info/no-column-info: Enable/Disable generation of column table # information. +# - dwarf5: Force compilation with dwarf-5 debug information. # # And here are some of the not too obscure options understood by DejaGnu that # influence the compilation: @@ -5465,16 +5933,17 @@ proc gdb_compile {source dest type options} { } # If the 'build-id' option is used, then ensure that we generate a - # build-id. GCC does this by default, but Clang does not, so - # enable it now. - if {[lsearch -exact $options build-id] > 0 - && [test_compiler_info "clang-*"]} { - lappend new_options "additional_flags=-Wl,--build-id" + # build-id. It is possible that the compiler is configured to do + # so automatically, but at least for GCC the configure option + # --enable-linker-build-id is not enabled by default. + # So to be sure, enable it explicitly. + if {[lsearch -exact $options build-id] > 0} { + lappend new_options "ldflags=-Wl,--build-id" } # If the 'no-build-id' option is used then disable the build-id. if {[lsearch -exact $options no-build-id] > 0} { - lappend new_options "additional_flags=-Wl,--build-id=none" + lappend new_options "ldflags=-Wl,--build-id=none" } # Sanity check. If both 'build-id' and 'no-build-id' are used @@ -5541,6 +6010,23 @@ proc gdb_compile {source dest type options} { } } + # On AIX systems, until GCC 12 (maybe later), stabs was the default + # debug option, but we'd like to have dwarf instead. + # If we're running on one of those systems and debug was requested, + # but no explicit -g<format> option was given, use -gdwarf to force + # that as the debug info for the inferior. + # This list should be exhaustive: + set debug_format "btf|ctf|stabs|vms|coff|xcoff" + # Since additional_flags is a comma separated list, identify if there + # are other (optional) flags in the list. + set other_options "-\[a-zA-Z0-9\]*," + set full_regexp "^additional_flags=\($other_options\)*-g\($debug_format\)" + if { [istarget *-*-aix*] + && [lsearch -exact $options debug] != -1 + && [lsearch -regexp $options $full_regexp] == -1} { + lappend new_options "additional_flags=-gdwarf" + } + set shlib_found 0 set shlib_load 0 foreach opt $options { @@ -5622,6 +6108,13 @@ proc gdb_compile {source dest type options} { error "Option gno-column-info not supported by compiler." } + } elseif { $opt == "dwarf5" } { + if {[test_compiler_info {gcc-*}] \ + || [test_compiler_info {clang-*}]} { + lappend new_options "additional_flags=-gdwarf-5" + } else { + error "No idea how to force DWARF-5 in this compiler" + } } else { lappend new_options $opt } @@ -6321,14 +6814,23 @@ proc gdb_exit { } { catch default_gdb_exit } -# Helper function for can_spawn_for_attach. Try to spawn and attach, and -# return 0 only if we cannot attach because it's unsupported. +# Return true if we can spawn a program on the target and attach to +# it. -gdb_caching_proc can_spawn_for_attach_1 {} { - # For the benefit of gdb-caching-proc-consistency.exp, which - # calls can_spawn_for_attach_1 directly. Keep in sync with - # can_spawn_for_attach. - if { [is_remote target] || [target_info exists use_gdb_stub] } { +gdb_caching_proc can_spawn_for_attach {} { + # We use exp_pid to get the inferior's pid, assuming that gives + # back the pid of the program. On remote boards, that would give + # us instead the PID of e.g., the ssh client, etc. + if {[is_remote target]} { + verbose -log "can't spawn for attach (target is remote)" + return 0 + } + + # The "attach" command doesn't make sense when the target is + # stub-like, where GDB finds the program already started on + # initial connection. + if {[target_info exists use_gdb_stub]} { + verbose -log "can't spawn for attach (target is stub)" return 0 } @@ -6353,6 +6855,9 @@ gdb_caching_proc can_spawn_for_attach_1 {} { set test_spawn_id [spawn_wait_for_attach_1 $obj] remote_file build delete $obj + # In case GDB is already running. + gdb_exit + gdb_start set test_pid [spawn_id_get_pid $test_spawn_id] @@ -6374,61 +6879,6 @@ gdb_caching_proc can_spawn_for_attach_1 {} { return $res } -# Return true if we can spawn a program on the target and attach to -# it. Calls gdb_exit for the first call in a test-case. - -proc can_spawn_for_attach { } { - # We use exp_pid to get the inferior's pid, assuming that gives - # back the pid of the program. On remote boards, that would give - # us instead the PID of e.g., the ssh client, etc. - if {[is_remote target]} { - verbose -log "can't spawn for attach (target is remote)" - return 0 - } - - # The "attach" command doesn't make sense when the target is - # stub-like, where GDB finds the program already started on - # initial connection. - if {[target_info exists use_gdb_stub]} { - verbose -log "can't spawn for attach (target is stub)" - return 0 - } - - # The normal sequence to use for a runtime test like - # can_spawn_for_attach_1 is: - # - gdb_exit (don't use a running gdb, we don't know what state it is in), - # - gdb_start (start a new gdb), and - # - gdb_exit (cleanup). - # - # By making can_spawn_for_attach_1 a gdb_caching_proc, we make it - # unpredictable which test-case will call it first, and consequently a - # test-case may pass in say a full test run, but fail when run - # individually, due to a can_spawn_for_attach call in a location where a - # gdb_exit (as can_spawn_for_attach_1 does) breaks things. - # To avoid this, we move the initial gdb_exit out of - # can_spawn_for_attach_1, guaranteeing that we end up in the same state - # regardless of whether can_spawn_for_attach_1 is called. However, that - # is only necessary for the first call in a test-case, so cache the result - # in a global (which should be reset after each test-case) to keep track - # of that. - # - # In summary, we distinguish between three cases: - # - first call in first test-case. Executes can_spawn_for_attach_1. - # Calls gdb_exit, gdb_start, gdb_exit. - # - first call in following test-cases. Uses cached result of - # can_spawn_for_attach_1. Calls gdb_exit. - # - rest. Use cached result in cache_can_spawn_for_attach_1. Calls no - # gdb_start or gdb_exit. - global cache_can_spawn_for_attach_1 - if { [info exists cache_can_spawn_for_attach_1] } { - return $cache_can_spawn_for_attach_1 - } - gdb_exit - - set cache_can_spawn_for_attach_1 [can_spawn_for_attach_1] - return $cache_can_spawn_for_attach_1 -} - # Centralize the failure checking of "attach" command. # Return 0 if attach failed, otherwise return 1. @@ -6530,7 +6980,7 @@ proc kill_wait_spawned_process { proc_spawn_id } { proc spawn_id_get_pid { spawn_id } { set testpid [exp_pid -i $spawn_id] - if { [istarget "*-*-cygwin*"] } { + if { [istarget "*-*-cygwin*"] || [istarget "*-*-mingw*"] } { # testpid is the Cygwin PID, GDB uses the Windows PID, which # might be different due to the way fork/exec works. set testpid [ exec ps -e | gawk "{ if (\$1 == $testpid) print \$4; }" ] @@ -6617,6 +7067,24 @@ proc gdb_load_cmd { args } { return -1 } +# Return non-zero if 'gcore' command is available. +gdb_caching_proc gcore_cmd_available { } { + gdb_exit + gdb_start + + # Does this gdb support gcore? + gdb_test_multiple "help gcore" "" { + -re -wrap "Undefined command: .*" { + return 0 + } + -re -wrap "Save a core file .*" { + return 1 + } + } + + return 0 +} + # Invoke "gcore". CORE is the name of the core file to write. TEST # is the name of the test case. This will return 1 if the core file # was created, 0 otherwise. If this fails to make a core file because @@ -7081,6 +7549,22 @@ proc default_gdb_init { test_file_name } { setenv LC_CTYPE C setenv LANG C + # With MSYS2 and TERM={xterm,ansi}, I get: + # + # builtin_spawn gdb -q ... + # ^[[6n(gdb) + # + # While we're addressing this in default_gdb_start, this is not specific + # to gdb, other tools produce the same CSI sequence, and consequently we + # run into trouble in other places (like get_compiler_info). + # + # Set TERM to dumb to prevent the '^[[6n' from occurring. + # + # We could do this only for ishost *-*-mingw*, but that introduces + # inconsistency between platforms, with test-cases passing on one platform + # but failing on the other. So, we do this for all platforms. + setenv TERM dumb + # 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 @@ -8115,7 +8599,6 @@ gdb_caching_proc gdb_has_argv0 {} { || [istarget *-wince-pe] || [istarget *-*-mingw32ce*] || [istarget *-*-osf*] || [istarget *-*-dicos*] - || [istarget *-*-nto*] || [istarget *-*-*vms*] || [istarget *-*-lynx*178]) } { fail "argv\[0\] should be available on this target" @@ -8181,14 +8664,17 @@ proc get_build_id { filename } { # Return the build-id hex string (usually 160 bits as 40 hex characters) # converted to the form: .build-id/ab/cdef1234...89.debug +# +# The '.debug' suffix can be changed by passing the SUFFIX argument. +# # Return "" if no build-id found. -proc build_id_debug_filename_get { filename } { +proc build_id_debug_filename_get { filename {suffix ".debug"} } { set data [get_build_id $filename] if { $data == "" } { return "" } regsub {^..} $data {\0/} data - return ".build-id/${data}.debug" + return ".build-id/${data}${suffix}" } # DEST should be a file compiled with debug information. This proc @@ -8366,8 +8852,8 @@ proc test_prefix_command_help { command_list expected_initial_lines args } { # Use 'list' and not just {} because we want variables to # be expanded in this list. set l_stock_body [list\ - "List of $full_command subcommands\:.*\[\r\n\]+"\ - "Type \"help $full_command\" followed by $full_command subcommand name for full documentation\.\[\r\n\]+"] + "List of \"$full_command\" subcommands\:.*\[\r\n\]+"\ + "Type \"help $full_command\" followed by subcommand name for full documentation\.\[\r\n\]+"] set l_entire_body [concat $expected_initial_lines $l_stock_body $help_list_trailer] if {[llength $args]>0} { help_test_raw "help ${command}" $l_entire_body [lindex $args 0] @@ -8894,7 +9380,12 @@ proc core_find {binfile {deletefiles {}} {arg ""}} { file mkdir $coredir catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >/dev/null 2>&1\"" # remote_exec host "${binfile}" - foreach i "${coredir}/core ${coredir}/core.coremaker.c ${binfile}.core" { + set binfile_basename [file tail $binfile] + foreach i [list \ + ${coredir}/core \ + ${coredir}/core.coremaker.c \ + ${coredir}/${binfile_basename}.core \ + ${coredir}/${binfile_basename}.exe.core] { if [remote_file build exists $i] { remote_exec build "mv $i $destcore" set found 1 @@ -9152,7 +9643,7 @@ proc using_fission { } { # # Example: # proc myproc {foo args} { -# parse_list args 1 {{bar} {baz "abc"} {qux}} "-" false +# parse_list 1 args {{bar} {baz "abc"} {qux}} "-" false # # ... # } # myproc ABC -bar -baz DEF peanut butter @@ -9213,13 +9704,32 @@ proc parse_list { level listname argset prefix eval } { # Search the caller's args variable and set variables according to the list of # valid options described by ARGSET. -proc parse_args { argset } { +proc parse_some_args { argset } { parse_list 2 args $argset "-" false # The remaining args should be checked to see that they match the # number of items expected to be passed into the procedure... } +# Check that the caller's args variable is empty. + +proc check_no_args_left {} { + # Require no remaining args. + upvar 1 args args + if { [llength $args] != 0 } { + error "Args left unparsed: $args" + } +} + +# As parse_some_args, but check that no args remain after parsing. + +proc parse_args { argset } { + uplevel parse_some_args [list $argset] + + # Require no remaining args. + uplevel check_no_args_left +} + # Process the caller's options variable and set variables according # to the list of valid options described by OPTIONSET. @@ -9600,18 +10110,6 @@ gdb_caching_proc supports_statement_frontiers {} { } executable "additional_flags=-gstatement-frontiers"] } -# Return 1 if compiler supports -mmpx -fcheck-pointer-bounds. Otherwise, -# return 0. - -gdb_caching_proc supports_mpx_check_pointer_bounds {} { - set flags "additional_flags=-mmpx additional_flags=-fcheck-pointer-bounds" - return [gdb_can_simple_compile supports_mpx_check_pointer_bounds { - int main () { - return 0; - } - } executable $flags] -} - # Return 1 if compiler supports -fcf-protection=. Otherwise, # return 0. @@ -9923,10 +10421,11 @@ proc with_override { name override body } { # Run BODY after setting the TERM environment variable to 'ansi', and # unsetting the NO_COLOR environment variable. proc with_ansi_styling_terminal { body } { - save_vars { ::env(TERM) ::env(NO_COLOR) } { + save_vars { ::env(TERM) ::env(NO_COLOR) ::env(COLORTERM) } { # Set environment variables to allow styling. setenv TERM ansi unset -nocomplain ::env(NO_COLOR) + unset -nocomplain ::env(COLORTERM) set code [catch {uplevel 1 $body} result] } @@ -10040,83 +10539,6 @@ gdb_caching_proc supports_gnuc {} { 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 target_obj [gdb_remote_download target $obj] - set result [remote_exec target $target_obj] - set status [lindex $result 0] - set output [lindex $result 1] - if { $output != "" } { - set status 0 - } - - remote_file build delete $obj - - if { $status == 0 } { - verbose "$me: returning $status" 2 - return $status - } - - # Compile program with -mmpx -fcheck-pointer-bounds, try to trigger - # 'No MPX support', in other words, see if kernel supports mpx. - set src { int main (void) { return 0; } } - set comp_flags {} - append comp_flags " additional_flags=-mmpx" - append comp_flags " additional_flags=-fcheck-pointer-bounds" - if {![gdb_simple_compile $me-2 $src executable $comp_flags]} { - return 0 - } - - set target_obj [gdb_remote_download target $obj] - set result [remote_exec target $target_obj] - set status [lindex $result 0] - set output [lindex $result 1] - set status [expr ($status == 0) \ - && ![regexp "^No MPX support\r?\n" $output]] - - 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 @@ -10162,6 +10584,51 @@ gdb_caching_proc have_avx {} { return $status } +# Return 1 if target supports avx2, otherwise return 0. +gdb_caching_proc have_avx2 {} { + global srcdir + + set me "have_avx2" + if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } { + verbose "$me: target does not support avx2, 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_count (7, 0, &eax, &ebx, &ecx, &edx)) + return 0; + + if ((ebx & bit_AVX2) == bit_AVX2) + return 1; + else + return 0; + } + } + set compile_flags "incdir=${srcdir}/.." + if {![gdb_simple_compile $me $src executable $compile_flags]} { + return 0 + } + + set target_obj [gdb_remote_download target $obj] + set result [remote_exec target $target_obj] + set status [lindex $result 0] + set output [lindex $result 1] + if { $output != "" } { + set status 0 + } + + remote_file build delete $obj + + verbose "$me: returning $status" 2 + return $status +} + # Called as # - require ARG... # @@ -10698,5 +11165,50 @@ gdb_caching_proc root_user {} { return [expr $uid == 0] } +# Return nul-terminated string read from section SECTION of EXEC. Return "" +# if no such section or nul-terminated string was found. Function is useful +# for sections ".interp" or ".gnu_debuglink". + +proc section_get {exec section} { + global subdir + set tmp [standard_output_file section_get.tmp] + set objcopy_program [gdb_find_objcopy] + + set command "exec $objcopy_program -O binary --set-section-flags $section=A --change-section-address $section=0 -j $section $exec $tmp" + verbose -log "command is $command" + set result [catch $command output] + verbose -log "result is $result" + verbose -log "output is $output" + if {$result == 1} { + return "" + } + set fi [open $tmp] + fconfigure $fi -translation binary + set data [read $fi] + close $fi + file delete $tmp + # .interp has size $len + 1 but .gnu_debuglink contains garbage after \000. + set len [string first \000 $data] + if {$len < 0} { + verbose -log "section $section not found" + return "" + } + set retval [string range $data 0 [expr $len - 1]] + verbose -log "section $section is <$retval>" + return $retval +} + +# Return 1 if the compiler supports __builtin_trap, else return 0. + +gdb_caching_proc have_builtin_trap {} { + + return [gdb_can_simple_compile builtin_trap { + int main() { + __builtin_trap (); + return 0; + } + } executable] +} + # Always load compatibility stuff. load_lib future.exp diff --git a/gdb/testsuite/lib/gdbreplay-support.exp b/gdb/testsuite/lib/gdbreplay-support.exp new file mode 100644 index 0000000..fc4dc52 --- /dev/null +++ b/gdb/testsuite/lib/gdbreplay-support.exp @@ -0,0 +1,143 @@ +# Copyright 2024-2025 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 +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +# We're going to reuse some helper function from the gdbserver library. +load_lib gdbserver-support.exp + +if {![info exists GDBREPLAY]} { + set GDBREPLAY [findfile $base_dir/../../gdbserver/gdbreplay] +} + +global GDBREPLAY +verbose "using GDBREPLAY = $GDBREPLAY" 2 + +# Check is non empty and we're running on the host. +proc has_gdbreplay {} { + global GDBREPLAY + if {$GDBREPLAY == ""} { + return false + } + + # We currently rely on running gdbreplay on the same machine as + # GDB. + if {[is_remote target]} { + return false + } + + return true +} + +# Write the command line used to invocate gdbserver to the cmd file. + +proc gdbreplay_write_cmd_file { cmdline } { + set logfile [standard_output_file_with_gdb_instance gdbreplay.cmd] + set cmd_file [open $logfile w] + puts $cmd_file $cmdline + catch "close $cmd_file" +} + +# Start gdbreplay using REMOTELOG as the log file. Return a list of +# two elements, the protocol and the hostname:port string. This +# result list has the same format as gdbserver_start. + +proc gdbreplay_start { remotelog } { + # Port id -- either specified in baseboard file, or managed here. + set portnum [get_portnum] + + # Extract the protocol + if [target_info exists gdb_protocol] { + set protocol [target_info gdb_protocol] + } else { + set protocol "remote" + } + + # Loop till we find a free port. + while 1 { + # Fire off the debug agent. + set gdbreplay_command "$::GDBREPLAY $remotelog localhost:$portnum" + + gdbreplay_write_cmd_file $gdbreplay_command + + global gdbreplay_spawn_id + set gdbreplay_spawn_id [remote_spawn target $gdbreplay_command] + + # Wait for the server to open its TCP socket, so that GDB can connect. + expect { + -i $gdbreplay_spawn_id + -timeout 120 + -notransfer + -re "Replay logfile using" { } + -re "Can't (bind address|listen on socket): Address already in use\\.\r\n" { + verbose -log "Port $portnum is already in use." + set other_portnum [get_portnum] + if { $other_portnum != $portnum } { + # Bump the port number to avoid the conflict. + wait -i $expect_out(spawn_id) + set portnum $other_portnum + continue + } + } + -re ".*: cannot resolve name: .*\r\n" { + error "gdbserver cannot resolve name." + } + -re "Can't open socket: Address family not supported by protocol." { + return {} + } + timeout { + error "Timeout waiting for gdbreplay response." + } + } + break + } + + return [list $protocol "localhost:$portnum"] +} + +# MATCH_REGEXP matches lines from GDB to gdbserver. Once a match is +# found then NEWLINE is used to build a replacement line to send from +# gdbserver to GDB. +# +# Examples of MATCH_REGEXP: "vMustReplyEmpty" +# +# Example usage: +# +# update_log $logname "${logname}.updated" "vMustReplyEmpty" "E.failed" + +proc update_log { filename_in filename_out match_regexp newline } { + set fh_in [open $filename_in r] + set fh_out [open $filename_out w] + + while { [gets $fh_in line] >= 0 } { + # Print the line to the file. + puts $fh_out $line + if { [regexp $match_regexp $line] } { + # print out NEWLINE. + puts $fh_out "r +\$${newline}" + + # Don't truncate the file, otherwise gdbreplay will + # close the connection early and this might impact + # what GDB does. We want GDB to get a chance to + # process the error. + puts $fh_out "c q" + puts $fh_out "w \$qTStatus#49" + puts $fh_out "End of log" + + break + } + } + + close $fh_out + close $fh_in +} diff --git a/gdb/testsuite/lib/gdbserver-support.exp b/gdb/testsuite/lib/gdbserver-support.exp index 41ad5e6..2389206 100644 --- a/gdb/testsuite/lib/gdbserver-support.exp +++ b/gdb/testsuite/lib/gdbserver-support.exp @@ -1,4 +1,4 @@ -# Copyright 2000-2024 Free Software Foundation, Inc. +# Copyright 2000-2025 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 @@ -69,7 +69,7 @@ proc gdb_target_cmd_ext { targetname serialport {additional_text ""} } { } -re "Non-stop mode requested, but remote does not support non-stop.*$gdb_prompt $" { verbose "remote does not support non-stop" - return 1 + return 2 } -re "Remote MIPS debugging.*$additional_text.*$gdb_prompt" { verbose "Set target to $targetname" @@ -367,12 +367,26 @@ proc gdbserver_start { options arguments } { set enabled 0 foreach entry [split $gdbserverdebug ,] { switch -- $entry { - "debug" { - append gdbserver_command " --debug" + "debug-all" { + append gdbserver_command " --debug=all" + set enabled 1 + } + "all" { + # Different from the debug-all option, all argument sets + # the replay log file. See gdb_debug_init. + append gdbserver_command " --debug=all" + set enabled 1 + } + "debug-threads" { + append gdbserver_command " --debug=threads" + set enabled 1 + } + "debug-remote" { + append gdbserver_command " --debug=remote" set enabled 1 } - "remote" { - append gdbserver_command " --remote-debug" + "debug-event-loop" { + append gdbserver_command " --debug=event-loop" set enabled 1 } } @@ -707,11 +721,6 @@ proc gdbserver_debug_enabled { } { } } - # Expand the all option - if { $gdbserverdebug == "all" } { - set gdbserverdebug "debug,remote,replay" - } - # Ensure it is not empty. return [expr { $gdbserverdebug != "" }] } @@ -736,7 +745,7 @@ proc gdb_debug_init { } { if [gdbserver_debug_enabled] { foreach entry [split $gdbserverdebug ,] { - if { $entry == "replay" } { + if { $entry == "replay" || $entry == "all"} { set replayfile [standard_output_file_with_gdb_instance gdbserver.replay] send_gdb "set remotelogfile $replayfile\n" optional gdb_expect 10 { diff --git a/gdb/testsuite/lib/gen-perf-test.exp b/gdb/testsuite/lib/gen-perf-test.exp index a4debf8..dbdc79b 100644 --- a/gdb/testsuite/lib/gen-perf-test.exp +++ b/gdb/testsuite/lib/gen-perf-test.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2013-2024 Free Software Foundation, Inc. +# Copyright (C) 2013-2025 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 diff --git a/gdb/testsuite/lib/gnat_debug_info_test.adb b/gdb/testsuite/lib/gnat_debug_info_test.adb index b8f0b03..b195cb8 100644 --- a/gdb/testsuite/lib/gnat_debug_info_test.adb +++ b/gdb/testsuite/lib/gnat_debug_info_test.adb @@ -1,3 +1,18 @@ +-- Copyright 2019-2025 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 +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + with Ada.Text_IO; procedure GNAT_Debug_Info_Test is diff --git a/gdb/testsuite/lib/go.exp b/gdb/testsuite/lib/go.exp index 4525d77..5f668e2 100644 --- a/gdb/testsuite/lib/go.exp +++ b/gdb/testsuite/lib/go.exp @@ -1,4 +1,4 @@ -# Copyright 2012-2024 Free Software Foundation, Inc. +# Copyright 2012-2025 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 diff --git a/gdb/testsuite/lib/jit-elf-helpers.exp b/gdb/testsuite/lib/jit-elf-helpers.exp index 4d9c055..e5c328e 100644 --- a/gdb/testsuite/lib/jit-elf-helpers.exp +++ b/gdb/testsuite/lib/jit-elf-helpers.exp @@ -1,4 +1,4 @@ -# Copyright 2020-2024 Free Software Foundation, Inc. +# Copyright 2020-2025 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 diff --git a/gdb/testsuite/lib/memory.exp b/gdb/testsuite/lib/memory.exp index 6675641..b8aadb6 100644 --- a/gdb/testsuite/lib/memory.exp +++ b/gdb/testsuite/lib/memory.exp @@ -1,4 +1,4 @@ -# Copyright 2012-2024 Free Software Foundation, Inc. +# Copyright 2012-2025 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 diff --git a/gdb/testsuite/lib/mi-support.exp b/gdb/testsuite/lib/mi-support.exp index aa0f9df..aba13a2 100644 --- a/gdb/testsuite/lib/mi-support.exp +++ b/gdb/testsuite/lib/mi-support.exp @@ -1,4 +1,4 @@ -# Copyright 1999-2024 Free Software Foundation, Inc. +# Copyright 1999-2025 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 @@ -131,7 +131,7 @@ proc mi_create_inferior_pty {} { } } -# Create a new pty, and reate a new MI UI (using the new-ui command) on it. +# Create a new pty, and create a new MI UI (using the new-ui command) on it. # # Return a list with the spawn id for that pty and the pty file name. @@ -247,7 +247,7 @@ proc default_mi_gdb_start { { flags {} } } { return [mi_gdb_start_separate_mi_tty $flags] } - # Set the default value, it may be overriden later by specific testfile. + # Set the default value, it may be overridden later by specific testfile. set use_gdb_stub [target_info exists use_gdb_stub] # Start SID. @@ -1953,50 +1953,50 @@ proc mi_run_inline_test { testcase } { } proc get_mi_thread_list {name} { - global expect_out - - # MI will return a list of thread ids: - # - # -thread-list-ids - # ^done,thread-ids=[thread-id="1",thread-id="2",...],number-of-threads="N" - # (gdb) - mi_gdb_test "-thread-list-ids" \ - {.*\^done,thread-ids={(thread-id="[0-9]+"(,)?)+},current-thread-id="[0-9]+",number-of-threads="[0-9]+"} \ - "-thread_list_ids ($name)" - - set output {} - if {[info exists expect_out(buffer)]} { - set output $expect_out(buffer) - } - - set thread_list {} - if {![regexp {thread-ids=\{(thread-id="[0-9]+"(,)?)*\}} $output threads]} { - fail "finding threads in MI output ($name)" - } else { - pass "finding threads in MI output ($name)" - - # Make list of console threads - set start [expr {[string first \{ $threads] + 1}] - set end [expr {[string first \} $threads] - 1}] - set threads [string range $threads $start $end] - foreach thread [split $threads ,] { - if {[scan $thread {thread-id="%d"} num]} { - lappend thread_list $num - } + # MI will return a list of thread ids: + # + # -thread-list-ids + # ^done,thread-ids={thread-id="1",thread-id="2",...},number-of-threads="N" + # (gdb) + # + # In case there are too many threads, the expect buffer would + # become full. Process the buffer contents in small chunks. + set thread_list {} + set num_threads "unknown" + set test "$name: get MI thread list" + gdb_test_multiple "-thread-list-ids" $test -prompt "$::mi_gdb_prompt" { + -re "done,thread-ids=\{" { + exp_continue + } + -re "^thread-id=\"($::decimal)\"(,|\})" { + lappend thread_list $expect_out(1,string) + exp_continue + } + -re "^,current-thread-id=\"$::decimal\"" { + exp_continue + } + -re "^,number-of-threads=\"($::decimal)\"" { + set num_threads $expect_out(1,string) + exp_continue + } + -re "^\r\n$::mi_gdb_prompt" { + pass $gdb_test_name + } } - } - return $thread_list + gdb_assert {[llength $thread_list] == $num_threads} \ + "$name: found thread ids in MI output" + + return $thread_list } -# Check that MI and the console know of the same threads. -# Appends NAME to all test names. -proc check_mi_and_console_threads {name} { +# Helper function for check_mi_and_console_threads. +proc check_mi_and_console_threads_1 { name } { global expect_out mi_gdb_test "-thread-list-ids" \ {.*\^done,thread-ids={(thread-id="[0-9]+"(,)*)+},current-thread-id="[0-9]+",number-of-threads="[0-9]+"} \ - "-thread-list-ids ($name)" + "-thread-list-ids" set mi_output {} if {[info exists expect_out(buffer)]} { set mi_output $expect_out(buffer) @@ -2013,7 +2013,7 @@ proc check_mi_and_console_threads {name} { # FIXME: kseitz/2002-09-05: Don't use the hack-cli method. mi_gdb_test "info threads" \ {.*(~".*"[\r\n]*)+.*} \ - "info threads ($name)" + "info threads" set console_output {} if {[info exists expect_out(buffer)]} { set console_output $expect_out(buffer) @@ -2039,29 +2039,29 @@ proc check_mi_and_console_threads {name} { } } if {$mi_result == ""} { - fail "finding MI result string ($name)" + fail "finding MI result string" } else { - pass "finding MI result string ($name)" + pass "finding MI result string" } # Finally, extract the thread ids and compare them to the console set num_mi_threads_str "" if {![regexp {number-of-threads="[0-9]+"} $mi_result num_mi_threads_str]} { - fail "finding number of threads in MI output ($name)" + fail "finding number of threads in MI output" } else { - pass "finding number of threads in MI output ($name)" + pass "finding number of threads in MI output" # Extract the number of threads from the MI result if {![scan $num_mi_threads_str {number-of-threads="%d"} num_mi_threads]} { - fail "got number of threads from MI ($name)" + fail "got number of threads from MI" } else { - pass "got number of threads from MI ($name)" + pass "got number of threads from MI" # Check if MI and console have same number of threads if {$num_mi_threads != [llength $console_thread_list]} { - fail "console and MI have same number of threads ($name)" + fail "console and MI have same number of threads" } else { - pass "console and MI have same number of threads ($name)" + pass "console and MI have same number of threads" # Get MI thread list set mi_thread_list [get_mi_thread_list $name] @@ -2074,19 +2074,27 @@ proc check_mi_and_console_threads {name} { } } if {$fails > 0} { - fail "MI and console have same threads ($name)" + fail "MI and console have same threads" # Send a list of failures to the log send_log "Console has thread ids: $console_thread_list\n" send_log "MI has thread ids: $mi_thread_list\n" } else { - pass "MI and console have same threads ($name)" + pass "MI and console have same threads" } } } } } +# Check that MI and the console know of the same threads. +# Appends NAME to all test names. +proc check_mi_and_console_threads { name } { + with_test_prefix $name { + check_mi_and_console_threads_1 $name + } +} + # Set solib-search-path to allow gdb to locate shlib FILE. proc mi_locate_shlib { file } { global mi_spawn_id @@ -2673,7 +2681,7 @@ proc mi_make_info_frame_regexp {args} { # build the regexp for matching against the -stack-info-frame output. proc mi_info_frame { test args } { - parse_args {{frame ""} {thread ""}} + parse_some_args {{frame ""} {thread ""}} set re [eval mi_make_info_frame_regexp $args] diff --git a/gdb/testsuite/lib/my-syscalls.S b/gdb/testsuite/lib/my-syscalls.S index 19df0ca..c514b32 100644 --- a/gdb/testsuite/lib/my-syscalls.S +++ b/gdb/testsuite/lib/my-syscalls.S @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2020-2024 Free Software Foundation, Inc. + Copyright 2020-2025 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 diff --git a/gdb/testsuite/lib/my-syscalls.h b/gdb/testsuite/lib/my-syscalls.h index 8de28ae..03c6f7e 100644 --- a/gdb/testsuite/lib/my-syscalls.h +++ b/gdb/testsuite/lib/my-syscalls.h @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2020-2024 Free Software Foundation, Inc. + Copyright 2020-2025 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 diff --git a/gdb/testsuite/lib/notty-wrap b/gdb/testsuite/lib/notty-wrap index 93b81fb..3011753 100755 --- a/gdb/testsuite/lib/notty-wrap +++ b/gdb/testsuite/lib/notty-wrap @@ -1,6 +1,6 @@ #!/bin/sh -# Copyright (C) 2021-2024 Free Software Foundation, Inc. +# Copyright (C) 2021-2025 Free Software Foundation, Inc. # # This file is part of GDB. # diff --git a/gdb/testsuite/lib/objc.exp b/gdb/testsuite/lib/objc.exp index 1378f56..cf1fed9 100644 --- a/gdb/testsuite/lib/objc.exp +++ b/gdb/testsuite/lib/objc.exp @@ -1,6 +1,6 @@ # This test code is part of GDB, the GNU debugger. -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/opencl.exp b/gdb/testsuite/lib/opencl.exp index caa0e1e..2a5300e 100644 --- a/gdb/testsuite/lib/opencl.exp +++ b/gdb/testsuite/lib/opencl.exp @@ -1,4 +1,4 @@ -# Copyright 2010-2024 Free Software Foundation, Inc. +# Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/opencl_hostapp.c b/gdb/testsuite/lib/opencl_hostapp.c index 7637a0f..c39995f 100644 --- a/gdb/testsuite/lib/opencl_hostapp.c +++ b/gdb/testsuite/lib/opencl_hostapp.c @@ -1,6 +1,6 @@ /* This testcase is part of GDB, the GNU debugger. - Copyright 2010-2024 Free Software Foundation, Inc. + Copyright 2010-2025 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 diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp index 236eca1..d76cdca 100644 --- a/gdb/testsuite/lib/pascal.exp +++ b/gdb/testsuite/lib/pascal.exp @@ -1,4 +1,4 @@ -# Copyright 2007-2024 Free Software Foundation, Inc. +# Copyright 2007-2025 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 diff --git a/gdb/testsuite/lib/pdtrace.in b/gdb/testsuite/lib/pdtrace.in index 08b9efa..a629ff6 100755 --- a/gdb/testsuite/lib/pdtrace.in +++ b/gdb/testsuite/lib/pdtrace.in @@ -2,7 +2,7 @@ # A Poor (but Free) Man's dtrace # -# Copyright (C) 2014-2024 Free Software Foundation, Inc. +# Copyright (C) 2014-2025 Free Software Foundation, Inc. # # Contributed by Oracle, Inc. # diff --git a/gdb/testsuite/lib/perftest.exp b/gdb/testsuite/lib/perftest.exp index b4c997a..cca0ede 100644 --- a/gdb/testsuite/lib/perftest.exp +++ b/gdb/testsuite/lib/perftest.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2013-2024 Free Software Foundation, Inc. +# Copyright (C) 2013-2025 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 diff --git a/gdb/testsuite/lib/precise-aligned-alloc.c b/gdb/testsuite/lib/precise-aligned-alloc.c index 4f55ffd..b914afe 100644 --- a/gdb/testsuite/lib/precise-aligned-alloc.c +++ b/gdb/testsuite/lib/precise-aligned-alloc.c @@ -1,6 +1,6 @@ /* This test file is part of GDB, the GNU debugger. - Copyright 2021-2024 Free Software Foundation, Inc. + Copyright 2021-2025 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 diff --git a/gdb/testsuite/lib/prelink-support.exp b/gdb/testsuite/lib/prelink-support.exp index 8be5067..a712a7a 100644 --- a/gdb/testsuite/lib/prelink-support.exp +++ b/gdb/testsuite/lib/prelink-support.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2010-2024 Free Software Foundation, Inc. +# Copyright (C) 2010-2025 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 @@ -13,39 +13,6 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see <http://www.gnu.org/licenses/>. -# Return nul-terminated string read from section SECTION of EXEC. Return "" -# if no such section or nul-terminated string was found. Function is useful -# for sections ".interp" or ".gnu_debuglink". - -proc section_get {exec section} { - global subdir - set tmp [standard_output_file section_get.tmp] - set objcopy_program [gdb_find_objcopy] - - set command "exec $objcopy_program -O binary --set-section-flags $section=A --change-section-address $section=0 -j $section $exec $tmp" - verbose -log "command is $command" - set result [catch $command output] - verbose -log "result is $result" - verbose -log "output is $output" - if {$result == 1} { - return "" - } - set fi [open $tmp] - fconfigure $fi -translation binary - set data [read $fi] - close $fi - file delete $tmp - # .interp has size $len + 1 but .gnu_debuglink contains garbage after \000. - set len [string first \000 $data] - if {$len < 0} { - verbose -log "section $section not found" - return "" - } - set retval [string range $data 0 [expr $len - 1]] - verbose -log "section $section is <$retval>" - return $retval -} - # Resolve symlinks. proc symlink_resolve {file} { @@ -57,7 +24,7 @@ proc symlink_resolve {file} { } else { set src2 $target } - verbose -log "Resolved symlink $file targetting $target as $src2" + verbose -log "Resolved symlink $file targeting $target as $src2" set file $src2 set loop [expr $loop + 1] diff --git a/gdb/testsuite/lib/prompt.exp b/gdb/testsuite/lib/prompt.exp index a19a057..7fa131b 100644 --- a/gdb/testsuite/lib/prompt.exp +++ b/gdb/testsuite/lib/prompt.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2011-2024 Free Software Foundation, Inc. +# Copyright (C) 2011-2025 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 @@ -32,7 +32,7 @@ proc default_prompt_gdb_start { } { global timeout global gdb_spawn_id - # Set the default value, it may be overriden later by specific testfile. + # Set the default value, it may be overridden later by specific testfile. # # Use `set_board_info use_gdb_stub' for the board file to flag the inferior # is already started after connecting and run/attach are not supported. diff --git a/gdb/testsuite/lib/range-stepping-support.exp b/gdb/testsuite/lib/range-stepping-support.exp index 1f1f9d7..27587e5 100644 --- a/gdb/testsuite/lib/range-stepping-support.exp +++ b/gdb/testsuite/lib/range-stepping-support.exp @@ -1,4 +1,4 @@ -# Copyright 2013-2024 Free Software Foundation, Inc. +# Copyright 2013-2025 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 diff --git a/gdb/testsuite/lib/read1.c b/gdb/testsuite/lib/read1.c index e449717..c4c9ee2 100644 --- a/gdb/testsuite/lib/read1.c +++ b/gdb/testsuite/lib/read1.c @@ -1,6 +1,6 @@ /* This is part of GDB, the GNU debugger. - Copyright 2011-2024 Free Software Foundation, Inc. + Copyright 2011-2025 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 @@ -62,7 +62,7 @@ init_readmore (int *method, unsigned int *sleep, FILE **log) *log = fopen (env, "w"); } -/* Wrap 'read', and modify it's behaviour using READ1 or READMORE style. */ +/* Wrap 'read', and modify it's behavior using READ1 or READMORE style. */ ssize_t read (int fd, void *buf, size_t count) @@ -89,7 +89,7 @@ read (int fd, void *buf, size_t count) init_readmore (&readmore_method, &readmore_sleep, &log); } - /* Only modify 'read' behaviour when reading from the terminal. */ + /* Only modify 'read' behavior when reading from the terminal. */ if (isatty (fd) == 0) goto fallback; diff --git a/gdb/testsuite/lib/rocm.exp b/gdb/testsuite/lib/rocm.exp index b2db0d5..d3f201c 100644 --- a/gdb/testsuite/lib/rocm.exp +++ b/gdb/testsuite/lib/rocm.exp @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2024 Free Software Foundation, Inc. +# Copyright (C) 2019-2025 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 @@ -15,48 +15,83 @@ # # Support library for testing ROCm (AMD GPU) GDB features. -# Get the list of gpu targets to compile for. -# -# If HCC_AMDGPU_TARGET is set in the environment, use it. Otherwise, -# try reading it from the system using the rocm_agent_enumerator -# utility. +# ROCM_PATH is used by hipcc as well. +if {[info exists ::env(ROCM_PATH)]} { + set rocm_path $::env(ROCM_PATH) +} else { + set rocm_path "/opt/rocm" +} -proc hcc_amdgpu_targets {} { - # Look for HCC_AMDGPU_TARGET (same env var hipcc uses). If - # that fails, try using rocm_agent_enumerator (again, same as - # hipcc does). - if {[info exists ::env(HCC_AMDGPU_TARGET)]} { - return [split $::env(HCC_AMDGPU_TARGET) ","] +# Act as a drop-in replacement for "remote_exec host" +# that logs the failures. + +proc log_host_exec { cmd } { + set result [remote_exec host "$cmd"] + set exit_status [lindex $result 0] + if {$exit_status != 0} { + # -1 indicates that $cmd could not be executed at all. + if {$exit_status == -1} { + verbose -log "Cannot execute $cmd." + } else { + verbose -log "$cmd returned an error." + } } - set rocm_agent_enumerator "rocm_agent_enumerator" + return $result +} - # If available, use ROCM_PATH to locate rocm_agent_enumerator. - if { [info exists ::env(ROCM_PATH)] } { - set rocm_agent_enumerator \ - "$::env(ROCM_PATH)/bin/rocm_agent_enumerator" +# Detect available AMDGPU devices. +# +# Return a list of GPU devices that do exist on the system. +# The list will be empty when there's no GPU or the execution +# of rocm_agent_enumerator does not succeed. It is up to the +# caller of this procedure that what should happen when an empty +# list is returned. + +gdb_caching_proc find_amdgpu_devices {} { + global rocm_path + set hip_gpu_devices [list] + set enumerator "rocm_agent_enumerator" + set targets "" + + # Try the PATH first + set result [log_host_exec "$enumerator"] + if {[lindex $result 0] == 0} { + set targets [lindex $result 1] + } else { + # Now try the ROCM_PATH + set result [log_host_exec "$rocm_path/bin/$enumerator"] + if {[lindex $result 0] == 0} { + set targets [lindex $result 1] + } } - # If we fail to locate the rocm_agent_enumerator, just return an empty - # list of targets and let the caller decide if this should be an error. - if { [which $rocm_agent_enumerator] == 0 } { - return [list] + if {$targets != ""} { + foreach dev $targets { + # Ignore the 'gfx000' device which identifies the host. + if {$dev != "gfx000"} { + lappend hip_gpu_devices $dev + } + } } - set result [remote_exec host $rocm_agent_enumerator] - if { [lindex $result 0] != 0 } { - error "rocm_agent_enumerator failed" - } + return $hip_gpu_devices +} - set targets [list] - foreach target [lindex $result 1] { - # Ignore gfx000 which is the host CPU. - if { $target ne "gfx000" } { - lappend targets $target - } +# Get the list of GPU targets to compile for. +# +# If HCC_AMDGPU_TARGET is set in the environment, use it. +# Otherwise, consider the devices available on the system. + +proc hcc_amdgpu_targets {} { + # First, look for HCC_AMDGPU_TARGET (same env var hipcc uses). + if {[info exists ::env(HCC_AMDGPU_TARGET)]} { + # We don't verify the contents of HCC_AMDGPU_TARGET. + # That's the toolchain's job. + return [split $::env(HCC_AMDGPU_TARGET) ","] } - return $targets + return [find_amdgpu_devices] } gdb_caching_proc allow_hipcc_tests {} { @@ -77,12 +112,15 @@ gdb_caching_proc allow_hipcc_tests {} { return {0 "amd-dbgapi not supported"} } - # Check we have a working hipcc compiler available. - set targets [hcc_amdgpu_targets] - if { [llength $targets] == 0} { + # Check if there's any GPU device to run the tests on. + set devices [find_amdgpu_devices] + if {[llength $devices] == 0} { return {0 "no suitable amdgpu targets found"} } + # Check if we have a working hipcc compiler available. + # TARGETS won't be empty, because there's at least one GPU device. + set targets [hcc_amdgpu_targets] set flags [list hip additional_flags=--offload-arch=[join $targets ","]] if {![gdb_simple_compile hipprobe { #include <hip/hip_runtime.h> @@ -126,26 +164,7 @@ proc hip_devices_support_debug_multi_process {} { set unsupported_targets \ {gfx900 gfx906 gfx908 gfx1010 gfx1011 gfx1012 gfx1030 gfx1031 gfx1032} - set targets [hcc_amdgpu_targets] - if { [llength $targets] == 0 } { - return 0 - } - - foreach target $targets { - if { [lsearch -exact $unsupported_targets $target] != -1 } { - return 0 - } - } - return 1 -} - -# Return true if all the devices on the host support precise memory. - -proc hip_devices_support_precise_memory {} { - set unsupported_targets \ - {gfx900 gfx906 gfx908 gfx1010 gfx1011 gfx1012 gfx1030 gfx1031 gfx1032} - - set targets [hcc_amdgpu_targets] + set targets [find_amdgpu_devices] if { [llength $targets] == 0 } { return 0 } diff --git a/gdb/testsuite/lib/rust-support.exp b/gdb/testsuite/lib/rust-support.exp index 971a4a6..94888e9 100644 --- a/gdb/testsuite/lib/rust-support.exp +++ b/gdb/testsuite/lib/rust-support.exp @@ -1,4 +1,4 @@ -# Copyright 2016-2024 Free Software Foundation, Inc. +# Copyright 2016-2025 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 diff --git a/gdb/testsuite/lib/selftest-support.exp b/gdb/testsuite/lib/selftest-support.exp index 00d7e30..e037664 100644 --- a/gdb/testsuite/lib/selftest-support.exp +++ b/gdb/testsuite/lib/selftest-support.exp @@ -1,4 +1,4 @@ -# Copyright 2003-2024 Free Software Foundation, Inc. +# Copyright 2003-2025 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 @@ -100,7 +100,7 @@ proc selftest_setup { executable function } { # self-test, then return an empty string. proc selftest_prepare {} { # Are we testing with a remote board? In that case, the target - # won't have access to the GDB's auxilliary data files + # won't have access to the GDB's auxiliary data files # (data-directory, etc.). It's simpler to just skip. if { [is_remote target] || [is_remote host] } { return diff --git a/gdb/testsuite/lib/set_unbuffered_mode.c b/gdb/testsuite/lib/set_unbuffered_mode.c index 0c92d55..f0604a0 100644 --- a/gdb/testsuite/lib/set_unbuffered_mode.c +++ b/gdb/testsuite/lib/set_unbuffered_mode.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2024 Free Software Foundation, Inc. +/* Copyright (C) 2008-2025 Free Software Foundation, Inc. This file is part of GDB. diff --git a/gdb/testsuite/lib/sym-info-cmds.exp b/gdb/testsuite/lib/sym-info-cmds.exp index 9714529..c94b06f 100644 --- a/gdb/testsuite/lib/sym-info-cmds.exp +++ b/gdb/testsuite/lib/sym-info-cmds.exp @@ -1,4 +1,4 @@ -# Copyright 2019-2024 Free Software Foundation, Inc. +# Copyright 2019-2025 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 diff --git a/gdb/testsuite/lib/trace-support.exp b/gdb/testsuite/lib/trace-support.exp index c9c9697..a8d0699 100644 --- a/gdb/testsuite/lib/trace-support.exp +++ b/gdb/testsuite/lib/trace-support.exp @@ -1,4 +1,4 @@ -# Copyright (C) 1998-2024 Free Software Foundation, Inc. +# Copyright (C) 1998-2025 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 @@ -366,6 +366,20 @@ proc gdb_find_recursion_test_baseline { filename } { return $baseline } +# Return 1 if the IPA library is available and 0 otherwise. + +proc allow_in_proc_agent {} { + global objdir + + if [target_info exists in_proc_agent] { + return 1 + } elseif [file exists "$objdir/../../gdbserver/libinproctrace.so"] { + return 1 + } else { + return 0 + } +} + # Return the location of the IPA library. proc get_in_proc_agent {} { diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp index 25f597b..a0cd199 100644 --- a/gdb/testsuite/lib/tuiterm.exp +++ b/gdb/testsuite/lib/tuiterm.exp @@ -1,4 +1,4 @@ -# Copyright 2019-2024 Free Software Foundation, Inc. +# Copyright 2019-2025 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 @@ -1133,11 +1133,16 @@ namespace eval Term { gdb_assert {![regexp -- $regexp $contents]} $test_name } - # Get the region of the screen described by X, Y, WIDTH, - # and HEIGHT, and separate the lines using SEP. - proc get_region { x y width height sep } { + # Get the region of the screen described by X, Y, WIDTH, and + # HEIGHT, and separate the lines using SEP. If ATTRS is true then + # include attribute information in the output. + proc get_region { x y width height sep { attrs false } } { variable _chars + if { $attrs } { + _reset_attrs region_attrs + } + # Grab the contents of the box, join each line together # using $sep. set result "" @@ -1148,9 +1153,19 @@ namespace eval Term { append result $sep } for {set xx $x} {$xx < [expr {$x + $width}]} {incr xx} { - append result [lindex $_chars($xx,$yy) 0] + if { $attrs } { + set char_attrs [lindex $_chars($xx,$yy) 1] + append result [apply_attrs region_attrs $char_attrs] + } + + append result [get_char $xx $yy] } } + if { $attrs } { + _reset_attrs zero_attrs + set char_attrs [array get zero_attrs] + append result [apply_attrs region_attrs $char_attrs] + } return $result } @@ -1178,7 +1193,7 @@ namespace eval Term { } # Check the contents of a box on the screen. This is a little - # like check_contents, but doens't check the whole screen + # like check_contents, but doesn't check the whole screen # contents, only the contents of a single box. This procedure # includes (effectively) a call to check_box to ensure there is a # box where expected, if there is then the contents of the box are diff --git a/gdb/testsuite/lib/unbuffer_output.c b/gdb/testsuite/lib/unbuffer_output.c index a286e3f..cdaa227 100644 --- a/gdb/testsuite/lib/unbuffer_output.c +++ b/gdb/testsuite/lib/unbuffer_output.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2024 Free Software Foundation, Inc. +/* Copyright (C) 2008-2025 Free Software Foundation, Inc. This file is part of GDB. diff --git a/gdb/testsuite/lib/valgrind.exp b/gdb/testsuite/lib/valgrind.exp index c952e92..aad0a3b 100644 --- a/gdb/testsuite/lib/valgrind.exp +++ b/gdb/testsuite/lib/valgrind.exp @@ -1,4 +1,4 @@ -# Copyright 2009-2024 Free Software Foundation, Inc. +# Copyright 2009-2025 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 |