[3/6] gdb/testsuite/tui: Introduce check_box_contents
Commit Message
A new test procedure for matching the contents of one screen box
against a regexp. This can be used to match the contents of one TUI
window against a regexp without any of the borders, or other windows
being included in the matched output (as is currently the case with
check_contents).
This will be used in a later commit.
gdb/testsuite/ChangeLog:
* lib/tuiterm.exp (Term::check_box_contents): New proc.
Change-Id: Icf795bf38dd9295e282a34eecc318a9cdbc73926
---
gdb/testsuite/ChangeLog | 4 ++++
gdb/testsuite/lib/tuiterm.exp | 31 +++++++++++++++++++++++++++++++
2 files changed, 35 insertions(+)
Comments
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> A new test procedure for matching the contents of one screen box
Andrew> against a regexp. This can be used to match the contents of one TUI
Andrew> window against a regexp without any of the borders, or other windows
Andrew> being included in the matched output (as is currently the case with
Andrew> check_contents).
Andrew> This will be used in a later commit.
Andrew> gdb/testsuite/ChangeLog:
Andrew> * lib/tuiterm.exp (Term::check_box_contents): New proc.
Thanks, this looks good.
Tom
@@ -600,6 +600,37 @@ namespace eval Term {
}
}
+ # Check the contents of a box on the screen. This is a little
+ # like check_contents, but doens't check the whole screen
+ # contents, only the contents of a single box. This procedure
+ # includes (effectively) a call to check_box to ensure there is a
+ # box where expected, if there is then the contents of the box are
+ # matched against REGEXP.
+ proc check_box_contents {test_name x y width height regexp} {
+ variable _chars
+
+ set why [_check_box $x $y $width $height]
+ if {$why != ""} {
+ dump_screen
+ fail "$test_name (box check: $why)"
+ return
+ }
+
+ # Now grab the contents of the box, join each line together
+ # with a newline character and match against REGEXP.
+ set result ""
+ for {set yy [expr {$y + 1}]} {$yy < [expr {$y + $height - 1}]} {incr yy} {
+ for {set xx [expr {$x + 1}]} {$xx < [expr {$x + $width - 1}]} {incr xx} {
+ append result [lindex $_chars($xx,$yy) 0]
+ }
+ append result "\n"
+ }
+
+ if {![gdb_assert {[regexp -- $regexp $result]} $test_name]} {
+ dump_screen
+ }
+ }
+
# A debugging function to dump the current screen, with line
# numbers.
proc dump_screen {} {