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