[PATCH v2 0/8] TUI testing

[PATCH v2 0/8] TUI testing

[Tom Tromey]

Here's v2 of the TUI testing series.

This version uses gdb_assert in almost every place that was explicitly
calling pass and fail.

Tom

[PATCH v2 8/8] Add test that "file" shows "main"

[Tom Tromey]

This adds a new test that checks that the "file" command will show the
program's "main".

2019-07-21  Tom Tromey  <tom@tromey.com>

	* gdb.tui/main.exp: New file.
---
 gdb/testsuite/ChangeLog        |  4 ++++
 gdb/testsuite/gdb.tui/main.exp | 37 ++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)
 create mode 100644 gdb/testsuite/gdb.tui/main.exp

diff --git a/gdb/testsuite/gdb.tui/main.exp b/gdb/testsuite/gdb.tui/main.exp
new file mode 100644
index 00000000000..9b950e8a52c
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/main.exp
@@ -0,0 +1,37 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Test that "file" shows "main".
+
+load_lib "tuiterm.exp"
+
+standard_testfile tui-layout.c
+
+if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
+    return -1
+}
+
+# Note: don't pass the executable here
+Term::clean_restart 24 80
+
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+Term::command "file [standard_output_file $testfile]"
+set text [Term::get_all_lines]
+if {![gdb_assert {[regexp ">|21 *return 0" $text]} "show main after file"]} {
+    Term::dump_screen
+}
-- 
2.17.2

[PATCH v2 7/8] Add test case for empty TUI windows

[Tom Tromey]

My original intent here was to add a test case to test that empty TUI
windows re-render their contents after a resize.  However, this seems
pretty broken at the moment, so a lot of the test is actually
disabled.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* lib/tuiterm.exp (Term::clean_restart): Make "executable"
	optional.
	* gdb.tui/empty.exp: New file.
---
 gdb/testsuite/ChangeLog         |   6 ++
 gdb/testsuite/gdb.tui/empty.exp | 103 ++++++++++++++++++++++++++++++++
 gdb/testsuite/lib/tuiterm.exp   |  11 +++-
 3 files changed, 117 insertions(+), 3 deletions(-)
 create mode 100644 gdb/testsuite/gdb.tui/empty.exp

diff --git a/gdb/testsuite/gdb.tui/empty.exp b/gdb/testsuite/gdb.tui/empty.exp
new file mode 100644
index 00000000000..90e26b3316e
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/empty.exp
@@ -0,0 +1,103 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Test TUI resizing with empty windows.
+
+load_lib "tuiterm.exp"
+
+standard_testfile
+
+Term::clean_restart 24 80
+
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+# Each entry describes a layout.  It has these items:
+# 1. Layout name
+# 2. Test name
+# 3. List of boxes in 80x24 mode
+# 4. List of boxes in 90x40 mode
+# 5. List of test name and text for the empty window
+set layouts {
+    {src src {{3 0 77 15}} {{3 0 87 23}}
+	{{"no source" "No Source Available"}}}
+    {regs src-regs {{0 0 80 8} {3 7 77 8}} {{0 0 90 13} {3 13 87 13}}
+	{
+	    {"no source" "No Source Available"}
+	    {"no regs" "Register Values Unavailable"}
+	}}
+    {asm asm {{3 0 77 15}} {{3 0 87 24}}
+	{"no asm" "No Assembly Available"}}
+    {regs asm-regs {{0 0 80 8} {3 7 77 9}} {{0 0 90 13} {3 13 87 14}}
+	{
+	    {"no asm" "No Assembly Available"}
+	    {"no regs" "Register Values Unavailable"}
+	}}
+    {split split {{3 0 77 8} {3 7 77 9}} {{3 0 87 14} {3 14 87 14}}
+	{
+	    {"no source" "No Source Available"}
+	    {"no asm" "No Assembly Available"}
+	}}
+    {regs split-regs {{0 0 80 8} {3 7 77 9}} {{0 0 90 13} {3 13 87 14}}
+	{
+	    {"no asm" "No Assembly Available"}
+	    {"no regs" "Register Values Unavailable"}
+	}}
+}
+
+# Helper function to verify a list of boxes.
+proc check_boxes {boxes} {
+    set boxno 1
+    foreach box $boxes {
+	if {$boxno > 1} {
+	    # The upper-left corner of the second box may not render
+	    # properly, due to overlap.
+	    setup_xfail *-*-*
+	}
+	eval Term::check_box [list "box $boxno"] $box
+	incr boxno
+    }
+}
+
+# Helper function to verify text.
+proc check_text {text_list} {
+    set text [Term::get_all_lines]
+    foreach item $text_list {
+	lassign $item testname check
+	gdb_assert {[string first $check $text]} $testname
+    }
+}
+
+foreach layout $layouts {
+    lassign $layout name testname small_boxes large_boxes text_list
+
+    with_test_prefix $testname {
+	Term::command "layout $name"
+	with_test_prefix 80x24 {
+	    check_boxes $small_boxes
+	    check_text $text_list
+	}
+
+	# FIXME: resizing is broken enough that we don't test it for
+	# now.
+	# Term::resize 40 90
+	# with_test_prefix 90x40 {
+	#     check_boxes $large_boxes
+	#     check_text $text_list
+	# }
+	# Term::resize 24 80
+    }
+}
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 3fc4fcb614a..e56e4a48952 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -392,13 +392,18 @@ namespace eval Term {
 
     # Like ::clean_restart, but ensures that gdb starts in an
     # environment where the TUI can work.  ROWS and COLS are the size
-    # of the terminal.  EXECUTABLE is passed to clean_restart.
-    proc clean_restart {rows cols executable} {
+    # of the terminal.  EXECUTABLE, if given, is passed to
+    # clean_restart.
+    proc clean_restart {rows cols {executable {}}} {
 	global env stty_init
 	save_vars {env(TERM) stty_init} {
 	    setenv TERM ansi
 	    _setup $rows $cols
-	    ::clean_restart $executable
+	    if {$executable == ""} {
+		::clean_restart
+	    } else {
+		::clean_restart $executable
+	    }
 	}
     }
 
-- 
2.17.2

[PATCH v2 5/8] Add TUI test for "list"

[Tom Tromey]

This adds a test to check that the "list" command will update the TUI
source window.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* gdb.tui/list.exp: New file.
---
 gdb/testsuite/ChangeLog        |  4 ++++
 gdb/testsuite/gdb.tui/list.exp | 40 ++++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+)
 create mode 100644 gdb/testsuite/gdb.tui/list.exp

diff --git a/gdb/testsuite/gdb.tui/list.exp b/gdb/testsuite/gdb.tui/list.exp
new file mode 100644
index 00000000000..0229b81c8a7
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/list.exp
@@ -0,0 +1,40 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Ensure that "list" will switch to the source view.
+
+load_lib "tuiterm.exp"
+
+standard_testfile tui-layout.c
+
+if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
+    return -1
+}
+
+Term::clean_restart 24 80 $testfile
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+set text [Term::get_all_lines]
+gdb_assert {[regexp "No Source Available" $text]} "initial source listing"
+
+Term::command "layout asm"
+set text [Term::get_all_lines]
+gdb_assert {[regexp "$hex <main>" $text]} "asm window shows main"
+
+Term::command "list main"
+set text [Term::get_all_lines]
+gdb_assert {[regexp "21 *return 0" $text]} "list main"
-- 
2.17.2

