Assorted improvements to make better use of tcltest2

1 files changed, 165 insertions, 143 deletions

diff --git a/tests/timer.test b/tests/timer.test
index 6eecb7c..16eff33 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -13,30 +13,36 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: timer.test,v 1.12 2005/11/09 21:28:36 kennykb Exp $
+# RCS: @(#) $Id: timer.test,v 1.13 2008/04/23 15:44:38 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-test timer-1.1 {Tcl_CreateTimerHandler procedure} {
+test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x ""
     foreach i {100 200 1000 50 150} {
 	after $i lappend x $i
     }
     after 200 set done 1
     vwait done
-    set x
-} {50 100 150 200}
+    return $x
+} -cleanup {
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {50 100 150 200}
 
-test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
+test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x ""
     foreach i {100 200 1000 50 150} {
 	after $i lappend x $i
@@ -45,8 +51,8 @@ test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
     after cancel lappend x 50
     after 200 set done 1
     vwait done
-    set x
-} {100 200}
+    return $x
+} -result {100 200}
 
 # No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
 # above.
@@ -60,10 +66,11 @@ test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
     update
     lappend result $x
 } {start fired}
-test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
+test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     foreach i {200 600 1000} {
 	after $i lappend x $i
     }
@@ -78,45 +85,49 @@ test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
     after 400
     update
     lappend result $x
-} {200 {200 600} {200 600 1000}}
-test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
+} -result {200 {200 600} {200 600 1000}}
+test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 lappend x 100
     set i [after 300 lappend x 300]
     after 200 after cancel $i
     after 400
     update
-    set x
-} 100
-test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
+    return $x
+} -result 100
+test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 lappend x a
     after 200 lappend x b
     after 300 lappend x c
     after 300
     vwait x
-    set x
-} {a b c}
-test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    return $x
+} -result {a b c}
+test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 {lappend x a; after 0 lappend x b}
     after 100
     vwait x
-    set x
-} a
-test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    return $x
+} -result a
+test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 {lappend x a; after 100 lappend x b; after 100}
     after 100
@@ -124,15 +135,16 @@ test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't
     set result $x
     vwait x
     lappend result $x
-} {a {a b}}
+} -result {a {a b}}
 
 # No tests for Tcl_DoWhenIdle:  it's already tested by other tests
 # below.
 
-test timer-4.1 {Tcl_CancelIdleCall procedure} {
+test timer-4.1 {Tcl_CancelIdleCall procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y before
     set z before
@@ -141,12 +153,13 @@ test timer-4.1 {Tcl_CancelIdleCall procedure} {
     after idle set z after3
     after cancel set y after2
     update idletasks
-    concat $x $y $z
-} {after1 before after3}
-test timer-4.2 {Tcl_CancelIdleCall procedure} {
+    list $x $y $z
+} -result {after1 before after3}
+test timer-4.2 {Tcl_CancelIdleCall procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y before
     set z before
@@ -155,13 +168,14 @@ test timer-4.2 {Tcl_CancelIdleCall procedure} {
     after idle set z after3
     after cancel set x after1
     update idletasks
-    concat $x $y $z
-} {before after2 after3}
+    list $x $y $z
+} -result {before after2 after3}
 
-test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
+test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x 1
     set y 23
     after idle {incr x; after idle {incr x; after idle {incr x}}}
@@ -170,17 +184,17 @@ test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
     set result "$x $y"
     update idletasks
     lappend result $x
-} {2 24 4}
+} -result {2 24 4}
 
-test timer-6.1 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after} msg] $msg
-} {1 {wrong # args: should be "after option ?arg arg ...?"}}
-test timer-6.2 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after 2x} msg] $msg
-} {1 {bad argument "2x": must be cancel, idle, info, or an integer}}
-test timer-6.3 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}}
+test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after
+} -result {wrong # args: should be "after option ?arg arg ...?"}
+test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after 2x
+} -result {bad argument "2x": must be cancel, idle, info, or an integer}
+test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after gorp
+} -result {bad argument "gorp": must be cancel, idle, info, or an integer}
 test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
     set x before
     after 400 {set x after}
@@ -201,41 +215,44 @@ test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
     update
     list $y $x
 } {before after}
-test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {
-    list [catch {after cancel} msg] $msg
-} {1 {wrong # args: should be "after cancel id|command"}}
+test timer-6.6 {Tcl_AfterCmd procedure, cancel option} -body {
+    after cancel
+} -returnCodes error -result {wrong # args: should be "after cancel id|command"}
 test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {
     after cancel after#1
 } {}
 test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {
     after cancel {foo bar}
 } {}
-test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
+test timer-6.9 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y [after 100 set x after]
     after cancel $y
     after 200
     update
-    set x
-} {before}
-test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
+    return $x
+} -result {before}
+test timer-6.10 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     after 100 set x after
     after cancel {set x after}
     after 200
     update
-    set x
-} {before}
-test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
+    return $x
+} -result {before}
+test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     after 100 set x after
     set id [after 300 set x after]
