Fixed tests to run independent of working dir.

Changed statistic printing feature in all and defs.

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