[PATCH v2 1/8] A virtual terminal for the test suite

[Tom Tromey]

This patch implements a simple ANSI terminal emulator for the test
suite.  It is still quite basic, but it is good enough to allow some
simple TUI testing to be done.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* lib/tuiterm.exp: New file.
	* gdb.tui/basic.exp: New file.
---
 gdb/testsuite/ChangeLog         |   5 +
 gdb/testsuite/gdb.tui/basic.exp |  42 +++
 gdb/testsuite/lib/tuiterm.exp   | 517 ++++++++++++++++++++++++++++++++
 3 files changed, 564 insertions(+)
 create mode 100644 gdb/testsuite/gdb.tui/basic.exp
 create mode 100644 gdb/testsuite/lib/tuiterm.exp

diff --git a/gdb/testsuite/gdb.tui/basic.exp b/gdb/testsuite/gdb.tui/basic.exp
new file mode 100644
index 00000000000..33ce49a1b3f
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/basic.exp
@@ -0,0 +1,42 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Basic TUI tests.
+
+load_lib "tuiterm.exp"
+
+standard_testfile tui-layout.c
+
+if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
+    return -1
+}
+
+Term::clean_restart 24 80 $testfile
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+set text [Term::get_all_lines]
+gdb_assert {![string match "No Source Available" $text]} \
+    "initial source listing"
+
+Term::command "list main"
+set text [Term::get_all_lines]
+gdb_assert {[regexp "21 *return 0" $text]} "list main"
+
+# This check fails because the file name in the title overwrites the
+# box.
+setup_xfail *-*-*
+Term::check_box "source box" 3 0 77 15
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
new file mode 100644
index 00000000000..2b0af86c48c
--- /dev/null
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -0,0 +1,517 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# An ANSI terminal emulator for expect.
+
+namespace eval Term {
+    variable _rows
+    variable _cols
+    variable _chars
+
+    variable _cur_x
+    variable _cur_y
+
+    variable _attrs
+
+    variable _last_char
+
+    # If ARG is empty, return DEF: otherwise ARG.  This is useful for
+    # defaulting arguments in CSIs.
+    proc _default {arg def} {
+	if {$arg == ""} {
+	    return $def
+	}
+	return $arg
+    }
+
+    # Erase in the line Y from SX to just before EX.
+    proc _clear_in_line {sx ex y} {
+	variable _attrs
+	variable _chars
+	set lattr [array get _attrs]
+	while {$sx < $ex} {
+	    set _chars($sx,$y) [list " " $lattr]
+	    incr sx
+	}
+    }
+
+    # Erase the lines from SY to just before EY.
+    proc _clear_lines {sy ey} {
+	variable _cols
+	while {$sy < $ey} {
+	    _clear_in_line 0 $_cols $sy
+	    incr sy
+	}
+    }
+
+    # Beep.
+    proc _ctl_0x07 {} {
+    }
+
+    # Backspace.
+    proc _ctl_0x08 {} {
+	variable _cur_x
+	incr _cur_x -1
+	if {$_cur_x < 0} {
+	    variable _cur_y
+	    variable _cols
+	    set _cur_x [expr {$_cols - 1}]
+	    incr _cur_y -1
+	    if {$_cur_y < 0} {
+		set _cur_y 0
+	    }
+	}
+    }
+
+    # Linefeed.
+    proc _ctl_0x0a {} {
+	variable _cur_y
+	variable _rows
+	incr _cur_y 1
+	if {$_cur_y >= $_rows} {
+	    error "FIXME scroll"
+	}
+    }
+
+    # Carriage return.
+    proc _ctl_0x0d {} {
+	variable _cur_x
+	set _cur_x 0
+    }
+
+    # Cursor Up.
+    proc _csi_A {args} {
+	variable _cur_y
+	set arg [_default [lindex $args 0] 1]
+	set _cur_y [expr {max ($_cur_y - $arg, 0)}]
+    }
+
+    # Cursor Down.
+    proc _csi_B {args} {
+	variable _cur_y
+	variable _rows
+	set arg [_default [lindex $args 0] 1]
+	set _cur_y [expr {min ($_cur_y + $arg, $_rows)}]
+    }
+
+    # Cursor Forward.
+    proc _csi_C {args} {
+	variable _cur_x
+	variable _cols
+	set arg [_default [lindex $args 0] 1]
+	set _cur_x [expr {min ($_cur_x + $arg, $_cols)}]
+    }
+
+    # Cursor Back.
+    proc _csi_D {args} {
+	variable _cur_x
+	set arg [_default [lindex $args 0] 1]
+	set _cur_x [expr {max ($_cur_x - $arg, 0)}]
+    }
+
+    # Cursor Next Line.
+    proc _csi_E {args} {
+	variable _cur_x
+	variable _cur_y
+	variable _rows
+	set arg [_default [lindex $args 0] 1]
+	set _cur_x 0
+	set _cur_y [expr {min ($_cur_y + $arg, $_rows)}]
+    }
+
+    # Cursor Previous Line.
+    proc _csi_F {args} {
+	variable _cur_x
+	variable _cur_y
+	variable _rows
+	set arg [_default [lindex $args 0] 1]
+	set _cur_x 0
+	set _cur_y [expr {max ($_cur_y - $arg, 0)}]
+    }
+
+    # Cursor Horizontal Absolute.
+    proc _csi_G {args} {
+	variable _cur_x
+	variable _cols
+	set arg [_default [lindex $args 0] 1]
+	set _cur_x [expr {min ($arg - 1, $_cols)}]
+    }
+
+    # Move cursor (don't know the official name of this one).
+    proc _csi_H {args} {
+	variable _cur_x
+	variable _cur_y
+	set _cur_y [expr {[_default [lindex $args 0] 1] - 1}]
+	set _cur_x [expr {[_default [lindex $args 1] 1] - 1}]
+    }
+
+    # Cursor Forward Tabulation.
+    proc _csi_I {args} {
+	set n [_default [lindex $args 0] 1]
+	variable _cur_x
+	variable _cols
+	incr _cur_x [expr {$n * 8 - $_cur_x % 8}]
+	if {$_cur_x >= $_cols} {
+	    set _cur_x [expr {$_cols - 1}]
+	}
+    }
+
+    # Erase.
+    proc _csi_J {args} {
+	variable _cur_x
+	variable _cur_y
+	variable _rows
+	variable _cols
+	set arg [_default [lindex $args 0] 0]
+	if {$arg == 0} {
+	    _clear_in_line $_cur_x $_cols $_cur_y
+	    _clear_lines [expr {$_cur_y + 1}] $_rows
+	} elseif {$arg == 1} {
+	    _clear_lines 0 [expr {$_cur_y - 1}]
+	    _clear_in_line 0 $_cur_x $_cur_y
+	} elseif {$arg == 2} {
+	    _clear_lines 0 $_rows
+	}
+    }
+
+    # Erase Line.
+    proc _csi_K {args} {
+	variable _cur_x
+	variable _cur_y
+	variable _cols
+	set arg [_default [lindex $args 0] 0]
+	if {$arg == 0} {
+	    # From cursor to end.
+	    _clear_in_line $_cur_x $_cols $_cur_y
+	} elseif {$arg == 1} {
+	    _clear_in_line 0 $_cur_x $_cur_y
+	} elseif {$arg == 2} {
+	    _clear_in_line 0 $_cols $_cur_y
+	}
+    }
+
+    # Delete lines.
+    proc _csi_M {args} {
+	variable _cur_y
+	variable _rows
+	variable _cols
+	variable _chars
+	set count [_default [lindex $args 0] 1]
+	set y $_cur_y
+	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
+	}
+	_clear_lines $next_y $_rows
+    }
+
+    # Erase chars.
+    proc _csi_X {args} {
+	set n [_default [lindex $args 0] 1]
+	_insert [string repeat " " $n]
+    }
+
+    # Repeat.
+    proc _csi_b {args} {
+	variable _last_char
+	set n [_default [lindex $args 0] 1]
+	_insert [string repeat $_last_char $n]
+    }
+
+    # Line Position Absolute.
+    proc _csi_d {args} {
+	variable _cur_y
+	set _cur_y [expr {[_default [lindex $args 0] 1] - 1}]
+    }
+
+    # Select Graphic Rendition.
+    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
+		}
+	    }
+	}
+    }
+
+    # Insert string at the cursor location.
+    proc _insert {str} {
+	verbose "INSERT <<$str>>"
+	variable _cur_x
+	variable _cur_y
+	variable _rows
+	variable _cols
+	variable _attrs
+	variable _chars
+	set lattr [array get _attrs]
+	foreach char [split $str {}] {
+	    set _chars($_cur_x,$_cur_y) [list $char $lattr]
+	    incr _cur_x
+	    if {$_cur_x >= $_cols} {
+		set _cur_x 0
+		incr _cur_y
+		if {$_cur_y >= $_rows} {
+		    error "FIXME scroll"
+		}
+	    }
+	}
+    }
+
+    # Initialize.
+    proc _setup {rows cols} {
+	global stty_init
+	set stty_init "rows $rows columns $cols"
+
+	variable _rows
+	variable _cols
+	variable _cur_x
+	variable _cur_y
+	variable _attrs
+
+	set _rows $rows
+	set _cols $cols
+	set _cur_x 0
+	set _cur_y 0
+	array set _attrs {
+	    intensity normal
+	    fg default
+	    bg default
+	    underline 0
+	    reverse 0
+	}
+
+	_clear_lines 0 $_rows
+    }
+
+    # Accept some output from gdb and update the screen.
+    proc _accept {} {
+	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
+	    }
+	    -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
+		set prev [get_line $_cur_y $_cur_x]
+		if {![regexp -- "$gdb_prompt \$" $prev]} {
+		    exp_continue
+		}
+	    }
+	}
+    }
+
+    # Like ::clean_restart, but ensures that gdb starts in an
+    # environment where the TUI can work.  ROWS and COLS are the size
+    # of the terminal.  EXECUTABLE is passed to clean_restart.
+    proc clean_restart {rows cols executable} {
+	global env stty_init
+	save_vars {env(TERM) stty_init} {
+	    setenv TERM ansi
+	    _setup $rows $cols
+	    ::clean_restart $executable
+	}
+    }
+
+    # Start the TUI.  Returns 1 on success, 0 if TUI tests should be
+    # skipped.
+    proc enter_tui {} {
+	if {[skip_tui_tests]} {
+	    return 0
+	}
+
+	gdb_test_no_output "set tui border-kind ascii"
+	command "tui enable"
+	return 1
+    }
+
+    # Send the command CMD to gdb, then wait for a gdb prompt to be
+    # seen in the TUI.  CMD should not end with a newline -- that will
+    # be supplied by this function.
+    proc command {cmd} {
+	send_gdb "$cmd\n"
+	_accept
+    }
+
+    # 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 ""}} {
+	set result ""
+	variable _cols
+	variable _chars
+	set c [_default $c $_cols]
+	set x 0
+	while {$x < $c} {
+	    append result [lindex $_chars($x,$n) 0]
+	    incr x
+	}
+	return $result
+    }
+
+    # Get just the character at (X, Y).
+    proc get_char {x y} {
+	variable _chars
+	return [lindex $_chars($x,$y) 0]
+    }
+
+    # Get the entire screen as a string.
+    proc get_all_lines {} {
+	variable _rows
+	variable _cols
+	variable _chars
+
+	set result ""
+	for {set y 0} {$y < $_rows} {incr y} {
+	    for {set x 0} {$x < $_cols} {incr x} {
+		append result [lindex $_chars($x,$y) 0]
+	    }
+	    append result "\n"
+	}
+
+	return $result
+    }
+
+    # Get the text just before the cursor.
+    proc get_current_line {} {
+	variable _cur_x
+	variable _cur_y
+	return [get_line $_cur_y $_cur_x]
+    }
+
+    # Helper function for check_box.  Returns empty string if the box
+    # is found, description of why not otherwise.
+    proc _check_box {x y width height} {
+	set x2 [expr {$x + $width - 1}]
+	set y2 [expr {$y + $height - 1}]
+
+	if {[get_char $x $y] != "+"} {
+	    return "ul corner"
+	}
+	if {[get_char $x $y2] != "+"} {
+	    return "ll corner"
+	}
+	if {[get_char $x2 $y] != "+"} {
+	    return "ur corner"
+	}
+	if {[get_char $x2 $y2] != "+"} {
+	    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"
+	    }
+	}
+	for {set i [expr {$y + 1}]} {$i < $y2 - 1} {incr i} {
+	    if {[get_char $x $i] != "|"} {
+		return "left side $i"
+	    }
+	    if {[get_char $x2 $i] != "|"} {
+		return "right side $i"
+	    }
+	}
+
+	return ""
+    }
+
+    # Check for a box at the given coordinates.
+    proc check_box {test_name x y width height} {
+	set why [_check_box $x $y $width $height]
+	if {$why == ""} {
+	    pass $test_name
+	} else {
+	    dump_screen
+	    fail "$test_name ($why)"
+	}
+    }
+
+    # A debugging function to dump the current screen, with line
+    # numbers.
+    proc dump_screen {} {
+	variable _rows
+	verbose "Screen Dump:"
+	for {set y 0} {$y < $_rows} {incr y} {
+	    set fmt [format %5d $y]
+	    verbose "$fmt [get_line $y]"
+	}
+    }
+}
-- 
2.17.2

