gdb/testsuite: improve logging in lib/tuiterm.exp

Here's a bonus patch that applies on top of the other two.

While debugging TUI test cases, it's hard to know what exactly is
happening in the little mind of the terminal emulator.  Add some logging
for all input processing.  Right now I'm interested in seeing what
happens to the cursor position, so made it so all operations log the
"before" and "after" cursor position.  It should help see if any
operation is not behaving as expected, w.r.t. the cursor position.

Here are some examples of the logging found in gdb.log with this patch
applied:

    +++ Inserting string '+|'
    +++   Inserted char '+', cursor: (0, 79) -> (1, 0)
    +++   Inserted char '|', cursor: (1, 0) -> (1, 1)
    +++ Inserted string '+|', cursor: (0, 79) -> (1, 1)
    +++ Cursor Horizontal Absolute (80), cursor: (1, 1) -> (1, 79)

In the last line, note that the argument is 80 and we move to 79, that's
because the position in the argument to the control sequence is 1-based,
while our indexing is 0-based.

gdb/testsuite/ChangeLog:

	* lib/tuiterm.exp (_log, _log_cur): New, use throughout.

Change-Id: Ibf570d4b2867729ce65bea8c193343a8a846170d
This commit is contained in:
Simon Marchi 2021-01-21 14:03:51 -05:00
parent a72d0f3d69
commit 730af66356
2 changed files with 281 additions and 171 deletions

View File

@ -1,3 +1,7 @@
2021-01-21 Simon Marchi <simon.marchi@polymtl.ca>
* lib/tuiterm.exp (_log, _log_cur): New, use throughout.
2021-01-21 Hannes Domani <ssbssa@yahoo.de>
PR python/19151

View File

