gdb/testsuite/gdb.threads/schedlock.exp

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