Re: [PATCH v2 1/8] A virtual terminal for the test suite

[Andrew Burgess]

I took a look through the whole series and it all looks good.  I did
have one observation, see below...

* Tom Tromey <tom@tromey.com> [2019-07-26 12:51:27 -0600]:

> This patch implements a simple ANSI terminal emulator for the test
> suite.  It is still quite basic, but it is good enough to allow some
> simple TUI testing to be done.
> 
> 2019-07-21  Tom Tromey  <tom@tromey.com>
> 
> 	* lib/tuiterm.exp: New file.
> 	* gdb.tui/basic.exp: New file.
> ---
>  gdb/testsuite/ChangeLog         |   5 +
>  gdb/testsuite/gdb.tui/basic.exp |  42 +++
>  gdb/testsuite/lib/tuiterm.exp   | 517 ++++++++++++++++++++++++++++++++
>  3 files changed, 564 insertions(+)
>  create mode 100644 gdb/testsuite/gdb.tui/basic.exp
>  create mode 100644 gdb/testsuite/lib/tuiterm.exp
> 
> diff --git a/gdb/testsuite/gdb.tui/basic.exp b/gdb/testsuite/gdb.tui/basic.exp
> new file mode 100644
> index 00000000000..33ce49a1b3f
> --- /dev/null
> +++ b/gdb/testsuite/gdb.tui/basic.exp
> @@ -0,0 +1,42 @@
> +# Copyright 2019 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
> +# the Free Software Foundation; either version 3 of the License, or
> +# (at your option) any later version.
> +#
> +# This program is distributed in the hope that it will be useful,
> +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +# GNU General Public License for more details.
> +#
> +# You should have received a copy of the GNU General Public License
> +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
> +
> +# Basic TUI tests.
> +
> +load_lib "tuiterm.exp"
> +
> +standard_testfile tui-layout.c
> +
> +if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
> +    return -1
> +}
> +
> +Term::clean_restart 24 80 $testfile
> +if {![Term::enter_tui]} {
> +    unsupported "TUI not supported"
> +}
> +
> +set text [Term::get_all_lines]
> +gdb_assert {![string match "No Source Available" $text]} \
> +    "initial source listing"
> +
> +Term::command "list main"
> +set text [Term::get_all_lines]
> +gdb_assert {[regexp "21 *return 0" $text]} "list main"

