diff options
author | Tom de Vries <tdevries@suse.de> | 2022-05-08 19:47:40 +0200 |
---|---|---|
committer | Tom de Vries <tdevries@suse.de> | 2022-05-08 19:47:40 +0200 |
commit | 4a43e2435b1a24d5bd32fae7807fdba8e93b93fe (patch) | |
tree | 8e64be4e67740855ac04862e0cd1a394a21d2889 /gdb | |
parent | a1aaf801d5f0989ea0857dfd896830570603b523 (diff) | |
download | gdb-4a43e2435b1a24d5bd32fae7807fdba8e93b93fe.zip gdb-4a43e2435b1a24d5bd32fae7807fdba8e93b93fe.tar.gz gdb-4a43e2435b1a24d5bd32fae7807fdba8e93b93fe.tar.bz2 |
[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.
Diffstat (limited to 'gdb')
-rw-r--r-- | gdb/testsuite/gdb.tui/scroll.exp | 8 | ||||
-rw-r--r-- | 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 c23cd2b..f34f8fd 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 e660840..bf09413 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 |