[thirdparty/binutils-gdb.git] / gdb / testsuite / lib / sym-info-cmds.exp

# 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
    }
}
Commit	Line	Data
1d506c26	1	# Copyright 2019-2024 Free Software Foundation, Inc.
d57cbee9 AB	2
	3	# This program is free software; you can redistribute it and/or modify
	4	# it under the terms of the GNU General Public License as published by
	5	# the Free Software Foundation; either version 3 of the License, or
	6	# (at your option) any later version.
	7	#
	8	# This program is distributed in the hope that it will be useful,
	9	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	# GNU General Public License for more details.
	12	#
	13	# You should have received a copy of the GNU General Public License
	14	# along with this program. If not, see <http://www.gnu.org/licenses/>.
	15
	16	# Make it easier to run the 'info modules' command (using
	17	# GDBInfoModules), and the 'info module ...' commands (using
	18	# GDBInfoModuleContents) and process the output.
	19	#
	20	# The difficulty we run into is that different versions of gFortran
	21	# include different helper modules which show up in the results. The
	22	# procedures in this library help process those parts of the output we
	23	# actually want to check, while ignoring those parts that we don't
	24	# care about.
	25	#
	26	# For each namespace GDBInfoModules and GDBInfoModuleContents, there's
	27	# a run_command proc, use this to run a command and capture the
	28	# output. Then make calls to check_header, check_entry, and
	29	# check_no_entry to ensure the output was as expected.
	30
	31	namespace eval GDBInfoSymbols {
	32
	33	# A string that is the header printed by GDB immediately after the
	34	# 'info [modules\|types\|functions\|variables]' command has been issued.
	35	variable _header
	36
	37	# A list of entries extracted from the output of the command.
	38	# Each entry is a filename, a line number, and the rest of the
	39	# text describing the entry. If an entry has no line number then
	40	# it is replaced with the text NONE.
	41	variable _entries
	42
	43	# The string that is the complete last command run.
	44	variable _last_command
	45
	46	# Add a new entry to the _entries list.
	47	proc _add_entry { filename lineno text } {
	48	variable _entries
	49
	50	set entry [list $filename $lineno $text]
	51	lappend _entries $entry
	52	}
	53
	54	# Run the 'info modules' command, passing ARGS as extra arguments
	55	# to the command. Process the output storing the results within
	56	# the variables in this namespace.
	57	#
	58	# The results of any previous call to run_command are discarded
	59	# when this is called.
	60	proc run_command { cmd { testname "" } } {
	61	global gdb_prompt
	62
	63	variable _header
	64	variable _entries
	65	variable _last_command
66
67	if {![regexp -- "^info (modules\|types\|variables\|functions)" $cmd]} {
68	perror "invalid command"
69	}
70
71	set _header ""
72	set _entries [list]
73	set _last_command $cmd
74
75	if { $testname == "" } {
76	set testname $cmd
77	}
78
79	send_gdb "$cmd\n"
80	gdb_expect {
81	-re "^$cmd\r\n" {
82	# Match the original command echoed back to us.
83	}
84	timeout {
85	fail "$testname (timeout)"
86	return 0
87	}
88	}
89
90	gdb_expect {
91	-re "^\r\n" {
92	# Found the blank line after the header, we're done
93	# parsing the header now.
94	}
95	-re "^\[ \t]*(\[^\r\n\]+)\r\n" {
96	set str $expect_out(1,string)
97	if { $_header == "" } {
98	set _header $str
99	} else {
100	set _header "$_header $str"
101	}
102	exp_continue
103	}
104	timeout {
105	fail "$testname (timeout)"
106	return 0
107	}
108	}
109
110	set current_file ""
111	gdb_expect {
112	-re "^File (\[^\r\n\]+):\r\n" {
113	set current_file $expect_out(1,string)
114	exp_continue
115	}
116	-re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
117	set lineno $expect_out(1,string)
118	set text $expect_out(2,string)
119	if { $current_file == "" } {
120	fail "$testname (missing filename)"
121	return 0
122	}
123	_add_entry $current_file $lineno $text
124	exp_continue
125	}
126	-re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
127	set lineno "NONE"
128	set text $expect_out(1,string)
129	if { $current_file == "" } {
130	fail "$testname (missing filename)"
131	return 0
132	}
133	_add_entry $current_file $lineno $text
134	exp_continue
135	}
136	-re "^\r\n" {
137	exp_continue
138	}
139	-re "^$gdb_prompt $" {
140	# All done.
141	}
142	timeout {
143	fail "$testname (timeout)"
144	return 0
145	}
146	}
147
148	pass $testname
149	return 1
150	}
151
152	# Check that the header held in _header matches PATTERN. Use
153	# TESTNAME as the name of the test, or create a suitable default
154	# test name based on the last command.
155	proc check_header { pattern { testname "" } } {
156	variable _header
157	variable _last_command
158
159	if { $testname == "" } {
160	set testname "$_last_command: check header"
161	}
162
163	gdb_assert {[regexp -- $pattern $_header]} $testname
164	}
165
5c8ff7f6 NCK	166	# Call check_entry_1 with OPTIONAL == 0.
	167	proc check_entry { filename lineno text { testname "" } } {
	168	check_entry_1 $filename $lineno $text 0 $testname
	169	}
	170
	171	# Call check_entry_1 with OPTIONAL == 1.
	172	proc check_optional_entry { filename lineno text { testname "" } } {
	173	check_entry_1 $filename $lineno $text 1 $testname
	174	}
	175
