diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-03-24 10:35:21 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-03-24 10:35:21 (GMT) |
commit | 8158cea2c168d259b1161bffdc4cd276b93b386b (patch) | |
tree | e55e7930d4aa4db67742d5e62a7214fce2864a3f | |
parent | 26683d2945cd970b898e6e20c238bdc844c9af94 (diff) | |
download | tcl-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-- | ChangeLog | 4 | ||||
-rw-r--r-- | tests/async.test | 68 |
2 files changed, 36 insertions, 36 deletions
@@ -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 } |