[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.
This commit is contained in:
Tom de Vries
2022-05-08 19:47:40 +02:00
parent a1aaf801d5
commit 4a43e2435b
2 changed files with 74 additions and 33 deletions

View File

@ -60,7 +60,13 @@ Term::command "winheight cmd 8"
Term::check_box "src window after resize" 0 8 80 16 Term::check_box "src window after resize" 0 8 80 16
for {set i 10} {$i < 20} {incr i 1} { 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. # Now check that the contents of the command window are as expected.

View File

@ -663,11 +663,47 @@ namespace eval Term {
_clear_lines 0 $_rows _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 # 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 # a regexp matching the line to wait for. Return 0 on timeout, 1
# on success. # on success.
proc wait_for {wait_for} { proc wait_for {wait_for} {
global expect_out
global gdb_prompt global gdb_prompt
variable _cur_col variable _cur_col
variable _cur_row variable _cur_row
@ -675,34 +711,8 @@ namespace eval Term {
set prompt_wait_for "$gdb_prompt \$" set prompt_wait_for "$gdb_prompt \$"
while 1 { while 1 {
gdb_expect { if { [accept_gdb_output] == 0 } {
-re "^\[\x07\x08\x0a\x0d\]" { return 0
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 the cursor appears just after the prompt, return. It # If the cursor appears just after the prompt, return. It
@ -724,6 +734,23 @@ namespace eval Term {
return 1 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 # Like ::clean_restart, but ensures that gdb starts in an
# environment where the TUI can work. ROWS and COLS are the size # environment where the TUI can work. ROWS and COLS are the size
# of the terminal. EXECUTABLE, if given, is passed to # 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 # and HEIGHT match REGEXP. This is like check_contents except
# only part of the screen is checked. This can be used to check # 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 # the contents within a box (though check_box_contents is a better
# choice for boxes with a border). # choice for boxes with a border). Return 1 if check succeeded.
proc check_region_contents { test_name x y width height regexp } { proc check_region_contents_p { x y width height regexp } {
variable _chars variable _chars
dump_box $x $y $width $height dump_box $x $y $width $height
# Now grab the contents of the box, join each line together # Now grab the contents of the box, join each line together
# with a '\r\n' sequence and match against REGEXP. # with a '\r\n' sequence and match against REGEXP.
set result [get_region $x $y $width $height "\r\n"] 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 # Check the contents of a box on the screen. This is a little