From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 6676 invoked by alias); 27 Jul 2019 16:01:47 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Received: (qmail 6667 invoked by uid 89); 27 Jul 2019 16:01:47 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.9 required=5.0 tests=BAYES_00,GIT_PATCH_0,GIT_PATCH_1,GIT_PATCH_2,GIT_PATCH_3,KAM_SHORT,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.1 spammy=HX-Envelope-From:sk:andrew. X-HELO: mail-wm1-f66.google.com Received: from mail-wm1-f66.google.com (HELO mail-wm1-f66.google.com) (209.85.128.66) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 27 Jul 2019 16:01:44 +0000 Received: by mail-wm1-f66.google.com with SMTP id v15so50350918wml.0 for ; Sat, 27 Jul 2019 09:01:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=date:from:to:cc:subject:message-id:references:mime-version :content-disposition:in-reply-to:user-agent; bh=9gxCtIfnlPPIHnSXKyPbzoFz8O9/mzH+3IE4tc46Ymw=; b=RBrL778qcXPgWqPY/mid2RmG+wn7ttaU5rVCqN0/o4otYVnjPeqbyrWq8q324gfLH8 8rLD3Am8mOpCHvzlZXKEZ/0aHRNBVHLqbAAoYS/bxMESg/LpSb3TpL76mGc+0K1346Hm rwDqn6dZE/DeMrh9okJkCG9myU023VT0Px9NcIGZNpFF1CT+qXppNiOQ6hxcxkpi43wH 7B8ORrzyBd6d+yV1SLv+ihcGvCVEfQgvJhoPx1P3r3wNH+4NUTamfp3ahhtTT0/teQxE PLzEieE1wF2RqNOH1hJGwBpLbZv+Xg6mb81T+ZtKwxYCrU85kSDW8qktfRtAvY/I9OoL KKwg== Return-Path: Received: from localhost (188.29.165.26.threembb.co.uk. [188.29.165.26]) by smtp.gmail.com with ESMTPSA id j33sm115290718wre.42.2019.07.27.09.01.40 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sat, 27 Jul 2019 09:01:41 -0700 (PDT) Date: Sat, 27 Jul 2019 16:01:00 -0000 From: Andrew Burgess To: Tom Tromey Cc: gdb-patches@sourceware.org Subject: Re: [PATCH v2 1/8] A virtual terminal for the test suite Message-ID: <20190727160139.GL23204@embecosm.com> References: <20190726185134.1856-1-tom@tromey.com> <20190726185134.1856-2-tom@tromey.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <20190726185134.1856-2-tom@tromey.com> X-Fortune: There's enough money here to buy 5000 cans of Noodle-Roni! X-Editor: GNU Emacs [ http://www.gnu.org/software/emacs ] User-Agent: Mutt/1.9.2 (2017-12-15) X-IsSubscribed: yes X-SW-Source: 2019-07/txt/msg00607.txt.bz2 I took a look through the whole series and it all looks good. I did have one observation, see below... * Tom Tromey [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 > > * 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 . > + > +# 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 . > + > +# 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 >