# Copyright 2023 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 . # Test prompt edit wrapping in CLI. # We set TERM on build, but we need to set it on host. That only works if # build == host. require {!is_remote host} # Test both ansi (no auto-wrap) and xterm (auto-wrap). set terms {ansi xterm} # Fill line, assuming we start after the gdb prompt. proc fill_line { width } { set res "" # Take into account that the prompt also takes space. set prefix [string length "(gdb) "] set start [expr $prefix + 1] # Print chars. for { set i $start } { $i <= $width } { incr i } { set c [expr $i % 10] send_gdb $c append res $c } return $res } proc get_screen_width { } { upvar gdb_width gdb_width upvar readline_width readline_width upvar env_width env_width set gdb_width 0 set readline_width 0 set env_width 0 set re1 "Number of characters gdb thinks are in a line is ($::decimal)\[^\r\n\]*\\." set re2 \ "Number of characters readline reports are in a line is ($::decimal)\[^\r\n\]*\\." set re3 \ "Number of characters curses thinks are in a line is $::decimal\\." set re4 \ "Number of characters environment thinks are in a line is ($::decimal) \\(COLUMNS\\)." set cmd "maint info screen" set re \ [multi_line \ ^$cmd \ $re1 \ $re2 \ "(?:$re3" \ ")?$re4" \ .*] gdb_test_multiple $cmd "" { -re -wrap $re { set gdb_width $expect_out(1,string) set readline_width $expect_out(2,string) set env_width $expect_out(3,string) pass $gdb_test_name } } } proc test_wrap { width_auto_detected } { if { ! [readline_is_used] } { return } get_screen_width if { $::term == "xterm" } { gdb_assert { $gdb_width == $readline_width } } else { gdb_assert { $gdb_width == [expr $readline_width + 1] } } if { $width_auto_detected && $::term == "ansi" } { if { $gdb_width == [expr $env_width - 1] || $gdb_width == $env_width } { # Generate KFAIL or KPASS. setup_kfail "cli/30346" "*-*-*" } } gdb_assert { $gdb_width == $env_width } "width" # New prompt, but avoid emitting a pass in order to avoid ending the line # after the prompt in gdb.log. This make it a bit easier in gdb.log to # understand where wrapping occurred. gdb_test_multiple "print 1" "" { -re -wrap " = 1" { } } # Fill the line to just before wrapping. set str [fill_line $readline_width] # Now print the first char we expect to wrap. send_gdb "W" # Note the difference between autowrap and no autowrap. In the autowrap # case, readline doesn't emit a '\n', the terminal takes care of that. if { $::term == "xterm" } { # xterm, autowrap. set re "^${str}( |W)\rW" } else { # ansi, no autowrap. set re "^$str\r\n\rW" } gdb_test_multiple "" "wrap" { -re $re { pass $gdb_test_name } } # Generate a prompt. send_gdb "\003" gdb_test "" "Quit" "prompt after wrap" } foreach_with_prefix term $terms { save_vars { env(TERM) INTERNAL_GDBFLAGS } { setenv TERM $term with_test_prefix width-hard-coded { clean_restart # Env_width should match whatever was set in default_gdb_init # using stty_init. with_test_prefix initial { get_screen_width } gdb_test_no_output "set width $env_width" test_wrap 0 } with_test_prefix width-auto-detected { # Avoid "set width 0" argument. set INTERNAL_GDBFLAGS \ [string map {{-iex "set width 0"} ""} $INTERNAL_GDBFLAGS] # Avoid "set width 0" in default_gdb_start. gdb_exit gdb_spawn set test "initial prompt" gdb_test_multiple "" $test { -re "^$gdb_prompt $" { pass "$test" } } test_wrap 1 } } }