1d506c26d9
This commit is the result of the following actions:
- Running gdb/copyright.py to update all of the copyright headers to
include 2024,
- Manually updating a few files the copyright.py script told me to
update, these files had copyright headers embedded within the
file,
- Regenerating gdbsupport/Makefile.in to refresh it's copyright
date,
- Using grep to find other files that still mentioned 2023. If
these files were updated last year from 2022 to 2023 then I've
updated them this year to 2024.
I'm sure I've probably missed some dates. Feel free to fix them up as
you spot them.
538 lines
14 KiB
Text
538 lines
14 KiB
Text
# Copyright 2019-2024 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/>.
|
|
|
|
# Make it easier to run the 'info modules' command (using
|
|
# GDBInfoModules), and the 'info module ...' commands (using
|
|
# GDBInfoModuleContents) and process the output.
|
|
#
|
|
# The difficulty we run into is that different versions of gFortran
|
|
# include different helper modules which show up in the results. The
|
|
# procedures in this library help process those parts of the output we
|
|
# actually want to check, while ignoring those parts that we don't
|
|
# care about.
|
|
#
|
|
# For each namespace GDBInfoModules and GDBInfoModuleContents, there's
|
|
# a run_command proc, use this to run a command and capture the
|
|
# output. Then make calls to check_header, check_entry, and
|
|
# check_no_entry to ensure the output was as expected.
|
|
|
|
namespace eval GDBInfoSymbols {
|
|
|
|
# A string that is the header printed by GDB immediately after the
|
|
# 'info [modules|types|functions|variables]' command has been issued.
|
|
variable _header
|
|
|
|
# A list of entries extracted from the output of the command.
|
|
# Each entry is a filename, a line number, and the rest of the
|
|
# text describing the entry. If an entry has no line number then
|
|
# it is replaced with the text NONE.
|
|
variable _entries
|
|
|
|
# The string that is the complete last command run.
|
|
variable _last_command
|
|
|
|
# Add a new entry to the _entries list.
|
|
proc _add_entry { filename lineno text } {
|
|
variable _entries
|
|
|
|
set entry [list $filename $lineno $text]
|
|
lappend _entries $entry
|
|
}
|
|
|
|
# Run the 'info modules' command, passing ARGS as extra arguments
|
|
# to the command. Process the output storing the results within
|
|
# the variables in this namespace.
|
|
#
|
|
# The results of any previous call to run_command are discarded
|
|
# when this is called.
|
|
proc run_command { cmd { testname "" } } {
|
|
global gdb_prompt
|
|
|
|
variable _header
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if {![regexp -- "^info (modules|types|variables|functions)" $cmd]} {
|
|
perror "invalid command"
|
|
}
|
|
|
|
set _header ""
|
|
set _entries [list]
|
|
set _last_command $cmd
|
|
|
|
if { $testname == "" } {
|
|
set testname $cmd
|
|
}
|
|
|
|
send_gdb "$cmd\n"
|
|
gdb_expect {
|
|
-re "^$cmd\r\n" {
|
|
# Match the original command echoed back to us.
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
gdb_expect {
|
|
-re "^\r\n" {
|
|
# Found the blank line after the header, we're done
|
|
# parsing the header now.
|
|
}
|
|
-re "^\[ \t]*(\[^\r\n\]+)\r\n" {
|
|
set str $expect_out(1,string)
|
|
if { $_header == "" } {
|
|
set _header $str
|
|
} else {
|
|
set _header "$_header $str"
|
|
}
|
|
exp_continue
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
set current_file ""
|
|
gdb_expect {
|
|
-re "^File (\[^\r\n\]+):\r\n" {
|
|
set current_file $expect_out(1,string)
|
|
exp_continue
|
|
}
|
|
-re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
|
|
set lineno $expect_out(1,string)
|
|
set text $expect_out(2,string)
|
|
if { $current_file == "" } {
|
|
fail "$testname (missing filename)"
|
|
return 0
|
|
}
|
|
_add_entry $current_file $lineno $text
|
|
exp_continue
|
|
}
|
|
-re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
|
|
set lineno "NONE"
|
|
set text $expect_out(1,string)
|
|
if { $current_file == "" } {
|
|
fail "$testname (missing filename)"
|
|
return 0
|
|
}
|
|
_add_entry $current_file $lineno $text
|
|
exp_continue
|
|
}
|
|
-re "^\r\n" {
|
|
exp_continue
|
|
}
|
|
-re "^$gdb_prompt $" {
|
|
# All done.
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
pass $testname
|
|
return 1
|
|
}
|
|
|
|
# Check that the header held in _header matches PATTERN. Use
|
|
# TESTNAME as the name of the test, or create a suitable default
|
|
# test name based on the last command.
|
|
proc check_header { pattern { testname "" } } {
|
|
variable _header
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname "$_last_command: check header"
|
|
}
|
|
|
|
gdb_assert {[regexp -- $pattern $_header]} $testname
|
|
}
|
|
|
|
# Call check_entry_1 with OPTIONAL == 0.
|
|
proc check_entry { filename lineno text { testname "" } } {
|
|
check_entry_1 $filename $lineno $text 0 $testname
|
|
}
|
|
|
|
# Call check_entry_1 with OPTIONAL == 1.
|
|
proc check_optional_entry { filename lineno text { testname "" } } {
|
|
check_entry_1 $filename $lineno $text 1 $testname
|
|
}
|
|
|
|
# Check that we have an entry in _entries matching FILENAME,
|
|
# LINENO, and TEXT. If LINENO is the empty string it is replaced
|
|
# with the string NONE in order to match a similarly missing line
|
|
# number in the output of the command.
|
|
#
|
|
# TESTNAME is the name of the test, or a default will be created
|
|
# based on the last command run and the arguments passed here.
|
|
#
|
|
# If a matching entry is found then it is removed from the
|
|
# _entries list, this allows us to check for duplicates using the
|
|
# check_no_entry call.
|
|
proc check_entry_1 { filename lineno text optional testname } {
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname \
|
|
"$_last_command: check for entry '$filename', '$lineno', '$text'"
|
|
}
|
|
|
|
if { $lineno == "" } {
|
|
set lineno "NONE"
|
|
}
|
|
|
|
set new_entries [list]
|
|
|
|
set found_match 0
|
|
foreach entry $_entries {
|
|
|
|
if {!$found_match} {
|
|
set f [lindex $entry 0]
|
|
set l [lindex $entry 1]
|
|
set t [lindex $entry 2]
|
|
if { [regexp -- $filename $f] \
|
|
&& [regexp -- $lineno $l] \
|
|
&& [regexp -- $text $t] } {
|
|
set found_match 1
|
|
} else {
|
|
lappend new_entries $entry
|
|
}
|
|
} else {
|
|
lappend new_entries $entry
|
|
}
|
|
}
|
|
|
|
set _entries $new_entries
|
|
if { $optional && ! $found_match } {
|
|
unsupported $testname
|
|
} else {
|
|
gdb_assert { $found_match } $testname
|
|
}
|
|
}
|
|
|
|
# Check that there is no entry in the _entries list matching
|
|
# FILENAME, LINENO, and TEXT. The LINENO and TEXT are optional,
|
|
# and will be replaced with '.*' if missing.
|
|
#
|
|
# If LINENO is the empty string then it will be replaced with the
|
|
# string NONE in order to match against missing line numbers in
|
|
# the output of the command.
|
|
#
|
|
# TESTNAME is the name of the test, or a default will be built
|
|
# from the last command run and the arguments passed here.
|
|
#
|
|
# This can be used after a call to check_entry to ensure that
|
|
# there are no further matches for a particular file in the
|
|
# output.
|
|
proc check_no_entry { filename { lineno ".*" } { text ".*" } \
|
|
{ testname "" } } {
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname \
|
|
"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
|
|
}
|
|
|
|
if { $lineno == "" } {
|
|
set lineno "NONE"
|
|
}
|
|
|
|
foreach entry $_entries {
|
|
set f [lindex $entry 0]
|
|
set l [lindex $entry 1]
|
|
set t [lindex $entry 2]
|
|
if { [regexp -- $filename $f] \
|
|
&& [regexp -- $lineno $l] \
|
|
&& [regexp -- $text $t] } {
|
|
fail $testname
|
|
}
|
|
}
|
|
|
|
pass $testname
|
|
}
|
|
}
|
|
|
|
|
|
namespace eval GDBInfoModuleSymbols {
|
|
|
|
# A string that is the header printed by GDB immediately after the
|
|
# 'info modules (variables|functions)' command has been issued.
|
|
variable _header
|
|
|
|
# A list of entries extracted from the output of the command.
|
|
# Each entry is a filename, a module name, a line number, and the
|
|
# rest of the text describing the entry. If an entry has no line
|
|
# number then it is replaced with the text NONE.
|
|
variable _entries
|
|
|
|
# The string that is the complete last command run.
|
|
variable _last_command
|
|
|
|
# Add a new entry to the _entries list.
|
|
proc _add_entry { filename module lineno text } {
|
|
variable _entries
|
|
|
|
set entry [list $filename $module $lineno $text]
|
|
lappend _entries $entry
|
|
}
|
|
|
|
# Run the 'info module ....' command, passing ARGS as extra
|
|
# arguments to the command. Process the output storing the
|
|
# results within the variables in this namespace.
|
|
#
|
|
# The results of any previous call to run_command are discarded
|
|
# when this is called.
|
|
proc run_command { cmd { testname "" } } {
|
|
global gdb_prompt
|
|
|
|
variable _header
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if {![regexp -- "^info module (variables|functions)" $cmd]} {
|
|
perror "invalid command: '$cmd'"
|
|
}
|
|
|
|
set _header ""
|
|
set _entries [list]
|
|
set _last_command $cmd
|
|
|
|
if { $testname == "" } {
|
|
set testname $cmd
|
|
}
|
|
|
|
send_gdb "$cmd\n"
|
|
gdb_expect {
|
|
-re "^$cmd\r\n" {
|
|
# Match the original command echoed back to us.
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
gdb_expect {
|
|
-re "^\r\n" {
|
|
# Found the blank line after the header, we're done
|
|
# parsing the header now.
|
|
}
|
|
-re "^\[ \t\]*(\[^\r\n\]+)\r\n" {
|
|
set str $expect_out(1,string)
|
|
if { $_header == "" } {
|
|
set _header $str
|
|
} else {
|
|
set _header "$_header $str"
|
|
}
|
|
exp_continue
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
set current_module ""
|
|
set current_file ""
|
|
gdb_expect {
|
|
-re "^Module \"(\[^\"\]+)\":\r\n" {
|
|
set current_module $expect_out(1,string)
|
|
exp_continue
|
|
}
|
|
-re "^File (\[^\r\n\]+):\r\n" {
|
|
if { $current_module == "" } {
|
|
fail "$testname (missing module)"
|
|
return 0
|
|
}
|
|
set current_file $expect_out(1,string)
|
|
exp_continue
|
|
}
|
|
-re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
|
|
set lineno $expect_out(1,string)
|
|
set text $expect_out(2,string)
|
|
if { $current_module == "" } {
|
|
fail "$testname (missing module)"
|
|
return 0
|
|
}
|
|
if { $current_file == "" } {
|
|
fail "$testname (missing filename)"
|
|
return 0
|
|
}
|
|
_add_entry $current_file $current_module \
|
|
$lineno $text
|
|
exp_continue
|
|
}
|
|
-re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
|
|
set lineno "NONE"
|
|
set text $expect_out(1,string)
|
|
if { $current_module == "" } {
|
|
fail "$testname (missing module)"
|
|
return 0
|
|
}
|
|
if { $current_file == "" } {
|
|
fail "$testname (missing filename)"
|
|
return 0
|
|
}
|
|
_add_entry $current_file $current_module \
|
|
$lineno $text
|
|
exp_continue
|
|
}
|
|
-re "^\r\n" {
|
|
exp_continue
|
|
}
|
|
-re "^$gdb_prompt $" {
|
|
# All done.
|
|
}
|
|
timeout {
|
|
fail "$testname (timeout)"
|
|
return 0
|
|
}
|
|
}
|
|
|
|
pass $testname
|
|
return 1
|
|
}
|
|
|
|
# Check that the header held in _header matches PATTERN. Use
|
|
# TESTNAME as the name of the test, or create a suitable default
|
|
# test name based on the last command.
|
|
proc check_header { pattern { testname "" } } {
|
|
variable _header
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname "$_last_command: check header"
|
|
}
|
|
|
|
gdb_assert {[regexp -- $pattern $_header]} $testname
|
|
}
|
|
|
|
# Check that we have an entry in _entries matching FILENAME,
|
|
# MODULE, LINENO, and TEXT. If LINENO is the empty string it is
|
|
# replaced with the string NONE in order to match a similarly
|
|
# missing line number in the output of the command.
|
|
#
|
|
# TESTNAME is the name of the test, or a default will be created
|
|
# based on the last command run and the arguments passed here.
|
|
#
|
|
# If a matching entry is found then it is removed from the
|
|
# _entries list, this allows us to check for duplicates using the
|
|
# check_no_entry call.
|
|
#
|
|
# If OPTIONAL, don't generate a FAIL for a mismatch, but use UNSUPPORTED
|
|
# instead.
|
|
proc check_entry_1 { filename module lineno text optional testname } {
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname \
|
|
"$_last_command: check for entry '$filename', '$lineno', '$text'"
|
|
}
|
|
|
|
if { $lineno == "" } {
|
|
set lineno "NONE"
|
|
}
|
|
|
|
set new_entries [list]
|
|
|
|
set found_match 0
|
|
foreach entry $_entries {
|
|
|
|
if {!$found_match} {
|
|
set f [lindex $entry 0]
|
|
set m [lindex $entry 1]
|
|
set l [lindex $entry 2]
|
|
set t [lindex $entry 3]
|
|
if { [regexp -- $filename $f] \
|
|
&& [regexp -- $module $m] \
|
|
&& [regexp -- $lineno $l] \
|
|
&& [regexp -- $text $t] } {
|
|
set found_match 1
|
|
} else {
|
|
lappend new_entries $entry
|
|
}
|
|
} else {
|
|
lappend new_entries $entry
|
|
}
|
|
}
|
|
|
|
set _entries $new_entries
|
|
if { $optional && ! $found_match } {
|
|
unsupported $testname
|
|
} else {
|
|
gdb_assert { $found_match } $testname
|
|
}
|
|
}
|
|
|
|
# Call check_entry_1 with OPTIONAL == 0.
|
|
proc check_entry { filename module lineno text { testname "" } } {
|
|
check_entry_1 $filename $module $lineno $text 0 $testname
|
|
}
|
|
|
|
# Call check_entry_1 with OPTIONAL == 1.
|
|
proc check_optional_entry { filename module lineno text { testname "" } } {
|
|
check_entry_1 $filename $module $lineno $text 1 $testname
|
|
}
|
|
|
|
# Check that there is no entry in the _entries list matching
|
|
# FILENAME, MODULE, LINENO, and TEXT. The LINENO and TEXT are
|
|
# optional, and will be replaced with '.*' if missing.
|
|
#
|
|
# If LINENO is the empty string then it will be replaced with the
|
|
# string NONE in order to match against missing line numbers in
|
|
# the output of the command.
|
|
#
|
|
# TESTNAME is the name of the test, or a default will be built
|
|
# from the last command run and the arguments passed here.
|
|
#
|
|
# This can be used after a call to check_entry to ensure that
|
|
# there are no further matches for a particular file in the
|
|
# output.
|
|
proc check_no_entry { filename module { lineno ".*" } \
|
|
{ text ".*" } { testname "" } } {
|
|
variable _entries
|
|
variable _last_command
|
|
|
|
if { $testname == "" } {
|
|
set testname \
|
|
"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
|
|
}
|
|
|
|
if { $lineno == "" } {
|
|
set lineno "NONE"
|
|
}
|
|
|
|
foreach entry $_entries {
|
|
set f [lindex $entry 0]
|
|
set m [lindex $entry 1]
|
|
set l [lindex $entry 2]
|
|
set t [lindex $entry 3]
|
|
if { [regexp -- $filename $f] \
|
|
&& [regexp -- $module $m] \
|
|
&& [regexp -- $lineno $l] \
|
|
&& [regexp -- $text $t] } {
|
|
fail $testname
|
|
}
|
|
}
|
|
|
|
pass $testname
|
|
}
|
|
}
|