diff options
Diffstat (limited to 'tests/async.test')
| -rw-r--r-- | tests/async.test | 106 |
1 files changed, 45 insertions, 61 deletions
diff --git a/tests/async.test b/tests/async.test index 49a00ff..b369839 100644 --- a/tests/async.test +++ b/tests/async.test @@ -4,24 +4,22 @@ # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1993 The Regents of the University of California. -# Copyright © 1994-1996 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1993 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] - -testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint testasync [llength [info commands testasync]] -testConstraint knownMsvcBug [string match msvc-* [tcl::build-info compiler]] +testConstraint threaded [expr { + [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded) +}] proc async1 {result code} { global aresult acode @@ -149,77 +147,63 @@ test async-3.1 {deleting handlers} testasync { list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x } {3 del2 {0 0 0 del1 del2}} -test async-4.1 {async interrupting bytecode sequence} -constraints { - testasync thread -} -setup { - set hm [testasync create async3] - proc nothing {} { - # empty proc - } -} -body { - apply {{handle} { +proc nothing {} { + # empty proc +} +proc hang1 {handle} { global aresult set aresult {Async event not delivered} testasync marklater $handle - # allow plenty of time to pass in case valgrind is running - set start [clock seconds] - while { - [clock seconds] - $start < 180 && $aresult eq "Async event not delivered" - } { - # be less busy - after 100 + for {set i 0} { + $i < 2500000 && $aresult eq "Async event not delivered" + } {incr i} { nothing } - return $aresult - }} $hm + 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] +} -body { + hang1 $hm } -result {test pattern} -cleanup { - # give other threads some time to go way so that valgrind doesn't pick up - # "still reachable" cases from early thread termination - after 100 testasync delete $hm } test async-4.2 {async interrupting straight bytecode sequence} -constraints { - testasync thread + testasync threaded } -setup { set hm [testasync create async3] } -body { - apply {{handle} { - global aresult - set aresult {Async event not delivered} - testasync marklater $handle - # allow plenty of time to pass in case valgrind is running - set start [clock seconds] - while { - [clock seconds] - $start < 180 && $aresult eq "Async event not delivered" - } { - # be less busy - after 100 - } - return $aresult - }} $hm + hang2 $hm } -result {test pattern} -cleanup { - # give other threads some time to go way so that valgrind doesn't pick up - # "still reachable" cases from early thread termination - after 100 testasync delete $hm } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { - testasync thread knownMsvcBug + testasync threaded } -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 { - # give other threads some time to go way so that valgrind doesn't pick up - # "still reachable" cases from early thread termination - after 100 testasync delete $hm } |