gdb/testsuite/gdb.base/readline.exp

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