diff options
author | pooryorick <com.digitalsmarties@pooryorick.com> | 2018-06-21 22:16:29 (GMT) |
---|---|---|
committer | pooryorick <com.digitalsmarties@pooryorick.com> | 2018-06-21 22:16:29 (GMT) |
commit | 107fb1eb331d7f346dfbdf5e7655a28f4643899c (patch) | |
tree | bf618ad4f7a65b52ac655d18f4c4b2d2bfe700cf | |
parent | c911dc937fb03f387cc7ecd74b04a2e60ddb53b5 (diff) | |
download | tcl-107fb1eb331d7f346dfbdf5e7655a28f4643899c.zip tcl-107fb1eb331d7f346dfbdf5e7655a28f4643899c.tar.gz tcl-107fb1eb331d7f346dfbdf5e7655a28f4643899c.tar.bz2 |
Suppress more valgrind "still reachable" reports and ensure that threads are
fully finalized in thread tests.
-rw-r--r-- | tests/thread.test | 56 | ||||
-rw-r--r-- | tools/valgrind_suppress | 87 |
2 files changed, 106 insertions, 37 deletions
diff --git a/tests/thread.test b/tests/thread.test index cc4c871..a23670a 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -11,17 +11,22 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# when thread::release is used, -wait is passed in order allow the thread to +# be fully finalized, which avoids valgrind "still reachable" reports. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.2 namespace import -force ::tcltest::* } +package require tcltests + ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testthread command -testConstraint testthread [expr {[info commands testthread] != {}}] +testConstraint testthread [expr {[info commands testthread] ne {}}] # Some tests require the Thread package @@ -72,6 +77,17 @@ proc ThreadError {id info} { set threadSawError($id) true; # signal main thread to exit [vwait]. } +proc threadSuperKill id { + variable threadSuperKillScript + try { + thread::send $id $::threadSuperKillScript + } on error {tres topts} { + if {$tres ne {target thread died}} { + return -options $topts $tres + } + } +} + if {[testConstraint thread]} { thread::errorproc ThreadError } @@ -96,22 +112,22 @@ test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} { test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} { set serverthread [thread::create -preserved] set numthreads [llength [thread::names]] - thread::release $serverthread + thread::release -wait $serverthread set numthreads -} {2} +} 2 test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} { thread::create {set x 5} foreach try {0 1 2 4 5 6} { - # Try various ways to yield - update - after 10 - set l [llength [thread::names]] - if {$l == 1} { - break - } + # Try various ways to yield + update + after 10 + set l [llength [thread::names]] + if {$l == 1} { + break + } } set l -} {1} +} 1 test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { thread::create {{*}{}} update @@ -121,13 +137,13 @@ test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} { set serverthread [thread::create -preserved] set five [thread::send $serverthread {set x 5}] - thread::release $serverthread + thread::release -wait $serverthread set five } 5 test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} { set serverthread [thread::create -preserved {set z 5 ; thread::wait}] set five [thread::send $serverthread {set z}] - thread::release $serverthread + thread::release -wait $serverthread set five } 5 @@ -159,7 +175,7 @@ test thread-3.1 {TclThreadList} {thread} { set l2 [thread::names] set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]] foreach t $l1 { - thread::release $t + thread::release -wait $t } list $len $c } {1 0} @@ -887,7 +903,7 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainE # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ @@ -929,7 +945,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1029,7 +1045,7 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1071,7 +1087,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1111,7 +1127,7 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1153,7 +1169,7 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] - thread::send $serverthread $::threadSuperKillScript + threadSuperKill $serverthread vwait ::threadSawError($serverthread) thread::join $serverthread; drainEventQueue list $res [expr {[info exists ::threadIdStarted] ? \ diff --git a/tools/valgrind_suppress b/tools/valgrind_suppress index 3c733c2..ede584a 100644 --- a/tools/valgrind_suppress +++ b/tools/valgrind_suppress @@ -1,63 +1,116 @@ { - TclpGetPwNam/getpwname_r/__nss_next2/calloc + TclCreatesocketAddress/getaddrinfo/calloc + Memcheck:Leak + match-leak-kinds: reachable + fun:calloc + ... + fun:getaddrinfo + fun:TclCreateSocketAddress +} + +{ + TclCreatesocketAddress/getaddrinfo/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:getaddrinfo + fun:TclCreateSocketAddress +} + +{ + TclpDlopen/load + Memcheck:Leak + match-leak-kinds: reachable + fun:calloc + ... + fun:dlopen + fun:TclpDlopen +} + +{ + TclpGetGrNam/__nss_next2/calloc Memcheck:Leak match-leak-kinds: reachable fun:calloc ... fun:__nss_next2 ... - fun:TclpGetPwNam + fun:TclpGetGrNam } { - TclpGetPwNam/getpwname_r/__nss_next2/malloc + TclpGetGrNam/__nss_next2/malloc Memcheck:Leak match-leak-kinds: reachable fun:malloc ... fun:__nss_next2 ... - fun:TclpGetPwNam + fun:TclpGetGrNam } { - TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc + TclpGetGrNam/__nss_systemd_getfrname_r/malloc Memcheck:Leak match-leak-kinds: reachable fun:malloc ... - fun:_nss_systemd_getpwnam_r + fun:_nss_systemd_getgrnam_r ... - fun:TclpGetPwNam + fun:TclpGetGrNam } { - TclCreatesocketAddress/getaddrinfo/calloc + TclpGetPwNam/getpwname_r/__nss_next2/calloc Memcheck:Leak match-leak-kinds: reachable fun:calloc ... - fun:getaddrinfo - fun:TclCreateSocketAddress + fun:__nss_next2 + ... + fun:TclpGetPwNam } { - TclCreatesocketAddress/getaddrinfo/malloc + TclpGetPwNam/getpwname_r/__nss_next2/malloc Memcheck:Leak match-leak-kinds: reachable fun:malloc ... - fun:getaddrinfo - fun:TclCreateSocketAddress + fun:__nss_next2 + ... + fun:TclpGetPwNam } { - TclpDlopen/load + TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc Memcheck:Leak match-leak-kinds: reachable - fun:calloc + fun:malloc ... - fun:dlopen - fun:TclpDlopen + fun:_nss_systemd_getpwnam_r + ... + fun:TclpGetPwNam +} + +{ + TclpThreadExit/pthread_exit/calloc + Memcheck:Leak + match-leak-kinds: reachable + fun:calloc + ... + fun:pthread_exit + fun:TclpThreadExit +} + +{ + TclpThreadExit/pthread_exit/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:pthread_exit + fun:TclpThreadExit } |