[binutils-gdb] [gdb/testsuite] Fix gdb.tui/scroll.exp with read1

[binutils-gdb] [gdb/testsuite] Fix gdb.tui/scroll.exp with read1

[Tom de Vries]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=4a43e2435b1a24d5bd32fae7807fdba8e93b93fe

commit 4a43e2435b1a24d5bd32fae7807fdba8e93b93fe
Author: Tom de Vries <tdevries@suse.de>
Date:   Sun May 8 19:47:40 2022 +0200

    [gdb/testsuite] Fix gdb.tui/scroll.exp with read1
    
    When running test-case gdb.tui/scroll.exp, I get:
    ...
    Box Dump (80 x 8) @ (0, 0):
        0 $17 = 16
        1 (gdb) p 17
        2 $18 = 17
        3 (gdb) p 18
        4 $19 = 18
        5 (gdb) p 19
        6 $20 = 19
        7 (gdb)
    PASS: gdb.tui/scroll.exp: check cmd window in flip layout
    ...
    but with check-read1 I get instead:
    ...
    Box Dump (80 x 8) @ (0, 0):
        0 (gdb) 15
        1 (gdb) p 16
        2 $17 = 16
        3 (gdb) p 17
        4 $18 = 17
        5 (gdb) p 18
        6 $19 = 18
        7 (gdb) p 19
    FAIL: gdb.tui/scroll.exp: check cmd window in flip layout
    ...
    
    The "p 19" command is handled by Term::command, which sends the command and then
    does Term::wait_for "^$gdb_prompt [string_to_regexp $cmd]", which:
    - matches the line with "(gdb) p 19", and
    - tries to match the following prompt "(gdb) "
    
    The problem is that scrolling results in reissuing output before the "(gdb) p
    19", and the second matching triggers on that.  Consequently, wait_for no
    longer translates gdb output into screen actions, and the screen does not
    reflect the result of "p 19".
    
    Fix this by using a new proc wait_for_region_contents, which in contrast to
    wait_for can handle a multi-line regexp.
    
    Tested on x86_64-linux with make targets check and check-read1.

Diff:
---
 gdb/testsuite/gdb.tui/scroll.exp |  8 +++-
 gdb/testsuite/lib/tuiterm.exp    | 99 +++++++++++++++++++++++++++-------------
 2 files changed, 74 insertions(+), 33 deletions(-)

diff --git a/gdb/testsuite/gdb.tui/scroll.exp b/gdb/testsuite/gdb.tui/scroll.exp
index c23cd2b9abf..f34f8fddc68 100644
--- a/gdb/testsuite/gdb.tui/scroll.exp
+++ b/gdb/testsuite/gdb.tui/scroll.exp
@@ -60,7 +60,13 @@ Term::command "winheight cmd 8"
 Term::check_box "src window after resize" 0 8 80 16
 
 for {set i 10} {$i < 20} {incr i 1} {
-    Term::command "p $i"
+    set cmd "p $i"
+    send_gdb "$cmd\n"
+    Term::wait_for_region_contents 0 0 80 8 \
+	[multi_line \
+	     "$gdb_prompt [string_to_regexp $cmd]\\s+" \
+	     "\\\$\\d+ = $i\\s+" \
+	     "$gdb_prompt "]
 }
 
 # Now check that the contents of the command window are as expected.
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index e660840eed9..bf094131eac 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -663,11 +663,47 @@ namespace eval Term {
 	_clear_lines 0 $_rows
     }
 
