gnu/dist/gdb6/gdb/testsuite/gdb.gdb/complaints.exp

   1 # Copyright 2002, 2004
   2 # Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  17
  18 # This file was written by Andrew Cagney (cagney at redhat dot com),
  19 # derived from xfullpath.exp (written by Joel Brobecker), derived from
  20 # selftest.exp (written by Rob Savoye).
  21
  22 if $tracelevel then {
  23     strace $tracelevel
  24 }
  25
  26 set prms_id 0
  27 set bug_id 0
  28
  29 # are we on a target board
  30 if [is_remote target] {
  31     return
  32 }
  33
  34 proc setup_test { executable } {
  35     global gdb_prompt
  36     global timeout
  37
  38     # load yourself into the debugger
  39     # This can take a relatively long time, particularly for testing where
  40     # the executable is being accessed over a network, or where gdb does not
  41     # support partial symbols for a particular target and has to load the
  42     # entire symbol table.  Set the timeout to 10 minutes, which should be
  43     # adequate for most environments (it *has* timed out with 5 min on a
  44     # SPARCstation SLC under moderate load, so this isn't unreasonable).
  45     # After gdb is started, set the timeout to 30 seconds for the duration
  46     # of this test, and then back to the original value.
  47
  48     set oldtimeout $timeout
  49     set timeout 600
  50     verbose "Timeout is now $timeout seconds" 2
  51
  52     global gdb_file_cmd_debug_info
  53     set gdb_file_cmd_debug_info "unset"
  54
  55     set result [gdb_load $executable]
  56     set timeout $oldtimeout
  57     verbose "Timeout is now $timeout seconds" 2
  58
  59     if { $result != 0 } then {
  60         return -1
  61     }
  62
  63     if { $gdb_file_cmd_debug_info != "debug" } then {
  64         untested "No debug information, skipping testcase."
  65         return -1
  66     }
  67
  68     # Set a breakpoint at main
  69     gdb_test "break captured_command_loop" \
  70             "Breakpoint.*at.* file.*, line.*" \
  71             "breakpoint in captured_command_loop"
  72
  73     # run yourself
  74     # It may take a very long time for the inferior gdb to start (lynx),
  75     # so we bump it back up for the duration of this command.
  76     set timeout 600
  77
  78     set description "run until breakpoint at captured_command_loop"
  79     send_gdb "run -nw\n"
  80     gdb_expect {
  81         -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.* at .*main.c:.*$gdb_prompt $" {
  82             pass "$description"
  83         }
  84         -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.*$gdb_prompt $" {
  85             xfail "$description (line numbers scrambled?)"
  86         }
  87         -re "vfork: No more processes.*$gdb_prompt $" {
  88             fail "$description (out of virtual memory)"
  89             set timeout $oldtimeout
  90             verbose "Timeout is now $timeout seconds" 2
  91             return -1
  92         }
  93         -re ".*$gdb_prompt $" {
  94             fail "$description"
  95             set timeout $oldtimeout
  96             verbose "Timeout is now $timeout seconds" 2
  97             return -1
  98         }
  99         timeout {
 100             fail "$description (timeout)"
 101         }
 102     }
 103
 104     set timeout $oldtimeout
 105     verbose "Timeout is now $timeout seconds" 2
 106
 107     return 0
 108 }
 109
 110 proc test_initial_complaints { } {
 111
 112     global gdb_prompt
 113
 114     # Unsupress complaints
 115     gdb_test "set stop_whining = 2"
 116
 117     # Prime the system
 118     gdb_test "call complaint (&symfile_complaints, \"Register a complaint\")" \
 119             "During symbol reading, Register a complaint."
 120
 121     # Check that the complaint was inserted and where
 122     gdb_test "print symfile_complaints->root->fmt" \
 123             ".\[0-9\]+ =.*\"Register a complaint\""
 124
 125     # Re-issue the first message #1
 126     gdb_test "call complaint (&symfile_complaints, symfile_complaints->root->fmt)" \
 127             "During symbol reading, Register a complaint."
 128
 129     # Check that there is only one thing in the list
 130     gdb_test "print symfile_complaints->root->next == &complaint_sentinel" \
 131             ".\[0-9\]+ = 1" "list has one entry"
 132
 133     # Add a second complaint, expect it
 134     gdb_test "call complaint (&symfile_complaints, \"Testing! Testing! Testing!\")" \
 135             "During symbol reading, Testing. Testing. Testing.."
 136
 137     return 0
 138 }
 139
 140 proc test_serial_complaints { } {
 141
 142     global gdb_prompt
 143
 144     gdb_test_exact "call clear_complaints (&symfile_complaints, 1, 0)" "" "serial start"
 145
 146     # Prime the system
 147     send_gdb "call complaint (&symfile_complaints, \"serial line  1\")\n"
 148     gdb_expect {
 149         -re "During symbol reading...serial line  1...$gdb_prompt " {
 150             pass "serial line 1"
 151         }
 152         "$gdb_prompt" {
 153             fail "serial line  1"
 154         }
 155         timeout {
 156             fail "serial line  1 (timeout)"
 157         }
 158     }
 159
 160     # Add a second complaint, expect it
 161     send_gdb "call complaint (&symfile_complaints, \"serial line 2\")\n"
 162     gdb_expect {
 163         -re "serial line 2...$gdb_prompt " {
 164             pass "serial line 2"
 165         }
 166         "$gdb_prompt" {
 167             fail "serial line 2"
 168         }
 169         timeout {
 170             fail "serial line 2 (timeout)"
 171         }
 172     }
 173
 174     send_gdb "call clear_complaints (&symfile_complaints, 1, 0)\n"
 175     gdb_expect {
 176         -re "\r\n\r\n$gdb_prompt " {
 177             pass "serial end"
 178         }
 179         "$gdb_prompt" {
 180             fail "serial end"
 181         }
 182         timeout {
 183             fail "serial end (timeout)"
 184         }
 185     }
 186
 187     return 0
 188 }
 189
 190 # For short complaints, all are the same
 191
 192 proc test_short_complaints { } {
 193
 194     global gdb_prompt
 195
 196     gdb_test_exact "call clear_complaints (&symfile_complaints, 1, 1)" "" "short start"
 197
 198     # Prime the system
 199     send_gdb "call complaint (&symfile_complaints, \"short line 1\")\n"
 200     gdb_expect {
 201         -re "short line 1...$gdb_prompt " {
 202             pass "short line 1"
 203         }
 204         "$gdb_prompt" {
 205             fail "short line 1"
 206         }
 207         timeout {
 208             fail "short line 1 (timeout)"
 209         }
 210     }
 211
 212     # Add a second complaint, expect it
 213     send_gdb "call complaint (&symfile_complaints, \"short line 2\")\n"
 214     gdb_expect {
 215         -re "short line 2...$gdb_prompt " {
 216             pass "short line 2"
 217         }
 218         "$gdb_prompt" {
 219             fail "short line 2"
 220         }
 221         timeout {
 222             fail "short line 2 (timeout)"
 223         }
 224     }
 225
 226     send_gdb "call clear_complaints (&symfile_complaints, 1, 0)\n"
 227     gdb_expect {
 228         -re "\r\n\r\n$gdb_prompt " {
 229             pass "short end"
 230         }
 231         "$gdb_prompt" {
 232             fail "short end"
 233         }
 234         timeout {
 235             fail "short end (timeout)"
 236         }
 237     }
 238
 239     return 0
 240 }
 241
 242 # Check that nothing comes out when there haven't been any real
 243 # complaints.  Note that each test is really checking the previous
 244 # command.
 245
 246 proc test_empty_complaint { cmd msg } {
 247     global gdb_prompt
 248     send_gdb $cmd
 249     gdb_expect {
 250         -re "\r\n\r\n$gdb_prompt " {
 251             fail $msg
 252         }
 253         "\r\n$gdb_prompt" {
 254             pass $msg
 255         }
 256         timeout {
 257             fail "$msg (timeout)"
 258         }
 259     }
 260
 261 }
 262
 263 proc test_empty_complaints { } {
 264
 265     test_empty_complaint "call clear_complaints(&symfile_complaints,0,0)\n" \
 266             "empty non-verbose non-noisy clear"
 267     test_empty_complaint "call clear_complaints(&symfile_complaints,1,0)\n" \
 268             "empty verbose non-noisy clear"
 269     test_empty_complaint "call clear_complaints(&symfile_complaints,1,1)\n" \
 270             "empty verbose noisy clear"
 271     test_empty_complaint "call clear_complaints(&symfile_complaints,0,1)\n" \
 272             "empty non-verbose noisy clear"
 273
 274     return 0
 275 }
 276
 277 # Find a pathname to a file that we would execute if the shell was asked
 278 # to run $arg using the current PATH.
 279
 280 proc find_gdb { arg } {
 281
 282     # If the arg directly specifies an existing executable file, then
 283     # simply use it.
 284
 285     if [file executable $arg] then {
 286         return $arg
 287     }
 288
 289     set result [which $arg]
 290     if [string match "/" [ string range $result 0 0 ]] then {
 291         return $result
 292     }
 293
 294     # If everything fails, just return the unqualified pathname as default
 295     # and hope for best.
 296
 297     return $arg
 298 }
 299
 300 # Run the test with self.
 301 # Copy the file executable file in case this OS doesn't like to edit its own
 302 # text space.
 303
 304 set GDB_FULLPATH [find_gdb $GDB]
 305
 306 # Remove any old copy lying around.
 307 remote_file host delete x$tool
 308
 309 gdb_start
 310
 311 set file [remote_download host $GDB_FULLPATH x$tool]
 312
 313 set setup_result [setup_test $file ]
 314 if {$setup_result <0} then {
 315     return -1
 316 }
 317
 318 test_initial_complaints
 319 test_serial_complaints
 320 test_short_complaints
 321 test_empty_complaints
 322
 323 gdb_exit;
 324 catch "remote_file host delete $file";