aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/testsuite')
-rw-r--r--gdb/testsuite/gdb.arch/amd64-disp-step-self-call-alarm.c18
-rw-r--r--gdb/testsuite/gdb.arch/amd64-disp-step-self-call.S23
-rw-r--r--gdb/testsuite/gdb.arch/i386-disp-step-self-call-alarm.c18
-rw-r--r--gdb/testsuite/gdb.arch/i386-disp-step-self-call.S23
-rw-r--r--gdb/testsuite/gdb.base/backtrace-through-cu-nodebug.exp69
-rw-r--r--gdb/testsuite/gdb.base/break-dbg.exp12
-rw-r--r--gdb/testsuite/gdb.base/command-line-input.exp60
-rw-r--r--gdb/testsuite/gdb.base/style.exp10
-rw-r--r--gdb/testsuite/gdb.cp/static-print-quit.exp23
-rw-r--r--gdb/testsuite/gdb.multi/pending-bp.exp6
-rw-r--r--gdb/testsuite/gdb.python/py-cmd.exp8
-rw-r--r--gdb/testsuite/gdb.python/python.exp16
-rw-r--r--gdb/testsuite/gdb.reverse/i386-avx-reverse.c4
-rw-r--r--gdb/testsuite/gdb.reverse/i386-avx-reverse.exp2
-rw-r--r--gdb/testsuite/gdb.tui/main-2.exp2
-rw-r--r--gdb/testsuite/gdb.tui/tuiterm.exp46
-rw-r--r--gdb/testsuite/lib/gdb.exp11
-rw-r--r--gdb/testsuite/lib/tuiterm.exp91
18 files changed, 305 insertions, 137 deletions
diff --git a/gdb/testsuite/gdb.arch/amd64-disp-step-self-call-alarm.c b/gdb/testsuite/gdb.arch/amd64-disp-step-self-call-alarm.c
index 03b868c..0fb2904 100644
--- a/gdb/testsuite/gdb.arch/amd64-disp-step-self-call-alarm.c
+++ b/gdb/testsuite/gdb.arch/amd64-disp-step-self-call-alarm.c
@@ -16,9 +16,27 @@
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
+#include <stdlib.h>
+
+extern void test_call (void);
+
+void
+unreachable (void)
+{
+ abort ();
+}
void
setup_alarm (void)
{
alarm (300);
}
+
+int
+main ()
+{
+ setup_alarm ();
+ test_call ();
+ unreachable ();
+ return 0;
+}
diff --git a/gdb/testsuite/gdb.arch/amd64-disp-step-self-call.S b/gdb/testsuite/gdb.arch/amd64-disp-step-self-call.S
index 78a6859..20a8eb7 100644
--- a/gdb/testsuite/gdb.arch/amd64-disp-step-self-call.S
+++ b/gdb/testsuite/gdb.arch/amd64-disp-step-self-call.S
@@ -18,33 +18,12 @@
handling. */
.text
-
- .global main
-main:
- nop
-
- callq setup_alarm
-
- nop
-
-/***********************************************/
-
-/* test call/ret */
-
.global test_call
test_call:
call test_call
- nop
+ call unreachable
.global test_ret_end
test_ret_end:
nop
-/***********************************************/
-
-/* all done */
-
-done:
- mov $0,%rdi
- call exit
- hlt
.section .note.GNU-stack,"",@progbits
diff --git a/gdb/testsuite/gdb.arch/i386-disp-step-self-call-alarm.c b/gdb/testsuite/gdb.arch/i386-disp-step-self-call-alarm.c
index 03b868c..0fb2904 100644
--- a/gdb/testsuite/gdb.arch/i386-disp-step-self-call-alarm.c
+++ b/gdb/testsuite/gdb.arch/i386-disp-step-self-call-alarm.c
@@ -16,9 +16,27 @@
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
+#include <stdlib.h>
+
+extern void test_call (void);
+
+void
+unreachable (void)
+{
+ abort ();
+}
void
setup_alarm (void)
{
alarm (300);
}
+
+int
+main ()
+{
+ setup_alarm ();
+ test_call ();
+ unreachable ();
+ return 0;
+}
diff --git a/gdb/testsuite/gdb.arch/i386-disp-step-self-call.S b/gdb/testsuite/gdb.arch/i386-disp-step-self-call.S
index 466e50c..20a8eb7 100644
--- a/gdb/testsuite/gdb.arch/i386-disp-step-self-call.S
+++ b/gdb/testsuite/gdb.arch/i386-disp-step-self-call.S
@@ -18,33 +18,12 @@
handling. */
.text
-
- .global main
-main:
- nop
-
- call setup_alarm
-
- nop
-
-/***********************************************/
-
-/* test call/ret */
-
.global test_call
test_call:
call test_call
- nop
+ call unreachable
.global test_ret_end
test_ret_end:
nop
-/***********************************************/
-
-/* all done */
-
-done:
- pushl $0
- call exit
- hlt
.section .note.GNU-stack,"",@progbits
diff --git a/gdb/testsuite/gdb.base/backtrace-through-cu-nodebug.exp b/gdb/testsuite/gdb.base/backtrace-through-cu-nodebug.exp
index 53bf642..fce6d67 100644
--- a/gdb/testsuite/gdb.base/backtrace-through-cu-nodebug.exp
+++ b/gdb/testsuite/gdb.base/backtrace-through-cu-nodebug.exp
@@ -31,7 +31,7 @@ proc prepare_test {has_cfi} {
"${objcallerfile}" \
object [list {additional_flags=-fomit-frame-pointer \
-funwind-tables -fasynchronous-unwind-tables}]] != "" } {
- untested "couldn't compile with cfi"
+ untested "couldn't compile"
return false
}
} else {
@@ -41,7 +41,7 @@ proc prepare_test {has_cfi} {
object [list {additional_flags=-fomit-frame-pointer \
-fno-unwind-tables \
-fno-asynchronous-unwind-tables}]] != "" } {
- untested "couldn't compile without cfi"
+ untested "couldn't compile"
return false
}
}
@@ -54,15 +54,12 @@ proc prepare_test {has_cfi} {
clean_restart "$binfile-${extension}"
- with_test_prefix "${extension}" {
-
- if ![runto callback] then {
- fail "has_cfi=$has_cfi: Can't run to callback"
- return false
- }
- gdb_test_no_output "maint frame-unwinder disable ARCH"
- return true
+ if ![runto callback] then {
+ fail "has_cfi=$has_cfi: Can't run to callback"
+ return false
}
+ gdb_test_no_output "maint frame-unwinder disable ARCH"
+ return true
}
if {[gdb_compile "${srcdir}/${subdir}/${srcfile2}" \
@@ -72,15 +69,45 @@ if {[gdb_compile "${srcdir}/${subdir}/${srcfile2}" \
return
}
-if { [prepare_test false] } {
- gdb_test "bt" \
+proc_with_prefix no-cfi {} {
+ if { ![prepare_test false] } {
+ return
+ }
+
+ set re_msg \
+ [string_list_to_regexp \
+ "Required frame unwinder may have been disabled," \
+ " see 'maint info frame-unwinders'"]
+ set hs {[^\r\n]}
+ set re_bt_line "#0\\s+[string_to_regexp {callback ()}] $hs+"
+ set re_bt_no_filters \
[multi_line \
- "\[^\r\n\]+Required frame unwinder may have been disabled, \[^\r\n\]+" \
- "#0\\s+callback \\(\\) \[^\r\n\]+"] \
- "verify unwind fail without CFI"
+ $re_bt_line \
+ $re_msg]
+ gdb_test "bt -no-filters" \
+ $re_bt_no_filters \
+ "verify no-filters unwind fail"
+
+ # Flush frame cache to retrigger the message.
+ gdb_test "maint flush register-cache" \
+ [string_to_regexp "Register cache flushed."]
+
+ # This output may occur when we run into the message while applying the
+ # frame filters.
+ set re_bt \
+ [multi_line \
+ $hs+$re_msg \
+ $re_bt_line]
+ gdb_test "bt" \
+ "($re_bt|$re_bt_no_filters)" \
+ "verify unwind fail"
}
-if { [prepare_test true] } {
+proc_with_prefix cfi {} {
+ if { ![prepare_test true] } {
+ return
+ }
+
if { [istarget "arm*-*-*"] } {
setup_kfail backtrace/31950 *-*-*
}
@@ -89,6 +116,12 @@ if { [prepare_test true] } {
# #1 0x00000000004004e9 in caller ()
# #2 0x00000000004004cd in main () at ...
gdb_test "bt" \
- "#0 +callback $text\r\n#1 $text in caller $text\r\n#2 $text in main $text" \
- "Verify unwinding works based only on CFI information"
+ [multi_line \
+ "#0 +callback $text" \
+ "#1 $text in caller $text" \
+ "#2 $text in main $text"] \
+ "Verify unwinding works"
}
+
+no-cfi
+cfi
diff --git a/gdb/testsuite/gdb.base/break-dbg.exp b/gdb/testsuite/gdb.base/break-dbg.exp
index 3652b8e..a7c7d92 100644
--- a/gdb/testsuite/gdb.base/break-dbg.exp
+++ b/gdb/testsuite/gdb.base/break-dbg.exp
@@ -46,7 +46,17 @@ gdb_test "catch load" "^Catchpoint $decimal \\(load\\)"
gdb_test "catch unload" "^Catchpoint $decimal \\(unload\\)"
gdb_test "catch signal" "^Catchpoint $decimal \\(standard signals\\)"
-gdb_test "catch syscall" "^Catchpoint $decimal \\(any syscall\\)"
+
+set re_warning_xml_disabled \
+ [string_to_regexp \
+ [join \
+ [list \
+ "warning: Can not parse XML syscalls information;" \
+ "XML support was disabled at compile time."]]]
+gdb_test "catch syscall" \
+ [multi_line \
+ "^($re_warning_xml_disabled" \
+ ")?Catchpoint $decimal [string_to_regexp {(any syscall)}]"]
gdb_test "watch -l global_var" "\[Ww]atchpoint $decimal: -location global_var"
diff --git a/gdb/testsuite/gdb.base/command-line-input.exp b/gdb/testsuite/gdb.base/command-line-input.exp
index af228dc..9760f1a 100644
--- a/gdb/testsuite/gdb.base/command-line-input.exp
+++ b/gdb/testsuite/gdb.base/command-line-input.exp
@@ -18,19 +18,59 @@
# Test issuing a command split in multiple lines with continuation
# characters.
-gdb_exit
-gdb_start
+clean_restart
-set test "print 1\\\\n + 2"
-gdb_test_multiple "print 1\\\n + 2" $test {
- -re "^print 1\\\\\r\n \\+ 2\r\n\\\$$decimal = 3\r\n$gdb_prompt $" {
- pass $test
+set bs "\\"
+set re_bs [string_to_regexp $bs]
+set re_dollar [string_to_regexp $]
+
+set re \
+ [multi_line \
+ ^[string_to_regexp "print 1$bs"] \
+ [string_to_regexp " + 2"] \
+ "$re_dollar$decimal = 3" \
+ "$gdb_prompt $"]
+gdb_test_multiple "print 1$bs\n + 2" "print 1$bs${bs}n + 2" {
+ -re $re {
+ pass $gdb_test_name
+ }
+}
+
+set re \
+ [multi_line \
+ ^[string_to_regexp "print 1$bs"] \
+ "2" \
+ "$re_dollar$decimal = 12" \
+ "$gdb_prompt $"]
+gdb_test_multiple "print 1$bs\n2" "print 1$bs${bs}n2" {
+ -re $re {
+ pass $gdb_test_name
}
}
-set test "print 1\\\\n2"
-gdb_test_multiple "print 1\\\n2" $test {
- -re "^print 1\\\\\r\n2\r\n\\\$$decimal = 12\r\n$gdb_prompt $" {
- pass $test
+with_test_prefix "cancel multiline" {
+ send_gdb "print$bs\n 1"
+ gdb_test_multiple "" "setup" {
+ -re "print$re_bs\r\n 1" {
+ pass $gdb_test_name
+ }
+ }
+
+ send_gdb "\003"
+ gdb_test_multiple "" "cancel" {
+ -re -wrap "" {
+ pass $gdb_test_name
+ }
+ }
+
+ # Regression test for PR cli/33063.
+ gdb_test_multiple "print 2" "command after cancel" {
+ -re -wrap " = 2" {
+ pass $gdb_test_name
+ }
+ -re -wrap "" {
+ # Avoid undefined command error.
+ fail $gdb_test_name
+ }
}
}
diff --git a/gdb/testsuite/gdb.base/style.exp b/gdb/testsuite/gdb.base/style.exp
index 503671b..47efb64 100644
--- a/gdb/testsuite/gdb.base/style.exp
+++ b/gdb/testsuite/gdb.base/style.exp
@@ -859,7 +859,7 @@ proc previous_line_is_ok { str } {
# For lines that don't match this pattern, we cannot comment on
# where the style reset should occur, so lets just claim the line
# is fine.
- if { ![regexp "\\s+$::hex - $::hex is \[^\r\n\]+ in " $str] } {
+ if { ![regexp "\\s+$::hex - $::hex is \[^\r\n\]+ in \033" $str] } {
return true
}
@@ -923,8 +923,14 @@ proc test_pagination_prompt_styling {} {
}
}
+ if { $desired_width < [string length $::pagination_prompt_str] + 2 } {
+ # Avoid readline wrapping after printing the pagination prompt.
+ return
+ }
+
# Now setup the screen width.
- gdb_test_no_output "set width $desired_width"
+ gdb_test_no_output "set width $desired_width" \
+ "set width to desired width"
# Re-run 'info files'. Check that the content before any
# pagination prompt correctly disables styling.
diff --git a/gdb/testsuite/gdb.cp/static-print-quit.exp b/gdb/testsuite/gdb.cp/static-print-quit.exp
index 8e0b61d..e4bce7f 100644
--- a/gdb/testsuite/gdb.cp/static-print-quit.exp
+++ b/gdb/testsuite/gdb.cp/static-print-quit.exp
@@ -27,32 +27,17 @@ clean_restart $testfile.o
gdb_test_no_output "set width 80"
gdb_test_no_output "set height 2"
-set test "print c - <return>"
-gdb_test_multiple "print c" $test {
- -re "\\$\[0-9\]+ = \{loooooooooooooooooooooooooooooooooooooooooooooong = 0, static field = \{\r\n--Type <RET>" {
- pass $test
+gdb_test_multiple "print c" "" {
+ -re "\\$\[0-9\]+ = \{loooooooooooooooooooooooooooooooooooooooooooooong = 0, static field = \{\r\n$pagination_prompt$" {
+ pass $gdb_test_name
}
- -re "\r\n--Type <RET>" {
+ -re "\r\n$pagination_prompt$" {
# gdb-7.1 did not crash with this testcase but it had the same bug.
untested "bug does not reproduce"
return 0
}
}
-set test "print c - q <return>"
-gdb_test_multiple "" $test {
- -re " for more, q to quit, " {
- pass $test
- }
-}
-
-set test "print c - remainder"
-gdb_test_multiple "" $test {
- -re "c to continue without paging--$" {
- pass $test
- }
-}
-
gdb_test "q" ".*"
# Now the obstack is uninitialized. Exercise it.
diff --git a/gdb/testsuite/gdb.multi/pending-bp.exp b/gdb/testsuite/gdb.multi/pending-bp.exp
index 1cd1cfb..2458cd7 100644
--- a/gdb/testsuite/gdb.multi/pending-bp.exp
+++ b/gdb/testsuite/gdb.multi/pending-bp.exp
@@ -328,5 +328,7 @@ proc_with_prefix py_test_clear_thread {} {
# Run all the tests.
test_no_inf_display
test_pending_toggle
-py_test_toggle_thread
-py_test_clear_thread
+if { [allow_python_tests] } {
+ py_test_toggle_thread
+ py_test_clear_thread
+}
diff --git a/gdb/testsuite/gdb.python/py-cmd.exp b/gdb/testsuite/gdb.python/py-cmd.exp
index 5ac5712..1fa3c73 100644
--- a/gdb/testsuite/gdb.python/py-cmd.exp
+++ b/gdb/testsuite/gdb.python/py-cmd.exp
@@ -278,13 +278,7 @@ gdb_test_multiline "input multi-line-output command" \
set test "verify pagination from test_multiline"
gdb_test_multiple "test_multiline" $test {
- -re "--Type <RET>" {
- exp_continue
- }
- -re " for more, q to quit" {
- exp_continue
- }
- -re ", c to continue without paging--$" {
+ -re "$pagination_prompt$" {
pass $test
}
}
diff --git a/gdb/testsuite/gdb.python/python.exp b/gdb/testsuite/gdb.python/python.exp
index 6b2f671..96977df 100644
--- a/gdb/testsuite/gdb.python/python.exp
+++ b/gdb/testsuite/gdb.python/python.exp
@@ -152,13 +152,7 @@ gdb_test_no_output "set height $lines"
set test "verify pagination beforehand"
gdb_test_multiple "python print (\"\\n\" * $lines)" $test {
- -re "--Type <RET>" {
- exp_continue
- }
- -re " for more, q to quit" {
- exp_continue
- }
- -re ", c to continue without paging--$" {
+ -re "$pagination_prompt$" {
pass $test
}
}
@@ -168,13 +162,7 @@ gdb_test "python if gdb.execute('python print (\"\\\\n\" * $lines)', to_string=T
set test "verify pagination afterwards"
gdb_test_multiple "python print (\"\\n\" * $lines)" $test {
- -re "--Type <RET>" {
- exp_continue
- }
- -re " for more, q to quit" {
- exp_continue
- }
- -re ", c to continue without paging--$" {
+ -re "$pagination_prompt$" {
pass $test
}
}
diff --git a/gdb/testsuite/gdb.reverse/i386-avx-reverse.c b/gdb/testsuite/gdb.reverse/i386-avx-reverse.c
index a3d6427..bf6cb77 100644
--- a/gdb/testsuite/gdb.reverse/i386-avx-reverse.c
+++ b/gdb/testsuite/gdb.reverse/i386-avx-reverse.c
@@ -299,10 +299,10 @@ vpbroadcast_test ()
asm volatile ("vbroadcastss %xmm1, %xmm0");
asm volatile ("vbroadcastss %xmm1, %ymm15");
asm volatile ("vbroadcastss %0, %%ymm0" : : "m" (global_buf0));
- asm volatile ("vbroadcastss %0, %%xmm15": : "m" (dyn_buf0));
+ asm volatile ("vbroadcastss %0, %%xmm15": : "m" (*dyn_buf0));
asm volatile ("vbroadcastsd %xmm1, %ymm0");
asm volatile ("vbroadcastsd %0, %%ymm15": : "m" (global_buf0));
- asm volatile ("vbroadcastf128 %0, %%ymm0" : : "m" (dyn_buf0));
+ asm volatile ("vbroadcastf128 %0, %%ymm0" : : "m" (*dyn_buf0));
/* We have a return statement to deal with
epilogue in different compilers. */
diff --git a/gdb/testsuite/gdb.reverse/i386-avx-reverse.exp b/gdb/testsuite/gdb.reverse/i386-avx-reverse.exp
index 7e75542..fb04260 100644
--- a/gdb/testsuite/gdb.reverse/i386-avx-reverse.exp
+++ b/gdb/testsuite/gdb.reverse/i386-avx-reverse.exp
@@ -395,7 +395,7 @@ if {[record_full_function "vpbroadcast"] == true} {
test_one_register "vbroadcastf128" "ymm0" \
"0x17161514131211101716151413121110, 0x17161514131211101716151413121110"
test_one_register "vbroadcastsd" "ymm15" \
- "0x404060004040600040406000404060, 0x0"
+ "0x23222120232221202322212023222120, 0x0"
test_one_register "vbroadcastsd" "ymm0" \
"0x13121110131211101312111013121110, 0x13121110131211101312111013121110"
diff --git a/gdb/testsuite/gdb.tui/main-2.exp b/gdb/testsuite/gdb.tui/main-2.exp
index 2b0fb6b..71ad03b 100644
--- a/gdb/testsuite/gdb.tui/main-2.exp
+++ b/gdb/testsuite/gdb.tui/main-2.exp
@@ -41,7 +41,7 @@ if {![Term::enter_tui]} {
set line " return 0;"
set nr [gdb_get_line_number $line]
-set screen_line [Term::get_line_with_attrs 6]
+set screen_line [Term::get_string_with_attrs 6 1 79]
verbose -log "screen line 6: '$screen_line'"
gdb_assert { [regexp "$nr <reverse:1>$line<reverse:0>" $screen_line] } \
"highlighted line in middle of source window"
diff --git a/gdb/testsuite/gdb.tui/tuiterm.exp b/gdb/testsuite/gdb.tui/tuiterm.exp
index 9dc2402..6cd65f3 100644
--- a/gdb/testsuite/gdb.tui/tuiterm.exp
+++ b/gdb/testsuite/gdb.tui/tuiterm.exp
@@ -102,7 +102,7 @@ proc test_backspace {} {
Term::_move_cursor 1 2
- Term::_ctl_0x08
+ Term::_ctl_0x08 0
check "backspace one" {
"abcdefgh"
"ijklmnop"
@@ -111,13 +111,22 @@ proc test_backspace {} {
} 0 2
# Cursor should not move if it is already at column 0.
- Term::_ctl_0x08
+ Term::_ctl_0x08 0
check "backspace 2" {
"abcdefgh"
"ijklmnop"
"qrstuvwx"
"yz01234 "
} 0 2
+
+ # Cursor should wrap to previous line.
+ Term::_ctl_0x08 1
+ check "backspace 3" {
+ "abcdefgh"
+ "ijklmnop"
+ "qrstuvwx"
+ "yz01234 "
+ } 7 1
}
proc test_linefeed { } {
@@ -435,6 +444,30 @@ proc test_horizontal_absolute { } {
"qrstuvwx"
"yz01234 "
} 3 2
+
+ Term::_csi_G 8
+ check "cursor horizontal absolute 3" {
+ "abcdefgh"
+ "ijklmnop"
+ "qrstuvwx"
+ "yz01234 "
+ } 7 2
+
+ Term::_csi_G 9
+ check "cursor horizontal absolute 4" {
+ "abcdefgh"
+ "ijklmnop"
+ "qrstuvwx"
+ "yz01234 "
+ } 7 2
+
+ Term::_csi_`
+ check "horizontal position absolute 1" {
+ "abcdefgh"
+ "ijklmnop"
+ "qrstuvwx"
+ "yz01234 "
+ } 0 2
}
proc test_cursor_position { } {
@@ -750,6 +783,15 @@ proc test_attrs {} {
set line [Term::get_line_with_attrs 0]
gdb_assert { [regexp $re $line] } "attribute: $attr"
}
+
+ # Regression test: Check that _csi_m works without arguments.
+ setup_terminal 4 1
+ Term::_csi_m 7
+ Term::_insert "a"
+ Term::_csi_m
+ Term::_insert "a"
+ set line [Term::get_line_with_attrs 0]
+ gdb_assert { [string equal $line "<reverse:1>a<reverse:0>a "] }
}
# Run proc TEST_PROC_NAME with a "small" terminal.
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.
generated by cgit v1.1 at 2025-07-24 13:44:42 +0000