[gdb/testsuite] Fix gdb.base/info-macros.exp with check-read1
With check-read1 we run into: ... FAIL: gdb.base/info-macros.exp: info macros info-macros.c:42 (timeout) ... Fix this by using gdb_test_lines from gdb.base/info-types.exp.tcl. Tested on x86_64-linux. gdb/testsuite/ChangeLog: 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.
This commit is contained in:
Tom de Vries
parent
58f076c6f8
commit
c3cfd9eb5b
4 changed files with 91 additions and 85 deletions
|
|
@ -1,3 +1,9 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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 } {
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue