changed all and defs to print stats at end of all tests.

blocked one test out of winDialog.

3 files changed, 100 insertions, 49 deletions

diff --git a/tests/all.tcl b/tests/all.tcl
index fa7fb58..ae90c01 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -7,18 +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:51:26 hershey Exp $
-
-# extra files: arc.tcl bugs.tcl butGeom2.tcl \
-#	canvPsBmap.tcl canvPsText.tcl bevel.tcl butGeom.tcl \
-#	canvPsArc.tcl canvPsGrph.tcl cmap.tcl filebox.test \
-#	visual
-
-# trouble files: unixWm.test filebox.test
+# RCS: @(#) $Id: all.tcl,v 1.1.2.3 1999/03/14 01:22:52 hershey Exp $
 
 if {[lsearch ::test [namespace children]] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
+set ::test::testSingleFile false
+
 puts stdout "Tk 8.1 tests running in interp:  [info nameofexecutable]"
 puts stdout "Tests running in working dir:  $::test::tmpDir"
 if {[llength $::test::skippingTests] > 0} {
@@ -51,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]} {
@@ -65,7 +61,10 @@ foreach file [lsort $fileList] {
 	puts stdout $msg
     }
 }
-puts stdout "\nTests ended at [eval $timeCmd]"
 
-catch {destroy .}
+# cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::test::cleanupTests 1
+#catch {destroy .}
 exit
+#return
diff --git a/tests/defs.tcl b/tests/defs.tcl
index 68b5f2c..a98e3f6 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:50:47 hershey Exp $
+# RCS: @(#) $Id: defs.tcl,v 1.1.2.2 1999/03/14 01:22:52 hershey Exp $
 
 tk appname tktest
 wm title . tktest
@@ -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
@@ -189,7 +199,6 @@ proc ::test::processCmdLineArgs {} {
 }
 test::processCmdLineArgs
 
-
 # Check configuration information that will determine which tests
 # to run.  To do this, create an array ::test::testConfig.  Each element
 # has a 0 or 1 value, and the following elements are defined:
@@ -227,6 +236,19 @@ test::processCmdLineArgs
 #			where the configuration is well known.  You can
 #			run these tests by using the -constraint command
 #			line option with "nonPortable" in the argument list.
+#	tempNotPc -	The inverse of pcOnly.  This flag is used to
+#			temporarily disable a test.
+#	tempNotMac -	The inverse of macOnly.  This flag is used to
+#			temporarily disable a test.
+#	nonBlockFiles - 1 means this platform supports setting files into
+#			nonblocking mode.
+#	asyncPipeClose- 1 means this platform supports async flush and
+#			async close on a pipe.
+#	unixExecs     - 1 means this machine has commands such as 'cat',
+#			'echo' etc available.
+#       hasIsoLocale  - 1 means the tests that need to switch to an iso
+#                       locale can be run.
+#
 
 catch {unset ::test::testConfig}
 
@@ -408,24 +430,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]} {
@@ -433,27 +448,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 {}
+	    }
+	}
+
+	# 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"
 	}
-    }
-    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
+	# 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
 }
 
 
@@ -551,6 +597,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 ""
 	}
@@ -741,8 +788,13 @@ if {$tcl_platform(os) != "Win32s"} {
 	    exit
 	}
 	close $f
-	set f [open "|[list $tcltest tmp]" r]
-	close $f
+
+	# The following 2 lines are commented out due to a new pipe bug
+	# (bugID 1495) on windowns in Tk8.1b2
+
+	#set f [open "|[list $tcltest tmp]" r]
+	#close $f
+
 	set ::test::testConfig(stdio) 1
     }
     catch {file delete -force tmp}
diff --git a/tests/winDialog.test b/tests/winDialog.test
index 5537ba6..60c043f 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winDialog.test,v 1.1.2.3 1999/03/11 18:51:21 hershey Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.1.2.4 1999/03/14 01:22:53 hershey Exp $
 
 if {$tcl_platform(os) != "Windows NT"} {
     puts "skipping: Windows NT only tests..."
@@ -179,7 +179,7 @@ append a $a
 append a $a
 append a $a
 append a $a
-test winDialog-5.16 {GetFileName: initial file: long name} {
+test winDialog-5.16 {GetFileName: initial file: long name} {knownBug} {
     start {set x [tk_getSaveFile -initialfile $a -title Long]}
     then {
 	Click 1