gnu/dist/gdb6/gdb/testsuite/gdb.threads/schedlock.exp

   1 # Copyright (C) 1996, 1997, 2002, 2003 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 Daniel Jacobowitz <drow@mvista.com>
  21 # (parts based on pthreads.exp by Fred Fish (fnf@cygnus.com).
  22 #
  23 # This test covers the various forms of "set scheduler-locking".
  24
  25 if $tracelevel then {
  26         strace $tracelevel
  27 }
  28
  29 set prms_id 0
  30 set bug_id 0
  31
  32 set testfile "schedlock"
  33 set srcfile ${testfile}.c
  34 set binfile ${objdir}/${subdir}/${testfile}
  35
  36 if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug "incdir=${objdir}"]] != "" } {
  37     return -1
  38 }
  39
  40 # Now we can proceed with the real testing.
  41
  42 proc get_args { } {
  43   global list_count
  44   global gdb_prompt
  45
  46   send_gdb "print args\n"
  47   gdb_expect {
  48     -re "\\\$\[0-9\]+ = {(\[0-9\]+), (\[0-9\]+), (\[0-9\]+), (\[0-9\]+), (\[0-9\]+), (\[0-9\]+)}.*$gdb_prompt"
  49       {
  50         set list_count [expr $list_count + 1]
  51         pass "listed args ($list_count)"
  52         return [list $expect_out(1,string) $expect_out(2,string) $expect_out(3,string) $expect_out(4,string) $expect_out(5,string) $expect_out(6,string)]
  53       }
  54     -re "$gdb_prompt"
  55       {
  56         fail "listed args ($list_count) (unknown output)"
  57       }
  58     timeout
  59       {
  60         fail "listed args ($list_count) (timeout)"
  61       }
  62   }
  63 }
  64
  65 proc stop_process { description } {
  66   global gdb_prompt
  67
  68   # For this to work we must be sure to consume the "Continuing."
  69   # message first, or GDB's signal handler may not be in place.
  70   after 1000 {send_gdb "\003"}
  71   gdb_expect {
  72     -re "Program received signal SIGINT.*$gdb_prompt $"
  73       {
  74         pass $description
  75       }
  76     timeout
  77       {
  78         fail "$description (timeout)"
  79       }
  80   }
  81 }
  82
  83 proc get_current_thread { description } {
  84   global gdb_prompt
  85
  86   send_gdb "bt\n"
  87   gdb_expect {
  88     -re "thread_function \\(arg=0x(\[0-9\])\\).*$gdb_prompt $"
  89       {
  90         pass $description
  91         return $expect_out(1,string)
  92       }
  93     -re "$gdb_prompt $"
  94       {
  95         fail "$description (unknown output)"
  96       }
  97     timeout
  98       {
  99         fail "$description (timeout)"
 100       }
 101   }
 102 }
 103
 104 proc my_continue { msg } {
 105   send_gdb "continue\n"
 106   gdb_expect {
 107     -re "Continuing"
 108       { pass "continue ($msg)" }
 109     timeout
 110       { fail "continue ($msg) (timeout)" }
 111   }
 112
 113   stop_process "stop all threads ($msg)"
 114
 115   # Make sure we're in one of the non-main looping threads.
 116   gdb_breakpoint [concat [gdb_get_line_number "schedlock.exp: main loop"] " if arg != 5"]
 117   gdb_continue_to_breakpoint "return to loop ($msg)"
 118   delete_breakpoints
 119 }
 120
 121 proc step_ten_loops { msg } {
 122     global gdb_prompt
 123
 124     for {set i 0} {[expr $i < 10]} {set i [expr $i + 1]} {
 125         send_gdb "step\n"
 126         set other_step 0
 127         gdb_expect {
 128             -re ".*myp\\) \\+\\+;\[\r\n\]+$gdb_prompt $" {
 129                 pass "step to increment ($msg $i)"
 130             }
 131             -re "$gdb_prompt $" {
 132                 if {$other_step == 0} {
 133                     set other_step 1
 134                     send_gdb "step\n"
 135                     exp_continue
 136                 } else {
 137                     fail "step to increment ($msg $i)"
 138                     # FIXME cascade?
 139                 }
 140             }
 141             timeout {
 142                 fail "step to increment ($msg $i) (timeout)"
 143             }
 144         }
 145     }
 146 }
 147
 148 # Start with a fresh gdb.
 149
 150 gdb_exit
 151 gdb_start
 152 gdb_reinitialize_dir $srcdir/$subdir
 153
 154 # We'll need this when we send_gdb a ^C to GDB.  Need to do it before we
 155 # run the program and gdb starts saving and restoring tty states.
 156 # On Ultrix, we don't need it and it is really slow (because shell_escape
 157 # doesn't use vfork).
 158 if ![istarget "*-*-ultrix*"] then {
 159     gdb_test "shell stty intr '^C'" ""
 160 }
 161
 162 gdb_load ${binfile}
 163
 164 gdb_test "set print sevenbit-strings" ""
 165 gdb_test "set width 0" ""
 166
 167 runto_main
 168
 169 # See if scheduler locking is available on this target.
 170 send_gdb "set scheduler-locking off\n"
 171 global gdb_prompt
 172 gdb_expect {
 173   -re "Target .* cannot support this command"
 174     {
 175       unsupported "target does not support scheduler locking"
 176       return
 177     }
 178   -re "$gdb_prompt $"
 179     {
 180       pass "scheduler locking set to none"
 181     }
 182   timeout
 183     {
 184       unsupported "target does not support scheduler locking (timeout)"
 185       return
 186     }
 187 }
 188
 189 gdb_breakpoint [gdb_get_line_number "schedlock.exp: last thread start"]
 190 gdb_continue_to_breakpoint "all threads started"
 191
 192 global list_count
 193 set list_count 0
 194
 195 set start_args [get_args]
 196
 197 # First make sure that all threads are alive.
 198 my_continue "initial"
 199
 200 set cont_args [get_args]
 201
 202 for {set i 0} {[expr $i < 6]} {set i [expr $i + 1]} {
 203   if {[lindex $start_args $i] == [lindex $cont_args $i]} {
 204     fail "thread $i ran (didn't run)"
 205   } else {
 206     pass "thread $i ran"
 207   }
 208 }
 209
 210 # We can't change threads, unfortunately, in current GDB.  Use
 211 # whichever we stopped in.
 212 set curthread [get_current_thread "find current thread (1)"]
 213
 214
 215
 216
 217 # Test stepping without scheduler locking.
 218 gdb_test "set scheduler-locking off"  ""
 219
 220 step_ten_loops "unlocked"
 221
 222 # Make sure we're still in the same thread.
 223 set newthread [get_current_thread "find current thread (2)"]
 224 if {$curthread == $newthread} {
 225     pass "step without lock does not change thread"
 226 } else {
 227     fail "step without lock does not change thread (switched to thread $newthread)"
 228 }
 229
 230 set start_args $cont_args
 231 set cont_args [get_args]
 232
 233 set num_other_threads 0
 234 for {set i 0} {[expr $i < 6]} {set i [expr $i + 1]} {
 235   if {[lindex $start_args $i] == [lindex $cont_args $i]} {
 236     if {$i == $curthread} {
 237       fail "current thread stepped (didn't run)"
 238     }
 239   } else {
 240     if {$i == $curthread} {
 241         if {[lindex $start_args $i] == [expr [lindex $cont_args $i] - 10]} {
 242             pass "current thread stepped"
 243         } else {
 244             fail "current thread stepped (wrong amount)"
 245         }
 246     } else {
 247       set num_other_threads [expr $num_other_threads + 1]
 248     }
 249   }
 250 }
 251 if {$num_other_threads > 0} {
 252   pass "other threads ran (1)"
 253 } else {
 254   fail "other threads ran (no other threads ran) (1)"
 255 }
 256
 257 # Test continue with scheduler locking
 258 gdb_test "set scheduler-locking on"  ""
 259
 260 my_continue "with lock"
 261
 262 # Make sure we're still in the same thread.
 263 set newthread [get_current_thread "find current thread (3)"]
 264 if {$curthread == $newthread} {
 265     pass "continue with lock does not change thread"
 266 } else {
 267     fail "continue with lock does not change thread (switched to thread $newthread)"
 268 }
 269
 270 set start_args $cont_args
 271 set cont_args [get_args]
 272
 273 for {set i 0} {[expr $i < 6]} {set i [expr $i + 1]} {
 274   if {[lindex $start_args $i] == [lindex $cont_args $i]} {
 275     if {$i == $curthread} {
 276       fail "current thread ran (didn't run)"
 277     } else {
 278       pass "other thread $i didn't run"
 279     }
 280   } else {
 281     if {$i == $curthread} {
 282       pass "current thread ran"
 283     } else {
 284       fail "other thread $i didn't run (ran)"
 285     }
 286   }
 287 }
 288
 289 # Test stepping with scheduler locking
 290 step_ten_loops "locked"
 291
 292 # Make sure we're still in the same thread.
 293 set newthread [get_current_thread "find current thread (2)"]
 294 if {$curthread == $newthread} {
 295     pass "step with lock does not change thread"
 296 } else {
 297     fail "step with lock does not change thread (switched to thread $newthread)"
 298 }
 299
 300 set start_args $cont_args
 301 set cont_args [get_args]
 302
 303 for {set i 0} {[expr $i < 6]} {set i [expr $i + 1]} {
 304   if {[lindex $start_args $i] == [lindex $cont_args $i]} {
 305     if {$i == $curthread} {
 306       fail "current thread stepped locked (didn't run)"
 307     } else {
 308       pass "other thread $i didn't run (stepping)"
 309     }
 310   } else {
 311     if {$i == $curthread} {
 312         if {[lindex $start_args $i] == [expr [lindex $cont_args $i] - 10]} {
 313             pass "current thread stepped locked"
 314         } else {
 315             fail "current thread stepped locked (wrong amount)"
 316         }
 317     } else {
 318       fail "other thread $i didn't run (stepping) (ran)"
 319     }
 320   }
 321 }
 322
 323 return 0