[RFC,gdb/testsuite] Add -early pattern flag for gdb_test_multiple
Commit Message
Hi,
since you mentioned extending gdb_test_multiple functionality using new
pattern flags, I've rewritten the gdb_test_multiple part of this (
https://sourceware.org/ml/gdb-patches/2019-09/msg00221.html ) patch into
a patch that adds a '-early' pattern flag (which results in less
intrusive code changes than the previous attempt).
WDYT?
Thanks,
- Tom
[gdb/testsuite] Add -early pattern flag for gdb_test_multiple
Proc gdb_test_multiple builds up and executes a gdb_expect expression with
pattern/action clauses. The clauses are either implicit (added by
gdb_test_multiple) or explicit (passed via the gdb_test_multiple parameter
user_code).
However, there are a few implicit clauses which are inserted before the
explicit ones, making sure those take precedence.
Add an -early pattern flag for a gdb_test_multiple user_code clause to specify
that the clause needs to be inserted before any implicit clause.
Tested on x86_64-linux.
gdb/testsuite/ChangeLog:
2019-09-12 Tom de Vries <tdevries@suse.de>
* lib/gdb.exp (gdb_test_multiple): Handle -early pattern flag.
---
gdb/testsuite/lib/gdb.exp | 24 ++++++++++++++++--------
1 file changed, 16 insertions(+), 8 deletions(-)
@@ -804,37 +804,44 @@ proc gdb_test_multiple { command message user_code { prompt_regexp "" } } {
set subst_code [uplevel list $subst_code]
set processed_code ""
+ set early_processed_code ""
+ set current_list processed_code
set patterns ""
set expecting_action 0
set expecting_arg 0
foreach item $user_code subst_item $subst_code {
if { $item == "-n" || $item == "-notransfer" || $item == "-nocase" } {
- lappend processed_code $item
+ lappend $current_list $item
continue
}
if { $item == "-indices" || $item == "-re" || $item == "-ex" } {
- lappend processed_code $item
+ lappend $current_list $item
+ continue
+ }
+ if { $item == "-early" } {
+ set current_list early_processed_code
continue
}
if { $item == "-timeout" || $item == "-i" } {
set expecting_arg 1
- lappend processed_code $item
+ lappend $current_list $item
continue
}
if { $expecting_arg } {
set expecting_arg 0
- lappend processed_code $subst_item
+ lappend $current_list $subst_item
continue
}
if { $expecting_action } {
- lappend processed_code "uplevel [list $item]"
+ lappend $current_list "uplevel [list $item]"
set expecting_action 0
# Cosmetic, no effect on the list.
- append processed_code "\n"
+ append $current_list "\n"
+ set current_list processed_code
continue
}
set expecting_action 1
- lappend processed_code $subst_item
+ lappend $current_list $subst_item
if {$patterns != ""} {
append patterns "; "
}
@@ -897,7 +904,8 @@ proc gdb_test_multiple { command message user_code { prompt_regexp "" } } {
}
}
- set code {
+ set code $early_processed_code
+ append code {
-re ".*A problem internal to GDB has been detected" {
fail "$message (GDB internal error)"
gdb_internal_error_resync