gdb/testsuite/gdb.gdbtk/console.test

   1 #   Copyright (C) 1998, 1999, 2002 Red Hat, 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 2 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, write to the Free Software
  15 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # This file was written by Keith Seitz (keiths@cygnus.com)
  18
  19 # Read in the standard defs file
  20
  21 if {![gdbtk_read_defs]} {
  22   break
  23 }
  24
  25 global objdir test_ran
  26 global console text
  27 set console [ManagedWin::open Console]
  28 set text [$console test set _twin]
  29
  30 #####                            #####
  31 #                                    #
  32 #  Helper functions for this module  #
  33 #                                    #
  34 #####                            #####
  35
  36 # console_command --
  37 #      Invoke STRING as a command in the console window and
  38 #      return the result
  39 proc console_command {string} {
  40   global console text
  41
  42   # Save current position
  43   set line [lindex [split [$text index cmdmark] .] 0]
  44   incr line 1
  45
  46   # Insert and invoke command
  47   $text insert end $string
  48   $console invoke
  49   update
  50
  51   # Get the result
  52   set end [lindex [split [$text index cmdmark] .] 0]
  53   incr end -1
  54   return [$text get $line.0 [list $end.0 lineend]]
  55 }
  56
  57 # get_cmd_line --
  58 #     Return the command line
  59 proc get_cmd_line {} {
  60   global text
  61
  62   update
  63   set index [$text index cmdmark]
  64   return [$text get [list $index linestart] [list $index lineend]]
  65 }
  66
  67 # clear_command_line --
  68 #     Clear the command line
  69 proc clear_command_line {} {
  70   global text
  71   $text delete {cmdmark + 1 char} insert
  72 }
  73
  74 #####         #####
  75 #                 #
  76 #  CONSOLE TESTS  #
  77 #                 #
  78 #####         #####
  79
  80 #
  81 # Miscellaneous tests
  82 #
  83
  84 # Test:  console-misc-1
  85 # Desc:  Change console prompt
  86 gdbtk_test console-misc-1 {change console prompt} {
  87   # Insert the "set prompt" command into the text widget
  88   console_command {set prompt (test) }
  89
  90   $text get {cmdmark linestart} {cmdmark lineend}
  91 } {(test) }
  92 if {$test_ran} {
  93   console_command {set prompt (gdb) }
  94 }
  95
  96 #
  97 # Paste tests
  98 #
  99
 100 # Test:  console-paste-1
 101 # Desc:  Paste the X selection into console window
 102 gdbtk_test console-paste-1 {paste X text} {
 103   # This is cheesy, but it works... Create a text widget
 104   # which holds the current selection...
 105   text .test_text
 106   .test_text insert end "this is some pasted text"
 107   .test_text tag add sel 1.0 {1.0 lineend}
 108   event generate .test_text <<Copy>>
 109   event generate $text <<Paste>>
 110   get_cmd_line
 111 } {(gdb) this is some pasted text}
 112 if {$test_ran} {
 113   destroy .test_text
 114   clear_command_line
 115 }
 116
 117 #
 118 # Test for errors
 119 #
 120
 121 # Test:  console-error-1
 122 # Desc:  Check if console window reports internal gdb errors
 123 gdbtk_test console-error-1 {invoke unknown command} {
 124   console_command {this_command_doesn't_exist}
 125 } {Error: Undefined command: "this".  Try "help".
 126 }
 127
 128 #
 129 # History tests
 130 #
 131
 132 # Test:  console-history-1.1
 133 # Desc:  Exercise the up-history functionality
 134 gdbtk_test console-history-1.1 {up history once} {
 135   # Add some commands into the command buffer
 136   console_command {show annotate}
 137   console_command {show complaints}
 138   console_command {show confirm}
 139   console_command {show height}
 140   console_command {show language}
 141   console_command {show print demangle}
 142   console_command {show remotebaud}
 143   console_command {show remotebreak}
 144   console_command {show remotecache}
 145   console_command {show remotedebug}
 146   console_command {show remotedevice}
 147   console_command {show remotelogbase}
 148   console_command {help quit}
 149   console_command {help si}
 150   # this doesn't seem to work reliably: event generate $text <Up>
 151   $console test _previous
 152   get_cmd_line
 153 } {(gdb) help si}
 154 if {$test_ran} {
 155   clear_command_line
 156 }
 157
 158 # Test:  console-history-1.2
 159 # Desc:  Exercise the up-history functionality
 160 gdbtk_test console-history-1.2 {up history twice} {
 161   # Add some commands into the command buffer
 162   console_command {show annotate}
 163   console_command {show complaints}
 164   console_command {show confirm}
 165   console_command {show height}
 166   console_command {show language}
 167   console_command {show print demangle}
 168   console_command {show remotebaud}
 169   console_command {show remotebreak}
 170   console_command {show remotecache}
 171   console_command {show remotedebug}
 172   console_command {show remotedevice}
 173   console_command {show remotelogbase}
 174   console_command {help quit}
 175   console_command {help si}
 176   # this doesn't seem to work reliably: event generate $text <Up>
 177   # this doesn't seem to work reliably: event generate $text <Up>
 178   $console test _previous
 179   $console test _previous
 180   get_cmd_line
 181 } {(gdb) help quit}
 182 if {$test_ran} {
 183   clear_command_line
 184 }
 185
 186 # Test:  console-history-1.3
 187 # Desc:  Exercise the up-history functionality
 188 gdbtk_test console-history-1.3 {up history four times} {
 189   # Add some commands into the command buffer
 190   console_command {show annotate}
 191   console_command {show complaints}
 192   console_command {show confirm}
 193   console_command {show height}
 194   console_command {show language}
 195   console_command {show print demangle}
 196   console_command {show remotebaud}
 197   console_command {show remotebreak}
 198   console_command {show remotecache}
 199   console_command {show remotedebug}
 200   console_command {show remotedevice}
 201   console_command {show remotelogbase}
 202   console_command {help quit}
 203   console_command {help si}
 204
 205   for {set i 0} {$i < 4} {incr i} {
 206     # this doesn't seem to work reliably: event generate $text <Up>
 207     $console test _previous
 208   }
 209   get_cmd_line
 210 } {(gdb) show remotedevice}
 211 if {$test_ran} {
 212   clear_command_line
 213 }
 214
 215 # Test:  console-history-1.4
 216 # Desc:  Exercise the up-history functionality
 217 gdbtk_test console-history-1.4 {up fourteen times} {
 218   # Add some commands into the command buffer
 219   console_command {show annotate}
 220   console_command {show complaints}
 221   console_command {show confirm}
 222   console_command {show height}
 223   console_command {show language}
 224   console_command {show print demangle}
 225   console_command {show remotebaud}
 226   console_command {show remotebreak}
 227   console_command {show remotecache}
 228   console_command {show remotedebug}
 229   console_command {show remotedevice}
 230   console_command {show remotelogbase}
 231   console_command {help quit}
 232   console_command {help si}
 233   for {set i 0} {$i < 14} {incr i} {
 234     # this doesn't seem to work reliably: event generate $text <Up>
 235     $console test _previous
 236   }
 237   get_cmd_line
 238 } {(gdb) show annotate}
 239 if {$test_ran} {
 240   clear_command_line
 241 }
 242
 243 # Test:  console-history-1.5
 244 # Desc:  Exercise the up-history search functionality
 245 gdbtk_test console-history-1.5 {up search} {
 246  # Add some commands into the command buffer
 247   console_command {show height}
 248   console_command {show annotate}
 249   console_command {show complaints}
 250   console_command {print main}
 251   console_command {show remotelogbase}
 252   console_command {help quit}
 253   console_command {help si}
 254
 255   $text insert end "sh"
 256   # this doesn't seem to work reliably: event generate $text <Shift-Up>
 257   # this doesn't seem to work reliably: event generate $text <Shift-Up>
 258   # this doesn't seem to work reliably: event generate $text <Shift-Up>
 259   $console test _search_history
 260   $console test _search_history
 261   $console test _search_history
 262   get_cmd_line
 263 } {(gdb) show annotate}
 264
 265
 266 # Test:  console-history-1.6
 267 # Desc:  Exercise the down-history search functionality
 268 gdbtk_test console-history-1.6 {down search} {
 269   # this doesn't seem to work reliably: event generate $text <Shift-Down>
 270   # this doesn't seem to work reliably: event generate $text <Shift-Down>
 271   $console test _rsearch_history
 272   $console test _rsearch_history
 273   get_cmd_line
 274 } {(gdb) show remotelogbase}
 275
 276 # Test:  console-history-1.7
 277 # Desc:  Down-history search to bottom
 278 # We go back down until the original partialcommand is displayed
 279 gdbtk_test console-history-1.7 {down search to bottom} {
 280   # this doesn't seem to work reliably: event generate $text <Shift-Down>
 281   # this doesn't seem to work reliably: event generate $text <Shift-Down>
 282   $console test _rsearch_history
 283   $console test _rsearch_history
 284   get_cmd_line
 285 } {(gdb) sh}
 286
 287 # Test:  console-history-1.8
 288 # Desc:  Up-history search to top
 289 # We go up until there are no matches
 290 gdbtk_test console-history-1.8 {up search to top} {
 291   for {set i 0} {$i < 100} {incr i} {
 292     # this doesn't seem to work reliably: event generate $text <Shift-Up>
 293     $console test _search_history
 294   }
 295   get_cmd_line
 296 } {(gdb) show annotate}
 297
 298 if {$test_ran} {
 299   clear_command_line
 300 }
 301
 302 # Test:  console-history-2.1
 303 # Desc:  Exercise the down-history functionality
 304 gdbtk_test console-history-2.1 {down once} {
 305   # Add some commands into the command buffer
 306   console_command {show annotate}
 307   console_command {show complaints}
 308   console_command {show confirm}
 309   console_command {show height}
 310   console_command {show language}
 311   console_command {show print demangle}
 312   console_command {show remotebaud}
 313   console_command {show remotebreak}
 314   console_command {show remotecache}
 315   console_command {show remotedebug}
 316   console_command {show remotedevice}
 317   console_command {show remotelogbase}
 318   console_command {help quit}
 319   console_command {help si}
 320
 321   for {set i 0} {$i < 14} {incr i} {
 322     # this doesn't seem to work reliably: event generate $text <Up>
 323     $console test _previous
 324   }
 325   # this doesn't seem to work reliably: event generate $text <Down>
 326   $console test _next
 327   get_cmd_line
 328 } {(gdb) show complaints}
 329 if {$test_ran} {
 330   clear_command_line
 331 }
 332
 333 # Test:  console-history-2.2
 334 # Desc:  Exercise the down-history functionality
 335 gdbtk_test console-history-2.2 {down twice} {
 336   # Add some commands into the command buffer
 337   console_command {show annotate}
 338   console_command {show complaints}
 339   console_command {show confirm}
 340   console_command {show height}
 341   console_command {show language}
 342   console_command {show print demangle}
 343   console_command {show remotebaud}
 344   console_command {show remotebreak}
 345   console_command {show remotecache}
 346   console_command {show remotedebug}
 347   console_command {show remotedevice}
 348   console_command {show remotelogbase}
 349   console_command {help quit}
 350   console_command {help si}
 351
 352   for {set i 0} {$i < 14} {incr i} {
 353     # this doesn't seem to work reliably: event generate $text <Up>
 354     $console test _previous
 355   }
 356
 357   # this doesn't seem to work reliably: event generate $text <Down>
 358   # this doesn't seem to work reliably: event generate $text <Down>
 359   $console test _next
 360   $console test _next
 361   get_cmd_line
 362 } {(gdb) show confirm}
 363 if {$test_ran} {
 364   clear_command_line
 365 }
 366
 367 # Test:  console-history-2.3
 368 # Desc:  Exercise the down-history functionality
 369 gdbtk_test console-history-2.3 {down four times} {
 370   # Add some commands into the command buffer
 371   console_command {show annotate}
 372   console_command {show complaints}
 373   console_command {show confirm}
 374   console_command {show height}
 375   console_command {show language}
 376   console_command {show print demangle}
 377   console_command {show remotebaud}
 378   console_command {show remotebreak}
 379   console_command {show remotecache}
 380   console_command {show remotedebug}
 381   console_command {show remotedevice}
 382   console_command {show remotelogbase}
 383   console_command {help quit}
 384   console_command {help si}
 385
 386   for {set i 0} {$i < 14} {incr i} {
 387     # this doesn't seem to work reliably: event generate $text <Up>
 388     $console test _previous
 389   }
 390
 391   for {set i 0} {$i < 4} {incr i} {
 392     # this doesn't seem to work reliably: event generate $text <Down>
 393     $console test _next
 394   }
 395   get_cmd_line
 396 } {(gdb) show language}
 397 if {$test_ran} {
 398   clear_command_line
 399 }
 400
 401 # Test:  console-history-2.4
 402 # Desc:  Exercise the down-history functionality
 403 gdbtk_test console-history-2.4 {down infinitely} {
 404   # Add some commands into the command buffer
 405   console_command {show annotate}
 406   console_command {show complaints}
 407   console_command {show confirm}
 408   console_command {show height}
 409   console_command {show language}
 410   console_command {show print demangle}
 411   console_command {show remotebaud}
 412   console_command {show remotebreak}
 413   console_command {show remotecache}
 414   console_command {show remotedebug}
 415   console_command {show remotedevice}
 416   console_command {show remotelogbase}
 417   console_command {help quit}
 418   console_command {help si}
 419   for {set i 0} {$i < 14} {incr i} {
 420     # this doesn't seem to work reliably: event generate $text <Up>
 421     $console test _previous
 422   }
 423
 424   for {set i 0} {$i < 20} {incr i} {
 425     # this doesn't seem to work reliably: event generate $text <Down>
 426     $console test _next
 427   }
 428   get_cmd_line
 429 } {(gdb) }
 430 if {$test_ran} {
 431   clear_command_line
 432 }
 433
 434 #
 435 # gdb - gdbtk Interface Tests
 436 #
 437
 438 # Test:  console-interface-1.1
 439 # Desc:  Verify that a "file" command in the console window causes
 440 #        gdb to invoke the pre-/post-add-symbol hooks
 441 set file_loaded 0
 442 gdbtk_test console-interface-1.1 {file command goes through hooks} {
 443   global TEST1_RESULT TEST2_RESULT
 444
 445   # This is really ugly, but its the only way to do this...
 446   rename gdbtk_tcl_pre_add_symbol pre_add
 447   rename gdbtk_tcl_post_add_symbol post_add
 448
 449   proc gdbtk_tcl_pre_add_symbol {file} {
 450     global TEST1_RESULT
 451
 452     set TEST1_RESULT $file
 453     pre_add $file
 454   }
 455   proc gdbtk_tcl_post_add_symbol {} {
 456     global TEST2_RESULT
 457
 458     set TEST2_RESULT ok
 459     post_add
 460   }
 461
 462   # load a file and make sure we went through the pre/post_add_symbol hooks
 463   set TEST1_RESULT {}
 464   set TEST2_RESULT {}
 465   set file [file join $objdir simple]
 466   console_command "file $file"
 467   if {$TEST1_RESULT != $file} {
 468     set result "did not go through gdbtk_tcl_pre_add_symbol ($TEST1_RESULT)"
 469   } elseif {$TEST2_RESULT != "ok"} {
 470     set result "did not go through gdbtk_tcl_post_add_symbol"
 471   } else {
 472     set result {}
 473     set file_loaded 1
 474   }
 475
 476   set result
 477 } {}
 478 if {$test_ran} {
 479   rename gdbtk_tcl_pre_add_symbol {}
 480   rename gdbtk_tcl_post_add_symbol {}
 481   rename pre_add gdbtk_tcl_pre_add_symbol
 482   rename post_add gdbtk_tcl_post_add_symbol
 483 }
 484
 485 #
 486 #  Exit
 487 #
 488 gdbtk_test_done