diff options
author | hershey <hershey> | 1999-03-12 19:51:30 (GMT) |
---|---|---|
committer | hershey <hershey> | 1999-03-12 19:51:30 (GMT) |
commit | 6ac2b4f4e0c4bb8a02ea11746f94a36d0679aabf (patch) | |
tree | e1e6d1f0eff61c14402f7735b0c64cca4c9cd339 | |
parent | 53f8ec2a7e24bf50bf077d642099eefa32baa56a (diff) | |
download | tcl-6ac2b4f4e0c4bb8a02ea11746f94a36d0679aabf.zip tcl-6ac2b4f4e0c4bb8a02ea11746f94a36d0679aabf.tar.gz tcl-6ac2b4f4e0c4bb8a02ea11746f94a36d0679aabf.tar.bz2 |
Fixed tests to run independent of working dir.
Changed statistic printing feature in all and defs.
-rw-r--r-- | tests/all.tcl | 11 | ||||
-rw-r--r-- | tests/defs.tcl | 101 | ||||
-rw-r--r-- | tests/pkg.test | 4 | ||||
-rw-r--r-- | tests/pkgMkIndex.test | 18 | ||||
-rw-r--r-- | tests/socket.test | 10 |
5 files changed, 94 insertions, 50 deletions
diff --git a/tests/all.tcl b/tests/all.tcl index 8d32df9..c5ae0b6 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -7,11 +7,13 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: all.tcl,v 1.1.2.2 1999/03/11 23:50:38 hershey Exp $ +# RCS: @(#) $Id: all.tcl,v 1.1.2.3 1999/03/12 19:51:30 hershey Exp $ if {[lsearch ::test [namespace children]] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } +set ::test::testSingleFile false + puts stdout "Tcl 8.1 tests running in interp: [info nameofexecutable]" puts stdout "Tests running in working dir: $::test::tmpDir" if {[llength $::test::skippingTests] > 0} { @@ -44,9 +46,10 @@ if {[llength $fileList] < 1} { puts "Error: no files found matching $globPattern" exit } - set timeCmd {clock format [clock seconds]} puts stdout "Tests began at [eval $timeCmd]" + +# source each of the specified tests foreach file [lsort $fileList] { set tail [file tail $file] if {[string match l.*.test $tail]} { @@ -58,4 +61,8 @@ foreach file [lsort $fileList] { puts stdout $msg } } + +# cleanup puts stdout "\nTests ended at [eval $timeCmd]" +::test::cleanupTests 1 +return diff --git a/tests/defs.tcl b/tests/defs.tcl index 4d8af11..3ec9d95 100644 --- a/tests/defs.tcl +++ b/tests/defs.tcl @@ -11,7 +11,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: defs.tcl,v 1.1.2.1 1999/03/11 18:49:31 hershey Exp $ +# RCS: @(#) $Id: defs.tcl,v 1.1.2.2 1999/03/12 19:51:30 hershey Exp $ # Ensure that we have a minimal auto_path so we don't pick up extra junk. set auto_path [list [info library]] @@ -44,6 +44,18 @@ namespace eval test { variable testsDir [pwd] cd $originalDir + # Count the number of files tested (0 if all.tcl wasn't called). + # The all.tcl file will set testSingleFile to false, so stats will + # not be printed until all.tcl calls the cleanupTests proc. + # The currentFailure var stores the boolean value of whether the + # current test file has had any failures. The failFiles list + # stores the names of test files that had failures. + + variable numTestFiles 0 + variable testSingleFile true + variable currentFailure false + variable failFiles {} + # Tests should remove all files they create. The test suite will # check tmpDir for files created by the tests. ::test::filesMade # keeps track of such files created using the test::makeFile and @@ -56,8 +68,6 @@ namespace eval test { # initialize ::test::numTests array to keep track fo the number of # tests that pass, fial, and are skipped. array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] - #array set originalEnv [array get env] - } # If there is no "memory" command (because memory debugging isn't @@ -395,24 +405,17 @@ if {($::test::testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "window # ::test::cleanupTests -- # -# Print the number tests (total, passed, failed, and skipped) since the -# last time this procedure was invoked. -# # Remove files and dirs created using the makeFile and makeDirectory # commands since the last time this proc was invoked. # # Print the names of the files created without the makeFile command -# since the last time this proc was invoked. +# since the tests were invoked. +# +# Print the number tests (total, passed, failed, and skipped) since the +# tests were invoked. # -proc ::test::cleanupTests {} { - # print stats - puts -nonewline stdout "[file tail [info script]]:" - foreach index [list "Total" "Passed" "Skipped" "Failed"] { - puts -nonewline stdout "\t$index\t$::test::numTests($index)" - } - puts stdout "" - +proc ::test::cleanupTests {{all 0}} { # remove files and directories created by the tests foreach file $::test::filesMade { if {[file exists $file]} { @@ -420,27 +423,58 @@ proc ::test::cleanupTests {} { } } - # report the names of files in ::test::tmpDir that were not pre-existing. - set currentFiles {} - foreach file [glob -nocomplain [file join $::test::tmpDir *]] { - lappend currentFiles [file tail $file] - } - set filesNew {} - foreach file $currentFiles { - if {[lsearch $::test::filesExisted $file] == -1} { - lappend filesNew $file + set tail [file tail [info script]] + if {$all || $::test::testSingleFile} { + # print stats + puts -nonewline stdout "$tail:" + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + puts -nonewline stdout "\t$index\t$::test::numTests($index)" + } + puts stdout "" + + # print number test files sourced + # print names of files that ran tests which failed + if {$all} { + puts stdout "Sourced $::test::numTestFiles Test Files." + set ::test::numTestFiles 0 + if {[llength $::test::failFiles] > 0} { + puts stdout "Files with failing tests: $::test::failFiles" + set ::test::failFiles {} + } } - } - if {[llength $filesNew] > 0} { - puts stdout "\t\tFiles created:\t$filesNew" - } - # reset filesMade, filesExisted, and numTests - foreach index [list "Total" "Passed" "Skipped" "Failed"] { - set ::test::numTests($index) 0 + # report the names of files in ::test::tmpDir that were not pre-existing. + set currentFiles {} + foreach file [glob -nocomplain [file join $::test::tmpDir *]] { + lappend currentFiles [file tail $file] + } + set filesNew {} + foreach file $currentFiles { + if {[lsearch $::test::filesExisted $file] == -1} { + lappend filesNew $file + } + } + if {[llength $filesNew] > 0} { + puts stdout "Warning: created files:\t$filesNew" + } + + # reset filesMade, filesExisted, and numTests + set ::test::filesMade {} + set ::test::filesExisted $currentFiles + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + set ::test::numTests($index) 0 + } + } else { + # if we're deferring stat-reporting until all files are sourced, + # then add current file to failFile list if any tests in this file + # failed + incr ::test::numTestFiles + if {($::test::currentFailure) && \ + ([lsearch $::test::failFiles $tail] == -1)} { + lappend ::test::failFiles $tail + } + set ::test::currentFailure false } - set ::test::filesMade {} - set ::test::filesExisted $currentFiles } @@ -538,6 +572,7 @@ proc ::test::test {name description script expectedAnswer args} { set code [catch {uplevel $script} actualAnswer] if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} { incr ::test::numTests(Failed) + set ::test::currentFailure true if {[string first b $::test::verbose] == -1} { set script "" } diff --git a/tests/pkg.test b/tests/pkg.test index ed6d49f..d9ec80e 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pkg.test,v 1.1.2.4 1999/03/11 18:50:00 hershey Exp $ +# RCS: @(#) $Id: pkg.test,v 1.1.2.5 1999/03/12 19:51:31 hershey Exp $ if {[lsearch [namespace children] ::test] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -630,12 +630,12 @@ test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { set auto_path $oldPath package unknown $oldPkgUnknown -::test::cleanupTests concat } # cleanup interp delete $i +::test::cleanupTests return diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index d13a040..dba2218 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,20 +8,22 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.2 1999/03/11 18:50:01 hershey Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.3 1999/03/12 19:51:31 hershey Exp $ if {[lsearch [namespace children] ::test] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir -set origPkgDir [file join $::test::testsDir pkg] -set newPkgDir [file join $::test::tmpDir pkg] -if {![catch {file copy $origPkgDir $newPkgDir}]} { - set removePkgDir 1 -} -if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} { - set removePkg1Dir 1 +if {"$::test::testsDir" != "$::test::tmpDir"} { + set origPkgDir [file join $::test::testsDir pkg] + set newPkgDir [file join $::test::tmpDir pkg] + if {![catch {file copy $origPkgDir $newPkgDir}]} { + set removePkgDir 1 + } + if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} { + set removePkg1Dir 1 + } } # Add the pkg1 directory to auto_path, so that its packages can be found. diff --git a/tests/socket.test b/tests/socket.test index 5c185e3..aa9d597 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: socket.test,v 1.1.2.5 1999/03/11 18:50:08 hershey Exp $ +# RCS: @(#) $Id: socket.test,v 1.1.2.6 1999/03/12 19:51:32 hershey Exp $ # Running socket tests with a remote server: # ------------------------------------------ @@ -124,9 +124,9 @@ if {$doTestsWithRemoteServer} { set doTestsWithRemoteServer 0 } else { set remoteServerIP 127.0.0.1 - #set remoteFile [file join $::test::testsDir remote.tcl] + set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ - [open "|[list $tcltest remote.tcl \ + [open "|[list $tcltest $remoteFile \ -serverIsSilent \ -port $remoteServerPort \ -address $remoteServerIP]" \ @@ -1583,12 +1583,12 @@ test socket-12.3 {testing inheritance of accepted sockets} {doTestsWithRemoteSer } {accepted socket was not inherited} # cleanup -catch {close $commandSocket} -catch {close $remoteProcChan} if {[string match sock* $commandSocket] == 1} { puts $commandSocket exit flush $commandSocket } +catch {close $commandSocket} +catch {close $remoteProcChan} ::test::cleanupTests flush stdout |