This pattern of 'Term::get_all_lines' followed by a regexp check crops
up a lot throughout the series.  I wonder if there's any merit in
providing a wrapper, something like:

  Term::command "list main"
  gdb_assert {[Term::regexp "21 *return 0"]} "list main"

Just an idea.

Otherwise it all looks good.

Thanks,
Andrew

> +
> +# This check fails because the file name in the title overwrites the
> +# box.
> +setup_xfail *-*-*
> +Term::check_box "source box" 3 0 77 15
> diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
> new file mode 100644
> index 00000000000..2b0af86c48c
> --- /dev/null
> +++ b/gdb/testsuite/lib/tuiterm.exp
> @@ -0,0 +1,517 @@
> +# Copyright 2019 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
> +# the Free Software Foundation; either version 3 of the License, or
> +# (at your option) any later version.
> +#
> +# This program is distributed in the hope that it will be useful,
> +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +# GNU General Public License for more details.
> +#
> +# You should have received a copy of the GNU General Public License
> +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
> +
> +# An ANSI terminal emulator for expect.
> +
> +namespace eval Term {
> +    variable _rows
> +    variable _cols
> +    variable _chars
> +
> +    variable _cur_x
> +    variable _cur_y
> +
> +    variable _attrs
> +
> +    variable _last_char
> +
> +    # If ARG is empty, return DEF: otherwise ARG.  This is useful for
> +    # defaulting arguments in CSIs.
> +    proc _default {arg def} {
> +	if {$arg == ""} {
> +	    return $def
> +	}
> +	return $arg
> +    }
> +
> +    # Erase in the line Y from SX to just before EX.
> +    proc _clear_in_line {sx ex y} {
> +	variable _attrs
> +	variable _chars
> +	set lattr [array get _attrs]
> +	while {$sx < $ex} {
> +	    set _chars($sx,$y) [list " " $lattr]
> +	    incr sx
> +	}
> +    }
> +
> +    # Erase the lines from SY to just before EY.
> +    proc _clear_lines {sy ey} {
> +	variable _cols
> +	while {$sy < $ey} {
> +	    _clear_in_line 0 $_cols $sy
> +	    incr sy
> +	}
> +    }
> +
> +    # Beep.
> +    proc _ctl_0x07 {} {
> +    }
> +
> +    # Backspace.
> +    proc _ctl_0x08 {} {
> +	variable _cur_x
> +	incr _cur_x -1
> +	if {$_cur_x < 0} {
> +	    variable _cur_y
> +	    variable _cols
> +	    set _cur_x [expr {$_cols - 1}]
> +	    incr _cur_y -1
> +	    if {$_cur_y < 0} {
> +		set _cur_y 0
> +	    }
> +	}
> +    }
> +
> +    # Linefeed.
> +    proc _ctl_0x0a {} {
> +	variable _cur_y
> +	variable _rows
> +	incr _cur_y 1
> +	if {$_cur_y >= $_rows} {
> +	    error "FIXME scroll"
> +	}
> +    }
> +
> +    # Carriage return.
> +    proc _ctl_0x0d {} {
> +	variable _cur_x
> +	set _cur_x 0
> +    }
> +
> +    # Cursor Up.
> +    proc _csi_A {args} {
> +	variable _cur_y
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_y [expr {max ($_cur_y - $arg, 0)}]
> +    }
> +
> +    # Cursor Down.
> +    proc _csi_B {args} {
> +	variable _cur_y
> +	variable _rows
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_y [expr {min ($_cur_y + $arg, $_rows)}]
> +    }
> +
> +    # Cursor Forward.
> +    proc _csi_C {args} {
> +	variable _cur_x
> +	variable _cols
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_x [expr {min ($_cur_x + $arg, $_cols)}]
> +    }
> +
> +    # Cursor Back.
> +    proc _csi_D {args} {
> +	variable _cur_x
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_x [expr {max ($_cur_x - $arg, 0)}]
> +    }
> +
> +    # Cursor Next Line.
> +    proc _csi_E {args} {
> +	variable _cur_x
> +	variable _cur_y
> +	variable _rows
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_x 0
> +	set _cur_y [expr {min ($_cur_y + $arg, $_rows)}]
> +    }
> +
> +    # Cursor Previous Line.
> +    proc _csi_F {args} {
> +	variable _cur_x
> +	variable _cur_y
> +	variable _rows
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_x 0
> +	set _cur_y [expr {max ($_cur_y - $arg, 0)}]
> +    }
> +
> +    # Cursor Horizontal Absolute.
> +    proc _csi_G {args} {
> +	variable _cur_x
> +	variable _cols
> +	set arg [_default [lindex $args 0] 1]
> +	set _cur_x [expr {min ($arg - 1, $_cols)}]
> +    }
> +
> +    # Move cursor (don't know the official name of this one).
> +    proc _csi_H {args} {
> +	variable _cur_x
> +	variable _cur_y
> +	set _cur_y [expr {[_default [lindex $args 0] 1] - 1}]
> +	set _cur_x [expr {[_default [lindex $args 1] 1] - 1}]
> +    }
> +
> +    # Cursor Forward Tabulation.
> +    proc _csi_I {args} {
> +	set n [_default [lindex $args 0] 1]
> +	variable _cur_x
> +	variable _cols
> +	incr _cur_x [expr {$n * 8 - $_cur_x % 8}]
> +	if {$_cur_x >= $_cols} {
> +	    set _cur_x [expr {$_cols - 1}]
> +	}
> +    }
> +
> +    # Erase.
> +    proc _csi_J {args} {
> +	variable _cur_x
> +	variable _cur_y
> +	variable _rows
> +	variable _cols
> +	set arg [_default [lindex $args 0] 0]
> +	if {$arg == 0} {
> +	    _clear_in_line $_cur_x $_cols $_cur_y
> +	    _clear_lines [expr {$_cur_y + 1}] $_rows
> +	} elseif {$arg == 1} {
> +	    _clear_lines 0 [expr {$_cur_y - 1}]
> +	    _clear_in_line 0 $_cur_x $_cur_y
> +	} elseif {$arg == 2} {
> +	    _clear_lines 0 $_rows
> +	}
> +    }
> +
> +    # Erase Line.
> +    proc _csi_K {args} {
> +	variable _cur_x
> +	variable _cur_y
> +	variable _cols
> +	set arg [_default [lindex $args 0] 0]
> +	if {$arg == 0} {
> +	    # From cursor to end.
> +	    _clear_in_line $_cur_x $_cols $_cur_y
> +	} elseif {$arg == 1} {
> +	    _clear_in_line 0 $_cur_x $_cur_y
> +	} elseif {$arg == 2} {
> +	    _clear_in_line 0 $_cols $_cur_y
> +	}
> +    }
> +
> +    # Delete lines.
> +    proc _csi_M {args} {
> +	variable _cur_y
> +	variable _rows
> +	variable _cols
> +	variable _chars
> +	set count [_default [lindex $args 0] 1]
> +	set y $_cur_y
> +	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
> +	}
> +	_clear_lines $next_y $_rows
> +    }
> +
> +    # Erase chars.
> +    proc _csi_X {args} {
> +	set n [_default [lindex $args 0] 1]
> +	_insert [string repeat " " $n]
> +    }
> +
> +    # Repeat.
> +    proc _csi_b {args} {
> +	variable _last_char
> +	set n [_default [lindex $args 0] 1]
> +	_insert [string repeat $_last_char $n]
> +    }
> +
> +    # Line Position Absolute.
> +    proc _csi_d {args} {
> +	variable _cur_y
> +	set _cur_y [expr {[_default [lindex $args 0] 1] - 1}]
> +    }
> +
> +    # Select Graphic Rendition.
> +    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
> +		}
> +	    }
> +	}
> +    }
> +
> +    # Insert string at the cursor location.
> +    proc _insert {str} {
> +	verbose "INSERT <<$str>>"
> +	variable _cur_x
> +	variable _cur_y
> +	variable _rows
> +	variable _cols
> +	variable _attrs
> +	variable _chars
> +	set lattr [array get _attrs]
> +	foreach char [split $str {}] {
> +	    set _chars($_cur_x,$_cur_y) [list $char $lattr]
> +	    incr _cur_x
> +	    if {$_cur_x >= $_cols} {
> +		set _cur_x 0
> +		incr _cur_y
> +		if {$_cur_y >= $_rows} {
> +		    error "FIXME scroll"
> +		}
> +	    }
> +	}
> +    }
> +
> +    # Initialize.
> +    proc _setup {rows cols} {
> +	global stty_init
> +	set stty_init "rows $rows columns $cols"
> +
> +	variable _rows
> +	variable _cols
> +	variable _cur_x
> +	variable _cur_y
> +	variable _attrs
> +
> +	set _rows $rows
> +	set _cols $cols
> +	set _cur_x 0
> +	set _cur_y 0
> +	array set _attrs {
> +	    intensity normal
> +	    fg default
> +	    bg default
> +	    underline 0
> +	    reverse 0
> +	}
> +
> +	_clear_lines 0 $_rows
> +    }
> +
> +    # Accept some output from gdb and update the screen.
> +    proc _accept {} {
> +	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
> +	    }
> +	    -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
> +		set prev [get_line $_cur_y $_cur_x]
> +		if {![regexp -- "$gdb_prompt \$" $prev]} {
> +		    exp_continue
> +		}
> +	    }
> +	}
> +    }
> +
> +    # Like ::clean_restart, but ensures that gdb starts in an
> +    # environment where the TUI can work.  ROWS and COLS are the size
> +    # of the terminal.  EXECUTABLE is passed to clean_restart.
> +    proc clean_restart {rows cols executable} {
> +	global env stty_init
> +	save_vars {env(TERM) stty_init} {
> +	    setenv TERM ansi
> +	    _setup $rows $cols
> +	    ::clean_restart $executable
> +	}
> +    }
> +
> +    # Start the TUI.  Returns 1 on success, 0 if TUI tests should be
> +    # skipped.
> +    proc enter_tui {} {
> +	if {[skip_tui_tests]} {
> +	    return 0
> +	}
> +
> +	gdb_test_no_output "set tui border-kind ascii"
> +	command "tui enable"
> +	return 1
> +    }
> +
> +    # Send the command CMD to gdb, then wait for a gdb prompt to be
> +    # seen in the TUI.  CMD should not end with a newline -- that will
> +    # be supplied by this function.
> +    proc command {cmd} {
> +	send_gdb "$cmd\n"
> +	_accept
> +    }
> +
> +    # 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 ""}} {
> +	set result ""
> +	variable _cols
> +	variable _chars
> +	set c [_default $c $_cols]
> +	set x 0
> +	while {$x < $c} {
> +	    append result [lindex $_chars($x,$n) 0]
> +	    incr x
> +	}
> +	return $result
> +    }
> +
> +    # Get just the character at (X, Y).
> +    proc get_char {x y} {
> +	variable _chars
> +	return [lindex $_chars($x,$y) 0]
> +    }
> +
> +    # Get the entire screen as a string.
> +    proc get_all_lines {} {
> +	variable _rows
> +	variable _cols
> +	variable _chars
> +
> +	set result ""
> +	for {set y 0} {$y < $_rows} {incr y} {
> +	    for {set x 0} {$x < $_cols} {incr x} {
> +		append result [lindex $_chars($x,$y) 0]
> +	    }
> +	    append result "\n"
> +	}
> +
> +	return $result
> +    }
> +
> +    # Get the text just before the cursor.
> +    proc get_current_line {} {
> +	variable _cur_x
> +	variable _cur_y
> +	return [get_line $_cur_y $_cur_x]
> +    }
> +
> +    # Helper function for check_box.  Returns empty string if the box
> +    # is found, description of why not otherwise.
> +    proc _check_box {x y width height} {
> +	set x2 [expr {$x + $width - 1}]
> +	set y2 [expr {$y + $height - 1}]
> +
> +	if {[get_char $x $y] != "+"} {
> +	    return "ul corner"
> +	}
> +	if {[get_char $x $y2] != "+"} {
> +	    return "ll corner"
> +	}
> +	if {[get_char $x2 $y] != "+"} {
> +	    return "ur corner"
> +	}
> +	if {[get_char $x2 $y2] != "+"} {
> +	    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"
> +	    }
> +	}
> +	for {set i [expr {$y + 1}]} {$i < $y2 - 1} {incr i} {
> +	    if {[get_char $x $i] != "|"} {
> +		return "left side $i"
> +	    }
> +	    if {[get_char $x2 $i] != "|"} {
> +		return "right side $i"
> +	    }
> +	}
> +
> +	return ""
> +    }
> +
> +    # Check for a box at the given coordinates.
> +    proc check_box {test_name x y width height} {
> +	set why [_check_box $x $y $width $height]
> +	if {$why == ""} {
> +	    pass $test_name
> +	} else {
> +	    dump_screen
> +	    fail "$test_name ($why)"
> +	}
> +    }
> +
> +    # A debugging function to dump the current screen, with line
> +    # numbers.
> +    proc dump_screen {} {
> +	variable _rows
> +	verbose "Screen Dump:"
> +	for {set y 0} {$y < $_rows} {incr y} {
> +	    set fmt [format %5d $y]
> +	    verbose "$fmt [get_line $y]"
> +	}
> +    }
> +}
> -- 
> 2.17.2
> 

