From patchwork Sun Jul 21 18:49:03 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom Tromey X-Patchwork-Id: 33753 Received: (qmail 96756 invoked by alias); 21 Jul 2019 18:49:20 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 96681 invoked by uid 89); 21 Jul 2019 18:49:20 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-18.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, RCVD_IN_SEMBLACK, SPF_HELO_PASS autolearn=ham version=3.3.1 spammy=coordinates, Back, Horizontal, bold X-HELO: gateway21.websitewelcome.com Received: from gateway21.websitewelcome.com (HELO gateway21.websitewelcome.com) (192.185.45.155) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 21 Jul 2019 18:49:17 +0000 Received: from cm10.websitewelcome.com (cm10.websitewelcome.com [100.42.49.4]) by gateway21.websitewelcome.com (Postfix) with ESMTP id A90B7400C3ED6 for ; Sun, 21 Jul 2019 13:49:15 -0500 (CDT) Received: from box5379.bluehost.com ([162.241.216.53]) by cmsmtp with SMTP id pGtXhiWSl2PzOpGtXhqack; Sun, 21 Jul 2019 13:49:15 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tromey.com; s=default; h=References:In-Reply-To:Message-Id:Date:Subject:Cc:To:From: Sender:Reply-To:MIME-Version:Content-Type:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=/bGZmm9zgo8hXfqlNX28DWXmqLWQDWjElMoDoXdlmxk=; b=vVrmE7nRUi9ZEYZX8M5S9RCeH+ 4uOCQO2lTc+C24vGKYHWkFTNbtUNTrx3OTZHzlc4NpdxCq9hOni5/mG0BgxHwhWBmujzQADBRJOIE gQAnGnWyNjHhXQiQXP0H9Im7Y; Received: from 97-122-178-82.hlrn.qwest.net ([97.122.178.82]:58458 helo=bapiya.Home) by box5379.bluehost.com with esmtpsa (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256) (Exim 4.92) (envelope-from ) id 1hpGtX-002hWd-7V; Sun, 21 Jul 2019 13:49:15 -0500 From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH 1/8] A virtual terminal for the test suite Date: Sun, 21 Jul 2019 12:49:03 -0600 Message-Id: <20190721184910.26679-2-tom@tromey.com> In-Reply-To: <20190721184910.26679-1-tom@tromey.com> References: <20190721184910.26679-1-tom@tromey.com> 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. gdb/testsuite/ChangeLog 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 | 49 +++ gdb/testsuite/lib/tuiterm.exp | 517 ++++++++++++++++++++++++++++++++ 3 files changed, 571 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..48d39741ba5 --- /dev/null +++ b/gdb/testsuite/gdb.tui/basic.exp @@ -0,0 +1,49 @@ +# 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] +if {[string match "No Source Available" $text]} { + fail "initial source listing" +} else { + pass "initial source listing" +} + +Term::command "list main" +set text [Term::get_all_lines] +if {[regexp "21 *return 0" $text]} { + pass "list main" +} else { + fail "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 . + +# 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]" + } + } +}