@@ -247,11 +264,12 @@ test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
     after 200
     update
     list $y $x
-} {after cleared}
-test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
+} -result {after cleared}
+test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x first
     after idle lappend x second
     after idle lappend x third
@@ -259,12 +277,13 @@ test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
     after cancel {lappend x second}
     after cancel $i
     update idletasks
-    set x
-} {first third}
-test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
+    return $x
+} -result {first third}
+test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x first
     after idle lappend x second
     after idle lappend x third
@@ -272,12 +291,13 @@ test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for c
     after cancel lappend x second
     after cancel $i
     update idletasks
-    set x
-} {first third}
-test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
+    return $x
+} -result {first third}
+test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set id [
 	after 100 {
 	    set x done
@@ -285,11 +305,12 @@ test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, u
 	}
     ]
     vwait x
-} {}
-test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
+} -result {}
+test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     interp create x
     x eval {set a before; set b before; after idle {set a a-after};
 	    after idle {set b b-after}}
@@ -301,12 +322,12 @@ test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
     x eval {after cancel set a a-after}
     update idletasks
     lappend result $a $b [x eval {list $a $b}]
+} -cleanup {
     interp delete x
-    set result
-} {2 0 aaa bbb {before b-after}}
-test timer-6.16 {Tcl_AfterCmd procedure, idle option} {
-    list [catch {after idle} msg] $msg
-} {1 {wrong # args: should be "after idle script script ..."}}
+} -result {2 0 aaa bbb {before b-after}}
+test timer-6.16 {Tcl_AfterCmd procedure, idle option} -body {
+    after idle
+} -returnCodes error -result {wrong # args: should be "after idle script script ..."}
 test timer-6.17 {Tcl_AfterCmd procedure, idle option} {
     set x before
     after idle {set x after}
@@ -321,6 +342,7 @@ test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
     update idletasks
     list $y $x
 } {before after}
+
 set event1 [after idle event 1]
 set event2 [after 1000 event 2]
 interp create x
@@ -328,120 +350,125 @@ set childEvent [x eval {after idle event in child}]
 test timer-6.19 {Tcl_AfterCmd, info option} {
     lsort [after info]
 } [lsort "$event1 $event2"]
-test timer-6.20 {Tcl_AfterCmd, info option} {
-    list [catch {after info a b} msg] $msg
-} {1 {wrong # args: should be "after info ?id?"}}
-test timer-6.21 {Tcl_AfterCmd, info option} {
-    list [catch {after info $childEvent} msg] $msg
-} "1 {event \"$childEvent\" doesn't exist}"
+test timer-6.20 {Tcl_AfterCmd, info option} -returnCodes error -body {
+    after info a b
+} -result {wrong # args: should be "after info ?id?"}
+test timer-6.21 {Tcl_AfterCmd, info option} -returnCodes error -body {
+    after info $childEvent
+} -result "event \"$childEvent\" doesn't exist"
 test timer-6.22 {Tcl_AfterCmd, info option} {
     list [after info $event1] [after info $event2]
 } {{{event 1} idle} {{event 2} timer}}
-
 after cancel $event1
 after cancel $event2
 interp delete x
 
-test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
+test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 "set x ab\0cd"
     after 10
     update
     string length $x
-} {5}
-test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
+} -result {5}
+test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after 10
     update
     string length $x
-} {5}
-test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+} -result {5}
+test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after cancel "set x ab\0ef"
-    set x [llength [after info]]
+    llength [after info]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set x
-} {1}
-test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+} -result {1}
+test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after cancel set x ab\0ef
-    set y [llength [after info]]
+    llength [after info]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set y
-} {1}
-test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+} -result {1}
+test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after idle "set x ab\0cd"
     update
     string length $x
-} {5}
-test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+} -result {5}
+test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after idle set x ab\0cd
     update
     string length $x
-} {5}
-test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
+} -result {5}
+test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     set id junk
     set id [after 10 set x ab\0cd]
     update
-    set y [string length [lindex [lindex [after info $id] 0] 2]]
+    string length [lindex [lindex [after info $id] 0] 2]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set y
-} {5}
+} -result 5
 
 set event [after idle foo bar]