Re: [PATCH v2 1/8] A virtual terminal for the test suite

[Tom Tromey]

>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:

Andrew> I took a look through the whole series and it all looks good.  I did
Andrew> have one observation, see below...

>> +Term::command "list main"
>> +set text [Term::get_all_lines]
>> +gdb_assert {[regexp "21 *return 0" $text]} "list main"

Andrew> This pattern of 'Term::get_all_lines' followed by a regexp check crops
Andrew> up a lot throughout the series.  I wonder if there's any merit in
Andrew> providing a wrapper, something like:

Andrew>   Term::command "list main"
Andrew>   gdb_assert {[Term::regexp "21 *return 0"]} "list main"

Andrew> Just an idea.

Good idea.  Actually I think I will shorten it even further to something
like

Term::check_contents $regexp $testname

If this works out adequately, I plan to push it in.

thanks,
Tom

minimal tcl version for gdb test suite

[Tom de Vries]

[ Re: [PATCH v2 1/8] A virtual terminal for the test suite ]
On 26-07-19 20:51, Tom Tromey wrote:
> +	_insert [string repeat " " $n]

Hi,

I noticed you started using "string repeat", available since tcl 8.3.

So, I was wondering ... is there a minimal required tcl version for the
gdb testsuite? If so, is it documented somewhere?

