summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-03-24 10:35:21 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-03-24 10:35:21 (GMT)
commit8158cea2c168d259b1161bffdc4cd276b93b386b (patch)
treee55e7930d4aa4db67742d5e62a7214fce2864a3f
parent26683d2945cd970b898e6e20c238bdc844c9af94 (diff)
downloadtcl-8158cea2c168d259b1161bffdc4cd276b93b386b.zip
tcl-8158cea2c168d259b1161bffdc4cd276b93b386b.tar.gz
tcl-8158cea2c168d259b1161bffdc4cd276b93b386b.tar.bz2
* tests/async.test (async-4.*): Reduce obscurity of these tests by
putting the bulk of the code for them inside the test body with the help of [apply].
-rw-r--r--ChangeLog4
-rw-r--r--tests/async.test68
2 files changed, 36 insertions, 36 deletions
diff --git a/ChangeLog b/ChangeLog
index 76dfb6e..85214c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2010-03-24 Donal K. Fellows <dkf@users.sf.net>
+ * tests/async.test (async-4.*): Reduce obscurity of these tests by
+ putting the bulk of the code for them inside the test body with the
+ help of [apply].
+
* generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the
[try] command does not trap unwinding due to limits.
diff --git a/tests/async.test b/tests/async.test
index 014740a..654f995 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: async.test,v 1.9 2006/03/21 11:12:27 dkf Exp $
+# RCS: @(#) $Id: async.test,v 1.10 2010/03/24 10:35:21 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -149,44 +149,25 @@ test async-3.1 {deleting handlers} testasync {
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
-proc nothing {} {
- # empty proc
-}
-proc hang1 {handle} {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- for {set i 0} {
- $i < 2500000 && $aresult eq "Async event not delivered"
- } {incr i} {
- nothing
- }
- return $aresult
-}
-proc hang2 {handle} {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- for {set i 0} {
- $i < 2500000 && $aresult eq "Async event not delivered"
- } {incr i} {}
- return $aresult
-}
-proc hang3 {handle} [concat {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- set i 0
-} [string repeat {;incr i;} 1500000] {
- return $aresult
-}]
-
test async-4.1 {async interrupting bytecode sequence} -constraints {
testasync threaded
} -setup {
set hm [testasync create async3]
+ proc nothing {} {
+ # empty proc
+ }
} -body {
- hang1 $hm
+ apply {{handle} {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ for {set i 0} {
+ $i < 2500000 && $aresult eq "Async event not delivered"
+ } {incr i} {
+ nothing
+ }
+ return $aresult
+ }} $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}
@@ -195,7 +176,15 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
} -setup {
set hm [testasync create async3]
} -body {
- hang2 $hm
+ apply {{handle} {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ for {set i 0} {
+ $i < 2500000 && $aresult eq "Async event not delivered"
+ } {incr i} {}
+ return $aresult
+ }} $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}
@@ -204,7 +193,14 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
} -setup {
set hm [testasync create async3]
} -body {
- hang3 $hm
+ apply [list {handle} [concat {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ set i 0
+ } [string repeat {;incr i;} 1500000] {
+ return $aresult
+ }]] $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}