diff options
Diffstat (limited to 'gdb')
| -rw-r--r-- | gdb/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.base/info-macros.exp | 6 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.base/info-types.exp.tcl | 82 | ||||
| -rw-r--r-- | gdb/testsuite/lib/gdb.exp | 82 |
4 files changed, 91 insertions, 85 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 06880fa..e2f1486 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,11 @@ 2021-06-08 Tom de Vries <tdevries@suse.de> + * gdb.base/info-types.exp.tcl (match_line, gdb_test_lines): Move ... + * lib/gdb.exp: ... here. + * gdb.base/info-macros.exp: Use gdb_test_lines. + +2021-06-08 Tom de Vries <tdevries@suse.de> + * gdb.base/info-types.exp.tcl (match_line): Handle --any. (gdb_test_lines): Factor out of ... (run_test): ... here. diff --git a/gdb/testsuite/gdb.base/info-macros.exp b/gdb/testsuite/gdb.base/info-macros.exp index c75229f..3d096a3 100644 --- a/gdb/testsuite/gdb.base/info-macros.exp +++ b/gdb/testsuite/gdb.base/info-macros.exp @@ -273,6 +273,6 @@ gdb_test_multiple_with_read1_timeout_factor 10 "$test" $testname { set test "info macros info-macros.c:42" -set r1 ".*define DEF_MACROS" -set r2 ".*define ONE" -gdb_test "$test" "$r1$r2.*" +set r1 "#define DEF_MACROS" +set r2 "#define ONE" +gdb_test_lines "$test" "" [list $r1 "--any" $r2] diff --git a/gdb/testsuite/gdb.base/info-types.exp.tcl b/gdb/testsuite/gdb.base/info-types.exp.tcl index eef4b07..c820adc 100644 --- a/gdb/testsuite/gdb.base/info-types.exp.tcl +++ b/gdb/testsuite/gdb.base/info-types.exp.tcl @@ -16,88 +16,6 @@ # Check that 'info types' produces the expected output for an inferior # containing a number of different types. -# Match LINE against regexp OUTPUT_LINES[IDX]. Helper function for -# gdb_test_lines. -proc match_line { line output_lines idx_name } { - upvar $idx_name idx - - while { 1 } { - if { $idx == [llength $output_lines] } { - # Ran out of regexps, bail out. - return -1 - } - - set re [lindex $output_lines $idx] - set opt 0 - set any 0 - if { $re == "--optional" } { - # Optional, get actual regexp. - set opt 1 - incr idx - set re [lindex $output_lines $idx] - } elseif { $re == "--any" } { - set any 1 - incr idx - set re [lindex $output_lines $idx] - } - - if { [regexp $re $line] } { - # Match. - incr idx - if { $idx == [llength $output_lines] } { - # Last match, we're done. - return 1 - } - # Match found, keep looking for next match. - return 0 - } else { - # No match. - if { $idx == 0 } { - # First match not found, just keep looking for first match. - return 0 - } elseif { $opt } { - # Try next regexp on same line. - incr idx - continue - } elseif { $any } { - # Try again with next line. - incr idx -1 - return 0 - } else { - # Mismatch, bail out. - return -1 - } - } - break - } - - # Keep going. - return 0 -} - -# Match output of COMMAND line-by-line, using PATTERNS. -# Report pass/fail with MESSAGE. - -proc gdb_test_lines { command message patterns } { - set found 0 - set idx 0 - if { $message == ""} { - set message $command - } - gdb_test_multiple $command $message { - -re "\r\n(\[^\r\n\]*)(?=\r\n)" { - if { $found == 0 } { - set line $expect_out(1,string) - set found [match_line $line $patterns idx] - } - exp_continue - } - -re -wrap "" { - gdb_assert { $found == 1 } $gdb_test_name - } - } -} - # Run 'info types' test, compiling the test file for language LANG, # which should be either 'c' or 'c++'. proc run_test { lang } { diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index f6686e1..f7ab219 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -1432,6 +1432,88 @@ proc gdb_test_sequence { args } { } +# Match LINE against regexp OUTPUT_LINES[IDX]. Helper function for +# gdb_test_lines. +proc match_line { line output_lines idx_name } { + upvar $idx_name idx + + while { 1 } { + if { $idx == [llength $output_lines] } { + # Ran out of regexps, bail out. + return -1 + } + + set re [lindex $output_lines $idx] + set opt 0 + set any 0 + if { $re == "--optional" } { + # Optional, get actual regexp. + set opt 1 + incr idx + set re [lindex $output_lines $idx] + } elseif { $re == "--any" } { + set any 1 + incr idx + set re [lindex $output_lines $idx] + } + + if { [regexp $re $line] } { + # Match. + incr idx + if { $idx == [llength $output_lines] } { + # Last match, we're done. + return 1 + } + # Match found, keep looking for next match. + return 0 + } else { + # No match. + if { $idx == 0 } { + # First match not found, just keep looking for first match. + return 0 + } elseif { $opt } { + # Try next regexp on same line. + incr idx + continue + } elseif { $any } { + # Try again with next line. + incr idx -1 + return 0 + } else { + # Mismatch, bail out. + return -1 + } + } + break + } + + # Keep going. + return 0 +} + +# Match output of COMMAND line-by-line, using PATTERNS. +# Report pass/fail with MESSAGE. + +proc gdb_test_lines { command message patterns } { + set found 0 + set idx 0 + if { $message == ""} { + set message $command + } + gdb_test_multiple $command $message { + -re "\r\n(\[^\r\n\]*)(?=\r\n)" { + if { $found == 0 } { + set line $expect_out(1,string) + set found [match_line $line $patterns idx] + } + exp_continue + } + -re -wrap "" { + gdb_assert { $found == 1 } $gdb_test_name + } + } +} + # Test that a command gives an error. For pass or fail, return # a 1 to indicate that more tests can proceed. However a timeout # is a serious error, generates a special fail message, and causes |