Thanks,
- Tom

Re: minimal tcl version for gdb test suite

[Tom Tromey]

>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:

>> +	_insert [string repeat " " $n]

Tom> I noticed you started using "string repeat", available since tcl 8.3.

Tom> So, I was wondering ... is there a minimal required tcl version for the
Tom> gdb testsuite? If so, is it documented somewhere?

Thanks for the note.  FWIW I didn't "upgrade" gdb intentionally.  We can
remove this use if need be.

I don't know whether there is a minimum version.
According to https://www.tcl.tk/software/tcltk/8.3.html, Tcl 8.3.5 was
released on Oct 18, 2002.  So, it is 17 years old.

Of course, the standard isn't date-based -- it's based on what the
distros do.  I don't have a super way to check that though.

I tend to think gdb could be more aggressive about requiring newer
tools, in general, and especially for things that only affect gdb
developers.

Perhaps if someone is affected by this, they could speak up.

thanks,
Tom

Re: minimal tcl version for gdb test suite

[Tom de Vries]

On 31-07-19 19:46, Tom Tromey wrote:
>>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:
> 
>>> +	_insert [string repeat " " $n]
> 
> Tom> I noticed you started using "string repeat", available since tcl 8.3.
> 
> Tom> So, I was wondering ... is there a minimal required tcl version for the
> Tom> gdb testsuite? If so, is it documented somewhere?
> 
> Thanks for the note.  FWIW I didn't "upgrade" gdb intentionally.  We can
> remove this use if need be.
> 
> I don't know whether there is a minimum version.
> According to https://www.tcl.tk/software/tcltk/8.3.html, Tcl 8.3.5 was
> released on Oct 18, 2002.  So, it is 17 years old.
> 
> Of course, the standard isn't date-based -- it's based on what the
> distros do.  I don't have a super way to check that though.
> 

