-# Copyright 2019 Free Software Foundation, Inc.
+# Copyright 2019-2020 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
variable _last_char
+ variable _resize_count
+
# If ARG is empty, return DEF: otherwise ARG. This is useful for
# defaulting arguments in CSIs.
proc _default {arg def} {
}
}
+ # Backward tab stops.
+ proc _csi_Z {args} {
+ set n [_default [lindex $args 0] 1]
+ variable _cur_x
+ set _cur_x [expr {max (int (($_cur_x - 1) / 8) * 8 - ($n - 1) * 8, 0)}]
+ }
+
# Repeat.
proc _csi_b {args} {
variable _last_char
variable _cur_x
variable _cur_y
variable _attrs
+ variable _resize_count
set _rows $rows
set _cols $cols
set _cur_x 0
set _cur_y 0
+ set _resize_count 0
array set _attrs {
intensity normal
fg default
}
# Accept some output from gdb and update the screen.
- proc _accept {} {
+ proc _accept {wait_for} {
global expect_out
- gdb_expect {
- -re "^\[\x07\x08\x0a\x0d\]" {
- scan $expect_out(0,string) %c val
- set hexval [format "%02x" $val]
- verbose "+++ _ctl_0x${hexval}"
- _ctl_0x${hexval}
- exp_continue
- }
- -re "^\x1b(\[0-9a-zA-Z\])" {
- verbose "+++ unsupported escape"
- error "unsupported escape"
- }
- -re "^\x1b\\\[(\[0-9;\]*)(\[0-9a-zA-Z@\])" {
- set cmd $expect_out(2,string)
- set params [split $expect_out(1,string) ";"]
- verbose "+++ _csi_$cmd <<<$expect_out(1,string)>>>"
- eval _csi_$cmd $params
- exp_continue
+ global gdb_prompt
+ variable _cur_x
+ variable _cur_y
+
+ 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]
+ verbose "+++ _ctl_0x${hexval}"
+ _ctl_0x${hexval}
+ }
+ -re "^\x1b(\[0-9a-zA-Z\])" {
+ verbose "+++ 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)>>>"
+ 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
+ }
}
- -re "^\[^\x07\x08\x0a\x0d\x1b\]+" {
- _insert $expect_out(0,string)
- variable _last_char
- set _last_char [string index $expect_out(0,string) end]
- # If the prompt was just inserted, return.
- variable _cur_x
- variable _cur_y
- global gdb_prompt
+
+ # If the cursor appears just after the prompt, return. It
+ # isn't reliable to check this only after an insertion,
+ # because curses may make "unusual" redrawing decisions.
+ if {$wait_for == "$prompt_wait_for"} {
set prev [get_line $_cur_y $_cur_x]
- if {![regexp -- "$gdb_prompt \$" $prev]} {
- exp_continue
+ } else {
+ set prev [get_line $_cur_y]
+ }
+ if {[regexp -- $wait_for $prev]} {
+ if {$wait_for == "$prompt_wait_for"} {
+ break
}
+ set wait_for $prompt_wait_for
}
}
}
}
}
+ # Setup ready for starting the tui, but don't actually start it.
+ # Returns 1 on success, 0 if TUI tests should be skipped.
+ proc prepare_for_tui {} {
+ if {[skip_tui_tests]} {
+ return 0
+ }
+
+ gdb_test_no_output "set tui border-kind ascii"
+ gdb_test_no_output "maint set tui-resize-message on"
+ return 1
+ }
+
# Start the TUI. Returns 1 on success, 0 if TUI tests should be
# skipped.
proc enter_tui {} {
- if {[skip_tui_tests]} {
+ if {![prepare_for_tui]} {
return 0
}
- gdb_test_no_output "set tui border-kind ascii"
command "tui enable"
return 1
}
# be supplied by this function.
proc command {cmd} {
send_gdb "$cmd\n"
- _accept
+ _accept [string_to_regexp $cmd]
}
# Return the text of screen line N, without attributes. Lines are
# 0-based. If C is given, stop before column C. Columns are also
# zero-based.
proc get_line {n {c ""}} {
+ variable _rows
+ # This can happen during resizing, if the cursor seems to
+ # temporarily be off-screen.
+ if {$n >= $_rows} {
+ return ""
+ }
+
set result ""
variable _cols
variable _chars
return "lr corner"
}
- for {set i [expr {$x + 1}]} {$i < $x2 - 1} {incr i} {
- # Note we do not check the top border of the box, because
- # it will contain a title.
- if {[get_char $i $y2] != "-"} {
- return "bottom border $i"
- }
- }
+ # Note we do not check the horizonal borders of the box. The
+ # top will contain a title, and the bottom may as well, if it
+ # is overlapped by some other border.
for {set i [expr {$y + 1}]} {$i < $y2 - 1} {incr i} {
if {[get_char $x $i] != "|"} {
return "left side $i"
}
}
+ # Check the contents of a box on the screen. This is a little
+ # like check_contents, but doens't check the whole screen
+ # contents, only the contents of a single box. This procedure
+ # includes (effectively) a call to check_box to ensure there is a
+ # box where expected, if there is then the contents of the box are
+ # matched against REGEXP.
+ proc check_box_contents {test_name x y width height regexp} {
+ variable _chars
+
+ set why [_check_box $x $y $width $height]
+ if {$why != ""} {
+ dump_screen
+ fail "$test_name (box check: $why)"
+ return
+ }
+
+ # Now grab the contents of the box, join each line together
+ # with a newline character and match against REGEXP.
+ set result ""
+ for {set yy [expr {$y + 1}]} {$yy < [expr {$y + $height - 1}]} {incr yy} {
+ for {set xx [expr {$x + 1}]} {$xx < [expr {$x + $width - 1}]} {incr xx} {
+ append result [lindex $_chars($xx,$yy) 0]
+ }
+ append result "\n"
+ }
+
+ if {![gdb_assert {[regexp -- $regexp $result]} $test_name]} {
+ dump_screen
+ }
+ }
+
# A debugging function to dump the current screen, with line
# numbers.
proc dump_screen {} {
variable _rows
- verbose "Screen Dump:"
+ variable _cols
+ verbose -log "Screen Dump ($_cols x $_rows):"
for {set y 0} {$y < $_rows} {incr y} {
set fmt [format %5d $y]
- verbose "$fmt [get_line $y]"
+ verbose -log "$fmt [get_line $y]"
}
}
# Resize the terminal.
- proc resize {rows cols} {
+ proc _do_resize {rows cols} {
variable _chars
variable _rows
variable _cols
set _chars($x,$y) $local_chars($x,$y)
}
}
+ }
+
+ proc resize {rows cols} {
+ variable _rows
+ variable _cols
+ variable _resize_count
global gdb_spawn_name
+ # expect handles each argument to stty separately. This means
+ # that gdb will see SIGWINCH twice. Rather than rely on this
+ # behavior (which, after all, could be changed), we make it
+ # explicit here. This also simplifies waiting for the redraw.
+ _do_resize $rows $_cols
+ stty rows $_rows < $gdb_spawn_name
+ # Due to the strange column resizing behavior, and because we
+ # don't care about this intermediate resize, we don't check
+ # the size here.
+ _accept "@@ resize done $_resize_count"
+ incr _resize_count
# Somehow the number of columns transmitted to gdb is one less
# than what we request from expect. We hide this weird
# details from the caller.
- stty rows $_rows columns [expr {$_cols + 1}] \
- < $gdb_spawn_name
- _accept
+ _do_resize $_rows $cols
+ stty columns [expr {$_cols + 1}] < $gdb_spawn_name
+ _accept "@@ resize done $_resize_count, size = ${_cols}x${rows}"
+ incr _resize_count
}
}
projects / deliverable / binutils-gdb.git / blobdiff