Commit | Line | Data |
---|---|---|
d57cbee9 AB |
1 | # Copyright 2019 Free Software Foundation, Inc. |
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 \ | |
236 | "$_last_command: check no matches for '$filename', $lineno', and '$text'" | |
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. | |
424 | proc check_entry { filename module lineno text { testname "" } } { | |
425 | variable _entries | |
426 | variable _last_command | |
427 | ||
428 | if { $testname == "" } { | |
429 | set testname \ | |
430 | "$_last_command: check for entry '$filename', '$lineno', '$text'" | |
431 | } | |
432 | ||
433 | if { $lineno == "" } { | |
434 | set lineno "NONE" | |
435 | } | |
436 | ||
437 | set new_entries [list] | |
438 | ||
439 | set found_match 0 | |
440 | foreach entry $_entries { | |
441 | ||
442 | if {!$found_match} { | |
443 | set f [lindex $entry 0] | |
444 | set m [lindex $entry 1] | |
445 | set l [lindex $entry 2] | |
446 | set t [lindex $entry 3] | |
447 | if { [regexp -- $filename $f] \ | |
448 | && [regexp -- $module $m] \ | |
449 | && [regexp -- $lineno $l] \ | |
450 | && [regexp -- $text $t] } { | |
451 | set found_match 1 | |
452 | } else { | |
453 | lappend new_entries $entry | |
454 | } | |
455 | } else { | |
456 | lappend new_entries $entry | |
457 | } | |
458 | } | |
459 | ||
460 | set _entries $new_entries | |
461 | gdb_assert { $found_match } $testname | |
462 | } | |
463 | ||
464 | # Check that there is no entry in the _entries list matching | |
465 | # FILENAME, MODULE, LINENO, and TEXT. The LINENO and TEXT are | |
466 | # optional, and will be replaced with '.*' if missing. | |
467 | # | |
468 | # If LINENO is the empty string then it will be replaced with the | |
469 | # string NONE in order to match against missing line numbers in | |
470 | # the output of the command. | |
471 | # | |
472 | # TESTNAME is the name of the test, or a default will be built | |
473 | # from the last command run and the arguments passed here. | |
474 | # | |
475 | # This can be used after a call to check_entry to ensure that | |
476 | # there are no further matches for a particular file in the | |
477 | # output. | |
478 | proc check_no_entry { filename module { lineno ".*" } \ | |
479 | { text ".*" } { testname "" } } { | |
480 | variable _entries | |
481 | variable _last_command | |
482 | ||
483 | if { $testname == "" } { | |
484 | set testname \ | |
485 | "$_last_command: check no matches for '$filename', $lineno', and '$text'" | |
486 | } | |
487 | ||
488 | if { $lineno == "" } { | |
489 | set lineno "NONE" | |
490 | } | |
491 | ||
492 | foreach entry $_entries { | |
493 | set f [lindex $entry 0] | |
494 | set m [lindex $entry 1] | |
495 | set l [lindex $entry 2] | |
496 | set t [lindex $entry 3] | |
497 | if { [regexp -- $filename $f] \ | |
498 | && [regexp -- $module $m] \ | |
499 | && [regexp -- $lineno $l] \ | |
500 | && [regexp -- $text $t] } { | |
501 | fail $testname | |
502 | } | |
503 | } | |
504 | ||
505 | pass $testname | |
506 | } | |
507 | } |