-scan $event after#%d id
-
-test timer-7.1 {GetAfterEvent procedure} {
-    list [catch {after info xfter#$id} msg] $msg
-} "1 {event \"xfter#$id\" doesn't exist}"
-test timer-7.2 {GetAfterEvent procedure} {
-    list [catch {after info afterx$id} msg] $msg
-} "1 {event \"afterx$id\" doesn't exist}"
-test timer-7.3 {GetAfterEvent procedure} {
-    list [catch {after info after#ab} msg] $msg
-} {1 {event "after#ab" doesn't exist}}
-test timer-7.4 {GetAfterEvent procedure} {
-    list [catch {after info after#} msg] $msg
-} {1 {event "after#" doesn't exist}}
-test timer-7.5 {GetAfterEvent procedure} {
-    list [catch {after info after#${id}x} msg] $msg
-} "1 {event \"after#${id}x\" doesn't exist}"
-test timer-7.6 {GetAfterEvent procedure} {
-    list [catch {after info afterx[expr $id+1]} msg] $msg
-} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
+scan $event after#%d lastId
+test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body {
+    after info xfter#$lastId
+} -result "event \"xfter#$lastId\" doesn't exist"
+test timer-7.2 {GetAfterEvent procedure} -returnCodes error -body {
+    after info afterx$lastId
+} -result "event \"afterx$lastId\" doesn't exist"
+test timer-7.3 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#ab
+} -result {event "after#ab" doesn't exist}
+test timer-7.4 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#
+} -result {event "after#" doesn't exist}
+test timer-7.5 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#${lastId}x
+} -result "event \"after#${lastId}x\" doesn't exist"
+test timer-7.6 {GetAfterEvent procedure} -returnCodes error -body {
+    after info afterx[expr {$lastId+1}]
+} -result "event \"afterx[expr {$lastId+1}]\" doesn't exist"
 after cancel $event
 
 test timer-8.1 {AfterProc procedure} {
@@ -474,10 +501,11 @@ test timer-8.2 {AfterProc procedure} -setup {
     while executing
 "error "After error""
     ("after" script)}}}
-test timer-8.3 {AfterProc procedure, deleting handler from itself} {
+test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     proc foo {} {
 	global x
 	set x {}
@@ -489,12 +517,13 @@ test timer-8.3 {AfterProc procedure, deleting handler from itself} {
     after idle foo
     after 1000 {error "I shouldn't ever have executed"}
     update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
-test timer-8.4 {AfterProc procedure, deleting handler from itself} {
+    return $x
+} -result {{{error "I shouldn't ever have executed"} timer}}
+test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     proc foo {} {
 	global x
 	set x {}
@@ -506,8 +535,8 @@ test timer-8.4 {AfterProc procedure, deleting handler from itself} {
     after 1000 {error "I shouldn't ever have executed"}
     after idle foo
     update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
+    return $x
+} -result {{{error "I shouldn't ever have executed"} timer}}
 
 foreach i [after info] {
     after cancel $i
@@ -515,9 +544,9 @@ foreach i [after info] {
 
 # No test for FreeAfterPtr, since it is already tested above.
 
-
-test timer-9.1 {AfterCleanupProc procedure} {
+test timer-9.1 {AfterCleanupProc procedure} -setup {
     catch {interp delete x}
+} -body {
     interp create x
     x eval {after 200 {
 	lappend x after
@@ -537,8 +566,8 @@ test timer-9.1 {AfterCleanupProc procedure} {
     set x before
     after 300
     update
-    set x
-} {before after2 after4}
+    return $x
+} -result {before after2 after4}
 
 test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
     interp create slave
@@ -552,29 +581,22 @@ test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
     interp delete slave
 } -result ::after
 
-test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} \
-    -body {
-	set b ok
-	set a [after 0x100000001 {set b "after fired early"}]
-	after 100 set done 1
-	vwait done
-	set b
-    } \
-    -cleanup {
-	catch {after cancel $a}
-    } \
-    -result ok
-
-test timer-11.2 {Bug 1350293: [after] negative argument} \
-    -body {
-	set l {}
-	after 100 {lappend l 100; set done 1}
-	after -1 {lappend l -1}
-	vwait done
-	set l
-    } \
-    -result {-1 100}
-
+test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body {
+    set b ok
+    set a [after 0x100000001 {set b "after fired early"}]
+    after 100 set done 1
+    vwait done
+    return $b
+} -cleanup {
+    catch {after cancel $a}
+} -result ok
+test timer-11.2 {Bug 1350293: [after] negative argument} -body {
+    set l {}
+    after 100 {lappend l 100; set done 1}
+    after -1 {lappend l -1}
+    vwait done
+    return $l
+} -result {-1 100}
 
 # cleanup
 ::tcltest::cleanupTests