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

# Copyright 2019-2021 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.
    #
    # 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
3666a048	1	# Copyright 2019-2021 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
166	# Check that we have an entry in _entries matching FILENAME,
167	# LINENO, and TEXT. If LINENO is the empty string it is replaced
168	# with the string NONE in order to match a similarly missing line
169	# number in the output of the command.
170	#
171	# TESTNAME is the name of the test, or a default will be created
172	# based on the last command run and the arguments passed here.
173	#
174	# If a matching entry is found then it is removed from the
175	# _entries list, this allows us to check for duplicates using the
176	# check_no_entry call.
177	proc check_entry { filename lineno text { testname "" } } {
178	variable _entries
179	variable _last_command
180
181	if { $testname == "" } {
182	set testname \
183	"$_last_command: check for entry '$filename', '$lineno', '$text'"
184	}
185
186	if { $lineno == "" } {
187	set lineno "NONE"
188	}
189
190	set new_entries [list]
191
192	set found_match 0
193	foreach entry $_entries {
194
195	if {!$found_match} {
196	set f [lindex $entry 0]
197	set l [lindex $entry 1]
198	set t [lindex $entry 2]
199	if { [regexp -- $filename $f] \
200	&& [regexp -- $lineno $l] \
201	&& [regexp -- $text $t] } {
202	set found_match 1
203	} else {
204	lappend new_entries $entry
205	}
206	} else {
207	lappend new_entries $entry
208	}
209	}
210
211	set _entries $new_entries
212	gdb_assert { $found_match } $testname
213	}
214
215	# Check that there is no entry in the _entries list matching
216	# FILENAME, LINENO, and TEXT. The LINENO and TEXT are optional,
217	# and will be replaced with '.*' if missing.
218	#
219	# If LINENO is the empty string then it will be replaced with the
220	# string NONE in order to match against missing line numbers in
221	# the output of the command.
222	#
223	# TESTNAME is the name of the test, or a default will be built
224	# from the last command run and the arguments passed here.
225	#
226	# This can be used after a call to check_entry to ensure that
227	# there are no further matches for a particular file in the
228	# output.
229	proc check_no_entry { filename { lineno "." } { text "." } \
230	{ testname "" } } {
231	variable _entries
232	variable _last_command
233
234	if { $testname == "" } {
235	set testname \
7f2d7a0d	236	"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
d57cbee9 AB	237	}
	238
	239	if { $lineno == "" } {
	240	set lineno "NONE"
	241	}
	242
	243	foreach entry $_entries {
	244	set f [lindex $entry 0]
	245	set l [lindex $entry 1]
	246	set t [lindex $entry 2]
	247	if { [regexp -- $filename $f] \
	248	&& [regexp -- $lineno $l] \
	249	&& [regexp -- $text $t] } {
	250	fail $testname
	251	}
	252	}
	253
	254	pass $testname
	255	}
	256	}
	257
	258
	259	namespace eval GDBInfoModuleSymbols {
	260
	261	# A string that is the header printed by GDB immediately after the
	262	# 'info modules (variables\|functions)' command has been issued.
	263	variable _header
	264
	265	# A list of entries extracted from the output of the command.
	266	# Each entry is a filename, a module name, a line number, and the
	267	# rest of the text describing the entry. If an entry has no line
	268	# number then it is replaced with the text NONE.
	269	variable _entries
	270
	271	# The string that is the complete last command run.
	272	variable _last_command
	273
	274	# Add a new entry to the _entries list.
	275	proc _add_entry { filename module lineno text } {
	276	variable _entries
	277
	278	set entry [list $filename $module $lineno $text]
	279	lappend _entries $entry
	280	}
	281
	282	# Run the 'info module ....' command, passing ARGS as extra
	283	# arguments to the command. Process the output storing the
	284	# results within the variables in this namespace.
	285	#
	286	# The results of any previous call to run_command are discarded
	287	# when this is called.
	288	proc run_command { cmd { testname "" } } {
	289	global gdb_prompt
	290
	291	variable _header
	292	variable _entries
	293	variable _last_command
	294
	295	if {![regexp -- "^info module (variables\|functions)" $cmd]} {
	296	perror "invalid command: '$cmd'"
	297	}
	298
	299	set _header ""
	300	set _entries [list]
301	set _last_command $cmd
302
303	if { $testname == "" } {
304	set testname $cmd
305	}
306
307	send_gdb "$cmd\n"
308	gdb_expect {
309	-re "^$cmd\r\n" {
310	# Match the original command echoed back to us.
311	}
312	timeout {
313	fail "$testname (timeout)"
314	return 0
315	}
316	}
317
318	gdb_expect {
319	-re "^\r\n" {
320	# Found the blank line after the header, we're done
321	# parsing the header now.
322	}
323	-re "^\[ \t\]*(\[^\r\n\]+)\r\n" {
324	set str $expect_out(1,string)
325	if { $_header == "" } {
326	set _header $str
327	} else {
328	set _header "$_header $str"
329	}
330	exp_continue
331	}
332	timeout {
333	fail "$testname (timeout)"
334	return 0
335	}
336	}
337
338	set current_module ""
339	set current_file ""
340	gdb_expect {
341	-re "^Module \"(\[^\"\]+)\":\r\n" {
342	set current_module $expect_out(1,string)
343	exp_continue
344	}
345	-re "^File (\[^\r\n\]+):\r\n" {
346	if { $current_module == "" } {
347	fail "$testname (missing module)"
348	return 0
349	}
350	set current_file $expect_out(1,string)
351	exp_continue
352	}
353	-re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
354	set lineno $expect_out(1,string)
355	set text $expect_out(2,string)
356	if { $current_module == "" } {
357	fail "$testname (missing module)"
358	return 0
359	}
360	if { $current_file == "" } {
361	fail "$testname (missing filename)"
362	return 0
363	}
364	_add_entry $current_file $current_module \
365	$lineno $text
366	exp_continue
367	}
368	-re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
369	set lineno "NONE"
370	set text $expect_out(1,string)
371	if { $current_module == "" } {
372	fail "$testname (missing module)"
373	return 0
374	}
375	if { $current_file == "" } {
376	fail "$testname (missing filename)"
377	return 0
378	}
379	_add_entry $current_file $current_module \
380	$lineno $text
381	exp_continue
382	}
383	-re "^\r\n" {
384	exp_continue
385	}
386	-re "^$gdb_prompt $" {
387	# All done.
388	}
389	timeout {
390	fail "$testname (timeout)"
391	return 0
392	}
393	}
394
395	pass $testname
396	return 1
397	}
398
399	# Check that the header held in _header matches PATTERN. Use
400	# TESTNAME as the name of the test, or create a suitable default
401	# test name based on the last command.
402	proc check_header { pattern { testname "" } } {
403	variable _header
404	variable _last_command
405
406	if { $testname == "" } {
407	set testname "$_last_command: check header"
408	}
409
410	gdb_assert {[regexp -- $pattern $_header]} $testname
411	}
412
413	# Check that we have an entry in _entries matching FILENAME,
414	# MODULE, LINENO, and TEXT. If LINENO is the empty string it is
415	# replaced with the string NONE in order to match a similarly
416	# missing line number in the output of the command.
417	#
418	# TESTNAME is the name of the test, or a default will be created
419	# based on the last command run and the arguments passed here.
420	#
421	# If a matching entry is found then it is removed from the
422	# _entries list, this allows us to check for duplicates using the
423	# check_no_entry call.
e12dcc50 TV	424	#
	425	# If OPTIONAL, don't generate a FAIL for a mismatch, but use UNSUPPORTED
	426	# instead.
	427	proc check_entry_1 { filename module lineno text optional testname } {
d57cbee9 AB	428	variable _entries
	429	variable _last_command
	430
	431	if { $testname == "" } {
	432	set testname \
	433	"$_last_command: check for entry '$filename', '$lineno', '$text'"
	434	}
	435
	436	if { $lineno == "" } {
	437	set lineno "NONE"
	438	}
	439
	440	set new_entries [list]
	441
	442	set found_match 0
	443	foreach entry $_entries {
	444
	445	if {!$found_match} {
	446	set f [lindex $entry 0]
	447	set m [lindex $entry 1]
	448	set l [lindex $entry 2]
	449	set t [lindex $entry 3]
	450	if { [regexp -- $filename $f] \
	451	&& [regexp -- $module $m] \
	452	&& [regexp -- $lineno $l] \
	453	&& [regexp -- $text $t] } {
	454	set found_match 1
	455	} else {
	456	lappend new_entries $entry
	457	}
	458	} else {
	459	lappend new_entries $entry
	460	}
	461	}
	462
	463	set _entries $new_entries
e12dcc50 TV	464	if { $optional && ! $found_match } {
	465	unsupported $testname
	466	} else {
	467	gdb_assert { $found_match } $testname
	468	}
	469	}
	470
	471	# Call check_entry_1 with OPTIONAL == 0.
	472	proc check_entry { filename module lineno text { testname "" } } {
	473	check_entry_1 $filename $module $lineno $text 0 $testname
	474	}
	475
	476	# Call check_entry_1 with OPTIONAL == 1.
	477	proc check_optional_entry { filename module lineno text { testname "" } } {
	478	check_entry_1 $filename $module $lineno $text 1 $testname
d57cbee9 AB	479	}
	480
	481	# Check that there is no entry in the _entries list matching
	482	# FILENAME, MODULE, LINENO, and TEXT. The LINENO and TEXT are
	483	# optional, and will be replaced with '.*' if missing.
	484	#
	485	# If LINENO is the empty string then it will be replaced with the
	486	# string NONE in order to match against missing line numbers in
	487	# the output of the command.
	488	#
	489	# TESTNAME is the name of the test, or a default will be built
	490	# from the last command run and the arguments passed here.
	491	#
	492	# This can be used after a call to check_entry to ensure that
	493	# there are no further matches for a particular file in the
	494	# output.
	495	proc check_no_entry { filename module { lineno ".*" } \
	496	{ text ".*" } { testname "" } } {
	497	variable _entries
	498	variable _last_command
	499
	500	if { $testname == "" } {
	501	set testname \
f3bce483	502	"$_last_command: check no matches for '$filename', '$lineno', and '$text'"
d57cbee9 AB	503	}
	504
	505	if { $lineno == "" } {
	506	set lineno "NONE"
	507	}
	508
	509	foreach entry $_entries {
	510	set f [lindex $entry 0]
	511	set m [lindex $entry 1]
	512	set l [lindex $entry 2]
	513	set t [lindex $entry 3]
	514	if { [regexp -- $filename $f] \
	515	&& [regexp -- $module $m] \
	516	&& [regexp -- $lineno $l] \
	517	&& [regexp -- $text $t] } {
	518	fail $testname
	519	}
	520	}
	521
	522	pass $testname
	523	}
	524	}