gdb/testsuite/gdb.base/readline.exp

   1 # Copyright 2002, 2003, 2007, 2008 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 # Please email any bugs, comments, and/or additions to this file to:
  17 # bug-gdb@prep.ai.mit.edu
  18
  19 # This file was written by Tom Tromey <tromey@redhat.com>
  20
  21 # This file is part of the gdb testsuite.
  22
  23 #
  24 # Tests for readline operations.
  25 #
  26
  27 # This function is used to test operate-and-get-next.
  28 # NAME is the name of the test.
  29 # ARGS is a list of alternating commands and expected results.
  30 proc operate_and_get_next {name args} {
  31   global gdb_prompt
  32
  33   set my_gdb_prompt "($gdb_prompt| >)"
  34
  35   set reverse {}
  36   foreach {item result} $args {
  37     verbose "sending $item"
  38     sleep 1
  39
  40     # We can't use gdb_test here because we might see a " >" prompt.
  41     set status 0
  42     send_gdb "$item\n"
  43     gdb_expect {
  44       -re "$item" {
  45         # Ok
  46       }
  47       timeout {
  48         set status 1
  49       }
  50     }
  51
  52     if {! $status} {
  53       gdb_expect {
  54         -re "$result" {
  55           # Ok.
  56         }
  57         timeout {
  58           set status 1
  59         }
  60       }
  61     }
  62
  63     if {$status} {
  64       fail "$name - send $item"
  65       return 0
  66     }
  67     pass "$name - send $item"
  68
  69     set reverse [linsert $reverse 0 $item $result]
  70   }
  71
  72   # Now use C-p to go back to the start.
  73   foreach {item result} $reverse {
  74     # Actually send C-p followed by C-l.  This lets us recognize the
  75     # command when gdb prints it again.
  76     send_gdb "\x10\x0c"
  77     set status 0
  78     gdb_expect {
  79       -re "$item" {
  80         # Ok
  81       }
  82       timeout {
  83         set status 1
  84       }
  85     }
  86     if {$status} {
  87       fail "$name - C-p to $item"
  88       return 0
  89     }
  90     pass "$name - C-p to $item"
  91   }
  92
  93   # Now C-o through the list.  Don't send the command, since it is
  94   # already there.  Strip off the first command from the list so we
  95   # can see the next command inside the loop.
  96   set count 0
  97   foreach {item result} $args {
  98     set status 0
  99
 100     # If this isn't the first item, make sure we see the command at
 101     # the prompt.
 102     if {$count > 0} {
 103       gdb_expect {
 104         -re ".*$item" {
 105           # Ok
 106         }
 107         timeout {
 108           set status 1
 109         }
 110       }
 111     }
 112
 113     if {! $status} {
 114       # For the last item, send a simple \n instead of C-o.
 115       if {$count == [llength $args] - 2} {
 116         send_gdb "\n"
 117       } else {
 118         # 15 is C-o.
 119         send_gdb [format %c 15]
 120       }
 121       set status 0
 122       gdb_expect {
 123         -re "$result" {
 124           # Ok
 125         }
 126         timeout {
 127           set status 1
 128         }
 129       }
 130     }
 131
 132     if {$status} {
 133       fail "$name - C-o for $item"
 134       return 0
 135     }
 136     pass "$name - C-o for $item"
 137
 138     set count [expr {$count + 2}]
 139   }
 140
 141   # Match the prompt so the next test starts at the right place.
 142   gdb_test "" "" "$name - final prompt"
 143
 144   return 1
 145 }
 146
 147
 148 if $tracelevel {
 149   strace $tracelevel
 150 }
 151
 152 # Don't let a .inputrc file or an existing setting of INPUTRC mess up
 153 # the test results.  Even if /dev/null doesn't exist on the particular
 154 # platform, the readline library will use the default setting just by
 155 # failing to open the file.  OTOH, opening /dev/null successfully will
 156 # also result in the default settings being used since nothing will be
 157 # read from this file.
 158 global env
 159 if [info exists env(INPUTRC)] {
 160     set old_inputrc $env(INPUTRC)
 161 }
 162 set env(INPUTRC) "/dev/null"
 163
 164 # The arrow key test relies on the standard VT100 bindings, so make
 165 # sure that an appropriate terminal is selected.  The same bug
 166 # doesn't show up if we use ^P / ^N instead.
 167 if [info exists env(TERM)] {
 168     set old_term $env(TERM)
 169 }
 170 set env(TERM) "vt100"
 171
 172 gdb_start
 173 gdb_reinitialize_dir $srcdir/$subdir
 174
 175 set oldtimeout1 $timeout
 176 set timeout 30
 177
 178
 179 # A simple test of operate-and-get-next.
 180 operate_and_get_next "Simple operate-and-get-next" \
 181   "p 1" ".* = 1" \
 182   "p 2" ".* = 2" \
 183   "p 3" ".* = 3"
 184
 185 # Test operate-and-get-next with a secondary prompt.
 186 operate_and_get_next "operate-and-get-next with secondary prompt" \
 187   "if 1 > 0" "" \
 188   "p 5" "" \
 189   "end" ".* = 5"
 190
 191 # Verify that arrow keys work in secondary prompts.  The control
 192 # sequence is a hard-coded VT100 up arrow.
 193 gdb_test "print 42" "\\\$\[0-9\]* = 42"
 194 set msg "arrow keys with secondary prompt"
 195 gdb_test_multiple "if 1 > 0\n\033\[A\033\[A\nend" $msg {
 196     -re ".*\\\$\[0-9\]* = 42\r\n$gdb_prompt $" {
 197         pass $msg
 198     }
 199     -re ".*Undefined command:.*$gdb_prompt $" {
 200         fail $msg
 201     }
 202 }
 203
 204 # Now repeat the first test with a history file that fills the entire
 205 # history list.
 206
 207 if [info exists env(GDBHISTFILE)] {
 208     set old_gdbhistfile $env(GDBHISTFILE)
 209 }
 210 if [info exists env(HISTSIZE)] {
 211     set old_histsize $env(HISTSIZE)
 212 }
 213 set env(GDBHISTFILE) "${srcdir}/${subdir}/gdb_history"
 214 set env(HISTSIZE) "10"
 215
 216 gdb_exit
 217 gdb_start
 218 gdb_reinitialize_dir $srcdir/$subdir
 219
 220 operate_and_get_next "Simple operate-and-get-next" \
 221   "p 7" ".* = 7" \
 222   "p 8" ".* = 8" \
 223   "p 9" ".* = 9"
 224
 225
 226 # Restore globals modified in this test...
 227 if [info exists old_inputrc] {
 228     set env(INPUTRC) $old_inputrc
 229 } else {
 230     unset env(INPUTRC)
 231 }
 232 if [info exists old_gdbhistfile] {
 233     set env(GDBHISTFILE) $old_gdbhistfile
 234 } else {
 235     unset env(GDBHISTFILE)
 236 }
 237 if [info exists old_histsize] {
 238     set env(HISTSIZE) $old_histsize
 239 } else {
 240     unset env(HISTSIZE)
 241 }
 242 set timeout $oldtimeout1
 243
 244 return 0