diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/all.tcl | 2 | ||||
| -rw-r--r-- | tests/chanio.test | 4 | ||||
| -rw-r--r-- | tests/io.test | 4 | ||||
| -rw-r--r-- | tests/ioCmd.test | 16 | ||||
| -rw-r--r-- | tests/platform.test | 6 | ||||
| -rw-r--r-- | tests/tcltest.test | 7 | ||||
| -rw-r--r-- | tests/tcltests.tcl | 12 | ||||
| -rw-r--r-- | tests/thread.test | 11 |
8 files changed, 34 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 "" |