summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-07-05 09:50:10 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-07-05 09:50:10 (GMT)
commit1d8a79987fd062bf83f82fb9bc229e7b0e410606 (patch)
tree8888c1f26150742009e2dba16f8e5286c08b81d5 /tests
parent9609405eafd2fde57e8b3c013767c1390cf00c98 (diff)
downloadtcl-1d8a79987fd062bf83f82fb9bc229e7b0e410606.zip
tcl-1d8a79987fd062bf83f82fb9bc229e7b0e410606.tar.gz
tcl-1d8a79987fd062bf83f82fb9bc229e7b0e410606.tar.bz2
Tidying up and taking better advantage of tcltest2 to make the tests more
robust and (apparently) similar through focusing in on what is really being tested
Diffstat (limited to 'tests')
-rw-r--r--tests/event.test773
1 files changed, 387 insertions, 386 deletions
diff --git a/tests/event.test b/tests/event.test
index 8beda80..c6ac019 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,7 +1,7 @@
# This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "update", and "vwait" Tcl
-# commands. Sourcing this file into Tcl runs the tests and generates
-# output for errors. No output means no errors were found.
+# tclEvent.c, which includes the "update", and "vwait" Tcl commands. Sourcing
+# this file into Tcl runs the tests and generates output for errors. No
+# output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: event.test,v 1.28 2008/06/20 20:48:49 dgp Exp $
+# RCS: @(#) $Id: event.test,v 1.29 2010/07/05 09:50:10 dkf Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -17,30 +17,33 @@ namespace import -force ::tcltest::*
testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
-
-test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
+testConstraint exec [llength [info commands exec]]
+
+test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler} -body {
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
- set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 0} {1 0} {2 0}}
-test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
- # This test is non-portable because on some systems (e.g.
- # SunOS 4.1.3) pipes seem to be writable always.
+} -result {{0 0} {1 0} {2 0}}
+test event-1.2 {Tcl_CreateFileHandler, writing} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
+ # This test is non-portable because on some systems (e.g., SunOS 4.1.3)
+ # pipes seem to be writable always.
testfilehandler create 0 off writable
testfilehandler clear 0
testfilehandler oneevent
- set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
@@ -48,16 +51,17 @@ test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
testfilehandler fill 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {0 2} {0 2}}
-test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+} -result {{0 1} {0 2} {0 2}}
+test event-1.3 {Tcl_DeleteFileHandler} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler create 0 disabled disabled
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -67,16 +71,17 @@ test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
+} -result {{0 1} {1 1} {1 2} {0 0}}
-test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+test event-2.1 {Tcl_DeleteFileHandler} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -86,43 +91,44 @@ test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
- {testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 0 readable writable
testfilehandler fillpartial 0
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {0 0}}
+} -result {{0 1} {0 0}}
-test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
+test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup {
testfilehandler close
+} -constraints {testfilehandler} -body {
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
testfilehandler windowevent
- set result [testfilehandler counts 1]
+ testfilehandler counts 1
+} -cleanup {
testfilehandler close
- set result
-} {0 0}
+} -result {0 0}
-test event-4.1 {FileHandlerEventProc, race between event and disabling} \
- {testfilehandler nonPortable} {
+test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup {
update
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -132,13 +138,13 @@ test event-4.1 {FileHandlerEventProc, race between event and disabling} \
testfilehandler create 1 disabled disabled
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
- {testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup {
update
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 1 readable writable
testfilehandler create 2 readable writable
testfilehandler fillpartial 1
@@ -148,13 +154,14 @@ test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler windowevent
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+} -cleanup {
testfilehandler close
- set result
-} {{0 0} {0 1} {0 0} {0 1}}
+} -result {{0 0} {0 1} {0 0} {0 1}}
update
-test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
catch {rename bgerror {}}
+} -body {
proc bgerror msg {
global errorInfo errorCode x
lappend x [list $msg $errorInfo $errorCode]
@@ -164,18 +171,19 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
after idle {set errorInfo foobar; set errorCode xyzzy}
set x {}
update idletasks
+ regsub -all [file join {} non_existent] $x "non_existent"
+} -cleanup {
rename bgerror {}
- regsub -all [file join {} non_existent] $x "non_existent" x
- set x
-} {{{a simple error} {a simple error
+} -result {{{a simple error} {a simple error
while executing
"error "a simple error""
("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
"open non_existent"
("after" script)} {POSIX ENOENT {no such file or directory}}}}
-test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
catch {rename bgerror {}}
+} -body {
proc bgerror msg {
global x
lappend x $msg
@@ -185,9 +193,10 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
after idle {open non_existent}
set x {}
update idletasks
+ return $x
+} -cleanup {
rename bgerror {}
- set x
-} {{a simple error}}
+} -result {{a simple error}}
test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
variable x
proc demo args {variable x done}
@@ -226,53 +235,60 @@ test event-5.8 {Default [interp bgerror] handler} -body {
test event-5.9 {Default [interp bgerror] handler} -body {
::tcl::Bgerror {} {-level 0 -code ok}
} -returnCodes error -match glob -result {*expected integer*}
-test event-5.10 {Default [interp bgerror] handler} {
+test event-5.10 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror {} {-level 0 -code 0}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {}
-test event-5.11 {Default [interp bgerror] handler} {
+} -result {}
+test event-5.11 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror msg {-level 0 -code 1}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {msg}
-test event-5.12 {Default [interp bgerror] handler} {
+} -result {msg}
+test event-5.12 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror msg {-level 0 -code 2}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {command returned bad code: 2}
-test event-5.13 {Default [interp bgerror] handler} {
+} -result {command returned bad code: 2}
+test event-5.13 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror msg {-level 0 -code 3}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {invoked "break" outside of a loop}
-test event-5.14 {Default [interp bgerror] handler} {
+} -result {invoked "break" outside of a loop}
+test event-5.14 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror msg {-level 0 -code 4}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {invoked "continue" outside of a loop}
-test event-5.15 {Default [interp bgerror] handler} {
+} -result {invoked "continue" outside of a loop}
+test event-5.15 {Default [interp bgerror] handler} -body {
proc bgerror {m} {append ::res $m}
set ::res {}
::tcl::Bgerror msg {-level 0 -code 5}
+ return $::res
+} -cleanup {
rename bgerror {}
- set ::res
-} {command returned bad code: 5}
+} -result {command returned bad code: 5}
-test event-6.1 {BgErrorDeleteProc procedure} {
+test event-6.1 {BgErrorDeleteProc procedure} -setup {
catch {interp delete foo}
interp create foo
set erroutfile [makeFile Unmodified err.out]
+} -body {
foo eval [list set erroutfile $erroutfile]
foo eval {
proc bgerror args {
@@ -291,104 +307,99 @@ test event-6.1 {BgErrorDeleteProc procedure} {
set f [open $erroutfile r]
set result [read $f]
close $f
+ return $result
+} -cleanup {
removeFile $erroutfile
- set result
-} {Unmodified
+} -result {Unmodified
}
test event-7.1 {bgerror / regular} {
set errRes {}
proc bgerror {err} {
- global errRes;
- set errRes $err;
+ global errRes
+ set errRes $err
}
after 0 {error err1}
- vwait errRes;
- set errRes;
+ vwait errRes
+ return $errRes
} err1
-
test event-7.2 {bgerror / accumulation} {
set errRes {}
proc bgerror {err} {
- global errRes;
- lappend errRes $err;
+ global errRes
+ lappend errRes $err
}
after 0 {error err1}
after 0 {error err2}
after 0 {error err3}
update
- set errRes;
+ return $errRes
} {err1 err2 err3}
-
test event-7.3 {bgerror / accumulation / break} {
set errRes {}
proc bgerror {err} {
- global errRes;
- lappend errRes $err;
- return -code break "skip!";
+ global errRes
+ lappend errRes $err
+ return -code break "skip!"
}
after 0 {error err1}
after 0 {error err2}
after 0 {error err3}
update
- set errRes;
+ return $errRes
} err1
-
-test event-7.4 {tkerror is nothing special anymore to tcl} {
+test event-7.4 {tkerror is nothing special anymore to tcl} -body {
set errRes {}
# we don't just rename bgerror to empty because it could then
# be autoloaded...
proc bgerror {err} {
- global errRes;
- lappend errRes "bg:$err";
+ global errRes
+ lappend errRes "bg:$err"
}
proc tkerror {err} {
- global errRes;
- lappend errRes "tk:$err";
+ global errRes
+ lappend errRes "tk:$err"
}
after 0 {error err1}
update
+ return $errRes
+} -cleanup {
rename tkerror {}
- set errRes
-} bg:err1
-
-testConstraint exec [llength [info commands exec]]
-
-test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
- set script {
+} -result bg:err1
+test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body {
+ exec [interpreter] << {
after 1000 error hello
after 2000 set a 0
vwait a
}
-
- list [catch {exec [interpreter] << $script} errMsg] $errMsg
-} {1 {hello
+} -constraints {exec} -returnCodes error -result {hello
while executing
"error hello"
- ("after" script)}}
-
-test event-7.6 {safe hidden bgerror fallback} {
+ ("after" script)}
+test event-7.6 {safe hidden bgerror fallback} -setup {
variable result {}
interp create -safe safe
+} -body {
safe alias puts puts
safe alias result ::append [namespace which -variable result]
safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
safe hide bgerror
safe eval after 0 error foo
update
+ return $result
+} -cleanup {
interp delete safe
- set result
-} {foo
+} -result {foo
NONE
foo
while executing
"error foo"
("after" script)
}
-
-test event-7.7 {safe hidden bgerror fallback} {
+test event-7.7 {safe hidden bgerror fallback} -setup {
variable result {}
interp create -safe safe
+} -body {
safe alias puts puts
safe alias result ::append [namespace which -variable result]
safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
@@ -396,9 +407,10 @@ test event-7.7 {safe hidden bgerror fallback} {
safe eval {proc bgerror m {error bar soom baz}}
safe eval after 0 error foo
update
+ return $result
+} -cleanup {
interp delete safe
- set result
-} {foo
+} -result {foo
NONE
foo
while executing
@@ -406,18 +418,15 @@ foo
("after" script)
}
-
-# someday : add a test checking that
-# when there is no bgerror, an error msg goes to stderr
-# ideally one would use sub interp and transfer a fake stderr
-# to it, unfortunatly the current interp tcl API does not allow
-# that. the other option would be to use fork a test but it
-# then becomes more a file/exec test than a bgerror test.
+# someday : add a test checking that when there is no bgerror, an error msg
+# goes to stderr ideally one would use sub interp and transfer a fake stderr
+# to it, unfortunatly the current interp tcl API does not allow that. The
+# other option would be to use fork a test but it then becomes more a
+# file/exec test than a bgerror test.
# end of bgerror tests
catch {rename bgerror {}}
-
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
@@ -425,7 +434,7 @@ test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 6
even 4
odd 41
@@ -439,7 +448,7 @@ test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 16
even 6
even 4
@@ -452,8 +461,8 @@ test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
flush $child
set result [read $child]
close $child
- set result
- } {even 16
+ return $result
+} {even 16
even 6
odd 41
}
@@ -465,7 +474,7 @@ test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 16
even 4
odd 41
@@ -477,7 +486,7 @@ test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 16
}
@@ -488,22 +497,24 @@ test event-10.1 {Tcl_Exit procedure} {stdio} {
[lindex $::errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}
-test event-11.1 {Tcl_VwaitCmd procedure} {
- list [catch {vwait} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.2 {Tcl_VwaitCmd procedure} {
- list [catch {vwait a b} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.3 {Tcl_VwaitCmd procedure} {
+test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+ vwait
+} -result {wrong # args: should be "vwait name"}
+test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+ vwait a b
+} -result {wrong # args: should be "vwait name"}
+test event-11.3 {Tcl_VwaitCmd procedure} -setup {
catch {unset x}
+} -body {
set x 1
- list [catch {vwait x(1)} msg] $msg
-} {1 {can't trace "x(1)": variable isn't array}}
-test event-11.4 {Tcl_VwaitCmd procedure} {} {
+ vwait x(1)
+} -returnCodes error -result {can't trace "x(1)": variable isn't array}
+test event-11.4 {Tcl_VwaitCmd procedure} -setup {
foreach i [after info] {
after cancel $i
}
after 10; update; # On Mac make sure update won't take long
+} -body {
after 100 {set x x-done}
after 200 {set y y-done}
after 300 {set z z-done}
@@ -513,22 +524,22 @@ test event-11.4 {Tcl_VwaitCmd procedure} {} {
set z before
set q before
list [vwait y] $x $y $z $q
-} {{} x-done y-done before q-done}
-
-foreach i [after info] {
- after cancel $i
-}
-
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} x-done y-done before q-done}
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {
set test1file [makeFile "" test1]
+} -constraints {socket} -body {
set f1 [open $test1file w]
proc accept {s args} {
puts $s foobar
close $s
}
- catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]}
+ set s1 [socket -server accept -myaddr 127.0.0.1 0]
after 1000
- catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
+ set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]
close $s1
set x 0
set y 0
@@ -540,9 +551,10 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
vwait z
close $f1
close $s2
- removeFile $test1file
list $x $y $z
-} {3 3 done}
+} -cleanup {
+ removeFile $test1file
+} -result {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
set test1file [makeFile "" test1]
set test2file [makeFile "" test2]
@@ -562,17 +574,17 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
list $x $y $z
} {3 3 done}
-
-test event-12.1 {Tcl_UpdateCmd procedure} {
- list [catch {update a b} msg] $msg
-} {1 {wrong # args: should be "update ?idletasks?"}}
-test event-12.2 {Tcl_UpdateCmd procedure} {
- list [catch {update bogus} msg] $msg
-} {1 {bad option "bogus": must be idletasks}}
-test event-12.3 {Tcl_UpdateCmd procedure} {
+test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+ update a b
+} -result {wrong # args: should be "update ?idletasks?"}
+test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+ update bogus
+} -result {bad option "bogus": must be idletasks}
+test event-12.3 {Tcl_UpdateCmd procedure} -setup {
foreach i [after info] {
after cancel $i
}
+} -body {
after 500 {set x after}
after idle {set y after}
after idle {set z "after, y = $y"}
@@ -581,11 +593,16 @@ test event-12.3 {Tcl_UpdateCmd procedure} {
set z before
update idletasks
list $x $y $z
-} {before after {after, y = after}}
-test event-12.4 {Tcl_UpdateCmd procedure} {
+} -cleanup {
foreach i [after info] {
after cancel $i
}
+} -result {before after {after, y = after}}
+test event-12.4 {Tcl_UpdateCmd procedure} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -body {
after 10; update; # On Mac make sure update won't take long
after 200 {set x x-done}
after 600 {set y y-done}
@@ -596,327 +613,311 @@ test event-12.4 {Tcl_UpdateCmd procedure} {
after 300
update
list $x $y $z
-} {x-done before z-done}
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {x-done before z-done}
-test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
+test event-13.1 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 0]
update
- testfilehandler close
list $result $x
-} {{} {no timeout}}
-test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {no timeout}}
+test event-13.2 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
- testfilehandler close
list $result $x
-} {{} timeout}
-test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} timeout}
+test event-13.3 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fillpartial 1
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
- testfilehandler close
list $result $x
-} {readable {no timeout}}
-test event-13.4 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {readable {no timeout}}
+test event-13.4 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 0]
update
- testfilehandler close
list $result $x
-} {{} {no timeout}}
-test event-13.5 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {no timeout}}
+test event-13.5 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
- testfilehandler close
list $result $x
-} {{} timeout}
-test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} timeout}
+test event-13.6 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
- testfilehandler close
list $result $x
-} {writable {no timeout}}
-test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
+} -cleanup {
+ testfilehandler close
foreach i [after info] {
after cancel $i
}
+} -result {writable {no timeout}}
+test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+ testfilehandler close
+} -constraints testfilehandler -body {
after 100 lappend x timeout
after idle lappend x idle
- testfilehandler close
testfilehandler create 1 off off
set x ""
set result [list [testfilehandler wait 1 readable 200] $x]
update
- testfilehandler close
lappend result $x
-} {{} {} {timeout idle}}
-
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {} {timeout idle}}
test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
set f [open "|sleep 2" r]
set result ""
lappend result [testfilewait $f readable 100]
lappend result [testfilewait $f readable -1]
close $f
- set result
+ return $result
} {{} readable}
-
-test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \
- -constraints {testfilehandler unix} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 0]
- update
- testfilehandler close
- list $result $x
- } \
- -result {{} {no timeout}} \
- -cleanup {
- foreach chan $chanList {close $chan}
+test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \
- -constraints {testfilehandler unix} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
- } \
- -result {{} timeout} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 0]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \
- -constraints {testfilehandler unix} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fillpartial 1
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
- } \
- -result {readable {no timeout}} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \
- -constraints {testfilehandler unix nonPortable} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 0]
- update
- testfilehandler close
- list $result $
- } \
- -result {{} {no timeout}} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fillpartial 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {readable {no timeout}}
+test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \
- -constraints {testfilehandler unix nonPortable} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
- } \
- -result {{} timeout} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 0]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \
- -constraints {testfilehandler unix} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
- } \
- -result {writable {no timeout}} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \
- -constraints {testfilehandler unix} \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -body {
- foreach i [after info] {
- after cancel $i
- }
- after 100 lappend x timeout
- after idle lappend x idle
- testfilehandler close
- testfilehandler create 1 off off
- set x ""
- set result [list [testfilehandler wait 1 readable 200] $x]
- update
- testfilehandler close
- lappend result $x
- } \
- -result {{} {} {timeout idle}} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {writable {no timeout}}
+test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
-
-test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \
- -constraints {testfilewait unix} \
- -body {
- set f [open "|sleep 2" r]
- set result ""
- lappend result [testfilewait $f readable 100]
- lappend result [testfilewait $f readable -1]
- close $f
- set result
- } \
- -setup {
- set chanList {}
- for {set i 0} {$i < 32} {incr i} {
- lappend chanList [open /dev/null r]
- }
- } \
- -result {{} readable} \
- -cleanup {
- foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 lappend x timeout
+ after idle lappend x idle
+ testfilehandler create 1 off off
+ set x ""
+ set result [list [testfilehandler wait 1 readable 200] $x]
+ update
+ lappend result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {} {timeout idle}}
+test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
}
-
+} -constraints {testfilewait unix} -body {
+ set f [open "|sleep 2" r]
+ set result ""
+ lappend result [testfilewait $f readable 100]
+ lappend result [testfilewait $f readable -1]
+ close $f
+ return $result
+} -cleanup {
+ foreach chan $chanList {close $chan}
+} -result {{} readable}
+
# cleanup
foreach i [after info] {
after cancel $i
}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: