diff options
Diffstat (limited to 'tests/async.test')
| -rw-r--r-- | tests/async.test | 73 |
1 files changed, 38 insertions, 35 deletions
diff --git a/tests/async.test b/tests/async.test index cb67cc2..b369839 100644 --- a/tests/async.test +++ b/tests/async.test @@ -16,11 +16,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - testConstraint testasync [llength [info commands testasync]] -testConstraint threaded [::tcl::pkgconfig get threaded] +testConstraint threaded [expr { + [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded) +}] proc async1 {result code} { global aresult acode @@ -148,25 +147,44 @@ 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]after 10;" { + return $aresult +}] + test async-4.1 {async interrupting bytecode sequence} -constraints { testasync threaded } -setup { set hm [testasync create async3] - proc nothing {} { - # empty proc - } } -body { - 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 + hang1 $hm } -result {test pattern} -cleanup { testasync delete $hm } @@ -175,15 +193,7 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints { } -setup { set hm [testasync create async3] } -body { - 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 + hang2 $hm } -result {test pattern} -cleanup { testasync delete $hm } @@ -192,14 +202,7 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { } -setup { set hm [testasync create async3] } -body { - apply [list {handle} [concat { - global aresult - set aresult {Async event not delivered} - testasync marklater $handle - set i 0 - } "[string repeat {;incr i;} 1500000]after 10;" { - return $aresult - }]] $hm + hang3 $hm } -result {test pattern} -cleanup { testasync delete $hm } |