diff options
Diffstat (limited to 'tests/async.test')
| -rw-r--r-- | tests/async.test | 142 |
1 files changed, 69 insertions, 73 deletions
diff --git a/tests/async.test b/tests/async.test index 863be98..cb67cc2 100644 --- a/tests/async.test +++ b/tests/async.test @@ -10,24 +10,17 @@ # # 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.7 2003/11/16 00:49:20 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -if {[info commands testasync] == {}} { - puts "This application hasn't been compiled with the \"testasync\"" - puts "command, so I can't test Tcl_AsyncCreate et al." - ::tcltest::cleanupTests - return -} +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] -tcltest::testConstraint threaded [expr { - [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded) -}] +testConstraint testasync [llength [info commands testasync]] +testConstraint threaded [::tcl::pkgconfig get threaded] proc async1 {result code} { global aresult acode @@ -53,43 +46,45 @@ proc \# {result code} { return "comment quoting" } -set handler1 [testasync create async1] -set handler2 [testasync create async2] -set handler3 [testasync create async3] -set handler4 [testasync create #] -test async-1.1 {basic async handlers} { +if {[testConstraint testasync]} { + set handler1 [testasync create async1] + set handler2 [testasync create async2] + set handler3 [testasync create async3] + set handler4 [testasync create \#] +} +test async-1.1 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler1 "original" 0} msg] $msg \ $acode $aresult } {0 {new result} 0 original} -test async-1.2 {basic async handlers} { +test async-1.2 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler1 "original" 1} msg] $msg \ $acode $aresult } {0 {new result} 1 original} -test async-1.3 {basic async handlers} { +test async-1.3 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler2 "old" 0} msg] $msg \ $acode $aresult } {1 xyzzy 0 old} -test async-1.4 {basic async handlers} { +test async-1.4 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler2 "old" 3} msg] $msg \ $acode $aresult } {1 xyzzy 3 old} -test async-1.5 {basic async handlers} { +test async-1.5 {basic async handlers} testasync { set aresult xxx list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult } {0 foobar {test pattern}} -test async-1.6 {basic async handlers} { +test async-1.6 {basic async handlers} testasync { set aresult xxx list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult } {1 foobar {test pattern}} -test async-1.7 {basic async handlers} { +test async-1.7 {basic async handlers} testasync { set aresult xxx set acode yyy list [catch {testasync mark $handler4 "original" 0} msg] $msg \ @@ -101,13 +96,11 @@ proc mult1 {result code} { lappend x mult1 return -code 7 mult1 } -set hm1 [testasync create mult1] proc mult2 {result code} { global x lappend x mult2 return -code 9 mult2 } -set hm2 [testasync create mult2] proc mult3 {result code} { global x hm1 hm2 lappend x [catch {testasync mark $hm2 serial2 0}] @@ -115,9 +108,12 @@ proc mult3 {result code} { lappend x mult3 return -code 11 mult3 } -set hm3 [testasync create mult3] - -test async-2.1 {multiple handlers} { +if {[testConstraint testasync]} { + set hm1 [testasync create mult1] + set hm2 [testasync create mult2] + set hm3 [testasync create mult3] +} +test async-2.1 {multiple handlers} testasync { set x {} list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x } {9 mult2 {0 0 mult3 mult1 mult2}} @@ -138,80 +134,80 @@ proc del2 {result code} { lappend x del2 return -code 3 del2 } -testasync delete $handler1 -testasync delete $hm2 -testasync delete $hm3 -set hm2 [testasync create del1] -set hm3 [testasync create mult2] -set hm4 [testasync create del2] +if {[testConstraint testasync]} { + testasync delete $handler1 + testasync delete $hm2 + testasync delete $hm3 + set hm2 [testasync create del1] + set hm3 [testasync create mult2] + set hm4 [testasync create del2] +} -test async-3.1 {deleting handlers} { +test async-3.1 {deleting handlers} testasync { set x {} 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 { - threaded + 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 } test async-4.2 {async interrupting straight bytecode sequence} -constraints { - threaded + testasync threaded } -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 } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { - threaded + testasync threaded } -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]after 10;" { + return $aresult + }]] $hm } -result {test pattern} -cleanup { testasync delete $hm } # cleanup -testasync delete +if {[testConstraint testasync]} { + testasync delete +} ::tcltest::cleanupTests return |