@ -63,6 +63,23 @@ namespace eval Term {
variable _resize_count
proc _log { what } {
verbose -log "+++ $what"
}
# Call BODY, then log WHAT along with the original and new cursor position.
proc _log_cur { what body } {
variable _cur_row
variable _cur_col
set orig_cur_row $_cur_row
set orig_cur_col $_cur_col
uplevel $body
_log "$what, cursor: ($orig_cur_row, $orig_cur_col) -> ($_cur_row, $_cur_col)"
}
# If ARG is empty, return DEF: otherwise ARG. This is useful for
# defaulting arguments in CSIs.
proc _default {arg def} {
@ -98,33 +115,43 @@ namespace eval Term {
# Backspace.
proc _ctl_0x08 {} {
variable _cur_col
incr _cur_col -1
if {$_cur_col < 0} {
variable _cur_row
variable _cols
set _cur_col [expr {$_cols - 1}]
incr _cur_row -1
if {$_cur_row < 0} {
set _cur_row 0
_log_cur "Backspace" {
variable _cur_col
incr _cur_col -1
if {$_cur_col < 0} {
variable _cur_row
variable _cols
set _cur_col [expr {$_cols - 1}]
incr _cur_row -1
if {$_cur_row < 0} {
set _cur_row 0
}
}
}
}
# Linefeed.
proc _ctl_0x0a {} {
variable _cur_row
variable _rows
incr _cur_row 1
if {$_cur_row >= $_rows} {
error "FIXME scroll"
_log_cur "Line feed" {
variable _cur_row
variable _rows
incr _cur_row 1
if {$_cur_row >= $_rows} {
error "FIXME scroll"
}
}
}
# Carriage return.
proc _ctl_0x0d {} {
variable _cur_col
set _cur_col 0
_log_cur "Carriage return" {
variable _cur_col
set _cur_col 0
}
}
# Insert Character.
@ -132,15 +159,19 @@ namespace eval Term {
# https://vt100.net/docs/vt510-rm/ICH.html
proc _csi_@ {args} {
set n [_default [lindex $args 0] 1]
variable _cur_col
variable _cur_row
variable _chars
set in_x $_cur_col
set out_x [expr {$_cur_col + $n}]
for {set i 0} {$i < $n} {incr i} {
set _chars($out_x,$_cur_row) $_chars($in_x,$_cur_row)
incr in_x
incr out_x
_log_cur "Insert Character ($n)" {
variable _cur_col
variable _cur_row
variable _chars
set in_x $_cur_col
set out_x [expr {$_cur_col + $n}]
for {set i 0} {$i < $n} {incr i} {
set _chars($out_x,$_cur_row) $_chars($in_x,$_cur_row)
incr in_x
incr out_x
}
}
}
@ -148,82 +179,116 @@ namespace eval Term {
#
# https://vt100.net/docs/vt510-rm/CUU.html
proc _csi_A {args} {
variable _cur_row
set arg [_default [lindex $args 0] 1]
set _cur_row [expr {max ($_cur_row - $arg, 0)}]
_log_cur "Cursor Up ($arg)" {
variable _cur_row
set _cur_row [expr {max ($_cur_row - $arg, 0)}]
}
}
# Cursor Down.
#
# https://vt100.net/docs/vt510-rm/CUD.html
proc _csi_B {args} {
variable _cur_row
variable _rows
set arg [_default [lindex $args 0] 1]
set _cur_row [expr {min ($_cur_row + $arg, $_rows)}]
_log_cur "Cursor Down ($arg)" {
variable _cur_row
variable _rows
set _cur_row [expr {min ($_cur_row + $arg, $_rows)}]
}
}
# Cursor Forward.
#
# https://vt100.net/docs/vt510-rm/CUF.html
proc _csi_C {args} {
variable _cur_col
variable _cols
set arg [_default [lindex $args 0] 1]
set _cur_col [expr {min ($_cur_col + $arg, $_cols)}]
_log_cur "Cursor Forward ($arg)" {
variable _cur_col
variable _cols
set _cur_col [expr {min ($_cur_col + $arg, $_cols)}]
}
}
# Cursor Backward.
#
# https://vt100.net/docs/vt510-rm/CUB.html
proc _csi_D {args} {
variable _cur_col
set arg [_default [lindex $args 0] 1]
set _cur_col [expr {max ($_cur_col - $arg, 0)}]
_log_cur "Cursor Backward ($arg)" {
variable _cur_col
set _cur_col [expr {max ($_cur_col - $arg, 0)}]
}
}
# Cursor Next Line.
#
# https://vt100.net/docs/vt510-rm/CNL.html
proc _csi_E {args} {
variable _cur_col
variable _cur_row
variable _rows
set arg [_default [lindex $args 0] 1]
set _cur_col 0
set _cur_row [expr {min ($_cur_row + $arg, $_rows)}]
_log_cur "Cursor Next Line ($arg)" {
variable _cur_col
variable _cur_row
variable _rows
set _cur_col 0
set _cur_row [expr {min ($_cur_row + $arg, $_rows)}]
}
}
# Cursor Previous Line.
#
# https://vt100.net/docs/vt510-rm/CPL.html
proc _csi_F {args} {
variable _cur_col
variable _cur_row
variable _rows
set arg [_default [lindex $args 0] 1]
set _cur_col 0
set _cur_row [expr {max ($_cur_row - $arg, 0)}]
_log_cur "Cursor Previous Line ($arg)" {
variable _cur_col
variable _cur_row
variable _rows
set _cur_col 0
set _cur_row [expr {max ($_cur_row - $arg, 0)}]
}
}
# Cursor Horizontal Absolute.
#
# https://vt100.net/docs/vt510-rm/CHA.html
proc _csi_G {args} {
variable _cur_col
variable _cols
set arg [_default [lindex $args 0] 1]
set _cur_col [expr {min ($arg - 1, $_cols)}]
_log_cur "Cursor Horizontal Absolute ($arg)" {
variable _cur_col
variable _cols
set _cur_col [expr {min ($arg - 1, $_cols)}]
}
}
# Cursor Position.
#
# https://vt100.net/docs/vt510-rm/CUP.html
proc _csi_H {args} {
variable _cur_col
variable _cur_row
set _cur_row [expr {[_default [lindex $args 0] 1] - 1}]
set _cur_col [expr {[_default [lindex $args 1] 1] - 1}]
set row [_default [lindex $args 0] 1]
set col [_default [lindex $args 1] 1]
_log_cur "Cursor Position ($row, $col)" {
variable _cur_col
variable _cur_row
set _cur_row [expr {$row - 1}]
set _cur_col [expr {$col - 1}]
}
}
# Cursor Horizontal Forward Tabulation.
@ -231,11 +296,15 @@ namespace eval Term {
# https://vt100.net/docs/vt510-rm/CHT.html
proc _csi_I {args} {
set n [_default [lindex $args 0] 1]
variable _cur_col
variable _cols
incr _cur_col [expr {$n * 8 - $_cur_col % 8}]
if {$_cur_col >= $_cols} {
set _cur_col [expr {$_cols - 1}]
_log_cur "Cursor Horizontal Forward Tabulation ($n)" {
variable _cur_col
variable _cols
incr _cur_col [expr {$n * 8 - $_cur_col % 8}]
if {$_cur_col >= $_cols} {
set _cur_col [expr {$_cols - 1}]
}
}
}
@ -243,19 +312,23 @@ namespace eval Term {
#
# https://vt100.net/docs/vt510-rm/ED.html
proc _csi_J {args} {
variable _cur_col
variable _cur_row
variable _rows
variable _cols
set arg [_default [lindex $args 0] 0]
if {$arg == 0} {
_clear_in_line $_cur_col $_cols $_cur_row
_clear_lines [expr {$_cur_row + 1}] $_rows
} elseif {$arg == 1} {
_clear_lines 0 [expr {$_cur_row - 1}]
_clear_in_line 0 $_cur_col $_cur_row
} elseif {$arg == 2} {
_clear_lines 0 $_rows
_log_cur "Erase in Display ($arg)" {
variable _cur_col
variable _cur_row
variable _rows
variable _cols
if {$arg == 0} {
_clear_in_line $_cur_col $_cols $_cur_row
_clear_lines [expr {$_cur_row + 1}] $_rows
} elseif {$arg == 1} {
_clear_lines 0 [expr {$_cur_row - 1}]
_clear_in_line 0 $_cur_col $_cur_row
} elseif {$arg == 2} {
_clear_lines 0 $_rows
}
}
}
@ -263,17 +336,21 @@ namespace eval Term {
#
# https://vt100.net/docs/vt510-rm/EL.html
proc _csi_K {args} {
variable _cur_col
variable _cur_row
variable _cols
set arg [_default [lindex $args 0] 0]
if {$arg == 0} {
# From cursor to end.
_clear_in_line $_cur_col $_cols $_cur_row
} elseif {$arg == 1} {
_clear_in_line 0 $_cur_col $_cur_row
} elseif {$arg == 2} {
_clear_in_line 0 $_cols $_cur_row
_log_cur "Erase in Line ($arg)" {
variable _cur_col
variable _cur_row
variable _cols
if {$arg == 0} {
# From cursor to end.
_clear_in_line $_cur_col $_cols $_cur_row
} elseif {$arg == 1} {
_clear_in_line 0 $_cur_col $_cur_row
} elseif {$arg == 2} {
_clear_in_line 0 $_cols $_cur_row
}
}
}
@ -281,22 +358,26 @@ namespace eval Term {
#
# https://vt100.net/docs/vt510-rm/DL.html
proc _csi_M {args} {
variable _cur_row
variable _rows
variable _cols
variable _chars
set count [_default [lindex $args 0] 1]
set y $_cur_row
set next_y [expr {$y + 1}]
while {$count > 0 && $next_y < $_rows} {
for {set x 0} {$x < $_cols} {incr x} {
set _chars($x,$y) $_chars($x,$next_y)
_log_cur "Delete line ($count)" {
variable _cur_row
variable _rows
variable _cols
variable _chars
set y $_cur_row
set next_y [expr {$y + 1}]
while {$count > 0 && $next_y < $_rows} {
for {set x 0} {$x < $_cols} {incr x} {
set _chars($x,$y) $_chars($x,$next_y)
}
incr y
incr next_y
incr count -1
}
incr y
incr next_y
incr count -1
_clear_lines $next_y $_rows
}
_clear_lines $next_y $_rows
}
# Erase chars.
@ -304,16 +385,20 @@ namespace eval Term {
# https://vt100.net/docs/vt510-rm/ECH.html
proc _csi_X {args} {
set n [_default [lindex $args 0] 1]
# Erase characters but don't move cursor.
variable _cur_col
variable _cur_row
variable _attrs
variable _chars
set lattr [array get _attrs]
set x $_cur_col
for {set i 0} {$i < $n} {incr i} {
set _chars($x,$_cur_row) [list " " $lattr]
incr x
_log_cur "Erase chars ($n)" {
# Erase characters but don't move cursor.
variable _cur_col
variable _cur_row
variable _attrs
variable _chars
set lattr [array get _attrs]
set x $_cur_col
for {set i 0} {$i < $n} {incr i} {
set _chars($x,$_cur_row) [list " " $lattr]
incr x
}
}
}
@ -322,96 +407,117 @@ namespace eval Term {
# https://vt100.net/docs/vt510-rm/CBT.html
proc _csi_Z {args} {
set n [_default [lindex $args 0] 1]
variable _cur_col
set _cur_col [expr {max (int (($_cur_col - 1) / 8) * 8 - ($n - 1) * 8, 0)}]
_log_cur "Cursor Backward Tabulation ($n)" {
variable _cur_col
set _cur_col [expr {max (int (($_cur_col - 1) / 8) * 8 - ($n - 1) * 8, 0)}]
}
}
# Repeat.
#
# https://www.xfree86.org/current/ctlseqs.html (See `(REP)`)
proc _csi_b {args} {
variable _last_char
set n [_default [lindex $args 0] 1]
_insert [string repeat $_last_char $n]
_log_cur "Repeat ($n)" {
variable _last_char
_insert [string repeat $_last_char $n]
}
}
# Vertical Line Position Absolute.
#
# https://vt100.net/docs/vt510-rm/VPA.html
proc _csi_d {args} {
variable _cur_row
set _cur_row [expr {[_default [lindex $args 0] 1] - 1}]
set row [_default [lindex $args 0] 1]
_log_cur "Vertical Line Position Absolute ($row)" {
variable _cur_row
set _cur_row [expr {$row - 1}]
}
}
# Select Graphic Rendition.
#
# https://vt100.net/docs/vt510-rm/SGR.html
proc _csi_m {args} {
variable _attrs
foreach item $args {
switch -exact -- $item {
"" - 0 {
set _attrs(intensity) normal
set _attrs(fg) default
set _attrs(bg) default
set _attrs(underline) 0
set _attrs(reverse) 0
}
1 {
set _attrs(intensity) bold
}
2 {
set _attrs(intensity) dim
}
4 {
set _attrs(underline) 1
}
7 {
set _attrs(reverse) 1
}
22 {
set _attrs(intensity) normal
}
24 {
set _attrs(underline) 0
}
27 {
set _attrs(reverse) 1
}
30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 {
set _attrs(fg) $item
}
39 {
set _attrs(fg) default
}
40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 {
set _attrs(bg) $item
}
49 {
set _attrs(bg) default
}
}
_log_cur "Select Graphic Rendition ([join $args {, }])" {
variable _attrs
foreach item $args {
switch -exact -- $item {
"" - 0 {
set _attrs(intensity) normal
set _attrs(fg) default
set _attrs(bg) default
set _attrs(underline) 0
set _attrs(reverse) 0
}
1 {
set _attrs(intensity) bold
}
2 {
set _attrs(intensity) dim
}
4 {
set _attrs(underline) 1
}
7 {
set _attrs(reverse) 1
}
22 {
set _attrs(intensity) normal
}
24 {
set _attrs(underline) 0
}
27 {
set _attrs(reverse) 1
}
30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 {
set _attrs(fg) $item
}
39 {
set _attrs(fg) default
}
40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 {
set _attrs(bg) $item
}
49 {
set _attrs(bg) default
}
}
}
}
}
# Insert string at the cursor location.
proc _insert {str} {
verbose "INSERT <<$str>>"
variable _cur_col
variable _cur_row
variable _rows
variable _cols
variable _attrs
variable _chars
set lattr [array get _attrs]
foreach char [split $str {}] {
set _chars($_cur_col,$_cur_row) [list $char $lattr]
incr _cur_col
if {$_cur_col >= $_cols} {
set _cur_col 0
incr _cur_row
if {$_cur_row >= $_rows} {
error "FIXME scroll"
_log_cur "Inserted string '$str'" {
_log "Inserting string '$str'"
variable _cur_col
variable _cur_row
variable _rows
variable _cols
variable _attrs
variable _chars
set lattr [array get _attrs]
foreach char [split $str {}] {
_log_cur " Inserted char '$char'" {
set _chars($_cur_col,$_cur_row) [list $char $lattr]
incr _cur_col
if {$_cur_col >= $_cols} {
set _cur_col 0
incr _cur_row
if {$_cur_row >= $_rows} {
error "FIXME scroll"
}
}
}
}
}
@ -461,17 +567,17 @@ namespace eval Term {
-re "^\[\x07\x08\x0a\x0d\]" {
scan $expect_out(0,string) %c val
set hexval [format "%02x" $val]
verbose "+++ _ctl_0x${hexval}"
_log "wait_for: _ctl_0x${hexval}"
_ctl_0x${hexval}
}
-re "^\x1b(\[0-9a-zA-Z\])" {
verbose "+++ unsupported escape"
_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) ";"]
verbose "+++ _csi_$cmd <<<$expect_out(1,string)>>>"
_log "wait_for: _csi_$cmd <<<$expect_out(1,string)>>>"
eval _csi_$cmd $params
}
-re "^\[^\x07\x08\x0a\x0d\x1b\]+" {