This is the mail archive of the
gdb-cvs@sourceware.org
mailing list for the GDB project.
[binutils-gdb] gdb/testsuite/fortran: Fix info-modules/info-types for gfortran 8+
- From: Andrew Burgess <aburgess at sourceware dot org>
- To: gdb-cvs at sourceware dot org
- Date: 9 Dec 2019 13:06:40 -0000
- Subject: [binutils-gdb] gdb/testsuite/fortran: Fix info-modules/info-types for gfortran 8+
https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=d57cbee932f86df06251498daa93154046dc77c0
commit d57cbee932f86df06251498daa93154046dc77c0
Author: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Tue Dec 3 13:18:43 2019 +0000
gdb/testsuite/fortran: Fix info-modules/info-types for gfortran 8+
The gdb.fortran/info-modules.exp and gdb.fortran/info-types.exp tests
are failing on versions of gfortran after 7.3 due to the inclusion of
extra "system" modules and type that were not being matched by the
current test patterns.
Rather than building increasingly complex patterns that would always
be at risk of breaking with future versions of GCC I have instead
added a new library that parses the output of the following commands:
info types
info variables
info functions
info modules
info module functions
info module variables
into a data structure, the test can than run checks against the
contents of this data structure.
The benefit is that we can simply ignore extra results that we don't
care about.
There is a small risk that a bug in GDB might allow us to start
reporting incorrect results in such a way that the new library will
not spot the error. However, I have tried to mitigate this risk by
adding extra procedures into the test library (see check_no_entry) and
we can add more in future if we wanted to be even more defensive.
I tested this test file with gFortran 7.3.1, 8.3.0, and 9.2.0, I now
see 100% pass in all cases.
gdb/testsuite/ChangeLog:
* gdb.fortran/info-modules.exp: Rewrite to make use of new
sym-info-cmds library.
* gdb.fortran/info-types.exp: Likewise.
* lib/sym-info-cmds.exp: New file.
Change-Id: Iff81624f51b5afb6c95393932f3d94472d7c2970
Diff:
---
gdb/testsuite/ChangeLog | 7 +
gdb/testsuite/gdb.fortran/info-modules.exp | 261 +++++++--------
gdb/testsuite/gdb.fortran/info-types.exp | 13 +
gdb/testsuite/lib/sym-info-cmds.exp | 507 +++++++++++++++++++++++++++++
4 files changed, 648 insertions(+), 140 deletions(-)
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 64e7ad7..7d41fad 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-12-09 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/info-modules.exp: Rewrite to make use of new
+ sym-info-cmds library.
+ * gdb.fortran/info-types.exp: Likewise.
+ * lib/sym-info-cmds.exp: New file.
+
2019-12-08 Tom de Vries <tdevries@suse.de>
* gdb.dwarf2/imported-unit.exp: Fix inter-CU references.
diff --git a/gdb/testsuite/gdb.fortran/info-modules.exp b/gdb/testsuite/gdb.fortran/info-modules.exp
index c57ac3f..cf20f0a 100644
--- a/gdb/testsuite/gdb.fortran/info-modules.exp
+++ b/gdb/testsuite/gdb.fortran/info-modules.exp
@@ -17,6 +17,7 @@
# module variables'.
load_lib "fortran.exp"
+load_lib "sym-info-cmds.exp"
if { [skip_fortran_tests] } { continue }
@@ -38,150 +39,130 @@ set real4 [fortran_real4]
# Test 'info modules' command.
-gdb_test "info modules" \
- [multi_line \
- "All defined modules:" \
- "" \
- "File .*${srcfile2}:" \
- "18:\[\t \]+mod2" \
- "" \
- "File .*${srcfile}:" \
- "16:\[\t \]+mod1" ]
-
-gdb_test "info modules 1" \
- [multi_line \
- "All modules matching regular expression \"1\":" \
- "" \
- "File .*${srcfile}:" \
- "16:\[\t \]+mod1" ]
-
-gdb_test "info modules 2" \
- [multi_line \
- "All modules matching regular expression \"2\":" \
- "" \
- "File .*${srcfile2}:" \
- "18:\[\t \]+mod2" ]
-
-gdb_test "info modules mod" \
- [multi_line \
- "All modules matching regular expression \"mod\":" \
- "" \
- "File .*${srcfile2}:" \
- "18:\[\t \]+mod2" \
- "" \
- "File .*${srcfile}:" \
- "16:\[\t \]+mod1" ]
+GDBInfoSymbols::run_command "info modules"
+GDBInfoSymbols::check_header "All defined modules:"
+GDBInfoSymbols::check_entry "${srcfile2}" "18" "mod2"
+GDBInfoSymbols::check_entry "${srcfile}" "16" "mod1"
+GDBInfoSymbols::check_no_entry "${srcfile}"
+GDBInfoSymbols::check_no_entry "${srcfile2}"
+
+GDBInfoSymbols::run_command "info modules 1"
+GDBInfoSymbols::check_header \
+ "All modules matching regular expression \"1\":"
+GDBInfoSymbols::check_entry "${srcfile}" "16" "mod1"
+GDBInfoSymbols::check_no_entry "${srcfile}"
+GDBInfoSymbols::check_no_entry "${srcfile2}"
+
+GDBInfoSymbols::run_command "info modules 2"
+GDBInfoSymbols::check_header \
+ "All modules matching regular expression \"2\":"
+GDBInfoSymbols::check_entry "${srcfile2}" "18" "mod2"
+GDBInfoSymbols::check_no_entry "${srcfile}"
+GDBInfoSymbols::check_no_entry "${srcfile2}"
+
+GDBInfoSymbols::run_command "info modules mod"
+GDBInfoSymbols::check_header \
+ "All modules matching regular expression \"mod\":"
+GDBInfoSymbols::check_entry "${srcfile2}" "18" "mod2"
+GDBInfoSymbols::check_entry "${srcfile}" "16" "mod1"
+GDBInfoSymbols::check_no_entry "${srcfile}"
+GDBInfoSymbols::check_no_entry "${srcfile2}"
# Test 'info module functions'.
-gdb_test "info module functions" \
- [multi_line \
- "All functions in all modules:" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*${srcfile2}:" \
- "22:\[\t \]+void mod2::sub_m2_a\\(${integer4}, ${logical4}\\);" \
- "30:\[\t \]+${logical4} mod2::sub_m2_b\\(${real4}\\);" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*${srcfile}:" \
- "35:\[\t \]+void mod1::__copy_mod1_M1t1\\(Type m1t1, Type m1t1\\);" \
- "25:\[\t \]+void mod1::sub_m1_a\\(${integer4}\\);" \
- "31:\[\t \]+${integer4} mod1::sub_m1_b\\(void\\);" ]
-
-gdb_test "info module functions -m mod1" \
- [multi_line \
- "All functions in all modules matching regular expression \"mod1\":" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*:" \
- "35:\[\t \]+void mod1::__copy_mod1_M1t1\\(Type m1t1, Type m1t1\\);" \
- "25:\[\t \]+void mod1::sub_m1_a\\(${integer4}\\);" \
- "31:\[\t \]+${integer4} mod1::sub_m1_b\\(void\\);" ]
-
-gdb_test "info module functions -t integer" \
- [multi_line \
- "All functions with type matching regular expression \"integer\" in all modules:" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*${srcfile2}:" \
- "22:\[\t \]+void mod2::sub_m2_a\\(${integer4}, ${logical4}\\);" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*${srcfile}:" \
- "25:\[\t \]+void mod1::sub_m1_a\\(${integer4}\\);" \
- "31:\[\t \]+${integer4} mod1::sub_m1_b\\(void\\);" ]
+GDBInfoModuleSymbols::run_command "info module functions"
+GDBInfoModuleSymbols::check_header "All functions in all modules:"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "22" \
+ "void mod2::sub_m2_a\\(${integer4}, ${logical4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "30" \
+ "${logical4} mod2::sub_m2_b\\(${real4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "35" \
+ "void mod1::__copy_mod1_M1t1\\(Type m1t1, Type m1t1\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "25" \
+ "void mod1::sub_m1_a\\(${integer4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "31" \
+ "${integer4} mod1::sub_m1_b\\(void\\);"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module functions -m mod1"
+GDBInfoModuleSymbols::check_header \
+ "All functions in all modules matching regular expression \"mod1\":"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "35" \
+ "void mod1::__copy_mod1_M1t1\\(Type m1t1, Type m1t1\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "25" \
+ "void mod1::sub_m1_a\\(${integer4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "31" \
+ "${integer4} mod1::sub_m1_b\\(void\\);"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module functions -t integer"
+GDBInfoModuleSymbols::check_header \
+ "All functions with type matching regular expression \"integer\" in all modules:"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "22" \
+ "void mod2::sub_m2_a\\(${integer4}, ${logical4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "25" \
+ "void mod1::sub_m1_a\\(${integer4}\\);"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "31" \
+ "${integer4} mod1::sub_m1_b\\(void\\);"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
# Test 'info module variables'.
-gdb_test "info module variables" \
- [multi_line \
- "All variables in all modules:" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*${srcfile2}:" \
- "19:\[\t \]+${integer4} mod2::mod2_var_1;" \
- "20:\[\t \]+${real4} mod2::mod2_var_2;" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*${srcfile}:" \
- "35:\[\t \]+Type m1t1 mod1::__def_init_mod1_M1t1;" \
- "35:\[\t \]+Type __vtype_mod1_M1t1 mod1::__vtab_mod1_M1t1;" \
- "21:\[\t \]+${real4} mod1::mod1_var_1;" \
- "22:\[\t \]+${integer4} mod1::mod1_var_2;" ]
-
-gdb_test "info module variables -t real" \
- [multi_line \
- "All variables with type matching regular expression \"real\" in all modules:" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*:" \
- "20:\[\t \]+${real4} mod2::mod2_var_2;" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*:" \
- "21:\[\t \]+${real4} mod1::mod1_var_1;" ]
-
-gdb_test "info module variables -m mod2" \
- [multi_line \
- "All variables in all modules matching regular expression \"mod2\":" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*${srcfile2}:" \
- "19:\[\t \]+${integer4} mod2::mod2_var_1;" \
- "20:\[\t \]+${real4} mod2::mod2_var_2;" ]
-
-gdb_test "info module variables -m mod2 -t real" \
- [multi_line \
- "All variables with type matching regular expression \"real\"" \
- " in all modules matching regular expression \"mod2\":" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*${srcfile2}:" \
- "20:\[\t \]+${real4} mod2::mod2_var_2;" ]
-
-gdb_test "info module variables _1" \
- [multi_line \
- "All variables matching regular expression \"_1\" in all modules:" \
- "" \
- "Module \"mod2\":" \
- "" \
- "File .*:" \
- "19:\[\t \]+${integer4} mod2::mod2_var_1;" \
- "" \
- "Module \"mod1\":" \
- "" \
- "File .*:" \
- "21:\[\t \]+${real4} mod1::mod1_var_1;" ]
+GDBInfoModuleSymbols::run_command "info module variables"
+GDBInfoModuleSymbols::check_header "All variables in all modules:"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "19" \
+ "${integer4} mod2::mod2_var_1;"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "20" \
+ "${real4} mod2::mod2_var_2;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "35" \
+ "Type m1t1 mod1::__def_init_mod1_M1t1;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "35" \
+ "Type __vtype_mod1_M1t1 mod1::__vtab_mod1_M1t1;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "21" \
+ "${real4} mod1::mod1_var_1;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "22" \
+ "${integer4} mod1::mod1_var_2;"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module variables -t real"
+GDBInfoModuleSymbols::check_header \
+ "All variables with type matching regular expression \"real\" in all modules:"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "20" \
+ "${real4} mod2::mod2_var_2;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "21" \
+ "${real4} mod1::mod1_var_1;"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module variables -m mod2"
+GDBInfoModuleSymbols::check_header \
+ "All variables in all modules matching regular expression \"mod2\":"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "19" \
+ "${integer4} mod2::mod2_var_1;"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "20" \
+ "${real4} mod2::mod2_var_2;"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module variables -m mod2 -t real"
+GDBInfoModuleSymbols::check_header \
+ "All variables with type matching regular expression \"real\" in all modules matching regular expression \"mod2\":"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "20" \
+ "${real4} mod2::mod2_var_2;"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
+
+GDBInfoModuleSymbols::run_command "info module variables _1"
+GDBInfoModuleSymbols::check_header \
+ "All variables matching regular expression \"_1\" in all modules:"
+GDBInfoModuleSymbols::check_entry "${srcfile2}" "mod2" "19" \
+ "${integer4} mod2::mod2_var_1;"
+GDBInfoModuleSymbols::check_entry "${srcfile}" "mod1" "21" \
+ "${real4} mod1::mod1_var_1;"
+GDBInfoModuleSymbols::check_no_entry "${srcfile}" ".*"
+GDBInfoModuleSymbols::check_no_entry "${srcfile2}" ".*"
diff --git a/gdb/testsuite/gdb.fortran/info-types.exp b/gdb/testsuite/gdb.fortran/info-types.exp
index 324b4e0..a99ac84 100644
--- a/gdb/testsuite/gdb.fortran/info-types.exp
+++ b/gdb/testsuite/gdb.fortran/info-types.exp
@@ -16,6 +16,7 @@
# This file tests 'info types' for some Fortran types.
load_lib "fortran.exp"
+load_lib "sym-info-cmds.exp"
if { [skip_fortran_tests] } { continue }
@@ -37,6 +38,18 @@ set logical4 [fortran_logical4]
set character1 [fortran_character1]
set real4 [fortran_real4]
+GDBInfoSymbols::run_command "info types"
+GDBInfoSymbols::check_header "All defined types:"
+
+GDBInfoSymbols::check_entry "${srcfile}" "" "${character1}"
+GDBInfoSymbols::check_entry "${srcfile}" "" "${integer4}"
+GDBInfoSymbols::check_entry "${srcfile}" "" "${logical4}"
+GDBInfoSymbols::check_entry "${srcfile}" "$decimal" "Type m1t1;"
+GDBInfoSymbols::check_entry "${srcfile}" "" "${real4}"
+GDBInfoSymbols::check_entry "${srcfile}" "37" "Type s1;"
+
+return 0
+
gdb_test "info types" \
[multi_line \
"All defined types:" \
diff --git a/gdb/testsuite/lib/sym-info-cmds.exp b/gdb/testsuite/lib/sym-info-cmds.exp
new file mode 100644
index 0000000..9c2777d
--- /dev/null
+++ b/gdb/testsuite/lib/sym-info-cmds.exp
@@ -0,0 +1,507 @@
+# Copyright 2019 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# 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
+ }
+
+ # 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 { filename lineno text { 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
+ 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.
+ proc check_entry { filename module lineno text { 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
+ gdb_assert { $found_match } $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
+ }
+}