summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/all.tcl2
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/io.test4
-rw-r--r--tests/ioCmd.test16
-rw-r--r--tests/platform.test6
-rw-r--r--tests/tcltest.test7
-rw-r--r--tests/tcltests.tcl12
-rw-r--r--tests/thread.test11
-rw-r--r--tools/valgrind_suppress10
9 files changed, 44 insertions, 28 deletions
diff --git a/tests/all.tcl b/tests/all.tcl
index 250163b..4fce323 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -13,7 +13,7 @@
package prefer latest
package require Tcl 8.5-
package require tcltest 2.2
-namespace import tcltest::*
+namespace import -force ::tcltest::*
configure {*}$argv -testdir [file dirname [file dirname [file normalize [
info script]/...]]]
diff --git a/tests/chanio.test b/tests/chanio.test
index 86c1485..492c11e 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/io.test b/tests/io.test
index cdecb7b..cc1d986 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/platform.test b/tests/platform.test
index 8ee0ec7..e5a4c90 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/tcltest.test b/tests/tcltest.test
index 17fa926..0bcf342 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -908,7 +908,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
}
@@ -920,6 +922,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 8d42b70..2105279 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -1,7 +1,11 @@
#! /usr/bin/env tclsh
-# Some tests require the "exec" command.
-# Skip them if exec is not defined.
-testConstraint exec [llength [info commands exec]]
+package require tcltest 2.2
+namespace import -force ::tcltest::*
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
+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 a23670a..eaaaa41 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -14,10 +14,6 @@
# 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
@@ -28,13 +24,6 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testthread [expr {[info commands testthread] ne {}}]
-# Some tests require the Thread package
-
-testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
-
-# Some tests may not work under valgrind
-
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
set threadSuperKillScript {
rename catch ""
diff --git a/tools/valgrind_suppress b/tools/valgrind_suppress
index ede584a..fb7f173 100644
--- a/tools/valgrind_suppress
+++ b/tools/valgrind_suppress
@@ -29,6 +29,16 @@
}
{
+ TclpDlopen/load
+ Memcheck:Leak
+ match-leak-kinds: reachable
+ fun:malloc
+ ...
+ fun:dlopen
+ fun:TclpDlopen
+}
+
+{
TclpGetGrNam/__nss_next2/calloc
Memcheck:Leak
match-leak-kinds: reachable