From 3804da7e07a13c14210d79de55ebfe2318421164 Mon Sep 17 00:00:00 2001
From: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Tue, 7 Jan 2020 00:35:02 +0000
Subject: [PATCH] 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
---
 gdb/testsuite/ChangeLog       |  4 ++++
 gdb/testsuite/lib/tuiterm.exp | 31 +++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+)

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 7d8c8d0b7c..78880be484 100644
--- 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 9ac599b6f2..0307745d87 100644
--- 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 {} {
-- 
2.34.1