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
parent
a72d0f3d69
commit
730af66356
@ -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
|
||||
|
||||
@ -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,11 +115,14 @@ namespace eval Term {
|
||||
|
||||
# Backspace.
|
||||
proc _ctl_0x08 {} {
|
||||
_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} {
|
||||
@ -110,31 +130,41 @@ namespace eval Term {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Linefeed.
|
||||
proc _ctl_0x0a {} {
|
||||
_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 {} {
|
||||
_log_cur "Carriage return" {
|
||||
variable _cur_col
|
||||
|
||||
set _cur_col 0
|
||||
}
|
||||
}
|
||||
|
||||
# Insert Character.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/ICH.html
|
||||
proc _csi_@ {args} {
|
||||
set n [_default [lindex $args 0] 1]
|
||||
|
||||
_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} {
|
||||
@ -143,87 +173,122 @@ namespace eval Term {
|
||||
incr out_x
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Up.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CUU.html
|
||||
proc _csi_A {args} {
|
||||
variable _cur_row
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_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} {
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Cursor Down ($arg)" {
|
||||
variable _cur_row
|
||||
variable _rows
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
set _cur_row [expr {min ($_cur_row + $arg, $_rows)}]
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Forward.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CUF.html
|
||||
proc _csi_C {args} {
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Cursor Forward ($arg)" {
|
||||
variable _cur_col
|
||||
variable _cols
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
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]
|
||||
|
||||
_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} {
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Cursor Next Line ($arg)" {
|
||||
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)}]
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Previous Line.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CPL.html
|
||||
proc _csi_F {args} {
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Cursor Previous Line ($arg)" {
|
||||
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)}]
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Horizontal Absolute.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CHA.html
|
||||
proc _csi_G {args} {
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Cursor Horizontal Absolute ($arg)" {
|
||||
variable _cur_col
|
||||
variable _cols
|
||||
set arg [_default [lindex $args 0] 1]
|
||||
|
||||
set _cur_col [expr {min ($arg - 1, $_cols)}]
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Position.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CUP.html
|
||||
proc _csi_H {args} {
|
||||
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 {[_default [lindex $args 0] 1] - 1}]
|
||||
set _cur_col [expr {[_default [lindex $args 1] 1] - 1}]
|
||||
|
||||
set _cur_row [expr {$row - 1}]
|
||||
set _cur_col [expr {$col - 1}]
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Horizontal Forward Tabulation.
|
||||
@ -231,23 +296,30 @@ namespace eval Term {
|
||||
# https://vt100.net/docs/vt510-rm/CHT.html
|
||||
proc _csi_I {args} {
|
||||
set n [_default [lindex $args 0] 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}]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Erase in Display.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/ED.html
|
||||
proc _csi_J {args} {
|
||||
set arg [_default [lindex $args 0] 0]
|
||||
|
||||
_log_cur "Erase in Display ($arg)" {
|
||||
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
|
||||
@ -258,15 +330,19 @@ namespace eval Term {
|
||||
_clear_lines 0 $_rows
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Erase in Line.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/EL.html
|
||||
proc _csi_K {args} {
|
||||
set arg [_default [lindex $args 0] 0]
|
||||
|
||||
_log_cur "Erase in Line ($arg)" {
|
||||
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
|
||||
@ -276,16 +352,20 @@ namespace eval Term {
|
||||
_clear_in_line 0 $_cols $_cur_row
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Delete line.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/DL.html
|
||||
proc _csi_M {args} {
|
||||
set count [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Delete line ($count)" {
|
||||
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} {
|
||||
@ -298,17 +378,21 @@ namespace eval Term {
|
||||
}
|
||||
_clear_lines $next_y $_rows
|
||||
}
|
||||
}
|
||||
|
||||
# Erase chars.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/ECH.html
|
||||
proc _csi_X {args} {
|
||||
set n [_default [lindex $args 0] 1]
|
||||
|
||||
_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} {
|
||||
@ -316,38 +400,54 @@ namespace eval Term {
|
||||
incr x
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Cursor Backward Tabulation.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/CBT.html
|
||||
proc _csi_Z {args} {
|
||||
set n [_default [lindex $args 0] 1]
|
||||
|
||||
_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]
|
||||
|
||||
_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} {
|
||||
set row [_default [lindex $args 0] 1]
|
||||
|
||||
_log_cur "Vertical Line Position Absolute ($row)" {
|
||||
variable _cur_row
|
||||
set _cur_row [expr {[_default [lindex $args 0] 1] - 1}]
|
||||
|
||||
set _cur_row [expr {$row - 1}]
|
||||
}
|
||||
}
|
||||
|
||||
# Select Graphic Rendition.
|
||||
#
|
||||
# https://vt100.net/docs/vt510-rm/SGR.html
|
||||
proc _csi_m {args} {
|
||||
_log_cur "Select Graphic Rendition ([join $args {, }])" {
|
||||
variable _attrs
|
||||
|
||||
foreach item $args {
|
||||
switch -exact -- $item {
|
||||
"" - 0 {
|
||||
@ -393,10 +493,13 @@ namespace eval Term {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Insert string at the cursor location.
|
||||
proc _insert {str} {
|
||||
verbose "INSERT <<$str>>"
|
||||
_log_cur "Inserted string '$str'" {
|
||||
_log "Inserting string '$str'"
|
||||
|
||||
variable _cur_col
|
||||
variable _cur_row
|
||||
variable _rows
|
||||
@ -405,6 +508,7 @@ namespace eval Term {
|
||||
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} {
|
||||
@ -416,6 +520,8 @@ namespace eval Term {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Initialize.
|
||||
proc _setup {rows cols} {
|
||||
@ -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\]+" {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user