| # Copyright (C) 1998, 1999, 2002 Red Hat, 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 2 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, write to the Free Software |
| # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
| |
| # Please email any bugs, comments, and/or additions to this file to: |
| # bug-gdb@prep.ai.mit.edu |
| |
| # This file was written by Keith Seitz (keiths@cygnus.com) |
| |
| # Read in the standard defs file |
| |
| if {![gdbtk_read_defs]} { |
| break |
| } |
| |
| global objdir test_ran |
| global console text |
| set console [ManagedWin::open Console] |
| set text [$console test set _twin] |
| |
| ##### ##### |
| # # |
| # Helper functions for this module # |
| # # |
| ##### ##### |
| |
| # console_command -- |
| # Invoke STRING as a command in the console window and |
| # return the result |
| proc console_command {string} { |
| global console text |
| |
| # Save current position |
| set line [lindex [split [$text index cmdmark] .] 0] |
| incr line 1 |
| |
| # Insert and invoke command |
| $text insert end $string |
| $console invoke |
| update |
| |
| # Get the result |
| set end [lindex [split [$text index cmdmark] .] 0] |
| incr end -1 |
| return [$text get $line.0 [list $end.0 lineend]] |
| } |
| |
| # get_cmd_line -- |
| # Return the command line |
| proc get_cmd_line {} { |
| global text |
| |
| update |
| set index [$text index cmdmark] |
| return [$text get [list $index linestart] [list $index lineend]] |
| } |
| |
| # clear_command_line -- |
| # Clear the command line |
| proc clear_command_line {} { |
| global text |
| $text delete {cmdmark + 1 char} insert |
| } |
| |
| ##### ##### |
| # # |
| # CONSOLE TESTS # |
| # # |
| ##### ##### |
| |
| # |
| # Miscellaneous tests |
| # |
| |
| # Test: console-misc-1 |
| # Desc: Change console prompt |
| gdbtk_test console-misc-1 {change console prompt} { |
| # Insert the "set prompt" command into the text widget |
| console_command {set prompt (test) } |
| |
| $text get {cmdmark linestart} {cmdmark lineend} |
| } {(test) } |
| if {$test_ran} { |
| console_command {set prompt (gdb) } |
| } |
| |
| # |
| # Paste tests |
| # |
| |
| # Test: console-paste-1 |
| # Desc: Paste the X selection into console window |
| gdbtk_test console-paste-1 {paste X text} { |
| # This is cheesy, but it works... Create a text widget |
| # which holds the current selection... |
| text .test_text |
| .test_text insert end "this is some pasted text" |
| .test_text tag add sel 1.0 {1.0 lineend} |
| event generate .test_text <<Copy>> |
| event generate $text <<Paste>> |
| get_cmd_line |
| } {(gdb) this is some pasted text} |
| if {$test_ran} { |
| destroy .test_text |
| clear_command_line |
| } |
| |
| # |
| # Test for errors |
| # |
| |
| # Test: console-error-1 |
| # Desc: Check if console window reports internal gdb errors |
| gdbtk_test console-error-1 {invoke unknown command} { |
| console_command {this_command_doesn't_exist} |
| } {Error: Undefined command: "this". Try "help". |
| } |
| |
| # |
| # History tests |
| # |
| |
| # Test: console-history-1.1 |
| # Desc: Exercise the up-history functionality |
| gdbtk_test console-history-1.1 {up history once} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| get_cmd_line |
| } {(gdb) help si} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-1.2 |
| # Desc: Exercise the up-history functionality |
| gdbtk_test console-history-1.2 {up history twice} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| # this doesn't seem to work reliably: event generate $text <Up> |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| $console test _previous |
| get_cmd_line |
| } {(gdb) help quit} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-1.3 |
| # Desc: Exercise the up-history functionality |
| gdbtk_test console-history-1.3 {up history four times} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| |
| for {set i 0} {$i < 4} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| get_cmd_line |
| } {(gdb) show remotedevice} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-1.4 |
| # Desc: Exercise the up-history functionality |
| gdbtk_test console-history-1.4 {up fourteen times} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| for {set i 0} {$i < 14} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| get_cmd_line |
| } {(gdb) show annotate} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-1.5 |
| # Desc: Exercise the up-history search functionality |
| gdbtk_test console-history-1.5 {up search} { |
| # Add some commands into the command buffer |
| console_command {show height} |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {print main} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| |
| $text insert end "sh" |
| # this doesn't seem to work reliably: event generate $text <Shift-Up> |
| # this doesn't seem to work reliably: event generate $text <Shift-Up> |
| # this doesn't seem to work reliably: event generate $text <Shift-Up> |
| $console test _search_history |
| $console test _search_history |
| $console test _search_history |
| get_cmd_line |
| } {(gdb) show annotate} |
| |
| |
| # Test: console-history-1.6 |
| # Desc: Exercise the down-history search functionality |
| gdbtk_test console-history-1.6 {down search} { |
| # this doesn't seem to work reliably: event generate $text <Shift-Down> |
| # this doesn't seem to work reliably: event generate $text <Shift-Down> |
| $console test _rsearch_history |
| $console test _rsearch_history |
| get_cmd_line |
| } {(gdb) show remotelogbase} |
| |
| # Test: console-history-1.7 |
| # Desc: Down-history search to bottom |
| # We go back down until the original partialcommand is displayed |
| gdbtk_test console-history-1.7 {down search to bottom} { |
| # this doesn't seem to work reliably: event generate $text <Shift-Down> |
| # this doesn't seem to work reliably: event generate $text <Shift-Down> |
| $console test _rsearch_history |
| $console test _rsearch_history |
| get_cmd_line |
| } {(gdb) sh} |
| |
| # Test: console-history-1.8 |
| # Desc: Up-history search to top |
| # We go up until there are no matches |
| gdbtk_test console-history-1.8 {up search to top} { |
| for {set i 0} {$i < 100} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Shift-Up> |
| $console test _search_history |
| } |
| get_cmd_line |
| } {(gdb) show annotate} |
| |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-2.1 |
| # Desc: Exercise the down-history functionality |
| gdbtk_test console-history-2.1 {down once} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| |
| for {set i 0} {$i < 14} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| # this doesn't seem to work reliably: event generate $text <Down> |
| $console test _next |
| get_cmd_line |
| } {(gdb) show complaints} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-2.2 |
| # Desc: Exercise the down-history functionality |
| gdbtk_test console-history-2.2 {down twice} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| |
| for {set i 0} {$i < 14} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| |
| # this doesn't seem to work reliably: event generate $text <Down> |
| # this doesn't seem to work reliably: event generate $text <Down> |
| $console test _next |
| $console test _next |
| get_cmd_line |
| } {(gdb) show confirm} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-2.3 |
| # Desc: Exercise the down-history functionality |
| gdbtk_test console-history-2.3 {down four times} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| |
| for {set i 0} {$i < 14} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| |
| for {set i 0} {$i < 4} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Down> |
| $console test _next |
| } |
| get_cmd_line |
| } {(gdb) show language} |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # Test: console-history-2.4 |
| # Desc: Exercise the down-history functionality |
| gdbtk_test console-history-2.4 {down infinitely} { |
| # Add some commands into the command buffer |
| console_command {show annotate} |
| console_command {show complaints} |
| console_command {show confirm} |
| console_command {show height} |
| console_command {show language} |
| console_command {show print demangle} |
| console_command {show remotebaud} |
| console_command {show remotebreak} |
| console_command {show remotecache} |
| console_command {show remotedebug} |
| console_command {show remotedevice} |
| console_command {show remotelogbase} |
| console_command {help quit} |
| console_command {help si} |
| for {set i 0} {$i < 14} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Up> |
| $console test _previous |
| } |
| |
| for {set i 0} {$i < 20} {incr i} { |
| # this doesn't seem to work reliably: event generate $text <Down> |
| $console test _next |
| } |
| get_cmd_line |
| } {(gdb) } |
| if {$test_ran} { |
| clear_command_line |
| } |
| |
| # |
| # gdb - gdbtk Interface Tests |
| # |
| |
| # Test: console-interface-1.1 |
| # Desc: Verify that a "file" command in the console window causes |
| # gdb to invoke the pre-/post-add-symbol hooks |
| set file_loaded 0 |
| gdbtk_test console-interface-1.1 {file command goes through hooks} { |
| global TEST1_RESULT TEST2_RESULT |
| |
| # This is really ugly, but its the only way to do this... |
| rename gdbtk_tcl_pre_add_symbol pre_add |
| rename gdbtk_tcl_post_add_symbol post_add |
| |
| proc gdbtk_tcl_pre_add_symbol {file} { |
| global TEST1_RESULT |
| |
| set TEST1_RESULT $file |
| pre_add $file |
| } |
| proc gdbtk_tcl_post_add_symbol {} { |
| global TEST2_RESULT |
| |
| set TEST2_RESULT ok |
| post_add |
| } |
| |
| # load a file and make sure we went through the pre/post_add_symbol hooks |
| set TEST1_RESULT {} |
| set TEST2_RESULT {} |
| set file [file join $objdir simple] |
| console_command "file $file" |
| if {$TEST1_RESULT != $file} { |
| set result "did not go through gdbtk_tcl_pre_add_symbol ($TEST1_RESULT)" |
| } elseif {$TEST2_RESULT != "ok"} { |
| set result "did not go through gdbtk_tcl_post_add_symbol" |
| } else { |
| set result {} |
| set file_loaded 1 |
| } |
| |
| set result |
| } {} |
| if {$test_ran} { |
| rename gdbtk_tcl_pre_add_symbol {} |
| rename gdbtk_tcl_post_add_symbol {} |
| rename pre_add gdbtk_tcl_pre_add_symbol |
| rename post_add gdbtk_tcl_post_add_symbol |
| } |
| |
| # |
| # Exit |
| # |
| gdbtk_test_done |
