gdb/testsuite/tui: Introduce check_box_contents

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

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 7d8c8d0b7c5f9f831e80863c6447a3889f256866..78880be4843ae4976cb21933cd49e1a6249741a3 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2020-01-09  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+       * lib/tuiterm.exp (Term::check_box_contents): New proc.
+
 2020-01-09  Andrew Burgess  <andrew.burgess@embecosm.com>
 
        * lib/tuiterm.exp (Term::prepare_for_tui): New proc.

diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 9ac599b6f2d333cc28d06d32f743a8254c80c058..0307745d879df67bae83e1f875fe9ff44d7463c1 100644 (file)
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -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 {} {