+    # Accept some output from gdb and update the screen.
+    # Return 1 if successful, or 0 if a timeout occurred.
+    proc accept_gdb_output { } {
+	global expect_out
+	gdb_expect {
+	    -re "^\[\x07\x08\x0a\x0d\]" {
+		scan $expect_out(0,string) %c val
+		set hexval [format "%02x" $val]
+		_log "wait_for: _ctl_0x${hexval}"
+		_ctl_0x${hexval}
+	    }
+	    -re "^\x1b(\[0-9a-zA-Z\])" {
+		_log "wait_for: unsupported escape"
+		error "unsupported escape"
+	    }
+	    -re "^\x1b\\\[(\[0-9;\]*)(\[a-zA-Z@\])" {
+		set cmd $expect_out(2,string)
+		set params [split $expect_out(1,string) ";"]
+		_log "wait_for: _csi_$cmd <<<$expect_out(1,string)>>>"
+		eval _csi_$cmd $params
+	    }
+	    -re "^\[^\x07\x08\x0a\x0d\x1b\]+" {
+		_insert $expect_out(0,string)
+		variable _last_char
+		set _last_char [string index $expect_out(0,string) end]
+	    }
+
+	    timeout {
+		# Assume a timeout means we somehow missed the
+		# expected result, and carry on.
+		return 0
+	    }
+	}
+
+	return 1
+    }
+
     # Accept some output from gdb and update the screen.  WAIT_FOR is
     # a regexp matching the line to wait for.  Return 0 on timeout, 1
     # on success.
     proc wait_for {wait_for} {
-	global expect_out
 	global gdb_prompt
 	variable _cur_col
 	variable _cur_row
@@ -675,34 +711,8 @@ namespace eval Term {
 	set prompt_wait_for "$gdb_prompt \$"
 
 	while 1 {
-	    gdb_expect {
-		-re "^\[\x07\x08\x0a\x0d\]" {
-		    scan $expect_out(0,string) %c val
-		    set hexval [format "%02x" $val]
-		    _log "wait_for: _ctl_0x${hexval}"
-		    _ctl_0x${hexval}
-		}
-		-re "^\x1b(\[0-9a-zA-Z\])" {
-		    _log "wait_for: unsupported escape"
-		    error "unsupported escape"
-		}
-		-re "^\x1b\\\[(\[0-9;\]*)(\[a-zA-Z@\])" {
-		    set cmd $expect_out(2,string)
-		    set params [split $expect_out(1,string) ";"]
-		    _log "wait_for: _csi_$cmd <<<$expect_out(1,string)>>>"
-		    eval _csi_$cmd $params
-		}
-		-re "^\[^\x07\x08\x0a\x0d\x1b\]+" {
-		    _insert $expect_out(0,string)
-		    variable _last_char
-		    set _last_char [string index $expect_out(0,string) end]
-		}
-
-		timeout {
-		    # Assume a timeout means we somehow missed the
-		    # expected result, and carry on.
-		    return 0
-		}
+	    if { [accept_gdb_output] == 0 } {
+		return 0
 	    }
 
 	    # If the cursor appears just after the prompt, return.  It
@@ -724,6 +734,23 @@ namespace eval Term {
 	return 1
     }
 
+    # Accept some output from gdb and update the screen.  Wait for the screen
+    # region X/Y/WIDTH/HEIGTH to matches REGEXP.  Return 0 on timeout, 1 on
+    # success.
+    proc wait_for_region_contents {x y width height regexp} {
+	while 1 {
+	    if { [accept_gdb_output] == 0 } {
+		return 0
+	    }
+
+	    if { [check_region_contents_p $x $y $width $height $regexp] } {
+		break
+	    }
+	}
+
+	return 1
+    }
+
     # Like ::clean_restart, but ensures that gdb starts in an
     # environment where the TUI can work.  ROWS and COLS are the size
     # of the terminal.  EXECUTABLE, if given, is passed to
@@ -940,15 +967,23 @@ namespace eval Term {
     # and HEIGHT match REGEXP.  This is like check_contents except
     # only part of the screen is checked.  This can be used to check
     # the contents within a box (though check_box_contents is a better
-    # choice for boxes with a border).
-    proc check_region_contents { test_name x y width height regexp } {
+    # choice for boxes with a border).  Return 1 if check succeeded.
+    proc check_region_contents_p { x y width height regexp } {
 	variable _chars
 	dump_box $x $y $width $height
 
 	# Now grab the contents of the box, join each line together
 	# with a '\r\n' sequence and match against REGEXP.
 	set result [get_region $x $y $width $height "\r\n"]
-	gdb_assert {[regexp -- $regexp $result]} $test_name
+	return [regexp -- $regexp $result]
+    }
+
+    # Check that the region of the screen described by X, Y, WIDTH,
+    # and HEIGHT match REGEXP.  As check_region_contents_p, but produce
+    # a pass/fail message.
+    proc check_region_contents { test_name x y width height regexp } {
+	set ok [check_region_contents_p $x $y $width $height $regexp]
+	gdb_assert {$ok} $test_name
     }
 
     # Check the contents of a box on the screen.  This is a little