Ok, I see. I guess then we operate on a "it's fine if nobody complains"
basis.

I've just committed a patch (
https://sourceware.org/ml/gdb-patches/2019-08/msg00003.html ) that uses
lrepeat. This was added in tcl 8.5, so I've added an lrepeat version in
gdb.exp for older versions, just in case.

FWIW:
- I found a commit message (75312ae3ab) mentioning something about mingw
  using tcl 8.4
- We've also got lrepeat, which was added in 2012 for backward
  compatibility with tcl pre-7.5.

Thanks,
- Tom

Re: minimal tcl version for gdb test suite

[Tom Tromey]

Tom> Ok, I see. I guess then we operate on a "it's fine if nobody complains"
Tom> basis.

Yeah partly that, plus "what do the major distros ship in their stable
release".

Tom

[PATCH v2 4/8] Add TUI register window test

[Tom Tromey]

This adds a very simple test of the TUI register window.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* gdb.tui/regs.exp: New file.
---
 gdb/testsuite/ChangeLog        |  4 +++
 gdb/testsuite/gdb.tui/regs.exp | 51 ++++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 gdb/testsuite/gdb.tui/regs.exp

diff --git a/gdb/testsuite/gdb.tui/regs.exp b/gdb/testsuite/gdb.tui/regs.exp
new file mode 100644
index 00000000000..b29fead17ec
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/regs.exp
@@ -0,0 +1,51 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Simple test of TUI register window.
+
+load_lib "tuiterm.exp"
+
+standard_testfile tui-layout.c
+
+if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
+    return -1
+}
+
+Term::clean_restart 24 80 $testfile
+
+if {![runto_main]} {
+    perror "test suppressed"
+    return
+}
+
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+set text [Term::get_all_lines]
+if {![gdb_assert {[regexp ">|21 *return 0" $text]} "source at startup"]} {
+    Term::dump_screen
+}
+
+Term::command "layout regs"
+Term::check_box "register box" 0 0 80 8
+# This check fails because the file name in the title overwrites the
+# box.
+setup_xfail *-*-*
+Term::check_box "source box in regs layout" 0 7 80 8
+
+set text [Term::get_line 1]
+# Just check for any register window content at all.
+gdb_assert {[regexp "^|.*\[^ \].*|$" $text]} "any register contents"
-- 
2.17.2

