os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/event.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/event.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,803 @@
1.4 +# This file contains a collection of tests for the procedures in the file
1.5 +# tclEvent.c, which includes the "update", and "vwait" Tcl
1.6 +# commands. Sourcing this file into Tcl runs the tests and generates
1.7 +# output for errors. No output means no errors were found.
1.8 +#
1.9 +# Copyright (c) 1995-1997 Sun Microsystems, Inc.
1.10 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.11 +#
1.12 +# See the file "license.terms" for information on usage and redistribution
1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 +#
1.15 +# RCS: @(#) $Id: event.test,v 1.20.2.1 2006/11/28 16:29:47 kennykb Exp $
1.16 +
1.17 +package require tcltest 2
1.18 +namespace import -force ::tcltest::*
1.19 +
1.20 +testConstraint testfilehandler [llength [info commands testfilehandler]]
1.21 +testConstraint testexithandler [llength [info commands testexithandler]]
1.22 +testConstraint testfilewait [llength [info commands testfilewait]]
1.23 +
1.24 +test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
1.25 + testfilehandler close
1.26 + testfilehandler create 0 readable off
1.27 + testfilehandler clear 0
1.28 + testfilehandler oneevent
1.29 + set result ""
1.30 + lappend result [testfilehandler counts 0]
1.31 + testfilehandler fillpartial 0
1.32 + testfilehandler oneevent
1.33 + lappend result [testfilehandler counts 0]
1.34 + testfilehandler oneevent
1.35 + lappend result [testfilehandler counts 0]
1.36 + testfilehandler close
1.37 + set result
1.38 +} {{0 0} {1 0} {2 0}}
1.39 +test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
1.40 + # This test is non-portable because on some systems (e.g.
1.41 + # SunOS 4.1.3) pipes seem to be writable always.
1.42 + testfilehandler close
1.43 + testfilehandler create 0 off writable
1.44 + testfilehandler clear 0
1.45 + testfilehandler oneevent
1.46 + set result ""
1.47 + lappend result [testfilehandler counts 0]
1.48 + testfilehandler fillpartial 0
1.49 + testfilehandler oneevent
1.50 + lappend result [testfilehandler counts 0]
1.51 + testfilehandler fill 0
1.52 + testfilehandler oneevent
1.53 + lappend result [testfilehandler counts 0]
1.54 + testfilehandler close
1.55 + set result
1.56 +} {{0 1} {0 2} {0 2}}
1.57 +test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
1.58 + testfilehandler close
1.59 + testfilehandler create 2 disabled disabled
1.60 + testfilehandler create 1 readable writable
1.61 + testfilehandler create 0 disabled disabled
1.62 + testfilehandler fillpartial 1
1.63 + set result ""
1.64 + testfilehandler oneevent
1.65 + lappend result [testfilehandler counts 1]
1.66 + testfilehandler oneevent
1.67 + lappend result [testfilehandler counts 1]
1.68 + testfilehandler oneevent
1.69 + lappend result [testfilehandler counts 1]
1.70 + testfilehandler create 1 off off
1.71 + testfilehandler oneevent
1.72 + lappend result [testfilehandler counts 1]
1.73 + testfilehandler close
1.74 + set result
1.75 +} {{0 1} {1 1} {1 2} {0 0}}
1.76 +
1.77 +test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
1.78 + testfilehandler close
1.79 + testfilehandler create 2 disabled disabled
1.80 + testfilehandler create 1 readable writable
1.81 + testfilehandler fillpartial 1
1.82 + set result ""
1.83 + testfilehandler oneevent
1.84 + lappend result [testfilehandler counts 1]
1.85 + testfilehandler oneevent
1.86 + lappend result [testfilehandler counts 1]
1.87 + testfilehandler oneevent
1.88 + lappend result [testfilehandler counts 1]
1.89 + testfilehandler create 1 off off
1.90 + testfilehandler oneevent
1.91 + lappend result [testfilehandler counts 1]
1.92 + testfilehandler close
1.93 + set result
1.94 +} {{0 1} {1 1} {1 2} {0 0}}
1.95 +test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
1.96 + {testfilehandler nonPortable} {
1.97 + testfilehandler close
1.98 + testfilehandler create 0 readable writable
1.99 + testfilehandler fillpartial 0
1.100 + set result ""
1.101 + testfilehandler oneevent
1.102 + lappend result [testfilehandler counts 0]
1.103 + testfilehandler close
1.104 + testfilehandler create 0 readable writable
1.105 + testfilehandler oneevent
1.106 + lappend result [testfilehandler counts 0]
1.107 + testfilehandler close
1.108 + set result
1.109 +} {{0 1} {0 0}}
1.110 +
1.111 +test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
1.112 + testfilehandler close
1.113 + testfilehandler create 1 readable writable
1.114 + testfilehandler fillpartial 1
1.115 + testfilehandler windowevent
1.116 + set result [testfilehandler counts 1]
1.117 + testfilehandler close
1.118 + set result
1.119 +} {0 0}
1.120 +
1.121 +test event-4.1 {FileHandlerEventProc, race between event and disabling} \
1.122 + {testfilehandler nonPortable} {
1.123 + update
1.124 + testfilehandler close
1.125 + testfilehandler create 2 disabled disabled
1.126 + testfilehandler create 1 readable writable
1.127 + testfilehandler fillpartial 1
1.128 + set result ""
1.129 + testfilehandler oneevent
1.130 + lappend result [testfilehandler counts 1]
1.131 + testfilehandler oneevent
1.132 + lappend result [testfilehandler counts 1]
1.133 + testfilehandler oneevent
1.134 + lappend result [testfilehandler counts 1]
1.135 + testfilehandler create 1 disabled disabled
1.136 + testfilehandler oneevent
1.137 + lappend result [testfilehandler counts 1]
1.138 + testfilehandler close
1.139 + set result
1.140 +} {{0 1} {1 1} {1 2} {0 0}}
1.141 +test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
1.142 + {testfilehandler nonPortable} {
1.143 + update
1.144 + testfilehandler close
1.145 + testfilehandler create 1 readable writable
1.146 + testfilehandler create 2 readable writable
1.147 + testfilehandler fillpartial 1
1.148 + testfilehandler fillpartial 2
1.149 + testfilehandler oneevent
1.150 + set result ""
1.151 + lappend result [testfilehandler counts 1] [testfilehandler counts 2]
1.152 + testfilehandler windowevent
1.153 + lappend result [testfilehandler counts 1] [testfilehandler counts 2]
1.154 + testfilehandler close
1.155 + set result
1.156 +} {{0 0} {0 1} {0 0} {0 1}}
1.157 +update
1.158 +
1.159 +test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
1.160 + catch {rename bgerror {}}
1.161 + proc bgerror msg {
1.162 + global errorInfo errorCode x
1.163 + lappend x [list $msg $errorInfo $errorCode]
1.164 + }
1.165 + after idle {error "a simple error"}
1.166 + after idle {open non_existent}
1.167 + after idle {set errorInfo foobar; set errorCode xyzzy}
1.168 + set x {}
1.169 + update idletasks
1.170 + rename bgerror {}
1.171 + regsub -all [file join {} non_existent] $x "non_existent" x
1.172 + set x
1.173 +} {{{a simple error} {a simple error
1.174 + while executing
1.175 +"error "a simple error""
1.176 + ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
1.177 + while executing
1.178 +"open non_existent"
1.179 + ("after" script)} {POSIX ENOENT {no such file or directory}}}}
1.180 +test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
1.181 + catch {rename bgerror {}}
1.182 + proc bgerror msg {
1.183 + global x
1.184 + lappend x $msg
1.185 + return -code break
1.186 + }
1.187 + after idle {error "a simple error"}
1.188 + after idle {open non_existent}
1.189 + set x {}
1.190 + update idletasks
1.191 + rename bgerror {}
1.192 + set x
1.193 +} {{a simple error}}
1.194 +
1.195 +test event-6.1 {BgErrorDeleteProc procedure} {
1.196 + catch {interp delete foo}
1.197 + interp create foo
1.198 + set erroutfile [makeFile Unmodified err.out]
1.199 + foo eval [list set erroutfile $erroutfile]
1.200 + foo eval {
1.201 + proc bgerror args {
1.202 + global errorInfo erroutfile
1.203 + set f [open $erroutfile r+]
1.204 + seek $f 0 end
1.205 + puts $f "$args $errorInfo"
1.206 + close $f
1.207 + }
1.208 + after 100 {error "first error"}
1.209 + after 100 {error "second error"}
1.210 + }
1.211 + after 100 {interp delete foo}
1.212 + after 200
1.213 + update
1.214 + set f [open $erroutfile r]
1.215 + set result [read $f]
1.216 + close $f
1.217 + removeFile $erroutfile
1.218 + set result
1.219 +} {Unmodified
1.220 +}
1.221 +
1.222 +test event-7.1 {bgerror / regular} {
1.223 + set errRes {}
1.224 + proc bgerror {err} {
1.225 + global errRes;
1.226 + set errRes $err;
1.227 + }
1.228 + after 0 {error err1}
1.229 + vwait errRes;
1.230 + set errRes;
1.231 +} err1
1.232 +
1.233 +test event-7.2 {bgerror / accumulation} {
1.234 + set errRes {}
1.235 + proc bgerror {err} {
1.236 + global errRes;
1.237 + lappend errRes $err;
1.238 + }
1.239 + after 0 {error err1}
1.240 + after 0 {error err2}
1.241 + after 0 {error err3}
1.242 + update
1.243 + set errRes;
1.244 +} {err1 err2 err3}
1.245 +
1.246 +test event-7.3 {bgerror / accumulation / break} {
1.247 + set errRes {}
1.248 + proc bgerror {err} {
1.249 + global errRes;
1.250 + lappend errRes $err;
1.251 + return -code break "skip!";
1.252 + }
1.253 + after 0 {error err1}
1.254 + after 0 {error err2}
1.255 + after 0 {error err3}
1.256 + update
1.257 + set errRes;
1.258 +} err1
1.259 +
1.260 +test event-7.4 {tkerror is nothing special anymore to tcl} {
1.261 + set errRes {}
1.262 + # we don't just rename bgerror to empty because it could then
1.263 + # be autoloaded...
1.264 + proc bgerror {err} {
1.265 + global errRes;
1.266 + lappend errRes "bg:$err";
1.267 + }
1.268 + proc tkerror {err} {
1.269 + global errRes;
1.270 + lappend errRes "tk:$err";
1.271 + }
1.272 + after 0 {error err1}
1.273 + update
1.274 + rename tkerror {}
1.275 + set errRes
1.276 +} bg:err1
1.277 +
1.278 +testConstraint exec [llength [info commands exec]]
1.279 +
1.280 +test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
1.281 + set script {
1.282 + after 1000 error hello
1.283 + after 2000 set a 0
1.284 + vwait a
1.285 + }
1.286 +
1.287 + list [catch {exec [interpreter] << $script} errMsg] $errMsg
1.288 +} {1 {hello
1.289 + while executing
1.290 +"error hello"
1.291 + ("after" script)}}
1.292 +
1.293 +
1.294 +# someday : add a test checking that
1.295 +# when there is no bgerror, an error msg goes to stderr
1.296 +# ideally one would use sub interp and transfer a fake stderr
1.297 +# to it, unfortunatly the current interp tcl API does not allow
1.298 +# that. the other option would be to use fork a test but it
1.299 +# then becomes more a file/exec test than a bgerror test.
1.300 +
1.301 +# end of bgerror tests
1.302 +catch {rename bgerror {}}
1.303 +
1.304 +
1.305 +test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
1.306 + set child [open |[list [interpreter]] r+]
1.307 + puts $child "testexithandler create 41; testexithandler create 4"
1.308 + puts $child "testexithandler create 6; exit"
1.309 + flush $child
1.310 + set result [read $child]
1.311 + close $child
1.312 + set result
1.313 +} {even 6
1.314 +even 4
1.315 +odd 41
1.316 +}
1.317 +
1.318 +test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
1.319 + set child [open |[list [interpreter]] r+]
1.320 + puts $child "testexithandler create 41; testexithandler create 4"
1.321 + puts $child "testexithandler create 6; testexithandler delete 41"
1.322 + puts $child "testexithandler create 16; exit"
1.323 + flush $child
1.324 + set result [read $child]
1.325 + close $child
1.326 + set result
1.327 +} {even 16
1.328 +even 6
1.329 +even 4
1.330 +}
1.331 +test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
1.332 + set child [open |[list [interpreter]] r+]
1.333 + puts $child "testexithandler create 41; testexithandler create 4"
1.334 + puts $child "testexithandler create 6; testexithandler delete 4"
1.335 + puts $child "testexithandler create 16; exit"
1.336 + flush $child
1.337 + set result [read $child]
1.338 + close $child
1.339 + set result
1.340 + } {even 16
1.341 +even 6
1.342 +odd 41
1.343 +}
1.344 +test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
1.345 + set child [open |[list [interpreter]] r+]
1.346 + puts $child "testexithandler create 41; testexithandler create 4"
1.347 + puts $child "testexithandler create 6; testexithandler delete 6"
1.348 + puts $child "testexithandler create 16; exit"
1.349 + flush $child
1.350 + set result [read $child]
1.351 + close $child
1.352 + set result
1.353 +} {even 16
1.354 +even 4
1.355 +odd 41
1.356 +}
1.357 +test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
1.358 + set child [open |[list [interpreter]] r+]
1.359 + puts $child "testexithandler create 41; testexithandler delete 41"
1.360 + puts $child "testexithandler create 16; exit"
1.361 + flush $child
1.362 + set result [read $child]
1.363 + close $child
1.364 + set result
1.365 +} {even 16
1.366 +}
1.367 +
1.368 +test event-10.1 {Tcl_Exit procedure} {stdio} {
1.369 + set child [open |[list [interpreter]] r+]
1.370 + puts $child "exit 3"
1.371 + list [catch {close $child} msg] $msg [lindex $errorCode 0] \
1.372 + [lindex $errorCode 2]
1.373 +} {1 {child process exited abnormally} CHILDSTATUS 3}
1.374 +
1.375 +test event-11.1 {Tcl_VwaitCmd procedure} {
1.376 + list [catch {vwait} msg] $msg
1.377 +} {1 {wrong # args: should be "vwait name"}}
1.378 +test event-11.2 {Tcl_VwaitCmd procedure} {
1.379 + list [catch {vwait a b} msg] $msg
1.380 +} {1 {wrong # args: should be "vwait name"}}
1.381 +test event-11.3 {Tcl_VwaitCmd procedure} {
1.382 + catch {unset x}
1.383 + set x 1
1.384 + list [catch {vwait x(1)} msg] $msg
1.385 +} {1 {can't trace "x(1)": variable isn't array}}
1.386 +test event-11.4 {Tcl_VwaitCmd procedure} {} {
1.387 + foreach i [after info] {
1.388 + after cancel $i
1.389 + }
1.390 + after 10; update; # On Mac make sure update won't take long
1.391 + after 100 {set x x-done}
1.392 + after 200 {set y y-done}
1.393 + after 300 {set z z-done}
1.394 + after idle {set q q-done}
1.395 + set x before
1.396 + set y before
1.397 + set z before
1.398 + set q before
1.399 + list [vwait y] $x $y $z $q
1.400 +} {{} x-done y-done before q-done}
1.401 +
1.402 +foreach i [after info] {
1.403 + after cancel $i
1.404 +}
1.405 +
1.406 +test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
1.407 + set test1file [makeFile "" test1]
1.408 + set f1 [open $test1file w]
1.409 + proc accept {s args} {
1.410 + puts $s foobar
1.411 + close $s
1.412 + }
1.413 + catch {set s1 [socket -server accept 0]}
1.414 + after 1000
1.415 + catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
1.416 + close $s1
1.417 + set x 0
1.418 + set y 0
1.419 + set z 0
1.420 + fileevent $s2 readable {incr z}
1.421 + vwait z
1.422 + fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
1.423 + fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
1.424 + vwait z
1.425 + close $f1
1.426 + close $s2
1.427 + removeFile $test1file
1.428 + list $x $y $z
1.429 +} {3 3 done}
1.430 +test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
1.431 + set test1file [makeFile "" test1]
1.432 + set test2file [makeFile "" test2]
1.433 + set f1 [open $test1file w]
1.434 + set f2 [open $test2file w]
1.435 + set x 0
1.436 + set y 0
1.437 + set z 0
1.438 + update
1.439 + fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
1.440 + fileevent $f2 writable {incr y; if {$x == 3} {set z done}}
1.441 + vwait z
1.442 + close $f1
1.443 + close $f2
1.444 + removeFile $test1file
1.445 + removeFile $test2file
1.446 + list $x $y $z
1.447 +} {3 3 done}
1.448 +
1.449 +
1.450 +test event-12.1 {Tcl_UpdateCmd procedure} {
1.451 + list [catch {update a b} msg] $msg
1.452 +} {1 {wrong # args: should be "update ?idletasks?"}}
1.453 +test event-12.2 {Tcl_UpdateCmd procedure} {
1.454 + list [catch {update bogus} msg] $msg
1.455 +} {1 {bad option "bogus": must be idletasks}}
1.456 +test event-12.3 {Tcl_UpdateCmd procedure} {
1.457 + foreach i [after info] {
1.458 + after cancel $i
1.459 + }
1.460 + after 500 {set x after}
1.461 + after idle {set y after}
1.462 + after idle {set z "after, y = $y"}
1.463 + set x before
1.464 + set y before
1.465 + set z before
1.466 + update idletasks
1.467 + list $x $y $z
1.468 +} {before after {after, y = after}}
1.469 +test event-12.4 {Tcl_UpdateCmd procedure} {
1.470 + foreach i [after info] {
1.471 + after cancel $i
1.472 + }
1.473 + after 10; update; # On Mac make sure update won't take long
1.474 + after 200 {set x x-done}
1.475 + after 600 {set y y-done}
1.476 + after idle {set z z-done}
1.477 + set x before
1.478 + set y before
1.479 + set z before
1.480 + after 300
1.481 + update
1.482 + list $x $y $z
1.483 +} {x-done before z-done}
1.484 +
1.485 +test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
1.486 + foreach i [after info] {
1.487 + after cancel $i
1.488 + }
1.489 + after 100 set x timeout
1.490 + testfilehandler close
1.491 + testfilehandler create 1 off off
1.492 + set x "no timeout"
1.493 + set result [testfilehandler wait 1 readable 0]
1.494 + update
1.495 + testfilehandler close
1.496 + list $result $x
1.497 +} {{} {no timeout}}
1.498 +test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
1.499 + foreach i [after info] {
1.500 + after cancel $i
1.501 + }
1.502 + after 100 set x timeout
1.503 + testfilehandler close
1.504 + testfilehandler create 1 off off
1.505 + set x "no timeout"
1.506 + set result [testfilehandler wait 1 readable 100]
1.507 + update
1.508 + testfilehandler close
1.509 + list $result $x
1.510 +} {{} timeout}
1.511 +test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
1.512 + foreach i [after info] {
1.513 + after cancel $i
1.514 + }
1.515 + after 100 set x timeout
1.516 + testfilehandler close
1.517 + testfilehandler create 1 off off
1.518 + testfilehandler fillpartial 1
1.519 + set x "no timeout"
1.520 + set result [testfilehandler wait 1 readable 100]
1.521 + update
1.522 + testfilehandler close
1.523 + list $result $x
1.524 +} {readable {no timeout}}
1.525 +test event-13.4 {Tcl_WaitForFile procedure, writable} \
1.526 + {testfilehandler nonPortable} {
1.527 + foreach i [after info] {
1.528 + after cancel $i
1.529 + }
1.530 + after 100 set x timeout
1.531 + testfilehandler close
1.532 + testfilehandler create 1 off off
1.533 + testfilehandler fill 1
1.534 + set x "no timeout"
1.535 + set result [testfilehandler wait 1 writable 0]
1.536 + update
1.537 + testfilehandler close
1.538 + list $result $x
1.539 +} {{} {no timeout}}
1.540 +test event-13.5 {Tcl_WaitForFile procedure, writable} \
1.541 + {testfilehandler nonPortable} {
1.542 + foreach i [after info] {
1.543 + after cancel $i
1.544 + }
1.545 + after 100 set x timeout
1.546 + testfilehandler close
1.547 + testfilehandler create 1 off off
1.548 + testfilehandler fill 1
1.549 + set x "no timeout"
1.550 + set result [testfilehandler wait 1 writable 100]
1.551 + update
1.552 + testfilehandler close
1.553 + list $result $x
1.554 +} {{} timeout}
1.555 +test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
1.556 + foreach i [after info] {
1.557 + after cancel $i
1.558 + }
1.559 + after 100 set x timeout
1.560 + testfilehandler close
1.561 + testfilehandler create 1 off off
1.562 + set x "no timeout"
1.563 + set result [testfilehandler wait 1 writable 100]
1.564 + update
1.565 + testfilehandler close
1.566 + list $result $x
1.567 +} {writable {no timeout}}
1.568 +test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
1.569 + foreach i [after info] {
1.570 + after cancel $i
1.571 + }
1.572 + after 100 lappend x timeout
1.573 + after idle lappend x idle
1.574 + testfilehandler close
1.575 + testfilehandler create 1 off off
1.576 + set x ""
1.577 + set result [list [testfilehandler wait 1 readable 200] $x]
1.578 + update
1.579 + testfilehandler close
1.580 + lappend result $x
1.581 +} {{} {} {timeout idle}}
1.582 +
1.583 +test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
1.584 + set f [open "|sleep 2" r]
1.585 + set result ""
1.586 + lappend result [testfilewait $f readable 100]
1.587 + lappend result [testfilewait $f readable -1]
1.588 + close $f
1.589 + set result
1.590 +} {{} readable}
1.591 +
1.592 +
1.593 +test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \
1.594 + -constraints {testfilehandler unix} \
1.595 + -setup {
1.596 + set chanList {}
1.597 + for {set i 0} {$i < 32} {incr i} {
1.598 + lappend chanList [open /dev/null r]
1.599 + }
1.600 + } \
1.601 + -body {
1.602 + foreach i [after info] {
1.603 + after cancel $i
1.604 + }
1.605 + after 100 set x timeout
1.606 + testfilehandler close
1.607 + testfilehandler create 1 off off
1.608 + set x "no timeout"
1.609 + set result [testfilehandler wait 1 readable 0]
1.610 + update
1.611 + testfilehandler close
1.612 + list $result $x
1.613 + } \
1.614 + -result {{} {no timeout}} \
1.615 + -cleanup {
1.616 + foreach chan $chanList {close $chan}
1.617 + }
1.618 +
1.619 +test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \
1.620 + -constraints {testfilehandler unix} \
1.621 + -setup {
1.622 + set chanList {}
1.623 + for {set i 0} {$i < 32} {incr i} {
1.624 + lappend chanList [open /dev/null r]
1.625 + }
1.626 + } \
1.627 + -body {
1.628 + foreach i [after info] {
1.629 + after cancel $i
1.630 + }
1.631 + after 100 set x timeout
1.632 + testfilehandler close
1.633 + testfilehandler create 1 off off
1.634 + set x "no timeout"
1.635 + set result [testfilehandler wait 1 readable 100]
1.636 + update
1.637 + testfilehandler close
1.638 + list $result $x
1.639 + } \
1.640 + -result {{} timeout} \
1.641 + -cleanup {
1.642 + foreach chan $chanList {close $chan}
1.643 + }
1.644 +
1.645 +test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \
1.646 + -constraints {testfilehandler unix} \
1.647 + -setup {
1.648 + set chanList {}
1.649 + for {set i 0} {$i < 32} {incr i} {
1.650 + lappend chanList [open /dev/null r]
1.651 + }
1.652 + } \
1.653 + -body {
1.654 + foreach i [after info] {
1.655 + after cancel $i
1.656 + }
1.657 + after 100 set x timeout
1.658 + testfilehandler close
1.659 + testfilehandler create 1 off off
1.660 + testfilehandler fillpartial 1
1.661 + set x "no timeout"
1.662 + set result [testfilehandler wait 1 readable 100]
1.663 + update
1.664 + testfilehandler close
1.665 + list $result $x
1.666 + } \
1.667 + -result {readable {no timeout}} \
1.668 + -cleanup {
1.669 + foreach chan $chanList {close $chan}
1.670 + }
1.671 +
1.672 +test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \
1.673 + -constraints {testfilehandler unix nonPortable} \
1.674 + -setup {
1.675 + set chanList {}
1.676 + for {set i 0} {$i < 32} {incr i} {
1.677 + lappend chanList [open /dev/null r]
1.678 + }
1.679 + } \
1.680 + -body {
1.681 + foreach i [after info] {
1.682 + after cancel $i
1.683 + }
1.684 + after 100 set x timeout
1.685 + testfilehandler close
1.686 + testfilehandler create 1 off off
1.687 + testfilehandler fill 1
1.688 + set x "no timeout"
1.689 + set result [testfilehandler wait 1 writable 0]
1.690 + update
1.691 + testfilehandler close
1.692 + list $result $
1.693 + } \
1.694 + -result {{} {no timeout}} \
1.695 + -cleanup {
1.696 + foreach chan $chanList {close $chan}
1.697 + }
1.698 +
1.699 +test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \
1.700 + -constraints {testfilehandler unix nonPortable} \
1.701 + -setup {
1.702 + set chanList {}
1.703 + for {set i 0} {$i < 32} {incr i} {
1.704 + lappend chanList [open /dev/null r]
1.705 + }
1.706 + } \
1.707 + -body {
1.708 + foreach i [after info] {
1.709 + after cancel $i
1.710 + }
1.711 + after 100 set x timeout
1.712 + testfilehandler close
1.713 + testfilehandler create 1 off off
1.714 + testfilehandler fill 1
1.715 + set x "no timeout"
1.716 + set result [testfilehandler wait 1 writable 100]
1.717 + update
1.718 + testfilehandler close
1.719 + list $result $x
1.720 + } \
1.721 + -result {{} timeout} \
1.722 + -cleanup {
1.723 + foreach chan $chanList {close $chan}
1.724 + }
1.725 +
1.726 +test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \
1.727 + -constraints {testfilehandler unix} \
1.728 + -setup {
1.729 + set chanList {}
1.730 + for {set i 0} {$i < 32} {incr i} {
1.731 + lappend chanList [open /dev/null r]
1.732 + }
1.733 + } \
1.734 + -body {
1.735 + foreach i [after info] {
1.736 + after cancel $i
1.737 + }
1.738 + after 100 set x timeout
1.739 + testfilehandler close
1.740 + testfilehandler create 1 off off
1.741 + set x "no timeout"
1.742 + set result [testfilehandler wait 1 writable 100]
1.743 + update
1.744 + testfilehandler close
1.745 + list $result $x
1.746 + } \
1.747 + -result {writable {no timeout}} \
1.748 + -cleanup {
1.749 + foreach chan $chanList {close $chan}
1.750 + }
1.751 +
1.752 +test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \
1.753 + -constraints {testfilehandler unix} \
1.754 + -setup {
1.755 + set chanList {}
1.756 + for {set i 0} {$i < 32} {incr i} {
1.757 + lappend chanList [open /dev/null r]
1.758 + }
1.759 + } \
1.760 + -body {
1.761 + foreach i [after info] {
1.762 + after cancel $i
1.763 + }
1.764 + after 100 lappend x timeout
1.765 + after idle lappend x idle
1.766 + testfilehandler close
1.767 + testfilehandler create 1 off off
1.768 + set x ""
1.769 + set result [list [testfilehandler wait 1 readable 200] $x]
1.770 + update
1.771 + testfilehandler close
1.772 + lappend result $x
1.773 + } \
1.774 + -result {{} {} {timeout idle}} \
1.775 + -cleanup {
1.776 + foreach chan $chanList {close $chan}
1.777 + }
1.778 +
1.779 +
1.780 +test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \
1.781 + -constraints {testfilewait unix} \
1.782 + -body {
1.783 + set f [open "|sleep 2" r]
1.784 + set result ""
1.785 + lappend result [testfilewait $f readable 100]
1.786 + lappend result [testfilewait $f readable -1]
1.787 + close $f
1.788 + set result
1.789 + } \
1.790 + -setup {
1.791 + set chanList {}
1.792 + for {set i 0} {$i < 32} {incr i} {
1.793 + lappend chanList [open /dev/null r]
1.794 + }
1.795 + } \
1.796 + -result {{} readable} \
1.797 + -cleanup {
1.798 + foreach chan $chanList {close $chan}
1.799 + }
1.800 +
1.801 +# cleanup
1.802 +foreach i [after info] {
1.803 + after cancel $i
1.804 +}
1.805 +::tcltest::cleanupTests
1.806 +return