summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-06-25 20:39:31 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-06-25 20:39:31 (GMT)
commit3c26b9439d5c9a10bfac52bd5e96024b475e79fd (patch)
tree934c4fd78ce15f57b6ec976b70ce60caf450a63d
parent6264f4978838b089748579e436d35b30a4e56201 (diff)
parentfdee46ab16b879589155729e6db4fdabe235880f (diff)
downloadtcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.zip
tcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.tar.gz
tcl-3c26b9439d5c9a10bfac52bd5e96024b475e79fd.tar.bz2
merge 8.7
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclTest.c16
-rw-r--r--generic/tclThreadTest.c8
-rw-r--r--tests/all.tcl15
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/expr.test9
-rw-r--r--tests/http11.test7
-rw-r--r--tests/io.test4
-rw-r--r--tests/ioCmd.test16
-rw-r--r--tests/iogt.test2
-rw-r--r--tests/pkgIndex.tcl2
-rw-r--r--tests/platform.test6
-rw-r--r--tests/tailcall.test20
-rw-r--r--tests/tcltest.test7
-rw-r--r--tests/tcltests.tcl10
-rw-r--r--tests/thread.test67
-rw-r--r--tools/valgrind_suppress126
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/tclUnixSock.c6
-rw-r--r--unix/tclUnixThrd.c6
-rw-r--r--win/tclWinInit.c19
-rw-r--r--win/tclWinSock.c20
-rw-r--r--win/tclWinThrd.c8
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.
*