[PATCH v2 3/8] Add "layout split" test

[Tom Tromey]

This adds a test of "layout split" to the TUI test suite.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* gdb.tui/basic.exp: Add "layout split" test.
---
 gdb/testsuite/ChangeLog         |  4 ++++
 gdb/testsuite/gdb.tui/basic.exp | 11 +++++++++++
 2 files changed, 15 insertions(+)

diff --git a/gdb/testsuite/gdb.tui/basic.exp b/gdb/testsuite/gdb.tui/basic.exp
index 6f0e1457051..42afe354435 100644
--- a/gdb/testsuite/gdb.tui/basic.exp
+++ b/gdb/testsuite/gdb.tui/basic.exp
@@ -46,3 +46,14 @@ set text [Term::get_all_lines]
 gdb_assert {[regexp "$hex <main>" $text]} "asm window shows main"
 
 Term::check_box "asm box" 3 0 77 15
+
+Term::command "layout split"
+set text [Term::get_all_lines]
+gdb_assert {[regexp "21 *return 0.*$hex <main>" $text]} \
+    "split layout contents"
+
+# This check fails because the file name in the title overwrites the
+# box.
+setup_xfail *-*-*
+Term::check_box "source box in split layout" 3 0 77 8
+Term::check_box "asm box in split layout" 3 7 77 8
-- 
2.17.2

[PATCH v2 6/8] Add TUI resizing test

[Tom Tromey]

This adds a test case that resizes the terminal and then checks that
the TUI updates properly.

2019-07-21  Tom Tromey  <tom@tromey.com>

	* lib/tuiterm.exp (spawn): New proc.
	(Term::resize): New proc.
	* gdb.tui/resize.exp: New file.
---
 gdb/testsuite/ChangeLog          |  6 +++++
 gdb/testsuite/gdb.tui/resize.exp | 45 ++++++++++++++++++++++++++++++++
 gdb/testsuite/lib/tuiterm.exp    | 45 ++++++++++++++++++++++++++++++++
 3 files changed, 96 insertions(+)
 create mode 100644 gdb/testsuite/gdb.tui/resize.exp

diff --git a/gdb/testsuite/gdb.tui/resize.exp b/gdb/testsuite/gdb.tui/resize.exp
new file mode 100644
index 00000000000..faa9b6f6f56
--- /dev/null
+++ b/gdb/testsuite/gdb.tui/resize.exp
@@ -0,0 +1,45 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Test TUI resizing.
+
+load_lib "tuiterm.exp"
+
+standard_testfile tui-layout.c
+
+if {[build_executable "failed to prepare" ${testfile} ${srcfile}] == -1} {
+    return -1
+}
+
+Term::clean_restart 24 80 $testfile
+
+if {![runto_main]} {
+    perror "test suppressed"
+    return
+}
+
+if {![Term::enter_tui]} {
+    unsupported "TUI not supported"
+}
+
+set text [Term::get_all_lines]
+if {![gdb_assert {[regexp ">|21 *return 0" $text]} "source at startup"]} {
+    Term::dump_screen
+}
+
+Term::resize 40 90
+# Resizing seems to be somewhat broken.
+setup_xfail *-*-*
+Term::check_box "source box after resize" 0 0 90 23
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 2b0af86c48c..3fc4fcb614a 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -15,6 +15,19 @@
 
 # An ANSI terminal emulator for expect.
 
+# The expect "spawn" function puts the tty name into the spawn_out
+# array; but dejagnu doesn't export this globally.  So, we have to
+# wrap spawn with our own function, so that we can capture this value.
+# The value is later used in calls to stty.
+rename spawn builtin_spawn
+proc spawn {args} {
+    set result [uplevel builtin_spawn $args]
+    global gdb_spawn_name
+    upvar spawn_out spawn_out
+    set gdb_spawn_name $spawn_out(slave,name)
+    return $result
+}
+
 namespace eval Term {
     variable _rows
     variable _cols
@@ -514,4 +527,36 @@ namespace eval Term {
 	    verbose "$fmt [get_line $y]"
 	}
     }
+
+    # Resize the terminal.
+    proc resize {rows cols} {
+	variable _chars
+	variable _rows
+	variable _cols
+
+	set old_rows [expr {min ($_rows, $rows)}]
+	set old_cols [expr {min ($_cols, $cols)}]
+
+	# Copy locally.
+	array set local_chars [array get _chars]
+	unset _chars
+
+	set _rows $rows
+	set _cols $cols
+	_clear_lines 0 $_rows
+
+	for {set x 0} {$x < $old_cols} {incr x} {
+	    for {set y 0} {$y < $old_rows} {incr y} {
+		set _chars($x,$y) $local_chars($x,$y)
+	    }
+	}
+
+	global gdb_spawn_name
+	# 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
+    }
 }
-- 
2.17.2

[PATCH v2 2/8] Add test for "layout asm"

[Tom Tromey]

This adds a very simple test for "layout asm".

2019-07-21  Tom Tromey  <tom@tromey.com>

	* gdb.tui/basic.exp: Add "layout asm" test.
---
 gdb/testsuite/ChangeLog         | 4 ++++
 gdb/testsuite/gdb.tui/basic.exp | 6 ++++++
 2 files changed, 10 insertions(+)

diff --git a/gdb/testsuite/gdb.tui/basic.exp b/gdb/testsuite/gdb.tui/basic.exp
index 33ce49a1b3f..6f0e1457051 100644
--- a/gdb/testsuite/gdb.tui/basic.exp
+++ b/gdb/testsuite/gdb.tui/basic.exp
@@ -40,3 +40,9 @@ gdb_assert {[regexp "21 *return 0" $text]} "list main"
 # box.
 setup_xfail *-*-*
 Term::check_box "source box" 3 0 77 15
+
+Term::command "layout asm"
+set text [Term::get_all_lines]
+gdb_assert {[regexp "$hex <main>" $text]} "asm window shows main"
+
+Term::check_box "asm box" 3 0 77 15
-- 
2.17.2