From 4a43e2435b1a24d5bd32fae7807fdba8e93b93fe Mon Sep 17 00:00:00 2001 From: Tom de Vries Date: Sun, 8 May 2022 19:47:40 +0200 Subject: [PATCH] [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. --- 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 -- 2.30.2