d57cbee9 AB	176	# Check that we have an entry in _entries matching FILENAME,
	177	# LINENO, and TEXT. If LINENO is the empty string it is replaced
	178	# with the string NONE in order to match a similarly missing line
	179	# number in the output of the command.
	180	#
	181	# TESTNAME is the name of the test, or a default will be created
	182	# based on the last command run and the arguments passed here.
	183	#
	184	# If a matching entry is found then it is removed from the
	185	# _entries list, this allows us to check for duplicates using the
	186	# check_no_entry call.
5c8ff7f6	187	proc check_entry_1 { filename lineno text optional testname } {
d57cbee9 AB	188	variable _entries
	189	variable _last_command
	190
	191	if { $testname == "" } {
	192	set testname \
	193	"$_last_command: check for entry '$filename', '$lineno', '$text'"
	194	}
	195
	196	if { $lineno == "" } {
	197	set lineno "NONE"
	198	}
	199
	200	set new_entries [list]
	201
	202	set found_match 0
	203	foreach entry $_entries {
	204
	205	if {!$found_match} {
	206	set f [lindex $entry 0]
	207	set l [lindex $entry 1]
	208	set t [lindex $entry 2]
	209	if { [regexp -- $filename $f] \
	210	&& [regexp -- $lineno $l] \
	211	&& [regexp -- $text $t] } {
	212	set found_match 1
	213	} else {
	214	lappend new_entries $entry
	215	}
	216	} else {
	217	lappend new_entries $entry
	218	}
	219	}
	220
	221	set _entries $new_entries
5c8ff7f6 NCK	222	if { $optional && ! $found_match } {
	223	unsupported $testname
	224	} else {
	225	gdb_assert { $found_match } $testname
	226	}
d57cbee9 AB	227	}
	228
	229	# Check that there is no entry in the _entries list matching
	230	# FILENAME, LINENO, and TEXT. The LINENO and TEXT are optional,
	231	# and will be replaced with '.*' if missing.
	232	#
	233	# If LINENO is the empty string then it will be replaced with the
	234	# string NONE in order to match against missing line numbers in
	235	# the output of the command.
	236	#
	237	# TESTNAME is the name of the test, or a default will be built
	238	# from the last command run and the arguments passed here.
	239	#
	240	# This can be used after a call to check_entry to ensure that
	241	# there are no further matches for a particular file in the
	242	# output.
	243	proc check_no_entry { filename { lineno "." } { text "." } \
	244	{ testname "" } } {
	245	variable _entries
	246	variable _last_command
	247
	248	if { $testname == "" } {
	249	set testname \
7f2d7a0d	250	"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
d57cbee9 AB	251	}
	252
	253	if { $lineno == "" } {
	254	set lineno "NONE"
	255	}
	256
	257	foreach entry $_entries {
	258	set f [lindex $entry 0]
	259	set l [lindex $entry 1]
	260	set t [lindex $entry 2]
	261	if { [regexp -- $filename $f] \
	262	&& [regexp -- $lineno $l] \
	263	&& [regexp -- $text $t] } {
	264	fail $testname
	265	}
	266	}
	267
	268	pass $testname
	269	}
	270	}
	271
	272
	273	namespace eval GDBInfoModuleSymbols {
	274
	275	# A string that is the header printed by GDB immediately after the
	276	# 'info modules (variables\|functions)' command has been issued.
	277	variable _header
	278
	279	# A list of entries extracted from the output of the command.
	280	# Each entry is a filename, a module name, a line number, and the
	281	# rest of the text describing the entry. If an entry has no line
	282	# number then it is replaced with the text NONE.
	283	variable _entries
	284
	285	# The string that is the complete last command run.
	286	variable _last_command
	287
	288	# Add a new entry to the _entries list.
	289	proc _add_entry { filename module lineno text } {
	290	variable _entries
	291
	292	set entry [list $filename $module $lineno $text]
	293	lappend _entries $entry
	294	}
	295
	296	# Run the 'info module ....' command, passing ARGS as extra
	297	# arguments to the command. Process the output storing the
	298	# results within the variables in this namespace.
	299	#
	300	# The results of any previous call to run_command are discarded
	301	# when this is called.
	302	proc run_command { cmd { testname "" } } {
	303	global gdb_prompt
	304
	305	variable _header
	306	variable _entries
	307	variable _last_command
	308
	309	if {![regexp -- "^info module (variables\|functions)" $cmd]} {
	310	perror "invalid command: '$cmd'"
	311	}
	312
	313	set _header ""
	314	set _entries [list]
315	set _last_command $cmd
316
317	if { $testname == "" } {
318	set testname $cmd
319	}
320
321	send_gdb "$cmd\n"
322	gdb_expect {
323	-re "^$cmd\r\n" {
324	# Match the original command echoed back to us.
325	}
326	timeout {
327	fail "$testname (timeout)"
328	return 0
329	}
330	}
331
332	gdb_expect {
333	-re "^\r\n" {
334	# Found the blank line after the header, we're done
335	# parsing the header now.
336	}
337	-re "^\[ \t\]*(\[^\r\n\]+)\r\n" {
338	set str $expect_out(1,string)
339	if { $_header == "" } {
340	set _header $str
341	} else {
342	set _header "$_header $str"
343	}
344	exp_continue
345	}
346	timeout {
347	fail "$testname (timeout)"
348	return 0
349	}
350	}
351
352	set current_module ""
353	set current_file ""
354	gdb_expect {
355	-re "^Module \"(\[^\"\]+)\":\r\n" {
356	set current_module $expect_out(1,string)
357	exp_continue
358	}
359	-re "^File (\[^\r\n\]+):\r\n" {
360	if { $current_module == "" } {
361	fail "$testname (missing module)"
362	return 0
363	}
364	set current_file $expect_out(1,string)
365	exp_continue
366	}
367	-re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
368	set lineno $expect_out(1,string)
369	set text $expect_out(2,string)
370	if { $current_module == "" } {
371	fail "$testname (missing module)"
372	return 0
373	}
374	if { $current_file == "" } {
375	fail "$testname (missing filename)"
376	return 0
377	}
378	_add_entry $current_file $current_module \
379	$lineno $text
380	exp_continue
381	}
382	-re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
383	set lineno "NONE"
384	set text $expect_out(1,string)
385	if { $current_module == "" } {
386	fail "$testname (missing module)"
387	return 0
388	}
389	if { $current_file == "" } {
390	fail "$testname (missing filename)"
391	return 0
392	}
393	_add_entry $current_file $current_module \
394	$lineno $text
395	exp_continue
396	}
397	-re "^\r\n" {
398	exp_continue
399	}
400	-re "^$gdb_prompt $" {
401	# All done.
402	}
403	timeout {
404	fail "$testname (timeout)"
405	return 0
406	}
407	}
408
409	pass $testname
410	return 1
411	}
412
413	# Check that the header held in _header matches PATTERN. Use
414	# TESTNAME as the name of the test, or create a suitable default
415	# test name based on the last command.
416	proc check_header { pattern { testname "" } } {
417	variable _header
418	variable _last_command
419
420	if { $testname == "" } {
421	set testname "$_last_command: check header"
422	}
423
424	gdb_assert {[regexp -- $pattern $_header]} $testname
425	}
426
427	# Check that we have an entry in _entries matching FILENAME,
428	# MODULE, LINENO, and TEXT. If LINENO is the empty string it is
429	# replaced with the string NONE in order to match a similarly
430	# missing line number in the output of the command.
431	#
432	# TESTNAME is the name of the test, or a default will be created
433	# based on the last command run and the arguments passed here.
434	#
435	# If a matching entry is found then it is removed from the
436	# _entries list, this allows us to check for duplicates using the
437	# check_no_entry call.
e12dcc50 TV	438	#
	439	# If OPTIONAL, don't generate a FAIL for a mismatch, but use UNSUPPORTED
	440	# instead.
	441	proc check_entry_1 { filename module lineno text optional testname } {
d57cbee9 AB	442	variable _entries
	443	variable _last_command
	444
	445	if { $testname == "" } {
	446	set testname \
	447	"$_last_command: check for entry '$filename', '$lineno', '$text'"
	448	}
	449
	450	if { $lineno == "" } {
	451	set lineno "NONE"
	452	}
	453
	454	set new_entries [list]
	455
	456	set found_match 0
	457	foreach entry $_entries {
	458
	459	if {!$found_match} {
	460	set f [lindex $entry 0]
	461	set m [lindex $entry 1]
	462	set l [lindex $entry 2]
	463	set t [lindex $entry 3]
	464	if { [regexp -- $filename $f] \
	465	&& [regexp -- $module $m] \
	466	&& [regexp -- $lineno $l] \
	467	&& [regexp -- $text $t] } {
	468	set found_match 1
	469	} else {
	470	lappend new_entries $entry
	471	}
	472	} else {
	473	lappend new_entries $entry
	474	}
	475	}
	476
	477	set _entries $new_entries
e12dcc50 TV	478	if { $optional && ! $found_match } {
	479	unsupported $testname
	480	} else {
	481	gdb_assert { $found_match } $testname
	482	}
	483	}
	484
	485	# Call check_entry_1 with OPTIONAL == 0.
	486	proc check_entry { filename module lineno text { testname "" } } {
	487	check_entry_1 $filename $module $lineno $text 0 $testname
	488	}
	489
	490	# Call check_entry_1 with OPTIONAL == 1.
	491	proc check_optional_entry { filename module lineno text { testname "" } } {
	492	check_entry_1 $filename $module $lineno $text 1 $testname
d57cbee9 AB	493	}
	494
	495	# Check that there is no entry in the _entries list matching
	496	# FILENAME, MODULE, LINENO, and TEXT. The LINENO and TEXT are
	497	# optional, and will be replaced with '.*' if missing.
	498	#
	499	# If LINENO is the empty string then it will be replaced with the
	500	# string NONE in order to match against missing line numbers in
	501	# the output of the command.
	502	#
	503	# TESTNAME is the name of the test, or a default will be built
	504	# from the last command run and the arguments passed here.
	505	#
	506	# This can be used after a call to check_entry to ensure that
	507	# there are no further matches for a particular file in the
	508	# output.
	509	proc check_no_entry { filename module { lineno ".*" } \
	510	{ text ".*" } { testname "" } } {
	511	variable _entries
	512	variable _last_command
	513
	514	if { $testname == "" } {
	515	set testname \
f3bce483	516	"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
d57cbee9 AB	517	}
	518
	519	if { $lineno == "" } {
	520	set lineno "NONE"
	521	}
	522
	523	foreach entry $_entries {
	524	set f [lindex $entry 0]
	525	set m [lindex $entry 1]
	526	set l [lindex $entry 2]
	527	set t [lindex $entry 3]
	528	if { [regexp -- $filename $f] \
	529	&& [regexp -- $module $m] \
	530	&& [regexp -- $lineno $l] \
	531	&& [regexp -- $text $t] } {
	532	fail $testname
	533	}
	534	}
	535
	536	pass $testname
	537	}
	538	}