summaryrefslogtreecommitdiffstats
path: root/tests/async.test
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-28 19:36:34 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-28 19:36:34 (GMT)
commit1f6c360968fab22aa02a30a72c196a8f8eb19c0c (patch)
treec490d9cba824ba803b713fe06b6ccfb7f98caca3 /tests/async.test
parent63b8d1466dca7693cf0f6b61d39fada6fd1e0e7f (diff)
parentccb97d88ffefe602e7eb5a9610bd356d66bc2f20 (diff)
downloadtcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.zip
tcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.tar.gz
tcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.tar.bz2
Merge tip-468 branch
Diffstat (limited to 'tests/async.test')
-rw-r--r--tests/async.test47
1 files changed, 32 insertions, 15 deletions
diff --git a/tests/async.test b/tests/async.test
index cb67cc2..34c2fdc 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -20,7 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testasync [llength [info commands testasync]]
-testConstraint threaded [::tcl::pkgconfig get threaded]
proc async1 {result code} {
global aresult acode
@@ -149,7 +148,7 @@ test async-3.1 {deleting handlers} testasync {
} {3 del2 {0 0 0 del1 del2}}
test async-4.1 {async interrupting bytecode sequence} -constraints {
- testasync threaded
+ testasync
} -setup {
set hm [testasync create async3]
proc nothing {} {
@@ -157,21 +156,28 @@ test async-4.1 {async interrupting bytecode sequence} -constraints {
}
} -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
- }
+ 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
+ nothing
+ }
return $aresult
}} $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 threaded
+ testasync
} -setup {
set hm [testasync create async3]
} -body {
@@ -179,16 +185,24 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
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} {}
+ # 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
} -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 threaded
+ testasync
} -setup {
set hm [testasync create async3]
} -body {
@@ -201,6 +215,9 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
return $aresult
}]] $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
}