gdb/testsuite/gdb.base/readline.exp

   1 # Copyright 2002 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   return 1
 143 }
 144
 145
 146 if $tracelevel {
 147   strace $tracelevel
 148 }
 149
 150 # Don't let a .inputrc file or an existing setting of INPUTRC mess up
 151 # the test results.  Even if /dev/null doesn't exist on the particular
 152 # platform, the readline library will use the default setting just by
 153 # failing to open the file.  OTOH, opening /dev/null successfully will
 154 # also result in the default settings being used since nothing will be
 155 # read from this file.
 156 global env
 157 if [info exists env(INPUTRC)] {
 158     set old_inputrc $env(INPUTRC)
 159 }
 160 set env(INPUTRC) "/dev/null"
 161
 162 gdb_start
 163 gdb_reinitialize_dir $srcdir/$subdir
 164
 165 set oldtimeout1 $timeout
 166 set timeout 30
 167
 168
 169 # A simple test of operate-and-get-next.
 170 operate_and_get_next "Simple operate-and-get-next" \
 171   "p 1" ".* = 1" \
 172   "p 2" ".* = 2"\
 173   "p 3" ".* = 3"
 174
 175 # Test operate-and-get-next with a secondary prompt.
 176 operate_and_get_next "operate-and-get-next with secondary prompt" \
 177   "if 1 > 0" "" \
 178   "p 5" "" \
 179   "end" ".* = 5"
 180
 181
 182 # Restore globals modified in this test...
 183 if [info exists old_inputrc] {
 184     set env(INPUTRC) $old_inputrc
 185 } else {
 186     unset env(INPUTRC)
 187 }
 188 set timeout $oldtimeout1
 189
 190 return 0