gdb/testsuite/tui: Introduce check_box_contents

[deliverable/binutils-gdb.git] / gdb / testsuite / lib / tuiterm.exp

diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 81247d5d9a45d7072f105f431a9a3608a3cf9325..0307745d879df67bae83e1f875fe9ff44d7463c1 100644 (file)
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -1,4 +1,4 @@
-# Copyright 2019 Free Software Foundation, Inc.
+# Copyright 2019-2020 Free Software Foundation, Inc.
 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -462,15 +462,25 @@ namespace eval Term {
        }
     }
 
-    # Start the TUI.  Returns 1 on success, 0 if TUI tests should be
-    # skipped.
-    proc enter_tui {} {
+    # Setup ready for starting the tui, but don't actually start it.
+    # Returns 1 on success, 0 if TUI tests should be skipped.
+    proc prepare_for_tui {} {
        if {[skip_tui_tests]} {
            return 0
        }
 
        gdb_test_no_output "set tui border-kind ascii"
        gdb_test_no_output "maint set tui-resize-message on"
+       return 1
+    }
+
+    # Start the TUI.  Returns 1 on success, 0 if TUI tests should be
+    # skipped.
+    proc enter_tui {} {
+       if {![prepare_for_tui]} {
+           return 0
+       }
+
        command "tui enable"
        return 1
     }
@@ -590,15 +600,46 @@ 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 {} {
        variable _rows
        variable _cols
-       verbose "Screen Dump ($_cols x $_rows):"
+       verbose -log "Screen Dump ($_cols x $_rows):"
        for {set y 0} {$y < $_rows} {incr y} {
            set fmt [format %5d $y]
-           verbose "$fmt [get_line $y]"
+           verbose -log "$fmt [get_line $y]"
        }
     }