Home | History | Annotate | Line # | Download | only in gdb.tui 
      1 # Copyright 2023-2024 Free Software Foundation, Inc.
      2 
      3 # This program is free software; you can redistribute it and/or modify
      4 # it under the terms of the GNU General Public License as published by
      5 # the Free Software Foundation; either version 3 of the License, or
      6 # (at your option) any later version.
      7 #
      8 # This program is distributed in the hope that it will be useful,
      9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
     10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     11 # GNU General Public License for more details.
     12 #
     13 # You should have received a copy of the GNU General Public License
     14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
     15 
     16 # Test prompt edit wrapping in tuiterm, both in CLI and TUI mode.
     17 
     18 # Required for tuiterm.
     19 require {!is_remote host}
     20 
     21 tuiterm_env
     22 
     23 # Make cols wide enough for the longest command.
     24 set cols 50
     25 set lines 24
     26 set dims [list $lines $cols]
     27 
     28 # Sometimes we see ^C.  This is something we'd like to fix.  It's reported as
     29 # a readline problem here (
     30 # https://lists.gnu.org/archive/html/bug-readline/2023-06/msg00000.html ).
     31 # For now, ignore it.
     32 set re_control_c "(\\^C)?Quit"
     33 
     34 # Fill line, assuming we start after the gdb prompt.
     35 proc fill_line { width } {
     36     set res ""
     37 
     38     # Take into account that the prompt also takes space.
     39     set prefix [string length "(gdb) "]
     40     set start [expr $prefix + 1]
     41 
     42     # Print chars.
     43     for { set i $start } { $i <= $width } { incr i } {
     44 	set c [expr $i % 10]
     45 	send_gdb $c
     46 	append res $c
     47     }
     48 
     49     return $res
     50 }
     51 
     52 # Test wrapping.
     53 proc test_wrap { wrap_width } {
     54     # Generate a prompt and parse it.
     55     send_gdb "\003"
     56     gdb_assert { [Term::wait_for "(^|$::gdb_prompt )$::re_control_c"] } "start line"
     57 
     58     # Fill the line to just before wrapping.
     59     set str [fill_line $wrap_width]
     60 
     61     # Remaining space on line.
     62     set space [string repeat " " [expr $::cols - $wrap_width]]
     63 
     64     # Now print the first char we expect to wrap.
     65     send_gdb "W"
     66 
     67     # Check that the wrap occurred at the expected location.
     68     gdb_assert { [Term::wait_for_region_contents 0 0 $::cols $::lines \
     69 		      "$::gdb_prompt $str$space\r\nW"] } "wrap"
     70 
     71     # Generate a prompt and parse it.
     72     send_gdb "\003"
     73     gdb_assert { [Term::wait_for "^W$::re_control_c"] } "prompt after wrap"
     74 }
     75 
     76 # Test wrapping in both CLI and TUI.
     77 proc test_wrap_cli_tui { auto_detected_width } {
     78     if { [allow_tui_tests] } {
     79 	# Use a TUI layout with just a command window.
     80 	gdb_test_no_output "tui new-layout command-layout cmd 1"
     81     }
     82 
     83     set gdb_width 0
     84     set readline_width 0
     85     set re1 "Number of characters gdb thinks are in a line is ($::decimal)\\."
     86     set re2 \
     87 	"Number of characters readline reports are in a line is ($::decimal)\\."
     88     set cmd "maint info screen"
     89     set re \
     90 	[multi_line \
     91 	     "^$re1" \
     92 	     $re2 \
     93 	    ".*"]
     94     gdb_test_multiple $cmd "" {
     95 	-re -wrap $re {
     96 	    set gdb_width $expect_out(1,string)
     97 	    set readline_width $expect_out(2,string)
     98 	    pass $gdb_test_name
     99 	}
    100     }
    101 
    102     gdb_assert { $gdb_width == $::cols } "width"
    103 
    104     # TERM=ansi, so readline hides the last column.
    105     gdb_assert { $gdb_width == [expr $readline_width + 1] }
    106 
    107     with_test_prefix cli {
    108 	set wrap_width $readline_width
    109 
    110 	test_wrap $wrap_width
    111     }
    112 
    113     with_test_prefix tui {
    114 	if {![Term::prepare_for_tui]} {
    115 	    unsupported "TUI not supported"
    116 	    return
    117 	}
    118 
    119 	# Enter TUI.
    120 	send_gdb "layout command-layout\n"
    121 	gdb_assert { [Term::wait_for ""] } "switched to TUI"
    122 
    123 	# TUI interacts with readline for prompt editing, but doesn't wrap at
    124 	# $cols - 1.  This is due to the fact that TUI defines its own
    125 	# rl_redisplay_function, tui_redisplay_readline which takes its cue
    126 	# for wrapping from curses.
    127 	set wrap_width $::cols
    128 
    129 	test_wrap $wrap_width
    130     }
    131 }
    132 
    133 with_test_prefix width-hard-coded {
    134     Term::clean_restart {*}$dims
    135 
    136     gdb_test_no_output "set width $cols"
    137 
    138     # Run tests with hard-coded screen width.
    139     test_wrap_cli_tui 0
    140 }
    141 
    142 with_test_prefix width-auto-detected {
    143     Term::with_tuiterm {*}$dims {
    144 	save_vars { ::INTERNAL_GDBFLAGS } {
    145 	    # Avoid "set width 0" argument.
    146 	    set INTERNAL_GDBFLAGS \
    147 		[string map {{-iex "set width 0"} ""} $INTERNAL_GDBFLAGS]
    148 
    149 	    # Avoid "set width 0" in default_gdb_start.
    150 	    gdb_exit
    151 	    gdb_spawn
    152 	}
    153 
    154 	set test "startup prompt"
    155 	gdb_test_multiple "" $test {
    156 	    -re "^$gdb_prompt $" {
    157 		pass "$test"
    158 	    }
    159 	}
    160     }
    161 
    162     # Run tests with auto-detected screen width.
    163     test_wrap_cli_tui 1
    164 }
    165