diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-06-25 20:39:31 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-06-25 20:39:31 (GMT) |
commit | 3c26b9439d5c9a10bfac52bd5e96024b475e79fd (patch) | |
tree | 934c4fd78ce15f57b6ec976b70ce60caf450a63d | |
parent | 6264f4978838b089748579e436d35b30a4e56201 (diff) | |
parent | fdee46ab16b879589155729e6db4fdabe235880f (diff) | |
download | tcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.zip tcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.tar.gz tcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.tar.bz2 |
merge 8.7
-rw-r--r-- | generic/tclBasic.c | 8 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | generic/tclTest.c | 16 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 8 | ||||
-rw-r--r-- | tests/all.tcl | 15 | ||||
-rw-r--r-- | tests/chanio.test | 4 | ||||
-rw-r--r-- | tests/expr.test | 9 | ||||
-rw-r--r-- | tests/http11.test | 7 | ||||
-rw-r--r-- | tests/io.test | 4 | ||||
-rw-r--r-- | tests/ioCmd.test | 16 | ||||
-rw-r--r-- | tests/iogt.test | 2 | ||||
-rw-r--r-- | tests/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | tests/platform.test | 6 | ||||
-rw-r--r-- | tests/tailcall.test | 20 | ||||
-rw-r--r-- | tests/tcltest.test | 7 | ||||
-rw-r--r-- | tests/tcltests.tcl | 10 | ||||
-rw-r--r-- | tests/thread.test | 67 | ||||
-rw-r--r-- | tools/valgrind_suppress | 126 | ||||
-rw-r--r-- | unix/Makefile.in | 4 | ||||
-rw-r--r-- | unix/tclUnixSock.c | 6 | ||||
-rw-r--r-- | unix/tclUnixThrd.c | 6 | ||||
-rw-r--r-- | win/tclWinInit.c | 19 | ||||
-rw-r--r-- | win/tclWinSock.c | 20 | ||||
-rw-r--r-- | win/tclWinThrd.c | 8 |
24 files changed, 299 insertions, 92 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9240b93..1fbb659 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -7911,18 +7911,12 @@ TclNRTailcallObjCmd( if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - Tcl_Namespace *ns1Ptr; /* The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ - listPtr = Tcl_NewListObj(objc, objv); - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) - || (nsPtr != ns1Ptr)) { - Tcl_Panic("Tailcall failed to find the proper namespace"); - } + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index 8687785..aa62fb3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4565,6 +4565,7 @@ MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init; MODULE_SCOPE Tcl_PackageInitProc TclThread_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; +MODULE_SCOPE void TclThreadTestFinalize(); /* *---------------------------------------------------------------- diff --git a/generic/tclTest.c b/generic/tclTest.c index b6d6b95..115fbcc 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -44,6 +44,7 @@ DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); +EXTERN TCL_NORETURN void Tcltest_Exit(ClientData clientData); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect @@ -570,6 +571,10 @@ Tcltest_Init( return TCL_ERROR; } + + /* Finalizer */ + Tcl_SetExitProc(Tcltest_Exit); + /* * Create additional commands and math functions for testing Tcl. */ @@ -797,6 +802,17 @@ Tcltest_SafeInit( return Procbodytest_SafeInit(interp); } +TCL_NORETURN void Tcltest_Exit( + ClientData clientData +) { + int status = PTR2INT(clientData); + Tcl_Finalize(); + TclThreadTestFinalize(); + TclpExit(status); + Tcl_Panic("OS exit failed!"); +} + + /* *---------------------------------------------------------------------- * diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 3a6fc43..6da26db 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -176,6 +176,14 @@ TclThread_Init( } +void TclThreadTestFinalize() { + if (errorProcString != NULL) { + ckfree(errorProcString); + errorProcString= NULL; + } + return; +} + /* *---------------------------------------------------------------------- * diff --git a/tests/all.tcl b/tests/all.tcl index ad372db..4fce323 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -13,19 +13,14 @@ package prefer latest package require Tcl 8.5- package require tcltest 2.2 -namespace import tcltest::* -configure {*}$argv -testdir [file dir [info script]] +namespace import -force ::tcltest::* + +configure {*}$argv -testdir [file dirname [file dirname [file normalize [ + info script]/...]]] + if {[singleProcess]} { interp debug {} -frame 1 } -set testsdir [file dirname [file dirname [file normalize [info script]/...]]] -lappend auto_path $testsdir {*}[apply {{testsdir args} { - lmap x $args { - if {$x eq $testsdir} continue - lindex $x - } -}} $testsdir {*}$auto_path] - runAllTests proc exit args {} diff --git a/tests/chanio.test b/tests/chanio.test index 97e7e70..b77f2aa 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -39,14 +39,10 @@ namespace eval ::tcl::test::io { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchannel [llength [info commands testchannel]] - testConstraint exec [llength [info commands exec]] testConstraint openpipe 1 - testConstraint fileevent [llength [info commands fileevent]] - testConstraint fcopy [llength [info commands fcopy]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] - testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... diff --git a/tests/expr.test b/tests/expr.test index 695469b..0b9bd48 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7157,6 +7157,15 @@ test expr-51.1 {test round-to-even on input} { expr 6.9294956446009195e15 } 6929495644600920.0 +test expr-52.1 { + comparison with empty string does not generate string representation +} { + set a [list one two three] + list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [ + string match {*no string representation*} [ + ::tcl::unsupported::representation $a]] +} {0 0 1 1} + # cleanup diff --git a/tests/http11.test b/tests/http11.test index c9ded0b..2e50837 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -666,6 +666,13 @@ test http11-4.3 "normal post request, check channel query length" -setup { # ------------------------------------------------------------------------- +# Eliminate valgrind "still reachable" reports on outstanding "Detached" +# structures in the detached list which stem from PipeClose2Proc not waiting +# around for background processes to complete, meaning that previous calls to +# Tcl_ReapDetachedProcs might not have had a chance to reap all processes. +after 10 +exec [info nameofexecutable] << {} + foreach p {create_httpd httpd_read halt_httpd meta check_crc} { if {[llength [info proc $p]]} {rename $p {}} } diff --git a/tests/io.test b/tests/io.test index 20bb565..c1d5205 100644 --- a/tests/io.test +++ b/tests/io.test @@ -36,14 +36,10 @@ namespace eval ::tcl::test::io { variable expected testConstraint testchannel [llength [info commands testchannel]] -testConstraint exec [llength [info commands exec]] testConstraint openpipe 1 -testConstraint fileevent [llength [info commands fileevent]] -testConstraint fcopy [llength [info commands fcopy]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] -testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint testobj [llength [info commands testobj]] # You need a *very* special environment to do some tests. In diff --git a/tests/ioCmd.test b/tests/ioCmd.test index ae58025..948671e 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -21,10 +21,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +package require tcltests + # Custom constraints used in this file -testConstraint fcopy [llength [info commands fcopy]] testConstraint testchannel [llength [info commands testchannel]] -testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] #---------------------------------------------------------------------- @@ -395,7 +395,7 @@ test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} { test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} -test iocmd-11.4 {I/O to command pipelines} unixOrPc { +test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrPc} { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} @@ -3833,6 +3833,16 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat rename track {} # cleanup + + +# Eliminate valgrind "still reachable" reports on outstanding "Detached" +# structures in the detached list which stem from PipeClose2Proc not waiting +# around for background processes to complete, meaning that previous calls to +# Tcl_ReapDetachedProcs might not have had a chance to reap all processes. +after 10 +exec [info nameofexecutable] << {} + + foreach file [list test1 test2 test3 test4] { removeFile $file } diff --git a/tests/iogt.test b/tests/iogt.test index aa579bf..3cac2cf 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -608,7 +608,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup { variable copy 1 } } -constraints {testchannel knownBug} -body { - # This test to check the validity of aquired Tcl_Channel references is not + # This test to check the validity of acquired Tcl_Channel references is not # possible because even a backgrounded fcopy will immediately start to # copy data, without waiting for the event loop. This is done only in case # of an underflow on the read size!. So stacking transforms after the diff --git a/tests/pkgIndex.tcl b/tests/pkgIndex.tcl index 0feb0eb..854b943 100644 --- a/tests/pkgIndex.tcl +++ b/tests/pkgIndex.tcl @@ -1,6 +1,6 @@ #! /usr/bin/env tclsh package ifneeded tcltests 0.1 " - source [list $dir]/tcltests.tcl + source [list $dir/tcltests.tcl] package provide tcltests 0.1 " diff --git a/tests/platform.test b/tests/platform.test index 8a68351..fa533e8 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -10,6 +10,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 +package require tcltests namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint @@ -67,7 +68,10 @@ test platform-3.1 {CPU ID on Windows/UNIX} \ # format of string it produces consists of two non-empty words separated by a # hyphen. package require platform -test platform-4.1 {format of platform::identify result} -match regexp -body { +test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body { + # [identify] may attempt to [exec] dpkg-architecture, which may not exist, + # in which case fork will not be followed by exec, and valgrind will issue + # "still reachable" reports. platform::identify } -result {^([^-]+-)+[^-]+$} test platform-4.2 {format of platform::generic result} -match regexp -body { diff --git a/tests/tailcall.test b/tests/tailcall.test index ce506a7..9174167 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -688,6 +688,26 @@ if {[testConstraint testnrelevels]} { namespace delete testnre } +test tailcall-14.1 {in a deleted namespace} -body { + namespace eval ns { + proc p args { + tailcall [namespace current] $args + } + namespace delete [namespace current] + p + } +} -returnCodes 1 -result {namespace "::ns" not found} + +test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body { + namespace eval ns { + proc p args { + tailcall [namespace current] {*}$args + } + namespace delete [namespace current] + p + } +} -returnCodes 1 -result {namespace "::ns" not found} + # cleanup ::tcltest::cleanupTests diff --git a/tests/tcltest.test b/tests/tcltest.test index 286f017..5a3671f 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -909,7 +909,9 @@ removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { + -constraints notValgrind -setup { + #to do: Why is $::tcltest::tcltest being saved and restored here? set old $::tcltest::tcltest set ::tcltest::tcltest tcltest } @@ -921,6 +923,11 @@ test tcltest-13.1 {interpreter} { } -result {tcltest tclsh tclsh} -cleanup { + # writing ::tcltest::tcltest triggers a trace that sets up the stdio + # constraint, which involves a call to [exec] that might fail after + # "fork" and before "exec", in which case the forked process will not + # have a chance to clean itself up before exiting, which causes + # valgrind to issue numerous "still reachable" reports. set ::tcltest::tcltest $old } } diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index f7597b5..2105279 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -1,3 +1,11 @@ #! /usr/bin/env tclsh -testConstraint notValgrind [expr {![testConstraint valgrind]}] +package require tcltest 2.2 +namespace import -force ::tcltest::* + +testConstraint exec [llength [info commands exec]] +testConstraint fcopy [llength [info commands fcopy]] +testConstraint fileevent [llength [info commands fileevent]] +testConstraint thread [ + expr {0 == [catch {package require Thread 2.7-}]}] +testConstraint notValgrind [expr {![testConstraint valgrind]}] diff --git a/tests/thread.test b/tests/thread.test index cc4c871..eaaaa41 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -11,25 +11,19 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2.2 - namespace import -force ::tcltest::* -} + +# when thread::release is used, -wait is passed in order allow the thread to +# be fully finalized, which avoids valgrind "still reachable" reports. + +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] != {}}] - -# Some tests require the Thread package - -testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] +testConstraint testthread [expr {[info commands testthread] ne {}}] -# Some tests may not work under valgrind - -testConstraint notValgrind [expr {![testConstraint valgrind]}] set threadSuperKillScript { rename catch "" @@ -72,6 +66,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 +101,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 +126,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 +164,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 +892,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 +934,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 +1034,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 +1076,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 +1116,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 +1158,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 new file mode 100644 index 0000000..fb7f173 --- /dev/null +++ b/tools/valgrind_suppress @@ -0,0 +1,126 @@ +{ + 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 +} + +{ + TclpDlopen/load + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:dlopen + fun:TclpDlopen +} + +{ + TclpGetGrNam/__nss_next2/calloc + Memcheck:Leak + match-leak-kinds: reachable + fun:calloc + ... + fun:__nss_next2 + ... + fun:TclpGetGrNam +} + +{ + TclpGetGrNam/__nss_next2/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:__nss_next2 + ... + fun:TclpGetGrNam +} + +{ + TclpGetGrNam/__nss_systemd_getfrname_r/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:_nss_systemd_getgrnam_r + ... + fun:TclpGetGrNam +} + +{ + TclpGetPwNam/getpwname_r/__nss_next2/calloc + Memcheck:Leak + match-leak-kinds: reachable + fun:calloc + ... + fun:__nss_next2 + ... + fun:TclpGetPwNam +} + +{ + TclpGetPwNam/getpwname_r/__nss_next2/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + fun:__nss_next2 + ... + fun:TclpGetPwNam +} + +{ + TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc + Memcheck:Leak + match-leak-kinds: reachable + fun:malloc + ... + 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 +} + diff --git a/unix/Makefile.in b/unix/Makefile.in index 41d7e7f..a932eb1 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -262,7 +262,9 @@ GDB = gdb TRACE = strace TRACE_OPTS = VALGRIND = valgrind -VALGRINDARGS = --tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v +VALGRINDARGS = --tool=memcheck --num-callers=24 \ + --leak-resolution=high --leak-check=yes --show-reachable=yes -v \ + --suppressions=$(TOOL_DIR)/valgrind_suppress #-------------------------------------------------------------------------- # The information below should be usable as is. The configure script won't diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 45abc01..7bef7c0 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1124,7 +1124,7 @@ TcpGetHandleProc( * TcpAsyncCallback -- * * Called by the event handler that TcpConnect sets up internally for - * [socket -async] to get notified when the asyncronous connection + * [socket -async] to get notified when the asynchronous connection * attempt has succeeded or failed. * * ---------------------------------------------------------------------- @@ -1157,7 +1157,7 @@ TcpAsyncCallback( * * Remarks: * A single host name may resolve to more than one IP address, e.g. for - * an IPv4/IPv6 dual stack host. For handling asyncronously connecting + * an IPv4/IPv6 dual stack host. For handling asynchronously connecting * sockets in the background for such hosts, this function can act as a * coroutine. On the first call, it sets up the control variables for the * two nested loops over the local and remote addresses. Once the first @@ -1165,7 +1165,7 @@ TcpAsyncCallback( * event handler for that socket, and returns. When the callback occurs, * control is transferred to the "reenter" label, right after the initial * return and the loops resume as if they had never been interrupted. - * For syncronously connecting sockets, the loops work the usual way. + * For synchronously connecting sockets, the loops work the usual way. * * ---------------------------------------------------------------------- */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 128602a..d6c420a 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -305,7 +305,7 @@ TclpInitUnlock(void) * in finalization; it is hidden during creation of the objects. * * This lock must be different than the initLock because the initLock is - * held during creation of syncronization objects. + * held during creation of synchronization objects. * * Results: * None. @@ -396,7 +396,7 @@ Tcl_GetAllocMutex(void) * None. * * Side effects: - * May block the current thread. The mutex is aquired when this returns. + * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a pthread_mutex_t and initialize this the * first time this Tcl_Mutex is used. * @@ -500,7 +500,7 @@ TclpFinalizeMutex( * None. * * Side effects: - * May block the current thread. The mutex is aquired when this returns. + * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a pthread_mutex_t and initialize this the * first time this Tcl_Mutex is used. * diff --git a/win/tclWinInit.c b/win/tclWinInit.c index e0fc73d..1d17465 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -107,7 +107,12 @@ static ProcessGlobalValue sourceLibraryDir = {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); -static int ToUtf(const WCHAR *wSrc, char *dst); + +#if TCL_UTF_MAX < 4 +static void ToUtf(const WCHAR *wSrc, char *dst); +#else +#define ToUtf(wSrc, dst) WideCharToMultiByte(CP_UTF8, 0, wSrc, -1, dst, MAX_PATH * TCL_UTF_MAX, NULL, NULL) +#endif /* *--------------------------------------------------------------------------- @@ -431,7 +436,7 @@ InitializeSourceLibraryDir( * * ToUtf -- * - * Convert a char string to a UTF string. + * Convert a wchar string to a UTF string. * * Results: * None. @@ -442,21 +447,19 @@ InitializeSourceLibraryDir( *--------------------------------------------------------------------------- */ -static int +#if TCL_UTF_MAX < 4 +static void ToUtf( const WCHAR *wSrc, char *dst) { - char *start; - - start = dst; while (*wSrc != '\0') { dst += Tcl_UniCharToUtf(*wSrc, dst); wSrc++; } *dst = '\0'; - return (int) (dst - start); } +#endif /* *--------------------------------------------------------------------------- @@ -646,7 +649,7 @@ TclpSetVariables( * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is - * case sensitive, on Windows this matches mioxed case. + * case sensitive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the name diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 7be194e..ac3ddbd 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -738,8 +738,8 @@ WaitForConnect( } /* - * A non blocking socket waiting for an asyncronous connect returns - * directly the error EWOULDBLOCK. + * A non blocking socket waiting for an asynchronous connect + * returns directly the error EWOULDBLOCK */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { @@ -1690,9 +1690,9 @@ TcpGetHandleProc( * * This might be called in 3 circumstances: * - By a regular socket command - * - By the event handler to continue an asynchroneous connect + * - By the event handler to continue an asynchronously connect * - By a blocking socket function (gets/puts) to terminate the - * connect synchroneously + * connect synchronously * * Results: * TCL_OK, if the socket was successfully connected or an asynchronous @@ -1704,7 +1704,7 @@ TcpGetHandleProc( * * Remarks: * A single host name may resolve to more than one IP address, e.g. for - * an IPv4/IPv6 dual stack host. For handling asyncronously connecting + * an IPv4/IPv6 dual stack host. For handling asynchronously connecting * sockets in the background for such hosts, this function can act as a * coroutine. On the first call, it sets up the control variables for the * two nested loops over the local and remote addresses. Once the first @@ -1712,7 +1712,7 @@ TcpGetHandleProc( * event handler for that socket, and returns. When the callback occurs, * control is transferred to the "reenter" label, right after the initial * return and the loops resume as if they had never been interrupted. - * For syncronously connecting sockets, the loops work the usual way. + * For synchronously connecting sockets, the loops work the usual way. * *---------------------------------------------------------------------- */ @@ -1816,7 +1816,7 @@ TcpConnect( } /* - * For asyncroneous connect set the socket in nonblocking mode + * For asynchroneous connect set the socket in nonblocking mode * and activate connect notification */ @@ -1930,8 +1930,8 @@ TcpConnect( } /* - * Clear the tsd socket list pointer if we did not wait for the - * FD_CONNECT asynchronously. + * Clear the tsd socket list pointer if we did not wait for + * the FD_CONNECT asynchroneously */ tsdPtr->pendingTcpState = NULL; @@ -2014,7 +2014,7 @@ TcpConnect( } /* - * Error message on syncroneous connect + * Error message on synchroneous connect */ if (interp != NULL) { diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 5ea407e..d169ebb 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -241,7 +241,7 @@ TclpThreadCreate( /* * The only purpose of this is to decrement the reference count so the - * OS resources will be reaquired when the thread closes. + * OS resources will be reacquired when the thread closes. */ CloseHandle(tHandle); @@ -399,7 +399,7 @@ TclpInitUnlock(void) * mutexes, condition variables, and thread local storage keys. * * This lock must be different than the initLock because the initLock is - * held during creation of syncronization objects. + * held during creation of synchronization objects. * * Results: * None. @@ -549,7 +549,7 @@ static void FinalizeConditionEvent(ClientData data); * None. * * Side effects: - * May block the current thread. The mutex is aquired when this returns. + * May block the current thread. The mutex is acquired when this returns. * *---------------------------------------------------------------------- */ @@ -649,7 +649,7 @@ TclpFinalizeMutex( * None. * * Side effects: - * May block the current thread. The mutex is aquired when this returns. + * May block the current thread. The mutex is acquired when this returns. * Will allocate memory for a HANDLE and initialize this the first time * this Tcl_Condition is used. * |