aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/lib
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/testsuite/lib')
-rw-r--r--gdb/testsuite/lib/gdb.exp11
-rw-r--r--gdb/testsuite/lib/tuiterm.exp91
2 files changed, 88 insertions, 14 deletions
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 777d64d..8d94d6b 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -287,10 +287,13 @@ if {![info exists gdb_prompt]} {
set gdb_prompt "\\(gdb\\)"
}
-# A regexp that matches the pagination prompt.
-set pagination_prompt \
+# The pagination prompt.
+set pagination_prompt_str \
"--Type <RET> for more, q to quit, c to continue without paging--"
+# A regexp that matches the pagination prompt.
+set pagination_prompt [string_to_regexp $pagination_prompt_str]
+
# The variable fullname_syntax_POSIX is a regexp which matches a POSIX
# absolute path ie. /foo/
set fullname_syntax_POSIX {/[^\n]*/}
@@ -9990,6 +9993,10 @@ proc gdb_stdin_log_init { } {
set logfile [standard_output_file_with_gdb_instance gdb.in]
set in_file [open $logfile w]
+
+ verbose -log ""
+ verbose -log "Starting logfile: $logfile"
+ verbose -log ""
}
# Write to the file for logging gdb input.
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index a0cd199..cc8e852 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -45,9 +45,16 @@ namespace eval Term {
set orig_cur_row $_cur_row
set orig_cur_col $_cur_col
- uplevel $body
+ set code [catch {uplevel $body} result]
_log "$what, cursor: ($orig_cur_row, $orig_cur_col) -> ($_cur_row, $_cur_col)"
+
+ if { $code == 1 } {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
}
# If ARG is empty, return DEF: otherwise ARG. This is useful for
@@ -83,14 +90,40 @@ namespace eval Term {
proc _ctl_0x07 {} {
}
+ # Return 1 if tuiterm has the bw/auto_left_margin enabled.
+ proc _have_bw {} {
+ return [string equal $Term::_TERM "ansiw"]
+ }
+
# Backspace.
- proc _ctl_0x08 {} {
- _log_cur "Backspace" {
+ proc _ctl_0x08 { {bw -1} } {
+ if { $bw == -1 } {
+ set bw [_have_bw]
+ }
+ _log_cur "Backspace, bw == $bw" {
variable _cur_col
+ variable _cur_row
+ variable _cols
- if {$_cur_col > 0} {
+ if { $_cur_col > 0 } {
+ # No wrapping needed.
incr _cur_col -1
+ return
+ }
+
+ if { ! $bw } {
+ # Wrapping not enabled.
+ return
}
+
+ if { $_cur_row == 0 } {
+ # Can't wrap.
+ return
+ }
+
+ # Wrap to previous line.
+ set _cur_col [expr $_cols - 1]
+ incr _cur_row -1
}
}
@@ -155,6 +188,14 @@ namespace eval Term {
}
}
+ # Horizontal Position Absolute.
+ #
+ # https://vt100.net/docs/vt510-rm/HPA.html
+ proc _csi_` {args} {
+ # Same as Cursor Horizontal Absolute.
+ return [Term::_csi_G {*}$args]
+ }
+
# Cursor Up.
#
# https://vt100.net/docs/vt510-rm/CUU.html
@@ -251,7 +292,7 @@ namespace eval Term {
variable _cur_col
variable _cols
- set _cur_col [expr {min ($arg - 1, $_cols)}]
+ set _cur_col [expr {min ($arg, $_cols)} - 1]
}
}
@@ -597,6 +638,11 @@ namespace eval Term {
#
# https://vt100.net/docs/vt510-rm/SGR.html
proc _csi_m {args} {
+ if { [llength $args] == 0 } {
+ # Apply default.
+ set args [list 0]
+ }
+
_log_cur "Select Graphic Rendition ([join $args {, }])" {
variable _attrs
@@ -740,7 +786,7 @@ namespace eval Term {
_log "wait_for: unsupported escape"
error "unsupported escape"
}
- -re "^\x1b\\\[(\[0-9;\]*)(\[a-zA-Z@\])" {
+ -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)>>>"
@@ -844,8 +890,16 @@ namespace eval Term {
# BODY.
proc with_tuiterm {rows cols body} {
global env stty_init
+ variable _TERM
save_vars {env(TERM) env(NO_COLOR) stty_init} {
- setenv TERM ansi
+ if { [ishost *-*-*bsd*] } {
+ setenv TERM ansiw
+ } else {
+ setenv TERM ansi
+ }
+ # Save active TERM variable.
+ set Term::_TERM $env(TERM)
+
setenv NO_COLOR ""
_setup $rows $cols
@@ -955,10 +1009,10 @@ namespace eval Term {
return $res
}
- # Return the text of screen line N. Lines are 0-based. If C is given,
- # stop before column C. Columns are also zero-based. If ATTRS, annotate
- # with attributes.
- proc get_line_1 {n c attrs} {
+ # Return the text of screen line N. Lines are 0-based. Start at column
+ # X. If C is non-empty, stop before column C. Columns are also
+ # zero-based. If ATTRS, annotate with attributes.
+ proc get_string {n x c {attrs 0}} {
variable _rows
# This can happen during resizing, if the cursor seems to
# temporarily be off-screen.
@@ -970,7 +1024,6 @@ namespace eval Term {
variable _cols
variable _chars
set c [_default $c $_cols]
- set x 0
if { $attrs } {
_reset_attrs line_attrs
}
@@ -990,6 +1043,20 @@ namespace eval Term {
return $result
}
+ # Return the text of screen line N. Lines are 0-based. Start at column
+ # X. If C is non-empty, stop before column C. Columns are also
+ # zero-based. Annotate with attributes.
+ proc get_string_with_attrs { n x c } {
+ return [get_string $n $x $c 1]
+ }
+
+ # Return the text of screen line N. Lines are 0-based. If C is
+ # non-empty, stop before column C. Columns are also zero-based. If
+ # ATTRS, annotate with attributes.
+ proc get_line_1 {n c attrs} {
+ return [get_string $n 0 $c $attrs]
+ }
+
# 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.