* tests/all.tcl: Removed support for tcltest 1.0.

* tests/tcltest.test:
* library/tcltest1.0/tcltest.tcl:
* library/tcltest1.0/pkgIndex.tcl:
* docs/tcltest.n: Moved tcltest2 code so that it's the standard
version of tcltest.  Removed all tcltest2 files
(tests/tcltest2.test, library/tcltest1.0/tcltest2.tcl,
docs/tcltest2.n).


FossilOrigin-Name: 30eb4d542e925f40201f5e76c74ff9050b2213c3

6 files changed, 4814 insertions, 8626 deletions

diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index e3746e2..da93644 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -8,5 +8,4 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.
 
-package ifneeded tcltest 1.0 [list source [file join $dir tcltest.tcl]]
-package ifneeded tcltest 2.0 [list source [file join $dir tcltest2.tcl]]
+package ifneeded tcltest 2.0 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 63639e3..80f80c7 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1,7 +1,7 @@
 # tcltest.tcl --
 #
 #	This file contains support code for the Tcl test suite.  It 
-#       defines the ::tcltest namespace and finds and defines the output
+#       defines the tcltest namespace and finds and defines the output
 #       directory, constraints available, output and error channels, etc. used
 #       by Tcl tests.  See the tcltest man page for more details.
 #       
@@ -10,11 +10,10 @@
 #
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.27 2000/09/06 18:50:15 hobbs Exp $
-
-package provide tcltest 1.0
+# RCS: @(#) $Id: tcltest.tcl,v 1.28 2000/10/24 22:30:32 jenn Exp $
 
 # create the "tcltest" namespace for all testing variables and procedures
 
@@ -23,19 +22,25 @@ namespace eval tcltest {
     # Export the public tcltest procs
     set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingFiles \
-	    loadTestedCommands normalizePath]
+	    viewFile bytestring threadReap debug testConstraint \
+	    limitConstraints loadTestedCommands normalizePath verbose match \
+	    skip matchFiles skipFiles preserveCore  loadScript loadFile \
+	    mainThread workingDirectory singleProcess interpreter runAllTests \
+	    outputChannel outputFile errorChannel \
+	    errorFile temporaryDirectory testsDirectory  matchDirectories \
+	    skipDirectories ]
     foreach proc $procList {
 	namespace export $proc
     }
 
-    # ::tcltest::verbose defaults to "b"
+    # tcltest::verbose defaults to {body}
     if {![info exists verbose]} {
-	variable verbose "b"
+	variable verbose {body}
     }
 
     # Match and skip patterns default to the empty list, except for
-    # matchFiles, which defaults to all .test files in the testsDirectory
+    # matchFiles, which defaults to all .test files in the testsDirectory and
+    # matchDirectories, which defaults to all directories.
 
     if {![info exists match]} {
 	variable match {}
@@ -49,6 +54,12 @@ namespace eval tcltest {
     if {![info exists skipFiles]} {
 	variable skipFiles {}
     }
+    if {![info exists matchDirectories]} {
+	variable matchDirectories {*}
+    }
+    if {![info exists skipDirectories]} {
+	variable skipDirectories {}
+    }
 
     # By default, don't save core files
     if {![info exists preserveCore]} {
@@ -59,11 +70,17 @@ namespace eval tcltest {
     if {![info exists outputChannel]} {
 	variable outputChannel stdout
     }
+    if {![info exists outputFile]} {
+	variable outputFile stdout
+    }
 
     # errors go to stderr by default
     if {![info exists errorChannel]} {
 	variable errorChannel stderr
     }
+    if {![info exists errorFile]} {
+	variable errorFile stderr
+    }
 
     # debug output doesn't get printed by default; debug level 1 spits
     # up only the tests that were skipped because they didn't match or were 
@@ -81,9 +98,9 @@ namespace eval tcltest {
 	variable parameters {}
     }
 
-    # 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.
+    # Count the number of files tested (0 if runAllTests wasn't called).
+    # runAllTests will set testSingleFile to false, so stats will
+    # not be printed until runAllTests 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.
@@ -103,9 +120,9 @@ namespace eval tcltest {
 
     # Tests should remove all files they create.  The test suite will
     # check the current working dir for files created by the tests.
-    # ::tcltest::filesMade keeps track of such files created using the
-    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
-    # ::tcltest::filesExisted stores the names of pre-existing files.
+    # tcltest::filesMade keeps track of such files created using the
+    # tcltest::makeFile and tcltest::makeDirectory procedures.
+    # tcltest::filesExisted stores the names of pre-existing files.
 
     if {![info exists filesMade]} {
 	variable filesMade {}
@@ -114,43 +131,47 @@ namespace eval tcltest {
 	variable filesExisted {}
     }
 
-    # ::tcltest::numTests will store test files as indices and the list
+    # tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
 
     if {![info exists createdNewFiles]} {
 	variable createdNewFiles
-	array set ::tcltest::createdNewFiles {}
+	array set tcltest::createdNewFiles {}
     }
 
-    # initialize ::tcltest::numTests array to keep track fo the number of
+    # initialize tcltest::numTests array to keep track fo the number of
     # tests that pass, fail, and are skipped.
 
     if {![info exists numTests]} {
 	variable numTests
-	array set ::tcltest::numTests \
+	array set tcltest::numTests \
 		[list Total 0 Passed 0 Skipped 0 Failed	0] 
     }
 
-    # initialize ::tcltest::skippedBecause array to keep track of
+    # initialize tcltest::skippedBecause array to keep track of
     # constraints that kept tests from running; a constraint name of
     # "userSpecifiedSkip" means that the test appeared on the list of tests
     # that matched the -skip value given to the flag; "userSpecifiedNonMatch"
     # means that the test didn't match the argument given to the -match flag;
-    # both of these constraints are counted only if ::tcltest::debug is set to
+    # both of these constraints are counted only if tcltest::debug is set to
     # true. 
 
     if {![info exists skippedBecause]} {
 	variable skippedBecause
-	array set ::tcltest::skippedBecause {}
+	array set tcltest::skippedBecause {}
     }
 
-    # initialize the ::tcltest::testConstraints array to keep track of valid
+    # initialize the tcltest::testConstraints array to keep track of valid
     # predefined constraints (see the explanation for the
-    # ::tcltest::initConstraints proc for more details).
+    # tcltest::initConstraints proc for more details).
 
     if {![info exists testConstraints]} {
 	variable testConstraints
-	array set ::tcltest::testConstraints {}
+	array set tcltest::testConstraints {}
+    }
+
+    if {![info exists constraintsSpecified]} {
+	variable constraintsSpecified {}
     }
 
     # Don't run only the constrained tests by default
@@ -166,6 +187,11 @@ namespace eval tcltest {
 	variable loadScript {}
     }
 
+    # and the filename of the script file, if it exists
+    if {![info exists loadFile]} {
+	variable loadFile {}
+    }
+
     # tests that use threads need to know which is the main thread
 
     if {![info exists mainThread]} {
@@ -181,10 +207,10 @@ namespace eval tcltest {
     
     if {![info exists originalEnv]} {
 	variable originalEnv
-	array set ::tcltest::originalEnv [array get ::env]
+	array set tcltest::originalEnv [array get ::env]
     }
 
-    # Set ::tcltest::workingDirectory to [pwd]. The default output directory
+    # Set tcltest::workingDirectory to [pwd]. The default output directory
     # for Tcl tests is the working directory.
 
     if {![info exists workingDirectory]} {
@@ -196,7 +222,7 @@ namespace eval tcltest {
 
     # Tests should not rely on the current working directory.
     # Files that are part of the test suite should be accessed relative to 
-    # ::tcltest::testsDirectory.
+    # tcltest::testsDirectory.
 
     if {![info exists testsDirectory]} {
 	set oldpwd [pwd]
@@ -206,30 +232,40 @@ namespace eval tcltest {
 	unset oldpwd
     }
 
-    # the variables and procs that existed when ::tcltest::saveState was
+    # Default is to run each test file in a separate process
+    if {![info exists singleProcess]} {
+	variable singleProcess 0
+    }
+
+    # the variables and procs that existed when tcltest::saveState was
     # called are stored in a variable of the same name
     if {![info exists saveState]} {
 	variable saveState {}
     }
 
-    # Internationalization support
+    # Internationalization support -- used in tcltest::set_iso8859_1_locale
+    # and tcltest::restore_locale. Those commands are used in cmdIL.test.
+    if {![info exists previousLocale]} {
+	variable previousLocale
+    }
+
     if {![info exists isoLocale]} {
 	variable isoLocale fr
-        switch $tcl_platform(platform) {
+	switch -- $tcl_platform(platform) {
 	    "unix" {
 
 		# Try some 'known' values for some platforms:
 
 		switch -exact -- $tcl_platform(os) {
 		    "FreeBSD" {
-			set ::tcltest::isoLocale fr_FR.ISO_8859-1
+			set tcltest::isoLocale fr_FR.ISO_8859-1
 		    }
 		    HP-UX {
-			set ::tcltest::isoLocale fr_FR.iso88591
+			set tcltest::isoLocale fr_FR.iso88591
 		    }
 		    Linux -
 		    IRIX {
-			set ::tcltest::isoLocale fr
+			set tcltest::isoLocale fr
 		    }
 		    default {
 
@@ -237,12 +273,12 @@ namespace eval tcltest {
 			# define it to something else on your system
 			#if you want to test those.
 
-			set ::tcltest::isoLocale iso_8859_1
+			set tcltest::isoLocale iso_8859_1
 		    }
 		}
 	    }
 	    "windows" {
-		set ::tcltest::isoLocale French
+		set tcltest::isoLocale French
 	    }
 	}
     }
@@ -250,7 +286,7 @@ namespace eval tcltest {
     # Set the location of the execuatble
     if {![info exists tcltest]} {
 	variable tcltest [info nameofexecutable]
-    }
+    }	
 
     # save the platform information so it can be restored later
     if {![info exists originalTclPlatform]} {
@@ -259,29 +295,34 @@ namespace eval tcltest {
 
     # If a core file exists, save its modification time.
     if {![info exists coreModificationTime]} {
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	if {[file exists [file join $tcltest::workingDirectory core]]} {
 	    variable coreModificationTime [file mtime [file join \
-		    $::tcltest::workingDirectory core]]
+		    $tcltest::workingDirectory core]]
 	}
     }
 
-    # Tcl version numbers
-    if {![info exists version]} {
-	variable version 8.4
+    # stdout and stderr buffers for use when we want to store them
+    if {![info exists outData]} {
+	variable outData {}
     }
-    if {![info exists patchLevel]} {
-	variable patchLevel 8.4a2
+    if {![info exists errData]} {
+	variable errData {}
     }
+
+    # keep track of test level for nested test commands
+    variable testLevel 0
 }   
 
-# ::tcltest::Debug* --
+#####################################################################
+
+# tcltest::Debug* --
 #
 #     Internal helper procedures to write out debug information
 #     dependent on the chosen level. A test shell may overide
 #     them, f.e. to redirect the output into a different
 #     channel, or even into a GUI.
 
-# ::tcltest::DebugPuts --
+# tcltest::DebugPuts --
 #
 #     Prints the specified string if the current debug level is
 #     higher than the provided level argument.
@@ -293,15 +334,19 @@ namespace eval tcltest {
 # Results:
 #     Prints the string. Nothing else is allowed.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugPuts {level string} {
+proc tcltest::DebugPuts {level string} {
     variable debug
     if {$debug >= $level} {
 	puts $string
     }
+    return
 }
 
-# ::tcltest::DebugPArray --
+# tcltest::DebugPArray --
 #
 #     Prints the contents of the specified array if the current
 #       debug level is higher than the provided level argument
@@ -313,17 +358,21 @@ proc ::tcltest::DebugPuts {level string} {
 # Results:
 #     Prints the contents of the array. Nothing else is allowed.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugPArray {level arrayvar} {
+proc tcltest::DebugPArray {level arrayvar} {
     variable debug
 
     if {$debug >= $level} {
 	catch {upvar  $arrayvar $arrayvar}
 	parray $arrayvar
     }
+    return
 }
 
-# ::tcltest::DebugDo --
+# tcltest::DebugDo --
 #
 #     Executes the script if the current debug level is greater than
 #       the provided level argument
@@ -335,16 +384,779 @@ proc ::tcltest::DebugPArray {level arrayvar} {
 # Results:
 #     Arbitrary side effects, dependent on the executed script.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugDo {level script} {
+proc tcltest::DebugDo {level script} {
     variable debug
 
     if {$debug >= $level} {
 	uplevel $script
     }
+    return
+}
+
+#####################################################################
+
+# tcltest::CheckDirectory --
+#
+#     This procedure checks whether the specified path is a readable
+#     and/or writable directory. If one of the conditions is not
+#     satisfied an error is printed and the application aborted. The
+#     procedure assumes that the caller already checked the existence
+#     of the path.
+#
+# Arguments
+#     rw      Information what attributes to check. Allowed values:
+#             r, w, rw, wr. If 'r' is part of the value the directory
+#             must be readable. 'w' associates to 'writable'.
+#     dir     The directory to check.
+#     errMsg  The string to prepend to the actual error message before
+#             printing it.
+#
+# Results
+#     none
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::CheckDirectory {rw dir errMsg} {
+    # Allowed values for 'rw': r, w, rw, wr
+
+    if {![file isdir $dir]} {
+	set msg "$errMsg \"$dir\" is not a directory"
+	error $msg
+    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
+	set msg "$errMsg \"$dir\" is not writeable"
+	error $msg
+    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
+	set msg "$errMsg \"$dir\" is not readable"
+	error $msg
+    }
+    return
+}
+
+# tcltest::normalizePath --
+#
+#     This procedure resolves any symlinks in the path thus creating a
+#     path without internal redirection. It assumes that the incoming
+#     path is absolute.
+#
+# Arguments
+#     pathVar contains the name of the variable containing the path to modify.
+#
+# Results
+#     The path is modified in place.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::normalizePath {pathVar} {
+    upvar $pathVar path
+
+    set oldpwd [pwd]
+    catch {cd $path}
+    set path [pwd]
+    cd $oldpwd
+    return $path
+}
+
+
+# tcltest::MakeAbsolutePath --
+#
+#     This procedure checks whether the incoming path is absolute or not.
+#     Makes it absolute if it was not.
+#
+# Arguments
+#     pathVar contains the name of the variable containing the path to modify.
+#     prefix  is optional, contains the path to use to make the other an
+#             absolute one. The current working directory is used if it was
+#             not specified.
+#
+# Results
+#     The path is modified in place.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
+    upvar $pathVar path
+
+    if {![string equal [file pathtype $path] "absolute"]} { 
+	if {$prefix == {}} {
+	    set prefix [pwd]
+	}
+
+	set path [file join $prefix $path] 
+    }
+    return $path
+}
+
+#####################################################################
+
+# tcltest::<variableName>
+#     
+#     Accessor functions for tcltest variables that can be modified externally.
+#     These are vars that could otherwise be modified using command line
+#     arguments to tcltest.
+
+# tcltest::verbose --
+#
+#	Set or return the verbosity level (tcltest::verbose) for tests.  This
+#       determines what gets printed to the screen and when, with regard to the
+#       running of the tests.  The proc does not check for invalid values.  It
+#       assumes that a string that doesn't match its predefined keywords
+#       is a string containing letter-specified verbosity levels.
+#
+# Arguments:
+#	A string containing any combination of 'pbste' or a list of keywords
+#       (listed in parens)
+#          p = print output whenever a test passes (pass)
+#          b = print the body of the test when it fails (body)
+#          s = print when a test is skipped (skip)
+#          t = print when a test starts (start)
+#          e = print errorInfo and errorCode when a test encounters an error
+#              (error) 
+#
+# Results:
+#	content of tcltest::verbose - this is always the character combination
+#       (pbste) instead of the list form.
+#
+# Side effects:
+#	None.
+
+proc tcltest::verbose { {level ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::verbose
+    } 
+    if {[llength $level] > 1} {
+  	set tcltest::verbose $level
+    } else {
+	if {[regexp {pass|body|skip|start|error} $level]} {
+	    set tcltest::verbose $level
+	} else { 
+	    set levelList [split $level {}]
+	    set tcltest::verbose [string map {p pass b body s skip t start e
+		error} $levelList]
+	}
+    }
+    return $tcltest::verbose
+}
+
+# tcltest::isVerbose --
+#
+#	Returns true if argument is one of the verbosity levels currently being
+#       used; returns false otherwise.
+#
+# Arguments:
+#	level
+#
+# Results:
+#	boolean 1 (true) or 0 (false), depending on whether or not the level
+#       provided is one of the ones stored in tcltest::verbose.
+#
+# Side effects:
+#	None.
+
+proc tcltest::isVerbose {level} {
+    if {[lsearch -exact [tcltest::verbose] $level] == -1} {
+	return 0
+    }
+    return 1
+}
+
+
+
+# tcltest::match --
+#
+#	Set or return the match patterns (tcltest::match) that determine which
+#       tests are run. 
+#
+# Arguments:
+#	List containing match patterns (glob format)
+#
+# Results:
+#	content of tcltest::match
+#
+# Side effects:
+#	none
+
+proc tcltest::match { {matchList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::match
+    } 
+    set tcltest::match $matchList
+}
+
+# tcltest::skip --
+#
+#	Set or return the skip patterns (tcltest::skip) that determine which
+#       tests are skipped. 
+#
+# Arguments:
+#	List containing skip patterns (glob format)
+#
+# Results:
+#	content of tcltest::skip
+#
+# Side effects:
+#	None.
+
+proc tcltest::skip { {skipList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skip
+    }
+    set tcltest::skip $skipList
+}
+
+# tcltest::matchFiles --
+#
+#	set or return the match patterns for file sourcing
+#
+# Arguments:
+#	list containing match file list (glob format)
+#
+# Results:
+#	content of tcltest::matchFiles
+#
+# Side effects:
+#	None.
+
+proc tcltest::matchFiles { {matchFileList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::matchFiles
+    }
+    set tcltest::matchFiles $matchFileList
+}
+
+# tcltest::skipFiles --
+#
+#	set or return the skip patterns for file sourcing
+#
+# Arguments:
+#	list containing the skip file list (glob format)
+#
+# Results:
+#	content of tcltest::skipFiles
+#
+# Side effects:
+#	None.
+
+proc tcltest::skipFiles { {skipFileList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skipFiles
+    }
+    set tcltest::skipFiles $skipFileList
+}
+
+
+# tcltest::matchDirectories --
+#
+#	set or return the list of directories for matching (glob pattern list)
+#
+# Arguments:
+#	list of glob patterns matching subdirectories of
+#       tcltest::testsDirectory 
+#
+# Results:
+#	content of tcltest::matchDirectories
+#
+# Side effects:
+#	None.
+
+proc tcltest::matchDirectories { {dirlist ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::matchDirectories
+    }
+    set tcltest::matchDirectories $dirlist
+}
+
+# tcltest::skipDirectories --
+#
+#	set or return the list of directories to skip (glob pattern list)
+#
+# Arguments:
+#	list of glob patterns matching directories to skip; these directories
+#       are subdirectories of tcltest::testsDirectory
+#
+# Results:
+#	content of tcltest::skipDirectories
+#
+# Side effects:
+#	None.
+
+proc tcltest::skipDirectories { {dirlist ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skipDirectories
+    }
+    set tcltest::skipDirectories $dirlist
+}
+
+# tcltest::preserveCore --
+#
+#	set or return the core preservation level.  This proc does not do any
+#       error checking for invalid values.
+#
+# Arguments:
+#	core level:
+#         '0' = don't do anything with core files (default)
+#         '1' = notify the user if core files are created
+#         '2' = save any core files produced during testing to
+#               tcltest::temporaryDirectory 
+#
+# Results:
+#	content of tcltest::preserveCore
+#
+# Side effects:
+#	None.
+
+proc tcltest::preserveCore { {coreLevel ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::preserveCore
+    }
+    set tcltest::preserveCore $coreLevel
+}
+
+# tcltest::outputChannel --
+#
+#	set or return the output file descriptor based on the supplied file
+#       name (where tcltest puts all of its output) 
+#
+# Arguments:
+#	output file descriptor
+#
+# Results:
+#	file descriptor corresponding to supplied file name (or currently set
+#       file descriptor, if no new filename was supplied) - this is the content
+#       of tcltest::outputChannel 
+#
+# Side effects:
+#	None.
+
+proc tcltest::outputChannel { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::outputChannel
+    }
+    if {($filename == "stderr") || ($filename == "stdout")} {
+	set tcltest::outputChannel $filename
+    } else {
+	set tcltest::outputChannel [open $filename w]
+    }
+    return $tcltest::outputChannel
+}
+
+# tcltest::outputFile --
+#
+#	set or return the output file name (where tcltest puts all of its
+#       output); calls tcltest::outputChannel to set the corresponding file
+#       descriptor 
+#
+# Arguments:
+#	output file name
+#
+# Results:
+#       file name corresponding to supplied file name (or currently set
+#       file name, if no new filename was supplied) - this is the content
+#       of tcltest::outputFile
+#
+# Side effects:
+#	if the file name supplied is relative, it will be made absolute with
+#       respect to the predefined temporaryDirectory
+
+proc tcltest::outputFile { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::outputFile
+    }
+    if {($filename != "stderr") && ($filename != "stdout")} {
+	MakeAbsolutePath filename $tcltest::temporaryDirectory
+    }
+    tcltest::outputChannel $filename
+    set tcltest::outputFile $filename
+}
+
+# tcltest::errorChannel --
+#
+#	set or return the error file descriptor based on the supplied file name
+#       (where tcltest sends all its errors)  
+#
+# Arguments:
+#	error file name
+#
+# Results:
+#	file descriptor corresponding to the supplied file name (or currently
+#       set file descriptor, if no new filename was supplied) - this is the
+#       content of tcltest::errorChannel
+#
+# Side effects:
+#	opens the descriptor in w mode unless the filename is set to stderr or
+#       stdout 
+
+proc tcltest::errorChannel { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::errorChannel
+    }
+    if {($filename == "stderr") || ($filename == "stdout")} {
+	set tcltest::errorChannel $filename
+    } else {
+	set tcltest::errorChannel [open $filename w]
+    }
+    return $tcltest::errorChannel
+}
+
+# tcltest::errorFile --
+#
+#	set or return the error file name; calls tcltest::errorChannel to set
+#       the corresponding file descriptor
+#
+# Arguments:
+#	error file name
+#
+# Results:
+#	content of tcltest::errorFile
+#
+# Side effects:
+#	if the file name supplied is relative, it will be made absolute with
+#       respect to the predefined temporaryDirectory
+
+proc tcltest::errorFile { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::errorFile
+    }
+    if {($filename != "stderr") && ($filename != "stdout")} {
+	MakeAbsolutePath filename $tcltest::temporaryDirectory
+    }
+    set tcltest::errorFile $filename
+    errorChannel $tcltest::errorFile
+    return $tcltest::errorFile
+}
+
+# tcltest::debug --
+#
+#	set or return the debug level for tcltest; this proc does not check for
+#       invalid values
+#
+# Arguments:
+#	debug level:
+#       '0' = no debug output (default)
+#       '1' = skipped tests
+#       '2' = tcltest variables and supplied flags
+#       '3' = harness operations
+#
+# Results:
+#	content of tcltest::debug
+#
+# Side effects:
+#	None.
+
+proc tcltest::debug { {debugLevel ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::debug
+    }
+    set tcltest::debug $debugLevel
+}
+
+# tcltest::testConstraint --
+#
+#	sets a test constraint to a value; to do multiple constraints, call
+#       this proc multiple times.  also returns the value of the named
+#       constraint if no value was supplied.
+#
+# Arguments:
+#	constraint - name of the constraint
+#       value - new value for constraint (should be boolean) - if not supplied,
+#               this is a query
+#
+# Results:
+#	content of tcltest::testConstraints($constraint)
+#
+# Side effects:
+#	appends the constraint name to tcltest::constraintsSpecified
+
+proc tcltest::testConstraint {constraint {value ""}} {
+    DebugPuts 3 "entering testConstraint $constraint $value"
+    if {[llength [info level 0]] == 2} {
+	return $tcltest::testConstraints($constraint)
+    } 
+    lappend tcltest::constraintsSpecified $constraint
+    set tcltest::testConstraints($constraint) $value
+}
+
+# tcltest::constraintsSpecified --
+#
+#	returns a list of all the constraint names specified using
+#       testConstraint 
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	list of the constraint names in tcltest::constraintsSpecified
+#
+# Side effects:
+#	None.
+
+proc tcltest::constraintsSpecified {} {
+    return $tcltest::constraintsSpecified
+}
+
+# tcltest::constraintList --
+#
+#	returns a list of all the constraint names
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	list of the constraint names in tcltest::testConstraints
+#
+# Side effects:
+#	None.
+
+proc tcltest::constraintList {} {
+    return [array names tcltest::testConstraints]
+}
+
+# tcltest::limitConstraints --
+#
+#	sets the limited constraints to tcltest::limitConstraints
+#
+# Arguments:
+#	list of constraint names
+#
+# Results:
+#	content of tcltest::limitConstraints
+#
+# Side effects:
+#	None.
+
+proc tcltest::limitConstraints { {constraintList ""} } {
+    DebugPuts 3 "entering limitConstraints $constraintList"
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::limitConstraints
+    } 
+    set tcltest::limitConstraints $constraintList
+    foreach elt [tcltest::constraintList] {
+	if {[lsearch -exact [tcltest::constraintsSpecified] $elt] == -1} {
+	    tcltest::testConstraint $elt 0
+	}
+    }
+    return $tcltest::limitConstraints
+}
+
+# tcltest::loadScript --
+#
+#	sets the load script
+#
+# Arguments:
+#	script to be set
+#
+# Results:
+#	contents of tcltest::loadScript
+#
+# Side effects:
+#	None.
+
+proc tcltest::loadScript { {script ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::loadScript
+    }
+    set tcltest::loadScript $script
+}
+
+# tcltest::loadFile --
+#
+#	set the load file (containing the load script); 
+#       put the content of the load file into loadScript
+#
+# Arguments:
+#	script's file name
+#
+# Results:
+#	content of tcltest::loadFile
+#
+# Side effects:
+#	None.
+
+proc tcltest::loadFile { {scriptFile ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::loadFile
+    }
+    MakeAbsolutePath scriptFile $tcltest::temporaryDirectory
+    set tmp [open $scriptFile r]
+    tcltest::loadScript [read $tmp]
+    close $tmp
+    set tcltest::loadFile $scriptFile
+}
+
+# tcltest::workingDirectory --
+#
+#	set workingDirectory to the given path. 
+#       If the path is relative, make it absolute.
+#       change directory to the stated working directory, if resetting the
+#       value 
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::workingDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::workingDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::workingDirectory
+    }
+    set tcltest::workingDirectory $dir
+    MakeAbsolutePath tcltest::workingDirectory
+    cd $tcltest::workingDirectory
+    return $tcltest::workingDirectory
+}
+
+# tcltest::temporaryDirectory --
+#
+#     Set tcltest::temporaryDirectory to the given path.
+#     If the path is relative, make it absolute.  If the file exists but
+#     is not a dir, then return an error.
+#
+#     If tcltest::temporaryDirectory does not already exist, create it.
+#     If you cannot create it, then return an error (the file mkdir isn't
+#     caught and will propagate).
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::temporaryDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::temporaryDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::temporaryDirectory
+    }
+    set tcltest::temporaryDirectory $dir
+
+    MakeAbsolutePath tcltest::temporaryDirectory
+    set tmpDirError "bad argument for temporary directory: "
+
+    if {[file exists $tcltest::temporaryDirectory]} {
+	tcltest::CheckDirectory rw $tcltest::temporaryDirectory $tmpDirError
+    } else {
+	file mkdir $tcltest::temporaryDirectory
+    }
+
+    normalizePath tcltest::temporaryDirectory
+}
+
+# tcltest::testsDirectory --
+#
+#     Set tcltest::testsDirectory to the given path.
+#     If the path is relative, make it absolute.  If the file exists but
+#     is not a dir, then return an error.
+#
+#     If tcltest::testsDirectory does not already exist, return an error.
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::testsDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::testsDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::testsDirectory
+    }
+
+    set tcltest::testsDirectory $dir
+    
+    MakeAbsolutePath tcltest::testsDirectory
+    set testDirError "bad argument for tests directory: "
+
+    if {[file exists $tcltest::testsDirectory]} {
+	tcltest::CheckDirectory r $tcltest::testsDirectory $testDirError
+    } else {
+	set msg "$testDirError \"$tcltest::testsDirectory\" does not exist"
+	error $msg
+    }
+    
+    normalizePath tcltest::testsDirectory
+}
+
+# tcltest::singleProcess --
+#
+#	sets tcltest::singleProcess to the value provided.
+#
+# Arguments:
+#	value for singleProcess:
+#       1 = source each test file into the current process
+#       0 = run each test file in its own process 
+#
+# Results:
+#	content of tcltest::singleProcess
+#
+# Side effects:
+#	None.
+
+proc tcltest::singleProcess { {value ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::singleProcess
+    }
+    set tcltest::singleProcess $value
+}
+
+# tcltest::interpreter --
+#
+#	the interpreter name stored in tcltest::tcltest
+#
+# Arguments:
+#	executable name
+#
+# Results:
+#	content of tcltest::tcltest
+#
+# Side effects:
+#	None.
+
+proc tcltest::interpreter { {interp ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::tcltest
+    }
+    set tcltest::tcltest $interp
+}
+
+# tcltest::mainThread --
+#
+#	sets or returns the thread id stored in tcltest::mainThread
+#
+# Arguments:
+#	thread id
+#
+# Results:
+#	content of tcltest::mainThread
+#
+# Side effects:
+#	None.
+
+proc tcltest::mainThread { {threadid ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::mainThread
+    }
+    set tcltest::mainThread $threadid
 }
 
-# ::tcltest::AddToSkippedBecause --
+#####################################################################
+
+# tcltest::AddToSkippedBecause --
 #
 #	Increments the variable used to track how many tests were skipped
 #       because of a particular constraint.
@@ -353,52 +1165,61 @@ proc ::tcltest::DebugDo {level script} {
 #	constraint     The name of the constraint to be modified
 #
 # Results:
-#	Modifies ::tcltest::skippedBecause; sets the variable to 1 if didn't
+#	Modifies tcltest::skippedBecause; sets the variable to 1 if didn't
 #       previously exist - otherwise, it just increments it.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::AddToSkippedBecause { constraint } {
+proc tcltest::AddToSkippedBecause { constraint {value 1}} {
     # add the constraint to the list of constraints that kept tests
     # from running
 
-    if {[info exists ::tcltest::skippedBecause($constraint)]} {
-	incr ::tcltest::skippedBecause($constraint)
+    if {[info exists tcltest::skippedBecause($constraint)]} {
+	incr tcltest::skippedBecause($constraint) $value
     } else {
-	set ::tcltest::skippedBecause($constraint) 1
+	set tcltest::skippedBecause($constraint) $value
     }
     return
 }
 
-# ::tcltest::PrintError --
+# tcltest::PrintError --
 #
-#	Prints errors to ::tcltest::errorChannel and then flushes that
+#	Prints errors to tcltest::errorChannel and then flushes that
 #       channel, making sure that all messages are < 80 characters per line.
 #
 # Arguments:
 #	errorMsg     String containing the error to be printed
 #
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::PrintError {errorMsg} {
+proc tcltest::PrintError {errorMsg} {
     set InitialMessage "Error:  "
     set InitialMsgLen  [string length $InitialMessage]
-    puts -nonewline $::tcltest::errorChannel $InitialMessage
+    puts -nonewline [errorChannel] $InitialMessage
 
     # Keep track of where the end of the string is.
     set endingIndex [string length $errorMsg]
 
     if {$endingIndex < 80} {
-	puts $::tcltest::errorChannel $errorMsg
+	puts [errorChannel] $errorMsg
     } else {
 	# Print up to 80 characters on the first line, including the
 	# InitialMessage. 
 	set beginningIndex [string last " " [string range $errorMsg 0 \
 		[expr {80 - $InitialMsgLen}]]]
-	puts $::tcltest::errorChannel [string range $errorMsg 0 $beginningIndex]
+	puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
 
 	while {$beginningIndex != "end"} {
-	    puts -nonewline $::tcltest::errorChannel \
+	    puts -nonewline [errorChannel] \
 		    [string repeat " " $InitialMsgLen]  
 	    if {[expr {$endingIndex - $beginningIndex}] < 72} {
-		puts $::tcltest::errorChannel [string trim \
+		puts [errorChannel] [string trim \
 			[string range $errorMsg $beginningIndex end]]
 		set beginningIndex end
 	    } else {
@@ -409,25 +1230,52 @@ proc ::tcltest::PrintError {errorMsg} {
 			|| ($newEndingIndex <= $beginningIndex)} {
 		    set newEndingIndex end
 		}
-		puts $::tcltest::errorChannel [string trim \
+		puts [errorChannel] [string trim \
 			[string range $errorMsg \
-			$beginningIndex $newEndingIndex]]
+			    $beginningIndex $newEndingIndex]]
 		set beginningIndex $newEndingIndex
 	    }
 	}
     }
-    flush $::tcltest::errorChannel
+    flush [errorChannel]
     return
 }
 
-if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
-    proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope tcltest info procs initConstraintsHook] == {}} {
+    proc tcltest::initConstraintsHook {} {}
+}
+
+# tcltest::safeFetch --
+#
+#	 The following trace procedure makes it so that we can safely refer to
+#        non-existent members of the tcltest::testConstraints array without 
+#        causing an error.  Instead, reading a non-existent member will return
+#        0. This is necessary because tests are allowed to use constraint "X"
+#        without ensuring that tcltest::testConstraints("X") is defined.
+#
+# Arguments:
+#	n1 - name of the array (tcltest::testConstraints)
+#       n2 - array key value (constraint name)
+#       op - operation performed on tcltest::testConstraints (generally r)
+#
+# Results:
+#	none
+#
+# Side effects:
+#	sets tcltest::testConstraints($n2) to 0 if it's referenced but never
+#       before used
+
+proc tcltest::safeFetch {n1 n2 op} {
+    DebugPuts 3 "entering safeFetch $n1 $n2 $op"
+    if {($n2 != {}) && ([info exists tcltest::testConstraints($n2)] == 0)} {
+	tcltest::testConstraint $n2 0
+    }
 }
 
-# ::tcltest::initConstraints --
+# tcltest::initConstraints --
 #
-# Check Constraintsuration information that will determine which tests
-# to run.  To do this, create an array ::tcltest::testConstraints.  Each
+# Check constraint information that will determine which tests
+# to run.  To do this, create an array tcltest::testConstraints.  Each
 # element has a 0 or 1 value.  If the element is "true" then tests
 # with that constraint will be run, otherwise tests with that constraint
 # will be skipped.  See the tcltest man page for the list of built-in
@@ -437,101 +1285,110 @@ if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
 #	none
 #
 # Results:
-#	The ::tcltest::testConstraints array is reset to have an index for
+#	The tcltest::testConstraints array is reset to have an index for
 #	each built-in test constraint.
+# 
+# Side Effects:
+#       None.
+#
 
-proc ::tcltest::initConstraints {} {
+proc tcltest::initConstraints {} {
     global tcl_platform tcl_interactive tk_version
 
-    # The following trace procedure makes it so that we can safely refer to
-    # non-existent members of the ::tcltest::testConstraints array without
-    # causing an error.  Instead, reading a non-existent member will return 0.
-    # This is necessary because tests are allowed to use constraint "X" without
-    # ensuring that ::tcltest::testConstraints("X") is defined.
+    # Safely refer to non-existent members of the tcltest::testConstraints
+    # array without causing an error.  
+    trace variable tcltest::testConstraints r tcltest::safeFetch
 
-    trace variable ::tcltest::testConstraints r ::tcltest::safeFetch
+    tcltest::initConstraintsHook
 
-    proc ::tcltest::safeFetch {n1 n2 op} {
-	if {($n2 != {}) && ([info exists ::tcltest::testConstraints($n2)] == 0)} {
-	    set ::tcltest::testConstraints($n2) 0
-	}
-    }
+    tcltest::testConstraint singleTestInterp [singleProcess]
 
-    ::tcltest::initConstraintsHook
+    # All the 'pc' constraints are here for backward compatibility and are not
+    # documented.  They have been replaced with equivalent 'win' constraints.
 
-    set ::tcltest::testConstraints(unixOnly) \
+    tcltest::testConstraint unixOnly \
 	    [string equal $tcl_platform(platform) "unix"]
-    set ::tcltest::testConstraints(macOnly) \
+    tcltest::testConstraint macOnly \
 	    [string equal $tcl_platform(platform) "macintosh"]
-    set ::tcltest::testConstraints(pcOnly) \
+    tcltest::testConstraint pcOnly \
+	    [string equal $tcl_platform(platform) "windows"]
+    tcltest::testConstraint winOnly \
 	    [string equal $tcl_platform(platform) "windows"]
 
-    set ::tcltest::testConstraints(unix) $::tcltest::testConstraints(unixOnly)
-    set ::tcltest::testConstraints(mac) $::tcltest::testConstraints(macOnly)
-    set ::tcltest::testConstraints(pc) $::tcltest::testConstraints(pcOnly)
-
-    set ::tcltest::testConstraints(unixOrPc) \
-	    [expr {$::tcltest::testConstraints(unix) \
-	    || $::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macOrPc) \
-	    [expr {$::tcltest::testConstraints(mac) \
-	    || $::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macOrUnix) \
-	    [expr {$::tcltest::testConstraints(mac) \
-	    || $::tcltest::testConstraints(unix)}]
-
-    set ::tcltest::testConstraints(nt) [string equal $tcl_platform(os) \
-	    "Windows NT"]
-    set ::tcltest::testConstraints(95) [string equal $tcl_platform(os) \
-	    "Windows 95"]
-    set ::tcltest::testConstraints(98) [string equal $tcl_platform(os) \
-	    "Windows 98"]
+    tcltest::testConstraint unix [tcltest::testConstraint unixOnly]
+    tcltest::testConstraint mac [tcltest::testConstraint macOnly]
+    tcltest::testConstraint pc [tcltest::testConstraint pcOnly]
+    tcltest::testConstraint win [tcltest::testConstraint winOnly]
+
+    tcltest::testConstraint unixOrPc \
+	    [expr {[tcltest::testConstraint unix] \
+		|| [tcltest::testConstraint pc]}]
+    tcltest::testConstraint macOrPc \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint pc]}]
+    tcltest::testConstraint unixOrWin \
+	    [expr {[tcltest::testConstraint unix] \
+		|| [tcltest::testConstraint win]}]
+    tcltest::testConstraint macOrWin \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint win]}]
+    tcltest::testConstraint macOrUnix \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint unix]}]
+
+    tcltest::testConstraint nt [string equal $tcl_platform(os) "Windows NT"]
+    tcltest::testConstraint 95 [string equal $tcl_platform(os) "Windows 95"]
+    tcltest::testConstraint 98 [string equal $tcl_platform(os) "Windows 98"]
 
     # The following Constraints switches are used to mark tests that should
     # work, but have been temporarily disabled on certain platforms because
     # they don't and we haven't gotten around to fixing the underlying
     # problem. 
 
-    set ::tcltest::testConstraints(tempNotPc) \
-	    [expr {!$::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(tempNotMac) \
-	    [expr {!$::tcltest::testConstraints(mac)}]
-    set ::tcltest::testConstraints(tempNotUnix) \
-	    [expr {!$::tcltest::testConstraints(unix)}]
+    tcltest::testConstraint tempNotPc \
+	    [expr {![tcltest::testConstraint pc]}]
+    tcltest::testConstraint tempNotWin \
+	    [expr {![tcltest::testConstraint win]}]
+    tcltest::testConstraint tempNotMac \
+	    [expr {![tcltest::testConstraint mac]}]
+    tcltest::testConstraint tempNotUnix \
+	    [expr {![tcltest::testConstraint unix]}]
 
     # The following Constraints switches are used to mark tests that crash on
     # certain platforms, so that they can be reactivated again when the
     # underlying problem is fixed.
 
-    set ::tcltest::testConstraints(pcCrash) \
-	    [expr {!$::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macCrash) \
-	    [expr {!$::tcltest::testConstraints(mac)}]
-    set ::tcltest::testConstraints(unixCrash) \
-	    [expr {!$::tcltest::testConstraints(unix)}]
+    tcltest::testConstraint pcCrash \
+	    [expr {![tcltest::testConstraint pc]}]
+    tcltest::testConstraint winCrash \
+	    [expr {![tcltest::testConstraint win]}]
+    tcltest::testConstraint macCrash \
+	    [expr {![tcltest::testConstraint mac]}]
+    tcltest::testConstraint unixCrash \
+	    [expr {![tcltest::testConstraint unix]}]
 
     # Skip empty tests
 
-    set ::tcltest::testConstraints(emptyTest) 0
+    tcltest::testConstraint emptyTest 0
 
     # By default, tests that expose known bugs are skipped.
 
-    set ::tcltest::testConstraints(knownBug) 0
+    tcltest::testConstraint knownBug 0
 
     # By default, non-portable tests are skipped.
 
-    set ::tcltest::testConstraints(nonPortable) 0
+    tcltest::testConstraint nonPortable 0
 
     # Some tests require user interaction.
 
-    set ::tcltest::testConstraints(userInteraction) 0
+    tcltest::testConstraint userInteraction 0
 
     # Some tests must be skipped if the interpreter is not in interactive mode
     
     if {[info exists tcl_interactive]} {
-	set ::tcltest::testConstraints(interactive) $::tcl_interactive
+	tcltest::testConstraint interactive $::tcl_interactive
     } else {
-	set ::tcltest::testConstraints(interactive) 0
+	tcltest::testConstraint interactive 0
     }
 
     # Some tests can only be run if the installation came from a CD image
@@ -539,8 +1396,8 @@ proc ::tcltest::initConstraints {} {
     # Some tests must be skipped if you are running as root on Unix.
     # Other tests can only be run if you are running as root on Unix.
 
-    set ::tcltest::testConstraints(root) 0
-    set ::tcltest::testConstraints(notRoot) 1
+    tcltest::testConstraint root 0
+    tcltest::testConstraint notRoot 1
     set user {}
     if {[string equal $tcl_platform(platform) "unix"]} {
 	catch {set user [exec whoami]}
@@ -548,21 +1405,21 @@ proc ::tcltest::initConstraints {} {
 	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
 	}
 	if {([string equal $user "root"]) || ([string equal $user ""])} {
-	    set ::tcltest::testConstraints(root) 1
-	    set ::tcltest::testConstraints(notRoot) 0
+	    tcltest::testConstraint root 1
+	    tcltest::testConstraint notRoot 0
 	}
     }
 
     # Set nonBlockFiles constraint: 1 means this platform supports
-    # setting files into nonblocking mode.
+    # ting files into nonblocking mode.
 
     if {[catch {set f [open defs r]}]} {
-	set ::tcltest::testConstraints(nonBlockFiles) 1
+	tcltest::testConstraint nonBlockFiles 1
     } else {
 	if {[catch {fconfigure $f -blocking off}] == 0} {
-	    set ::tcltest::testConstraints(nonBlockFiles) 1
+	    tcltest::testConstraint nonBlockFiles 1
 	} else {
-	    set ::tcltest::testConstraints(nonBlockFiles) 0
+	    tcltest::testConstraint nonBlockFiles 0
 	}
 	close $f
     }
@@ -576,75 +1433,75 @@ proc ::tcltest::initConstraints {} {
 
     if {[string equal $tcl_platform(platform) "unix"]} {
 	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
-	    set ::tcltest::testConstraints(asyncPipeClose) 0
+	    tcltest::testConstraint asyncPipeClose 0
 	} else {
-	    set ::tcltest::testConstraints(asyncPipeClose) 1
+	    tcltest::testConstraint asyncPipeClose 1
 	}
     } else {
-	set ::tcltest::testConstraints(asyncPipeClose) 1
+	tcltest::testConstraint asyncPipeClose 1
     }
 
     # Test to see if we have a broken version of sprintf with respect
     # to the "e" format of floating-point numbers.
 
-    set ::tcltest::testConstraints(eformat) 1
+    tcltest::testConstraint eformat 1
     if {![string equal "[format %g 5e-5]" "5e-05"]} {
-	set ::tcltest::testConstraints(eformat) 0
+	tcltest::testConstraint eformat 0
     }
 
     # Test to see if execed commands such as cat, echo, rm and so forth are
     # present on this machine.
 
-    set ::tcltest::testConstraints(unixExecs) 1
+    tcltest::testConstraint unixExecs 1
     if {[string equal $tcl_platform(platform) "macintosh"]} {
-	set ::tcltest::testConstraints(unixExecs) 0
+	tcltest::testConstraint unixExecs 0
     }
-    if {($::tcltest::testConstraints(unixExecs) == 1) && \
+    if {([tcltest::testConstraint unixExecs] == 1) && \
 	    ([string equal $tcl_platform(platform) "windows"])} {
 	if {[catch {exec cat defs}] == 1} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec echo hello}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec sh -c echo hello}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec wc defs}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {$::tcltest::testConstraints(unixExecs) == 1} {
+	if {[tcltest::testConstraint unixExecs] == 1} {
 	    exec echo hello > removeMe
 	    if {[catch {exec rm removeMe}] == 1} {
-		set ::tcltest::testConstraints(unixExecs) 0
+		tcltest::testConstraint unixExecs 0
 	    }
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec sleep 1}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec fgrep unixExecs defs}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec ps}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec echo abc > removeMe}] == 0) && \
 		([catch {exec chmod 644 removeMe}] == 1) && \
 		([catch {exec rm removeMe}] == 0)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	} else {
 	    catch {exec rm -f removeMe}
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec mkdir removeMe}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	} else {
 	    catch {exec rm -r removeMe}
 	}
@@ -653,14 +1510,14 @@ proc ::tcltest::initConstraints {} {
     # Locate tcltest executable
 
     if {![info exists tk_version]} {
-	set tcltest [info nameofexecutable]
+	set tcltest::tcltest [info nameofexecutable]
 
-	if {$tcltest == "{}"} {
-	    set tcltest {}
+	if {$tcltest::tcltest == "{}"} {
+	    set tcltest::tcltest {}
 	}
     }
 
-    set ::tcltest::testConstraints(stdio) 0
+    tcltest::testConstraint stdio 0
     catch {
 	catch {file delete -force tmp}
 	set f [open tmp w]
@@ -672,7 +1529,7 @@ proc ::tcltest::initConstraints {} {
 	set f [open "|[list $tcltest tmp]" r]
 	close $f
 	
-	set ::tcltest::testConstraints(stdio) 1
+	tcltest::testConstraint stdio 1
     }
     catch {file delete -force tmp}
 
@@ -681,50 +1538,62 @@ proc ::tcltest::initConstraints {} {
     # system. 
 
     catch {socket} msg
-    set ::tcltest::testConstraints(socket) \
+    tcltest::testConstraint socket \
 	    [expr {$msg != "sockets are not available on this system"}]
     
     # Check for internationalization
 
     if {[info commands testlocale] == ""} {
 	# No testlocale command, no tests...
-	set ::tcltest::testConstraints(hasIsoLocale) 0
+	tcltest::testConstraint hasIsoLocale 0
     } else {
-	set ::tcltest::testConstraints(hasIsoLocale) \
-		[string length [::tcltest::set_iso8859_1_locale]]
-	::tcltest::restore_locale
+	tcltest::testConstraint hasIsoLocale \
+		[string length [tcltest::set_iso8859_1_locale]]
+	tcltest::restore_locale
     }
 }   
 
-# ::tcltest::PrintUsageInfoHook
+#####################################################################
+
+# Handle command line arguments (from argv) and default arg settings 
+# (in TCLTEST_OPTIONS).
+
+# tcltest::PrintUsageInfoHook
 #
 #       Hook used for customization of display of usage information.
 #
 
-if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
-    proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope tcltest info procs PrintUsageInfoHook] == {}} {
+    proc tcltest::PrintUsageInfoHook {} {}
 }
 
-# ::tcltest::PrintUsageInfo
+# tcltest::PrintUsageInfo
 #
 #	Prints out the usage information for package tcltest.  This can be
-#       customized with the redefinition of ::tcltest::PrintUsageInfoHook.
+#       customized with the redefinition of tcltest::PrintUsageInfoHook.
 #
 # Arguments:
 #	none
 #
+# Results:
+#       none
+#
+# Side Effects: 
+#       none
 
-proc ::tcltest::PrintUsageInfo {} {
+proc tcltest::PrintUsageInfo {} {
     puts [format "Usage: [file tail [info nameofexecutable]] \
 	    script ?-help? ?flag value? ... \n\
 	    Available flags (and valid input values) are: \n\
 	    -help          \t Display this usage information. \n\
 	    -verbose level \t Takes any combination of the values \n\
-	    \t                 'p', 's' and 'b'.  Test suite will \n\
+	    \t                 'p', 's', 'b', 't' and 'e'.  Test suite will \n\
 	    \t                 display all passed tests if 'p' is \n\
 	    \t                 specified, all skipped tests if 's' \n\
-	    \t                 is specified, and the bodies of \n\
-	    \t                 failed tests if 'b' is specified. \n\
+	    \t                 is specified, the bodies of \n\
+	    \t                 failed tests if 'b' is specified, \n\
+	    \t                 and when tests start if 't' is specified. \n\
+	    \t                 ErrorInfo is displayed if 'e' is specified. \n\
 	    \t                 The default value is 'b'. \n\
 	    -constraints list\t Do not skip the listed constraints\n\
 	    -limitconstraints bool\t Only run tests with the constraints\n\
@@ -740,17 +1609,21 @@ proc ::tcltest::PrintUsageInfo {} {
 	    \t                 match the glob pattern given. \n\
 	    -notfile pattern\t Skip all test files that match the \n\
 	    \t                 glob pattern given. \n\
+	    -relateddir pattern\t Run tests in directories that match \n\
+	    \t                 the glob pattern given. \n\
+	    -asidefromdir pattern\t Skip tests in directories that match \n\
+	    \t                 the glob pattern given.\n\
 	    -preservecore level \t If 2, save any core files produced \n\
 	    \t                 during testing in the directory \n\
 	    \t                 specified by -tmpdir. If 1, notify the\n\
 	    \t                 user if core files are created. The default \n\
-	    \t                 is $::tcltest::preserveCore. \n\
+	    \t                 is $tcltest::preserveCore. \n\
 	    -tmpdir directory\t Save temporary files in the specified\n\
 	    \t                 directory.  The default value is \n\
-	    \t                 $::tcltest::temporaryDirectory. \n\
+	    \t                 $tcltest::temporaryDirectory. \n\
 	    -testdir directories\t Search tests in the specified\n\
 	    \t                 directories.  The default value is \n\
-	    \t                 $::tcltest::testsDirectory. \n\
+	    \t                 $tcltest::testsDirectory. \n\
 	    -outfile file    \t Send output from test runs to the \n\
 	    \t                 specified file.  The default is \n\
 	    \t                 stdout. \n\
@@ -762,207 +1635,98 @@ proc ::tcltest::PrintUsageInfo {} {
 	    -load script     \t Specifies the script to load the tested \n\
 	    \t                 commands. \n\
 	    -debug level     \t Internal debug flag."]
-    ::tcltest::PrintUsageInfoHook
+    tcltest::PrintUsageInfoHook
     return
 }
 
-# ::tcltest::CheckDirectory --
-#
-#     This procedure checks whether the specified path is a readable
-#     and/or writable directory. If one of the conditions is not
-#     satisfied an error is printed and the application aborted. The
-#     procedure assumes that the caller already checked the existence
-#     of the path.
-#
-# Arguments
-#     rw      Information what attributes to check. Allowed values:
-#             r, w, rw, wr. If 'r' is part of the value the directory
-#             must be readable. 'w' associates to 'writable'.
-#     dir     The directory to check.
-#     errMsg  The string to prepend to the actual error message before
-#             printing it.
-#
-# Results
-#     none
-#
-
-proc ::tcltest::CheckDirectory {rw dir errMsg} {
-    # Allowed values for 'rw': r, w, rw, wr
-
-    if {![file isdir $dir]} { 
-	::tcltest::PrintError "$errMsg \"$dir\" is not a directory"
-	exit 1
-    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
-	::tcltest::PrintError "$errMsg \"$dir\" is not writeable"
-	exit 1
-    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
-	::tcltest::PrintError "$errMsg \"$dir\" is not readable"
-	exit 1
-    }
-}
-
-# ::tcltest::normalizePath --
-#
-#     This procedure resolves any symlinks in the path thus creating a
-#     path without internal redirection. It assumes that the incoming
-#     path is absolute.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#
-# Results
-#     The path is modified in place.
-#
-
-proc ::tcltest::normalizePath {pathVar} {
-    upvar $pathVar path
-
-    set oldpwd [pwd]
-    catch {cd $path}
-    set path [pwd]
-    cd $oldpwd
-}
-
-# ::tcltest::MakeAbsolutePath --
-#
-#     This procedure checks whether the incoming path is absolute or not.
-#     Makes it absolute if it was not.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#     prefix  is optional, contains the path to use to make the other an
-#             absolute one. The current working directory is used if it was
-#             not specified.
-#
-# Results
-#     The path is modified in place.
-#
-
-proc ::tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
-    upvar $pathVar path
-
-    if {![string equal [file pathtype $path] "absolute"]} { 
-	if {$prefix == {}} {
-	    set prefix [pwd]
-	}
-
-	set path [file join $prefix $path] 
-    }
-}
-
-# ::tcltest::processCmdLineArgsFlagsHook --
+# tcltest::processCmdLineArgsFlagsHook --
 #
 #	This hook is used to add to the list of command line arguments that are
-#       processed by ::tcltest::processCmdLineArgs. 
+#       processed by tcltest::ProcessFlags.   It is called at the beginning of
+#       ProcessFlags.
 #
 
-if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
-    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc tcltest::processCmdLineArgsAddFlagsHook {} {}
 }
 
-# ::tcltest::processCmdLineArgsHook --
+# tcltest::processCmdLineArgsHook --
 #
 #	This hook is used to actually process the flags added by
-#       ::tcltest::processCmdLineArgsAddFlagsHook.
+#       tcltest::processCmdLineArgsAddFlagsHook.  It is called at the end of
+#       ProcessFlags. 
 #
 # Arguments:
 #	flags      The flags that have been pulled out of argv
 #
 
-if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
-    proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope tcltest info procs processCmdLineArgsHook] == {}} {
+    proc tcltest::processCmdLineArgsHook {flag} {}
 }
 
-# ::tcltest::processCmdLineArgs --
+# tcltest::ProcessFlags --
 #
-#	Use command line args to set the verbose, skip, and
-#	match, outputChannel, errorChannel, debug, and temporaryDirectory
-#       variables.   
-#
-#       This procedure must be run after constraints are initialized, because
-#       some constraints can be overridden.
+#	process command line arguments supplied in the flagArray - this is
+#       called by processCmdLineArgs
+#       modifies tcltest variables according to the content of the flagArray.
 #
 # Arguments:
-#	none
+#	flagArray - array containing name/value pairs of flags
 #
 # Results:
-#	Sets the above-named variables in the tcltest namespace.
-
-proc ::tcltest::processCmdLineArgs {} {
-    global argv
-
-    # The "argv" var doesn't exist in some cases, so use {}.
-
-    if {(![info exists argv]) || ([llength $argv] < 1)} {
-	set flagArray {}
-    } else {
-	set flagArray $argv
-    }
-    
-    # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
-    # Note that -verbose cannot be abbreviated to -v in wish because it
-    # conflicts with the wish option -visual.
+#	sets tcltest variables according to their values as defined by
+#       flagArray 
+#
+# Side effects:
+#	None.
 
+proc tcltest::ProcessFlags {flagArray} {
     # Process -help first
-    if {([lsearch -exact $flagArray {-help}] != -1) || \
-	    ([lsearch -exact $flagArray {-h}] != -1)} {
-	::tcltest::PrintUsageInfo
-	exit 1
-    }
-
-    if {[catch {array set flag $flagArray}]} {
-	::tcltest::PrintError "odd number of arguments specified on command line: \ 
-	$argv"
-	::tcltest::PrintUsageInfo
+    if {[lsearch -exact $flagArray {-help}] != -1} {
+	tcltest::PrintUsageInfo
 	exit 1
     }
+    
+    catch {array set flag $flagArray}
 
     # -help is not listed since it has already been processed
     lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints -args -testdir \
-	    -load -loadfile
+	    -preservecore -limitconstraints -testdir \
+	    -load -loadfile -asidefromdir \
+	    -relateddir -singleproc
     set defaultFlags [concat $defaultFlags \
-	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]
-
-    foreach arg $defaultFlags {
-	set abbrev [string range $arg 0 1]
-	if {([info exists flag($abbrev)]) && \
-		([lsearch -exact $flagArray $arg] < [lsearch -exact \
-		$flagArray $abbrev])} { 
-	    set flag($arg) $flag($abbrev)
-	}
-    }
-
-    # Set ::tcltest::parameters to the arg of the -args flag, if given
-    if {[info exists flag(-args)]} {
-	set ::tcltest::parameters $flag(-args)
-    }
-
-    # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+	    [tcltest::processCmdLineArgsAddFlagsHook ]]
 
+    # Set tcltest::verbose to the arg of the -verbose flag, if given
     if {[info exists flag(-verbose)]} {
-	set ::tcltest::verbose $flag(-verbose)
+	tcltest::verbose $flag(-verbose)
     }
 
-    # Set ::tcltest::match to the arg of the -match flag, if given.  
-
+    # Set tcltest::match to the arg of the -match flag, if given.  
     if {[info exists flag(-match)]} {
-	set ::tcltest::match $flag(-match)
+	tcltest::match $flag(-match)
     } 
 
-    # Set ::tcltest::skip to the arg of the -skip flag, if given
-
+    # Set tcltest::skip to the arg of the -skip flag, if given
     if {[info exists flag(-skip)]} {
-	set ::tcltest::skip $flag(-skip)
+	tcltest::skip $flag(-skip)
     }
 
     # Handle the -file and -notfile flags
     if {[info exists flag(-file)]} {
-	set ::tcltest::matchFiles $flag(-file)
+	tcltest::matchFiles $flag(-file)
     }
     if {[info exists flag(-notfile)]} {
-	set ::tcltest::skipFiles $flag(-notfile)
+	tcltest::skipFiles $flag(-notfile)
+    }
+
+    # Handle -relateddir and -asidefromdir flags
+    if {[info exists flag(-relateddir)]} {
+	tcltest::matchDirectories $flag(-relateddir)
+    }
+    if {[info exists flag(-asidefromdir)]} {
+	tcltest::skipDirectories $flag(-asidefromdir)
     }
 
     # Use the -constraints flag, if given, to turn on constraints that are
@@ -971,7 +1735,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-constraints)]} {
 	foreach elt $flag(-constraints) {
-	    set ::tcltest::testConstraints($elt) 1
+	    tcltest::testConstraint $elt 1
 	}
     }
 
@@ -980,87 +1744,35 @@ proc ::tcltest::processCmdLineArgs {} {
     # the -constraints flag was not specified, print out an error and exit.
     if {[info exists flag(-limitconstraints)]} {
 	if {![info exists flag(-constraints)]} {
-	    puts "You can only use the -limitconstraints flag with \
-		    -constraints"
-	    exit 1
-	}
-	set ::tcltest::limitConstraints $flag(-limitconstraints)
-	foreach elt [array names ::tcltest::testConstraints] {
-	    if {[lsearch -exact $flag(-constraints) $elt] == -1} {
-		set ::tcltest::testConstraints($elt) 0
-	    }
+	    set msg "-limitconstraints flag can only be used with -constraints"
+	    error $msg
 	}
+	tcltest::limitConstraints $flag(-limitconstraints)
     }
 
-    # Set the ::tcltest::temporaryDirectory to the arg of -tmpdir, if
+    # Set the tcltest::temporaryDirectory to the arg of -tmpdir, if
     # given.
-    # 
-    # If the path is relative, make it absolute.  If the file exists but
-    # is not a dir, then return an error.
-    #
-    # If ::tcltest::temporaryDirectory does not already exist, create it.
-    # If you cannot create it, then return an error.
 
-    set tmpDirError ""
     if {[info exists flag(-tmpdir)]} {
-	set ::tcltest::temporaryDirectory $flag(-tmpdir)
-	
-	MakeAbsolutePath ::tcltest::temporaryDirectory
-	set tmpDirError "bad argument \"$flag(-tmpdir)\" to -tmpdir: "
-    }
-    if {[file exists $::tcltest::temporaryDirectory]} {
-	::tcltest::CheckDirectory rw $::tcltest::temporaryDirectory $tmpDirError
-    } else {
-	file mkdir $::tcltest::temporaryDirectory
+	tcltest::temporaryDirectory $flag(-tmpdir)
     }
 
-    normalizePath ::tcltest::temporaryDirectory
-
-    # Set the ::tcltest::testsDirectory to the arg of -testdir, if
+    # Set the tcltest::testsDirectory to the arg of -testdir, if
     # given.
-    # 
-    # If the path is relative, make it absolute.  If the file exists but
-    # is not a dir, then return an error.
-    #
-    # If ::tcltest::temporaryDirectory does not already exist return an error.
     
-    set testDirError ""
     if {[info exists flag(-testdir)]} {
-	set ::tcltest::testsDirectory $flag(-testdir)
-	
-	MakeAbsolutePath ::tcltest::testsDirectory
-	set testDirError "bad argument \"$flag(-testdir)\" to -testdir: "
-    }
-    if {[file exists $::tcltest::testsDirectory]} {
-	::tcltest::CheckDirectory r $::tcltest::testsDirectory $testDirError
-    } else {
-	::tcltest::PrintError "$testDirError \"$::tcltest::testsDirectory\" \
-		does not exist"
-	exit 1
-    }
-    
-    normalizePath ::tcltest::testsDirectory
-    
-    # Save the names of files that already exist in
-    # the output directory.
-    foreach file [glob -nocomplain \
-	    [file join $::tcltest::temporaryDirectory *]] {
-	lappend ::tcltest::filesExisted [file tail $file]
+	tcltest::testsDirectory $flag(-testdir)
     }
 
     # If an alternate error or output files are specified, change the
     # default channels.
 
     if {[info exists flag(-outfile)]} {
-	set tmp $flag(-outfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set ::tcltest::outputChannel [open $tmp w]
+	tcltest::outputFile $flag(-outfile)
     } 
 
     if {[info exists flag(-errfile)]} {
-	set tmp $flag(-errfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set ::tcltest::errorChannel [open $tmp w]
+	tcltest::errorFile $flag(-errfile)
     }
 
     # If a load script was specified, either directly or through
@@ -1068,294 +1780,647 @@ proc ::tcltest::processCmdLineArgs {} {
     
     if {[info exists flag(-load)] &&  \
 	    ([lsearch -exact $flagArray -load] > \
-	    [lsearch -exact $flagArray -loadfile])} {
-	    set ::tcltest::loadScript $flag(-load)
+		[lsearch -exact $flagArray -loadfile])} {
+	tcltest::loadScript $flag(-load)
     }
     
     if {[info exists flag(-loadfile)] && \
 	    ([lsearch -exact $flagArray -loadfile] > \
-	    [lsearch -exact $flagArray -load]) } {
-	set tmp $flag(-loadfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set tmp [open $tmp r]
-	set ::tcltest::loadScript [read $tmp]
-	close $tmp
+		[lsearch -exact $flagArray -load]) } {
+	tcltest::loadFile $flag(-loadfile)
     }
 
     # If the user specifies debug testing, print out extra information during
     # the run.
     if {[info exists flag(-debug)]} {
-	set ::tcltest::debug $flag(-debug)
+	tcltest::debug $flag(-debug)
     }
 
     # Handle -preservecore
     if {[info exists flag(-preservecore)]} {
-	set ::tcltest::preserveCore $flag(-preservecore)
+	tcltest::preserveCore $flag(-preservecore)
+    }
+
+    # Handle -singleproc flag
+    if {[info exists flag(-singleproc)]} {
+	tcltest::singleProcess $flag(-singleproc)
     }
 
     # Call the hook
-    ::tcltest::processCmdLineArgsHook [array get flag]
+    tcltest::processCmdLineArgsHook [array get flag]
+    return
+}
 
-    # Spit out everything you know if we're at a debug level 2 or greater
+# tcltest::processCmdLineArgs --
+#
+#	Use command line args to set tcltest namespace variables.
+#
+#       This procedure must be run after constraints are initialized, because
+#       some constraints can be overridden.
+# 
+#       Set variables based on the contents of the environment variable
+#       TCLTEST_OPTIONS first, then override with command-line options, if
+#       specified. 
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Sets the above-named variables in the tcltest namespace.
+# 
+# Side Effects:
+#       None.
+#
+
+proc tcltest::processCmdLineArgs {} {
+    global argv
+
+    # If the TCLTEST_OPTIONS environment variable exists, parse it first, then
+    # the argv list.  The command line argument parsing will be a two-pass
+    # affair from now on, so that TCLTEST_OPTIONS contain the default options.
+    # These can be overridden by the command line flags.
+
+    if {[info exists ::env(TCLTEST_OPTIONS)]} {
+	tcltest::ProcessFlags $::env(TCLTEST_OPTIONS)
+    } 
+
+    # The "argv" var doesn't exist in some cases, so use {}.
+    if {(![info exists argv]) || ([llength $argv] < 1)} {
+	set flagArray {}
+    } else {
+	set flagArray $argv
+    }
+    
+    tcltest::ProcessFlags $flagArray
 
-    DebugPuts    2 "Flags passed into tcltest:"
-    DebugPArray  2 flag
-    DebugPuts    2 "::tcltest::debug              = $::tcltest::debug"
-    DebugPuts    2 "::tcltest::testsDirectory     = $::tcltest::testsDirectory"
-    DebugPuts    2 "::tcltest::workingDirectory   = $::tcltest::workingDirectory"
-    DebugPuts    2 "::tcltest::temporaryDirectory = $::tcltest::temporaryDirectory"
-    DebugPuts    2 "::tcltest::outputChannel      = $::tcltest::outputChannel"
-    DebugPuts    2 "::tcltest::errorChannel       = $::tcltest::errorChannel"
-    DebugPuts    2 "Original environment (::tcltest::originalEnv):"
-    DebugPArray  2 ::tcltest::originalEnv
+    # Spit out everything you know if we're at a debug level 2 or greater
+    DebugPuts 2 "Flags passed into tcltest:"
+    if {[info exists ::env(TCLTEST_OPTIONS)]} {
+	DebugPuts 2 "    ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
+    }
+    if {[info exists argv]} {
+	DebugPuts 2 "    argv: $argv"
+    }
+    DebugPuts    2 "tcltest::debug              = [tcltest::debug]"
+    DebugPuts    2 "tcltest::testsDirectory     = [tcltest::testsDirectory]"
+    DebugPuts    2 "tcltest::workingDirectory   = [tcltest::workingDirectory]"
+    DebugPuts    2 "tcltest::temporaryDirectory = [tcltest::temporaryDirectory]"
+    DebugPuts    2 "tcltest::outputChannel      = [outputChannel]"
+    DebugPuts    2 "tcltest::errorChannel       = [errorChannel]"
+    DebugPuts    2 "Original environment (tcltest::originalEnv):"
+    DebugPArray  2 tcltest::originalEnv
     DebugPuts    2 "Constraints:"
-    DebugPArray  2 ::tcltest::testConstraints
+    DebugPArray  2 tcltest::testConstraints
+    return
 }
 
-# ::tcltest::loadTestedCommands --
+#####################################################################
+
+# Code to run the tests goes here.
+
+# tcltest::testPuts --
 #
-#     Uses the specified script to load the commands to test. Allowed to
-#     be empty, as the tested commands could have been compiled into the
-#     interpreter.
+#	Used to redefine puts in test environment.
+#       Stores whatever goes out on stdout in tcltest::outData and stderr in 
+#       tcltest::errData before sending it on to the regular puts.
 #
-# Arguments
-#     none
+# Arguments:
+#	same as standard puts
 #
-# Results
-#     none
+# Results:
+#	none
+#
+# Side effects:
+#       Intercepts puts; data that would otherwise go to stdout, stderr, or
+#       file channels specified in tcltest::outputChannel and errorChannel does
+#       not get sent to the normal puts function.
+
+proc tcltest::testPuts {args} {
+    set len [llength $args]
+    if {$len == 1} {
+	# Only the string to be printed is specified
+	append tcltest::outData "[lindex $args 0]\n"
+	return
+#	return [tcltest::normalPuts [lindex $args 0]]
+    } elseif {$len == 2} {
+	# Either -nonewline or channelId has been specified
+	if {[regexp {^-nonewline} [lindex $args 0]]} {
+	    append tcltest::outData "[lindex $args end]"
+	    return
+#	    return [tcltest::normalPuts -nonewline [lindex $args end]]
+	} else {
+	    set channel [lindex $args 0]
+	}
+    } elseif {$len == 3} {
+	if {[lindex $args 0] == "-nonewline"} {
+	    # Both -nonewline and channelId are specified, unless it's an
+	    # error.  -nonewline is supposed to be argv[0].
+	    set channel [lindex $args 1]
+	}
+    }
 
-proc ::tcltest::loadTestedCommands {} {
-    if {$::tcltest::loadScript == {}} {
+    if {[info exists channel]} {
+	if {($channel == [outputChannel]) || ($channel == "stdout")} {
+	    append tcltest::outData "[lindex $args end]\n"
+	} elseif {($channel == [errorChannel]) || ($channel == "stderr")} {
+	    append tcltest::errData "[lindex $args end]\n"
+	}
 	return
+	# return [tcltest::normalPuts [lindex $args 0] [lindex $args end]]
     }
-    
-    uplevel #0 $::tcltest::loadScript
+
+    # If we haven't returned by now, we don't know how to handle the input.
+    # Let puts handle it.
+    return [eval tcltest::normalPuts $args]
 }
 
-# ::tcltest::cleanupTests --
+# tcltest::testEval --
 #
-# Remove files and dirs created using the makeFile and makeDirectory
-# commands since the last time this proc was invoked.
+#	Evaluate the script in the test environment.  If ignoreOutput is 
+#       false, store data sent to stderr and stdout in tcltest::outData and 
+#       tcltest::errData.  Otherwise, ignore this output altogether.
 #
-# Print the names of the files created without the makeFile command
-# since the tests were invoked.
+# Arguments:
+#	script             Script to evaluate
+#       ?ignoreOutput?     Indicates whether or not to ignore output sent to
+#                          stdout & stderr
 #
-# Print the number tests (total, passed, failed, and skipped) since the
-# tests were invoked.
-# 
-# Restore original environment (as reported by special variable env).
-
-proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
-
-    set testFileName [file tail [info script]]
+# Results:
+#	result from running the script
+#
+# Side effects:
+#	Empties the contents of tcltest::outData and tcltest::errData before
+#       running a test if ignoreOutput is set to 0. 
 
-    # Call the cleanup hook
-    ::tcltest::cleanupTestsHook 
+proc tcltest::testEval {script {ignoreOutput 1}} {
+    DebugPuts 3 "testEval called" 
+    if {!$ignoreOutput} {
+	set tcltest::outData {}
+	set tcltest::errData {}
+	uplevel rename ::puts tcltest::normalPuts
+	uplevel rename tcltest::testPuts ::puts
+    }
+    set result [uplevel $script]
+    if {!$ignoreOutput} {
+	uplevel rename ::puts tcltest::testPuts
+	uplevel rename tcltest::normalPuts ::puts
+    }
+    return $result
+}
 
-    # Remove files and directories created by the :tcltest::makeFile and
-    # ::tcltest::makeDirectory procedures.
-    # Record the names of files in ::tcltest::workingDirectory that were not
-    # pre-existing, and associate them with the test file that created them.
+# compareStrings --
+#
+#	compares the expected answer to the actual answer, depending on the
+#       mode provided.  Mode determines whether a regexp, exact, or glob
+#       comparison is done.
+#
+# Arguments:
+#	actual - string containing the actual result
+#       expected - pattern to be matched against
+#       mode - type of comparison to be done
+#
+# Results:
+#	result of the match
+#
+# Side effects:
+#	None.
 
-    if {!$calledFromAllFile} {
-	foreach file $::tcltest::filesMade {
-	    if {[file exists $file]} {
-		catch {file delete -force $file}
-	    }
+proc tcltest::compareStrings {actual expected mode} {
+    switch -- $mode {
+	exact {
+	    set retval [string equal $actual $expected]
 	}
-	set currentFiles {}
-	foreach file [glob -nocomplain \
-		[file join $::tcltest::temporaryDirectory *]] {
-	    lappend currentFiles [file tail $file]
+	glob {
+	    set retval [string match $expected $actual]
 	}
-	set newFiles {}
-	foreach file $currentFiles {
-	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
-		lappend newFiles $file
-	    }
-	}
-	set ::tcltest::filesExisted $currentFiles
-	if {[llength $newFiles] > 0} {
-	    set ::tcltest::createdNewFiles($testFileName) $newFiles
+	regexp {
+	    set retval [regexp -- $expected $actual]
 	}
     }
+    return $retval
+}
 
-    if {$calledFromAllFile || $::tcltest::testSingleFile} {
 
-	# print stats
+#
+# tcltest::substArguments list
+#
+# This helper function takes in a list of words, then perform a
+# substitution on the list as though each word in the list is a
+# separate argument to the Tcl function.  For example, if this
+# function is invoked as:
+#
+#      substArguments {$a {$a}}
+#
+# Then it is as though the function is invoked as:
+#
+#      substArguments $a {$a}
+#
+# This code is adapted from Paul Duffin's function "SplitIntoWords".
+# The original function can be found  on:
+#
+#      http://purl.org/thecliff/tcl/wiki/858.html
+#
+# Results:
+#     a list containing the result of the substitution
+#
+# Exceptions:
+#     An error may occur if the list containing unbalanced quote or
+#     unknown variable.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::substArguments {argList} {
+
+    # We need to split the argList up into tokens but cannot use
+    # list operations as they throw away some significant
+    # quoting, and [split] ignores braces as it should.
+    # Therefore what we do is gradually build up a string out of
+    # whitespace seperated strings. We cannot use [split] to
+    # split the argList into whitespace seperated strings as it
+    # throws away the whitespace which maybe important so we
+    # have to do it all by hand.
+
+    set result {}
+    set token ""
+
+    while {[string length $argList]} {
+        # Look for the next word containing a quote: " { }
+        if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \
+                $argList all]} {
+            # Get the text leading up to this word, but not
+            # including this word, from the argList.
+            set text [string range $argList 0 \
+                    [expr {[lindex $all 0] - 1}]]
+            # Get the word with the quote
+            set word [string range $argList \
+                    [lindex $all 0] [lindex $all 1]]
+
+            # Remove all text up to and including the word from the
+            # argList.
+            set argList [string range $argList \
+                    [expr {[lindex $all 1] + 1}] end]
+        } else {
+            # Take everything up to the end of the argList.
+            set text $argList
+            set word {}
+            set argList {}
+        }
+        
+        if {$token != {}} {
+            # If we saw a word with quote before, then there is a
+            # multi-word token starting with that word.  In this case,
+            # add the text and the current word to this token.
+            append token $text $word
+        } else {
+            # Add the text to the result.  There is no need to parse
+            # the text because it couldn't be a part of any multi-word
+            # token.  Then start a new multi-word token with the word
+            # because we need to pass this token to the Tcl parser to
+            # check for balancing quotes
+            append result $text
+            set token $word
+        }
+        
+        if { [catch {llength $token} length] == 0 && $length == 1} {
+            # The token is a valid list so add it to the result.
+            # lappend result [string trim $token]
+            append result \{$token\}
+            set token {}
+        }
+    }
 
-	puts -nonewline $::tcltest::outputChannel "$testFileName:"
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    puts -nonewline $::tcltest::outputChannel \
-		    "\t$index\t$::tcltest::numTests($index)"
-	}
-	puts $::tcltest::outputChannel ""
+    # If the last token has not been added to the list then there
+    # is a problem.
+    if { [string length $token] } {
+        error "incomplete token \"$token\""
+    }
 
-	# print number test files sourced
-	# print names of files that ran tests which failed
+    return $result
+}
 
-	if {$calledFromAllFile} {
-	    puts $::tcltest::outputChannel \
-		    "Sourced $::tcltest::numTestFiles Test Files."
-	    set ::tcltest::numTestFiles 0
-	    if {[llength $::tcltest::failFiles] > 0} {
-		puts $::tcltest::outputChannel \
-			"Files with failing tests: $::tcltest::failFiles"
-		set ::tcltest::failFiles {}
-	    }
-	}
 
-	# if any tests were skipped, print the constraints that kept them
-	# from running.
+# tcltest::test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If tcltest::verbose has been set, it also prints a message even if the
+# test succeeds.  The test will be skipped if it doesn't match the
+# tcltest::match variable, if it matches an element in
+# tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+# 
+# If testLevel is 1, then this is a top level test, and we record pass/fail
+# information; otherwise, this information is not logged and is not added to
+# running totals.
+# 
+# Attributes:
+#   Only description is a required attribute.  All others are optional.
+#   Default values are indicated.
+# 
+#   constraints -		A list of one or more keywords, each of
+#			        which must be the name of an element in
+#			        the array "tcltest::testConstraints".  If any
+#                               of these elements is zero, the test is
+#                               skipped. This attribute is optional; default is {}
+#   body -		        Script to run to carry out the test.  It must
+#			        return a result that can be checked for
+#			        correctness.  This attribute is optional;
+#                               default is {}
+#   result -	                Expected result from script.  This attribute is
+#                               optional; default is {}.
+#   output -                    Expected output sent to stdout.  This attribute
+#                               is optional; default is {}.  
+#   errorOutput -               Expected output sent to stderr.  This attribute
+#                               is optional; default is {}.  
+#   returnCodes -              Expected return codes.  This attribute is
+#                               optional; default is {0 2}.
+#   setup -                     Code to run before $script (above).  This
+#                               attribute is optional; default is {}.
+#   cleanup -                   Code to run after $script (above).  This
+#                               attribute is optional; default is {}.
+#   match -                     specifies type of matching to do on result,
+#                               output, errorOutput; this must be one of: exact,
+#                               glob, regexp.  default is exact.
+#
+# Arguments:
+#   name -		Name of test, in the form foo-1.2.
+#   description -	Short textual description of the test, to
+#  		  	help humans understand what it does.
+# 
+# Results:
+#	0 if the command ran successfully; 1 otherwise.
+#
+# Side effects:
+#       None.
+# 
 
-	set constraintList [array names ::tcltest::skippedBecause]
-	if {[llength $constraintList] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "Number of tests skipped for each constraint:"
-	    foreach constraint [lsort $constraintList] {
-		puts $::tcltest::outputChannel \
-			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
-		unset ::tcltest::skippedBecause($constraint)
-	    }
-	}
+proc tcltest::test {name description args} {
+    DebugPuts 3 "Test $name $args"
 
-	# report the names of test files in ::tcltest::createdNewFiles, and
-	# reset the array to be empty.
+    incr tcltest::testLevel
 
-	set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
-	if {[llength $testFilesThatTurded] > 0} {
-	    puts $::tcltest::outputChannel "Warning: files left behind:"
-	    foreach testFile $testFilesThatTurded {
-		puts $::tcltest::outputChannel \
-			"\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
-		unset ::tcltest::createdNewFiles($testFile)
+    # Pre-define everything to null except output and errorOutput.  We
+    # determine whether or not to trap output based on whether or not these
+    # variables (output & errorOutput) are defined.
+    foreach item {constraints setup cleanup body result returnCodes match} {
+	set $item {}
+    }
+
+    # Set the default match mode
+    set match exact
+
+    # Set the default match values for return codes (0 is the standard expected
+    # return value if everything went well; 2 represents 'return' being used in
+    # the test script).
+    set returnCodes [list 0 2]
+
+    # The old test format can't have a 3rd argument (constraints or script)
+    # that starts with '-'.
+    if {[llength $args] == 0} {
+	puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?options?\"}"
+	incr tcltest::testLevel -1
+	return 1
+    } elseif {([string index [lindex $args 0] 0] == "-") || ([llength $args] == 1)} {
+	
+	if {[llength $args] == 1} {
+	    set list [substArguments [lindex $args 0]]
+	    foreach {element value} $list { 
+		set testAttributes($element) $value
+	    }
+	    foreach item {constraints match setup body cleanup \
+		    result returnCodes output errorOutput} {
+		if {[info exists testAttributes([subst -$item])]} {
+		    set testAttributes([subst -$item]) \
+			    [uplevel concat $testAttributes([subst -$item])]
+		}
 	    }
+	} else {
+	    array set testAttributes $args
 	}
 
-	# reset filesMade, filesExisted, and numTests
+	set validFlags {-setup -cleanup -body -result -returnCodes -match \
+		-output -errorOutput -constraints}
 
-	set ::tcltest::filesMade {}
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    set ::tcltest::numTests($index) 0
+	foreach flag [array names testAttributes] {
+	    if {[lsearch -exact $validFlags $flag] == -1} {
+		puts [errorChannel] "test $name: bad flag $flag supplied to tcltest::test"
+		incr tcltest::testLevel -1
+		return 1
+	    }
 	}
 
-	# exit only if running Tk in non-interactive mode
-
-	global tk_version tcl_interactive
-	if {[info exists tk_version] && ![info exists tcl_interactive]} {
-	    exit
+	# store whatever the user gave us
+	foreach item [array names testAttributes] {
+	    set [string trimleft $item "-"] $testAttributes($item)
 	}
-    } 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
+	# Check the values supplied for -match
+	if {[lsearch {regexp glob exact} $match] == -1} {
+	    puts [errorChannel] "test $name: {bad value for -match: must be one of exact, glob, regexp}"
+	    incr tcltest::testLevel -1
+	    return 1
+	}
 
-	incr ::tcltest::numTestFiles
-	if {($::tcltest::currentFailure) && \
-		([lsearch -exact $::tcltest::failFiles $testFileName] == -1)} {
-	    lappend ::tcltest::failFiles $testFileName
+	# Replace symbolic valies supplied for -returnCodes
+	regsub -nocase normal $returnCodes 0 returnCodes
+	regsub -nocase error $returnCodes 1 returnCodes
+	regsub -nocase return $returnCodes 2 returnCodes
+	regsub -nocase break $returnCodes 3 returnCodes
+	regsub -nocase continue $returnCodes 4 returnCodes 
+    } else {
+	# This is parsing for the old test command format; it is here for
+	# backward compatibility.
+	set result [lindex $args end]
+	if {[llength $args] == 2} {
+	    set body [lindex $args 0]
+	} elseif {[llength $args] == 3} {
+	    set constraints [lindex $args 0]
+	    set body [lindex $args 1]
+	} else {
+	    puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?constraints? script expectedResult\"}"
+	    incr tcltest::testLevel -1
+	    return 1
 	}
-	set ::tcltest::currentFailure false
+    } 
 
-	# restore the environment to the state it was in before this package
-	# was loaded
+    set setupFailure 0
+    set cleanupFailure 0
 
-	set newEnv {}
-	set changedEnv {}
-	set removedEnv {}
-	foreach index [array names ::env] {
-	    if {![info exists ::tcltest::originalEnv($index)]} {
-		lappend newEnv $index
-		unset ::env($index)
-	    } else {
-		if {$::env($index) != $::tcltest::originalEnv($index)} {
-		    lappend changedEnv $index
-		    set ::env($index) $::tcltest::originalEnv($index)
-		}
-	    }
+    # Run the setup script
+    if {[catch {uplevel $setup} setupMsg]} {
+	set setupFailure 1
+    }
+
+    # run the test script
+    set command [list tcltest::runTest $name $description $body \
+	    $result $constraints]  
+    if {!$setupFailure} {
+	if {[info exists output] || [info exists errorOutput]} {
+	    set testResult [uplevel tcltest::testEval [list $command] 0]
+	} else {
+	    set testResult [uplevel tcltest::testEval [list $command] 1]
 	}
-	foreach index [array names ::tcltest::originalEnv] {
-	    if {![info exists ::env($index)]} {
-		lappend removedEnv $index
-		set ::env($index) $::tcltest::originalEnv($index)
+    } else {
+	set testResult setupFailure
+    }
+
+    # Run the cleanup code
+    if {[catch {uplevel $cleanup} cleanupMsg]} {
+	set cleanupFailure 1
+    }
+
+    # If testResult is an empty list, then the test was skipped
+    if {$testResult != {}} {
+	set coreFailure 0
+	set coreMsg ""
+	# check for a core file first - if one was created by the test, then
+	# the test failed
+	if {$tcltest::preserveCore} {
+	    set currentTclPlatform [array get tcl_platform]
+	    if {[file exists [file join [tcltest::workingDirectory] core]]} {
+		# There's only a test failure if there is a core file and (1)
+		# there previously wasn't one or (2) the new one is different
+		# from the old one. 
+		if {[info exists coreModTime]} {
+		    if {$coreModTime != [file mtime \
+			    [file join [tcltest::workingDirectory] core]]} {
+			set coreFailure 1
+		    } 
+		} else {
+		    set coreFailure 1
+		}
+		
+		if {($tcltest::preserveCore > 1) && ($coreFailure)} {
+		    append coreMsg "\nMoving file to: [file join $tcltest::temporaryDirectory core-$name]"
+		    catch {file rename -force \
+			    [file join [tcltest::workingDirectory] core] \
+			    [file join $tcltest::temporaryDirectory \
+				core-$name]} msg
+		    if {[string length $msg] > 0} {
+			append coreMsg "\nError: Problem renaming core file: $msg"
+		    }
+		}
 	    }
+	    array set tcl_platform $currentTclPlatform
 	}
-	if {[llength $newEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements created:\t$newEnv"
-	}
-	if {[llength $changedEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements changed:\t$changedEnv"
+
+	set actualAnswer [lindex $testResult 0]
+	set code [lindex $testResult end]
+
+	# If expected output/error strings exist, we have to compare
+	# them.  If the comparison fails, then so did the test.
+	set outputFailure 0
+	set errorFailure 0
+	if {[info exists output]} { 
+	    set outputFailure [expr ![compareStrings $tcltest::outData \
+		    $output $match]]
+	} 
+	if {[info exists errorOutput]} {
+	    set errorFailure [expr ![compareStrings $tcltest::errData \
+		    $errorOutput $match]]
 	}
-	if {[llength $removedEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements removed:\t$removedEnv"
+
+	set testFailed 1
+	set codeFailure 0
+	set scriptFailure 0
+
+	# check if the return code matched the expected return code
+	if {[lsearch -exact $returnCodes $code] == -1} {
+	    set codeFailure 1
+	} 
+
+	# check if the answer matched the expected answer
+	if {[compareStrings $actualAnswer $result $match] == 0} {
+	    set scriptFailure 1
 	}
 
-	set changedTclPlatform {}
-	foreach index [array names ::tcltest::originalTclPlatform] {
-	    if {$::tcl_platform($index) != \
-		    $::tcltest::originalTclPlatform($index)} { 
-		lappend changedTclPlatform $index
-		set ::tcl_platform($index) \
-			$::tcltest::originalTclPlatform($index) 
+	# if we didn't experience any failures, then we passed
+	if {!($setupFailure || $cleanupFailure || $coreFailure || \
+		$outputFailure || $errorFailure || $codeFailure || \
+		$scriptFailure)} {
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Passed)
+		if {[tcltest::isVerbose pass]} {
+		    puts [outputChannel] "++++ $name PASSED"
+		}
 	    }
+	    set testFailed 0
 	}
-	if {[llength $changedTclPlatform] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "tcl_platform array elements changed:\t$changedTclPlatform"
-	} 
 
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	    if {$::tcltest::preserveCore > 1} {
-		puts $::tcltest::outputChannel "produced core file! \
-			Moving file to: \
-			[file join $::tcltest::temporaryDirectory core-$name]"
-		flush $::tcltest::outputChannel
-		catch {file rename -force \
-			[file join $::tcltest::workingDirectory core] \
-			[file join $::tcltest::temporaryDirectory \
-			core-$name]} msg
-		if {[string length $msg] > 0} {
-		    ::tcltest::PrintError "Problem renaming file: $msg"
+	if {$testFailed} {
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Failed)
+	    }
+	    set tcltest::currentFailure true
+	    if {![tcltest::isVerbose body]} {
+		set body ""
+	    }	
+	    puts [outputChannel] "\n==== $name [string trim $description] FAILED"
+	    if {$body != ""} {
+		puts [outputChannel] "==== Contents of test case:"
+		puts [outputChannel] $body
+	    }
+	    if {$setupFailure} {
+		puts [outputChannel] "---- Test setup failed:\n$setupMsg"
+	    } 
+	    if {$scriptFailure} {
+		puts [outputChannel] "---- Result was:\n$actualAnswer"
+		puts [outputChannel] "---- Result should have been ($match matching):\n$result"
+	    }
+	    if {$codeFailure} {
+		switch -- $code {
+		    0 { set msg "Test completed normally" }
+		    1 { set msg "Test generated error" }
+		    2 { set msg "Test generated return exception" }
+		    3 { set msg "Test generated break exception" }
+		    4 { set msg "Test generated continue exception" } 
+		    default { set msg "Test generated exception" }
 		}
-	    } else {
-		# Print a message if there is a core file and (1) there
-		# previously wasn't one or (2) the new one is different from
-		# the old one. 
-
-		if {[info exists ::tcltest::coreModificationTime]} {
-		    if {$::tcltest::coreModificationTime != [file mtime \
-			    [file join $::tcltest::workingDirectory core]]} {
-			puts $::tcltest::outputChannel "A core file was created!"
+		puts [outputChannel] "---- $msg; Return code was: $code"
+		puts [outputChannel] "---- Return code should have been one of: $returnCodes"
+		if {[tcltest::isVerbose error]} {
+		    if {[info exists ::errorInfo]} {
+			puts [outputChannel] "---- errorInfo: $::errorInfo"
+			puts [outputChannel] "---- errorCode: $::errorCode"
 		    }
-		} else {
-		    puts $::tcltest::outputChannel "A core file was created!"
-		} 
+		}
+	    }
+	    if {$outputFailure} {
+		puts [outputChannel] "---- Output was:\n$tcltest::outData"
+		puts [outputChannel] "---- Output should have been ($match matching):\n$output"
+	    }
+	    if {$errorFailure} {
+		puts [outputChannel] "---- Error output was:\n$tcltest::errData"
+		puts [outputChannel] "---- Error output should have been ($match matching):\n$errorOutput"
+	    }
+	    if {$cleanupFailure} {
+		puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
 	    }
+	    if {$coreFailure} {
+		puts [outputChannel] "---- Core file produced while running test! $coreMsg"
+	    }
+	    puts [outputChannel] "==== $name FAILED\n"
+
 	}
     }
+    
+    incr tcltest::testLevel -1
+    return 0
 }
 
-# ::tcltest::cleanupTestsHook --
-#
-#	This hook allows a harness that builds upon tcltest to specify
-#       additional things that should be done at cleanup.
-#
-
-if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
-    proc ::tcltest::cleanupTestsHook {} {}
-}
 
-# test --
+# runTest --
 #
+# This is the defnition of the version 1.0 test routine for tcltest.  It is
+# provided here for backward compatibility.  It is also used as the 'backbone'
+# of the test procedure, as in, this is where all the work really gets done.
+# 
 # This procedure runs a test and prints an error message if the test fails.
-# If ::tcltest::verbose has been set, it also prints a message even if the
+# If tcltest::verbose has been set, it also prints a message even if the
 # test succeeds.  The test will be skipped if it doesn't match the
-# ::tcltest::match variable, if it matches an element in
-# ::tcltest::skip, or if one of the elements of "constraints" turns
+# tcltest::match variable, if it matches an element in
+# tcltest::skip, or if one of the elements of "constraints" turns
 # out not to be true.
 #
 # Arguments:
@@ -1364,81 +2429,93 @@ if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
 #			help humans understand what it does.
 # constraints -		A list of one or more keywords, each of
 #			which must be the name of an element in
-#			the array "::tcltest::testConstraints".  If any of these
+#			the array "tcltest::testConstraints".  If any of these
 #			elements is zero, the test is skipped.
 #			This argument may be omitted.
 # script -		Script to run to carry out the test.  It must
 #			return a result that can be checked for
 #			correctness.
 # expectedAnswer -	Expected result from script.
+# 
+# Behavior depends on the value of testLevel; if testLevel is 1 (top level),
+# then events are logged and we track the number of tests run/skipped and why.
+# Otherwise, we don't track this information.
+# 
+# Results:
+#    empty list if test is skipped; otherwise returns list containing
+#    actual returned value from the test and the return code.
+# 
+# Side Effects:
+#    none.
+#
 
-proc ::tcltest::test {name description script expectedAnswer args} {
-
-    DebugPuts 3 "Running $name ($description)"
-
-    incr ::tcltest::numTests(Total)
+proc tcltest::runTest {name description script expectedAnswer constraints} {
 
+    if {$tcltest::testLevel == 1} {
+	incr tcltest::numTests(Total)
+    }
+    
     # skip the test if it's name matches an element of skip
-
-    foreach pattern $::tcltest::skip {
+    foreach pattern $tcltest::skip {
 	if {[string match $pattern $name]} {
-	    incr ::tcltest::numTests(Skipped)
-	    DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedSkip}
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedSkip}
+	    }
 	    return
 	}
     }
 
     # skip the test if it's name doesn't match any element of match
-
-    if {[llength $::tcltest::match] > 0} {
+    if {[llength $tcltest::match] > 0} {
 	set ok 0
-	foreach pattern $::tcltest::match {
+	foreach pattern $tcltest::match {
 	    if {[string match $pattern $name]} {
 		set ok 1
 		break
 	    }
         }
 	if {!$ok} {
-	    incr ::tcltest::numTests(Skipped)
-	    DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedNonMatch}
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedNonMatch}
+	    }
 	    return
 	}
     }
 
-    set i [llength $args]
-    if {$i == 0} {
-	set constraints {}
+    DebugPuts 3 "Running $name ($description) {$script} {$expectedAnswer} $constraints"
+
+    if {$constraints == {}} {
 	# If we're limited to the listed constraints and there aren't any
 	# listed, then we shouldn't run the test.
-	if {$::tcltest::limitConstraints} {
-	    ::tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
-	    incr ::tcltest::numTests(Skipped)
+	if {$tcltest::limitConstraints} {
+	    tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+	    }
 	    return
 	}
-    } elseif {$i == 1} {
-
-	# "constraints" argument exists;  shuffle arguments down, then
+    } else {
+	# "constraints" argument exists; 
 	# make sure that the constraints are satisfied.
 
-	set constraints $script
-	set script $expectedAnswer
-	set expectedAnswer [lindex $args 0]
 	set doTest 0
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
-	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.\w]+} $constraints \
-		    {$::tcltest::testConstraints(&)} c
+	    # $tcltest::testConstraints(a) || $tcltest::testConstraints(b).
+	    regsub -all {[.\w]+} $constraints \
+		    {$tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
 	    set doTest 1
 	    foreach constraint $constraints {
-		if {(![info exists ::tcltest::testConstraints($constraint)]) \
-			|| (!$::tcltest::testConstraints($constraint))} {
+		if {(![info exists tcltest::testConstraints($constraint)]) \
+			|| (!$tcltest::testConstraints($constraint))} {
 		    set doTest 0
 
 		    # store the constraint that kept the test from running
@@ -1447,28 +2524,30 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 		}
 	    }
 	}
+	
 	if {$doTest == 0} {
-	    if {[string first s $::tcltest::verbose] != -1} {
-		puts $::tcltest::outputChannel "++++ $name SKIPPED: $constraints"
+	    if {[tcltest::isVerbose skip]} {
+		puts [outputChannel] "++++ $name SKIPPED: $constraints"
+	    }
+	    
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		tcltest::AddToSkippedBecause $constraints
 	    }
-
-	    incr ::tcltest::numTests(Skipped)
-	    ::tcltest::AddToSkippedBecause $constraints
 	    return	
 	}
-    } else {
-	error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
-    }   
+    }
 
     # Save information about the core file.  You need to restore the original
-    # tcl_platform environment because some of the tests mess with tcl_platform.
+    # tcl_platform environment because some of the tests mess with
+    # tcl_platform.
 
-    if {$::tcltest::preserveCore} {
+    if {$tcltest::preserveCore} {
 	set currentTclPlatform [array get tcl_platform]
-	array set tcl_platform $::tcltest::originalTclPlatform
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	array set tcl_platform $tcltest::originalTclPlatform
+	if {[file exists [file join [tcltest::workingDirectory] core]]} {
 	    set coreModTime [file mtime [file join \
-		    $::tcltest::workingDirectory core]]
+		    [tcltest::workingDirectory] core]]
 	}
 	array set tcl_platform $currentTclPlatform
     }
@@ -1480,107 +2559,288 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	memory tag $name
     }
 
+    if {[tcltest::isVerbose start]} {
+	puts [outputChannel] "---- $name start"
+	flush [outputChannel]
+    }
+    
     set code [catch {uplevel $script} actualAnswer]
-    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
-	incr ::tcltest::numTests(Passed)
-	if {[string first p $::tcltest::verbose] != -1} {
-	    puts $::tcltest::outputChannel "++++ $name PASSED"
+	    
+    return [list $actualAnswer $code]
+}
+
+#####################################################################
+
+# tcltest::cleanupTestsHook --
+#
+#	This hook allows a harness that builds upon tcltest to specify
+#       additional things that should be done at cleanup.
+#
+
+if {[namespace inscope tcltest info procs cleanupTestsHook] == {}} {
+    proc tcltest::cleanupTestsHook {} {}
+}
+
+# tcltest::cleanupTests --
+#
+# 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 tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+# 
+# Restore original environment (as reported by special variable env).
+# 
+# Arguments:
+#      calledFromAllFile - if 0, behave as if we are running a single test file
+#      within an entire suite of tests.  if we aren't running a single test
+#      file, then don't report status.  check for new files created during the
+#      test run and report on them.  if 1, report collated status from all the
+#      test file runs.
+# 
+# Results: 
+#      None.
+# 
+# Side Effects: 
+#      None
+# 
+
+proc tcltest::cleanupTests {{calledFromAllFile 0}} {
+
+    set testFileName [file tail [info script]]
+
+    # Call the cleanup hook
+    tcltest::cleanupTestsHook 
+
+    # Remove files and directories created by the :tcltest::makeFile and
+    # tcltest::makeDirectory procedures.
+    # Record the names of files in tcltest::workingDirectory that were not
+    # pre-existing, and associate them with the test file that created them.
+
+    if {!$calledFromAllFile} {
+	foreach file $tcltest::filesMade {
+	    if {[file exists $file]} {
+		catch {file delete -force $file}
+	    }
+	}
+	set currentFiles {}
+	foreach file [glob -nocomplain \
+		[file join $tcltest::temporaryDirectory *]] {
+	    lappend currentFiles [file tail $file]
+	}
+	set newFiles {}
+	foreach file $currentFiles {
+	    if {[lsearch -exact $tcltest::filesExisted $file] == -1} {
+		lappend newFiles $file
+	    }
+	}
+	set tcltest::filesExisted $currentFiles
+	if {[llength $newFiles] > 0} {
+	    set tcltest::createdNewFiles($testFileName) $newFiles
+	}
+    }
+
+    if {$calledFromAllFile || $tcltest::testSingleFile} {
+
+	# print stats
+
+	puts -nonewline [outputChannel] "$testFileName:"
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    puts -nonewline [outputChannel] \
+		    "\t$index\t$tcltest::numTests($index)"
+	}
+	puts [outputChannel] ""
+
+	# print number test files sourced
+	# print names of files that ran tests which failed
+
+	if {$calledFromAllFile} {
+	    puts [outputChannel] \
+		    "Sourced $tcltest::numTestFiles Test Files."
+	    set tcltest::numTestFiles 0
+	    if {[llength $tcltest::failFiles] > 0} {
+		puts [outputChannel] \
+			"Files with failing tests: $tcltest::failFiles"
+		set tcltest::failFiles {}
+	    }
+	}
+
+	# if any tests were skipped, print the constraints that kept them
+	# from running.
+
+	set constraintList [array names tcltest::skippedBecause]
+	if {[llength $constraintList] > 0} {
+	    puts [outputChannel] \
+		    "Number of tests skipped for each constraint:"
+	    foreach constraint [lsort $constraintList] {
+		puts [outputChannel] \
+			"\t$tcltest::skippedBecause($constraint)\t$constraint"
+		unset tcltest::skippedBecause($constraint)
+	    }
+	}
+
+	# report the names of test files in tcltest::createdNewFiles, and
+	# reset the array to be empty.
+
+	set testFilesThatTurded [lsort [array names tcltest::createdNewFiles]]
+	if {[llength $testFilesThatTurded] > 0} {
+	    puts [outputChannel] "Warning: files left behind:"
+	    foreach testFile $testFilesThatTurded {
+		puts [outputChannel] \
+			"\t$testFile:\t$tcltest::createdNewFiles($testFile)"
+		unset tcltest::createdNewFiles($testFile)
+	    }
+	}
+
+	# reset filesMade, filesExisted, and numTests
+
+	set tcltest::filesMade {}
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    set tcltest::numTests($index) 0
+	}
+
+	# exit only if running Tk in non-interactive mode
+
+	global tk_version tcl_interactive
+	if {[info exists tk_version] && ![info exists tcl_interactive]} {
+	    exit
 	}
     } else {
-	incr ::tcltest::numTests(Failed)
-	set ::tcltest::currentFailure true
-	if {[string first b $::tcltest::verbose] == -1} {
-	    set script ""
-	}
-	puts $::tcltest::outputChannel "\n==== $name $description FAILED"
-	if {$script != ""} {
-	    puts $::tcltest::outputChannel "==== Contents of test case:"
-	    puts $::tcltest::outputChannel $script
-	}
-	if {$code != 0} {
-	    if {$code == 1} {
-		puts $::tcltest::outputChannel "==== Test generated error:"
-		puts $::tcltest::outputChannel $actualAnswer
-	    } elseif {$code == 2} {
-		puts $::tcltest::outputChannel "==== Test generated return exception;  result was:"
-		puts $::tcltest::outputChannel $actualAnswer
-	    } elseif {$code == 3} {
-		puts $::tcltest::outputChannel "==== Test generated break exception"
-	    } elseif {$code == 4} {
-		puts $::tcltest::outputChannel "==== Test generated continue exception"
+
+	# 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 tcltest::numTestFiles
+	if {($tcltest::currentFailure) && \
+		([lsearch -exact $tcltest::failFiles $testFileName] == -1)} {
+	    lappend tcltest::failFiles $testFileName
+	}
+	set tcltest::currentFailure false
+
+	# restore the environment to the state it was in before this package
+	# was loaded
+
+	set newEnv {}
+	set changedEnv {}
+	set removedEnv {}
+	foreach index [array names ::env] {
+	    if {![info exists tcltest::originalEnv($index)]} {
+		lappend newEnv $index
+		unset ::env($index)
 	    } else {
-		puts $::tcltest::outputChannel "==== Test generated exception $code;  message was:"
-		puts $::tcltest::outputChannel $actualAnswer
+		if {$::env($index) != $tcltest::originalEnv($index)} {
+		    lappend changedEnv $index
+		    set ::env($index) $tcltest::originalEnv($index)
+		}
 	    }
-	} else {
-	    puts $::tcltest::outputChannel "---- Result was:\n$actualAnswer"
 	}
-	puts $::tcltest::outputChannel "---- Result should have been:\n$expectedAnswer"
-	puts $::tcltest::outputChannel "==== $name FAILED\n"
-    }
-    if {$::tcltest::preserveCore} {
-	set currentTclPlatform [array get tcl_platform]
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	    if {$::tcltest::preserveCore > 1} {
-		puts $::tcltest::outputChannel "==== $name produced core file! \
+	foreach index [array names tcltest::originalEnv] {
+	    if {![info exists ::env($index)]} {
+		lappend removedEnv $index
+		set ::env($index) $tcltest::originalEnv($index)
+	    }
+	}
+	if {[llength $newEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements created:\t$newEnv"
+	}
+	if {[llength $changedEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements changed:\t$changedEnv"
+	}
+	if {[llength $removedEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements removed:\t$removedEnv"
+	}
+
+	set changedTclPlatform {}
+	foreach index [array names tcltest::originalTclPlatform] {
+	    if {$::tcl_platform($index) != \
+		    $tcltest::originalTclPlatform($index)} { 
+		lappend changedTclPlatform $index
+		set ::tcl_platform($index) \
+			$tcltest::originalTclPlatform($index) 
+	    }
+	}
+	if {[llength $changedTclPlatform] > 0} {
+	    puts [outputChannel] \
+		    "tcl_platform array elements changed:\t$changedTclPlatform"
+	} 
+
+	if {[file exists [file join [tcltest::workingDirectory] core]]} {
+	    if {$tcltest::preserveCore > 1} {
+		puts "rename core file (> 1)" 
+		puts [outputChannel] "produced core file! \
 			Moving file to: \
-			[file join $::tcltest::temporaryDirectory core-$name]"
+			[file join $tcltest::temporaryDirectory core-$name]"
 		catch {file rename -force \
-			[file join $::tcltest::workingDirectory core] \
-			[file join $::tcltest::temporaryDirectory \
-			core-$name]} msg
+			[file join [tcltest::workingDirectory] core] \
+			[file join $tcltest::temporaryDirectory \
+			    core-$name]} msg
 		if {[string length $msg] > 0} {
-		    ::tcltest::PrintError "Problem renaming file: $msg"
+		    tcltest::PrintError "Problem renaming file: $msg"
 		}
 	    } else {
 		# Print a message if there is a core file and (1) there
 		# previously wasn't one or (2) the new one is different from
 		# the old one. 
 
-		if {[info exists coreModTime]} {
-		    if {$coreModTime != [file mtime \
-			    [file join $::tcltest::workingDirectory core]]} {
-			puts $::tcltest::outputChannel "==== $name produced core file!"
+		if {[info exists tcltest::coreModificationTime]} {
+		    if {$tcltest::coreModificationTime != [file mtime \
+			    [file join [tcltest::workingDirectory] core]]} {
+			puts [outputChannel] "A core file was created!"
 		    }
 		} else {
-		    puts $::tcltest::outputChannel "==== $name produced core file!"
+		    puts [outputChannel] "A core file was created!"
 		} 
 	    }
 	}
-	array set tcl_platform $currentTclPlatform
     }
+    flush [outputChannel]
+    flush [errorChannel]
+    return
 }
 
-# ::tcltest::getMatchingFiles
+#####################################################################
+
+# Procs that determine which tests/test files to run
+
+# tcltest::getMatchingFiles
 #
 #       Looks at the patterns given to match and skip files
 #       and uses them to put together a list of the tests that will be run.
 #
 # Arguments:
-#       none
+#       directory to search
 #
 # Results:
 #       The constructed list is returned to the user.  This will primarily
-#       be used in 'all.tcl' files.
+#       be used in 'all.tcl' files.  It is used in runAllTests.
+# 
+# Side Effects:
+#       None
 
-proc ::tcltest::getMatchingFiles {args} {
-    set matchingFiles {}
-    if {[llength $args]} {
-	set searchDirectory $args
-    } else {
-	set searchDirectory [list $::tcltest::testsDirectory]
+proc tcltest::getMatchingFiles { {searchDirectory ""} } {
+    if {[llength [info level 0]] == 1} {
+	set searchDirectory [tcltest::testsDirectory]
     }
+    set matchingFiles {}
+
     # Find the matching files in the list of directories and then remove the
     # ones that match the skip pattern
     foreach directory $searchDirectory {
 	set matchFileList {}
-	foreach match $::tcltest::matchFiles {
+	foreach match $tcltest::matchFiles {
 	    set matchFileList [concat $matchFileList \
 		    [glob -nocomplain [file join $directory $match]]]
 	}
-	if {[string compare {} $::tcltest::skipFiles]} {
+	if {[string compare {} $tcltest::skipFiles]} {
 	    set skipFileList {}
-	    foreach skip $::tcltest::skipFiles {
+	    foreach skip $tcltest::skipFiles {
 		set skipFileList [concat $skipFileList \
 			[glob -nocomplain [file join $directory $skip]]]
 	    }
@@ -1597,35 +2857,213 @@ proc ::tcltest::getMatchingFiles {args} {
 	}
     }
     if {[string equal $matchingFiles {}]} {
-	::tcltest::PrintError "No test files remain after applying \
+	tcltest::PrintError "No test files remain after applying \
 		your match and skip patterns!"
     }
     return $matchingFiles
 }
 
-# The following two procs are used in the io tests.
-
-proc ::tcltest::openfiles {} {
-    if {[catch {testchannel open} result]} {
-	return {}
+# tcltest::getMatchingDirectories --
+#
+#	Looks at the patterns given to match and skip directories and uses them
+#       to put together a list of the test directories that we should attempt
+#       to run.  (Only subdirectories containing an "all.tcl" file are put into
+#       the list.)
+#
+# Arguments:
+#	root directory from which to search
+#
+# Results:
+#	The constructed list is returned to the user.  This is used in the
+#       primary all.tcl file.  Lower-level all.tcl files should use the
+#       tcltest::testAllFiles proc instead.
+# 
+# Side Effects: 
+#       None.
+
+proc tcltest::getMatchingDirectories {rootdir} {
+    set matchingDirs {}
+    set matchDirList {}
+    # Find the matching directories in tcltest::testsDirectory and then
+    # remove the ones that match the skip pattern
+    foreach match $tcltest::matchDirectories {
+	foreach file [glob -nocomplain [file join $rootdir $match]] {
+	    if {([file isdirectory $file]) && ($file != $rootdir)} {
+		set matchDirList [concat $matchDirList \
+			[tcltest::getMatchingDirectories $file]]
+		if {[file exists [file join $file all.tcl]]} {
+		    set matchDirList [concat $matchDirList $file]
+		}
+	    }
+	}
     }
-    return $result
+    if {$tcltest::skipDirectories != {}} {
+	set skipDirs {} 
+	foreach skip $tcltest::skipDirectories {
+	    set skipDirs [concat $skipDirs \
+		    [glob -nocomplain [file join $tcltest::testsDirectory \
+			$skip]]]
+	}
+	foreach dir $matchDirList {
+	    # Only include directories that don't match the skip pattern
+	    if {[lsearch -exact $skipDirs $dir] == -1} {
+		lappend matchingDirs $dir
+	    }
+	}
+    } else {
+	set matchingDirs [concat $matchingDirs $matchDirList]
+    }
+    if {$matchingDirs == {}} {
+	DebugPuts 1 "No test directories remain after applying match and skip patterns!"
+    }
+    return $matchingDirs
 }
 
-proc ::tcltest::leakfiles {old} {
-    if {[catch {testchannel open} new]} {
-        return {}
+# tcltest::runAllTests --
+#
+#	prints output and sources test files according to the match and skip
+#       patterns provided.  after sourcing test files, it goes on to source
+#       all.tcl files in matching test subdirectories.
+#
+# Arguments:
+#	shell being tested
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::runAllTests { {shell ""} } {
+    global argv
+
+    if {[llength [info level 0]] == 1} {
+	set shell [tcltest::interpreter]
     }
-    set leak {}
-    foreach p $new {
-    	if {[lsearch $old $p] < 0} {
-	    lappend leak $p
+
+    set tcltest::testSingleFile false
+
+    puts [outputChannel] "Tests running in interp:  $shell"
+    puts [outputChannel] "Tests located in:  $tcltest::testsDirectory"
+    puts [outputChannel] "Tests running in:  [tcltest::workingDirectory]"
+    puts [outputChannel] "Temporary files stored in $tcltest::temporaryDirectory"
+    if {[tcltest::singleProcess]} {
+	puts [outputChannel] "Test files sourced into current interpreter"
+    } else {
+	puts [outputChannel] "Test files run in separate interpreters"
+    }
+    if {[llength $tcltest::skip] > 0} {
+	puts [outputChannel] "Skipping tests that match:  $tcltest::skip"
+    }
+    if {[llength $tcltest::match] > 0} {
+	puts [outputChannel] "Only running tests that match:  $tcltest::match"
+    }
+
+    if {[llength $tcltest::skipFiles] > 0} {
+	puts [outputChannel] "Skipping test files that match:  $tcltest::skipFiles"
+    }
+    if {[llength $tcltest::matchFiles] > 0} {
+	puts [outputChannel] "Only running test files that match:  $tcltest::matchFiles"
+    }
+
+    set timeCmd {clock format [clock seconds]}
+    puts [outputChannel] "Tests began at [eval $timeCmd]"
+
+    # Run each of the specified tests
+    foreach file [lsort [tcltest::getMatchingFiles]] {
+	set tail [file tail $file]
+	puts [outputChannel] $tail
+
+	if {$tcltest::singleProcess} {
+	    incr tcltest::numTestFiles
+	    uplevel [list source $file]
+	} else {
+	    # Change to the tests directory so the value of the following
+	    # variable is set correctly when we spawn the child test processes
+	    cd $tcltest::testsDirectory
+	    set cmd [concat [list | $shell $file] [split $argv]]
+	    if {[catch {
+		incr tcltest::numTestFiles
+		set pipeFd [open $cmd "r"] 
+		while {[gets $pipeFd line] >= 0} {
+		    if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
+			foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+			    incr tcltest::numTests($index) [set $index]
+			}
+			if {$Failed > 0} {
+			    lappend tcltest::failFiles $testFile
+			}
+		    } elseif {[regexp {^Number of tests skipped for each constraint:|^\t(\d+)\t(.+)$} $line match skipped constraint]} {
+			if {$match != "Number of tests skipped for each constraint:"} {
+			    tcltest::AddToSkippedBecause $constraint $skipped
+			}
+		    } else {
+			puts [outputChannel] $line
+		    }
+		}
+		close $pipeFd
+	    } msg]} {
+		# Print results to tcltest::outputChannel.
+		puts [outputChannel] "Test file error: $msg"
+		# append the name of the test to a list to be reported later
+		lappend testFileFailures $file 
+	    }
 	}
     }
-    return $leak
+
+    # cleanup
+    puts [outputChannel] "\nTests ended at [eval $timeCmd]"
+    tcltest::cleanupTests 1
+    if {[info exists testFileFailures]} {
+	puts [outputChannel] "\nTest files exiting with errors:  \n"
+	foreach file $testFileFailures {
+	    puts "  [file tail $file]\n"
+	}
+    }
+
+    # Checking for subdirectories in which to run tests
+    foreach directory [tcltest::getMatchingDirectories $tcltest::testsDirectory] {
+	set dir [file tail $directory]
+	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
+	puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
+	
+	uplevel "source [file join $directory all.tcl]"
+	
+	set endTime [eval $timeCmd]
+	puts [outputChannel] "\n$dir test ended at $endTime"
+	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
+    }
+    return
+}
+
+#####################################################################
+
+# Test utility procs - not used in tcltest, but may be useful for testing.
+
+# tcltest::loadTestedCommands --
+#
+#     Uses the specified script to load the commands to test. Allowed to
+#     be empty, as the tested commands could have been compiled into the
+#     interpreter.
+#
+# Arguments
+#     none
+#
+# Results
+#     none
+# 
+# Side Effects: 
+#     none.
+
+proc tcltest::loadTestedCommands {} {
+    if {$tcltest::loadScript == {}} {
+	return
+    }
+    
+    return [uplevel $tcltest::loadScript]
 }
 
-# ::tcltest::saveState --
+# tcltest::saveState --
 #
 #	Save information regarding what procs and variables exist.
 #
@@ -1633,58 +3071,71 @@ proc ::tcltest::leakfiles {old} {
 #	none
 #
 # Results:
-#	Modifies the variable ::tcltest::saveState
+#	Modifies the variable tcltest::saveState
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::saveState {} {
-    uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
-    DebugPuts 2 "::tcltest::saveState: $::tcltest::saveState"
+proc tcltest::saveState {} {
+    uplevel {set tcltest::saveState [list [info procs] [info vars]]}
+    DebugPuts  2 "tcltest::saveState: $tcltest::saveState"
+    return
 }
 
-# ::tcltest::restoreState --
+# tcltest::restoreState --
 #
 #	Remove procs and variables that didn't exist before the call to
-#       ::tcltest::saveState.
+#       tcltest::saveState.
 #
 # Arguments:
 #	none
 #
 # Results:
 #	Removes procs and variables from your environment if they don't exist
-#       in the ::tcltest::saveState variable.
+#       in the tcltest::saveState variable.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::restoreState {} {
+proc tcltest::restoreState {} {
     foreach p [info procs] {
-	if {([lsearch [lindex $::tcltest::saveState 0] $p] < 0) && \
-		(![string equal ::tcltest::$p [namespace origin $p]])} {
+	if {([lsearch [lindex $tcltest::saveState 0] $p] < 0) && \
+		(![string match "*tcltest::$p" [namespace origin $p]])} {
 	    
-	    DebugPuts 2 "::tcltest::restoreState: Removing proc $p"
+	    DebugPuts 2 "tcltest::restoreState: Removing proc $p"
 	    rename $p {}
 	}
     }
-    foreach p [uplevel #0 {info vars}] {
-	if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
-	    DebugPuts 2 "::tcltest::restoreState: Removing variable $p"
-	    uplevel #0 "catch {unset $p}"
+    foreach p [uplevel {info vars}] {
+	if {[lsearch [lindex $tcltest::saveState 1] $p] < 0} {
+	    DebugPuts 2 "tcltest::restoreState: Removing variable $p"
+	    uplevel "catch {unset $p}"
 	}
     }
+    return
 }
 
-# ::tcltest::normalizeMsg --
+# tcltest::normalizeMsg --
 #
 #	Removes "extra" newlines from a string.
 #
 # Arguments:
 #	msg        String to be modified
 #
+# Results:
+#	string with extra newlines removed
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::normalizeMsg {msg} {
+proc tcltest::normalizeMsg {msg} {
     regsub "\n$" [string tolower $msg] "" msg
     regsub -all "\n\n" $msg "\n" msg
     regsub -all "\n\}" $msg "\}" msg
     return $msg
 }
 
-# makeFile --
+# tcltest::makeFile --
 #
 # Create a new file with the name <name>, and write <contents> to it.
 #
@@ -1692,12 +3143,28 @@ proc ::tcltest::normalizeMsg {msg} {
 # cleanupTests was called, add it to the $filesMade list, so it will
 # be removed by the next call to cleanupTests.
 #
-proc ::tcltest::makeFile {contents name} {
+# Arguments:
+#	contents        content of the new file
+#       name            name of the new file
+#       directory       directory name for new file 
+#
+# Results:
+#	absolute path to the file created
+#
+# Side effects:
+#	None.
+
+proc tcltest::makeFile {contents name {directory ""}} {
     global tcl_platform
+
+    if {[llength [info level 0]] == 3} {
+	set directory [tcltest::temporaryDirectory]
+    }
     
-    DebugPuts 3 "::tcltest::makeFile: putting $contents into $name"
+    set fullName [file join $directory $name]
+
+    DebugPuts 3 "tcltest::makeFile: putting $contents into $fullName"
 
-    set fullName [file join $::tcltest::temporaryDirectory $name]
     set fd [open $fullName w]
 
     fconfigure $fd -translation lf
@@ -1709,26 +3176,36 @@ proc ::tcltest::makeFile {contents name} {
     }
     close $fd
 
-    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
-	lappend ::tcltest::filesMade $fullName
+    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
+	lappend tcltest::filesMade $fullName
     }
     return $fullName
 }
 
-# ::tcltest::removeFile --
+# tcltest::removeFile --
 #
 #	Removes the named file from the filesystem
 #
 # Arguments:
-#	name     file to be removed
+#	name          file to be removed
+#       directory     directory from which to remove file
 #
+# Results:
+#	return value from [file delete]
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::removeFile {name} {
-    DebugPuts 3 "::tcltest::removeFile: removing $name"
-    file delete [file join $::tcltest::temporaryDirectory $name]
+proc tcltest::removeFile {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
+    }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::removeFile: removing $fullName"
+    return [file delete $fullName]
 }
 
-# makeDirectory --
+# tcltest::makeDirectory --
 #
 # Create a new dir with the name <name>.
 #
@@ -1736,75 +3213,85 @@ proc ::tcltest::removeFile {name} {
 # cleanupTests was called, add it to the $directoriesMade list, so it will
 # be removed by the next call to cleanupTests.
 #
-proc ::tcltest::makeDirectory {name} {
-    file mkdir $name
+# Arguments:
+#       name            name of the new directory
+#       directory       directory in which to create new dir
+#
+# Results:
+#	absolute path to the directory created
+#
+# Side effects:
+#	None.
 
-    set fullName [file join [pwd] $name]
-    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
-	lappend ::tcltest::filesMade $fullName
+proc tcltest::makeDirectory {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::makeDirectory: creating $fullName"
+    file mkdir $fullName
+    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
+	lappend tcltest::filesMade $fullName
+    }
+    return $fullName
 }
 
-# ::tcltest::removeDirectory --
+# tcltest::removeDirectory --
 #
 #	Removes a named directory from the file system.
 #
 # Arguments:
-#	name    Name of the directory to remove
+#	name          Name of the directory to remove
+#       directory     Directory from which to remove
 #
+# Results:
+#	return value from [file delete]
+#
+# Side effects:
+#	None
 
-proc ::tcltest::removeDirectory {name} {
-    file delete -force $name
-}
-
-proc ::tcltest::viewFile {name} {
-    global tcl_platform
-    if {([string equal $tcl_platform(platform) "macintosh"]) || \
-	    ($::tcltest::testConstraints(unixExecs) == 0)} {
-	set f [open [file join $::tcltest::temporaryDirectory $name]]
-	set data [read -nonewline $f]
-	close $f
-	return $data
-    } else {
-	exec cat [file join $::tcltest::temporaryDirectory $name]
+proc tcltest::removeDirectory {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::removeDirectory: deleting $fullName"
+    return [file delete -force $fullName]
 }
 
-# grep --
+# tcltest::viewFile --
 #
-# Evaluate a given expression against each element of a list and return all
-# elements for which the expression evaluates to true.  For the purposes of
-# this proc, use of the keyword "CURRENT_ELEMENT" will flag the proc to use the
-# value of the current element within the expression.  This is equivalent to
-# the perl grep command where CURRENT_ELEMENT would be the name for the special
-# variable $_.
+#	reads the content of a file and returns it
 #
-# Examples of usage would be:
-#   set subList [grep {CURRENT_ELEMENT == 1} $listOfNumbers]
-#   set subList [grep {regexp {abc} CURRENT_ELEMENT} $listOfStrings]
+# Arguments:
+#	name of the file to read
+#       directory in which file is located
 #
-# Use of the CURRENT_ELEMENT keyword is optional.  If it is left out, it is
-# assumed to be the final argument to the expression provided.
-# 
-# Example:
-#   grep {regexp a} $someList   
+# Results:
+#	content of the named file
 #
-proc ::tcltest::grep { expression searchList } {
-    foreach element $searchList {
-	if {[regsub -all CURRENT_ELEMENT $expression $element \
-		newExpression] == 0} { 
-	    set newExpression "$expression {$element}"
-	}
-	if {[eval $newExpression] == 1} {
-	    lappend returnList $element
-	}
+# Side effects:
+#	None.
+
+proc tcltest::viewFile {name {directory ""}} {
+    global tcl_platform
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
-    if {[info exists returnList]} {
-	return $returnList
+    set fullName [file join $directory $name]
+    if {([string equal $tcl_platform(platform) "macintosh"]) || \
+	    ([tcltest::testConstraint unixExecs] == 0)} {
+	set f [open $fullName]
+	set data [read -nonewline $f]
+	close $f
+	return $data
+    } else {
+	return [exec cat $fullName]
     }
     return
 }
 
+# tcltest::bytestring --
 #
 # Construct a string that consists of the requested sequence of bytes,
 # as opposed to a string of properly formed UTF-8 characters.  
@@ -1818,30 +3305,112 @@ proc ::tcltest::grep { expression searchList } {
 # Generally, it's a bad idea to examine the bytes in a Tcl string or to
 # construct improperly formed strings in this manner, because it involves
 # exposing that Tcl uses UTF-8 internally.
+#
+# Arguments:
+#	string being converted
+#
+# Results:
+#	result fom encoding
+#
+# Side effects:
+#	None
+
+proc tcltest::bytestring {string} {
+    return [encoding convertfrom identity $string]
+}
+
+# tcltest::openfiles --
+#
+#	used in io tests, uses testchannel
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	???
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::bytestring {string} {
-    encoding convertfrom identity $string
+proc tcltest::openfiles {} {
+    if {[catch {testchannel open} result]} {
+	return {}
+    }
+    return $result
+}
+
+# tcltest::leakfiles --
+#
+#	used in io tests, uses testchannel
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	???
+#
+# Side effects:
+#	None.
+
+proc tcltest::leakfiles {old} {
+    if {[catch {testchannel open} new]} {
+	return {}
+    }
+    set leak {}
+    foreach p $new {
+	if {[lsearch $old $p] < 0} {
+	    lappend leak $p
+	}
+    }
+    return $leak
 }
 
 #
 # Internationalization / ISO support procs     -- dl
 #
-proc ::tcltest::set_iso8859_1_locale {} {
+
+# tcltest::set_iso8859_1_locale --
+#
+#	used in cmdIL.test, uses testlocale
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::set_iso8859_1_locale {} {
     if {[info commands testlocale] != ""} {
-	set ::tcltest::previousLocale [testlocale ctype]
-	testlocale ctype $::tcltest::isoLocale
+	set tcltest::previousLocale [testlocale ctype]
+	testlocale ctype $tcltest::isoLocale
     }
     return
 }
 
-proc ::tcltest::restore_locale {} {
+# tcltest::restore_locale --
+#
+#	used in cmdIL.test, uses testlocale
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::restore_locale {} {
     if {[info commands testlocale] != ""} {
-	testlocale ctype $::tcltest::previousLocale
+	testlocale ctype $tcltest::previousLocale
     }
     return
 }
 
-# threadReap --
+# tcltest::threadReap --
 #
 #	Kill all threads except for the main thread.
 #	Do nothing if testthread is not defined.
@@ -1851,7 +3420,12 @@ proc ::tcltest::restore_locale {} {
 #
 # Results:
 #	Returns the number of existing threads.
-proc ::tcltest::threadReap {} {
+# 
+# Side Effects: 
+#       none.
+#
+
+proc tcltest::threadReap {} {
     if {[info commands testthread] != {}} {
 
 	# testthread built into tcltest
@@ -1859,7 +3433,7 @@ proc ::tcltest::threadReap {} {
 	testthread errorproc ThreadNullError
 	while {[llength [testthread names]] > 1} {
 	    foreach tid [testthread names] {
-		if {$tid != $::tcltest::mainThread} {
+		if {$tid != $tcltest::mainThread} {
 		    catch {testthread send -async $tid {testthread exit}}
 		}
 	    }
@@ -1877,7 +3451,7 @@ proc ::tcltest::threadReap {} {
 	thread::errorproc ThreadNullError
 	while {[llength [thread::names]] > 1} {
 	    foreach tid [thread::names] {
-		if {$tid != $::tcltest::mainThread} {
+		if {$tid != $tcltest::mainThread} {
 		    catch {thread::send -async $tid {thread::exit}}
 		}
 	    }
@@ -1891,6 +3465,7 @@ proc ::tcltest::threadReap {} {
     } else {
 	return 1
     }
+    return 0
 }
 
 # Initialize the constraints and set up command line arguments 
@@ -1898,8 +3473,18 @@ namespace eval tcltest {
     # Ensure that we have a minimal auto_path so we don't pick up extra junk.
     set ::auto_path [list [info library]]
 
-    ::tcltest::initConstraints
-    if {[namespace children ::tcltest] == {}} {
-	::tcltest::processCmdLineArgs
+    tcltest::initConstraints
+    if {[namespace children [namespace current]] == {}} {
+	tcltest::processCmdLineArgs
+    }
+
+    # Save the names of files that already exist in
+    # the output directory.
+    foreach file [glob -nocomplain \
+	    [file join $tcltest::temporaryDirectory *]] {
+	lappend tcltest::filesExisted [file tail $file]
     }
 }
+
+package provide tcltest 2.0
+
diff --git a/library/tcltest/tcltest2.tcl b/library/tcltest/tcltest2.tcl
deleted file mode 100755
index c05732d..0000000
--- a/library/tcltest/tcltest2.tcl
+++ /dev/null
@@ -1,3490 +0,0 @@
-# tcltest.tcl --
-#
-#	This file contains support code for the Tcl test suite.  It 
-#       defines the tcltest namespace and finds and defines the output
-#       directory, constraints available, output and error channels, etc. used
-#       by Tcl tests.  See the tcltest man page for more details.
-#       
-#       This design was based on the Tcl testing approach designed and
-#       initially implemented by Mary Ann May-Pumphrey of Sun Microsystems. 
-#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2000 by Ajuba Solutions
-# All rights reserved.
-# 
-# RCS: @(#) $Id: tcltest2.tcl,v 1.4 2000/10/19 18:00:58 jenn Exp $
-
-# create the "tcltest" namespace for all testing variables and procedures
-
-namespace eval tcltest { 
-
-    # Export the public tcltest procs
-    set procList [list test cleanupTests saveState restoreState \
-	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring threadReap debug testConstraint \
-	    limitConstraints loadTestedCommands normalizePath verbose match \
-	    skip matchFiles skipFiles preserveCore  loadScript loadFile \
-	    mainThread workingDirectory singleProcess interpreter runAllTests \
-	    outputChannel outputFile errorChannel \
-	    errorFile temporaryDirectory testsDirectory  matchDirectories \
-	    skipDirectories ]
-    foreach proc $procList {
-	namespace export $proc
-    }
-
-    # tcltest::verbose defaults to {body}
-    if {![info exists verbose]} {
-	variable verbose {body}
-    }
-
-    # Match and skip patterns default to the empty list, except for
-    # matchFiles, which defaults to all .test files in the testsDirectory and
-    # matchDirectories, which defaults to all directories.
-
-    if {![info exists match]} {
-	variable match {}
-    }
-    if {![info exists skip]} {
-	variable skip {}
-    }
-    if {![info exists matchFiles]} {
-	variable matchFiles {*.test}
-    }
-    if {![info exists skipFiles]} {
-	variable skipFiles {}
-    }
-    if {![info exists matchDirectories]} {
-	variable matchDirectories {*}
-    }
-    if {![info exists skipDirectories]} {
-	variable skipDirectories {}
-    }
-
-    # By default, don't save core files
-    if {![info exists preserveCore]} {
-	variable preserveCore 0
-    }
-
-    # output goes to stdout by default
-    if {![info exists outputChannel]} {
-	variable outputChannel stdout
-    }
-    if {![info exists outputFile]} {
-	variable outputFile stdout
-    }
-
-    # errors go to stderr by default
-    if {![info exists errorChannel]} {
-	variable errorChannel stderr
-    }
-    if {![info exists errorFile]} {
-	variable errorFile stderr
-    }
-
-    # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tests that were skipped because they didn't match or were 
-    # specifically skipped.  A debug level of 2 would spit up the tcltest
-    # variables and flags provided; a debug level of 3 causes some additional
-    # output regarding operations of the test harness.  The tcltest package
-    # currently implements only up to debug level 3.
-    if {![info exists debug]} {
-	variable debug 0
-    }
-
-    # Save any arguments that we might want to pass through to other programs. 
-    # This is used by the -args flag.
-    if {![info exists parameters]} {
-	variable parameters {}
-    }
-
-    # Count the number of files tested (0 if runAllTests wasn't called).
-    # runAllTests will set testSingleFile to false, so stats will
-    # not be printed until runAllTests 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.
-
-    if {![info exists numTestFiles]} {
-	variable numTestFiles 0
-    }
-    if {![info exists testSingleFile]} {
-	variable testSingleFile true
-    }
-    if {![info exists currentFailure]} {
-	variable currentFailure false
-    }
-    if {![info exists failFiles]} {
-	variable failFiles {}
-    }
-
-    # Tests should remove all files they create.  The test suite will
-    # check the current working dir for files created by the tests.
-    # tcltest::filesMade keeps track of such files created using the
-    # tcltest::makeFile and tcltest::makeDirectory procedures.
-    # tcltest::filesExisted stores the names of pre-existing files.
-
-    if {![info exists filesMade]} {
-	variable filesMade {}
-    }
-    if {![info exists filesExisted]} {
-	variable filesExisted {}
-    }
-
-    # tcltest::numTests will store test files as indices and the list
-    # of files (that should not have been) left behind by the test files.
-
-    if {![info exists createdNewFiles]} {
-	variable createdNewFiles
-	array set tcltest::createdNewFiles {}
-    }
-
-    # initialize tcltest::numTests array to keep track fo the number of
-    # tests that pass, fail, and are skipped.
-
-    if {![info exists numTests]} {
-	variable numTests
-	array set tcltest::numTests \
-		[list Total 0 Passed 0 Skipped 0 Failed	0] 
-    }
-
-    # initialize tcltest::skippedBecause array to keep track of
-    # constraints that kept tests from running; a constraint name of
-    # "userSpecifiedSkip" means that the test appeared on the list of tests
-    # that matched the -skip value given to the flag; "userSpecifiedNonMatch"
-    # means that the test didn't match the argument given to the -match flag;
-    # both of these constraints are counted only if tcltest::debug is set to
-    # true. 
-
-    if {![info exists skippedBecause]} {
-	variable skippedBecause
-	array set tcltest::skippedBecause {}
-    }
-
-    # initialize the tcltest::testConstraints array to keep track of valid
-    # predefined constraints (see the explanation for the
-    # tcltest::initConstraints proc for more details).
-
-    if {![info exists testConstraints]} {
-	variable testConstraints
-	array set tcltest::testConstraints {}
-    }
-
-    if {![info exists constraintsSpecified]} {
-	variable constraintsSpecified {}
-    }
-
-    # Don't run only the constrained tests by default
-
-    if {![info exists limitConstraints]} {
-	variable limitConstraints false
-    }
-
-    # A test application has to know how to load the tested commands into
-    # the interpreter.
-
-    if {![info exists loadScript]} {
-	variable loadScript {}
-    }
-
-    # and the filename of the script file, if it exists
-    if {![info exists loadFile]} {
-	variable loadFile {}
-    }
-
-    # tests that use threads need to know which is the main thread
-
-    if {![info exists mainThread]} {
-	variable mainThread 1
-	if {[info commands thread::id] != {}} {
-	    set mainThread [thread::id]
-	} elseif {[info commands testthread] != {}} {
-	    set mainThread [testthread id]
-	}
-    }
-
-    # save the original environment so that it can be restored later
-    
-    if {![info exists originalEnv]} {
-	variable originalEnv
-	array set tcltest::originalEnv [array get ::env]
-    }
-
-    # Set tcltest::workingDirectory to [pwd]. The default output directory
-    # for Tcl tests is the working directory.
-
-    if {![info exists workingDirectory]} {
-	variable workingDirectory [pwd]
-    }
-    if {![info exists temporaryDirectory]} {
-	variable temporaryDirectory $workingDirectory
-    }
-
-    # Tests should not rely on the current working directory.
-    # Files that are part of the test suite should be accessed relative to 
-    # tcltest::testsDirectory.
-
-    if {![info exists testsDirectory]} {
-	set oldpwd [pwd]
-	catch {cd [file join [file dirname [info script]] .. .. tests]}
-	variable testsDirectory [pwd]
-	cd $oldpwd
-	unset oldpwd
-    }
-
-    # Default is to run each test file in a separate process
-    if {![info exists singleProcess]} {
-	variable singleProcess 0
-    }
-
-    # the variables and procs that existed when tcltest::saveState was
-    # called are stored in a variable of the same name
-    if {![info exists saveState]} {
-	variable saveState {}
-    }
-
-    # Internationalization support -- used in tcltest::set_iso8859_1_locale
-    # and tcltest::restore_locale. Those commands are used in cmdIL.test.
-    if {![info exists previousLocale]} {
-	variable previousLocale
-    }
-
-    if {![info exists isoLocale]} {
-	variable isoLocale fr
-	switch -- $tcl_platform(platform) {
-	    "unix" {
-
-		# Try some 'known' values for some platforms:
-
-		switch -exact -- $tcl_platform(os) {
-		    "FreeBSD" {
-			set tcltest::isoLocale fr_FR.ISO_8859-1
-		    }
-		    HP-UX {
-			set tcltest::isoLocale fr_FR.iso88591
-		    }
-		    Linux -
-		    IRIX {
-			set tcltest::isoLocale fr
-		    }
-		    default {
-
-			# Works on SunOS 4 and Solaris, and maybe others...
-			# define it to something else on your system
-			#if you want to test those.
-
-			set tcltest::isoLocale iso_8859_1
-		    }
-		}
-	    }
-	    "windows" {
-		set tcltest::isoLocale French
-	    }
-	}
-    }
-
-    # Set the location of the execuatble
-    if {![info exists tcltest]} {
-	variable tcltest [info nameofexecutable]
-    }	
-
-    # save the platform information so it can be restored later
-    if {![info exists originalTclPlatform]} {
-	variable originalTclPlatform [array get tcl_platform]
-    }
-
-    # If a core file exists, save its modification time.
-    if {![info exists coreModificationTime]} {
-	if {[file exists [file join $tcltest::workingDirectory core]]} {
-	    variable coreModificationTime [file mtime [file join \
-		    $tcltest::workingDirectory core]]
-	}
-    }
-
-    # stdout and stderr buffers for use when we want to store them
-    if {![info exists outData]} {
-	variable outData {}
-    }
-    if {![info exists errData]} {
-	variable errData {}
-    }
-
-    # keep track of test level for nested test commands
-    variable testLevel 0
-}   
-
-#####################################################################
-
-# tcltest::Debug* --
-#
-#     Internal helper procedures to write out debug information
-#     dependent on the chosen level. A test shell may overide
-#     them, f.e. to redirect the output into a different
-#     channel, or even into a GUI.
-
-# tcltest::DebugPuts --
-#
-#     Prints the specified string if the current debug level is
-#     higher than the provided level argument.
-#
-# Arguments:
-#     level   The lowest debug level triggering the output
-#     string  The string to print out.
-#
-# Results:
-#     Prints the string. Nothing else is allowed.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugPuts {level string} {
-    variable debug
-    if {$debug >= $level} {
-	puts $string
-    }
-    return
-}
-
-# tcltest::DebugPArray --
-#
-#     Prints the contents of the specified array if the current
-#       debug level is higher than the provided level argument
-#
-# Arguments:
-#     level           The lowest debug level triggering the output
-#     arrayvar        The name of the array to print out.
-#
-# Results:
-#     Prints the contents of the array. Nothing else is allowed.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugPArray {level arrayvar} {
-    variable debug
-
-    if {$debug >= $level} {
-	catch {upvar  $arrayvar $arrayvar}
-	parray $arrayvar
-    }
-    return
-}
-
-# tcltest::DebugDo --
-#
-#     Executes the script if the current debug level is greater than
-#       the provided level argument
-#
-# Arguments:
-#     level   The lowest debug level triggering the execution.
-#     script  The tcl script executed upon a debug level high enough.
-#
-# Results:
-#     Arbitrary side effects, dependent on the executed script.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugDo {level script} {
-    variable debug
-
-    if {$debug >= $level} {
-	uplevel $script
-    }
-    return
-}
-
-#####################################################################
-
-# tcltest::CheckDirectory --
-#
-#     This procedure checks whether the specified path is a readable
-#     and/or writable directory. If one of the conditions is not
-#     satisfied an error is printed and the application aborted. The
-#     procedure assumes that the caller already checked the existence
-#     of the path.
-#
-# Arguments
-#     rw      Information what attributes to check. Allowed values:
-#             r, w, rw, wr. If 'r' is part of the value the directory
-#             must be readable. 'w' associates to 'writable'.
-#     dir     The directory to check.
-#     errMsg  The string to prepend to the actual error message before
-#             printing it.
-#
-# Results
-#     none
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::CheckDirectory {rw dir errMsg} {
-    # Allowed values for 'rw': r, w, rw, wr
-
-    if {![file isdir $dir]} {
-	set msg "$errMsg \"$dir\" is not a directory"
-	error $msg
-    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
-	set msg "$errMsg \"$dir\" is not writeable"
-	error $msg
-    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
-	set msg "$errMsg \"$dir\" is not readable"
-	error $msg
-    }
-    return
-}
-
-# tcltest::normalizePath --
-#
-#     This procedure resolves any symlinks in the path thus creating a
-#     path without internal redirection. It assumes that the incoming
-#     path is absolute.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#
-# Results
-#     The path is modified in place.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::normalizePath {pathVar} {
-    upvar $pathVar path
-
-    set oldpwd [pwd]
-    catch {cd $path}
-    set path [pwd]
-    cd $oldpwd
-    return $path
-}
-
-
-# tcltest::MakeAbsolutePath --
-#
-#     This procedure checks whether the incoming path is absolute or not.
-#     Makes it absolute if it was not.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#     prefix  is optional, contains the path to use to make the other an
-#             absolute one. The current working directory is used if it was
-#             not specified.
-#
-# Results
-#     The path is modified in place.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
-    upvar $pathVar path
-
-    if {![string equal [file pathtype $path] "absolute"]} { 
-	if {$prefix == {}} {
-	    set prefix [pwd]
-	}
-
-	set path [file join $prefix $path] 
-    }
-    return $path
-}
-
-#####################################################################
-
-# tcltest::<variableName>
-#     
-#     Accessor functions for tcltest variables that can be modified externally.
-#     These are vars that could otherwise be modified using command line
-#     arguments to tcltest.
-
-# tcltest::verbose --
-#
-#	Set or return the verbosity level (tcltest::verbose) for tests.  This
-#       determines what gets printed to the screen and when, with regard to the
-#       running of the tests.  The proc does not check for invalid values.  It
-#       assumes that a string that doesn't match its predefined keywords
-#       is a string containing letter-specified verbosity levels.
-#
-# Arguments:
-#	A string containing any combination of 'pbste' or a list of keywords
-#       (listed in parens)
-#          p = print output whenever a test passes (pass)
-#          b = print the body of the test when it fails (body)
-#          s = print when a test is skipped (skip)
-#          t = print when a test starts (start)
-#          e = print errorInfo and errorCode when a test encounters an error
-#              (error) 
-#
-# Results:
-#	content of tcltest::verbose - this is always the character combination
-#       (pbste) instead of the list form.
-#
-# Side effects:
-#	None.
-
-proc tcltest::verbose { {level ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::verbose
-    } 
-    if {[llength $level] > 1} {
-  	set tcltest::verbose $level
-    } else {
-	if {[regexp {pass|body|skip|start|error} $level]} {
-	    set tcltest::verbose $level
-	} else { 
-	    set levelList [split $level {}]
-	    set tcltest::verbose [string map {p pass b body s skip t start e
-		error} $levelList]
-	}
-    }
-    return $tcltest::verbose
-}
-
-# tcltest::isVerbose --
-#
-#	Returns true if argument is one of the verbosity levels currently being
-#       used; returns false otherwise.
-#
-# Arguments:
-#	level
-#
-# Results:
-#	boolean 1 (true) or 0 (false), depending on whether or not the level
-#       provided is one of the ones stored in tcltest::verbose.
-#
-# Side effects:
-#	None.
-
-proc tcltest::isVerbose {level} {
-    if {[lsearch -exact [tcltest::verbose] $level] == -1} {
-	return 0
-    }
-    return 1
-}
-
-
-
-# tcltest::match --
-#
-#	Set or return the match patterns (tcltest::match) that determine which
-#       tests are run. 
-#
-# Arguments:
-#	List containing match patterns (glob format)
-#
-# Results:
-#	content of tcltest::match
-#
-# Side effects:
-#	none
-
-proc tcltest::match { {matchList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::match
-    } 
-    set tcltest::match $matchList
-}
-
-# tcltest::skip --
-#
-#	Set or return the skip patterns (tcltest::skip) that determine which
-#       tests are skipped. 
-#
-# Arguments:
-#	List containing skip patterns (glob format)
-#
-# Results:
-#	content of tcltest::skip
-#
-# Side effects:
-#	None.
-
-proc tcltest::skip { {skipList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skip
-    }
-    set tcltest::skip $skipList
-}
-
-# tcltest::matchFiles --
-#
-#	set or return the match patterns for file sourcing
-#
-# Arguments:
-#	list containing match file list (glob format)
-#
-# Results:
-#	content of tcltest::matchFiles
-#
-# Side effects:
-#	None.
-
-proc tcltest::matchFiles { {matchFileList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::matchFiles
-    }
-    set tcltest::matchFiles $matchFileList
-}
-
-# tcltest::skipFiles --
-#
-#	set or return the skip patterns for file sourcing
-#
-# Arguments:
-#	list containing the skip file list (glob format)
-#
-# Results:
-#	content of tcltest::skipFiles
-#
-# Side effects:
-#	None.
-
-proc tcltest::skipFiles { {skipFileList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skipFiles
-    }
-    set tcltest::skipFiles $skipFileList
-}
-
-
-# tcltest::matchDirectories --
-#
-#	set or return the list of directories for matching (glob pattern list)
-#
-# Arguments:
-#	list of glob patterns matching subdirectories of
-#       tcltest::testsDirectory 
-#
-# Results:
-#	content of tcltest::matchDirectories
-#
-# Side effects:
-#	None.
-
-proc tcltest::matchDirectories { {dirlist ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::matchDirectories
-    }
-    set tcltest::matchDirectories $dirlist
-}
-
-# tcltest::skipDirectories --
-#
-#	set or return the list of directories to skip (glob pattern list)
-#
-# Arguments:
-#	list of glob patterns matching directories to skip; these directories
-#       are subdirectories of tcltest::testsDirectory
-#
-# Results:
-#	content of tcltest::skipDirectories
-#
-# Side effects:
-#	None.
-
-proc tcltest::skipDirectories { {dirlist ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skipDirectories
-    }
-    set tcltest::skipDirectories $dirlist
-}
-
-# tcltest::preserveCore --
-#
-#	set or return the core preservation level.  This proc does not do any
-#       error checking for invalid values.
-#
-# Arguments:
-#	core level:
-#         '0' = don't do anything with core files (default)
-#         '1' = notify the user if core files are created
-#         '2' = save any core files produced during testing to
-#               tcltest::temporaryDirectory 
-#
-# Results:
-#	content of tcltest::preserveCore
-#
-# Side effects:
-#	None.
-
-proc tcltest::preserveCore { {coreLevel ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::preserveCore
-    }
-    set tcltest::preserveCore $coreLevel
-}
-
-# tcltest::outputChannel --
-#
-#	set or return the output file descriptor based on the supplied file
-#       name (where tcltest puts all of its output) 
-#
-# Arguments:
-#	output file descriptor
-#
-# Results:
-#	file descriptor corresponding to supplied file name (or currently set
-#       file descriptor, if no new filename was supplied) - this is the content
-#       of tcltest::outputChannel 
-#
-# Side effects:
-#	None.
-
-proc tcltest::outputChannel { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::outputChannel
-    }
-    if {($filename == "stderr") || ($filename == "stdout")} {
-	set tcltest::outputChannel $filename
-    } else {
-	set tcltest::outputChannel [open $filename w]
-    }
-    return $tcltest::outputChannel
-}
-
-# tcltest::outputFile --
-#
-#	set or return the output file name (where tcltest puts all of its
-#       output); calls tcltest::outputChannel to set the corresponding file
-#       descriptor 
-#
-# Arguments:
-#	output file name
-#
-# Results:
-#       file name corresponding to supplied file name (or currently set
-#       file name, if no new filename was supplied) - this is the content
-#       of tcltest::outputFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute with
-#       respect to the predefined temporaryDirectory
-
-proc tcltest::outputFile { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::outputFile
-    }
-    if {($filename != "stderr") && ($filename != "stdout")} {
-	MakeAbsolutePath filename $tcltest::temporaryDirectory
-    }
-    tcltest::outputChannel $filename
-    set tcltest::outputFile $filename
-}
-
-# tcltest::errorChannel --
-#
-#	set or return the error file descriptor based on the supplied file name
-#       (where tcltest sends all its errors)  
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	file descriptor corresponding to the supplied file name (or currently
-#       set file descriptor, if no new filename was supplied) - this is the
-#       content of tcltest::errorChannel
-#
-# Side effects:
-#	opens the descriptor in w mode unless the filename is set to stderr or
-#       stdout 
-
-proc tcltest::errorChannel { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::errorChannel
-    }
-    if {($filename == "stderr") || ($filename == "stdout")} {
-	set tcltest::errorChannel $filename
-    } else {
-	set tcltest::errorChannel [open $filename w]
-    }
-    return $tcltest::errorChannel
-}
-
-# tcltest::errorFile --
-#
-#	set or return the error file name; calls tcltest::errorChannel to set
-#       the corresponding file descriptor
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	content of tcltest::errorFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute with
-#       respect to the predefined temporaryDirectory
-
-proc tcltest::errorFile { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::errorFile
-    }
-    if {($filename != "stderr") && ($filename != "stdout")} {
-	MakeAbsolutePath filename $tcltest::temporaryDirectory
-    }
-    set tcltest::errorFile $filename
-    errorChannel $tcltest::errorFile
-    return $tcltest::errorFile
-}
-
-# tcltest::debug --
-#
-#	set or return the debug level for tcltest; this proc does not check for
-#       invalid values
-#
-# Arguments:
-#	debug level:
-#       '0' = no debug output (default)
-#       '1' = skipped tests
-#       '2' = tcltest variables and supplied flags
-#       '3' = harness operations
-#
-# Results:
-#	content of tcltest::debug
-#
-# Side effects:
-#	None.
-
-proc tcltest::debug { {debugLevel ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::debug
-    }
-    set tcltest::debug $debugLevel
-}
-
-# tcltest::testConstraint --
-#
-#	sets a test constraint to a value; to do multiple constraints, call
-#       this proc multiple times.  also returns the value of the named
-#       constraint if no value was supplied.
-#
-# Arguments:
-#	constraint - name of the constraint
-#       value - new value for constraint (should be boolean) - if not supplied,
-#               this is a query
-#
-# Results:
-#	content of tcltest::testConstraints($constraint)
-#
-# Side effects:
-#	appends the constraint name to tcltest::constraintsSpecified
-
-proc tcltest::testConstraint {constraint {value ""}} {
-    DebugPuts 3 "entering testConstraint $constraint $value"
-    if {[llength [info level 0]] == 2} {
-	return $tcltest::testConstraints($constraint)
-    } 
-    lappend tcltest::constraintsSpecified $constraint
-    set tcltest::testConstraints($constraint) $value
-}
-
-# tcltest::constraintsSpecified --
-#
-#	returns a list of all the constraint names specified using
-#       testConstraint 
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	list of the constraint names in tcltest::constraintsSpecified
-#
-# Side effects:
-#	None.
-
-proc tcltest::constraintsSpecified {} {
-    return $tcltest::constraintsSpecified
-}
-
-# tcltest::constraintList --
-#
-#	returns a list of all the constraint names
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	list of the constraint names in tcltest::testConstraints
-#
-# Side effects:
-#	None.
-
-proc tcltest::constraintList {} {
-    return [array names tcltest::testConstraints]
-}
-
-# tcltest::limitConstraints --
-#
-#	sets the limited constraints to tcltest::limitConstraints
-#
-# Arguments:
-#	list of constraint names
-#
-# Results:
-#	content of tcltest::limitConstraints
-#
-# Side effects:
-#	None.
-
-proc tcltest::limitConstraints { {constraintList ""} } {
-    DebugPuts 3 "entering limitConstraints $constraintList"
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::limitConstraints
-    } 
-    set tcltest::limitConstraints $constraintList
-    foreach elt [tcltest::constraintList] {
-	if {[lsearch -exact [tcltest::constraintsSpecified] $elt] == -1} {
-	    tcltest::testConstraint $elt 0
-	}
-    }
-    return $tcltest::limitConstraints
-}
-
-# tcltest::loadScript --
-#
-#	sets the load script
-#
-# Arguments:
-#	script to be set
-#
-# Results:
-#	contents of tcltest::loadScript
-#
-# Side effects:
-#	None.
-
-proc tcltest::loadScript { {script ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::loadScript
-    }
-    set tcltest::loadScript $script
-}
-
-# tcltest::loadFile --
-#
-#	set the load file (containing the load script); 
-#       put the content of the load file into loadScript
-#
-# Arguments:
-#	script's file name
-#
-# Results:
-#	content of tcltest::loadFile
-#
-# Side effects:
-#	None.
-
-proc tcltest::loadFile { {scriptFile ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::loadFile
-    }
-    MakeAbsolutePath scriptFile $tcltest::temporaryDirectory
-    set tmp [open $scriptFile r]
-    tcltest::loadScript [read $tmp]
-    close $tmp
-    set tcltest::loadFile $scriptFile
-}
-
-# tcltest::workingDirectory --
-#
-#	set workingDirectory to the given path. 
-#       If the path is relative, make it absolute.
-#       change directory to the stated working directory, if resetting the
-#       value 
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::workingDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::workingDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::workingDirectory
-    }
-    set tcltest::workingDirectory $dir
-    MakeAbsolutePath tcltest::workingDirectory
-    cd $tcltest::workingDirectory
-    return $tcltest::workingDirectory
-}
-
-# tcltest::temporaryDirectory --
-#
-#     Set tcltest::temporaryDirectory to the given path.
-#     If the path is relative, make it absolute.  If the file exists but
-#     is not a dir, then return an error.
-#
-#     If tcltest::temporaryDirectory does not already exist, create it.
-#     If you cannot create it, then return an error (the file mkdir isn't
-#     caught and will propagate).
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::temporaryDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::temporaryDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::temporaryDirectory
-    }
-    set tcltest::temporaryDirectory $dir
-
-    MakeAbsolutePath tcltest::temporaryDirectory
-    set tmpDirError "bad argument for temporary directory: "
-
-    if {[file exists $tcltest::temporaryDirectory]} {
-	tcltest::CheckDirectory rw $tcltest::temporaryDirectory $tmpDirError
-    } else {
-	file mkdir $tcltest::temporaryDirectory
-    }
-
-    normalizePath tcltest::temporaryDirectory
-}
-
-# tcltest::testsDirectory --
-#
-#     Set tcltest::testsDirectory to the given path.
-#     If the path is relative, make it absolute.  If the file exists but
-#     is not a dir, then return an error.
-#
-#     If tcltest::testsDirectory does not already exist, return an error.
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::testsDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::testsDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::testsDirectory
-    }
-
-    set tcltest::testsDirectory $dir
-    
-    MakeAbsolutePath tcltest::testsDirectory
-    set testDirError "bad argument for tests directory: "
-
-    if {[file exists $tcltest::testsDirectory]} {
-	tcltest::CheckDirectory r $tcltest::testsDirectory $testDirError
-    } else {
-	set msg "$testDirError \"$tcltest::testsDirectory\" does not exist"
-	error $msg
-    }
-    
-    normalizePath tcltest::testsDirectory
-}
-
-# tcltest::singleProcess --
-#
-#	sets tcltest::singleProcess to the value provided.
-#
-# Arguments:
-#	value for singleProcess:
-#       1 = source each test file into the current process
-#       0 = run each test file in its own process 
-#
-# Results:
-#	content of tcltest::singleProcess
-#
-# Side effects:
-#	None.
-
-proc tcltest::singleProcess { {value ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::singleProcess
-    }
-    set tcltest::singleProcess $value
-}
-
-# tcltest::interpreter --
-#
-#	the interpreter name stored in tcltest::tcltest
-#
-# Arguments:
-#	executable name
-#
-# Results:
-#	content of tcltest::tcltest
-#
-# Side effects:
-#	None.
-
-proc tcltest::interpreter { {interp ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::tcltest
-    }
-    set tcltest::tcltest $interp
-}
-
-# tcltest::mainThread --
-#
-#	sets or returns the thread id stored in tcltest::mainThread
-#
-# Arguments:
-#	thread id
-#
-# Results:
-#	content of tcltest::mainThread
-#
-# Side effects:
-#	None.
-
-proc tcltest::mainThread { {threadid ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::mainThread
-    }
-    set tcltest::mainThread $threadid
-}
-
-#####################################################################
-
-# tcltest::AddToSkippedBecause --
-#
-#	Increments the variable used to track how many tests were skipped
-#       because of a particular constraint.
-#
-# Arguments:
-#	constraint     The name of the constraint to be modified
-#
-# Results:
-#	Modifies tcltest::skippedBecause; sets the variable to 1 if didn't
-#       previously exist - otherwise, it just increments it.
-#
-# Side effects:
-#	None.
-
-proc tcltest::AddToSkippedBecause { constraint {value 1}} {
-    # add the constraint to the list of constraints that kept tests
-    # from running
-
-    if {[info exists tcltest::skippedBecause($constraint)]} {
-	incr tcltest::skippedBecause($constraint) $value
-    } else {
-	set tcltest::skippedBecause($constraint) $value
-    }
-    return
-}
-
-# tcltest::PrintError --
-#
-#	Prints errors to tcltest::errorChannel and then flushes that
-#       channel, making sure that all messages are < 80 characters per line.
-#
-# Arguments:
-#	errorMsg     String containing the error to be printed
-#
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::PrintError {errorMsg} {
-    set InitialMessage "Error:  "
-    set InitialMsgLen  [string length $InitialMessage]
-    puts -nonewline [errorChannel] $InitialMessage
-
-    # Keep track of where the end of the string is.
-    set endingIndex [string length $errorMsg]
-
-    if {$endingIndex < 80} {
-	puts [errorChannel] $errorMsg
-    } else {
-	# Print up to 80 characters on the first line, including the
-	# InitialMessage. 
-	set beginningIndex [string last " " [string range $errorMsg 0 \
-		[expr {80 - $InitialMsgLen}]]]
-	puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
-
-	while {$beginningIndex != "end"} {
-	    puts -nonewline [errorChannel] \
-		    [string repeat " " $InitialMsgLen]  
-	    if {[expr {$endingIndex - $beginningIndex}] < 72} {
-		puts [errorChannel] [string trim \
-			[string range $errorMsg $beginningIndex end]]
-		set beginningIndex end
-	    } else {
-		set newEndingIndex [expr [string last " " [string range \
-			$errorMsg $beginningIndex \
-			[expr {$beginningIndex + 72}]]] + $beginningIndex]
-		if {($newEndingIndex <= 0) \
-			|| ($newEndingIndex <= $beginningIndex)} {
-		    set newEndingIndex end
-		}
-		puts [errorChannel] [string trim \
-			[string range $errorMsg \
-			    $beginningIndex $newEndingIndex]]
-		set beginningIndex $newEndingIndex
-	    }
-	}
-    }
-    flush [errorChannel]
-    return
-}
-
-if {[namespace inscope tcltest info procs initConstraintsHook] == {}} {
-    proc tcltest::initConstraintsHook {} {}
-}
-
-# tcltest::safeFetch --
-#
-#	 The following trace procedure makes it so that we can safely refer to
-#        non-existent members of the tcltest::testConstraints array without 
-#        causing an error.  Instead, reading a non-existent member will return
-#        0. This is necessary because tests are allowed to use constraint "X"
-#        without ensuring that tcltest::testConstraints("X") is defined.
-#
-# Arguments:
-#	n1 - name of the array (tcltest::testConstraints)
-#       n2 - array key value (constraint name)
-#       op - operation performed on tcltest::testConstraints (generally r)
-#
-# Results:
-#	none
-#
-# Side effects:
-#	sets tcltest::testConstraints($n2) to 0 if it's referenced but never
-#       before used
-
-proc tcltest::safeFetch {n1 n2 op} {
-    DebugPuts 3 "entering safeFetch $n1 $n2 $op"
-    if {($n2 != {}) && ([info exists tcltest::testConstraints($n2)] == 0)} {
-	tcltest::testConstraint $n2 0
-    }
-}
-
-# tcltest::initConstraints --
-#
-# Check constraint information that will determine which tests
-# to run.  To do this, create an array tcltest::testConstraints.  Each
-# element has a 0 or 1 value.  If the element is "true" then tests
-# with that constraint will be run, otherwise tests with that constraint
-# will be skipped.  See the tcltest man page for the list of built-in
-# constraints defined in this procedure.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	The tcltest::testConstraints array is reset to have an index for
-#	each built-in test constraint.
-# 
-# Side Effects:
-#       None.
-#
-
-proc tcltest::initConstraints {} {
-    global tcl_platform tcl_interactive tk_version
-
-    # Safely refer to non-existent members of the tcltest::testConstraints
-    # array without causing an error.  
-    trace variable tcltest::testConstraints r tcltest::safeFetch
-
-    tcltest::initConstraintsHook
-
-    tcltest::testConstraint singleTestInterp [singleProcess]
-
-    # All the 'pc' constraints are here for backward compatibility and are not
-    # documented.  They have been replaced with equivalent 'win' constraints.
-
-    tcltest::testConstraint unixOnly \
-	    [string equal $tcl_platform(platform) "unix"]
-    tcltest::testConstraint macOnly \
-	    [string equal $tcl_platform(platform) "macintosh"]
-    tcltest::testConstraint pcOnly \
-	    [string equal $tcl_platform(platform) "windows"]
-    tcltest::testConstraint winOnly \
-	    [string equal $tcl_platform(platform) "windows"]
-
-    tcltest::testConstraint unix [tcltest::testConstraint unixOnly]
-    tcltest::testConstraint mac [tcltest::testConstraint macOnly]
-    tcltest::testConstraint pc [tcltest::testConstraint pcOnly]
-    tcltest::testConstraint win [tcltest::testConstraint winOnly]
-
-    tcltest::testConstraint unixOrPc \
-	    [expr {[tcltest::testConstraint unix] \
-		|| [tcltest::testConstraint pc]}]
-    tcltest::testConstraint macOrPc \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint pc]}]
-    tcltest::testConstraint unixOrWin \
-	    [expr {[tcltest::testConstraint unix] \
-		|| [tcltest::testConstraint win]}]
-    tcltest::testConstraint macOrWin \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint win]}]
-    tcltest::testConstraint macOrUnix \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint unix]}]
-
-    tcltest::testConstraint nt [string equal $tcl_platform(os) "Windows NT"]
-    tcltest::testConstraint 95 [string equal $tcl_platform(os) "Windows 95"]
-    tcltest::testConstraint 98 [string equal $tcl_platform(os) "Windows 98"]
-
-    # The following Constraints switches are used to mark tests that should
-    # work, but have been temporarily disabled on certain platforms because
-    # they don't and we haven't gotten around to fixing the underlying
-    # problem. 
-
-    tcltest::testConstraint tempNotPc \
-	    [expr {![tcltest::testConstraint pc]}]
-    tcltest::testConstraint tempNotWin \
-	    [expr {![tcltest::testConstraint win]}]
-    tcltest::testConstraint tempNotMac \
-	    [expr {![tcltest::testConstraint mac]}]
-    tcltest::testConstraint tempNotUnix \
-	    [expr {![tcltest::testConstraint unix]}]
-
-    # The following Constraints switches are used to mark tests that crash on
-    # certain platforms, so that they can be reactivated again when the
-    # underlying problem is fixed.
-
-    tcltest::testConstraint pcCrash \
-	    [expr {![tcltest::testConstraint pc]}]
-    tcltest::testConstraint winCrash \
-	    [expr {![tcltest::testConstraint win]}]
-    tcltest::testConstraint macCrash \
-	    [expr {![tcltest::testConstraint mac]}]
-    tcltest::testConstraint unixCrash \
-	    [expr {![tcltest::testConstraint unix]}]
-
-    # Skip empty tests
-
-    tcltest::testConstraint emptyTest 0
-
-    # By default, tests that expose known bugs are skipped.
-
-    tcltest::testConstraint knownBug 0
-
-    # By default, non-portable tests are skipped.
-
-    tcltest::testConstraint nonPortable 0
-
-    # Some tests require user interaction.
-
-    tcltest::testConstraint userInteraction 0
-
-    # Some tests must be skipped if the interpreter is not in interactive mode
-    
-    if {[info exists tcl_interactive]} {
-	tcltest::testConstraint interactive $::tcl_interactive
-    } else {
-	tcltest::testConstraint interactive 0
-    }
-
-    # Some tests can only be run if the installation came from a CD image
-    # instead of a web image
-    # Some tests must be skipped if you are running as root on Unix.
-    # Other tests can only be run if you are running as root on Unix.
-
-    tcltest::testConstraint root 0
-    tcltest::testConstraint notRoot 1
-    set user {}
-    if {[string equal $tcl_platform(platform) "unix"]} {
-	catch {set user [exec whoami]}
-	if {[string equal $user ""]} {
-	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
-	}
-	if {([string equal $user "root"]) || ([string equal $user ""])} {
-	    tcltest::testConstraint root 1
-	    tcltest::testConstraint notRoot 0
-	}
-    }
-
-    # Set nonBlockFiles constraint: 1 means this platform supports
-    # ting files into nonblocking mode.
-
-    if {[catch {set f [open defs r]}]} {
-	tcltest::testConstraint nonBlockFiles 1
-    } else {
-	if {[catch {fconfigure $f -blocking off}] == 0} {
-	    tcltest::testConstraint nonBlockFiles 1
-	} else {
-	    tcltest::testConstraint nonBlockFiles 0
-	}
-	close $f
-    }
-
-    # Set asyncPipeClose constraint: 1 means this platform supports
-    # async flush and async close on a pipe.
-    #
-    # Test for SCO Unix - cannot run async flushing tests because a
-    # potential problem with select is apparently interfering.
-    # (Mark Diekhans).
-
-    if {[string equal $tcl_platform(platform) "unix"]} {
-	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
-	    tcltest::testConstraint asyncPipeClose 0
-	} else {
-	    tcltest::testConstraint asyncPipeClose 1
-	}
-    } else {
-	tcltest::testConstraint asyncPipeClose 1
-    }
-
-    # Test to see if we have a broken version of sprintf with respect
-    # to the "e" format of floating-point numbers.
-
-    tcltest::testConstraint eformat 1
-    if {![string equal "[format %g 5e-5]" "5e-05"]} {
-	tcltest::testConstraint eformat 0
-    }
-
-    # Test to see if execed commands such as cat, echo, rm and so forth are
-    # present on this machine.
-
-    tcltest::testConstraint unixExecs 1
-    if {[string equal $tcl_platform(platform) "macintosh"]} {
-	tcltest::testConstraint unixExecs 0
-    }
-    if {([tcltest::testConstraint unixExecs] == 1) && \
-	    ([string equal $tcl_platform(platform) "windows"])} {
-	if {[catch {exec cat defs}] == 1} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec echo hello}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec sh -c echo hello}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec wc defs}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {[tcltest::testConstraint unixExecs] == 1} {
-	    exec echo hello > removeMe
-	    if {[catch {exec rm removeMe}] == 1} {
-		tcltest::testConstraint unixExecs 0
-	    }
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec sleep 1}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec fgrep unixExecs defs}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec ps}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec echo abc > removeMe}] == 0) && \
-		([catch {exec chmod 644 removeMe}] == 1) && \
-		([catch {exec rm removeMe}] == 0)} {
-	    tcltest::testConstraint unixExecs 0
-	} else {
-	    catch {exec rm -f removeMe}
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec mkdir removeMe}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	} else {
-	    catch {exec rm -r removeMe}
-	}
-    }
-
-    # Locate tcltest executable
-
-    if {![info exists tk_version]} {
-	set tcltest::tcltest [info nameofexecutable]
-
-	if {$tcltest::tcltest == "{}"} {
-	    set tcltest::tcltest {}
-	}
-    }
-
-    tcltest::testConstraint stdio 0
-    catch {
-	catch {file delete -force tmp}
-	set f [open tmp w]
-	puts $f {
-	    exit
-	}
-	close $f
-
-	set f [open "|[list $tcltest tmp]" r]
-	close $f
-	
-	tcltest::testConstraint stdio 1
-    }
-    catch {file delete -force tmp}
-
-    # Deliberately call socket with the wrong number of arguments.  The error
-    # message you get will indicate whether sockets are available on this
-    # system. 
-
-    catch {socket} msg
-    tcltest::testConstraint socket \
-	    [expr {$msg != "sockets are not available on this system"}]
-    
-    # Check for internationalization
-
-    if {[info commands testlocale] == ""} {
-	# No testlocale command, no tests...
-	tcltest::testConstraint hasIsoLocale 0
-    } else {
-	tcltest::testConstraint hasIsoLocale \
-		[string length [tcltest::set_iso8859_1_locale]]
-	tcltest::restore_locale
-    }
-}   
-
-#####################################################################
-
-# Handle command line arguments (from argv) and default arg settings 
-# (in TCLTEST_OPTIONS).
-
-# tcltest::PrintUsageInfoHook
-#
-#       Hook used for customization of display of usage information.
-#
-
-if {[namespace inscope tcltest info procs PrintUsageInfoHook] == {}} {
-    proc tcltest::PrintUsageInfoHook {} {}
-}
-
-# tcltest::PrintUsageInfo
-#
-#	Prints out the usage information for package tcltest.  This can be
-#       customized with the redefinition of tcltest::PrintUsageInfoHook.
-#
-# Arguments:
-#	none
-#
-# Results:
-#       none
-#
-# Side Effects: 
-#       none
-
-proc tcltest::PrintUsageInfo {} {
-    puts [format "Usage: [file tail [info nameofexecutable]] \
-	    script ?-help? ?flag value? ... \n\
-	    Available flags (and valid input values) are: \n\
-	    -help          \t Display this usage information. \n\
-	    -verbose level \t Takes any combination of the values \n\
-	    \t                 'p', 's', 'b', 't' and 'e'.  Test suite will \n\
-	    \t                 display all passed tests if 'p' is \n\
-	    \t                 specified, all skipped tests if 's' \n\
-	    \t                 is specified, the bodies of \n\
-	    \t                 failed tests if 'b' is specified, \n\
-	    \t                 and when tests start if 't' is specified. \n\
-	    \t                 ErrorInfo is displayed if 'e' is specified. \n\
-	    \t                 The default value is 'b'. \n\
-	    -constraints list\t Do not skip the listed constraints\n\
-	    -limitconstraints bool\t Only run tests with the constraints\n\
-	    \t                 listed in -constraints.\n\
-	    -match pattern \t Run all tests within the specified \n\
-	    \t                 files that match the glob pattern \n\
-	    \t                 given. \n\
-	    -skip pattern  \t Skip all tests within the set of \n\
-	    \t                 specified tests (via -match) and \n\
-	    \t                 files that match the glob pattern \n\
-	    \t                 given. \n\
-	    -file pattern  \t Run tests in all test files that \n\
-	    \t                 match the glob pattern given. \n\
-	    -notfile pattern\t Skip all test files that match the \n\
-	    \t                 glob pattern given. \n\
-	    -relateddir pattern\t Run tests in directories that match \n\
-	    \t                 the glob pattern given. \n\
-	    -asidefromdir pattern\t Skip tests in directories that match \n\
-	    \t                 the glob pattern given.\n\
-	    -preservecore level \t If 2, save any core files produced \n\
-	    \t                 during testing in the directory \n\
-	    \t                 specified by -tmpdir. If 1, notify the\n\
-	    \t                 user if core files are created. The default \n\
-	    \t                 is $tcltest::preserveCore. \n\
-	    -tmpdir directory\t Save temporary files in the specified\n\
-	    \t                 directory.  The default value is \n\
-	    \t                 $tcltest::temporaryDirectory. \n\
-	    -testdir directories\t Search tests in the specified\n\
-	    \t                 directories.  The default value is \n\
-	    \t                 $tcltest::testsDirectory. \n\
-	    -outfile file    \t Send output from test runs to the \n\
-	    \t                 specified file.  The default is \n\
-	    \t                 stdout. \n\
-	    -errfile file    \t Send errors from test runs to the \n\
-	    \t                 specified file.  The default is \n\
-	    \t                 stderr. \n\
-	    -loadfile file   \t Read the script to load the tested \n\
-	    \t                 commands from the specified file. \n\
-	    -load script     \t Specifies the script to load the tested \n\
-	    \t                 commands. \n\
-	    -debug level     \t Internal debug flag."]
-    tcltest::PrintUsageInfoHook
-    return
-}
-
-# tcltest::processCmdLineArgsFlagsHook --
-#
-#	This hook is used to add to the list of command line arguments that are
-#       processed by tcltest::ProcessFlags.   It is called at the beginning of
-#       ProcessFlags.
-#
-
-if {[namespace inscope tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
-    proc tcltest::processCmdLineArgsAddFlagsHook {} {}
-}
-
-# tcltest::processCmdLineArgsHook --
-#
-#	This hook is used to actually process the flags added by
-#       tcltest::processCmdLineArgsAddFlagsHook.  It is called at the end of
-#       ProcessFlags. 
-#
-# Arguments:
-#	flags      The flags that have been pulled out of argv
-#
-
-if {[namespace inscope tcltest info procs processCmdLineArgsHook] == {}} {
-    proc tcltest::processCmdLineArgsHook {flag} {}
-}
-
-# tcltest::ProcessFlags --
-#
-#	process command line arguments supplied in the flagArray - this is
-#       called by processCmdLineArgs
-#       modifies tcltest variables according to the content of the flagArray.
-#
-# Arguments:
-#	flagArray - array containing name/value pairs of flags
-#
-# Results:
-#	sets tcltest variables according to their values as defined by
-#       flagArray 
-#
-# Side effects:
-#	None.
-
-proc tcltest::ProcessFlags {flagArray} {
-    # Process -help first
-    if {[lsearch -exact $flagArray {-help}] != -1} {
-	tcltest::PrintUsageInfo
-	exit 1
-    }
-    
-    catch {array set flag $flagArray}
-
-    # -help is not listed since it has already been processed
-    lappend defaultFlags -verbose -match -skip -constraints \
-	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints -testdir \
-	    -load -loadfile -asidefromdir \
-	    -relateddir -singleproc
-    set defaultFlags [concat $defaultFlags \
-	    [tcltest::processCmdLineArgsAddFlagsHook ]]
-
-    # Set tcltest::verbose to the arg of the -verbose flag, if given
-    if {[info exists flag(-verbose)]} {
-	tcltest::verbose $flag(-verbose)
-    }
-
-    # Set tcltest::match to the arg of the -match flag, if given.  
-    if {[info exists flag(-match)]} {
-	tcltest::match $flag(-match)
-    } 
-
-    # Set tcltest::skip to the arg of the -skip flag, if given
-    if {[info exists flag(-skip)]} {
-	tcltest::skip $flag(-skip)
-    }
-
-    # Handle the -file and -notfile flags
-    if {[info exists flag(-file)]} {
-	tcltest::matchFiles $flag(-file)
-    }
-    if {[info exists flag(-notfile)]} {
-	tcltest::skipFiles $flag(-notfile)
-    }
-
-    # Handle -relateddir and -asidefromdir flags
-    if {[info exists flag(-relateddir)]} {
-	tcltest::matchDirectories $flag(-relateddir)
-    }
-    if {[info exists flag(-asidefromdir)]} {
-	tcltest::skipDirectories $flag(-asidefromdir)
-    }
-
-    # Use the -constraints flag, if given, to turn on constraints that are
-    # turned off by default: userInteractive knownBug nonPortable.  This
-    # code fragment must be run after constraints are initialized.
-
-    if {[info exists flag(-constraints)]} {
-	foreach elt $flag(-constraints) {
-	    tcltest::testConstraint $elt 1
-	}
-    }
-
-    # Use the -limitconstraints flag, if given, to tell the harness to limit
-    # tests run to those that were specified using the -constraints flag.  If
-    # the -constraints flag was not specified, print out an error and exit.
-    if {[info exists flag(-limitconstraints)]} {
-	if {![info exists flag(-constraints)]} {
-	    set msg "-limitconstraints flag can only be used with -constraints"
-	    error $msg
-	}
-	tcltest::limitConstraints $flag(-limitconstraints)
-    }
-
-    # Set the tcltest::temporaryDirectory to the arg of -tmpdir, if
-    # given.
-
-    if {[info exists flag(-tmpdir)]} {
-	tcltest::temporaryDirectory $flag(-tmpdir)
-    }
-
-    # Set the tcltest::testsDirectory to the arg of -testdir, if
-    # given.
-    
-    if {[info exists flag(-testdir)]} {
-	tcltest::testsDirectory $flag(-testdir)
-    }
-
-    # If an alternate error or output files are specified, change the
-    # default channels.
-
-    if {[info exists flag(-outfile)]} {
-	tcltest::outputFile $flag(-outfile)
-    } 
-
-    if {[info exists flag(-errfile)]} {
-	tcltest::errorFile $flag(-errfile)
-    }
-
-    # If a load script was specified, either directly or through
-    # a file, remember it for later usage.
-    
-    if {[info exists flag(-load)] &&  \
-	    ([lsearch -exact $flagArray -load] > \
-		[lsearch -exact $flagArray -loadfile])} {
-	tcltest::loadScript $flag(-load)
-    }
-    
-    if {[info exists flag(-loadfile)] && \
-	    ([lsearch -exact $flagArray -loadfile] > \
-		[lsearch -exact $flagArray -load]) } {
-	tcltest::loadFile $flag(-loadfile)
-    }
-
-    # If the user specifies debug testing, print out extra information during
-    # the run.
-    if {[info exists flag(-debug)]} {
-	tcltest::debug $flag(-debug)
-    }
-
-    # Handle -preservecore
-    if {[info exists flag(-preservecore)]} {
-	tcltest::preserveCore $flag(-preservecore)
-    }
-
-    # Handle -singleproc flag
-    if {[info exists flag(-singleproc)]} {
-	tcltest::singleProcess $flag(-singleproc)
-    }
-
-    # Call the hook
-    tcltest::processCmdLineArgsHook [array get flag]
-    return
-}
-
-# tcltest::processCmdLineArgs --
-#
-#	Use command line args to set tcltest namespace variables.
-#
-#       This procedure must be run after constraints are initialized, because
-#       some constraints can be overridden.
-# 
-#       Set variables based on the contents of the environment variable
-#       TCLTEST_OPTIONS first, then override with command-line options, if
-#       specified. 
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Sets the above-named variables in the tcltest namespace.
-# 
-# Side Effects:
-#       None.
-#
-
-proc tcltest::processCmdLineArgs {} {
-    global argv
-
-    # If the TCLTEST_OPTIONS environment variable exists, parse it first, then
-    # the argv list.  The command line argument parsing will be a two-pass
-    # affair from now on, so that TCLTEST_OPTIONS contain the default options.
-    # These can be overridden by the command line flags.
-
-    if {[info exists ::env(TCLTEST_OPTIONS)]} {
-	tcltest::ProcessFlags $::env(TCLTEST_OPTIONS)
-    } 
-
-    # The "argv" var doesn't exist in some cases, so use {}.
-    if {(![info exists argv]) || ([llength $argv] < 1)} {
-	set flagArray {}
-    } else {
-	set flagArray $argv
-    }
-    
-    tcltest::ProcessFlags $flagArray
-
-    # Spit out everything you know if we're at a debug level 2 or greater
-    DebugPuts 2 "Flags passed into tcltest:"
-    if {[info exists ::env(TCLTEST_OPTIONS)]} {
-	DebugPuts 2 "    ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
-    }
-    if {[info exists argv]} {
-	DebugPuts 2 "    argv: $argv"
-    }
-    DebugPuts    2 "tcltest::debug              = [tcltest::debug]"
-    DebugPuts    2 "tcltest::testsDirectory     = [tcltest::testsDirectory]"
-    DebugPuts    2 "tcltest::workingDirectory   = [tcltest::workingDirectory]"
-    DebugPuts    2 "tcltest::temporaryDirectory = [tcltest::temporaryDirectory]"
-    DebugPuts    2 "tcltest::outputChannel      = [outputChannel]"
-    DebugPuts    2 "tcltest::errorChannel       = [errorChannel]"
-    DebugPuts    2 "Original environment (tcltest::originalEnv):"
-    DebugPArray  2 tcltest::originalEnv
-    DebugPuts    2 "Constraints:"
-    DebugPArray  2 tcltest::testConstraints
-    return
-}
-
-#####################################################################
-
-# Code to run the tests goes here.
-
-# tcltest::testPuts --
-#
-#	Used to redefine puts in test environment.
-#       Stores whatever goes out on stdout in tcltest::outData and stderr in 
-#       tcltest::errData before sending it on to the regular puts.
-#
-# Arguments:
-#	same as standard puts
-#
-# Results:
-#	none
-#
-# Side effects:
-#       Intercepts puts; data that would otherwise go to stdout, stderr, or
-#       file channels specified in tcltest::outputChannel and errorChannel does
-#       not get sent to the normal puts function.
-
-proc tcltest::testPuts {args} {
-    set len [llength $args]
-    if {$len == 1} {
-	# Only the string to be printed is specified
-	append tcltest::outData "[lindex $args 0]\n"
-	return
-#	return [tcltest::normalPuts [lindex $args 0]]
-    } elseif {$len == 2} {
-	# Either -nonewline or channelId has been specified
-	if {[regexp {^-nonewline} [lindex $args 0]]} {
-	    append tcltest::outData "[lindex $args end]"
-	    return
-#	    return [tcltest::normalPuts -nonewline [lindex $args end]]
-	} else {
-	    set channel [lindex $args 0]
-	}
-    } elseif {$len == 3} {
-	if {[lindex $args 0] == "-nonewline"} {
-	    # Both -nonewline and channelId are specified, unless it's an
-	    # error.  -nonewline is supposed to be argv[0].
-	    set channel [lindex $args 1]
-	}
-    }
-
-    if {[info exists channel]} {
-	if {($channel == [outputChannel]) || ($channel == "stdout")} {
-	    append tcltest::outData "[lindex $args end]\n"
-	} elseif {($channel == [errorChannel]) || ($channel == "stderr")} {
-	    append tcltest::errData "[lindex $args end]\n"
-	}
-	return
-	# return [tcltest::normalPuts [lindex $args 0] [lindex $args end]]
-    }
-
-    # If we haven't returned by now, we don't know how to handle the input.
-    # Let puts handle it.
-    return [eval tcltest::normalPuts $args]
-}
-
-# tcltest::testEval --
-#
-#	Evaluate the script in the test environment.  If ignoreOutput is 
-#       false, store data sent to stderr and stdout in tcltest::outData and 
-#       tcltest::errData.  Otherwise, ignore this output altogether.
-#
-# Arguments:
-#	script             Script to evaluate
-#       ?ignoreOutput?     Indicates whether or not to ignore output sent to
-#                          stdout & stderr
-#
-# Results:
-#	result from running the script
-#
-# Side effects:
-#	Empties the contents of tcltest::outData and tcltest::errData before
-#       running a test if ignoreOutput is set to 0. 
-
-proc tcltest::testEval {script {ignoreOutput 1}} {
-    DebugPuts 3 "testEval called" 
-    if {!$ignoreOutput} {
-	set tcltest::outData {}
-	set tcltest::errData {}
-	uplevel rename ::puts tcltest::normalPuts
-	uplevel rename tcltest::testPuts ::puts
-    }
-    set result [uplevel $script]
-    if {!$ignoreOutput} {
-	uplevel rename ::puts tcltest::testPuts
-	uplevel rename tcltest::normalPuts ::puts
-    }
-    return $result
-}
-
-# compareStrings --
-#
-#	compares the expected answer to the actual answer, depending on the
-#       mode provided.  Mode determines whether a regexp, exact, or glob
-#       comparison is done.
-#
-# Arguments:
-#	actual - string containing the actual result
-#       expected - pattern to be matched against
-#       mode - type of comparison to be done
-#
-# Results:
-#	result of the match
-#
-# Side effects:
-#	None.
-
-proc tcltest::compareStrings {actual expected mode} {
-    switch -- $mode {
-	exact {
-	    set retval [string equal $actual $expected]
-	}
-	glob {
-	    set retval [string match $expected $actual]
-	}
-	regexp {
-	    set retval [regexp -- $expected $actual]
-	}
-    }
-    return $retval
-}
-
-
-#
-# tcltest::substArguments list
-#
-# This helper function takes in a list of words, then perform a
-# substitution on the list as though each word in the list is a
-# separate argument to the Tcl function.  For example, if this
-# function is invoked as:
-#
-#      substArguments {$a {$a}}
-#
-# Then it is as though the function is invoked as:
-#
-#      substArguments $a {$a}
-#
-# This code is adapted from Paul Duffin's function "SplitIntoWords".
-# The original function can be found  on:
-#
-#      http://purl.org/thecliff/tcl/wiki/858.html
-#
-# Results:
-#     a list containing the result of the substitution
-#
-# Exceptions:
-#     An error may occur if the list containing unbalanced quote or
-#     unknown variable.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::substArguments {argList} {
-
-    # We need to split the argList up into tokens but cannot use
-    # list operations as they throw away some significant
-    # quoting, and [split] ignores braces as it should.
-    # Therefore what we do is gradually build up a string out of
-    # whitespace seperated strings. We cannot use [split] to
-    # split the argList into whitespace seperated strings as it
-    # throws away the whitespace which maybe important so we
-    # have to do it all by hand.
-
-    set result {}
-    set token ""
-
-    while {[string length $argList]} {
-        # Look for the next word containing a quote: " { }
-        if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \
-                $argList all]} {
-            # Get the text leading up to this word, but not
-            # including this word, from the argList.
-            set text [string range $argList 0 \
-                    [expr {[lindex $all 0] - 1}]]
-            # Get the word with the quote
-            set word [string range $argList \
-                    [lindex $all 0] [lindex $all 1]]
-
-            # Remove all text up to and including the word from the
-            # argList.
-            set argList [string range $argList \
-                    [expr {[lindex $all 1] + 1}] end]
-        } else {
-            # Take everything up to the end of the argList.
-            set text $argList
-            set word {}
-            set argList {}
-        }
-        
-        if {$token != {}} {
-            # If we saw a word with quote before, then there is a
-            # multi-word token starting with that word.  In this case,
-            # add the text and the current word to this token.
-            append token $text $word
-        } else {
-            # Add the text to the result.  There is no need to parse
-            # the text because it couldn't be a part of any multi-word
-            # token.  Then start a new multi-word token with the word
-            # because we need to pass this token to the Tcl parser to
-            # check for balancing quotes
-            append result $text
-            set token $word
-        }
-        
-        if { [catch {llength $token} length] == 0 && $length == 1} {
-            # The token is a valid list so add it to the result.
-            # lappend result [string trim $token]
-            append result \{$token\}
-            set token {}
-        }
-    }
-
-    # If the last token has not been added to the list then there
-    # is a problem.
-    if { [string length $token] } {
-        error "incomplete token \"$token\""
-    }
-
-    return $result
-}
-
-
-# tcltest::test --
-#
-# This procedure runs a test and prints an error message if the test fails.
-# If tcltest::verbose has been set, it also prints a message even if the
-# test succeeds.  The test will be skipped if it doesn't match the
-# tcltest::match variable, if it matches an element in
-# tcltest::skip, or if one of the elements of "constraints" turns
-# out not to be true.
-# 
-# If testLevel is 1, then this is a top level test, and we record pass/fail
-# information; otherwise, this information is not logged and is not added to
-# running totals.
-# 
-# Attributes:
-#   Only description is a required attribute.  All others are optional.
-#   Default values are indicated.
-# 
-#   constraints -		A list of one or more keywords, each of
-#			        which must be the name of an element in
-#			        the array "tcltest::testConstraints".  If any
-#                               of these elements is zero, the test is
-#                               skipped. This attribute is optional; default is {}
-#   body -		        Script to run to carry out the test.  It must
-#			        return a result that can be checked for
-#			        correctness.  This attribute is optional;
-#                               default is {}
-#   result -	                Expected result from script.  This attribute is
-#                               optional; default is {}.
-#   output -                    Expected output sent to stdout.  This attribute
-#                               is optional; default is {}.  
-#   errorOutput -               Expected output sent to stderr.  This attribute
-#                               is optional; default is {}.  
-#   returnCodes -              Expected return codes.  This attribute is
-#                               optional; default is {0 2}.
-#   setup -                     Code to run before $script (above).  This
-#                               attribute is optional; default is {}.
-#   cleanup -                   Code to run after $script (above).  This
-#                               attribute is optional; default is {}.
-#   match -                     specifies type of matching to do on result,
-#                               output, errorOutput; this must be one of: exact,
-#                               glob, regexp.  default is exact.
-#
-# Arguments:
-#   name -		Name of test, in the form foo-1.2.
-#   description -	Short textual description of the test, to
-#  		  	help humans understand what it does.
-# 
-# Results:
-#	0 if the command ran successfully; 1 otherwise.
-#
-# Side effects:
-#       None.
-# 
-
-proc tcltest::test {name description args} {
-    DebugPuts 3 "Test $name $args"
-
-    incr tcltest::testLevel
-
-    # Pre-define everything to null except output and errorOutput.  We
-    # determine whether or not to trap output based on whether or not these
-    # variables (output & errorOutput) are defined.
-    foreach item {constraints setup cleanup body result returnCodes match} {
-	set $item {}
-    }
-
-    # Set the default match mode
-    set match exact
-
-    # Set the default match values for return codes (0 is the standard expected
-    # return value if everything went well; 2 represents 'return' being used in
-    # the test script).
-    set returnCodes [list 0 2]
-
-    # The old test format can't have a 3rd argument (constraints or script)
-    # that starts with '-'.
-    if {[llength $args] == 0} {
-	puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?options?\"}"
-	incr tcltest::testLevel -1
-	return 1
-    } elseif {([string index [lindex $args 0] 0] == "-") || ([llength $args] == 1)} {
-	
-	if {[llength $args] == 1} {
-	    set list [substArguments [lindex $args 0]]
-	    foreach {element value} $list { 
-		set testAttributes($element) $value
-	    }
-	    foreach item {constraints match setup body cleanup \
-		    result returnCodes output errorOutput} {
-		if {[info exists testAttributes([subst -$item])]} {
-		    set testAttributes([subst -$item]) \
-			    [uplevel concat $testAttributes([subst -$item])]
-		}
-	    }
-	} else {
-	    array set testAttributes $args
-	}
-
-	set validFlags {-setup -cleanup -body -result -returnCodes -match \
-		-output -errorOutput -constraints}
-
-	foreach flag [array names testAttributes] {
-	    if {[lsearch -exact $validFlags $flag] == -1} {
-		puts [errorChannel] "test $name: bad flag $flag supplied to tcltest::test"
-		incr tcltest::testLevel -1
-		return 1
-	    }
-	}
-
-	# store whatever the user gave us
-	foreach item [array names testAttributes] {
-	    set [string trimleft $item "-"] $testAttributes($item)
-	}
-
-	# Check the values supplied for -match
-	if {[lsearch {regexp glob exact} $match] == -1} {
-	    puts [errorChannel] "test $name: {bad value for -match: must be one of exact, glob, regexp}"
-	    incr tcltest::testLevel -1
-	    return 1
-	}
-
-	# Replace symbolic valies supplied for -returnCodes
-	regsub -nocase normal $returnCodes 0 returnCodes
-	regsub -nocase error $returnCodes 1 returnCodes
-	regsub -nocase return $returnCodes 2 returnCodes
-	regsub -nocase break $returnCodes 3 returnCodes
-	regsub -nocase continue $returnCodes 4 returnCodes 
-    } else {
-	# This is parsing for the old test command format; it is here for
-	# backward compatibility.
-	set result [lindex $args end]
-	if {[llength $args] == 2} {
-	    set body [lindex $args 0]
-	} elseif {[llength $args] == 3} {
-	    set constraints [lindex $args 0]
-	    set body [lindex $args 1]
-	} else {
-	    puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?constraints? script expectedResult\"}"
-	    incr tcltest::testLevel -1
-	    return 1
-	}
-    } 
-
-    set setupFailure 0
-    set cleanupFailure 0
-
-    # Run the setup script
-    if {[catch {uplevel $setup} setupMsg]} {
-	set setupFailure 1
-    }
-
-    # run the test script
-    set command [list tcltest::runTest $name $description $body \
-	    $result $constraints]  
-    if {!$setupFailure} {
-	if {[info exists output] || [info exists errorOutput]} {
-	    set testResult [uplevel tcltest::testEval [list $command] 0]
-	} else {
-	    set testResult [uplevel tcltest::testEval [list $command] 1]
-	}
-    } else {
-	set testResult setupFailure
-    }
-
-    # Run the cleanup code
-    if {[catch {uplevel $cleanup} cleanupMsg]} {
-	set cleanupFailure 1
-    }
-
-    # If testResult is an empty list, then the test was skipped
-    if {$testResult != {}} {
-	set coreFailure 0
-	set coreMsg ""
-	# check for a core file first - if one was created by the test, then
-	# the test failed
-	if {$tcltest::preserveCore} {
-	    set currentTclPlatform [array get tcl_platform]
-	    if {[file exists [file join [tcltest::workingDirectory] core]]} {
-		# There's only a test failure if there is a core file and (1)
-		# there previously wasn't one or (2) the new one is different
-		# from the old one. 
-		if {[info exists coreModTime]} {
-		    if {$coreModTime != [file mtime \
-			    [file join [tcltest::workingDirectory] core]]} {
-			set coreFailure 1
-		    } 
-		} else {
-		    set coreFailure 1
-		}
-		
-		if {($tcltest::preserveCore > 1) && ($coreFailure)} {
-		    append coreMsg "\nMoving file to: [file join $tcltest::temporaryDirectory core-$name]"
-		    catch {file rename -force \
-			    [file join [tcltest::workingDirectory] core] \
-			    [file join $tcltest::temporaryDirectory \
-				core-$name]} msg
-		    if {[string length $msg] > 0} {
-			append coreMsg "\nError: Problem renaming core file: $msg"
-		    }
-		}
-	    }
-	    array set tcl_platform $currentTclPlatform
-	}
-
-	set actualAnswer [lindex $testResult 0]
-	set code [lindex $testResult end]
-
-	# If expected output/error strings exist, we have to compare
-	# them.  If the comparison fails, then so did the test.
-	set outputFailure 0
-	set errorFailure 0
-	if {[info exists output]} { 
-	    set outputFailure [expr ![compareStrings $tcltest::outData \
-		    $output $match]]
-	} 
-	if {[info exists errorOutput]} {
-	    set errorFailure [expr ![compareStrings $tcltest::errData \
-		    $errorOutput $match]]
-	}
-
-	set testFailed 1
-	set codeFailure 0
-	set scriptFailure 0
-
-	# check if the return code matched the expected return code
-	if {[lsearch -exact $returnCodes $code] == -1} {
-	    set codeFailure 1
-	} 
-
-	# check if the answer matched the expected answer
-	if {[compareStrings $actualAnswer $result $match] == 0} {
-	    set scriptFailure 1
-	}
-
-	# if we didn't experience any failures, then we passed
-	if {!($setupFailure || $cleanupFailure || $coreFailure || \
-		$outputFailure || $errorFailure || $codeFailure || \
-		$scriptFailure)} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Passed)
-		if {[tcltest::isVerbose pass]} {
-		    puts [outputChannel] "++++ $name PASSED"
-		}
-	    }
-	    set testFailed 0
-	}
-
-	if {$testFailed} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Failed)
-	    }
-	    set tcltest::currentFailure true
-	    if {![tcltest::isVerbose body]} {
-		set body ""
-	    }	
-	    puts [outputChannel] "\n==== $name [string trim $description] FAILED"
-	    if {$body != ""} {
-		puts [outputChannel] "==== Contents of test case:"
-		puts [outputChannel] $body
-	    }
-	    if {$setupFailure} {
-		puts [outputChannel] "---- Test setup failed:\n$setupMsg"
-	    } 
-	    if {$scriptFailure} {
-		puts [outputChannel] "---- Result was:\n$actualAnswer"
-		puts [outputChannel] "---- Result should have been ($match matching):\n$result"
-	    }
-	    if {$codeFailure} {
-		switch -- $code {
-		    0 { set msg "Test completed normally" }
-		    1 { set msg "Test generated error" }
-		    2 { set msg "Test generated return exception" }
-		    3 { set msg "Test generated break exception" }
-		    4 { set msg "Test generated continue exception" } 
-		    default { set msg "Test generated exception" }
-		}
-		puts [outputChannel] "---- $msg; Return code was: $code"
-		puts [outputChannel] "---- Return code should have been one of: $returnCodes"
-		if {[tcltest::isVerbose error]} {
-		    if {[info exists ::errorInfo]} {
-			puts [outputChannel] "---- errorInfo: $::errorInfo"
-			puts [outputChannel] "---- errorCode: $::errorCode"
-		    }
-		}
-	    }
-	    if {$outputFailure} {
-		puts [outputChannel] "---- Output was:\n$tcltest::outData"
-		puts [outputChannel] "---- Output should have been ($match matching):\n$output"
-	    }
-	    if {$errorFailure} {
-		puts [outputChannel] "---- Error output was:\n$tcltest::errData"
-		puts [outputChannel] "---- Error output should have been ($match matching):\n$errorOutput"
-	    }
-	    if {$cleanupFailure} {
-		puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
-	    }
-	    if {$coreFailure} {
-		puts [outputChannel] "---- Core file produced while running test! $coreMsg"
-	    }
-	    puts [outputChannel] "==== $name FAILED\n"
-
-	}
-    }
-    
-    incr tcltest::testLevel -1
-    return 0
-}
-
-
-# runTest --
-#
-# This is the defnition of the version 1.0 test routine for tcltest.  It is
-# provided here for backward compatibility.  It is also used as the 'backbone'
-# of the test procedure, as in, this is where all the work really gets done.
-# 
-# This procedure runs a test and prints an error message if the test fails.
-# If tcltest::verbose has been set, it also prints a message even if the
-# test succeeds.  The test will be skipped if it doesn't match the
-# tcltest::match variable, if it matches an element in
-# tcltest::skip, or if one of the elements of "constraints" turns
-# out not to be true.
-#
-# Arguments:
-# name -		Name of test, in the form foo-1.2.
-# description -		Short textual description of the test, to
-#			help humans understand what it does.
-# constraints -		A list of one or more keywords, each of
-#			which must be the name of an element in
-#			the array "tcltest::testConstraints".  If any of these
-#			elements is zero, the test is skipped.
-#			This argument may be omitted.
-# script -		Script to run to carry out the test.  It must
-#			return a result that can be checked for
-#			correctness.
-# expectedAnswer -	Expected result from script.
-# 
-# Behavior depends on the value of testLevel; if testLevel is 1 (top level),
-# then events are logged and we track the number of tests run/skipped and why.
-# Otherwise, we don't track this information.
-# 
-# Results:
-#    empty list if test is skipped; otherwise returns list containing
-#    actual returned value from the test and the return code.
-# 
-# Side Effects:
-#    none.
-#
-
-proc tcltest::runTest {name description script expectedAnswer constraints} {
-
-    if {$tcltest::testLevel == 1} {
-	incr tcltest::numTests(Total)
-    }
-    
-    # skip the test if it's name matches an element of skip
-    foreach pattern $tcltest::skip {
-	if {[string match $pattern $name]} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedSkip}
-	    }
-	    return
-	}
-    }
-
-    # skip the test if it's name doesn't match any element of match
-    if {[llength $tcltest::match] > 0} {
-	set ok 0
-	foreach pattern $tcltest::match {
-	    if {[string match $pattern $name]} {
-		set ok 1
-		break
-	    }
-        }
-	if {!$ok} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedNonMatch}
-	    }
-	    return
-	}
-    }
-
-    DebugPuts 3 "Running $name ($description) {$script} {$expectedAnswer} $constraints"
-
-    if {$constraints == {}} {
-	# If we're limited to the listed constraints and there aren't any
-	# listed, then we shouldn't run the test.
-	if {$tcltest::limitConstraints} {
-	    tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-	    }
-	    return
-	}
-    } else {
-	# "constraints" argument exists; 
-	# make sure that the constraints are satisfied.
-
-	set doTest 0
-	if {[string match {*[$\[]*} $constraints] != 0} {
-	    # full expression, e.g. {$foo > [info tclversion]}
-	    catch {set doTest [uplevel #0 expr $constraints]}
-	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
-	    # something like {a || b} should be turned into 
-	    # $tcltest::testConstraints(a) || $tcltest::testConstraints(b).
-	    regsub -all {[.\w]+} $constraints \
-		    {$tcltest::testConstraints(&)} c
-	    catch {set doTest [eval expr $c]}
-	} else {
-	    # just simple constraints such as {unixOnly fonts}.
-	    set doTest 1
-	    foreach constraint $constraints {
-		if {(![info exists tcltest::testConstraints($constraint)]) \
-			|| (!$tcltest::testConstraints($constraint))} {
-		    set doTest 0
-
-		    # store the constraint that kept the test from running
-		    set constraints $constraint
-		    break
-		}
-	    }
-	}
-	
-	if {$doTest == 0} {
-	    if {[tcltest::isVerbose skip]} {
-		puts [outputChannel] "++++ $name SKIPPED: $constraints"
-	    }
-	    
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		tcltest::AddToSkippedBecause $constraints
-	    }
-	    return	
-	}
-    }
-
-    # Save information about the core file.  You need to restore the original
-    # tcl_platform environment because some of the tests mess with
-    # tcl_platform.
-
-    if {$tcltest::preserveCore} {
-	set currentTclPlatform [array get tcl_platform]
-	array set tcl_platform $tcltest::originalTclPlatform
-	if {[file exists [file join [tcltest::workingDirectory] core]]} {
-	    set coreModTime [file mtime [file join \
-		    [tcltest::workingDirectory] core]]
-	}
-	array set tcl_platform $currentTclPlatform
-    }
-
-    # If there is no "memory" command (because memory debugging isn't
-    # enabled), then don't attempt to use the command.
-    
-    if {[info commands memory] != {}} {
-	memory tag $name
-    }
-
-    if {[tcltest::isVerbose start]} {
-	puts [outputChannel] "---- $name start"
-	flush [outputChannel]
-    }
-    
-    set code [catch {uplevel $script} actualAnswer]
-	    
-    return [list $actualAnswer $code]
-}
-
-#####################################################################
-
-# tcltest::cleanupTestsHook --
-#
-#	This hook allows a harness that builds upon tcltest to specify
-#       additional things that should be done at cleanup.
-#
-
-if {[namespace inscope tcltest info procs cleanupTestsHook] == {}} {
-    proc tcltest::cleanupTestsHook {} {}
-}
-
-# tcltest::cleanupTests --
-#
-# 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 tests were invoked.
-#
-# Print the number tests (total, passed, failed, and skipped) since the
-# tests were invoked.
-# 
-# Restore original environment (as reported by special variable env).
-# 
-# Arguments:
-#      calledFromAllFile - if 0, behave as if we are running a single test file
-#      within an entire suite of tests.  if we aren't running a single test
-#      file, then don't report status.  check for new files created during the
-#      test run and report on them.  if 1, report collated status from all the
-#      test file runs.
-# 
-# Results: 
-#      None.
-# 
-# Side Effects: 
-#      None
-# 
-
-proc tcltest::cleanupTests {{calledFromAllFile 0}} {
-
-    set testFileName [file tail [info script]]
-
-    # Call the cleanup hook
-    tcltest::cleanupTestsHook 
-
-    # Remove files and directories created by the :tcltest::makeFile and
-    # tcltest::makeDirectory procedures.
-    # Record the names of files in tcltest::workingDirectory that were not
-    # pre-existing, and associate them with the test file that created them.
-
-    if {!$calledFromAllFile} {
-	foreach file $tcltest::filesMade {
-	    if {[file exists $file]} {
-		catch {file delete -force $file}
-	    }
-	}
-	set currentFiles {}
-	foreach file [glob -nocomplain \
-		[file join $tcltest::temporaryDirectory *]] {
-	    lappend currentFiles [file tail $file]
-	}
-	set newFiles {}
-	foreach file $currentFiles {
-	    if {[lsearch -exact $tcltest::filesExisted $file] == -1} {
-		lappend newFiles $file
-	    }
-	}
-	set tcltest::filesExisted $currentFiles
-	if {[llength $newFiles] > 0} {
-	    set tcltest::createdNewFiles($testFileName) $newFiles
-	}
-    }
-
-    if {$calledFromAllFile || $tcltest::testSingleFile} {
-
-	# print stats
-
-	puts -nonewline [outputChannel] "$testFileName:"
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    puts -nonewline [outputChannel] \
-		    "\t$index\t$tcltest::numTests($index)"
-	}
-	puts [outputChannel] ""
-
-	# print number test files sourced
-	# print names of files that ran tests which failed
-
-	if {$calledFromAllFile} {
-	    puts [outputChannel] \
-		    "Sourced $tcltest::numTestFiles Test Files."
-	    set tcltest::numTestFiles 0
-	    if {[llength $tcltest::failFiles] > 0} {
-		puts [outputChannel] \
-			"Files with failing tests: $tcltest::failFiles"
-		set tcltest::failFiles {}
-	    }
-	}
-
-	# if any tests were skipped, print the constraints that kept them
-	# from running.
-
-	set constraintList [array names tcltest::skippedBecause]
-	if {[llength $constraintList] > 0} {
-	    puts [outputChannel] \
-		    "Number of tests skipped for each constraint:"
-	    foreach constraint [lsort $constraintList] {
-		puts [outputChannel] \
-			"\t$tcltest::skippedBecause($constraint)\t$constraint"
-		unset tcltest::skippedBecause($constraint)
-	    }
-	}
-
-	# report the names of test files in tcltest::createdNewFiles, and
-	# reset the array to be empty.
-
-	set testFilesThatTurded [lsort [array names tcltest::createdNewFiles]]
-	if {[llength $testFilesThatTurded] > 0} {
-	    puts [outputChannel] "Warning: files left behind:"
-	    foreach testFile $testFilesThatTurded {
-		puts [outputChannel] \
-			"\t$testFile:\t$tcltest::createdNewFiles($testFile)"
-		unset tcltest::createdNewFiles($testFile)
-	    }
-	}
-
-	# reset filesMade, filesExisted, and numTests
-
-	set tcltest::filesMade {}
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    set tcltest::numTests($index) 0
-	}
-
-	# exit only if running Tk in non-interactive mode
-
-	global tk_version tcl_interactive
-	if {[info exists tk_version] && ![info exists tcl_interactive]} {
-	    exit
-	}
-    } 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 tcltest::numTestFiles
-	if {($tcltest::currentFailure) && \
-		([lsearch -exact $tcltest::failFiles $testFileName] == -1)} {
-	    lappend tcltest::failFiles $testFileName
-	}
-	set tcltest::currentFailure false
-
-	# restore the environment to the state it was in before this package
-	# was loaded
-
-	set newEnv {}
-	set changedEnv {}
-	set removedEnv {}
-	foreach index [array names ::env] {
-	    if {![info exists tcltest::originalEnv($index)]} {
-		lappend newEnv $index
-		unset ::env($index)
-	    } else {
-		if {$::env($index) != $tcltest::originalEnv($index)} {
-		    lappend changedEnv $index
-		    set ::env($index) $tcltest::originalEnv($index)
-		}
-	    }
-	}
-	foreach index [array names tcltest::originalEnv] {
-	    if {![info exists ::env($index)]} {
-		lappend removedEnv $index
-		set ::env($index) $tcltest::originalEnv($index)
-	    }
-	}
-	if {[llength $newEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements created:\t$newEnv"
-	}
-	if {[llength $changedEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements changed:\t$changedEnv"
-	}
-	if {[llength $removedEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements removed:\t$removedEnv"
-	}
-
-	set changedTclPlatform {}
-	foreach index [array names tcltest::originalTclPlatform] {
-	    if {$::tcl_platform($index) != \
-		    $tcltest::originalTclPlatform($index)} { 
-		lappend changedTclPlatform $index
-		set ::tcl_platform($index) \
-			$tcltest::originalTclPlatform($index) 
-	    }
-	}
-	if {[llength $changedTclPlatform] > 0} {
-	    puts [outputChannel] \
-		    "tcl_platform array elements changed:\t$changedTclPlatform"
-	} 
-
-	if {[file exists [file join [tcltest::workingDirectory] core]]} {
-	    if {$tcltest::preserveCore > 1} {
-		puts "rename core file (> 1)" 
-		puts [outputChannel] "produced core file! \
-			Moving file to: \
-			[file join $tcltest::temporaryDirectory core-$name]"
-		catch {file rename -force \
-			[file join [tcltest::workingDirectory] core] \
-			[file join $tcltest::temporaryDirectory \
-			    core-$name]} msg
-		if {[string length $msg] > 0} {
-		    tcltest::PrintError "Problem renaming file: $msg"
-		}
-	    } else {
-		# Print a message if there is a core file and (1) there
-		# previously wasn't one or (2) the new one is different from
-		# the old one. 
-
-		if {[info exists tcltest::coreModificationTime]} {
-		    if {$tcltest::coreModificationTime != [file mtime \
-			    [file join [tcltest::workingDirectory] core]]} {
-			puts [outputChannel] "A core file was created!"
-		    }
-		} else {
-		    puts [outputChannel] "A core file was created!"
-		} 
-	    }
-	}
-    }
-    flush [outputChannel]
-    flush [errorChannel]
-    return
-}
-
-#####################################################################
-
-# Procs that determine which tests/test files to run
-
-# tcltest::getMatchingFiles
-#
-#       Looks at the patterns given to match and skip files
-#       and uses them to put together a list of the tests that will be run.
-#
-# Arguments:
-#       directory to search
-#
-# Results:
-#       The constructed list is returned to the user.  This will primarily
-#       be used in 'all.tcl' files.  It is used in runAllTests.
-# 
-# Side Effects:
-#       None
-
-proc tcltest::getMatchingFiles { {searchDirectory ""} } {
-    if {[llength [info level 0]] == 1} {
-	set searchDirectory [tcltest::testsDirectory]
-    }
-    set matchingFiles {}
-
-    # Find the matching files in the list of directories and then remove the
-    # ones that match the skip pattern
-    foreach directory $searchDirectory {
-	set matchFileList {}
-	foreach match $tcltest::matchFiles {
-	    set matchFileList [concat $matchFileList \
-		    [glob -nocomplain [file join $directory $match]]]
-	}
-	if {[string compare {} $tcltest::skipFiles]} {
-	    set skipFileList {}
-	    foreach skip $tcltest::skipFiles {
-		set skipFileList [concat $skipFileList \
-			[glob -nocomplain [file join $directory $skip]]]
-	    }
-	    foreach file $matchFileList {
-		# Only include files that don't match the skip pattern and
-		# aren't SCCS lock files.
-		if {([lsearch -exact $skipFileList $file] == -1) && \
-			(![string match l.*.test [file tail $file]])} {
-		    lappend matchingFiles $file
-		}
-	    }
-	} else {
-	    set matchingFiles [concat $matchingFiles $matchFileList]
-	}
-    }
-    if {[string equal $matchingFiles {}]} {
-	tcltest::PrintError "No test files remain after applying \
-		your match and skip patterns!"
-    }
-    return $matchingFiles
-}
-
-# tcltest::getMatchingDirectories --
-#
-#	Looks at the patterns given to match and skip directories and uses them
-#       to put together a list of the test directories that we should attempt
-#       to run.  (Only subdirectories containing an "all.tcl" file are put into
-#       the list.)
-#
-# Arguments:
-#	root directory from which to search
-#
-# Results:
-#	The constructed list is returned to the user.  This is used in the
-#       primary all.tcl file.  Lower-level all.tcl files should use the
-#       tcltest::testAllFiles proc instead.
-# 
-# Side Effects: 
-#       None.
-
-proc tcltest::getMatchingDirectories {rootdir} {
-    set matchingDirs {}
-    set matchDirList {}
-    # Find the matching directories in tcltest::testsDirectory and then
-    # remove the ones that match the skip pattern
-    foreach match $tcltest::matchDirectories {
-	foreach file [glob -nocomplain [file join $rootdir $match]] {
-	    if {([file isdirectory $file]) && ($file != $rootdir)} {
-		set matchDirList [concat $matchDirList \
-			[tcltest::getMatchingDirectories $file]]
-		if {[file exists [file join $file all.tcl]]} {
-		    set matchDirList [concat $matchDirList $file]
-		}
-	    }
-	}
-    }
-    if {$tcltest::skipDirectories != {}} {
-	set skipDirs {} 
-	foreach skip $tcltest::skipDirectories {
-	    set skipDirs [concat $skipDirs \
-		    [glob -nocomplain [file join $tcltest::testsDirectory \
-			$skip]]]
-	}
-	foreach dir $matchDirList {
-	    # Only include directories that don't match the skip pattern
-	    if {[lsearch -exact $skipDirs $dir] == -1} {
-		lappend matchingDirs $dir
-	    }
-	}
-    } else {
-	set matchingDirs [concat $matchingDirs $matchDirList]
-    }
-    if {$matchingDirs == {}} {
-	DebugPuts 1 "No test directories remain after applying match and skip patterns!"
-    }
-    return $matchingDirs
-}
-
-# tcltest::runAllTests --
-#
-#	prints output and sources test files according to the match and skip
-#       patterns provided.  after sourcing test files, it goes on to source
-#       all.tcl files in matching test subdirectories.
-#
-# Arguments:
-#	shell being tested
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::runAllTests { {shell ""} } {
-    global argv
-
-    if {[llength [info level 0]] == 1} {
-	set shell [tcltest::interpreter]
-    }
-
-    set tcltest::testSingleFile false
-
-    puts [outputChannel] "Tests running in interp:  $shell"
-    puts [outputChannel] "Tests located in:  $tcltest::testsDirectory"
-    puts [outputChannel] "Tests running in:  [tcltest::workingDirectory]"
-    puts [outputChannel] "Temporary files stored in $tcltest::temporaryDirectory"
-    if {[tcltest::singleProcess]} {
-	puts [outputChannel] "Test files sourced into current interpreter"
-    } else {
-	puts [outputChannel] "Test files run in separate interpreters"
-    }
-    if {[llength $tcltest::skip] > 0} {
-	puts [outputChannel] "Skipping tests that match:  $tcltest::skip"
-    }
-    if {[llength $tcltest::match] > 0} {
-	puts [outputChannel] "Only running tests that match:  $tcltest::match"
-    }
-
-    if {[llength $tcltest::skipFiles] > 0} {
-	puts [outputChannel] "Skipping test files that match:  $tcltest::skipFiles"
-    }
-    if {[llength $tcltest::matchFiles] > 0} {
-	puts [outputChannel] "Only running test files that match:  $tcltest::matchFiles"
-    }
-
-    set timeCmd {clock format [clock seconds]}
-    puts [outputChannel] "Tests began at [eval $timeCmd]"
-
-    # Run each of the specified tests
-    foreach file [lsort [tcltest::getMatchingFiles]] {
-	set tail [file tail $file]
-	puts [outputChannel] $tail
-
-	if {$tcltest::singleProcess} {
-	    incr tcltest::numTestFiles
-	    uplevel [list source $file]
-	} else {
-	    # Change to the tests directory so the value of the following
-	    # variable is set correctly when we spawn the child test processes
-	    cd $tcltest::testsDirectory
-	    set cmd [concat [list | $shell $file] [split $argv]]
-	    if {[catch {
-		incr tcltest::numTestFiles
-		set pipeFd [open $cmd "r"] 
-		while {[gets $pipeFd line] >= 0} {
-		    if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
-			foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-			    incr tcltest::numTests($index) [set $index]
-			}
-			if {$Failed > 0} {
-			    lappend tcltest::failFiles $testFile
-			}
-		    } elseif {[regexp {^Number of tests skipped for each constraint:|^\t(\d+)\t(.+)$} $line match skipped constraint]} {
-			if {$match != "Number of tests skipped for each constraint:"} {
-			    tcltest::AddToSkippedBecause $constraint $skipped
-			}
-		    } else {
-			puts [outputChannel] $line
-		    }
-		}
-		close $pipeFd
-	    } msg]} {
-		# Print results to tcltest::outputChannel.
-		puts [outputChannel] "Test file error: $msg"
-		# append the name of the test to a list to be reported later
-		lappend testFileFailures $file 
-	    }
-	}
-    }
-
-    # cleanup
-    puts [outputChannel] "\nTests ended at [eval $timeCmd]"
-    tcltest::cleanupTests 1
-    if {[info exists testFileFailures]} {
-	puts [outputChannel] "\nTest files exiting with errors:  \n"
-	foreach file $testFileFailures {
-	    puts "  [file tail $file]\n"
-	}
-    }
-
-    # Checking for subdirectories in which to run tests
-    foreach directory [tcltest::getMatchingDirectories $tcltest::testsDirectory] {
-	set dir [file tail $directory]
-	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-	puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
-	
-	uplevel "source [file join $directory all.tcl]"
-	
-	set endTime [eval $timeCmd]
-	puts [outputChannel] "\n$dir test ended at $endTime"
-	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    }
-    return
-}
-
-#####################################################################
-
-# Test utility procs - not used in tcltest, but may be useful for testing.
-
-# tcltest::loadTestedCommands --
-#
-#     Uses the specified script to load the commands to test. Allowed to
-#     be empty, as the tested commands could have been compiled into the
-#     interpreter.
-#
-# Arguments
-#     none
-#
-# Results
-#     none
-# 
-# Side Effects: 
-#     none.
-
-proc tcltest::loadTestedCommands {} {
-    if {$tcltest::loadScript == {}} {
-	return
-    }
-    
-    return [uplevel $tcltest::loadScript]
-}
-
-# tcltest::saveState --
-#
-#	Save information regarding what procs and variables exist.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Modifies the variable tcltest::saveState
-#
-# Side effects:
-#	None.
-
-proc tcltest::saveState {} {
-    uplevel {set tcltest::saveState [list [info procs] [info vars]]}
-    DebugPuts  2 "tcltest::saveState: $tcltest::saveState"
-    return
-}
-
-# tcltest::restoreState --
-#
-#	Remove procs and variables that didn't exist before the call to
-#       tcltest::saveState.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Removes procs and variables from your environment if they don't exist
-#       in the tcltest::saveState variable.
-#
-# Side effects:
-#	None.
-
-proc tcltest::restoreState {} {
-    foreach p [info procs] {
-	if {([lsearch [lindex $tcltest::saveState 0] $p] < 0) && \
-		(![string match "*tcltest::$p" [namespace origin $p]])} {
-	    
-	    DebugPuts 2 "tcltest::restoreState: Removing proc $p"
-	    rename $p {}
-	}
-    }
-    foreach p [uplevel {info vars}] {
-	if {[lsearch [lindex $tcltest::saveState 1] $p] < 0} {
-	    DebugPuts 2 "tcltest::restoreState: Removing variable $p"
-	    uplevel "catch {unset $p}"
-	}
-    }
-    return
-}
-
-# tcltest::normalizeMsg --
-#
-#	Removes "extra" newlines from a string.
-#
-# Arguments:
-#	msg        String to be modified
-#
-# Results:
-#	string with extra newlines removed
-#
-# Side effects:
-#	None.
-
-proc tcltest::normalizeMsg {msg} {
-    regsub "\n$" [string tolower $msg] "" msg
-    regsub -all "\n\n" $msg "\n" msg
-    regsub -all "\n\}" $msg "\}" msg
-    return $msg
-}
-
-# tcltest::makeFile --
-#
-# Create a new file with the name <name>, and write <contents> to it.
-#
-# If this file hasn't been created via makeFile since the last time
-# cleanupTests was called, add it to the $filesMade list, so it will
-# be removed by the next call to cleanupTests.
-#
-# Arguments:
-#	contents        content of the new file
-#       name            name of the new file
-#       directory       directory name for new file 
-#
-# Results:
-#	absolute path to the file created
-#
-# Side effects:
-#	None.
-
-proc tcltest::makeFile {contents name {directory ""}} {
-    global tcl_platform
-
-    if {[llength [info level 0]] == 3} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    
-    set fullName [file join $directory $name]
-
-    DebugPuts 3 "tcltest::makeFile: putting $contents into $fullName"
-
-    set fd [open $fullName w]
-
-    fconfigure $fd -translation lf
-
-    if {[string equal [string index $contents end] "\n"]} {
-	puts -nonewline $fd $contents
-    } else {
-	puts $fd $contents
-    }
-    close $fd
-
-    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
-	lappend tcltest::filesMade $fullName
-    }
-    return $fullName
-}
-
-# tcltest::removeFile --
-#
-#	Removes the named file from the filesystem
-#
-# Arguments:
-#	name          file to be removed
-#       directory     directory from which to remove file
-#
-# Results:
-#	return value from [file delete]
-#
-# Side effects:
-#	None.
-
-proc tcltest::removeFile {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::removeFile: removing $fullName"
-    return [file delete $fullName]
-}
-
-# tcltest::makeDirectory --
-#
-# Create a new dir with the name <name>.
-#
-# If this dir hasn't been created via makeDirectory since the last time
-# cleanupTests was called, add it to the $directoriesMade list, so it will
-# be removed by the next call to cleanupTests.
-#
-# Arguments:
-#       name            name of the new directory
-#       directory       directory in which to create new dir
-#
-# Results:
-#	absolute path to the directory created
-#
-# Side effects:
-#	None.
-
-proc tcltest::makeDirectory {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::makeDirectory: creating $fullName"
-    file mkdir $fullName
-    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
-	lappend tcltest::filesMade $fullName
-    }
-    return $fullName
-}
-
-# tcltest::removeDirectory --
-#
-#	Removes a named directory from the file system.
-#
-# Arguments:
-#	name          Name of the directory to remove
-#       directory     Directory from which to remove
-#
-# Results:
-#	return value from [file delete]
-#
-# Side effects:
-#	None
-
-proc tcltest::removeDirectory {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::removeDirectory: deleting $fullName"
-    return [file delete -force $fullName]
-}
-
-# tcltest::viewFile --
-#
-#	reads the content of a file and returns it
-#
-# Arguments:
-#	name of the file to read
-#       directory in which file is located
-#
-# Results:
-#	content of the named file
-#
-# Side effects:
-#	None.
-
-proc tcltest::viewFile {name {directory ""}} {
-    global tcl_platform
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    if {([string equal $tcl_platform(platform) "macintosh"]) || \
-	    ([tcltest::testConstraint unixExecs] == 0)} {
-	set f [open $fullName]
-	set data [read -nonewline $f]
-	close $f
-	return $data
-    } else {
-	return [exec cat $fullName]
-    }
-    return
-}
-
-# tcltest::bytestring --
-#
-# Construct a string that consists of the requested sequence of bytes,
-# as opposed to a string of properly formed UTF-8 characters.  
-# This allows the tester to 
-# 1. Create denormalized or improperly formed strings to pass to C procedures 
-#    that are supposed to accept strings with embedded NULL bytes.
-# 2. Confirm that a string result has a certain pattern of bytes, for instance
-#    to confirm that "\xe0\0" in a Tcl script is stored internally in 
-#    UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
-#
-# Generally, it's a bad idea to examine the bytes in a Tcl string or to
-# construct improperly formed strings in this manner, because it involves
-# exposing that Tcl uses UTF-8 internally.
-#
-# Arguments:
-#	string being converted
-#
-# Results:
-#	result fom encoding
-#
-# Side effects:
-#	None
-
-proc tcltest::bytestring {string} {
-    return [encoding convertfrom identity $string]
-}
-
-# tcltest::openfiles --
-#
-#	used in io tests, uses testchannel
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	???
-#
-# Side effects:
-#	None.
-
-proc tcltest::openfiles {} {
-    if {[catch {testchannel open} result]} {
-	return {}
-    }
-    return $result
-}
-
-# tcltest::leakfiles --
-#
-#	used in io tests, uses testchannel
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	???
-#
-# Side effects:
-#	None.
-
-proc tcltest::leakfiles {old} {
-    if {[catch {testchannel open} new]} {
-	return {}
-    }
-    set leak {}
-    foreach p $new {
-	if {[lsearch $old $p] < 0} {
-	    lappend leak $p
-	}
-    }
-    return $leak
-}
-
-#
-# Internationalization / ISO support procs     -- dl
-#
-
-# tcltest::set_iso8859_1_locale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::set_iso8859_1_locale {} {
-    if {[info commands testlocale] != ""} {
-	set tcltest::previousLocale [testlocale ctype]
-	testlocale ctype $tcltest::isoLocale
-    }
-    return
-}
-
-# tcltest::restore_locale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::restore_locale {} {
-    if {[info commands testlocale] != ""} {
-	testlocale ctype $tcltest::previousLocale
-    }
-    return
-}
-
-# tcltest::threadReap --
-#
-#	Kill all threads except for the main thread.
-#	Do nothing if testthread is not defined.
-#
-# Arguments:
-#	none.
-#
-# Results:
-#	Returns the number of existing threads.
-# 
-# Side Effects: 
-#       none.
-#
-
-proc tcltest::threadReap {} {
-    if {[info commands testthread] != {}} {
-
-	# testthread built into tcltest
-
-	testthread errorproc ThreadNullError
-	while {[llength [testthread names]] > 1} {
-	    foreach tid [testthread names] {
-		if {$tid != $tcltest::mainThread} {
-		    catch {testthread send -async $tid {testthread exit}}
-		}
-	    }
-	    ## Enter a bit a sleep to give the threads enough breathing
-	    ## room to kill themselves off, otherwise the end up with a
-	    ## massive queue of repeated events
-	    after 1
-	}
-	testthread errorproc ThreadError
-	return [llength [testthread names]]
-    } elseif {[info commands thread::id] != {}} {
-	
-	# Thread extension
-
-	thread::errorproc ThreadNullError
-	while {[llength [thread::names]] > 1} {
-	    foreach tid [thread::names] {
-		if {$tid != $tcltest::mainThread} {
-		    catch {thread::send -async $tid {thread::exit}}
-		}
-	    }
-	    ## Enter a bit a sleep to give the threads enough breathing
-	    ## room to kill themselves off, otherwise the end up with a
-	    ## massive queue of repeated events
-	    after 1
-	}
-	thread::errorproc ThreadError
-	return [llength [thread::names]]
-    } else {
-	return 1
-    }
-    return 0
-}
-
-# Initialize the constraints and set up command line arguments 
-namespace eval tcltest {
-    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
-    set ::auto_path [list [info library]]
-
-    tcltest::initConstraints
-    if {[namespace children [namespace current]] == {}} {
-	tcltest::processCmdLineArgs
-    }
-
-    # Save the names of files that already exist in
-    # the output directory.
-    foreach file [glob -nocomplain \
-	    [file join $tcltest::temporaryDirectory *]] {
-	lappend tcltest::filesExisted [file tail $file]
-    }
-}
-
-package provide tcltest 2.0
-
diff --git a/library/tcltest1.0/pkgIndex.tcl b/library/tcltest1.0/pkgIndex.tcl
index e3746e2..da93644 100644
--- a/library/tcltest1.0/pkgIndex.tcl
+++ b/library/tcltest1.0/pkgIndex.tcl
@@ -8,5 +8,4 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.
 
-package ifneeded tcltest 1.0 [list source [file join $dir tcltest.tcl]]
-package ifneeded tcltest 2.0 [list source [file join $dir tcltest2.tcl]]
+package ifneeded tcltest 2.0 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest1.0/tcltest.tcl b/library/tcltest1.0/tcltest.tcl
index 63639e3..80f80c7 100644
--- a/library/tcltest1.0/tcltest.tcl
+++ b/library/tcltest1.0/tcltest.tcl
@@ -1,7 +1,7 @@
 # tcltest.tcl --
 #
 #	This file contains support code for the Tcl test suite.  It 
-#       defines the ::tcltest namespace and finds and defines the output
+#       defines the tcltest namespace and finds and defines the output
 #       directory, constraints available, output and error channels, etc. used
 #       by Tcl tests.  See the tcltest man page for more details.
 #       
@@ -10,11 +10,10 @@
 #
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.27 2000/09/06 18:50:15 hobbs Exp $
-
-package provide tcltest 1.0
+# RCS: @(#) $Id: tcltest.tcl,v 1.28 2000/10/24 22:30:32 jenn Exp $
 
 # create the "tcltest" namespace for all testing variables and procedures
 
@@ -23,19 +22,25 @@ namespace eval tcltest {
     # Export the public tcltest procs
     set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingFiles \
-	    loadTestedCommands normalizePath]
+	    viewFile bytestring threadReap debug testConstraint \
+	    limitConstraints loadTestedCommands normalizePath verbose match \
+	    skip matchFiles skipFiles preserveCore  loadScript loadFile \
+	    mainThread workingDirectory singleProcess interpreter runAllTests \
+	    outputChannel outputFile errorChannel \
+	    errorFile temporaryDirectory testsDirectory  matchDirectories \
+	    skipDirectories ]
     foreach proc $procList {
 	namespace export $proc
     }
 
-    # ::tcltest::verbose defaults to "b"
+    # tcltest::verbose defaults to {body}
     if {![info exists verbose]} {
-	variable verbose "b"
+	variable verbose {body}
     }
 
     # Match and skip patterns default to the empty list, except for
-    # matchFiles, which defaults to all .test files in the testsDirectory
+    # matchFiles, which defaults to all .test files in the testsDirectory and
+    # matchDirectories, which defaults to all directories.
 
     if {![info exists match]} {
 	variable match {}
@@ -49,6 +54,12 @@ namespace eval tcltest {
     if {![info exists skipFiles]} {
 	variable skipFiles {}
     }
+    if {![info exists matchDirectories]} {
+	variable matchDirectories {*}
+    }
+    if {![info exists skipDirectories]} {
+	variable skipDirectories {}
+    }
 
     # By default, don't save core files
     if {![info exists preserveCore]} {
@@ -59,11 +70,17 @@ namespace eval tcltest {
     if {![info exists outputChannel]} {
 	variable outputChannel stdout
     }
+    if {![info exists outputFile]} {
+	variable outputFile stdout
+    }
 
     # errors go to stderr by default
     if {![info exists errorChannel]} {
 	variable errorChannel stderr
     }
+    if {![info exists errorFile]} {
+	variable errorFile stderr
+    }
 
     # debug output doesn't get printed by default; debug level 1 spits
     # up only the tests that were skipped because they didn't match or were 
@@ -81,9 +98,9 @@ namespace eval tcltest {
 	variable parameters {}
     }
 
-    # 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.
+    # Count the number of files tested (0 if runAllTests wasn't called).
+    # runAllTests will set testSingleFile to false, so stats will
+    # not be printed until runAllTests 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.
@@ -103,9 +120,9 @@ namespace eval tcltest {
 
     # Tests should remove all files they create.  The test suite will
     # check the current working dir for files created by the tests.
-    # ::tcltest::filesMade keeps track of such files created using the
-    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
-    # ::tcltest::filesExisted stores the names of pre-existing files.
+    # tcltest::filesMade keeps track of such files created using the
+    # tcltest::makeFile and tcltest::makeDirectory procedures.
+    # tcltest::filesExisted stores the names of pre-existing files.
 
     if {![info exists filesMade]} {
 	variable filesMade {}
@@ -114,43 +131,47 @@ namespace eval tcltest {
 	variable filesExisted {}
     }
 
-    # ::tcltest::numTests will store test files as indices and the list
+    # tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
 
     if {![info exists createdNewFiles]} {
 	variable createdNewFiles
-	array set ::tcltest::createdNewFiles {}
+	array set tcltest::createdNewFiles {}
     }
 
-    # initialize ::tcltest::numTests array to keep track fo the number of
+    # initialize tcltest::numTests array to keep track fo the number of
     # tests that pass, fail, and are skipped.
 
     if {![info exists numTests]} {
 	variable numTests
-	array set ::tcltest::numTests \
+	array set tcltest::numTests \
 		[list Total 0 Passed 0 Skipped 0 Failed	0] 
     }
 
-    # initialize ::tcltest::skippedBecause array to keep track of
+    # initialize tcltest::skippedBecause array to keep track of
     # constraints that kept tests from running; a constraint name of
     # "userSpecifiedSkip" means that the test appeared on the list of tests
     # that matched the -skip value given to the flag; "userSpecifiedNonMatch"
     # means that the test didn't match the argument given to the -match flag;
-    # both of these constraints are counted only if ::tcltest::debug is set to
+    # both of these constraints are counted only if tcltest::debug is set to
     # true. 
 
     if {![info exists skippedBecause]} {
 	variable skippedBecause
-	array set ::tcltest::skippedBecause {}
+	array set tcltest::skippedBecause {}
     }
 
-    # initialize the ::tcltest::testConstraints array to keep track of valid
+    # initialize the tcltest::testConstraints array to keep track of valid
     # predefined constraints (see the explanation for the
-    # ::tcltest::initConstraints proc for more details).
+    # tcltest::initConstraints proc for more details).
 
     if {![info exists testConstraints]} {
 	variable testConstraints
-	array set ::tcltest::testConstraints {}
+	array set tcltest::testConstraints {}
+    }
+
+    if {![info exists constraintsSpecified]} {
+	variable constraintsSpecified {}
     }
 
     # Don't run only the constrained tests by default
@@ -166,6 +187,11 @@ namespace eval tcltest {
 	variable loadScript {}
     }
 
+    # and the filename of the script file, if it exists
+    if {![info exists loadFile]} {
+	variable loadFile {}
+    }
+
     # tests that use threads need to know which is the main thread
 
     if {![info exists mainThread]} {
@@ -181,10 +207,10 @@ namespace eval tcltest {
     
     if {![info exists originalEnv]} {
 	variable originalEnv
-	array set ::tcltest::originalEnv [array get ::env]
+	array set tcltest::originalEnv [array get ::env]
     }
 
-    # Set ::tcltest::workingDirectory to [pwd]. The default output directory
+    # Set tcltest::workingDirectory to [pwd]. The default output directory
     # for Tcl tests is the working directory.
 
     if {![info exists workingDirectory]} {
@@ -196,7 +222,7 @@ namespace eval tcltest {
 
     # Tests should not rely on the current working directory.
     # Files that are part of the test suite should be accessed relative to 
-    # ::tcltest::testsDirectory.
+    # tcltest::testsDirectory.
 
     if {![info exists testsDirectory]} {
 	set oldpwd [pwd]
@@ -206,30 +232,40 @@ namespace eval tcltest {
 	unset oldpwd
     }
 
-    # the variables and procs that existed when ::tcltest::saveState was
+    # Default is to run each test file in a separate process
+    if {![info exists singleProcess]} {
+	variable singleProcess 0
+    }
+
+    # the variables and procs that existed when tcltest::saveState was
     # called are stored in a variable of the same name
     if {![info exists saveState]} {
 	variable saveState {}
     }
 
-    # Internationalization support
+    # Internationalization support -- used in tcltest::set_iso8859_1_locale
+    # and tcltest::restore_locale. Those commands are used in cmdIL.test.
+    if {![info exists previousLocale]} {
+	variable previousLocale
+    }
+
     if {![info exists isoLocale]} {
 	variable isoLocale fr
-        switch $tcl_platform(platform) {
+	switch -- $tcl_platform(platform) {
 	    "unix" {
 
 		# Try some 'known' values for some platforms:
 
 		switch -exact -- $tcl_platform(os) {
 		    "FreeBSD" {
-			set ::tcltest::isoLocale fr_FR.ISO_8859-1
+			set tcltest::isoLocale fr_FR.ISO_8859-1
 		    }
 		    HP-UX {
-			set ::tcltest::isoLocale fr_FR.iso88591
+			set tcltest::isoLocale fr_FR.iso88591
 		    }
 		    Linux -
 		    IRIX {
-			set ::tcltest::isoLocale fr
+			set tcltest::isoLocale fr
 		    }
 		    default {
 
@@ -237,12 +273,12 @@ namespace eval tcltest {
 			# define it to something else on your system
 			#if you want to test those.
 
-			set ::tcltest::isoLocale iso_8859_1
+			set tcltest::isoLocale iso_8859_1
 		    }
 		}
 	    }
 	    "windows" {
-		set ::tcltest::isoLocale French
+		set tcltest::isoLocale French
 	    }
 	}
     }
@@ -250,7 +286,7 @@ namespace eval tcltest {
     # Set the location of the execuatble
     if {![info exists tcltest]} {
 	variable tcltest [info nameofexecutable]
-    }
+    }	
 
     # save the platform information so it can be restored later
     if {![info exists originalTclPlatform]} {
@@ -259,29 +295,34 @@ namespace eval tcltest {
 
     # If a core file exists, save its modification time.
     if {![info exists coreModificationTime]} {
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	if {[file exists [file join $tcltest::workingDirectory core]]} {
 	    variable coreModificationTime [file mtime [file join \
-		    $::tcltest::workingDirectory core]]
+		    $tcltest::workingDirectory core]]
 	}
     }
 
-    # Tcl version numbers
-    if {![info exists version]} {
-	variable version 8.4
+    # stdout and stderr buffers for use when we want to store them
+    if {![info exists outData]} {
+	variable outData {}
     }
-    if {![info exists patchLevel]} {
-	variable patchLevel 8.4a2
+    if {![info exists errData]} {
+	variable errData {}
     }
+
+    # keep track of test level for nested test commands
+    variable testLevel 0
 }   
 
-# ::tcltest::Debug* --
+#####################################################################
+
+# tcltest::Debug* --
 #
 #     Internal helper procedures to write out debug information
 #     dependent on the chosen level. A test shell may overide
 #     them, f.e. to redirect the output into a different
 #     channel, or even into a GUI.
 
-# ::tcltest::DebugPuts --
+# tcltest::DebugPuts --
 #
 #     Prints the specified string if the current debug level is
 #     higher than the provided level argument.
@@ -293,15 +334,19 @@ namespace eval tcltest {
 # Results:
 #     Prints the string. Nothing else is allowed.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugPuts {level string} {
+proc tcltest::DebugPuts {level string} {
     variable debug
     if {$debug >= $level} {
 	puts $string
     }
+    return
 }
 
-# ::tcltest::DebugPArray --
+# tcltest::DebugPArray --
 #
 #     Prints the contents of the specified array if the current
 #       debug level is higher than the provided level argument
@@ -313,17 +358,21 @@ proc ::tcltest::DebugPuts {level string} {
 # Results:
 #     Prints the contents of the array. Nothing else is allowed.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugPArray {level arrayvar} {
+proc tcltest::DebugPArray {level arrayvar} {
     variable debug
 
     if {$debug >= $level} {
 	catch {upvar  $arrayvar $arrayvar}
 	parray $arrayvar
     }
+    return
 }
 
-# ::tcltest::DebugDo --
+# tcltest::DebugDo --
 #
 #     Executes the script if the current debug level is greater than
 #       the provided level argument
@@ -335,16 +384,779 @@ proc ::tcltest::DebugPArray {level arrayvar} {
 # Results:
 #     Arbitrary side effects, dependent on the executed script.
 #
+# Side Effects:
+#     None.
+#
 
-proc ::tcltest::DebugDo {level script} {
+proc tcltest::DebugDo {level script} {
     variable debug
 
     if {$debug >= $level} {
 	uplevel $script
     }
+    return
+}
+
+#####################################################################
+
+# tcltest::CheckDirectory --
+#
+#     This procedure checks whether the specified path is a readable
+#     and/or writable directory. If one of the conditions is not
+#     satisfied an error is printed and the application aborted. The
+#     procedure assumes that the caller already checked the existence
+#     of the path.
+#
+# Arguments
+#     rw      Information what attributes to check. Allowed values:
+#             r, w, rw, wr. If 'r' is part of the value the directory
+#             must be readable. 'w' associates to 'writable'.
+#     dir     The directory to check.
+#     errMsg  The string to prepend to the actual error message before
+#             printing it.
+#
+# Results
+#     none
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::CheckDirectory {rw dir errMsg} {
+    # Allowed values for 'rw': r, w, rw, wr
+
+    if {![file isdir $dir]} {
+	set msg "$errMsg \"$dir\" is not a directory"
+	error $msg
+    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
+	set msg "$errMsg \"$dir\" is not writeable"
+	error $msg
+    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
+	set msg "$errMsg \"$dir\" is not readable"
+	error $msg
+    }
+    return
+}
+
+# tcltest::normalizePath --
+#
+#     This procedure resolves any symlinks in the path thus creating a
+#     path without internal redirection. It assumes that the incoming
+#     path is absolute.
+#
+# Arguments
+#     pathVar contains the name of the variable containing the path to modify.
+#
+# Results
+#     The path is modified in place.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::normalizePath {pathVar} {
+    upvar $pathVar path
+
+    set oldpwd [pwd]
+    catch {cd $path}
+    set path [pwd]
+    cd $oldpwd
+    return $path
+}
+
+
+# tcltest::MakeAbsolutePath --
+#
+#     This procedure checks whether the incoming path is absolute or not.
+#     Makes it absolute if it was not.
+#
+# Arguments
+#     pathVar contains the name of the variable containing the path to modify.
+#     prefix  is optional, contains the path to use to make the other an
+#             absolute one. The current working directory is used if it was
+#             not specified.
+#
+# Results
+#     The path is modified in place.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
+    upvar $pathVar path
+
+    if {![string equal [file pathtype $path] "absolute"]} { 
+	if {$prefix == {}} {
+	    set prefix [pwd]
+	}
+
+	set path [file join $prefix $path] 
+    }
+    return $path
+}
+
+#####################################################################
+
+# tcltest::<variableName>
+#     
+#     Accessor functions for tcltest variables that can be modified externally.
+#     These are vars that could otherwise be modified using command line
+#     arguments to tcltest.
+
+# tcltest::verbose --
+#
+#	Set or return the verbosity level (tcltest::verbose) for tests.  This
+#       determines what gets printed to the screen and when, with regard to the
+#       running of the tests.  The proc does not check for invalid values.  It
+#       assumes that a string that doesn't match its predefined keywords
+#       is a string containing letter-specified verbosity levels.
+#
+# Arguments:
+#	A string containing any combination of 'pbste' or a list of keywords
+#       (listed in parens)
+#          p = print output whenever a test passes (pass)
+#          b = print the body of the test when it fails (body)
+#          s = print when a test is skipped (skip)
+#          t = print when a test starts (start)
+#          e = print errorInfo and errorCode when a test encounters an error
+#              (error) 
+#
+# Results:
+#	content of tcltest::verbose - this is always the character combination
+#       (pbste) instead of the list form.
+#
+# Side effects:
+#	None.
+
+proc tcltest::verbose { {level ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::verbose
+    } 
+    if {[llength $level] > 1} {
+  	set tcltest::verbose $level
+    } else {
+	if {[regexp {pass|body|skip|start|error} $level]} {
+	    set tcltest::verbose $level
+	} else { 
+	    set levelList [split $level {}]
+	    set tcltest::verbose [string map {p pass b body s skip t start e
+		error} $levelList]
+	}
+    }
+    return $tcltest::verbose
+}
+
+# tcltest::isVerbose --
+#
+#	Returns true if argument is one of the verbosity levels currently being
+#       used; returns false otherwise.
+#
+# Arguments:
+#	level
+#
+# Results:
+#	boolean 1 (true) or 0 (false), depending on whether or not the level
+#       provided is one of the ones stored in tcltest::verbose.
+#
+# Side effects:
+#	None.
+
+proc tcltest::isVerbose {level} {
+    if {[lsearch -exact [tcltest::verbose] $level] == -1} {
+	return 0
+    }
+    return 1
+}
+
+
+
+# tcltest::match --
+#
+#	Set or return the match patterns (tcltest::match) that determine which
+#       tests are run. 
+#
+# Arguments:
+#	List containing match patterns (glob format)
+#
+# Results:
+#	content of tcltest::match
+#
+# Side effects:
+#	none
+
+proc tcltest::match { {matchList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::match
+    } 
+    set tcltest::match $matchList
+}
+
+# tcltest::skip --
+#
+#	Set or return the skip patterns (tcltest::skip) that determine which
+#       tests are skipped. 
+#
+# Arguments:
+#	List containing skip patterns (glob format)
+#
+# Results:
+#	content of tcltest::skip
+#
+# Side effects:
+#	None.
+
+proc tcltest::skip { {skipList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skip
+    }
+    set tcltest::skip $skipList
+}
+
+# tcltest::matchFiles --
+#
+#	set or return the match patterns for file sourcing
+#
+# Arguments:
+#	list containing match file list (glob format)
+#
+# Results:
+#	content of tcltest::matchFiles
+#
+# Side effects:
+#	None.
+
+proc tcltest::matchFiles { {matchFileList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::matchFiles
+    }
+    set tcltest::matchFiles $matchFileList
+}
+
+# tcltest::skipFiles --
+#
+#	set or return the skip patterns for file sourcing
+#
+# Arguments:
+#	list containing the skip file list (glob format)
+#
+# Results:
+#	content of tcltest::skipFiles
+#
+# Side effects:
+#	None.
+
+proc tcltest::skipFiles { {skipFileList ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skipFiles
+    }
+    set tcltest::skipFiles $skipFileList
+}
+
+
+# tcltest::matchDirectories --
+#
+#	set or return the list of directories for matching (glob pattern list)
+#
+# Arguments:
+#	list of glob patterns matching subdirectories of
+#       tcltest::testsDirectory 
+#
+# Results:
+#	content of tcltest::matchDirectories
+#
+# Side effects:
+#	None.
+
+proc tcltest::matchDirectories { {dirlist ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::matchDirectories
+    }
+    set tcltest::matchDirectories $dirlist
+}
+
+# tcltest::skipDirectories --
+#
+#	set or return the list of directories to skip (glob pattern list)
+#
+# Arguments:
+#	list of glob patterns matching directories to skip; these directories
+#       are subdirectories of tcltest::testsDirectory
+#
+# Results:
+#	content of tcltest::skipDirectories
+#
+# Side effects:
+#	None.
+
+proc tcltest::skipDirectories { {dirlist ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::skipDirectories
+    }
+    set tcltest::skipDirectories $dirlist
+}
+
+# tcltest::preserveCore --
+#
+#	set or return the core preservation level.  This proc does not do any
+#       error checking for invalid values.
+#
+# Arguments:
+#	core level:
+#         '0' = don't do anything with core files (default)
+#         '1' = notify the user if core files are created
+#         '2' = save any core files produced during testing to
+#               tcltest::temporaryDirectory 
+#
+# Results:
+#	content of tcltest::preserveCore
+#
+# Side effects:
+#	None.
+
+proc tcltest::preserveCore { {coreLevel ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::preserveCore
+    }
+    set tcltest::preserveCore $coreLevel
+}
+
+# tcltest::outputChannel --
+#
+#	set or return the output file descriptor based on the supplied file
+#       name (where tcltest puts all of its output) 
+#
+# Arguments:
+#	output file descriptor
+#
+# Results:
+#	file descriptor corresponding to supplied file name (or currently set
+#       file descriptor, if no new filename was supplied) - this is the content
+#       of tcltest::outputChannel 
+#
+# Side effects:
+#	None.
+
+proc tcltest::outputChannel { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::outputChannel
+    }
+    if {($filename == "stderr") || ($filename == "stdout")} {
+	set tcltest::outputChannel $filename
+    } else {
+	set tcltest::outputChannel [open $filename w]
+    }
+    return $tcltest::outputChannel
+}
+
+# tcltest::outputFile --
+#
+#	set or return the output file name (where tcltest puts all of its
+#       output); calls tcltest::outputChannel to set the corresponding file
+#       descriptor 
+#
+# Arguments:
+#	output file name
+#
+# Results:
+#       file name corresponding to supplied file name (or currently set
+#       file name, if no new filename was supplied) - this is the content
+#       of tcltest::outputFile
+#
+# Side effects:
+#	if the file name supplied is relative, it will be made absolute with
+#       respect to the predefined temporaryDirectory
+
+proc tcltest::outputFile { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::outputFile
+    }
+    if {($filename != "stderr") && ($filename != "stdout")} {
+	MakeAbsolutePath filename $tcltest::temporaryDirectory
+    }
+    tcltest::outputChannel $filename
+    set tcltest::outputFile $filename
+}
+
+# tcltest::errorChannel --
+#
+#	set or return the error file descriptor based on the supplied file name
+#       (where tcltest sends all its errors)  
+#
+# Arguments:
+#	error file name
+#
+# Results:
+#	file descriptor corresponding to the supplied file name (or currently
+#       set file descriptor, if no new filename was supplied) - this is the
+#       content of tcltest::errorChannel
+#
+# Side effects:
+#	opens the descriptor in w mode unless the filename is set to stderr or
+#       stdout 
+
+proc tcltest::errorChannel { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::errorChannel
+    }
+    if {($filename == "stderr") || ($filename == "stdout")} {
+	set tcltest::errorChannel $filename
+    } else {
+	set tcltest::errorChannel [open $filename w]
+    }
+    return $tcltest::errorChannel
+}
+
+# tcltest::errorFile --
+#
+#	set or return the error file name; calls tcltest::errorChannel to set
+#       the corresponding file descriptor
+#
+# Arguments:
+#	error file name
+#
+# Results:
+#	content of tcltest::errorFile
+#
+# Side effects:
+#	if the file name supplied is relative, it will be made absolute with
+#       respect to the predefined temporaryDirectory
+
+proc tcltest::errorFile { {filename ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::errorFile
+    }
+    if {($filename != "stderr") && ($filename != "stdout")} {
+	MakeAbsolutePath filename $tcltest::temporaryDirectory
+    }
+    set tcltest::errorFile $filename
+    errorChannel $tcltest::errorFile
+    return $tcltest::errorFile
+}
+
+# tcltest::debug --
+#
+#	set or return the debug level for tcltest; this proc does not check for
+#       invalid values
+#
+# Arguments:
+#	debug level:
+#       '0' = no debug output (default)
+#       '1' = skipped tests
+#       '2' = tcltest variables and supplied flags
+#       '3' = harness operations
+#
+# Results:
+#	content of tcltest::debug
+#
+# Side effects:
+#	None.
+
+proc tcltest::debug { {debugLevel ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::debug
+    }
+    set tcltest::debug $debugLevel
+}
+
+# tcltest::testConstraint --
+#
+#	sets a test constraint to a value; to do multiple constraints, call
+#       this proc multiple times.  also returns the value of the named
+#       constraint if no value was supplied.
+#
+# Arguments:
+#	constraint - name of the constraint
+#       value - new value for constraint (should be boolean) - if not supplied,
+#               this is a query
+#
+# Results:
+#	content of tcltest::testConstraints($constraint)
+#
+# Side effects:
+#	appends the constraint name to tcltest::constraintsSpecified
+
+proc tcltest::testConstraint {constraint {value ""}} {
+    DebugPuts 3 "entering testConstraint $constraint $value"
+    if {[llength [info level 0]] == 2} {
+	return $tcltest::testConstraints($constraint)
+    } 
+    lappend tcltest::constraintsSpecified $constraint
+    set tcltest::testConstraints($constraint) $value
+}
+
+# tcltest::constraintsSpecified --
+#
+#	returns a list of all the constraint names specified using
+#       testConstraint 
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	list of the constraint names in tcltest::constraintsSpecified
+#
+# Side effects:
+#	None.
+
+proc tcltest::constraintsSpecified {} {
+    return $tcltest::constraintsSpecified
+}
+
+# tcltest::constraintList --
+#
+#	returns a list of all the constraint names
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	list of the constraint names in tcltest::testConstraints
+#
+# Side effects:
+#	None.
+
+proc tcltest::constraintList {} {
+    return [array names tcltest::testConstraints]
+}
+
+# tcltest::limitConstraints --
+#
+#	sets the limited constraints to tcltest::limitConstraints
+#
+# Arguments:
+#	list of constraint names
+#
+# Results:
+#	content of tcltest::limitConstraints
+#
+# Side effects:
+#	None.
+
+proc tcltest::limitConstraints { {constraintList ""} } {
+    DebugPuts 3 "entering limitConstraints $constraintList"
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::limitConstraints
+    } 
+    set tcltest::limitConstraints $constraintList
+    foreach elt [tcltest::constraintList] {
+	if {[lsearch -exact [tcltest::constraintsSpecified] $elt] == -1} {
+	    tcltest::testConstraint $elt 0
+	}
+    }
+    return $tcltest::limitConstraints
+}
+
+# tcltest::loadScript --
+#
+#	sets the load script
+#
+# Arguments:
+#	script to be set
+#
+# Results:
+#	contents of tcltest::loadScript
+#
+# Side effects:
+#	None.
+
+proc tcltest::loadScript { {script ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::loadScript
+    }
+    set tcltest::loadScript $script
+}
+
+# tcltest::loadFile --
+#
+#	set the load file (containing the load script); 
+#       put the content of the load file into loadScript
+#
+# Arguments:
+#	script's file name
+#
+# Results:
+#	content of tcltest::loadFile
+#
+# Side effects:
+#	None.
+
+proc tcltest::loadFile { {scriptFile ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::loadFile
+    }
+    MakeAbsolutePath scriptFile $tcltest::temporaryDirectory
+    set tmp [open $scriptFile r]
+    tcltest::loadScript [read $tmp]
+    close $tmp
+    set tcltest::loadFile $scriptFile
+}
+
+# tcltest::workingDirectory --
+#
+#	set workingDirectory to the given path. 
+#       If the path is relative, make it absolute.
+#       change directory to the stated working directory, if resetting the
+#       value 
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::workingDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::workingDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::workingDirectory
+    }
+    set tcltest::workingDirectory $dir
+    MakeAbsolutePath tcltest::workingDirectory
+    cd $tcltest::workingDirectory
+    return $tcltest::workingDirectory
+}
+
+# tcltest::temporaryDirectory --
+#
+#     Set tcltest::temporaryDirectory to the given path.
+#     If the path is relative, make it absolute.  If the file exists but
+#     is not a dir, then return an error.
+#
+#     If tcltest::temporaryDirectory does not already exist, create it.
+#     If you cannot create it, then return an error (the file mkdir isn't
+#     caught and will propagate).
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::temporaryDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::temporaryDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::temporaryDirectory
+    }
+    set tcltest::temporaryDirectory $dir
+
+    MakeAbsolutePath tcltest::temporaryDirectory
+    set tmpDirError "bad argument for temporary directory: "
+
+    if {[file exists $tcltest::temporaryDirectory]} {
+	tcltest::CheckDirectory rw $tcltest::temporaryDirectory $tmpDirError
+    } else {
+	file mkdir $tcltest::temporaryDirectory
+    }
+
+    normalizePath tcltest::temporaryDirectory
+}
+
+# tcltest::testsDirectory --
+#
+#     Set tcltest::testsDirectory to the given path.
+#     If the path is relative, make it absolute.  If the file exists but
+#     is not a dir, then return an error.
+#
+#     If tcltest::testsDirectory does not already exist, return an error.
+#
+# Arguments:
+#	directory name
+#
+# Results:
+#	content of tcltest::testsDirectory
+#
+# Side effects:
+#	None.
+
+proc tcltest::testsDirectory { {dir ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::testsDirectory
+    }
+
+    set tcltest::testsDirectory $dir
+    
+    MakeAbsolutePath tcltest::testsDirectory
+    set testDirError "bad argument for tests directory: "
+
+    if {[file exists $tcltest::testsDirectory]} {
+	tcltest::CheckDirectory r $tcltest::testsDirectory $testDirError
+    } else {
+	set msg "$testDirError \"$tcltest::testsDirectory\" does not exist"
+	error $msg
+    }
+    
+    normalizePath tcltest::testsDirectory
+}
+
+# tcltest::singleProcess --
+#
+#	sets tcltest::singleProcess to the value provided.
+#
+# Arguments:
+#	value for singleProcess:
+#       1 = source each test file into the current process
+#       0 = run each test file in its own process 
+#
+# Results:
+#	content of tcltest::singleProcess
+#
+# Side effects:
+#	None.
+
+proc tcltest::singleProcess { {value ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::singleProcess
+    }
+    set tcltest::singleProcess $value
+}
+
+# tcltest::interpreter --
+#
+#	the interpreter name stored in tcltest::tcltest
+#
+# Arguments:
+#	executable name
+#
+# Results:
+#	content of tcltest::tcltest
+#
+# Side effects:
+#	None.
+
+proc tcltest::interpreter { {interp ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::tcltest
+    }
+    set tcltest::tcltest $interp
+}
+
+# tcltest::mainThread --
+#
+#	sets or returns the thread id stored in tcltest::mainThread
+#
+# Arguments:
+#	thread id
+#
+# Results:
+#	content of tcltest::mainThread
+#
+# Side effects:
+#	None.
+
+proc tcltest::mainThread { {threadid ""} } {
+    if {[llength [info level 0]] == 1} {
+	return $tcltest::mainThread
+    }
+    set tcltest::mainThread $threadid
 }
 
-# ::tcltest::AddToSkippedBecause --
+#####################################################################
+
+# tcltest::AddToSkippedBecause --
 #
 #	Increments the variable used to track how many tests were skipped
 #       because of a particular constraint.
@@ -353,52 +1165,61 @@ proc ::tcltest::DebugDo {level script} {
 #	constraint     The name of the constraint to be modified
 #
 # Results:
-#	Modifies ::tcltest::skippedBecause; sets the variable to 1 if didn't
+#	Modifies tcltest::skippedBecause; sets the variable to 1 if didn't
 #       previously exist - otherwise, it just increments it.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::AddToSkippedBecause { constraint } {
+proc tcltest::AddToSkippedBecause { constraint {value 1}} {
     # add the constraint to the list of constraints that kept tests
     # from running
 
-    if {[info exists ::tcltest::skippedBecause($constraint)]} {
-	incr ::tcltest::skippedBecause($constraint)
+    if {[info exists tcltest::skippedBecause($constraint)]} {
+	incr tcltest::skippedBecause($constraint) $value
     } else {
-	set ::tcltest::skippedBecause($constraint) 1
+	set tcltest::skippedBecause($constraint) $value
     }
     return
 }
 
-# ::tcltest::PrintError --
+# tcltest::PrintError --
 #
-#	Prints errors to ::tcltest::errorChannel and then flushes that
+#	Prints errors to tcltest::errorChannel and then flushes that
 #       channel, making sure that all messages are < 80 characters per line.
 #
 # Arguments:
 #	errorMsg     String containing the error to be printed
 #
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::PrintError {errorMsg} {
+proc tcltest::PrintError {errorMsg} {
     set InitialMessage "Error:  "
     set InitialMsgLen  [string length $InitialMessage]
-    puts -nonewline $::tcltest::errorChannel $InitialMessage
+    puts -nonewline [errorChannel] $InitialMessage
 
     # Keep track of where the end of the string is.
     set endingIndex [string length $errorMsg]
 
     if {$endingIndex < 80} {
-	puts $::tcltest::errorChannel $errorMsg
+	puts [errorChannel] $errorMsg
     } else {
 	# Print up to 80 characters on the first line, including the
 	# InitialMessage. 
 	set beginningIndex [string last " " [string range $errorMsg 0 \
 		[expr {80 - $InitialMsgLen}]]]
-	puts $::tcltest::errorChannel [string range $errorMsg 0 $beginningIndex]
+	puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
 
 	while {$beginningIndex != "end"} {
-	    puts -nonewline $::tcltest::errorChannel \
+	    puts -nonewline [errorChannel] \
 		    [string repeat " " $InitialMsgLen]  
 	    if {[expr {$endingIndex - $beginningIndex}] < 72} {
-		puts $::tcltest::errorChannel [string trim \
+		puts [errorChannel] [string trim \
 			[string range $errorMsg $beginningIndex end]]
 		set beginningIndex end
 	    } else {
@@ -409,25 +1230,52 @@ proc ::tcltest::PrintError {errorMsg} {
 			|| ($newEndingIndex <= $beginningIndex)} {
 		    set newEndingIndex end
 		}
-		puts $::tcltest::errorChannel [string trim \
+		puts [errorChannel] [string trim \
 			[string range $errorMsg \
-			$beginningIndex $newEndingIndex]]
+			    $beginningIndex $newEndingIndex]]
 		set beginningIndex $newEndingIndex
 	    }
 	}
     }
-    flush $::tcltest::errorChannel
+    flush [errorChannel]
     return
 }
 
-if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
-    proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope tcltest info procs initConstraintsHook] == {}} {
+    proc tcltest::initConstraintsHook {} {}
+}
+
+# tcltest::safeFetch --
+#
+#	 The following trace procedure makes it so that we can safely refer to
+#        non-existent members of the tcltest::testConstraints array without 
+#        causing an error.  Instead, reading a non-existent member will return
+#        0. This is necessary because tests are allowed to use constraint "X"
+#        without ensuring that tcltest::testConstraints("X") is defined.
+#
+# Arguments:
+#	n1 - name of the array (tcltest::testConstraints)
+#       n2 - array key value (constraint name)
+#       op - operation performed on tcltest::testConstraints (generally r)
+#
+# Results:
+#	none
+#
+# Side effects:
+#	sets tcltest::testConstraints($n2) to 0 if it's referenced but never
+#       before used
+
+proc tcltest::safeFetch {n1 n2 op} {
+    DebugPuts 3 "entering safeFetch $n1 $n2 $op"
+    if {($n2 != {}) && ([info exists tcltest::testConstraints($n2)] == 0)} {
+	tcltest::testConstraint $n2 0
+    }
 }
 
-# ::tcltest::initConstraints --
+# tcltest::initConstraints --
 #
-# Check Constraintsuration information that will determine which tests
-# to run.  To do this, create an array ::tcltest::testConstraints.  Each
+# Check constraint information that will determine which tests
+# to run.  To do this, create an array tcltest::testConstraints.  Each
 # element has a 0 or 1 value.  If the element is "true" then tests
 # with that constraint will be run, otherwise tests with that constraint
 # will be skipped.  See the tcltest man page for the list of built-in
@@ -437,101 +1285,110 @@ if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
 #	none
 #
 # Results:
-#	The ::tcltest::testConstraints array is reset to have an index for
+#	The tcltest::testConstraints array is reset to have an index for
 #	each built-in test constraint.
+# 
+# Side Effects:
+#       None.
+#
 
-proc ::tcltest::initConstraints {} {
+proc tcltest::initConstraints {} {
     global tcl_platform tcl_interactive tk_version
 
-    # The following trace procedure makes it so that we can safely refer to
-    # non-existent members of the ::tcltest::testConstraints array without
-    # causing an error.  Instead, reading a non-existent member will return 0.
-    # This is necessary because tests are allowed to use constraint "X" without
-    # ensuring that ::tcltest::testConstraints("X") is defined.
+    # Safely refer to non-existent members of the tcltest::testConstraints
+    # array without causing an error.  
+    trace variable tcltest::testConstraints r tcltest::safeFetch
 
-    trace variable ::tcltest::testConstraints r ::tcltest::safeFetch
+    tcltest::initConstraintsHook
 
-    proc ::tcltest::safeFetch {n1 n2 op} {
-	if {($n2 != {}) && ([info exists ::tcltest::testConstraints($n2)] == 0)} {
-	    set ::tcltest::testConstraints($n2) 0
-	}
-    }
+    tcltest::testConstraint singleTestInterp [singleProcess]
 
-    ::tcltest::initConstraintsHook
+    # All the 'pc' constraints are here for backward compatibility and are not
+    # documented.  They have been replaced with equivalent 'win' constraints.
 
-    set ::tcltest::testConstraints(unixOnly) \
+    tcltest::testConstraint unixOnly \
 	    [string equal $tcl_platform(platform) "unix"]
-    set ::tcltest::testConstraints(macOnly) \
+    tcltest::testConstraint macOnly \
 	    [string equal $tcl_platform(platform) "macintosh"]
-    set ::tcltest::testConstraints(pcOnly) \
+    tcltest::testConstraint pcOnly \
+	    [string equal $tcl_platform(platform) "windows"]
+    tcltest::testConstraint winOnly \
 	    [string equal $tcl_platform(platform) "windows"]
 
-    set ::tcltest::testConstraints(unix) $::tcltest::testConstraints(unixOnly)
-    set ::tcltest::testConstraints(mac) $::tcltest::testConstraints(macOnly)
-    set ::tcltest::testConstraints(pc) $::tcltest::testConstraints(pcOnly)
-
-    set ::tcltest::testConstraints(unixOrPc) \
-	    [expr {$::tcltest::testConstraints(unix) \
-	    || $::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macOrPc) \
-	    [expr {$::tcltest::testConstraints(mac) \
-	    || $::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macOrUnix) \
-	    [expr {$::tcltest::testConstraints(mac) \
-	    || $::tcltest::testConstraints(unix)}]
-
-    set ::tcltest::testConstraints(nt) [string equal $tcl_platform(os) \
-	    "Windows NT"]
-    set ::tcltest::testConstraints(95) [string equal $tcl_platform(os) \
-	    "Windows 95"]
-    set ::tcltest::testConstraints(98) [string equal $tcl_platform(os) \
-	    "Windows 98"]
+    tcltest::testConstraint unix [tcltest::testConstraint unixOnly]
+    tcltest::testConstraint mac [tcltest::testConstraint macOnly]
+    tcltest::testConstraint pc [tcltest::testConstraint pcOnly]
+    tcltest::testConstraint win [tcltest::testConstraint winOnly]
+
+    tcltest::testConstraint unixOrPc \
+	    [expr {[tcltest::testConstraint unix] \
+		|| [tcltest::testConstraint pc]}]
+    tcltest::testConstraint macOrPc \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint pc]}]
+    tcltest::testConstraint unixOrWin \
+	    [expr {[tcltest::testConstraint unix] \
+		|| [tcltest::testConstraint win]}]
+    tcltest::testConstraint macOrWin \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint win]}]
+    tcltest::testConstraint macOrUnix \
+	    [expr {[tcltest::testConstraint mac] \
+		|| [tcltest::testConstraint unix]}]
+
+    tcltest::testConstraint nt [string equal $tcl_platform(os) "Windows NT"]
+    tcltest::testConstraint 95 [string equal $tcl_platform(os) "Windows 95"]
+    tcltest::testConstraint 98 [string equal $tcl_platform(os) "Windows 98"]
 
     # The following Constraints switches are used to mark tests that should
     # work, but have been temporarily disabled on certain platforms because
     # they don't and we haven't gotten around to fixing the underlying
     # problem. 
 
-    set ::tcltest::testConstraints(tempNotPc) \
-	    [expr {!$::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(tempNotMac) \
-	    [expr {!$::tcltest::testConstraints(mac)}]
-    set ::tcltest::testConstraints(tempNotUnix) \
-	    [expr {!$::tcltest::testConstraints(unix)}]
+    tcltest::testConstraint tempNotPc \
+	    [expr {![tcltest::testConstraint pc]}]
+    tcltest::testConstraint tempNotWin \
+	    [expr {![tcltest::testConstraint win]}]
+    tcltest::testConstraint tempNotMac \
+	    [expr {![tcltest::testConstraint mac]}]
+    tcltest::testConstraint tempNotUnix \
+	    [expr {![tcltest::testConstraint unix]}]
 
     # The following Constraints switches are used to mark tests that crash on
     # certain platforms, so that they can be reactivated again when the
     # underlying problem is fixed.
 
-    set ::tcltest::testConstraints(pcCrash) \
-	    [expr {!$::tcltest::testConstraints(pc)}]
-    set ::tcltest::testConstraints(macCrash) \
-	    [expr {!$::tcltest::testConstraints(mac)}]
-    set ::tcltest::testConstraints(unixCrash) \
-	    [expr {!$::tcltest::testConstraints(unix)}]
+    tcltest::testConstraint pcCrash \
+	    [expr {![tcltest::testConstraint pc]}]
+    tcltest::testConstraint winCrash \
+	    [expr {![tcltest::testConstraint win]}]
+    tcltest::testConstraint macCrash \
+	    [expr {![tcltest::testConstraint mac]}]
+    tcltest::testConstraint unixCrash \
+	    [expr {![tcltest::testConstraint unix]}]
 
     # Skip empty tests
 
-    set ::tcltest::testConstraints(emptyTest) 0
+    tcltest::testConstraint emptyTest 0
 
     # By default, tests that expose known bugs are skipped.
 
-    set ::tcltest::testConstraints(knownBug) 0
+    tcltest::testConstraint knownBug 0
 
     # By default, non-portable tests are skipped.
 
-    set ::tcltest::testConstraints(nonPortable) 0
+    tcltest::testConstraint nonPortable 0
 
     # Some tests require user interaction.
 
-    set ::tcltest::testConstraints(userInteraction) 0
+    tcltest::testConstraint userInteraction 0
 
     # Some tests must be skipped if the interpreter is not in interactive mode
     
     if {[info exists tcl_interactive]} {
-	set ::tcltest::testConstraints(interactive) $::tcl_interactive
+	tcltest::testConstraint interactive $::tcl_interactive
     } else {
-	set ::tcltest::testConstraints(interactive) 0
+	tcltest::testConstraint interactive 0
     }
 
     # Some tests can only be run if the installation came from a CD image
@@ -539,8 +1396,8 @@ proc ::tcltest::initConstraints {} {
     # Some tests must be skipped if you are running as root on Unix.
     # Other tests can only be run if you are running as root on Unix.
 
-    set ::tcltest::testConstraints(root) 0
-    set ::tcltest::testConstraints(notRoot) 1
+    tcltest::testConstraint root 0
+    tcltest::testConstraint notRoot 1
     set user {}
     if {[string equal $tcl_platform(platform) "unix"]} {
 	catch {set user [exec whoami]}
@@ -548,21 +1405,21 @@ proc ::tcltest::initConstraints {} {
 	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
 	}
 	if {([string equal $user "root"]) || ([string equal $user ""])} {
-	    set ::tcltest::testConstraints(root) 1
-	    set ::tcltest::testConstraints(notRoot) 0
+	    tcltest::testConstraint root 1
+	    tcltest::testConstraint notRoot 0
 	}
     }
 
     # Set nonBlockFiles constraint: 1 means this platform supports
-    # setting files into nonblocking mode.
+    # ting files into nonblocking mode.
 
     if {[catch {set f [open defs r]}]} {
-	set ::tcltest::testConstraints(nonBlockFiles) 1
+	tcltest::testConstraint nonBlockFiles 1
     } else {
 	if {[catch {fconfigure $f -blocking off}] == 0} {
-	    set ::tcltest::testConstraints(nonBlockFiles) 1
+	    tcltest::testConstraint nonBlockFiles 1
 	} else {
-	    set ::tcltest::testConstraints(nonBlockFiles) 0
+	    tcltest::testConstraint nonBlockFiles 0
 	}
 	close $f
     }
@@ -576,75 +1433,75 @@ proc ::tcltest::initConstraints {} {
 
     if {[string equal $tcl_platform(platform) "unix"]} {
 	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
-	    set ::tcltest::testConstraints(asyncPipeClose) 0
+	    tcltest::testConstraint asyncPipeClose 0
 	} else {
-	    set ::tcltest::testConstraints(asyncPipeClose) 1
+	    tcltest::testConstraint asyncPipeClose 1
 	}
     } else {
-	set ::tcltest::testConstraints(asyncPipeClose) 1
+	tcltest::testConstraint asyncPipeClose 1
     }
 
     # Test to see if we have a broken version of sprintf with respect
     # to the "e" format of floating-point numbers.
 
-    set ::tcltest::testConstraints(eformat) 1
+    tcltest::testConstraint eformat 1
     if {![string equal "[format %g 5e-5]" "5e-05"]} {
-	set ::tcltest::testConstraints(eformat) 0
+	tcltest::testConstraint eformat 0
     }
 
     # Test to see if execed commands such as cat, echo, rm and so forth are
     # present on this machine.
 
-    set ::tcltest::testConstraints(unixExecs) 1
+    tcltest::testConstraint unixExecs 1
     if {[string equal $tcl_platform(platform) "macintosh"]} {
-	set ::tcltest::testConstraints(unixExecs) 0
+	tcltest::testConstraint unixExecs 0
     }
-    if {($::tcltest::testConstraints(unixExecs) == 1) && \
+    if {([tcltest::testConstraint unixExecs] == 1) && \
 	    ([string equal $tcl_platform(platform) "windows"])} {
 	if {[catch {exec cat defs}] == 1} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec echo hello}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec sh -c echo hello}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec wc defs}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {$::tcltest::testConstraints(unixExecs) == 1} {
+	if {[tcltest::testConstraint unixExecs] == 1} {
 	    exec echo hello > removeMe
 	    if {[catch {exec rm removeMe}] == 1} {
-		set ::tcltest::testConstraints(unixExecs) 0
+		tcltest::testConstraint unixExecs 0
 	    }
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec sleep 1}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec fgrep unixExecs defs}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec ps}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec echo abc > removeMe}] == 0) && \
 		([catch {exec chmod 644 removeMe}] == 1) && \
 		([catch {exec rm removeMe}] == 0)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	} else {
 	    catch {exec rm -f removeMe}
 	}
-	if {($::tcltest::testConstraints(unixExecs) == 1) && \
+	if {([tcltest::testConstraint unixExecs] == 1) && \
 		([catch {exec mkdir removeMe}] == 1)} {
-	    set ::tcltest::testConstraints(unixExecs) 0
+	    tcltest::testConstraint unixExecs 0
 	} else {
 	    catch {exec rm -r removeMe}
 	}
@@ -653,14 +1510,14 @@ proc ::tcltest::initConstraints {} {
     # Locate tcltest executable
 
     if {![info exists tk_version]} {
-	set tcltest [info nameofexecutable]
+	set tcltest::tcltest [info nameofexecutable]
 
-	if {$tcltest == "{}"} {
-	    set tcltest {}
+	if {$tcltest::tcltest == "{}"} {
+	    set tcltest::tcltest {}
 	}
     }
 
-    set ::tcltest::testConstraints(stdio) 0
+    tcltest::testConstraint stdio 0
     catch {
 	catch {file delete -force tmp}
 	set f [open tmp w]
@@ -672,7 +1529,7 @@ proc ::tcltest::initConstraints {} {
 	set f [open "|[list $tcltest tmp]" r]
 	close $f
 	
-	set ::tcltest::testConstraints(stdio) 1
+	tcltest::testConstraint stdio 1
     }
     catch {file delete -force tmp}
 
@@ -681,50 +1538,62 @@ proc ::tcltest::initConstraints {} {
     # system. 
 
     catch {socket} msg
-    set ::tcltest::testConstraints(socket) \
+    tcltest::testConstraint socket \
 	    [expr {$msg != "sockets are not available on this system"}]
     
     # Check for internationalization
 
     if {[info commands testlocale] == ""} {
 	# No testlocale command, no tests...
-	set ::tcltest::testConstraints(hasIsoLocale) 0
+	tcltest::testConstraint hasIsoLocale 0
     } else {
-	set ::tcltest::testConstraints(hasIsoLocale) \
-		[string length [::tcltest::set_iso8859_1_locale]]
-	::tcltest::restore_locale
+	tcltest::testConstraint hasIsoLocale \
+		[string length [tcltest::set_iso8859_1_locale]]
+	tcltest::restore_locale
     }
 }   
 
-# ::tcltest::PrintUsageInfoHook
+#####################################################################
+
+# Handle command line arguments (from argv) and default arg settings 
+# (in TCLTEST_OPTIONS).
+
+# tcltest::PrintUsageInfoHook
 #
 #       Hook used for customization of display of usage information.
 #
 
-if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
-    proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope tcltest info procs PrintUsageInfoHook] == {}} {
+    proc tcltest::PrintUsageInfoHook {} {}
 }
 
-# ::tcltest::PrintUsageInfo
+# tcltest::PrintUsageInfo
 #
 #	Prints out the usage information for package tcltest.  This can be
-#       customized with the redefinition of ::tcltest::PrintUsageInfoHook.
+#       customized with the redefinition of tcltest::PrintUsageInfoHook.
 #
 # Arguments:
 #	none
 #
+# Results:
+#       none
+#
+# Side Effects: 
+#       none
 
-proc ::tcltest::PrintUsageInfo {} {
+proc tcltest::PrintUsageInfo {} {
     puts [format "Usage: [file tail [info nameofexecutable]] \
 	    script ?-help? ?flag value? ... \n\
 	    Available flags (and valid input values) are: \n\
 	    -help          \t Display this usage information. \n\
 	    -verbose level \t Takes any combination of the values \n\
-	    \t                 'p', 's' and 'b'.  Test suite will \n\
+	    \t                 'p', 's', 'b', 't' and 'e'.  Test suite will \n\
 	    \t                 display all passed tests if 'p' is \n\
 	    \t                 specified, all skipped tests if 's' \n\
-	    \t                 is specified, and the bodies of \n\
-	    \t                 failed tests if 'b' is specified. \n\
+	    \t                 is specified, the bodies of \n\
+	    \t                 failed tests if 'b' is specified, \n\
+	    \t                 and when tests start if 't' is specified. \n\
+	    \t                 ErrorInfo is displayed if 'e' is specified. \n\
 	    \t                 The default value is 'b'. \n\
 	    -constraints list\t Do not skip the listed constraints\n\
 	    -limitconstraints bool\t Only run tests with the constraints\n\
@@ -740,17 +1609,21 @@ proc ::tcltest::PrintUsageInfo {} {
 	    \t                 match the glob pattern given. \n\
 	    -notfile pattern\t Skip all test files that match the \n\
 	    \t                 glob pattern given. \n\
+	    -relateddir pattern\t Run tests in directories that match \n\
+	    \t                 the glob pattern given. \n\
+	    -asidefromdir pattern\t Skip tests in directories that match \n\
+	    \t                 the glob pattern given.\n\
 	    -preservecore level \t If 2, save any core files produced \n\
 	    \t                 during testing in the directory \n\
 	    \t                 specified by -tmpdir. If 1, notify the\n\
 	    \t                 user if core files are created. The default \n\
-	    \t                 is $::tcltest::preserveCore. \n\
+	    \t                 is $tcltest::preserveCore. \n\
 	    -tmpdir directory\t Save temporary files in the specified\n\
 	    \t                 directory.  The default value is \n\
-	    \t                 $::tcltest::temporaryDirectory. \n\
+	    \t                 $tcltest::temporaryDirectory. \n\
 	    -testdir directories\t Search tests in the specified\n\
 	    \t                 directories.  The default value is \n\
-	    \t                 $::tcltest::testsDirectory. \n\
+	    \t                 $tcltest::testsDirectory. \n\
 	    -outfile file    \t Send output from test runs to the \n\
 	    \t                 specified file.  The default is \n\
 	    \t                 stdout. \n\
@@ -762,207 +1635,98 @@ proc ::tcltest::PrintUsageInfo {} {
 	    -load script     \t Specifies the script to load the tested \n\
 	    \t                 commands. \n\
 	    -debug level     \t Internal debug flag."]
-    ::tcltest::PrintUsageInfoHook
+    tcltest::PrintUsageInfoHook
     return
 }
 
-# ::tcltest::CheckDirectory --
-#
-#     This procedure checks whether the specified path is a readable
-#     and/or writable directory. If one of the conditions is not
-#     satisfied an error is printed and the application aborted. The
-#     procedure assumes that the caller already checked the existence
-#     of the path.
-#
-# Arguments
-#     rw      Information what attributes to check. Allowed values:
-#             r, w, rw, wr. If 'r' is part of the value the directory
-#             must be readable. 'w' associates to 'writable'.
-#     dir     The directory to check.
-#     errMsg  The string to prepend to the actual error message before
-#             printing it.
-#
-# Results
-#     none
-#
-
-proc ::tcltest::CheckDirectory {rw dir errMsg} {
-    # Allowed values for 'rw': r, w, rw, wr
-
-    if {![file isdir $dir]} { 
-	::tcltest::PrintError "$errMsg \"$dir\" is not a directory"
-	exit 1
-    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
-	::tcltest::PrintError "$errMsg \"$dir\" is not writeable"
-	exit 1
-    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
-	::tcltest::PrintError "$errMsg \"$dir\" is not readable"
-	exit 1
-    }
-}
-
-# ::tcltest::normalizePath --
-#
-#     This procedure resolves any symlinks in the path thus creating a
-#     path without internal redirection. It assumes that the incoming
-#     path is absolute.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#
-# Results
-#     The path is modified in place.
-#
-
-proc ::tcltest::normalizePath {pathVar} {
-    upvar $pathVar path
-
-    set oldpwd [pwd]
-    catch {cd $path}
-    set path [pwd]
-    cd $oldpwd
-}
-
-# ::tcltest::MakeAbsolutePath --
-#
-#     This procedure checks whether the incoming path is absolute or not.
-#     Makes it absolute if it was not.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#     prefix  is optional, contains the path to use to make the other an
-#             absolute one. The current working directory is used if it was
-#             not specified.
-#
-# Results
-#     The path is modified in place.
-#
-
-proc ::tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
-    upvar $pathVar path
-
-    if {![string equal [file pathtype $path] "absolute"]} { 
-	if {$prefix == {}} {
-	    set prefix [pwd]
-	}
-
-	set path [file join $prefix $path] 
-    }
-}
-
-# ::tcltest::processCmdLineArgsFlagsHook --
+# tcltest::processCmdLineArgsFlagsHook --
 #
 #	This hook is used to add to the list of command line arguments that are
-#       processed by ::tcltest::processCmdLineArgs. 
+#       processed by tcltest::ProcessFlags.   It is called at the beginning of
+#       ProcessFlags.
 #
 
-if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
-    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc tcltest::processCmdLineArgsAddFlagsHook {} {}
 }
 
-# ::tcltest::processCmdLineArgsHook --
+# tcltest::processCmdLineArgsHook --
 #
 #	This hook is used to actually process the flags added by
-#       ::tcltest::processCmdLineArgsAddFlagsHook.
+#       tcltest::processCmdLineArgsAddFlagsHook.  It is called at the end of
+#       ProcessFlags. 
 #
 # Arguments:
 #	flags      The flags that have been pulled out of argv
 #
 
-if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
-    proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope tcltest info procs processCmdLineArgsHook] == {}} {
+    proc tcltest::processCmdLineArgsHook {flag} {}
 }
 
-# ::tcltest::processCmdLineArgs --
+# tcltest::ProcessFlags --
 #
-#	Use command line args to set the verbose, skip, and
-#	match, outputChannel, errorChannel, debug, and temporaryDirectory
-#       variables.   
-#
-#       This procedure must be run after constraints are initialized, because
-#       some constraints can be overridden.
+#	process command line arguments supplied in the flagArray - this is
+#       called by processCmdLineArgs
+#       modifies tcltest variables according to the content of the flagArray.
 #
 # Arguments:
-#	none
+#	flagArray - array containing name/value pairs of flags
 #
 # Results:
-#	Sets the above-named variables in the tcltest namespace.
-
-proc ::tcltest::processCmdLineArgs {} {
-    global argv
-
-    # The "argv" var doesn't exist in some cases, so use {}.
-
-    if {(![info exists argv]) || ([llength $argv] < 1)} {
-	set flagArray {}
-    } else {
-	set flagArray $argv
-    }
-    
-    # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
-    # Note that -verbose cannot be abbreviated to -v in wish because it
-    # conflicts with the wish option -visual.
+#	sets tcltest variables according to their values as defined by
+#       flagArray 
+#
+# Side effects:
+#	None.
 
+proc tcltest::ProcessFlags {flagArray} {
     # Process -help first
-    if {([lsearch -exact $flagArray {-help}] != -1) || \
-	    ([lsearch -exact $flagArray {-h}] != -1)} {
-	::tcltest::PrintUsageInfo
-	exit 1
-    }
-
-    if {[catch {array set flag $flagArray}]} {
-	::tcltest::PrintError "odd number of arguments specified on command line: \ 
-	$argv"
-	::tcltest::PrintUsageInfo
+    if {[lsearch -exact $flagArray {-help}] != -1} {
+	tcltest::PrintUsageInfo
 	exit 1
     }
+    
+    catch {array set flag $flagArray}
 
     # -help is not listed since it has already been processed
     lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints -args -testdir \
-	    -load -loadfile
+	    -preservecore -limitconstraints -testdir \
+	    -load -loadfile -asidefromdir \
+	    -relateddir -singleproc
     set defaultFlags [concat $defaultFlags \
-	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]
-
-    foreach arg $defaultFlags {
-	set abbrev [string range $arg 0 1]
-	if {([info exists flag($abbrev)]) && \
-		([lsearch -exact $flagArray $arg] < [lsearch -exact \
-		$flagArray $abbrev])} { 
-	    set flag($arg) $flag($abbrev)
-	}
-    }
-
-    # Set ::tcltest::parameters to the arg of the -args flag, if given
-    if {[info exists flag(-args)]} {
-	set ::tcltest::parameters $flag(-args)
-    }
-
-    # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+	    [tcltest::processCmdLineArgsAddFlagsHook ]]
 
+    # Set tcltest::verbose to the arg of the -verbose flag, if given
     if {[info exists flag(-verbose)]} {
-	set ::tcltest::verbose $flag(-verbose)
+	tcltest::verbose $flag(-verbose)
     }
 
-    # Set ::tcltest::match to the arg of the -match flag, if given.  
-
+    # Set tcltest::match to the arg of the -match flag, if given.  
     if {[info exists flag(-match)]} {
-	set ::tcltest::match $flag(-match)
+	tcltest::match $flag(-match)
     } 
 
-    # Set ::tcltest::skip to the arg of the -skip flag, if given
-
+    # Set tcltest::skip to the arg of the -skip flag, if given
     if {[info exists flag(-skip)]} {
-	set ::tcltest::skip $flag(-skip)
+	tcltest::skip $flag(-skip)
     }
 
     # Handle the -file and -notfile flags
     if {[info exists flag(-file)]} {
-	set ::tcltest::matchFiles $flag(-file)
+	tcltest::matchFiles $flag(-file)
     }
     if {[info exists flag(-notfile)]} {
-	set ::tcltest::skipFiles $flag(-notfile)
+	tcltest::skipFiles $flag(-notfile)
+    }
+
+    # Handle -relateddir and -asidefromdir flags
+    if {[info exists flag(-relateddir)]} {
+	tcltest::matchDirectories $flag(-relateddir)
+    }
+    if {[info exists flag(-asidefromdir)]} {
+	tcltest::skipDirectories $flag(-asidefromdir)
     }
 
     # Use the -constraints flag, if given, to turn on constraints that are
@@ -971,7 +1735,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-constraints)]} {
 	foreach elt $flag(-constraints) {
-	    set ::tcltest::testConstraints($elt) 1
+	    tcltest::testConstraint $elt 1
 	}
     }
 
@@ -980,87 +1744,35 @@ proc ::tcltest::processCmdLineArgs {} {
     # the -constraints flag was not specified, print out an error and exit.
     if {[info exists flag(-limitconstraints)]} {
 	if {![info exists flag(-constraints)]} {
-	    puts "You can only use the -limitconstraints flag with \
-		    -constraints"
-	    exit 1
-	}
-	set ::tcltest::limitConstraints $flag(-limitconstraints)
-	foreach elt [array names ::tcltest::testConstraints] {
-	    if {[lsearch -exact $flag(-constraints) $elt] == -1} {
-		set ::tcltest::testConstraints($elt) 0
-	    }
+	    set msg "-limitconstraints flag can only be used with -constraints"
+	    error $msg
 	}
+	tcltest::limitConstraints $flag(-limitconstraints)
     }
 
-    # Set the ::tcltest::temporaryDirectory to the arg of -tmpdir, if
+    # Set the tcltest::temporaryDirectory to the arg of -tmpdir, if
     # given.
-    # 
-    # If the path is relative, make it absolute.  If the file exists but
-    # is not a dir, then return an error.
-    #
-    # If ::tcltest::temporaryDirectory does not already exist, create it.
-    # If you cannot create it, then return an error.
 
-    set tmpDirError ""
     if {[info exists flag(-tmpdir)]} {
-	set ::tcltest::temporaryDirectory $flag(-tmpdir)
-	
-	MakeAbsolutePath ::tcltest::temporaryDirectory
-	set tmpDirError "bad argument \"$flag(-tmpdir)\" to -tmpdir: "
-    }
-    if {[file exists $::tcltest::temporaryDirectory]} {
-	::tcltest::CheckDirectory rw $::tcltest::temporaryDirectory $tmpDirError
-    } else {
-	file mkdir $::tcltest::temporaryDirectory
+	tcltest::temporaryDirectory $flag(-tmpdir)
     }
 
-    normalizePath ::tcltest::temporaryDirectory
-
-    # Set the ::tcltest::testsDirectory to the arg of -testdir, if
+    # Set the tcltest::testsDirectory to the arg of -testdir, if
     # given.
-    # 
-    # If the path is relative, make it absolute.  If the file exists but
-    # is not a dir, then return an error.
-    #
-    # If ::tcltest::temporaryDirectory does not already exist return an error.
     
-    set testDirError ""
     if {[info exists flag(-testdir)]} {
-	set ::tcltest::testsDirectory $flag(-testdir)
-	
-	MakeAbsolutePath ::tcltest::testsDirectory
-	set testDirError "bad argument \"$flag(-testdir)\" to -testdir: "
-    }
-    if {[file exists $::tcltest::testsDirectory]} {
-	::tcltest::CheckDirectory r $::tcltest::testsDirectory $testDirError
-    } else {
-	::tcltest::PrintError "$testDirError \"$::tcltest::testsDirectory\" \
-		does not exist"
-	exit 1
-    }
-    
-    normalizePath ::tcltest::testsDirectory
-    
-    # Save the names of files that already exist in
-    # the output directory.
-    foreach file [glob -nocomplain \
-	    [file join $::tcltest::temporaryDirectory *]] {
-	lappend ::tcltest::filesExisted [file tail $file]
+	tcltest::testsDirectory $flag(-testdir)
     }
 
     # If an alternate error or output files are specified, change the
     # default channels.
 
     if {[info exists flag(-outfile)]} {
-	set tmp $flag(-outfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set ::tcltest::outputChannel [open $tmp w]
+	tcltest::outputFile $flag(-outfile)
     } 
 
     if {[info exists flag(-errfile)]} {
-	set tmp $flag(-errfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set ::tcltest::errorChannel [open $tmp w]
+	tcltest::errorFile $flag(-errfile)
     }
 
     # If a load script was specified, either directly or through
@@ -1068,294 +1780,647 @@ proc ::tcltest::processCmdLineArgs {} {
     
     if {[info exists flag(-load)] &&  \
 	    ([lsearch -exact $flagArray -load] > \
-	    [lsearch -exact $flagArray -loadfile])} {
-	    set ::tcltest::loadScript $flag(-load)
+		[lsearch -exact $flagArray -loadfile])} {
+	tcltest::loadScript $flag(-load)
     }
     
     if {[info exists flag(-loadfile)] && \
 	    ([lsearch -exact $flagArray -loadfile] > \
-	    [lsearch -exact $flagArray -load]) } {
-	set tmp $flag(-loadfile)
-	MakeAbsolutePath tmp $::tcltest::temporaryDirectory
-	set tmp [open $tmp r]
-	set ::tcltest::loadScript [read $tmp]
-	close $tmp
+		[lsearch -exact $flagArray -load]) } {
+	tcltest::loadFile $flag(-loadfile)
     }
 
     # If the user specifies debug testing, print out extra information during
     # the run.
     if {[info exists flag(-debug)]} {
-	set ::tcltest::debug $flag(-debug)
+	tcltest::debug $flag(-debug)
     }
 
     # Handle -preservecore
     if {[info exists flag(-preservecore)]} {
-	set ::tcltest::preserveCore $flag(-preservecore)
+	tcltest::preserveCore $flag(-preservecore)
+    }
+
+    # Handle -singleproc flag
+    if {[info exists flag(-singleproc)]} {
+	tcltest::singleProcess $flag(-singleproc)
     }
 
     # Call the hook
-    ::tcltest::processCmdLineArgsHook [array get flag]
+    tcltest::processCmdLineArgsHook [array get flag]
+    return
+}
 
-    # Spit out everything you know if we're at a debug level 2 or greater
+# tcltest::processCmdLineArgs --
+#
+#	Use command line args to set tcltest namespace variables.
+#
+#       This procedure must be run after constraints are initialized, because
+#       some constraints can be overridden.
+# 
+#       Set variables based on the contents of the environment variable
+#       TCLTEST_OPTIONS first, then override with command-line options, if
+#       specified. 
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Sets the above-named variables in the tcltest namespace.
+# 
+# Side Effects:
+#       None.
+#
+
+proc tcltest::processCmdLineArgs {} {
+    global argv
+
+    # If the TCLTEST_OPTIONS environment variable exists, parse it first, then
+    # the argv list.  The command line argument parsing will be a two-pass
+    # affair from now on, so that TCLTEST_OPTIONS contain the default options.
+    # These can be overridden by the command line flags.
+
+    if {[info exists ::env(TCLTEST_OPTIONS)]} {
+	tcltest::ProcessFlags $::env(TCLTEST_OPTIONS)
+    } 
+
+    # The "argv" var doesn't exist in some cases, so use {}.
+    if {(![info exists argv]) || ([llength $argv] < 1)} {
+	set flagArray {}
+    } else {
+	set flagArray $argv
+    }
+    
+    tcltest::ProcessFlags $flagArray
 
-    DebugPuts    2 "Flags passed into tcltest:"
-    DebugPArray  2 flag
-    DebugPuts    2 "::tcltest::debug              = $::tcltest::debug"
-    DebugPuts    2 "::tcltest::testsDirectory     = $::tcltest::testsDirectory"
-    DebugPuts    2 "::tcltest::workingDirectory   = $::tcltest::workingDirectory"
-    DebugPuts    2 "::tcltest::temporaryDirectory = $::tcltest::temporaryDirectory"
-    DebugPuts    2 "::tcltest::outputChannel      = $::tcltest::outputChannel"
-    DebugPuts    2 "::tcltest::errorChannel       = $::tcltest::errorChannel"
-    DebugPuts    2 "Original environment (::tcltest::originalEnv):"
-    DebugPArray  2 ::tcltest::originalEnv
+    # Spit out everything you know if we're at a debug level 2 or greater
+    DebugPuts 2 "Flags passed into tcltest:"
+    if {[info exists ::env(TCLTEST_OPTIONS)]} {
+	DebugPuts 2 "    ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
+    }
+    if {[info exists argv]} {
+	DebugPuts 2 "    argv: $argv"
+    }
+    DebugPuts    2 "tcltest::debug              = [tcltest::debug]"
+    DebugPuts    2 "tcltest::testsDirectory     = [tcltest::testsDirectory]"
+    DebugPuts    2 "tcltest::workingDirectory   = [tcltest::workingDirectory]"
+    DebugPuts    2 "tcltest::temporaryDirectory = [tcltest::temporaryDirectory]"
+    DebugPuts    2 "tcltest::outputChannel      = [outputChannel]"
+    DebugPuts    2 "tcltest::errorChannel       = [errorChannel]"
+    DebugPuts    2 "Original environment (tcltest::originalEnv):"
+    DebugPArray  2 tcltest::originalEnv
     DebugPuts    2 "Constraints:"
-    DebugPArray  2 ::tcltest::testConstraints
+    DebugPArray  2 tcltest::testConstraints
+    return
 }
 
-# ::tcltest::loadTestedCommands --
+#####################################################################
+
+# Code to run the tests goes here.
+
+# tcltest::testPuts --
 #
-#     Uses the specified script to load the commands to test. Allowed to
-#     be empty, as the tested commands could have been compiled into the
-#     interpreter.
+#	Used to redefine puts in test environment.
+#       Stores whatever goes out on stdout in tcltest::outData and stderr in 
+#       tcltest::errData before sending it on to the regular puts.
 #
-# Arguments
-#     none
+# Arguments:
+#	same as standard puts
 #
-# Results
-#     none
+# Results:
+#	none
+#
+# Side effects:
+#       Intercepts puts; data that would otherwise go to stdout, stderr, or
+#       file channels specified in tcltest::outputChannel and errorChannel does
+#       not get sent to the normal puts function.
+
+proc tcltest::testPuts {args} {
+    set len [llength $args]
+    if {$len == 1} {
+	# Only the string to be printed is specified
+	append tcltest::outData "[lindex $args 0]\n"
+	return
+#	return [tcltest::normalPuts [lindex $args 0]]
+    } elseif {$len == 2} {
+	# Either -nonewline or channelId has been specified
+	if {[regexp {^-nonewline} [lindex $args 0]]} {
+	    append tcltest::outData "[lindex $args end]"
+	    return
+#	    return [tcltest::normalPuts -nonewline [lindex $args end]]
+	} else {
+	    set channel [lindex $args 0]
+	}
+    } elseif {$len == 3} {
+	if {[lindex $args 0] == "-nonewline"} {
+	    # Both -nonewline and channelId are specified, unless it's an
+	    # error.  -nonewline is supposed to be argv[0].
+	    set channel [lindex $args 1]
+	}
+    }
 
-proc ::tcltest::loadTestedCommands {} {
-    if {$::tcltest::loadScript == {}} {
+    if {[info exists channel]} {
+	if {($channel == [outputChannel]) || ($channel == "stdout")} {
+	    append tcltest::outData "[lindex $args end]\n"
+	} elseif {($channel == [errorChannel]) || ($channel == "stderr")} {
+	    append tcltest::errData "[lindex $args end]\n"
+	}
 	return
+	# return [tcltest::normalPuts [lindex $args 0] [lindex $args end]]
     }
-    
-    uplevel #0 $::tcltest::loadScript
+
+    # If we haven't returned by now, we don't know how to handle the input.
+    # Let puts handle it.
+    return [eval tcltest::normalPuts $args]
 }
 
-# ::tcltest::cleanupTests --
+# tcltest::testEval --
 #
-# Remove files and dirs created using the makeFile and makeDirectory
-# commands since the last time this proc was invoked.
+#	Evaluate the script in the test environment.  If ignoreOutput is 
+#       false, store data sent to stderr and stdout in tcltest::outData and 
+#       tcltest::errData.  Otherwise, ignore this output altogether.
 #
-# Print the names of the files created without the makeFile command
-# since the tests were invoked.
+# Arguments:
+#	script             Script to evaluate
+#       ?ignoreOutput?     Indicates whether or not to ignore output sent to
+#                          stdout & stderr
 #
-# Print the number tests (total, passed, failed, and skipped) since the
-# tests were invoked.
-# 
-# Restore original environment (as reported by special variable env).
-
-proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
-
-    set testFileName [file tail [info script]]
+# Results:
+#	result from running the script
+#
+# Side effects:
+#	Empties the contents of tcltest::outData and tcltest::errData before
+#       running a test if ignoreOutput is set to 0. 
 
-    # Call the cleanup hook
-    ::tcltest::cleanupTestsHook 
+proc tcltest::testEval {script {ignoreOutput 1}} {
+    DebugPuts 3 "testEval called" 
+    if {!$ignoreOutput} {
+	set tcltest::outData {}
+	set tcltest::errData {}
+	uplevel rename ::puts tcltest::normalPuts
+	uplevel rename tcltest::testPuts ::puts
+    }
+    set result [uplevel $script]
+    if {!$ignoreOutput} {
+	uplevel rename ::puts tcltest::testPuts
+	uplevel rename tcltest::normalPuts ::puts
+    }
+    return $result
+}
 
-    # Remove files and directories created by the :tcltest::makeFile and
-    # ::tcltest::makeDirectory procedures.
-    # Record the names of files in ::tcltest::workingDirectory that were not
-    # pre-existing, and associate them with the test file that created them.
+# compareStrings --
+#
+#	compares the expected answer to the actual answer, depending on the
+#       mode provided.  Mode determines whether a regexp, exact, or glob
+#       comparison is done.
+#
+# Arguments:
+#	actual - string containing the actual result
+#       expected - pattern to be matched against
+#       mode - type of comparison to be done
+#
+# Results:
+#	result of the match
+#
+# Side effects:
+#	None.
 
-    if {!$calledFromAllFile} {
-	foreach file $::tcltest::filesMade {
-	    if {[file exists $file]} {
-		catch {file delete -force $file}
-	    }
+proc tcltest::compareStrings {actual expected mode} {
+    switch -- $mode {
+	exact {
+	    set retval [string equal $actual $expected]
 	}
-	set currentFiles {}
-	foreach file [glob -nocomplain \
-		[file join $::tcltest::temporaryDirectory *]] {
-	    lappend currentFiles [file tail $file]
+	glob {
+	    set retval [string match $expected $actual]
 	}
-	set newFiles {}
-	foreach file $currentFiles {
-	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
-		lappend newFiles $file
-	    }
-	}
-	set ::tcltest::filesExisted $currentFiles
-	if {[llength $newFiles] > 0} {
-	    set ::tcltest::createdNewFiles($testFileName) $newFiles
+	regexp {
+	    set retval [regexp -- $expected $actual]
 	}
     }
+    return $retval
+}
 
-    if {$calledFromAllFile || $::tcltest::testSingleFile} {
 
-	# print stats
+#
+# tcltest::substArguments list
+#
+# This helper function takes in a list of words, then perform a
+# substitution on the list as though each word in the list is a
+# separate argument to the Tcl function.  For example, if this
+# function is invoked as:
+#
+#      substArguments {$a {$a}}
+#
+# Then it is as though the function is invoked as:
+#
+#      substArguments $a {$a}
+#
+# This code is adapted from Paul Duffin's function "SplitIntoWords".
+# The original function can be found  on:
+#
+#      http://purl.org/thecliff/tcl/wiki/858.html
+#
+# Results:
+#     a list containing the result of the substitution
+#
+# Exceptions:
+#     An error may occur if the list containing unbalanced quote or
+#     unknown variable.
+#
+# Side Effects:
+#     None.
+#
+
+proc tcltest::substArguments {argList} {
+
+    # We need to split the argList up into tokens but cannot use
+    # list operations as they throw away some significant
+    # quoting, and [split] ignores braces as it should.
+    # Therefore what we do is gradually build up a string out of
+    # whitespace seperated strings. We cannot use [split] to
+    # split the argList into whitespace seperated strings as it
+    # throws away the whitespace which maybe important so we
+    # have to do it all by hand.
+
+    set result {}
+    set token ""
+
+    while {[string length $argList]} {
+        # Look for the next word containing a quote: " { }
+        if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \
+                $argList all]} {
+            # Get the text leading up to this word, but not
+            # including this word, from the argList.
+            set text [string range $argList 0 \
+                    [expr {[lindex $all 0] - 1}]]
+            # Get the word with the quote
+            set word [string range $argList \
+                    [lindex $all 0] [lindex $all 1]]
+
+            # Remove all text up to and including the word from the
+            # argList.
+            set argList [string range $argList \
+                    [expr {[lindex $all 1] + 1}] end]
+        } else {
+            # Take everything up to the end of the argList.
+            set text $argList
+            set word {}
+            set argList {}
+        }
+        
+        if {$token != {}} {
+            # If we saw a word with quote before, then there is a
+            # multi-word token starting with that word.  In this case,
+            # add the text and the current word to this token.
+            append token $text $word
+        } else {
+            # Add the text to the result.  There is no need to parse
+            # the text because it couldn't be a part of any multi-word
+            # token.  Then start a new multi-word token with the word
+            # because we need to pass this token to the Tcl parser to
+            # check for balancing quotes
+            append result $text
+            set token $word
+        }
+        
+        if { [catch {llength $token} length] == 0 && $length == 1} {
+            # The token is a valid list so add it to the result.
+            # lappend result [string trim $token]
+            append result \{$token\}
+            set token {}
+        }
+    }
 
-	puts -nonewline $::tcltest::outputChannel "$testFileName:"
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    puts -nonewline $::tcltest::outputChannel \
-		    "\t$index\t$::tcltest::numTests($index)"
-	}
-	puts $::tcltest::outputChannel ""
+    # If the last token has not been added to the list then there
+    # is a problem.
+    if { [string length $token] } {
+        error "incomplete token \"$token\""
+    }
 
-	# print number test files sourced
-	# print names of files that ran tests which failed
+    return $result
+}
 
-	if {$calledFromAllFile} {
-	    puts $::tcltest::outputChannel \
-		    "Sourced $::tcltest::numTestFiles Test Files."
-	    set ::tcltest::numTestFiles 0
-	    if {[llength $::tcltest::failFiles] > 0} {
-		puts $::tcltest::outputChannel \
-			"Files with failing tests: $::tcltest::failFiles"
-		set ::tcltest::failFiles {}
-	    }
-	}
 
-	# if any tests were skipped, print the constraints that kept them
-	# from running.
+# tcltest::test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If tcltest::verbose has been set, it also prints a message even if the
+# test succeeds.  The test will be skipped if it doesn't match the
+# tcltest::match variable, if it matches an element in
+# tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+# 
+# If testLevel is 1, then this is a top level test, and we record pass/fail
+# information; otherwise, this information is not logged and is not added to
+# running totals.
+# 
+# Attributes:
+#   Only description is a required attribute.  All others are optional.
+#   Default values are indicated.
+# 
+#   constraints -		A list of one or more keywords, each of
+#			        which must be the name of an element in
+#			        the array "tcltest::testConstraints".  If any
+#                               of these elements is zero, the test is
+#                               skipped. This attribute is optional; default is {}
+#   body -		        Script to run to carry out the test.  It must
+#			        return a result that can be checked for
+#			        correctness.  This attribute is optional;
+#                               default is {}
+#   result -	                Expected result from script.  This attribute is
+#                               optional; default is {}.
+#   output -                    Expected output sent to stdout.  This attribute
+#                               is optional; default is {}.  
+#   errorOutput -               Expected output sent to stderr.  This attribute
+#                               is optional; default is {}.  
+#   returnCodes -              Expected return codes.  This attribute is
+#                               optional; default is {0 2}.
+#   setup -                     Code to run before $script (above).  This
+#                               attribute is optional; default is {}.
+#   cleanup -                   Code to run after $script (above).  This
+#                               attribute is optional; default is {}.
+#   match -                     specifies type of matching to do on result,
+#                               output, errorOutput; this must be one of: exact,
+#                               glob, regexp.  default is exact.
+#
+# Arguments:
+#   name -		Name of test, in the form foo-1.2.
+#   description -	Short textual description of the test, to
+#  		  	help humans understand what it does.
+# 
+# Results:
+#	0 if the command ran successfully; 1 otherwise.
+#
+# Side effects:
+#       None.
+# 
 
-	set constraintList [array names ::tcltest::skippedBecause]
-	if {[llength $constraintList] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "Number of tests skipped for each constraint:"
-	    foreach constraint [lsort $constraintList] {
-		puts $::tcltest::outputChannel \
-			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
-		unset ::tcltest::skippedBecause($constraint)
-	    }
-	}
+proc tcltest::test {name description args} {
+    DebugPuts 3 "Test $name $args"
 
-	# report the names of test files in ::tcltest::createdNewFiles, and
-	# reset the array to be empty.
+    incr tcltest::testLevel
 
-	set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
-	if {[llength $testFilesThatTurded] > 0} {
-	    puts $::tcltest::outputChannel "Warning: files left behind:"
-	    foreach testFile $testFilesThatTurded {
-		puts $::tcltest::outputChannel \
-			"\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
-		unset ::tcltest::createdNewFiles($testFile)
+    # Pre-define everything to null except output and errorOutput.  We
+    # determine whether or not to trap output based on whether or not these
+    # variables (output & errorOutput) are defined.
+    foreach item {constraints setup cleanup body result returnCodes match} {
+	set $item {}
+    }
+
+    # Set the default match mode
+    set match exact
+
+    # Set the default match values for return codes (0 is the standard expected
+    # return value if everything went well; 2 represents 'return' being used in
+    # the test script).
+    set returnCodes [list 0 2]
+
+    # The old test format can't have a 3rd argument (constraints or script)
+    # that starts with '-'.
+    if {[llength $args] == 0} {
+	puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?options?\"}"
+	incr tcltest::testLevel -1
+	return 1
+    } elseif {([string index [lindex $args 0] 0] == "-") || ([llength $args] == 1)} {
+	
+	if {[llength $args] == 1} {
+	    set list [substArguments [lindex $args 0]]
+	    foreach {element value} $list { 
+		set testAttributes($element) $value
+	    }
+	    foreach item {constraints match setup body cleanup \
+		    result returnCodes output errorOutput} {
+		if {[info exists testAttributes([subst -$item])]} {
+		    set testAttributes([subst -$item]) \
+			    [uplevel concat $testAttributes([subst -$item])]
+		}
 	    }
+	} else {
+	    array set testAttributes $args
 	}
 
-	# reset filesMade, filesExisted, and numTests
+	set validFlags {-setup -cleanup -body -result -returnCodes -match \
+		-output -errorOutput -constraints}
 
-	set ::tcltest::filesMade {}
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    set ::tcltest::numTests($index) 0
+	foreach flag [array names testAttributes] {
+	    if {[lsearch -exact $validFlags $flag] == -1} {
+		puts [errorChannel] "test $name: bad flag $flag supplied to tcltest::test"
+		incr tcltest::testLevel -1
+		return 1
+	    }
 	}
 
-	# exit only if running Tk in non-interactive mode
-
-	global tk_version tcl_interactive
-	if {[info exists tk_version] && ![info exists tcl_interactive]} {
-	    exit
+	# store whatever the user gave us
+	foreach item [array names testAttributes] {
+	    set [string trimleft $item "-"] $testAttributes($item)
 	}
-    } 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
+	# Check the values supplied for -match
+	if {[lsearch {regexp glob exact} $match] == -1} {
+	    puts [errorChannel] "test $name: {bad value for -match: must be one of exact, glob, regexp}"
+	    incr tcltest::testLevel -1
+	    return 1
+	}
 
-	incr ::tcltest::numTestFiles
-	if {($::tcltest::currentFailure) && \
-		([lsearch -exact $::tcltest::failFiles $testFileName] == -1)} {
-	    lappend ::tcltest::failFiles $testFileName
+	# Replace symbolic valies supplied for -returnCodes
+	regsub -nocase normal $returnCodes 0 returnCodes
+	regsub -nocase error $returnCodes 1 returnCodes
+	regsub -nocase return $returnCodes 2 returnCodes
+	regsub -nocase break $returnCodes 3 returnCodes
+	regsub -nocase continue $returnCodes 4 returnCodes 
+    } else {
+	# This is parsing for the old test command format; it is here for
+	# backward compatibility.
+	set result [lindex $args end]
+	if {[llength $args] == 2} {
+	    set body [lindex $args 0]
+	} elseif {[llength $args] == 3} {
+	    set constraints [lindex $args 0]
+	    set body [lindex $args 1]
+	} else {
+	    puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?constraints? script expectedResult\"}"
+	    incr tcltest::testLevel -1
+	    return 1
 	}
-	set ::tcltest::currentFailure false
+    } 
 
-	# restore the environment to the state it was in before this package
-	# was loaded
+    set setupFailure 0
+    set cleanupFailure 0
 
-	set newEnv {}
-	set changedEnv {}
-	set removedEnv {}
-	foreach index [array names ::env] {
-	    if {![info exists ::tcltest::originalEnv($index)]} {
-		lappend newEnv $index
-		unset ::env($index)
-	    } else {
-		if {$::env($index) != $::tcltest::originalEnv($index)} {
-		    lappend changedEnv $index
-		    set ::env($index) $::tcltest::originalEnv($index)
-		}
-	    }
+    # Run the setup script
+    if {[catch {uplevel $setup} setupMsg]} {
+	set setupFailure 1
+    }
+
+    # run the test script
+    set command [list tcltest::runTest $name $description $body \
+	    $result $constraints]  
+    if {!$setupFailure} {
+	if {[info exists output] || [info exists errorOutput]} {
+	    set testResult [uplevel tcltest::testEval [list $command] 0]
+	} else {
+	    set testResult [uplevel tcltest::testEval [list $command] 1]
 	}
-	foreach index [array names ::tcltest::originalEnv] {
-	    if {![info exists ::env($index)]} {
-		lappend removedEnv $index
-		set ::env($index) $::tcltest::originalEnv($index)
+    } else {
+	set testResult setupFailure
+    }
+
+    # Run the cleanup code
+    if {[catch {uplevel $cleanup} cleanupMsg]} {
+	set cleanupFailure 1
+    }
+
+    # If testResult is an empty list, then the test was skipped
+    if {$testResult != {}} {
+	set coreFailure 0
+	set coreMsg ""
+	# check for a core file first - if one was created by the test, then
+	# the test failed
+	if {$tcltest::preserveCore} {
+	    set currentTclPlatform [array get tcl_platform]
+	    if {[file exists [file join [tcltest::workingDirectory] core]]} {
+		# There's only a test failure if there is a core file and (1)
+		# there previously wasn't one or (2) the new one is different
+		# from the old one. 
+		if {[info exists coreModTime]} {
+		    if {$coreModTime != [file mtime \
+			    [file join [tcltest::workingDirectory] core]]} {
+			set coreFailure 1
+		    } 
+		} else {
+		    set coreFailure 1
+		}
+		
+		if {($tcltest::preserveCore > 1) && ($coreFailure)} {
+		    append coreMsg "\nMoving file to: [file join $tcltest::temporaryDirectory core-$name]"
+		    catch {file rename -force \
+			    [file join [tcltest::workingDirectory] core] \
+			    [file join $tcltest::temporaryDirectory \
+				core-$name]} msg
+		    if {[string length $msg] > 0} {
+			append coreMsg "\nError: Problem renaming core file: $msg"
+		    }
+		}
 	    }
+	    array set tcl_platform $currentTclPlatform
 	}
-	if {[llength $newEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements created:\t$newEnv"
-	}
-	if {[llength $changedEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements changed:\t$changedEnv"
+
+	set actualAnswer [lindex $testResult 0]
+	set code [lindex $testResult end]
+
+	# If expected output/error strings exist, we have to compare
+	# them.  If the comparison fails, then so did the test.
+	set outputFailure 0
+	set errorFailure 0
+	if {[info exists output]} { 
+	    set outputFailure [expr ![compareStrings $tcltest::outData \
+		    $output $match]]
+	} 
+	if {[info exists errorOutput]} {
+	    set errorFailure [expr ![compareStrings $tcltest::errData \
+		    $errorOutput $match]]
 	}
-	if {[llength $removedEnv] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "env array elements removed:\t$removedEnv"
+
+	set testFailed 1
+	set codeFailure 0
+	set scriptFailure 0
+
+	# check if the return code matched the expected return code
+	if {[lsearch -exact $returnCodes $code] == -1} {
+	    set codeFailure 1
+	} 
+
+	# check if the answer matched the expected answer
+	if {[compareStrings $actualAnswer $result $match] == 0} {
+	    set scriptFailure 1
 	}
 
-	set changedTclPlatform {}
-	foreach index [array names ::tcltest::originalTclPlatform] {
-	    if {$::tcl_platform($index) != \
-		    $::tcltest::originalTclPlatform($index)} { 
-		lappend changedTclPlatform $index
-		set ::tcl_platform($index) \
-			$::tcltest::originalTclPlatform($index) 
+	# if we didn't experience any failures, then we passed
+	if {!($setupFailure || $cleanupFailure || $coreFailure || \
+		$outputFailure || $errorFailure || $codeFailure || \
+		$scriptFailure)} {
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Passed)
+		if {[tcltest::isVerbose pass]} {
+		    puts [outputChannel] "++++ $name PASSED"
+		}
 	    }
+	    set testFailed 0
 	}
-	if {[llength $changedTclPlatform] > 0} {
-	    puts $::tcltest::outputChannel \
-		    "tcl_platform array elements changed:\t$changedTclPlatform"
-	} 
 
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	    if {$::tcltest::preserveCore > 1} {
-		puts $::tcltest::outputChannel "produced core file! \
-			Moving file to: \
-			[file join $::tcltest::temporaryDirectory core-$name]"
-		flush $::tcltest::outputChannel
-		catch {file rename -force \
-			[file join $::tcltest::workingDirectory core] \
-			[file join $::tcltest::temporaryDirectory \
-			core-$name]} msg
-		if {[string length $msg] > 0} {
-		    ::tcltest::PrintError "Problem renaming file: $msg"
+	if {$testFailed} {
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Failed)
+	    }
+	    set tcltest::currentFailure true
+	    if {![tcltest::isVerbose body]} {
+		set body ""
+	    }	
+	    puts [outputChannel] "\n==== $name [string trim $description] FAILED"
+	    if {$body != ""} {
+		puts [outputChannel] "==== Contents of test case:"
+		puts [outputChannel] $body
+	    }
+	    if {$setupFailure} {
+		puts [outputChannel] "---- Test setup failed:\n$setupMsg"
+	    } 
+	    if {$scriptFailure} {
+		puts [outputChannel] "---- Result was:\n$actualAnswer"
+		puts [outputChannel] "---- Result should have been ($match matching):\n$result"
+	    }
+	    if {$codeFailure} {
+		switch -- $code {
+		    0 { set msg "Test completed normally" }
+		    1 { set msg "Test generated error" }
+		    2 { set msg "Test generated return exception" }
+		    3 { set msg "Test generated break exception" }
+		    4 { set msg "Test generated continue exception" } 
+		    default { set msg "Test generated exception" }
 		}
-	    } else {
-		# Print a message if there is a core file and (1) there
-		# previously wasn't one or (2) the new one is different from
-		# the old one. 
-
-		if {[info exists ::tcltest::coreModificationTime]} {
-		    if {$::tcltest::coreModificationTime != [file mtime \
-			    [file join $::tcltest::workingDirectory core]]} {
-			puts $::tcltest::outputChannel "A core file was created!"
+		puts [outputChannel] "---- $msg; Return code was: $code"
+		puts [outputChannel] "---- Return code should have been one of: $returnCodes"
+		if {[tcltest::isVerbose error]} {
+		    if {[info exists ::errorInfo]} {
+			puts [outputChannel] "---- errorInfo: $::errorInfo"
+			puts [outputChannel] "---- errorCode: $::errorCode"
 		    }
-		} else {
-		    puts $::tcltest::outputChannel "A core file was created!"
-		} 
+		}
+	    }
+	    if {$outputFailure} {
+		puts [outputChannel] "---- Output was:\n$tcltest::outData"
+		puts [outputChannel] "---- Output should have been ($match matching):\n$output"
+	    }
+	    if {$errorFailure} {
+		puts [outputChannel] "---- Error output was:\n$tcltest::errData"
+		puts [outputChannel] "---- Error output should have been ($match matching):\n$errorOutput"
+	    }
+	    if {$cleanupFailure} {
+		puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
 	    }
+	    if {$coreFailure} {
+		puts [outputChannel] "---- Core file produced while running test! $coreMsg"
+	    }
+	    puts [outputChannel] "==== $name FAILED\n"
+
 	}
     }
+    
+    incr tcltest::testLevel -1
+    return 0
 }
 
-# ::tcltest::cleanupTestsHook --
-#
-#	This hook allows a harness that builds upon tcltest to specify
-#       additional things that should be done at cleanup.
-#
-
-if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
-    proc ::tcltest::cleanupTestsHook {} {}
-}
 
-# test --
+# runTest --
 #
+# This is the defnition of the version 1.0 test routine for tcltest.  It is
+# provided here for backward compatibility.  It is also used as the 'backbone'
+# of the test procedure, as in, this is where all the work really gets done.
+# 
 # This procedure runs a test and prints an error message if the test fails.
-# If ::tcltest::verbose has been set, it also prints a message even if the
+# If tcltest::verbose has been set, it also prints a message even if the
 # test succeeds.  The test will be skipped if it doesn't match the
-# ::tcltest::match variable, if it matches an element in
-# ::tcltest::skip, or if one of the elements of "constraints" turns
+# tcltest::match variable, if it matches an element in
+# tcltest::skip, or if one of the elements of "constraints" turns
 # out not to be true.
 #
 # Arguments:
@@ -1364,81 +2429,93 @@ if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
 #			help humans understand what it does.
 # constraints -		A list of one or more keywords, each of
 #			which must be the name of an element in
-#			the array "::tcltest::testConstraints".  If any of these
+#			the array "tcltest::testConstraints".  If any of these
 #			elements is zero, the test is skipped.
 #			This argument may be omitted.
 # script -		Script to run to carry out the test.  It must
 #			return a result that can be checked for
 #			correctness.
 # expectedAnswer -	Expected result from script.
+# 
+# Behavior depends on the value of testLevel; if testLevel is 1 (top level),
+# then events are logged and we track the number of tests run/skipped and why.
+# Otherwise, we don't track this information.
+# 
+# Results:
+#    empty list if test is skipped; otherwise returns list containing
+#    actual returned value from the test and the return code.
+# 
+# Side Effects:
+#    none.
+#
 
-proc ::tcltest::test {name description script expectedAnswer args} {
-
-    DebugPuts 3 "Running $name ($description)"
-
-    incr ::tcltest::numTests(Total)
+proc tcltest::runTest {name description script expectedAnswer constraints} {
 
+    if {$tcltest::testLevel == 1} {
+	incr tcltest::numTests(Total)
+    }
+    
     # skip the test if it's name matches an element of skip
-
-    foreach pattern $::tcltest::skip {
+    foreach pattern $tcltest::skip {
 	if {[string match $pattern $name]} {
-	    incr ::tcltest::numTests(Skipped)
-	    DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedSkip}
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedSkip}
+	    }
 	    return
 	}
     }
 
     # skip the test if it's name doesn't match any element of match
-
-    if {[llength $::tcltest::match] > 0} {
+    if {[llength $tcltest::match] > 0} {
 	set ok 0
-	foreach pattern $::tcltest::match {
+	foreach pattern $tcltest::match {
 	    if {[string match $pattern $name]} {
 		set ok 1
 		break
 	    }
         }
 	if {!$ok} {
-	    incr ::tcltest::numTests(Skipped)
-	    DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedNonMatch}
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedNonMatch}
+	    }
 	    return
 	}
     }
 
-    set i [llength $args]
-    if {$i == 0} {
-	set constraints {}
+    DebugPuts 3 "Running $name ($description) {$script} {$expectedAnswer} $constraints"
+
+    if {$constraints == {}} {
 	# If we're limited to the listed constraints and there aren't any
 	# listed, then we shouldn't run the test.
-	if {$::tcltest::limitConstraints} {
-	    ::tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
-	    incr ::tcltest::numTests(Skipped)
+	if {$tcltest::limitConstraints} {
+	    tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+	    }
 	    return
 	}
-    } elseif {$i == 1} {
-
-	# "constraints" argument exists;  shuffle arguments down, then
+    } else {
+	# "constraints" argument exists; 
 	# make sure that the constraints are satisfied.
 
-	set constraints $script
-	set script $expectedAnswer
-	set expectedAnswer [lindex $args 0]
 	set doTest 0
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
-	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.\w]+} $constraints \
-		    {$::tcltest::testConstraints(&)} c
+	    # $tcltest::testConstraints(a) || $tcltest::testConstraints(b).
+	    regsub -all {[.\w]+} $constraints \
+		    {$tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
 	    set doTest 1
 	    foreach constraint $constraints {
-		if {(![info exists ::tcltest::testConstraints($constraint)]) \
-			|| (!$::tcltest::testConstraints($constraint))} {
+		if {(![info exists tcltest::testConstraints($constraint)]) \
+			|| (!$tcltest::testConstraints($constraint))} {
 		    set doTest 0
 
 		    # store the constraint that kept the test from running
@@ -1447,28 +2524,30 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 		}
 	    }
 	}
+	
 	if {$doTest == 0} {
-	    if {[string first s $::tcltest::verbose] != -1} {
-		puts $::tcltest::outputChannel "++++ $name SKIPPED: $constraints"
+	    if {[tcltest::isVerbose skip]} {
+		puts [outputChannel] "++++ $name SKIPPED: $constraints"
+	    }
+	    
+	    if {$tcltest::testLevel == 1} {
+		incr tcltest::numTests(Skipped)
+		tcltest::AddToSkippedBecause $constraints
 	    }
-
-	    incr ::tcltest::numTests(Skipped)
-	    ::tcltest::AddToSkippedBecause $constraints
 	    return	
 	}
-    } else {
-	error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
-    }   
+    }
 
     # Save information about the core file.  You need to restore the original
-    # tcl_platform environment because some of the tests mess with tcl_platform.
+    # tcl_platform environment because some of the tests mess with
+    # tcl_platform.
 
-    if {$::tcltest::preserveCore} {
+    if {$tcltest::preserveCore} {
 	set currentTclPlatform [array get tcl_platform]
-	array set tcl_platform $::tcltest::originalTclPlatform
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	array set tcl_platform $tcltest::originalTclPlatform
+	if {[file exists [file join [tcltest::workingDirectory] core]]} {
 	    set coreModTime [file mtime [file join \
-		    $::tcltest::workingDirectory core]]
+		    [tcltest::workingDirectory] core]]
 	}
 	array set tcl_platform $currentTclPlatform
     }
@@ -1480,107 +2559,288 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	memory tag $name
     }
 
+    if {[tcltest::isVerbose start]} {
+	puts [outputChannel] "---- $name start"
+	flush [outputChannel]
+    }
+    
     set code [catch {uplevel $script} actualAnswer]
-    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
-	incr ::tcltest::numTests(Passed)
-	if {[string first p $::tcltest::verbose] != -1} {
-	    puts $::tcltest::outputChannel "++++ $name PASSED"
+	    
+    return [list $actualAnswer $code]
+}
+
+#####################################################################
+
+# tcltest::cleanupTestsHook --
+#
+#	This hook allows a harness that builds upon tcltest to specify
+#       additional things that should be done at cleanup.
+#
+
+if {[namespace inscope tcltest info procs cleanupTestsHook] == {}} {
+    proc tcltest::cleanupTestsHook {} {}
+}
+
+# tcltest::cleanupTests --
+#
+# 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 tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+# 
+# Restore original environment (as reported by special variable env).
+# 
+# Arguments:
+#      calledFromAllFile - if 0, behave as if we are running a single test file
+#      within an entire suite of tests.  if we aren't running a single test
+#      file, then don't report status.  check for new files created during the
+#      test run and report on them.  if 1, report collated status from all the
+#      test file runs.
+# 
+# Results: 
+#      None.
+# 
+# Side Effects: 
+#      None
+# 
+
+proc tcltest::cleanupTests {{calledFromAllFile 0}} {
+
+    set testFileName [file tail [info script]]
+
+    # Call the cleanup hook
+    tcltest::cleanupTestsHook 
+
+    # Remove files and directories created by the :tcltest::makeFile and
+    # tcltest::makeDirectory procedures.
+    # Record the names of files in tcltest::workingDirectory that were not
+    # pre-existing, and associate them with the test file that created them.
+
+    if {!$calledFromAllFile} {
+	foreach file $tcltest::filesMade {
+	    if {[file exists $file]} {
+		catch {file delete -force $file}
+	    }
+	}
+	set currentFiles {}
+	foreach file [glob -nocomplain \
+		[file join $tcltest::temporaryDirectory *]] {
+	    lappend currentFiles [file tail $file]
+	}
+	set newFiles {}
+	foreach file $currentFiles {
+	    if {[lsearch -exact $tcltest::filesExisted $file] == -1} {
+		lappend newFiles $file
+	    }
+	}
+	set tcltest::filesExisted $currentFiles
+	if {[llength $newFiles] > 0} {
+	    set tcltest::createdNewFiles($testFileName) $newFiles
+	}
+    }
+
+    if {$calledFromAllFile || $tcltest::testSingleFile} {
+
+	# print stats
+
+	puts -nonewline [outputChannel] "$testFileName:"
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    puts -nonewline [outputChannel] \
+		    "\t$index\t$tcltest::numTests($index)"
+	}
+	puts [outputChannel] ""
+
+	# print number test files sourced
+	# print names of files that ran tests which failed
+
+	if {$calledFromAllFile} {
+	    puts [outputChannel] \
+		    "Sourced $tcltest::numTestFiles Test Files."
+	    set tcltest::numTestFiles 0
+	    if {[llength $tcltest::failFiles] > 0} {
+		puts [outputChannel] \
+			"Files with failing tests: $tcltest::failFiles"
+		set tcltest::failFiles {}
+	    }
+	}
+
+	# if any tests were skipped, print the constraints that kept them
+	# from running.
+
+	set constraintList [array names tcltest::skippedBecause]
+	if {[llength $constraintList] > 0} {
+	    puts [outputChannel] \
+		    "Number of tests skipped for each constraint:"
+	    foreach constraint [lsort $constraintList] {
+		puts [outputChannel] \
+			"\t$tcltest::skippedBecause($constraint)\t$constraint"
+		unset tcltest::skippedBecause($constraint)
+	    }
+	}
+
+	# report the names of test files in tcltest::createdNewFiles, and
+	# reset the array to be empty.
+
+	set testFilesThatTurded [lsort [array names tcltest::createdNewFiles]]
+	if {[llength $testFilesThatTurded] > 0} {
+	    puts [outputChannel] "Warning: files left behind:"
+	    foreach testFile $testFilesThatTurded {
+		puts [outputChannel] \
+			"\t$testFile:\t$tcltest::createdNewFiles($testFile)"
+		unset tcltest::createdNewFiles($testFile)
+	    }
+	}
+
+	# reset filesMade, filesExisted, and numTests
+
+	set tcltest::filesMade {}
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    set tcltest::numTests($index) 0
+	}
+
+	# exit only if running Tk in non-interactive mode
+
+	global tk_version tcl_interactive
+	if {[info exists tk_version] && ![info exists tcl_interactive]} {
+	    exit
 	}
     } else {
-	incr ::tcltest::numTests(Failed)
-	set ::tcltest::currentFailure true
-	if {[string first b $::tcltest::verbose] == -1} {
-	    set script ""
-	}
-	puts $::tcltest::outputChannel "\n==== $name $description FAILED"
-	if {$script != ""} {
-	    puts $::tcltest::outputChannel "==== Contents of test case:"
-	    puts $::tcltest::outputChannel $script
-	}
-	if {$code != 0} {
-	    if {$code == 1} {
-		puts $::tcltest::outputChannel "==== Test generated error:"
-		puts $::tcltest::outputChannel $actualAnswer
-	    } elseif {$code == 2} {
-		puts $::tcltest::outputChannel "==== Test generated return exception;  result was:"
-		puts $::tcltest::outputChannel $actualAnswer
-	    } elseif {$code == 3} {
-		puts $::tcltest::outputChannel "==== Test generated break exception"
-	    } elseif {$code == 4} {
-		puts $::tcltest::outputChannel "==== Test generated continue exception"
+
+	# 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 tcltest::numTestFiles
+	if {($tcltest::currentFailure) && \
+		([lsearch -exact $tcltest::failFiles $testFileName] == -1)} {
+	    lappend tcltest::failFiles $testFileName
+	}
+	set tcltest::currentFailure false
+
+	# restore the environment to the state it was in before this package
+	# was loaded
+
+	set newEnv {}
+	set changedEnv {}
+	set removedEnv {}
+	foreach index [array names ::env] {
+	    if {![info exists tcltest::originalEnv($index)]} {
+		lappend newEnv $index
+		unset ::env($index)
 	    } else {
-		puts $::tcltest::outputChannel "==== Test generated exception $code;  message was:"
-		puts $::tcltest::outputChannel $actualAnswer
+		if {$::env($index) != $tcltest::originalEnv($index)} {
+		    lappend changedEnv $index
+		    set ::env($index) $tcltest::originalEnv($index)
+		}
 	    }
-	} else {
-	    puts $::tcltest::outputChannel "---- Result was:\n$actualAnswer"
 	}
-	puts $::tcltest::outputChannel "---- Result should have been:\n$expectedAnswer"
-	puts $::tcltest::outputChannel "==== $name FAILED\n"
-    }
-    if {$::tcltest::preserveCore} {
-	set currentTclPlatform [array get tcl_platform]
-	if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	    if {$::tcltest::preserveCore > 1} {
-		puts $::tcltest::outputChannel "==== $name produced core file! \
+	foreach index [array names tcltest::originalEnv] {
+	    if {![info exists ::env($index)]} {
+		lappend removedEnv $index
+		set ::env($index) $tcltest::originalEnv($index)
+	    }
+	}
+	if {[llength $newEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements created:\t$newEnv"
+	}
+	if {[llength $changedEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements changed:\t$changedEnv"
+	}
+	if {[llength $removedEnv] > 0} {
+	    puts [outputChannel] \
+		    "env array elements removed:\t$removedEnv"
+	}
+
+	set changedTclPlatform {}
+	foreach index [array names tcltest::originalTclPlatform] {
+	    if {$::tcl_platform($index) != \
+		    $tcltest::originalTclPlatform($index)} { 
+		lappend changedTclPlatform $index
+		set ::tcl_platform($index) \
+			$tcltest::originalTclPlatform($index) 
+	    }
+	}
+	if {[llength $changedTclPlatform] > 0} {
+	    puts [outputChannel] \
+		    "tcl_platform array elements changed:\t$changedTclPlatform"
+	} 
+
+	if {[file exists [file join [tcltest::workingDirectory] core]]} {
+	    if {$tcltest::preserveCore > 1} {
+		puts "rename core file (> 1)" 
+		puts [outputChannel] "produced core file! \
 			Moving file to: \
-			[file join $::tcltest::temporaryDirectory core-$name]"
+			[file join $tcltest::temporaryDirectory core-$name]"
 		catch {file rename -force \
-			[file join $::tcltest::workingDirectory core] \
-			[file join $::tcltest::temporaryDirectory \
-			core-$name]} msg
+			[file join [tcltest::workingDirectory] core] \
+			[file join $tcltest::temporaryDirectory \
+			    core-$name]} msg
 		if {[string length $msg] > 0} {
-		    ::tcltest::PrintError "Problem renaming file: $msg"
+		    tcltest::PrintError "Problem renaming file: $msg"
 		}
 	    } else {
 		# Print a message if there is a core file and (1) there
 		# previously wasn't one or (2) the new one is different from
 		# the old one. 
 
-		if {[info exists coreModTime]} {
-		    if {$coreModTime != [file mtime \
-			    [file join $::tcltest::workingDirectory core]]} {
-			puts $::tcltest::outputChannel "==== $name produced core file!"
+		if {[info exists tcltest::coreModificationTime]} {
+		    if {$tcltest::coreModificationTime != [file mtime \
+			    [file join [tcltest::workingDirectory] core]]} {
+			puts [outputChannel] "A core file was created!"
 		    }
 		} else {
-		    puts $::tcltest::outputChannel "==== $name produced core file!"
+		    puts [outputChannel] "A core file was created!"
 		} 
 	    }
 	}
-	array set tcl_platform $currentTclPlatform
     }
+    flush [outputChannel]
+    flush [errorChannel]
+    return
 }
 
-# ::tcltest::getMatchingFiles
+#####################################################################
+
+# Procs that determine which tests/test files to run
+
+# tcltest::getMatchingFiles
 #
 #       Looks at the patterns given to match and skip files
 #       and uses them to put together a list of the tests that will be run.
 #
 # Arguments:
-#       none
+#       directory to search
 #
 # Results:
 #       The constructed list is returned to the user.  This will primarily
-#       be used in 'all.tcl' files.
+#       be used in 'all.tcl' files.  It is used in runAllTests.
+# 
+# Side Effects:
+#       None
 
-proc ::tcltest::getMatchingFiles {args} {
-    set matchingFiles {}
-    if {[llength $args]} {
-	set searchDirectory $args
-    } else {
-	set searchDirectory [list $::tcltest::testsDirectory]
+proc tcltest::getMatchingFiles { {searchDirectory ""} } {
+    if {[llength [info level 0]] == 1} {
+	set searchDirectory [tcltest::testsDirectory]
     }
+    set matchingFiles {}
+
     # Find the matching files in the list of directories and then remove the
     # ones that match the skip pattern
     foreach directory $searchDirectory {
 	set matchFileList {}
-	foreach match $::tcltest::matchFiles {
+	foreach match $tcltest::matchFiles {
 	    set matchFileList [concat $matchFileList \
 		    [glob -nocomplain [file join $directory $match]]]
 	}
-	if {[string compare {} $::tcltest::skipFiles]} {
+	if {[string compare {} $tcltest::skipFiles]} {
 	    set skipFileList {}
-	    foreach skip $::tcltest::skipFiles {
+	    foreach skip $tcltest::skipFiles {
 		set skipFileList [concat $skipFileList \
 			[glob -nocomplain [file join $directory $skip]]]
 	    }
@@ -1597,35 +2857,213 @@ proc ::tcltest::getMatchingFiles {args} {
 	}
     }
     if {[string equal $matchingFiles {}]} {
-	::tcltest::PrintError "No test files remain after applying \
+	tcltest::PrintError "No test files remain after applying \
 		your match and skip patterns!"
     }
     return $matchingFiles
 }
 
-# The following two procs are used in the io tests.
-
-proc ::tcltest::openfiles {} {
-    if {[catch {testchannel open} result]} {
-	return {}
+# tcltest::getMatchingDirectories --
+#
+#	Looks at the patterns given to match and skip directories and uses them
+#       to put together a list of the test directories that we should attempt
+#       to run.  (Only subdirectories containing an "all.tcl" file are put into
+#       the list.)
+#
+# Arguments:
+#	root directory from which to search
+#
+# Results:
+#	The constructed list is returned to the user.  This is used in the
+#       primary all.tcl file.  Lower-level all.tcl files should use the
+#       tcltest::testAllFiles proc instead.
+# 
+# Side Effects: 
+#       None.
+
+proc tcltest::getMatchingDirectories {rootdir} {
+    set matchingDirs {}
+    set matchDirList {}
+    # Find the matching directories in tcltest::testsDirectory and then
+    # remove the ones that match the skip pattern
+    foreach match $tcltest::matchDirectories {
+	foreach file [glob -nocomplain [file join $rootdir $match]] {
+	    if {([file isdirectory $file]) && ($file != $rootdir)} {
+		set matchDirList [concat $matchDirList \
+			[tcltest::getMatchingDirectories $file]]
+		if {[file exists [file join $file all.tcl]]} {
+		    set matchDirList [concat $matchDirList $file]
+		}
+	    }
+	}
     }
-    return $result
+    if {$tcltest::skipDirectories != {}} {
+	set skipDirs {} 
+	foreach skip $tcltest::skipDirectories {
+	    set skipDirs [concat $skipDirs \
+		    [glob -nocomplain [file join $tcltest::testsDirectory \
+			$skip]]]
+	}
+	foreach dir $matchDirList {
+	    # Only include directories that don't match the skip pattern
+	    if {[lsearch -exact $skipDirs $dir] == -1} {
+		lappend matchingDirs $dir
+	    }
+	}
+    } else {
+	set matchingDirs [concat $matchingDirs $matchDirList]
+    }
+    if {$matchingDirs == {}} {
+	DebugPuts 1 "No test directories remain after applying match and skip patterns!"
+    }
+    return $matchingDirs
 }
 
-proc ::tcltest::leakfiles {old} {
-    if {[catch {testchannel open} new]} {
-        return {}
+# tcltest::runAllTests --
+#
+#	prints output and sources test files according to the match and skip
+#       patterns provided.  after sourcing test files, it goes on to source
+#       all.tcl files in matching test subdirectories.
+#
+# Arguments:
+#	shell being tested
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::runAllTests { {shell ""} } {
+    global argv
+
+    if {[llength [info level 0]] == 1} {
+	set shell [tcltest::interpreter]
     }
-    set leak {}
-    foreach p $new {
-    	if {[lsearch $old $p] < 0} {
-	    lappend leak $p
+
+    set tcltest::testSingleFile false
+
+    puts [outputChannel] "Tests running in interp:  $shell"
+    puts [outputChannel] "Tests located in:  $tcltest::testsDirectory"
+    puts [outputChannel] "Tests running in:  [tcltest::workingDirectory]"
+    puts [outputChannel] "Temporary files stored in $tcltest::temporaryDirectory"
+    if {[tcltest::singleProcess]} {
+	puts [outputChannel] "Test files sourced into current interpreter"
+    } else {
+	puts [outputChannel] "Test files run in separate interpreters"
+    }
+    if {[llength $tcltest::skip] > 0} {
+	puts [outputChannel] "Skipping tests that match:  $tcltest::skip"
+    }
+    if {[llength $tcltest::match] > 0} {
+	puts [outputChannel] "Only running tests that match:  $tcltest::match"
+    }
+
+    if {[llength $tcltest::skipFiles] > 0} {
+	puts [outputChannel] "Skipping test files that match:  $tcltest::skipFiles"
+    }
+    if {[llength $tcltest::matchFiles] > 0} {
+	puts [outputChannel] "Only running test files that match:  $tcltest::matchFiles"
+    }
+
+    set timeCmd {clock format [clock seconds]}
+    puts [outputChannel] "Tests began at [eval $timeCmd]"
+
+    # Run each of the specified tests
+    foreach file [lsort [tcltest::getMatchingFiles]] {
+	set tail [file tail $file]
+	puts [outputChannel] $tail
+
+	if {$tcltest::singleProcess} {
+	    incr tcltest::numTestFiles
+	    uplevel [list source $file]
+	} else {
+	    # Change to the tests directory so the value of the following
+	    # variable is set correctly when we spawn the child test processes
+	    cd $tcltest::testsDirectory
+	    set cmd [concat [list | $shell $file] [split $argv]]
+	    if {[catch {
+		incr tcltest::numTestFiles
+		set pipeFd [open $cmd "r"] 
+		while {[gets $pipeFd line] >= 0} {
+		    if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
+			foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+			    incr tcltest::numTests($index) [set $index]
+			}
+			if {$Failed > 0} {
+			    lappend tcltest::failFiles $testFile
+			}
+		    } elseif {[regexp {^Number of tests skipped for each constraint:|^\t(\d+)\t(.+)$} $line match skipped constraint]} {
+			if {$match != "Number of tests skipped for each constraint:"} {
+			    tcltest::AddToSkippedBecause $constraint $skipped
+			}
+		    } else {
+			puts [outputChannel] $line
+		    }
+		}
+		close $pipeFd
+	    } msg]} {
+		# Print results to tcltest::outputChannel.
+		puts [outputChannel] "Test file error: $msg"
+		# append the name of the test to a list to be reported later
+		lappend testFileFailures $file 
+	    }
 	}
     }
-    return $leak
+
+    # cleanup
+    puts [outputChannel] "\nTests ended at [eval $timeCmd]"
+    tcltest::cleanupTests 1
+    if {[info exists testFileFailures]} {
+	puts [outputChannel] "\nTest files exiting with errors:  \n"
+	foreach file $testFileFailures {
+	    puts "  [file tail $file]\n"
+	}
+    }
+
+    # Checking for subdirectories in which to run tests
+    foreach directory [tcltest::getMatchingDirectories $tcltest::testsDirectory] {
+	set dir [file tail $directory]
+	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
+	puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
+	
+	uplevel "source [file join $directory all.tcl]"
+	
+	set endTime [eval $timeCmd]
+	puts [outputChannel] "\n$dir test ended at $endTime"
+	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
+    }
+    return
+}
+
+#####################################################################
+
+# Test utility procs - not used in tcltest, but may be useful for testing.
+
+# tcltest::loadTestedCommands --
+#
+#     Uses the specified script to load the commands to test. Allowed to
+#     be empty, as the tested commands could have been compiled into the
+#     interpreter.
+#
+# Arguments
+#     none
+#
+# Results
+#     none
+# 
+# Side Effects: 
+#     none.
+
+proc tcltest::loadTestedCommands {} {
+    if {$tcltest::loadScript == {}} {
+	return
+    }
+    
+    return [uplevel $tcltest::loadScript]
 }
 
-# ::tcltest::saveState --
+# tcltest::saveState --
 #
 #	Save information regarding what procs and variables exist.
 #
@@ -1633,58 +3071,71 @@ proc ::tcltest::leakfiles {old} {
 #	none
 #
 # Results:
-#	Modifies the variable ::tcltest::saveState
+#	Modifies the variable tcltest::saveState
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::saveState {} {
-    uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
-    DebugPuts 2 "::tcltest::saveState: $::tcltest::saveState"
+proc tcltest::saveState {} {
+    uplevel {set tcltest::saveState [list [info procs] [info vars]]}
+    DebugPuts  2 "tcltest::saveState: $tcltest::saveState"
+    return
 }
 
-# ::tcltest::restoreState --
+# tcltest::restoreState --
 #
 #	Remove procs and variables that didn't exist before the call to
-#       ::tcltest::saveState.
+#       tcltest::saveState.
 #
 # Arguments:
 #	none
 #
 # Results:
 #	Removes procs and variables from your environment if they don't exist
-#       in the ::tcltest::saveState variable.
+#       in the tcltest::saveState variable.
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::restoreState {} {
+proc tcltest::restoreState {} {
     foreach p [info procs] {
-	if {([lsearch [lindex $::tcltest::saveState 0] $p] < 0) && \
-		(![string equal ::tcltest::$p [namespace origin $p]])} {
+	if {([lsearch [lindex $tcltest::saveState 0] $p] < 0) && \
+		(![string match "*tcltest::$p" [namespace origin $p]])} {
 	    
-	    DebugPuts 2 "::tcltest::restoreState: Removing proc $p"
+	    DebugPuts 2 "tcltest::restoreState: Removing proc $p"
 	    rename $p {}
 	}
     }
-    foreach p [uplevel #0 {info vars}] {
-	if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
-	    DebugPuts 2 "::tcltest::restoreState: Removing variable $p"
-	    uplevel #0 "catch {unset $p}"
+    foreach p [uplevel {info vars}] {
+	if {[lsearch [lindex $tcltest::saveState 1] $p] < 0} {
+	    DebugPuts 2 "tcltest::restoreState: Removing variable $p"
+	    uplevel "catch {unset $p}"
 	}
     }
+    return
 }
 
-# ::tcltest::normalizeMsg --
+# tcltest::normalizeMsg --
 #
 #	Removes "extra" newlines from a string.
 #
 # Arguments:
 #	msg        String to be modified
 #
+# Results:
+#	string with extra newlines removed
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::normalizeMsg {msg} {
+proc tcltest::normalizeMsg {msg} {
     regsub "\n$" [string tolower $msg] "" msg
     regsub -all "\n\n" $msg "\n" msg
     regsub -all "\n\}" $msg "\}" msg
     return $msg
 }
 
-# makeFile --
+# tcltest::makeFile --
 #
 # Create a new file with the name <name>, and write <contents> to it.
 #
@@ -1692,12 +3143,28 @@ proc ::tcltest::normalizeMsg {msg} {
 # cleanupTests was called, add it to the $filesMade list, so it will
 # be removed by the next call to cleanupTests.
 #
-proc ::tcltest::makeFile {contents name} {
+# Arguments:
+#	contents        content of the new file
+#       name            name of the new file
+#       directory       directory name for new file 
+#
+# Results:
+#	absolute path to the file created
+#
+# Side effects:
+#	None.
+
+proc tcltest::makeFile {contents name {directory ""}} {
     global tcl_platform
+
+    if {[llength [info level 0]] == 3} {
+	set directory [tcltest::temporaryDirectory]
+    }
     
-    DebugPuts 3 "::tcltest::makeFile: putting $contents into $name"
+    set fullName [file join $directory $name]
+
+    DebugPuts 3 "tcltest::makeFile: putting $contents into $fullName"
 
-    set fullName [file join $::tcltest::temporaryDirectory $name]
     set fd [open $fullName w]
 
     fconfigure $fd -translation lf
@@ -1709,26 +3176,36 @@ proc ::tcltest::makeFile {contents name} {
     }
     close $fd
 
-    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
-	lappend ::tcltest::filesMade $fullName
+    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
+	lappend tcltest::filesMade $fullName
     }
     return $fullName
 }
 
-# ::tcltest::removeFile --
+# tcltest::removeFile --
 #
 #	Removes the named file from the filesystem
 #
 # Arguments:
-#	name     file to be removed
+#	name          file to be removed
+#       directory     directory from which to remove file
 #
+# Results:
+#	return value from [file delete]
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::removeFile {name} {
-    DebugPuts 3 "::tcltest::removeFile: removing $name"
-    file delete [file join $::tcltest::temporaryDirectory $name]
+proc tcltest::removeFile {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
+    }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::removeFile: removing $fullName"
+    return [file delete $fullName]
 }
 
-# makeDirectory --
+# tcltest::makeDirectory --
 #
 # Create a new dir with the name <name>.
 #
@@ -1736,75 +3213,85 @@ proc ::tcltest::removeFile {name} {
 # cleanupTests was called, add it to the $directoriesMade list, so it will
 # be removed by the next call to cleanupTests.
 #
-proc ::tcltest::makeDirectory {name} {
-    file mkdir $name
+# Arguments:
+#       name            name of the new directory
+#       directory       directory in which to create new dir
+#
+# Results:
+#	absolute path to the directory created
+#
+# Side effects:
+#	None.
 
-    set fullName [file join [pwd] $name]
-    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
-	lappend ::tcltest::filesMade $fullName
+proc tcltest::makeDirectory {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::makeDirectory: creating $fullName"
+    file mkdir $fullName
+    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
+	lappend tcltest::filesMade $fullName
+    }
+    return $fullName
 }
 
-# ::tcltest::removeDirectory --
+# tcltest::removeDirectory --
 #
 #	Removes a named directory from the file system.
 #
 # Arguments:
-#	name    Name of the directory to remove
+#	name          Name of the directory to remove
+#       directory     Directory from which to remove
 #
+# Results:
+#	return value from [file delete]
+#
+# Side effects:
+#	None
 
-proc ::tcltest::removeDirectory {name} {
-    file delete -force $name
-}
-
-proc ::tcltest::viewFile {name} {
-    global tcl_platform
-    if {([string equal $tcl_platform(platform) "macintosh"]) || \
-	    ($::tcltest::testConstraints(unixExecs) == 0)} {
-	set f [open [file join $::tcltest::temporaryDirectory $name]]
-	set data [read -nonewline $f]
-	close $f
-	return $data
-    } else {
-	exec cat [file join $::tcltest::temporaryDirectory $name]
+proc tcltest::removeDirectory {name {directory ""}} {
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
+    set fullName [file join $directory $name]
+    DebugPuts 3 "tcltest::removeDirectory: deleting $fullName"
+    return [file delete -force $fullName]
 }
 
-# grep --
+# tcltest::viewFile --
 #
-# Evaluate a given expression against each element of a list and return all
-# elements for which the expression evaluates to true.  For the purposes of
-# this proc, use of the keyword "CURRENT_ELEMENT" will flag the proc to use the
-# value of the current element within the expression.  This is equivalent to
-# the perl grep command where CURRENT_ELEMENT would be the name for the special
-# variable $_.
+#	reads the content of a file and returns it
 #
-# Examples of usage would be:
-#   set subList [grep {CURRENT_ELEMENT == 1} $listOfNumbers]
-#   set subList [grep {regexp {abc} CURRENT_ELEMENT} $listOfStrings]
+# Arguments:
+#	name of the file to read
+#       directory in which file is located
 #
-# Use of the CURRENT_ELEMENT keyword is optional.  If it is left out, it is
-# assumed to be the final argument to the expression provided.
-# 
-# Example:
-#   grep {regexp a} $someList   
+# Results:
+#	content of the named file
 #
-proc ::tcltest::grep { expression searchList } {
-    foreach element $searchList {
-	if {[regsub -all CURRENT_ELEMENT $expression $element \
-		newExpression] == 0} { 
-	    set newExpression "$expression {$element}"
-	}
-	if {[eval $newExpression] == 1} {
-	    lappend returnList $element
-	}
+# Side effects:
+#	None.
+
+proc tcltest::viewFile {name {directory ""}} {
+    global tcl_platform
+    if {[llength [info level 0]] == 2} {
+	set directory [tcltest::temporaryDirectory]
     }
-    if {[info exists returnList]} {
-	return $returnList
+    set fullName [file join $directory $name]
+    if {([string equal $tcl_platform(platform) "macintosh"]) || \
+	    ([tcltest::testConstraint unixExecs] == 0)} {
+	set f [open $fullName]
+	set data [read -nonewline $f]
+	close $f
+	return $data
+    } else {
+	return [exec cat $fullName]
     }
     return
 }
 
+# tcltest::bytestring --
 #
 # Construct a string that consists of the requested sequence of bytes,
 # as opposed to a string of properly formed UTF-8 characters.  
@@ -1818,30 +3305,112 @@ proc ::tcltest::grep { expression searchList } {
 # Generally, it's a bad idea to examine the bytes in a Tcl string or to
 # construct improperly formed strings in this manner, because it involves
 # exposing that Tcl uses UTF-8 internally.
+#
+# Arguments:
+#	string being converted
+#
+# Results:
+#	result fom encoding
+#
+# Side effects:
+#	None
+
+proc tcltest::bytestring {string} {
+    return [encoding convertfrom identity $string]
+}
+
+# tcltest::openfiles --
+#
+#	used in io tests, uses testchannel
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	???
+#
+# Side effects:
+#	None.
 
-proc ::tcltest::bytestring {string} {
-    encoding convertfrom identity $string
+proc tcltest::openfiles {} {
+    if {[catch {testchannel open} result]} {
+	return {}
+    }
+    return $result
+}
+
+# tcltest::leakfiles --
+#
+#	used in io tests, uses testchannel
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	???
+#
+# Side effects:
+#	None.
+
+proc tcltest::leakfiles {old} {
+    if {[catch {testchannel open} new]} {
+	return {}
+    }
+    set leak {}
+    foreach p $new {
+	if {[lsearch $old $p] < 0} {
+	    lappend leak $p
+	}
+    }
+    return $leak
 }
 
 #
 # Internationalization / ISO support procs     -- dl
 #
-proc ::tcltest::set_iso8859_1_locale {} {
+
+# tcltest::set_iso8859_1_locale --
+#
+#	used in cmdIL.test, uses testlocale
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::set_iso8859_1_locale {} {
     if {[info commands testlocale] != ""} {
-	set ::tcltest::previousLocale [testlocale ctype]
-	testlocale ctype $::tcltest::isoLocale
+	set tcltest::previousLocale [testlocale ctype]
+	testlocale ctype $tcltest::isoLocale
     }
     return
 }
 
-proc ::tcltest::restore_locale {} {
+# tcltest::restore_locale --
+#
+#	used in cmdIL.test, uses testlocale
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	None.
+
+proc tcltest::restore_locale {} {
     if {[info commands testlocale] != ""} {
-	testlocale ctype $::tcltest::previousLocale
+	testlocale ctype $tcltest::previousLocale
     }
     return
 }
 
-# threadReap --
+# tcltest::threadReap --
 #
 #	Kill all threads except for the main thread.
 #	Do nothing if testthread is not defined.
@@ -1851,7 +3420,12 @@ proc ::tcltest::restore_locale {} {
 #
 # Results:
 #	Returns the number of existing threads.
-proc ::tcltest::threadReap {} {
+# 
+# Side Effects: 
+#       none.
+#
+
+proc tcltest::threadReap {} {
     if {[info commands testthread] != {}} {
 
 	# testthread built into tcltest
@@ -1859,7 +3433,7 @@ proc ::tcltest::threadReap {} {
 	testthread errorproc ThreadNullError
 	while {[llength [testthread names]] > 1} {
 	    foreach tid [testthread names] {
-		if {$tid != $::tcltest::mainThread} {
+		if {$tid != $tcltest::mainThread} {
 		    catch {testthread send -async $tid {testthread exit}}
 		}
 	    }
@@ -1877,7 +3451,7 @@ proc ::tcltest::threadReap {} {
 	thread::errorproc ThreadNullError
 	while {[llength [thread::names]] > 1} {
 	    foreach tid [thread::names] {
-		if {$tid != $::tcltest::mainThread} {
+		if {$tid != $tcltest::mainThread} {
 		    catch {thread::send -async $tid {thread::exit}}
 		}
 	    }
@@ -1891,6 +3465,7 @@ proc ::tcltest::threadReap {} {
     } else {
 	return 1
     }
+    return 0
 }
 
 # Initialize the constraints and set up command line arguments 
@@ -1898,8 +3473,18 @@ namespace eval tcltest {
     # Ensure that we have a minimal auto_path so we don't pick up extra junk.
     set ::auto_path [list [info library]]
 
-    ::tcltest::initConstraints
-    if {[namespace children ::tcltest] == {}} {
-	::tcltest::processCmdLineArgs
+    tcltest::initConstraints
+    if {[namespace children [namespace current]] == {}} {
+	tcltest::processCmdLineArgs
+    }
+
+    # Save the names of files that already exist in
+    # the output directory.
+    foreach file [glob -nocomplain \
+	    [file join $tcltest::temporaryDirectory *]] {
+	lappend tcltest::filesExisted [file tail $file]
     }
 }
+
+package provide tcltest 2.0
+
diff --git a/library/tcltest1.0/tcltest2.tcl b/library/tcltest1.0/tcltest2.tcl
deleted file mode 100755
index c05732d..0000000
--- a/library/tcltest1.0/tcltest2.tcl
+++ /dev/null
@@ -1,3490 +0,0 @@
-# tcltest.tcl --
-#
-#	This file contains support code for the Tcl test suite.  It 
-#       defines the tcltest namespace and finds and defines the output
-#       directory, constraints available, output and error channels, etc. used
-#       by Tcl tests.  See the tcltest man page for more details.
-#       
-#       This design was based on the Tcl testing approach designed and
-#       initially implemented by Mary Ann May-Pumphrey of Sun Microsystems. 
-#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2000 by Ajuba Solutions
-# All rights reserved.
-# 
-# RCS: @(#) $Id: tcltest2.tcl,v 1.4 2000/10/19 18:00:58 jenn Exp $
-
-# create the "tcltest" namespace for all testing variables and procedures
-
-namespace eval tcltest { 
-
-    # Export the public tcltest procs
-    set procList [list test cleanupTests saveState restoreState \
-	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring threadReap debug testConstraint \
-	    limitConstraints loadTestedCommands normalizePath verbose match \
-	    skip matchFiles skipFiles preserveCore  loadScript loadFile \
-	    mainThread workingDirectory singleProcess interpreter runAllTests \
-	    outputChannel outputFile errorChannel \
-	    errorFile temporaryDirectory testsDirectory  matchDirectories \
-	    skipDirectories ]
-    foreach proc $procList {
-	namespace export $proc
-    }
-
-    # tcltest::verbose defaults to {body}
-    if {![info exists verbose]} {
-	variable verbose {body}
-    }
-
-    # Match and skip patterns default to the empty list, except for
-    # matchFiles, which defaults to all .test files in the testsDirectory and
-    # matchDirectories, which defaults to all directories.
-
-    if {![info exists match]} {
-	variable match {}
-    }
-    if {![info exists skip]} {
-	variable skip {}
-    }
-    if {![info exists matchFiles]} {
-	variable matchFiles {*.test}
-    }
-    if {![info exists skipFiles]} {
-	variable skipFiles {}
-    }
-    if {![info exists matchDirectories]} {
-	variable matchDirectories {*}
-    }
-    if {![info exists skipDirectories]} {
-	variable skipDirectories {}
-    }
-
-    # By default, don't save core files
-    if {![info exists preserveCore]} {
-	variable preserveCore 0
-    }
-
-    # output goes to stdout by default
-    if {![info exists outputChannel]} {
-	variable outputChannel stdout
-    }
-    if {![info exists outputFile]} {
-	variable outputFile stdout
-    }
-
-    # errors go to stderr by default
-    if {![info exists errorChannel]} {
-	variable errorChannel stderr
-    }
-    if {![info exists errorFile]} {
-	variable errorFile stderr
-    }
-
-    # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tests that were skipped because they didn't match or were 
-    # specifically skipped.  A debug level of 2 would spit up the tcltest
-    # variables and flags provided; a debug level of 3 causes some additional
-    # output regarding operations of the test harness.  The tcltest package
-    # currently implements only up to debug level 3.
-    if {![info exists debug]} {
-	variable debug 0
-    }
-
-    # Save any arguments that we might want to pass through to other programs. 
-    # This is used by the -args flag.
-    if {![info exists parameters]} {
-	variable parameters {}
-    }
-
-    # Count the number of files tested (0 if runAllTests wasn't called).
-    # runAllTests will set testSingleFile to false, so stats will
-    # not be printed until runAllTests 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.
-
-    if {![info exists numTestFiles]} {
-	variable numTestFiles 0
-    }
-    if {![info exists testSingleFile]} {
-	variable testSingleFile true
-    }
-    if {![info exists currentFailure]} {
-	variable currentFailure false
-    }
-    if {![info exists failFiles]} {
-	variable failFiles {}
-    }
-
-    # Tests should remove all files they create.  The test suite will
-    # check the current working dir for files created by the tests.
-    # tcltest::filesMade keeps track of such files created using the
-    # tcltest::makeFile and tcltest::makeDirectory procedures.
-    # tcltest::filesExisted stores the names of pre-existing files.
-
-    if {![info exists filesMade]} {
-	variable filesMade {}
-    }
-    if {![info exists filesExisted]} {
-	variable filesExisted {}
-    }
-
-    # tcltest::numTests will store test files as indices and the list
-    # of files (that should not have been) left behind by the test files.
-
-    if {![info exists createdNewFiles]} {
-	variable createdNewFiles
-	array set tcltest::createdNewFiles {}
-    }
-
-    # initialize tcltest::numTests array to keep track fo the number of
-    # tests that pass, fail, and are skipped.
-
-    if {![info exists numTests]} {
-	variable numTests
-	array set tcltest::numTests \
-		[list Total 0 Passed 0 Skipped 0 Failed	0] 
-    }
-
-    # initialize tcltest::skippedBecause array to keep track of
-    # constraints that kept tests from running; a constraint name of
-    # "userSpecifiedSkip" means that the test appeared on the list of tests
-    # that matched the -skip value given to the flag; "userSpecifiedNonMatch"
-    # means that the test didn't match the argument given to the -match flag;
-    # both of these constraints are counted only if tcltest::debug is set to
-    # true. 
-
-    if {![info exists skippedBecause]} {
-	variable skippedBecause
-	array set tcltest::skippedBecause {}
-    }
-
-    # initialize the tcltest::testConstraints array to keep track of valid
-    # predefined constraints (see the explanation for the
-    # tcltest::initConstraints proc for more details).
-
-    if {![info exists testConstraints]} {
-	variable testConstraints
-	array set tcltest::testConstraints {}
-    }
-
-    if {![info exists constraintsSpecified]} {
-	variable constraintsSpecified {}
-    }
-
-    # Don't run only the constrained tests by default
-
-    if {![info exists limitConstraints]} {
-	variable limitConstraints false
-    }
-
-    # A test application has to know how to load the tested commands into
-    # the interpreter.
-
-    if {![info exists loadScript]} {
-	variable loadScript {}
-    }
-
-    # and the filename of the script file, if it exists
-    if {![info exists loadFile]} {
-	variable loadFile {}
-    }
-
-    # tests that use threads need to know which is the main thread
-
-    if {![info exists mainThread]} {
-	variable mainThread 1
-	if {[info commands thread::id] != {}} {
-	    set mainThread [thread::id]
-	} elseif {[info commands testthread] != {}} {
-	    set mainThread [testthread id]
-	}
-    }
-
-    # save the original environment so that it can be restored later
-    
-    if {![info exists originalEnv]} {
-	variable originalEnv
-	array set tcltest::originalEnv [array get ::env]
-    }
-
-    # Set tcltest::workingDirectory to [pwd]. The default output directory
-    # for Tcl tests is the working directory.
-
-    if {![info exists workingDirectory]} {
-	variable workingDirectory [pwd]
-    }
-    if {![info exists temporaryDirectory]} {
-	variable temporaryDirectory $workingDirectory
-    }
-
-    # Tests should not rely on the current working directory.
-    # Files that are part of the test suite should be accessed relative to 
-    # tcltest::testsDirectory.
-
-    if {![info exists testsDirectory]} {
-	set oldpwd [pwd]
-	catch {cd [file join [file dirname [info script]] .. .. tests]}
-	variable testsDirectory [pwd]
-	cd $oldpwd
-	unset oldpwd
-    }
-
-    # Default is to run each test file in a separate process
-    if {![info exists singleProcess]} {
-	variable singleProcess 0
-    }
-
-    # the variables and procs that existed when tcltest::saveState was
-    # called are stored in a variable of the same name
-    if {![info exists saveState]} {
-	variable saveState {}
-    }
-
-    # Internationalization support -- used in tcltest::set_iso8859_1_locale
-    # and tcltest::restore_locale. Those commands are used in cmdIL.test.
-    if {![info exists previousLocale]} {
-	variable previousLocale
-    }
-
-    if {![info exists isoLocale]} {
-	variable isoLocale fr
-	switch -- $tcl_platform(platform) {
-	    "unix" {
-
-		# Try some 'known' values for some platforms:
-
-		switch -exact -- $tcl_platform(os) {
-		    "FreeBSD" {
-			set tcltest::isoLocale fr_FR.ISO_8859-1
-		    }
-		    HP-UX {
-			set tcltest::isoLocale fr_FR.iso88591
-		    }
-		    Linux -
-		    IRIX {
-			set tcltest::isoLocale fr
-		    }
-		    default {
-
-			# Works on SunOS 4 and Solaris, and maybe others...
-			# define it to something else on your system
-			#if you want to test those.
-
-			set tcltest::isoLocale iso_8859_1
-		    }
-		}
-	    }
-	    "windows" {
-		set tcltest::isoLocale French
-	    }
-	}
-    }
-
-    # Set the location of the execuatble
-    if {![info exists tcltest]} {
-	variable tcltest [info nameofexecutable]
-    }	
-
-    # save the platform information so it can be restored later
-    if {![info exists originalTclPlatform]} {
-	variable originalTclPlatform [array get tcl_platform]
-    }
-
-    # If a core file exists, save its modification time.
-    if {![info exists coreModificationTime]} {
-	if {[file exists [file join $tcltest::workingDirectory core]]} {
-	    variable coreModificationTime [file mtime [file join \
-		    $tcltest::workingDirectory core]]
-	}
-    }
-
-    # stdout and stderr buffers for use when we want to store them
-    if {![info exists outData]} {
-	variable outData {}
-    }
-    if {![info exists errData]} {
-	variable errData {}
-    }
-
-    # keep track of test level for nested test commands
-    variable testLevel 0
-}   
-
-#####################################################################
-
-# tcltest::Debug* --
-#
-#     Internal helper procedures to write out debug information
-#     dependent on the chosen level. A test shell may overide
-#     them, f.e. to redirect the output into a different
-#     channel, or even into a GUI.
-
-# tcltest::DebugPuts --
-#
-#     Prints the specified string if the current debug level is
-#     higher than the provided level argument.
-#
-# Arguments:
-#     level   The lowest debug level triggering the output
-#     string  The string to print out.
-#
-# Results:
-#     Prints the string. Nothing else is allowed.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugPuts {level string} {
-    variable debug
-    if {$debug >= $level} {
-	puts $string
-    }
-    return
-}
-
-# tcltest::DebugPArray --
-#
-#     Prints the contents of the specified array if the current
-#       debug level is higher than the provided level argument
-#
-# Arguments:
-#     level           The lowest debug level triggering the output
-#     arrayvar        The name of the array to print out.
-#
-# Results:
-#     Prints the contents of the array. Nothing else is allowed.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugPArray {level arrayvar} {
-    variable debug
-
-    if {$debug >= $level} {
-	catch {upvar  $arrayvar $arrayvar}
-	parray $arrayvar
-    }
-    return
-}
-
-# tcltest::DebugDo --
-#
-#     Executes the script if the current debug level is greater than
-#       the provided level argument
-#
-# Arguments:
-#     level   The lowest debug level triggering the execution.
-#     script  The tcl script executed upon a debug level high enough.
-#
-# Results:
-#     Arbitrary side effects, dependent on the executed script.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::DebugDo {level script} {
-    variable debug
-
-    if {$debug >= $level} {
-	uplevel $script
-    }
-    return
-}
-
-#####################################################################
-
-# tcltest::CheckDirectory --
-#
-#     This procedure checks whether the specified path is a readable
-#     and/or writable directory. If one of the conditions is not
-#     satisfied an error is printed and the application aborted. The
-#     procedure assumes that the caller already checked the existence
-#     of the path.
-#
-# Arguments
-#     rw      Information what attributes to check. Allowed values:
-#             r, w, rw, wr. If 'r' is part of the value the directory
-#             must be readable. 'w' associates to 'writable'.
-#     dir     The directory to check.
-#     errMsg  The string to prepend to the actual error message before
-#             printing it.
-#
-# Results
-#     none
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::CheckDirectory {rw dir errMsg} {
-    # Allowed values for 'rw': r, w, rw, wr
-
-    if {![file isdir $dir]} {
-	set msg "$errMsg \"$dir\" is not a directory"
-	error $msg
-    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
-	set msg "$errMsg \"$dir\" is not writeable"
-	error $msg
-    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
-	set msg "$errMsg \"$dir\" is not readable"
-	error $msg
-    }
-    return
-}
-
-# tcltest::normalizePath --
-#
-#     This procedure resolves any symlinks in the path thus creating a
-#     path without internal redirection. It assumes that the incoming
-#     path is absolute.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#
-# Results
-#     The path is modified in place.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::normalizePath {pathVar} {
-    upvar $pathVar path
-
-    set oldpwd [pwd]
-    catch {cd $path}
-    set path [pwd]
-    cd $oldpwd
-    return $path
-}
-
-
-# tcltest::MakeAbsolutePath --
-#
-#     This procedure checks whether the incoming path is absolute or not.
-#     Makes it absolute if it was not.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to modify.
-#     prefix  is optional, contains the path to use to make the other an
-#             absolute one. The current working directory is used if it was
-#             not specified.
-#
-# Results
-#     The path is modified in place.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
-    upvar $pathVar path
-
-    if {![string equal [file pathtype $path] "absolute"]} { 
-	if {$prefix == {}} {
-	    set prefix [pwd]
-	}
-
-	set path [file join $prefix $path] 
-    }
-    return $path
-}
-
-#####################################################################
-
-# tcltest::<variableName>
-#     
-#     Accessor functions for tcltest variables that can be modified externally.
-#     These are vars that could otherwise be modified using command line
-#     arguments to tcltest.
-
-# tcltest::verbose --
-#
-#	Set or return the verbosity level (tcltest::verbose) for tests.  This
-#       determines what gets printed to the screen and when, with regard to the
-#       running of the tests.  The proc does not check for invalid values.  It
-#       assumes that a string that doesn't match its predefined keywords
-#       is a string containing letter-specified verbosity levels.
-#
-# Arguments:
-#	A string containing any combination of 'pbste' or a list of keywords
-#       (listed in parens)
-#          p = print output whenever a test passes (pass)
-#          b = print the body of the test when it fails (body)
-#          s = print when a test is skipped (skip)
-#          t = print when a test starts (start)
-#          e = print errorInfo and errorCode when a test encounters an error
-#              (error) 
-#
-# Results:
-#	content of tcltest::verbose - this is always the character combination
-#       (pbste) instead of the list form.
-#
-# Side effects:
-#	None.
-
-proc tcltest::verbose { {level ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::verbose
-    } 
-    if {[llength $level] > 1} {
-  	set tcltest::verbose $level
-    } else {
-	if {[regexp {pass|body|skip|start|error} $level]} {
-	    set tcltest::verbose $level
-	} else { 
-	    set levelList [split $level {}]
-	    set tcltest::verbose [string map {p pass b body s skip t start e
-		error} $levelList]
-	}
-    }
-    return $tcltest::verbose
-}
-
-# tcltest::isVerbose --
-#
-#	Returns true if argument is one of the verbosity levels currently being
-#       used; returns false otherwise.
-#
-# Arguments:
-#	level
-#
-# Results:
-#	boolean 1 (true) or 0 (false), depending on whether or not the level
-#       provided is one of the ones stored in tcltest::verbose.
-#
-# Side effects:
-#	None.
-
-proc tcltest::isVerbose {level} {
-    if {[lsearch -exact [tcltest::verbose] $level] == -1} {
-	return 0
-    }
-    return 1
-}
-
-
-
-# tcltest::match --
-#
-#	Set or return the match patterns (tcltest::match) that determine which
-#       tests are run. 
-#
-# Arguments:
-#	List containing match patterns (glob format)
-#
-# Results:
-#	content of tcltest::match
-#
-# Side effects:
-#	none
-
-proc tcltest::match { {matchList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::match
-    } 
-    set tcltest::match $matchList
-}
-
-# tcltest::skip --
-#
-#	Set or return the skip patterns (tcltest::skip) that determine which
-#       tests are skipped. 
-#
-# Arguments:
-#	List containing skip patterns (glob format)
-#
-# Results:
-#	content of tcltest::skip
-#
-# Side effects:
-#	None.
-
-proc tcltest::skip { {skipList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skip
-    }
-    set tcltest::skip $skipList
-}
-
-# tcltest::matchFiles --
-#
-#	set or return the match patterns for file sourcing
-#
-# Arguments:
-#	list containing match file list (glob format)
-#
-# Results:
-#	content of tcltest::matchFiles
-#
-# Side effects:
-#	None.
-
-proc tcltest::matchFiles { {matchFileList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::matchFiles
-    }
-    set tcltest::matchFiles $matchFileList
-}
-
-# tcltest::skipFiles --
-#
-#	set or return the skip patterns for file sourcing
-#
-# Arguments:
-#	list containing the skip file list (glob format)
-#
-# Results:
-#	content of tcltest::skipFiles
-#
-# Side effects:
-#	None.
-
-proc tcltest::skipFiles { {skipFileList ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skipFiles
-    }
-    set tcltest::skipFiles $skipFileList
-}
-
-
-# tcltest::matchDirectories --
-#
-#	set or return the list of directories for matching (glob pattern list)
-#
-# Arguments:
-#	list of glob patterns matching subdirectories of
-#       tcltest::testsDirectory 
-#
-# Results:
-#	content of tcltest::matchDirectories
-#
-# Side effects:
-#	None.
-
-proc tcltest::matchDirectories { {dirlist ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::matchDirectories
-    }
-    set tcltest::matchDirectories $dirlist
-}
-
-# tcltest::skipDirectories --
-#
-#	set or return the list of directories to skip (glob pattern list)
-#
-# Arguments:
-#	list of glob patterns matching directories to skip; these directories
-#       are subdirectories of tcltest::testsDirectory
-#
-# Results:
-#	content of tcltest::skipDirectories
-#
-# Side effects:
-#	None.
-
-proc tcltest::skipDirectories { {dirlist ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::skipDirectories
-    }
-    set tcltest::skipDirectories $dirlist
-}
-
-# tcltest::preserveCore --
-#
-#	set or return the core preservation level.  This proc does not do any
-#       error checking for invalid values.
-#
-# Arguments:
-#	core level:
-#         '0' = don't do anything with core files (default)
-#         '1' = notify the user if core files are created
-#         '2' = save any core files produced during testing to
-#               tcltest::temporaryDirectory 
-#
-# Results:
-#	content of tcltest::preserveCore
-#
-# Side effects:
-#	None.
-
-proc tcltest::preserveCore { {coreLevel ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::preserveCore
-    }
-    set tcltest::preserveCore $coreLevel
-}
-
-# tcltest::outputChannel --
-#
-#	set or return the output file descriptor based on the supplied file
-#       name (where tcltest puts all of its output) 
-#
-# Arguments:
-#	output file descriptor
-#
-# Results:
-#	file descriptor corresponding to supplied file name (or currently set
-#       file descriptor, if no new filename was supplied) - this is the content
-#       of tcltest::outputChannel 
-#
-# Side effects:
-#	None.
-
-proc tcltest::outputChannel { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::outputChannel
-    }
-    if {($filename == "stderr") || ($filename == "stdout")} {
-	set tcltest::outputChannel $filename
-    } else {
-	set tcltest::outputChannel [open $filename w]
-    }
-    return $tcltest::outputChannel
-}
-
-# tcltest::outputFile --
-#
-#	set or return the output file name (where tcltest puts all of its
-#       output); calls tcltest::outputChannel to set the corresponding file
-#       descriptor 
-#
-# Arguments:
-#	output file name
-#
-# Results:
-#       file name corresponding to supplied file name (or currently set
-#       file name, if no new filename was supplied) - this is the content
-#       of tcltest::outputFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute with
-#       respect to the predefined temporaryDirectory
-
-proc tcltest::outputFile { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::outputFile
-    }
-    if {($filename != "stderr") && ($filename != "stdout")} {
-	MakeAbsolutePath filename $tcltest::temporaryDirectory
-    }
-    tcltest::outputChannel $filename
-    set tcltest::outputFile $filename
-}
-
-# tcltest::errorChannel --
-#
-#	set or return the error file descriptor based on the supplied file name
-#       (where tcltest sends all its errors)  
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	file descriptor corresponding to the supplied file name (or currently
-#       set file descriptor, if no new filename was supplied) - this is the
-#       content of tcltest::errorChannel
-#
-# Side effects:
-#	opens the descriptor in w mode unless the filename is set to stderr or
-#       stdout 
-
-proc tcltest::errorChannel { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::errorChannel
-    }
-    if {($filename == "stderr") || ($filename == "stdout")} {
-	set tcltest::errorChannel $filename
-    } else {
-	set tcltest::errorChannel [open $filename w]
-    }
-    return $tcltest::errorChannel
-}
-
-# tcltest::errorFile --
-#
-#	set or return the error file name; calls tcltest::errorChannel to set
-#       the corresponding file descriptor
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	content of tcltest::errorFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute with
-#       respect to the predefined temporaryDirectory
-
-proc tcltest::errorFile { {filename ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::errorFile
-    }
-    if {($filename != "stderr") && ($filename != "stdout")} {
-	MakeAbsolutePath filename $tcltest::temporaryDirectory
-    }
-    set tcltest::errorFile $filename
-    errorChannel $tcltest::errorFile
-    return $tcltest::errorFile
-}
-
-# tcltest::debug --
-#
-#	set or return the debug level for tcltest; this proc does not check for
-#       invalid values
-#
-# Arguments:
-#	debug level:
-#       '0' = no debug output (default)
-#       '1' = skipped tests
-#       '2' = tcltest variables and supplied flags
-#       '3' = harness operations
-#
-# Results:
-#	content of tcltest::debug
-#
-# Side effects:
-#	None.
-
-proc tcltest::debug { {debugLevel ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::debug
-    }
-    set tcltest::debug $debugLevel
-}
-
-# tcltest::testConstraint --
-#
-#	sets a test constraint to a value; to do multiple constraints, call
-#       this proc multiple times.  also returns the value of the named
-#       constraint if no value was supplied.
-#
-# Arguments:
-#	constraint - name of the constraint
-#       value - new value for constraint (should be boolean) - if not supplied,
-#               this is a query
-#
-# Results:
-#	content of tcltest::testConstraints($constraint)
-#
-# Side effects:
-#	appends the constraint name to tcltest::constraintsSpecified
-
-proc tcltest::testConstraint {constraint {value ""}} {
-    DebugPuts 3 "entering testConstraint $constraint $value"
-    if {[llength [info level 0]] == 2} {
-	return $tcltest::testConstraints($constraint)
-    } 
-    lappend tcltest::constraintsSpecified $constraint
-    set tcltest::testConstraints($constraint) $value
-}
-
-# tcltest::constraintsSpecified --
-#
-#	returns a list of all the constraint names specified using
-#       testConstraint 
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	list of the constraint names in tcltest::constraintsSpecified
-#
-# Side effects:
-#	None.
-
-proc tcltest::constraintsSpecified {} {
-    return $tcltest::constraintsSpecified
-}
-
-# tcltest::constraintList --
-#
-#	returns a list of all the constraint names
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	list of the constraint names in tcltest::testConstraints
-#
-# Side effects:
-#	None.
-
-proc tcltest::constraintList {} {
-    return [array names tcltest::testConstraints]
-}
-
-# tcltest::limitConstraints --
-#
-#	sets the limited constraints to tcltest::limitConstraints
-#
-# Arguments:
-#	list of constraint names
-#
-# Results:
-#	content of tcltest::limitConstraints
-#
-# Side effects:
-#	None.
-
-proc tcltest::limitConstraints { {constraintList ""} } {
-    DebugPuts 3 "entering limitConstraints $constraintList"
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::limitConstraints
-    } 
-    set tcltest::limitConstraints $constraintList
-    foreach elt [tcltest::constraintList] {
-	if {[lsearch -exact [tcltest::constraintsSpecified] $elt] == -1} {
-	    tcltest::testConstraint $elt 0
-	}
-    }
-    return $tcltest::limitConstraints
-}
-
-# tcltest::loadScript --
-#
-#	sets the load script
-#
-# Arguments:
-#	script to be set
-#
-# Results:
-#	contents of tcltest::loadScript
-#
-# Side effects:
-#	None.
-
-proc tcltest::loadScript { {script ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::loadScript
-    }
-    set tcltest::loadScript $script
-}
-
-# tcltest::loadFile --
-#
-#	set the load file (containing the load script); 
-#       put the content of the load file into loadScript
-#
-# Arguments:
-#	script's file name
-#
-# Results:
-#	content of tcltest::loadFile
-#
-# Side effects:
-#	None.
-
-proc tcltest::loadFile { {scriptFile ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::loadFile
-    }
-    MakeAbsolutePath scriptFile $tcltest::temporaryDirectory
-    set tmp [open $scriptFile r]
-    tcltest::loadScript [read $tmp]
-    close $tmp
-    set tcltest::loadFile $scriptFile
-}
-
-# tcltest::workingDirectory --
-#
-#	set workingDirectory to the given path. 
-#       If the path is relative, make it absolute.
-#       change directory to the stated working directory, if resetting the
-#       value 
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::workingDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::workingDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::workingDirectory
-    }
-    set tcltest::workingDirectory $dir
-    MakeAbsolutePath tcltest::workingDirectory
-    cd $tcltest::workingDirectory
-    return $tcltest::workingDirectory
-}
-
-# tcltest::temporaryDirectory --
-#
-#     Set tcltest::temporaryDirectory to the given path.
-#     If the path is relative, make it absolute.  If the file exists but
-#     is not a dir, then return an error.
-#
-#     If tcltest::temporaryDirectory does not already exist, create it.
-#     If you cannot create it, then return an error (the file mkdir isn't
-#     caught and will propagate).
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::temporaryDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::temporaryDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::temporaryDirectory
-    }
-    set tcltest::temporaryDirectory $dir
-
-    MakeAbsolutePath tcltest::temporaryDirectory
-    set tmpDirError "bad argument for temporary directory: "
-
-    if {[file exists $tcltest::temporaryDirectory]} {
-	tcltest::CheckDirectory rw $tcltest::temporaryDirectory $tmpDirError
-    } else {
-	file mkdir $tcltest::temporaryDirectory
-    }
-
-    normalizePath tcltest::temporaryDirectory
-}
-
-# tcltest::testsDirectory --
-#
-#     Set tcltest::testsDirectory to the given path.
-#     If the path is relative, make it absolute.  If the file exists but
-#     is not a dir, then return an error.
-#
-#     If tcltest::testsDirectory does not already exist, return an error.
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::testsDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::testsDirectory { {dir ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::testsDirectory
-    }
-
-    set tcltest::testsDirectory $dir
-    
-    MakeAbsolutePath tcltest::testsDirectory
-    set testDirError "bad argument for tests directory: "
-
-    if {[file exists $tcltest::testsDirectory]} {
-	tcltest::CheckDirectory r $tcltest::testsDirectory $testDirError
-    } else {
-	set msg "$testDirError \"$tcltest::testsDirectory\" does not exist"
-	error $msg
-    }
-    
-    normalizePath tcltest::testsDirectory
-}
-
-# tcltest::singleProcess --
-#
-#	sets tcltest::singleProcess to the value provided.
-#
-# Arguments:
-#	value for singleProcess:
-#       1 = source each test file into the current process
-#       0 = run each test file in its own process 
-#
-# Results:
-#	content of tcltest::singleProcess
-#
-# Side effects:
-#	None.
-
-proc tcltest::singleProcess { {value ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::singleProcess
-    }
-    set tcltest::singleProcess $value
-}
-
-# tcltest::interpreter --
-#
-#	the interpreter name stored in tcltest::tcltest
-#
-# Arguments:
-#	executable name
-#
-# Results:
-#	content of tcltest::tcltest
-#
-# Side effects:
-#	None.
-
-proc tcltest::interpreter { {interp ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::tcltest
-    }
-    set tcltest::tcltest $interp
-}
-
-# tcltest::mainThread --
-#
-#	sets or returns the thread id stored in tcltest::mainThread
-#
-# Arguments:
-#	thread id
-#
-# Results:
-#	content of tcltest::mainThread
-#
-# Side effects:
-#	None.
-
-proc tcltest::mainThread { {threadid ""} } {
-    if {[llength [info level 0]] == 1} {
-	return $tcltest::mainThread
-    }
-    set tcltest::mainThread $threadid
-}
-
-#####################################################################
-
-# tcltest::AddToSkippedBecause --
-#
-#	Increments the variable used to track how many tests were skipped
-#       because of a particular constraint.
-#
-# Arguments:
-#	constraint     The name of the constraint to be modified
-#
-# Results:
-#	Modifies tcltest::skippedBecause; sets the variable to 1 if didn't
-#       previously exist - otherwise, it just increments it.
-#
-# Side effects:
-#	None.
-
-proc tcltest::AddToSkippedBecause { constraint {value 1}} {
-    # add the constraint to the list of constraints that kept tests
-    # from running
-
-    if {[info exists tcltest::skippedBecause($constraint)]} {
-	incr tcltest::skippedBecause($constraint) $value
-    } else {
-	set tcltest::skippedBecause($constraint) $value
-    }
-    return
-}
-
-# tcltest::PrintError --
-#
-#	Prints errors to tcltest::errorChannel and then flushes that
-#       channel, making sure that all messages are < 80 characters per line.
-#
-# Arguments:
-#	errorMsg     String containing the error to be printed
-#
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::PrintError {errorMsg} {
-    set InitialMessage "Error:  "
-    set InitialMsgLen  [string length $InitialMessage]
-    puts -nonewline [errorChannel] $InitialMessage
-
-    # Keep track of where the end of the string is.
-    set endingIndex [string length $errorMsg]
-
-    if {$endingIndex < 80} {
-	puts [errorChannel] $errorMsg
-    } else {
-	# Print up to 80 characters on the first line, including the
-	# InitialMessage. 
-	set beginningIndex [string last " " [string range $errorMsg 0 \
-		[expr {80 - $InitialMsgLen}]]]
-	puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
-
-	while {$beginningIndex != "end"} {
-	    puts -nonewline [errorChannel] \
-		    [string repeat " " $InitialMsgLen]  
-	    if {[expr {$endingIndex - $beginningIndex}] < 72} {
-		puts [errorChannel] [string trim \
-			[string range $errorMsg $beginningIndex end]]
-		set beginningIndex end
-	    } else {
-		set newEndingIndex [expr [string last " " [string range \
-			$errorMsg $beginningIndex \
-			[expr {$beginningIndex + 72}]]] + $beginningIndex]
-		if {($newEndingIndex <= 0) \
-			|| ($newEndingIndex <= $beginningIndex)} {
-		    set newEndingIndex end
-		}
-		puts [errorChannel] [string trim \
-			[string range $errorMsg \
-			    $beginningIndex $newEndingIndex]]
-		set beginningIndex $newEndingIndex
-	    }
-	}
-    }
-    flush [errorChannel]
-    return
-}
-
-if {[namespace inscope tcltest info procs initConstraintsHook] == {}} {
-    proc tcltest::initConstraintsHook {} {}
-}
-
-# tcltest::safeFetch --
-#
-#	 The following trace procedure makes it so that we can safely refer to
-#        non-existent members of the tcltest::testConstraints array without 
-#        causing an error.  Instead, reading a non-existent member will return
-#        0. This is necessary because tests are allowed to use constraint "X"
-#        without ensuring that tcltest::testConstraints("X") is defined.
-#
-# Arguments:
-#	n1 - name of the array (tcltest::testConstraints)
-#       n2 - array key value (constraint name)
-#       op - operation performed on tcltest::testConstraints (generally r)
-#
-# Results:
-#	none
-#
-# Side effects:
-#	sets tcltest::testConstraints($n2) to 0 if it's referenced but never
-#       before used
-
-proc tcltest::safeFetch {n1 n2 op} {
-    DebugPuts 3 "entering safeFetch $n1 $n2 $op"
-    if {($n2 != {}) && ([info exists tcltest::testConstraints($n2)] == 0)} {
-	tcltest::testConstraint $n2 0
-    }
-}
-
-# tcltest::initConstraints --
-#
-# Check constraint information that will determine which tests
-# to run.  To do this, create an array tcltest::testConstraints.  Each
-# element has a 0 or 1 value.  If the element is "true" then tests
-# with that constraint will be run, otherwise tests with that constraint
-# will be skipped.  See the tcltest man page for the list of built-in
-# constraints defined in this procedure.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	The tcltest::testConstraints array is reset to have an index for
-#	each built-in test constraint.
-# 
-# Side Effects:
-#       None.
-#
-
-proc tcltest::initConstraints {} {
-    global tcl_platform tcl_interactive tk_version
-
-    # Safely refer to non-existent members of the tcltest::testConstraints
-    # array without causing an error.  
-    trace variable tcltest::testConstraints r tcltest::safeFetch
-
-    tcltest::initConstraintsHook
-
-    tcltest::testConstraint singleTestInterp [singleProcess]
-
-    # All the 'pc' constraints are here for backward compatibility and are not
-    # documented.  They have been replaced with equivalent 'win' constraints.
-
-    tcltest::testConstraint unixOnly \
-	    [string equal $tcl_platform(platform) "unix"]
-    tcltest::testConstraint macOnly \
-	    [string equal $tcl_platform(platform) "macintosh"]
-    tcltest::testConstraint pcOnly \
-	    [string equal $tcl_platform(platform) "windows"]
-    tcltest::testConstraint winOnly \
-	    [string equal $tcl_platform(platform) "windows"]
-
-    tcltest::testConstraint unix [tcltest::testConstraint unixOnly]
-    tcltest::testConstraint mac [tcltest::testConstraint macOnly]
-    tcltest::testConstraint pc [tcltest::testConstraint pcOnly]
-    tcltest::testConstraint win [tcltest::testConstraint winOnly]
-
-    tcltest::testConstraint unixOrPc \
-	    [expr {[tcltest::testConstraint unix] \
-		|| [tcltest::testConstraint pc]}]
-    tcltest::testConstraint macOrPc \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint pc]}]
-    tcltest::testConstraint unixOrWin \
-	    [expr {[tcltest::testConstraint unix] \
-		|| [tcltest::testConstraint win]}]
-    tcltest::testConstraint macOrWin \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint win]}]
-    tcltest::testConstraint macOrUnix \
-	    [expr {[tcltest::testConstraint mac] \
-		|| [tcltest::testConstraint unix]}]
-
-    tcltest::testConstraint nt [string equal $tcl_platform(os) "Windows NT"]
-    tcltest::testConstraint 95 [string equal $tcl_platform(os) "Windows 95"]
-    tcltest::testConstraint 98 [string equal $tcl_platform(os) "Windows 98"]
-
-    # The following Constraints switches are used to mark tests that should
-    # work, but have been temporarily disabled on certain platforms because
-    # they don't and we haven't gotten around to fixing the underlying
-    # problem. 
-
-    tcltest::testConstraint tempNotPc \
-	    [expr {![tcltest::testConstraint pc]}]
-    tcltest::testConstraint tempNotWin \
-	    [expr {![tcltest::testConstraint win]}]
-    tcltest::testConstraint tempNotMac \
-	    [expr {![tcltest::testConstraint mac]}]
-    tcltest::testConstraint tempNotUnix \
-	    [expr {![tcltest::testConstraint unix]}]
-
-    # The following Constraints switches are used to mark tests that crash on
-    # certain platforms, so that they can be reactivated again when the
-    # underlying problem is fixed.
-
-    tcltest::testConstraint pcCrash \
-	    [expr {![tcltest::testConstraint pc]}]
-    tcltest::testConstraint winCrash \
-	    [expr {![tcltest::testConstraint win]}]
-    tcltest::testConstraint macCrash \
-	    [expr {![tcltest::testConstraint mac]}]
-    tcltest::testConstraint unixCrash \
-	    [expr {![tcltest::testConstraint unix]}]
-
-    # Skip empty tests
-
-    tcltest::testConstraint emptyTest 0
-
-    # By default, tests that expose known bugs are skipped.
-
-    tcltest::testConstraint knownBug 0
-
-    # By default, non-portable tests are skipped.
-
-    tcltest::testConstraint nonPortable 0
-
-    # Some tests require user interaction.
-
-    tcltest::testConstraint userInteraction 0
-
-    # Some tests must be skipped if the interpreter is not in interactive mode
-    
-    if {[info exists tcl_interactive]} {
-	tcltest::testConstraint interactive $::tcl_interactive
-    } else {
-	tcltest::testConstraint interactive 0
-    }
-
-    # Some tests can only be run if the installation came from a CD image
-    # instead of a web image
-    # Some tests must be skipped if you are running as root on Unix.
-    # Other tests can only be run if you are running as root on Unix.
-
-    tcltest::testConstraint root 0
-    tcltest::testConstraint notRoot 1
-    set user {}
-    if {[string equal $tcl_platform(platform) "unix"]} {
-	catch {set user [exec whoami]}
-	if {[string equal $user ""]} {
-	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
-	}
-	if {([string equal $user "root"]) || ([string equal $user ""])} {
-	    tcltest::testConstraint root 1
-	    tcltest::testConstraint notRoot 0
-	}
-    }
-
-    # Set nonBlockFiles constraint: 1 means this platform supports
-    # ting files into nonblocking mode.
-
-    if {[catch {set f [open defs r]}]} {
-	tcltest::testConstraint nonBlockFiles 1
-    } else {
-	if {[catch {fconfigure $f -blocking off}] == 0} {
-	    tcltest::testConstraint nonBlockFiles 1
-	} else {
-	    tcltest::testConstraint nonBlockFiles 0
-	}
-	close $f
-    }
-
-    # Set asyncPipeClose constraint: 1 means this platform supports
-    # async flush and async close on a pipe.
-    #
-    # Test for SCO Unix - cannot run async flushing tests because a
-    # potential problem with select is apparently interfering.
-    # (Mark Diekhans).
-
-    if {[string equal $tcl_platform(platform) "unix"]} {
-	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
-	    tcltest::testConstraint asyncPipeClose 0
-	} else {
-	    tcltest::testConstraint asyncPipeClose 1
-	}
-    } else {
-	tcltest::testConstraint asyncPipeClose 1
-    }
-
-    # Test to see if we have a broken version of sprintf with respect
-    # to the "e" format of floating-point numbers.
-
-    tcltest::testConstraint eformat 1
-    if {![string equal "[format %g 5e-5]" "5e-05"]} {
-	tcltest::testConstraint eformat 0
-    }
-
-    # Test to see if execed commands such as cat, echo, rm and so forth are
-    # present on this machine.
-
-    tcltest::testConstraint unixExecs 1
-    if {[string equal $tcl_platform(platform) "macintosh"]} {
-	tcltest::testConstraint unixExecs 0
-    }
-    if {([tcltest::testConstraint unixExecs] == 1) && \
-	    ([string equal $tcl_platform(platform) "windows"])} {
-	if {[catch {exec cat defs}] == 1} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec echo hello}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec sh -c echo hello}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec wc defs}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {[tcltest::testConstraint unixExecs] == 1} {
-	    exec echo hello > removeMe
-	    if {[catch {exec rm removeMe}] == 1} {
-		tcltest::testConstraint unixExecs 0
-	    }
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec sleep 1}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec fgrep unixExecs defs}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec ps}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec echo abc > removeMe}] == 0) && \
-		([catch {exec chmod 644 removeMe}] == 1) && \
-		([catch {exec rm removeMe}] == 0)} {
-	    tcltest::testConstraint unixExecs 0
-	} else {
-	    catch {exec rm -f removeMe}
-	}
-	if {([tcltest::testConstraint unixExecs] == 1) && \
-		([catch {exec mkdir removeMe}] == 1)} {
-	    tcltest::testConstraint unixExecs 0
-	} else {
-	    catch {exec rm -r removeMe}
-	}
-    }
-
-    # Locate tcltest executable
-
-    if {![info exists tk_version]} {
-	set tcltest::tcltest [info nameofexecutable]
-
-	if {$tcltest::tcltest == "{}"} {
-	    set tcltest::tcltest {}
-	}
-    }
-
-    tcltest::testConstraint stdio 0
-    catch {
-	catch {file delete -force tmp}
-	set f [open tmp w]
-	puts $f {
-	    exit
-	}
-	close $f
-
-	set f [open "|[list $tcltest tmp]" r]
-	close $f
-	
-	tcltest::testConstraint stdio 1
-    }
-    catch {file delete -force tmp}
-
-    # Deliberately call socket with the wrong number of arguments.  The error
-    # message you get will indicate whether sockets are available on this
-    # system. 
-
-    catch {socket} msg
-    tcltest::testConstraint socket \
-	    [expr {$msg != "sockets are not available on this system"}]
-    
-    # Check for internationalization
-
-    if {[info commands testlocale] == ""} {
-	# No testlocale command, no tests...
-	tcltest::testConstraint hasIsoLocale 0
-    } else {
-	tcltest::testConstraint hasIsoLocale \
-		[string length [tcltest::set_iso8859_1_locale]]
-	tcltest::restore_locale
-    }
-}   
-
-#####################################################################
-
-# Handle command line arguments (from argv) and default arg settings 
-# (in TCLTEST_OPTIONS).
-
-# tcltest::PrintUsageInfoHook
-#
-#       Hook used for customization of display of usage information.
-#
-
-if {[namespace inscope tcltest info procs PrintUsageInfoHook] == {}} {
-    proc tcltest::PrintUsageInfoHook {} {}
-}
-
-# tcltest::PrintUsageInfo
-#
-#	Prints out the usage information for package tcltest.  This can be
-#       customized with the redefinition of tcltest::PrintUsageInfoHook.
-#
-# Arguments:
-#	none
-#
-# Results:
-#       none
-#
-# Side Effects: 
-#       none
-
-proc tcltest::PrintUsageInfo {} {
-    puts [format "Usage: [file tail [info nameofexecutable]] \
-	    script ?-help? ?flag value? ... \n\
-	    Available flags (and valid input values) are: \n\
-	    -help          \t Display this usage information. \n\
-	    -verbose level \t Takes any combination of the values \n\
-	    \t                 'p', 's', 'b', 't' and 'e'.  Test suite will \n\
-	    \t                 display all passed tests if 'p' is \n\
-	    \t                 specified, all skipped tests if 's' \n\
-	    \t                 is specified, the bodies of \n\
-	    \t                 failed tests if 'b' is specified, \n\
-	    \t                 and when tests start if 't' is specified. \n\
-	    \t                 ErrorInfo is displayed if 'e' is specified. \n\
-	    \t                 The default value is 'b'. \n\
-	    -constraints list\t Do not skip the listed constraints\n\
-	    -limitconstraints bool\t Only run tests with the constraints\n\
-	    \t                 listed in -constraints.\n\
-	    -match pattern \t Run all tests within the specified \n\
-	    \t                 files that match the glob pattern \n\
-	    \t                 given. \n\
-	    -skip pattern  \t Skip all tests within the set of \n\
-	    \t                 specified tests (via -match) and \n\
-	    \t                 files that match the glob pattern \n\
-	    \t                 given. \n\
-	    -file pattern  \t Run tests in all test files that \n\
-	    \t                 match the glob pattern given. \n\
-	    -notfile pattern\t Skip all test files that match the \n\
-	    \t                 glob pattern given. \n\
-	    -relateddir pattern\t Run tests in directories that match \n\
-	    \t                 the glob pattern given. \n\
-	    -asidefromdir pattern\t Skip tests in directories that match \n\
-	    \t                 the glob pattern given.\n\
-	    -preservecore level \t If 2, save any core files produced \n\
-	    \t                 during testing in the directory \n\
-	    \t                 specified by -tmpdir. If 1, notify the\n\
-	    \t                 user if core files are created. The default \n\
-	    \t                 is $tcltest::preserveCore. \n\
-	    -tmpdir directory\t Save temporary files in the specified\n\
-	    \t                 directory.  The default value is \n\
-	    \t                 $tcltest::temporaryDirectory. \n\
-	    -testdir directories\t Search tests in the specified\n\
-	    \t                 directories.  The default value is \n\
-	    \t                 $tcltest::testsDirectory. \n\
-	    -outfile file    \t Send output from test runs to the \n\
-	    \t                 specified file.  The default is \n\
-	    \t                 stdout. \n\
-	    -errfile file    \t Send errors from test runs to the \n\
-	    \t                 specified file.  The default is \n\
-	    \t                 stderr. \n\
-	    -loadfile file   \t Read the script to load the tested \n\
-	    \t                 commands from the specified file. \n\
-	    -load script     \t Specifies the script to load the tested \n\
-	    \t                 commands. \n\
-	    -debug level     \t Internal debug flag."]
-    tcltest::PrintUsageInfoHook
-    return
-}
-
-# tcltest::processCmdLineArgsFlagsHook --
-#
-#	This hook is used to add to the list of command line arguments that are
-#       processed by tcltest::ProcessFlags.   It is called at the beginning of
-#       ProcessFlags.
-#
-
-if {[namespace inscope tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
-    proc tcltest::processCmdLineArgsAddFlagsHook {} {}
-}
-
-# tcltest::processCmdLineArgsHook --
-#
-#	This hook is used to actually process the flags added by
-#       tcltest::processCmdLineArgsAddFlagsHook.  It is called at the end of
-#       ProcessFlags. 
-#
-# Arguments:
-#	flags      The flags that have been pulled out of argv
-#
-
-if {[namespace inscope tcltest info procs processCmdLineArgsHook] == {}} {
-    proc tcltest::processCmdLineArgsHook {flag} {}
-}
-
-# tcltest::ProcessFlags --
-#
-#	process command line arguments supplied in the flagArray - this is
-#       called by processCmdLineArgs
-#       modifies tcltest variables according to the content of the flagArray.
-#
-# Arguments:
-#	flagArray - array containing name/value pairs of flags
-#
-# Results:
-#	sets tcltest variables according to their values as defined by
-#       flagArray 
-#
-# Side effects:
-#	None.
-
-proc tcltest::ProcessFlags {flagArray} {
-    # Process -help first
-    if {[lsearch -exact $flagArray {-help}] != -1} {
-	tcltest::PrintUsageInfo
-	exit 1
-    }
-    
-    catch {array set flag $flagArray}
-
-    # -help is not listed since it has already been processed
-    lappend defaultFlags -verbose -match -skip -constraints \
-	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints -testdir \
-	    -load -loadfile -asidefromdir \
-	    -relateddir -singleproc
-    set defaultFlags [concat $defaultFlags \
-	    [tcltest::processCmdLineArgsAddFlagsHook ]]
-
-    # Set tcltest::verbose to the arg of the -verbose flag, if given
-    if {[info exists flag(-verbose)]} {
-	tcltest::verbose $flag(-verbose)
-    }
-
-    # Set tcltest::match to the arg of the -match flag, if given.  
-    if {[info exists flag(-match)]} {
-	tcltest::match $flag(-match)
-    } 
-
-    # Set tcltest::skip to the arg of the -skip flag, if given
-    if {[info exists flag(-skip)]} {
-	tcltest::skip $flag(-skip)
-    }
-
-    # Handle the -file and -notfile flags
-    if {[info exists flag(-file)]} {
-	tcltest::matchFiles $flag(-file)
-    }
-    if {[info exists flag(-notfile)]} {
-	tcltest::skipFiles $flag(-notfile)
-    }
-
-    # Handle -relateddir and -asidefromdir flags
-    if {[info exists flag(-relateddir)]} {
-	tcltest::matchDirectories $flag(-relateddir)
-    }
-    if {[info exists flag(-asidefromdir)]} {
-	tcltest::skipDirectories $flag(-asidefromdir)
-    }
-
-    # Use the -constraints flag, if given, to turn on constraints that are
-    # turned off by default: userInteractive knownBug nonPortable.  This
-    # code fragment must be run after constraints are initialized.
-
-    if {[info exists flag(-constraints)]} {
-	foreach elt $flag(-constraints) {
-	    tcltest::testConstraint $elt 1
-	}
-    }
-
-    # Use the -limitconstraints flag, if given, to tell the harness to limit
-    # tests run to those that were specified using the -constraints flag.  If
-    # the -constraints flag was not specified, print out an error and exit.
-    if {[info exists flag(-limitconstraints)]} {
-	if {![info exists flag(-constraints)]} {
-	    set msg "-limitconstraints flag can only be used with -constraints"
-	    error $msg
-	}
-	tcltest::limitConstraints $flag(-limitconstraints)
-    }
-
-    # Set the tcltest::temporaryDirectory to the arg of -tmpdir, if
-    # given.
-
-    if {[info exists flag(-tmpdir)]} {
-	tcltest::temporaryDirectory $flag(-tmpdir)
-    }
-
-    # Set the tcltest::testsDirectory to the arg of -testdir, if
-    # given.
-    
-    if {[info exists flag(-testdir)]} {
-	tcltest::testsDirectory $flag(-testdir)
-    }
-
-    # If an alternate error or output files are specified, change the
-    # default channels.
-
-    if {[info exists flag(-outfile)]} {
-	tcltest::outputFile $flag(-outfile)
-    } 
-
-    if {[info exists flag(-errfile)]} {
-	tcltest::errorFile $flag(-errfile)
-    }
-
-    # If a load script was specified, either directly or through
-    # a file, remember it for later usage.
-    
-    if {[info exists flag(-load)] &&  \
-	    ([lsearch -exact $flagArray -load] > \
-		[lsearch -exact $flagArray -loadfile])} {
-	tcltest::loadScript $flag(-load)
-    }
-    
-    if {[info exists flag(-loadfile)] && \
-	    ([lsearch -exact $flagArray -loadfile] > \
-		[lsearch -exact $flagArray -load]) } {
-	tcltest::loadFile $flag(-loadfile)
-    }
-
-    # If the user specifies debug testing, print out extra information during
-    # the run.
-    if {[info exists flag(-debug)]} {
-	tcltest::debug $flag(-debug)
-    }
-
-    # Handle -preservecore
-    if {[info exists flag(-preservecore)]} {
-	tcltest::preserveCore $flag(-preservecore)
-    }
-
-    # Handle -singleproc flag
-    if {[info exists flag(-singleproc)]} {
-	tcltest::singleProcess $flag(-singleproc)
-    }
-
-    # Call the hook
-    tcltest::processCmdLineArgsHook [array get flag]
-    return
-}
-
-# tcltest::processCmdLineArgs --
-#
-#	Use command line args to set tcltest namespace variables.
-#
-#       This procedure must be run after constraints are initialized, because
-#       some constraints can be overridden.
-# 
-#       Set variables based on the contents of the environment variable
-#       TCLTEST_OPTIONS first, then override with command-line options, if
-#       specified. 
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Sets the above-named variables in the tcltest namespace.
-# 
-# Side Effects:
-#       None.
-#
-
-proc tcltest::processCmdLineArgs {} {
-    global argv
-
-    # If the TCLTEST_OPTIONS environment variable exists, parse it first, then
-    # the argv list.  The command line argument parsing will be a two-pass
-    # affair from now on, so that TCLTEST_OPTIONS contain the default options.
-    # These can be overridden by the command line flags.
-
-    if {[info exists ::env(TCLTEST_OPTIONS)]} {
-	tcltest::ProcessFlags $::env(TCLTEST_OPTIONS)
-    } 
-
-    # The "argv" var doesn't exist in some cases, so use {}.
-    if {(![info exists argv]) || ([llength $argv] < 1)} {
-	set flagArray {}
-    } else {
-	set flagArray $argv
-    }
-    
-    tcltest::ProcessFlags $flagArray
-
-    # Spit out everything you know if we're at a debug level 2 or greater
-    DebugPuts 2 "Flags passed into tcltest:"
-    if {[info exists ::env(TCLTEST_OPTIONS)]} {
-	DebugPuts 2 "    ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
-    }
-    if {[info exists argv]} {
-	DebugPuts 2 "    argv: $argv"
-    }
-    DebugPuts    2 "tcltest::debug              = [tcltest::debug]"
-    DebugPuts    2 "tcltest::testsDirectory     = [tcltest::testsDirectory]"
-    DebugPuts    2 "tcltest::workingDirectory   = [tcltest::workingDirectory]"
-    DebugPuts    2 "tcltest::temporaryDirectory = [tcltest::temporaryDirectory]"
-    DebugPuts    2 "tcltest::outputChannel      = [outputChannel]"
-    DebugPuts    2 "tcltest::errorChannel       = [errorChannel]"
-    DebugPuts    2 "Original environment (tcltest::originalEnv):"
-    DebugPArray  2 tcltest::originalEnv
-    DebugPuts    2 "Constraints:"
-    DebugPArray  2 tcltest::testConstraints
-    return
-}
-
-#####################################################################
-
-# Code to run the tests goes here.
-
-# tcltest::testPuts --
-#
-#	Used to redefine puts in test environment.
-#       Stores whatever goes out on stdout in tcltest::outData and stderr in 
-#       tcltest::errData before sending it on to the regular puts.
-#
-# Arguments:
-#	same as standard puts
-#
-# Results:
-#	none
-#
-# Side effects:
-#       Intercepts puts; data that would otherwise go to stdout, stderr, or
-#       file channels specified in tcltest::outputChannel and errorChannel does
-#       not get sent to the normal puts function.
-
-proc tcltest::testPuts {args} {
-    set len [llength $args]
-    if {$len == 1} {
-	# Only the string to be printed is specified
-	append tcltest::outData "[lindex $args 0]\n"
-	return
-#	return [tcltest::normalPuts [lindex $args 0]]
-    } elseif {$len == 2} {
-	# Either -nonewline or channelId has been specified
-	if {[regexp {^-nonewline} [lindex $args 0]]} {
-	    append tcltest::outData "[lindex $args end]"
-	    return
-#	    return [tcltest::normalPuts -nonewline [lindex $args end]]
-	} else {
-	    set channel [lindex $args 0]
-	}
-    } elseif {$len == 3} {
-	if {[lindex $args 0] == "-nonewline"} {
-	    # Both -nonewline and channelId are specified, unless it's an
-	    # error.  -nonewline is supposed to be argv[0].
-	    set channel [lindex $args 1]
-	}
-    }
-
-    if {[info exists channel]} {
-	if {($channel == [outputChannel]) || ($channel == "stdout")} {
-	    append tcltest::outData "[lindex $args end]\n"
-	} elseif {($channel == [errorChannel]) || ($channel == "stderr")} {
-	    append tcltest::errData "[lindex $args end]\n"
-	}
-	return
-	# return [tcltest::normalPuts [lindex $args 0] [lindex $args end]]
-    }
-
-    # If we haven't returned by now, we don't know how to handle the input.
-    # Let puts handle it.
-    return [eval tcltest::normalPuts $args]
-}
-
-# tcltest::testEval --
-#
-#	Evaluate the script in the test environment.  If ignoreOutput is 
-#       false, store data sent to stderr and stdout in tcltest::outData and 
-#       tcltest::errData.  Otherwise, ignore this output altogether.
-#
-# Arguments:
-#	script             Script to evaluate
-#       ?ignoreOutput?     Indicates whether or not to ignore output sent to
-#                          stdout & stderr
-#
-# Results:
-#	result from running the script
-#
-# Side effects:
-#	Empties the contents of tcltest::outData and tcltest::errData before
-#       running a test if ignoreOutput is set to 0. 
-
-proc tcltest::testEval {script {ignoreOutput 1}} {
-    DebugPuts 3 "testEval called" 
-    if {!$ignoreOutput} {
-	set tcltest::outData {}
-	set tcltest::errData {}
-	uplevel rename ::puts tcltest::normalPuts
-	uplevel rename tcltest::testPuts ::puts
-    }
-    set result [uplevel $script]
-    if {!$ignoreOutput} {
-	uplevel rename ::puts tcltest::testPuts
-	uplevel rename tcltest::normalPuts ::puts
-    }
-    return $result
-}
-
-# compareStrings --
-#
-#	compares the expected answer to the actual answer, depending on the
-#       mode provided.  Mode determines whether a regexp, exact, or glob
-#       comparison is done.
-#
-# Arguments:
-#	actual - string containing the actual result
-#       expected - pattern to be matched against
-#       mode - type of comparison to be done
-#
-# Results:
-#	result of the match
-#
-# Side effects:
-#	None.
-
-proc tcltest::compareStrings {actual expected mode} {
-    switch -- $mode {
-	exact {
-	    set retval [string equal $actual $expected]
-	}
-	glob {
-	    set retval [string match $expected $actual]
-	}
-	regexp {
-	    set retval [regexp -- $expected $actual]
-	}
-    }
-    return $retval
-}
-
-
-#
-# tcltest::substArguments list
-#
-# This helper function takes in a list of words, then perform a
-# substitution on the list as though each word in the list is a
-# separate argument to the Tcl function.  For example, if this
-# function is invoked as:
-#
-#      substArguments {$a {$a}}
-#
-# Then it is as though the function is invoked as:
-#
-#      substArguments $a {$a}
-#
-# This code is adapted from Paul Duffin's function "SplitIntoWords".
-# The original function can be found  on:
-#
-#      http://purl.org/thecliff/tcl/wiki/858.html
-#
-# Results:
-#     a list containing the result of the substitution
-#
-# Exceptions:
-#     An error may occur if the list containing unbalanced quote or
-#     unknown variable.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::substArguments {argList} {
-
-    # We need to split the argList up into tokens but cannot use
-    # list operations as they throw away some significant
-    # quoting, and [split] ignores braces as it should.
-    # Therefore what we do is gradually build up a string out of
-    # whitespace seperated strings. We cannot use [split] to
-    # split the argList into whitespace seperated strings as it
-    # throws away the whitespace which maybe important so we
-    # have to do it all by hand.
-
-    set result {}
-    set token ""
-
-    while {[string length $argList]} {
-        # Look for the next word containing a quote: " { }
-        if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \
-                $argList all]} {
-            # Get the text leading up to this word, but not
-            # including this word, from the argList.
-            set text [string range $argList 0 \
-                    [expr {[lindex $all 0] - 1}]]
-            # Get the word with the quote
-            set word [string range $argList \
-                    [lindex $all 0] [lindex $all 1]]
-
-            # Remove all text up to and including the word from the
-            # argList.
-            set argList [string range $argList \
-                    [expr {[lindex $all 1] + 1}] end]
-        } else {
-            # Take everything up to the end of the argList.
-            set text $argList
-            set word {}
-            set argList {}
-        }
-        
-        if {$token != {}} {
-            # If we saw a word with quote before, then there is a
-            # multi-word token starting with that word.  In this case,
-            # add the text and the current word to this token.
-            append token $text $word
-        } else {
-            # Add the text to the result.  There is no need to parse
-            # the text because it couldn't be a part of any multi-word
-            # token.  Then start a new multi-word token with the word
-            # because we need to pass this token to the Tcl parser to
-            # check for balancing quotes
-            append result $text
-            set token $word
-        }
-        
-        if { [catch {llength $token} length] == 0 && $length == 1} {
-            # The token is a valid list so add it to the result.
-            # lappend result [string trim $token]
-            append result \{$token\}
-            set token {}
-        }
-    }
-
-    # If the last token has not been added to the list then there
-    # is a problem.
-    if { [string length $token] } {
-        error "incomplete token \"$token\""
-    }
-
-    return $result
-}
-
-
-# tcltest::test --
-#
-# This procedure runs a test and prints an error message if the test fails.
-# If tcltest::verbose has been set, it also prints a message even if the
-# test succeeds.  The test will be skipped if it doesn't match the
-# tcltest::match variable, if it matches an element in
-# tcltest::skip, or if one of the elements of "constraints" turns
-# out not to be true.
-# 
-# If testLevel is 1, then this is a top level test, and we record pass/fail
-# information; otherwise, this information is not logged and is not added to
-# running totals.
-# 
-# Attributes:
-#   Only description is a required attribute.  All others are optional.
-#   Default values are indicated.
-# 
-#   constraints -		A list of one or more keywords, each of
-#			        which must be the name of an element in
-#			        the array "tcltest::testConstraints".  If any
-#                               of these elements is zero, the test is
-#                               skipped. This attribute is optional; default is {}
-#   body -		        Script to run to carry out the test.  It must
-#			        return a result that can be checked for
-#			        correctness.  This attribute is optional;
-#                               default is {}
-#   result -	                Expected result from script.  This attribute is
-#                               optional; default is {}.
-#   output -                    Expected output sent to stdout.  This attribute
-#                               is optional; default is {}.  
-#   errorOutput -               Expected output sent to stderr.  This attribute
-#                               is optional; default is {}.  
-#   returnCodes -              Expected return codes.  This attribute is
-#                               optional; default is {0 2}.
-#   setup -                     Code to run before $script (above).  This
-#                               attribute is optional; default is {}.
-#   cleanup -                   Code to run after $script (above).  This
-#                               attribute is optional; default is {}.
-#   match -                     specifies type of matching to do on result,
-#                               output, errorOutput; this must be one of: exact,
-#                               glob, regexp.  default is exact.
-#
-# Arguments:
-#   name -		Name of test, in the form foo-1.2.
-#   description -	Short textual description of the test, to
-#  		  	help humans understand what it does.
-# 
-# Results:
-#	0 if the command ran successfully; 1 otherwise.
-#
-# Side effects:
-#       None.
-# 
-
-proc tcltest::test {name description args} {
-    DebugPuts 3 "Test $name $args"
-
-    incr tcltest::testLevel
-
-    # Pre-define everything to null except output and errorOutput.  We
-    # determine whether or not to trap output based on whether or not these
-    # variables (output & errorOutput) are defined.
-    foreach item {constraints setup cleanup body result returnCodes match} {
-	set $item {}
-    }
-
-    # Set the default match mode
-    set match exact
-
-    # Set the default match values for return codes (0 is the standard expected
-    # return value if everything went well; 2 represents 'return' being used in
-    # the test script).
-    set returnCodes [list 0 2]
-
-    # The old test format can't have a 3rd argument (constraints or script)
-    # that starts with '-'.
-    if {[llength $args] == 0} {
-	puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?options?\"}"
-	incr tcltest::testLevel -1
-	return 1
-    } elseif {([string index [lindex $args 0] 0] == "-") || ([llength $args] == 1)} {
-	
-	if {[llength $args] == 1} {
-	    set list [substArguments [lindex $args 0]]
-	    foreach {element value} $list { 
-		set testAttributes($element) $value
-	    }
-	    foreach item {constraints match setup body cleanup \
-		    result returnCodes output errorOutput} {
-		if {[info exists testAttributes([subst -$item])]} {
-		    set testAttributes([subst -$item]) \
-			    [uplevel concat $testAttributes([subst -$item])]
-		}
-	    }
-	} else {
-	    array set testAttributes $args
-	}
-
-	set validFlags {-setup -cleanup -body -result -returnCodes -match \
-		-output -errorOutput -constraints}
-
-	foreach flag [array names testAttributes] {
-	    if {[lsearch -exact $validFlags $flag] == -1} {
-		puts [errorChannel] "test $name: bad flag $flag supplied to tcltest::test"
-		incr tcltest::testLevel -1
-		return 1
-	    }
-	}
-
-	# store whatever the user gave us
-	foreach item [array names testAttributes] {
-	    set [string trimleft $item "-"] $testAttributes($item)
-	}
-
-	# Check the values supplied for -match
-	if {[lsearch {regexp glob exact} $match] == -1} {
-	    puts [errorChannel] "test $name: {bad value for -match: must be one of exact, glob, regexp}"
-	    incr tcltest::testLevel -1
-	    return 1
-	}
-
-	# Replace symbolic valies supplied for -returnCodes
-	regsub -nocase normal $returnCodes 0 returnCodes
-	regsub -nocase error $returnCodes 1 returnCodes
-	regsub -nocase return $returnCodes 2 returnCodes
-	regsub -nocase break $returnCodes 3 returnCodes
-	regsub -nocase continue $returnCodes 4 returnCodes 
-    } else {
-	# This is parsing for the old test command format; it is here for
-	# backward compatibility.
-	set result [lindex $args end]
-	if {[llength $args] == 2} {
-	    set body [lindex $args 0]
-	} elseif {[llength $args] == 3} {
-	    set constraints [lindex $args 0]
-	    set body [lindex $args 1]
-	} else {
-	    puts [errorChannel] "test $name: {wrong # args: should be \"test name desc ?constraints? script expectedResult\"}"
-	    incr tcltest::testLevel -1
-	    return 1
-	}
-    } 
-
-    set setupFailure 0
-    set cleanupFailure 0
-
-    # Run the setup script
-    if {[catch {uplevel $setup} setupMsg]} {
-	set setupFailure 1
-    }
-
-    # run the test script
-    set command [list tcltest::runTest $name $description $body \
-	    $result $constraints]  
-    if {!$setupFailure} {
-	if {[info exists output] || [info exists errorOutput]} {
-	    set testResult [uplevel tcltest::testEval [list $command] 0]
-	} else {
-	    set testResult [uplevel tcltest::testEval [list $command] 1]
-	}
-    } else {
-	set testResult setupFailure
-    }
-
-    # Run the cleanup code
-    if {[catch {uplevel $cleanup} cleanupMsg]} {
-	set cleanupFailure 1
-    }
-
-    # If testResult is an empty list, then the test was skipped
-    if {$testResult != {}} {
-	set coreFailure 0
-	set coreMsg ""
-	# check for a core file first - if one was created by the test, then
-	# the test failed
-	if {$tcltest::preserveCore} {
-	    set currentTclPlatform [array get tcl_platform]
-	    if {[file exists [file join [tcltest::workingDirectory] core]]} {
-		# There's only a test failure if there is a core file and (1)
-		# there previously wasn't one or (2) the new one is different
-		# from the old one. 
-		if {[info exists coreModTime]} {
-		    if {$coreModTime != [file mtime \
-			    [file join [tcltest::workingDirectory] core]]} {
-			set coreFailure 1
-		    } 
-		} else {
-		    set coreFailure 1
-		}
-		
-		if {($tcltest::preserveCore > 1) && ($coreFailure)} {
-		    append coreMsg "\nMoving file to: [file join $tcltest::temporaryDirectory core-$name]"
-		    catch {file rename -force \
-			    [file join [tcltest::workingDirectory] core] \
-			    [file join $tcltest::temporaryDirectory \
-				core-$name]} msg
-		    if {[string length $msg] > 0} {
-			append coreMsg "\nError: Problem renaming core file: $msg"
-		    }
-		}
-	    }
-	    array set tcl_platform $currentTclPlatform
-	}
-
-	set actualAnswer [lindex $testResult 0]
-	set code [lindex $testResult end]
-
-	# If expected output/error strings exist, we have to compare
-	# them.  If the comparison fails, then so did the test.
-	set outputFailure 0
-	set errorFailure 0
-	if {[info exists output]} { 
-	    set outputFailure [expr ![compareStrings $tcltest::outData \
-		    $output $match]]
-	} 
-	if {[info exists errorOutput]} {
-	    set errorFailure [expr ![compareStrings $tcltest::errData \
-		    $errorOutput $match]]
-	}
-
-	set testFailed 1
-	set codeFailure 0
-	set scriptFailure 0
-
-	# check if the return code matched the expected return code
-	if {[lsearch -exact $returnCodes $code] == -1} {
-	    set codeFailure 1
-	} 
-
-	# check if the answer matched the expected answer
-	if {[compareStrings $actualAnswer $result $match] == 0} {
-	    set scriptFailure 1
-	}
-
-	# if we didn't experience any failures, then we passed
-	if {!($setupFailure || $cleanupFailure || $coreFailure || \
-		$outputFailure || $errorFailure || $codeFailure || \
-		$scriptFailure)} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Passed)
-		if {[tcltest::isVerbose pass]} {
-		    puts [outputChannel] "++++ $name PASSED"
-		}
-	    }
-	    set testFailed 0
-	}
-
-	if {$testFailed} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Failed)
-	    }
-	    set tcltest::currentFailure true
-	    if {![tcltest::isVerbose body]} {
-		set body ""
-	    }	
-	    puts [outputChannel] "\n==== $name [string trim $description] FAILED"
-	    if {$body != ""} {
-		puts [outputChannel] "==== Contents of test case:"
-		puts [outputChannel] $body
-	    }
-	    if {$setupFailure} {
-		puts [outputChannel] "---- Test setup failed:\n$setupMsg"
-	    } 
-	    if {$scriptFailure} {
-		puts [outputChannel] "---- Result was:\n$actualAnswer"
-		puts [outputChannel] "---- Result should have been ($match matching):\n$result"
-	    }
-	    if {$codeFailure} {
-		switch -- $code {
-		    0 { set msg "Test completed normally" }
-		    1 { set msg "Test generated error" }
-		    2 { set msg "Test generated return exception" }
-		    3 { set msg "Test generated break exception" }
-		    4 { set msg "Test generated continue exception" } 
-		    default { set msg "Test generated exception" }
-		}
-		puts [outputChannel] "---- $msg; Return code was: $code"
-		puts [outputChannel] "---- Return code should have been one of: $returnCodes"
-		if {[tcltest::isVerbose error]} {
-		    if {[info exists ::errorInfo]} {
-			puts [outputChannel] "---- errorInfo: $::errorInfo"
-			puts [outputChannel] "---- errorCode: $::errorCode"
-		    }
-		}
-	    }
-	    if {$outputFailure} {
-		puts [outputChannel] "---- Output was:\n$tcltest::outData"
-		puts [outputChannel] "---- Output should have been ($match matching):\n$output"
-	    }
-	    if {$errorFailure} {
-		puts [outputChannel] "---- Error output was:\n$tcltest::errData"
-		puts [outputChannel] "---- Error output should have been ($match matching):\n$errorOutput"
-	    }
-	    if {$cleanupFailure} {
-		puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
-	    }
-	    if {$coreFailure} {
-		puts [outputChannel] "---- Core file produced while running test! $coreMsg"
-	    }
-	    puts [outputChannel] "==== $name FAILED\n"
-
-	}
-    }
-    
-    incr tcltest::testLevel -1
-    return 0
-}
-
-
-# runTest --
-#
-# This is the defnition of the version 1.0 test routine for tcltest.  It is
-# provided here for backward compatibility.  It is also used as the 'backbone'
-# of the test procedure, as in, this is where all the work really gets done.
-# 
-# This procedure runs a test and prints an error message if the test fails.
-# If tcltest::verbose has been set, it also prints a message even if the
-# test succeeds.  The test will be skipped if it doesn't match the
-# tcltest::match variable, if it matches an element in
-# tcltest::skip, or if one of the elements of "constraints" turns
-# out not to be true.
-#
-# Arguments:
-# name -		Name of test, in the form foo-1.2.
-# description -		Short textual description of the test, to
-#			help humans understand what it does.
-# constraints -		A list of one or more keywords, each of
-#			which must be the name of an element in
-#			the array "tcltest::testConstraints".  If any of these
-#			elements is zero, the test is skipped.
-#			This argument may be omitted.
-# script -		Script to run to carry out the test.  It must
-#			return a result that can be checked for
-#			correctness.
-# expectedAnswer -	Expected result from script.
-# 
-# Behavior depends on the value of testLevel; if testLevel is 1 (top level),
-# then events are logged and we track the number of tests run/skipped and why.
-# Otherwise, we don't track this information.
-# 
-# Results:
-#    empty list if test is skipped; otherwise returns list containing
-#    actual returned value from the test and the return code.
-# 
-# Side Effects:
-#    none.
-#
-
-proc tcltest::runTest {name description script expectedAnswer constraints} {
-
-    if {$tcltest::testLevel == 1} {
-	incr tcltest::numTests(Total)
-    }
-    
-    # skip the test if it's name matches an element of skip
-    foreach pattern $tcltest::skip {
-	if {[string match $pattern $name]} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedSkip}
-	    }
-	    return
-	}
-    }
-
-    # skip the test if it's name doesn't match any element of match
-    if {[llength $tcltest::match] > 0} {
-	set ok 0
-	foreach pattern $tcltest::match {
-	    if {[string match $pattern $name]} {
-		set ok 1
-		break
-	    }
-        }
-	if {!$ok} {
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		DebugDo 1 {tcltest::AddToSkippedBecause userSpecifiedNonMatch}
-	    }
-	    return
-	}
-    }
-
-    DebugPuts 3 "Running $name ($description) {$script} {$expectedAnswer} $constraints"
-
-    if {$constraints == {}} {
-	# If we're limited to the listed constraints and there aren't any
-	# listed, then we shouldn't run the test.
-	if {$tcltest::limitConstraints} {
-	    tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-	    }
-	    return
-	}
-    } else {
-	# "constraints" argument exists; 
-	# make sure that the constraints are satisfied.
-
-	set doTest 0
-	if {[string match {*[$\[]*} $constraints] != 0} {
-	    # full expression, e.g. {$foo > [info tclversion]}
-	    catch {set doTest [uplevel #0 expr $constraints]}
-	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
-	    # something like {a || b} should be turned into 
-	    # $tcltest::testConstraints(a) || $tcltest::testConstraints(b).
-	    regsub -all {[.\w]+} $constraints \
-		    {$tcltest::testConstraints(&)} c
-	    catch {set doTest [eval expr $c]}
-	} else {
-	    # just simple constraints such as {unixOnly fonts}.
-	    set doTest 1
-	    foreach constraint $constraints {
-		if {(![info exists tcltest::testConstraints($constraint)]) \
-			|| (!$tcltest::testConstraints($constraint))} {
-		    set doTest 0
-
-		    # store the constraint that kept the test from running
-		    set constraints $constraint
-		    break
-		}
-	    }
-	}
-	
-	if {$doTest == 0} {
-	    if {[tcltest::isVerbose skip]} {
-		puts [outputChannel] "++++ $name SKIPPED: $constraints"
-	    }
-	    
-	    if {$tcltest::testLevel == 1} {
-		incr tcltest::numTests(Skipped)
-		tcltest::AddToSkippedBecause $constraints
-	    }
-	    return	
-	}
-    }
-
-    # Save information about the core file.  You need to restore the original
-    # tcl_platform environment because some of the tests mess with
-    # tcl_platform.
-
-    if {$tcltest::preserveCore} {
-	set currentTclPlatform [array get tcl_platform]
-	array set tcl_platform $tcltest::originalTclPlatform
-	if {[file exists [file join [tcltest::workingDirectory] core]]} {
-	    set coreModTime [file mtime [file join \
-		    [tcltest::workingDirectory] core]]
-	}
-	array set tcl_platform $currentTclPlatform
-    }
-
-    # If there is no "memory" command (because memory debugging isn't
-    # enabled), then don't attempt to use the command.
-    
-    if {[info commands memory] != {}} {
-	memory tag $name
-    }
-
-    if {[tcltest::isVerbose start]} {
-	puts [outputChannel] "---- $name start"
-	flush [outputChannel]
-    }
-    
-    set code [catch {uplevel $script} actualAnswer]
-	    
-    return [list $actualAnswer $code]
-}
-
-#####################################################################
-
-# tcltest::cleanupTestsHook --
-#
-#	This hook allows a harness that builds upon tcltest to specify
-#       additional things that should be done at cleanup.
-#
-
-if {[namespace inscope tcltest info procs cleanupTestsHook] == {}} {
-    proc tcltest::cleanupTestsHook {} {}
-}
-
-# tcltest::cleanupTests --
-#
-# 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 tests were invoked.
-#
-# Print the number tests (total, passed, failed, and skipped) since the
-# tests were invoked.
-# 
-# Restore original environment (as reported by special variable env).
-# 
-# Arguments:
-#      calledFromAllFile - if 0, behave as if we are running a single test file
-#      within an entire suite of tests.  if we aren't running a single test
-#      file, then don't report status.  check for new files created during the
-#      test run and report on them.  if 1, report collated status from all the
-#      test file runs.
-# 
-# Results: 
-#      None.
-# 
-# Side Effects: 
-#      None
-# 
-
-proc tcltest::cleanupTests {{calledFromAllFile 0}} {
-
-    set testFileName [file tail [info script]]
-
-    # Call the cleanup hook
-    tcltest::cleanupTestsHook 
-
-    # Remove files and directories created by the :tcltest::makeFile and
-    # tcltest::makeDirectory procedures.
-    # Record the names of files in tcltest::workingDirectory that were not
-    # pre-existing, and associate them with the test file that created them.
-
-    if {!$calledFromAllFile} {
-	foreach file $tcltest::filesMade {
-	    if {[file exists $file]} {
-		catch {file delete -force $file}
-	    }
-	}
-	set currentFiles {}
-	foreach file [glob -nocomplain \
-		[file join $tcltest::temporaryDirectory *]] {
-	    lappend currentFiles [file tail $file]
-	}
-	set newFiles {}
-	foreach file $currentFiles {
-	    if {[lsearch -exact $tcltest::filesExisted $file] == -1} {
-		lappend newFiles $file
-	    }
-	}
-	set tcltest::filesExisted $currentFiles
-	if {[llength $newFiles] > 0} {
-	    set tcltest::createdNewFiles($testFileName) $newFiles
-	}
-    }
-
-    if {$calledFromAllFile || $tcltest::testSingleFile} {
-
-	# print stats
-
-	puts -nonewline [outputChannel] "$testFileName:"
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    puts -nonewline [outputChannel] \
-		    "\t$index\t$tcltest::numTests($index)"
-	}
-	puts [outputChannel] ""
-
-	# print number test files sourced
-	# print names of files that ran tests which failed
-
-	if {$calledFromAllFile} {
-	    puts [outputChannel] \
-		    "Sourced $tcltest::numTestFiles Test Files."
-	    set tcltest::numTestFiles 0
-	    if {[llength $tcltest::failFiles] > 0} {
-		puts [outputChannel] \
-			"Files with failing tests: $tcltest::failFiles"
-		set tcltest::failFiles {}
-	    }
-	}
-
-	# if any tests were skipped, print the constraints that kept them
-	# from running.
-
-	set constraintList [array names tcltest::skippedBecause]
-	if {[llength $constraintList] > 0} {
-	    puts [outputChannel] \
-		    "Number of tests skipped for each constraint:"
-	    foreach constraint [lsort $constraintList] {
-		puts [outputChannel] \
-			"\t$tcltest::skippedBecause($constraint)\t$constraint"
-		unset tcltest::skippedBecause($constraint)
-	    }
-	}
-
-	# report the names of test files in tcltest::createdNewFiles, and
-	# reset the array to be empty.
-
-	set testFilesThatTurded [lsort [array names tcltest::createdNewFiles]]
-	if {[llength $testFilesThatTurded] > 0} {
-	    puts [outputChannel] "Warning: files left behind:"
-	    foreach testFile $testFilesThatTurded {
-		puts [outputChannel] \
-			"\t$testFile:\t$tcltest::createdNewFiles($testFile)"
-		unset tcltest::createdNewFiles($testFile)
-	    }
-	}
-
-	# reset filesMade, filesExisted, and numTests
-
-	set tcltest::filesMade {}
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    set tcltest::numTests($index) 0
-	}
-
-	# exit only if running Tk in non-interactive mode
-
-	global tk_version tcl_interactive
-	if {[info exists tk_version] && ![info exists tcl_interactive]} {
-	    exit
-	}
-    } 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 tcltest::numTestFiles
-	if {($tcltest::currentFailure) && \
-		([lsearch -exact $tcltest::failFiles $testFileName] == -1)} {
-	    lappend tcltest::failFiles $testFileName
-	}
-	set tcltest::currentFailure false
-
-	# restore the environment to the state it was in before this package
-	# was loaded
-
-	set newEnv {}
-	set changedEnv {}
-	set removedEnv {}
-	foreach index [array names ::env] {
-	    if {![info exists tcltest::originalEnv($index)]} {
-		lappend newEnv $index
-		unset ::env($index)
-	    } else {
-		if {$::env($index) != $tcltest::originalEnv($index)} {
-		    lappend changedEnv $index
-		    set ::env($index) $tcltest::originalEnv($index)
-		}
-	    }
-	}
-	foreach index [array names tcltest::originalEnv] {
-	    if {![info exists ::env($index)]} {
-		lappend removedEnv $index
-		set ::env($index) $tcltest::originalEnv($index)
-	    }
-	}
-	if {[llength $newEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements created:\t$newEnv"
-	}
-	if {[llength $changedEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements changed:\t$changedEnv"
-	}
-	if {[llength $removedEnv] > 0} {
-	    puts [outputChannel] \
-		    "env array elements removed:\t$removedEnv"
-	}
-
-	set changedTclPlatform {}
-	foreach index [array names tcltest::originalTclPlatform] {
-	    if {$::tcl_platform($index) != \
-		    $tcltest::originalTclPlatform($index)} { 
-		lappend changedTclPlatform $index
-		set ::tcl_platform($index) \
-			$tcltest::originalTclPlatform($index) 
-	    }
-	}
-	if {[llength $changedTclPlatform] > 0} {
-	    puts [outputChannel] \
-		    "tcl_platform array elements changed:\t$changedTclPlatform"
-	} 
-
-	if {[file exists [file join [tcltest::workingDirectory] core]]} {
-	    if {$tcltest::preserveCore > 1} {
-		puts "rename core file (> 1)" 
-		puts [outputChannel] "produced core file! \
-			Moving file to: \
-			[file join $tcltest::temporaryDirectory core-$name]"
-		catch {file rename -force \
-			[file join [tcltest::workingDirectory] core] \
-			[file join $tcltest::temporaryDirectory \
-			    core-$name]} msg
-		if {[string length $msg] > 0} {
-		    tcltest::PrintError "Problem renaming file: $msg"
-		}
-	    } else {
-		# Print a message if there is a core file and (1) there
-		# previously wasn't one or (2) the new one is different from
-		# the old one. 
-
-		if {[info exists tcltest::coreModificationTime]} {
-		    if {$tcltest::coreModificationTime != [file mtime \
-			    [file join [tcltest::workingDirectory] core]]} {
-			puts [outputChannel] "A core file was created!"
-		    }
-		} else {
-		    puts [outputChannel] "A core file was created!"
-		} 
-	    }
-	}
-    }
-    flush [outputChannel]
-    flush [errorChannel]
-    return
-}
-
-#####################################################################
-
-# Procs that determine which tests/test files to run
-
-# tcltest::getMatchingFiles
-#
-#       Looks at the patterns given to match and skip files
-#       and uses them to put together a list of the tests that will be run.
-#
-# Arguments:
-#       directory to search
-#
-# Results:
-#       The constructed list is returned to the user.  This will primarily
-#       be used in 'all.tcl' files.  It is used in runAllTests.
-# 
-# Side Effects:
-#       None
-
-proc tcltest::getMatchingFiles { {searchDirectory ""} } {
-    if {[llength [info level 0]] == 1} {
-	set searchDirectory [tcltest::testsDirectory]
-    }
-    set matchingFiles {}
-
-    # Find the matching files in the list of directories and then remove the
-    # ones that match the skip pattern
-    foreach directory $searchDirectory {
-	set matchFileList {}
-	foreach match $tcltest::matchFiles {
-	    set matchFileList [concat $matchFileList \
-		    [glob -nocomplain [file join $directory $match]]]
-	}
-	if {[string compare {} $tcltest::skipFiles]} {
-	    set skipFileList {}
-	    foreach skip $tcltest::skipFiles {
-		set skipFileList [concat $skipFileList \
-			[glob -nocomplain [file join $directory $skip]]]
-	    }
-	    foreach file $matchFileList {
-		# Only include files that don't match the skip pattern and
-		# aren't SCCS lock files.
-		if {([lsearch -exact $skipFileList $file] == -1) && \
-			(![string match l.*.test [file tail $file]])} {
-		    lappend matchingFiles $file
-		}
-	    }
-	} else {
-	    set matchingFiles [concat $matchingFiles $matchFileList]
-	}
-    }
-    if {[string equal $matchingFiles {}]} {
-	tcltest::PrintError "No test files remain after applying \
-		your match and skip patterns!"
-    }
-    return $matchingFiles
-}
-
-# tcltest::getMatchingDirectories --
-#
-#	Looks at the patterns given to match and skip directories and uses them
-#       to put together a list of the test directories that we should attempt
-#       to run.  (Only subdirectories containing an "all.tcl" file are put into
-#       the list.)
-#
-# Arguments:
-#	root directory from which to search
-#
-# Results:
-#	The constructed list is returned to the user.  This is used in the
-#       primary all.tcl file.  Lower-level all.tcl files should use the
-#       tcltest::testAllFiles proc instead.
-# 
-# Side Effects: 
-#       None.
-
-proc tcltest::getMatchingDirectories {rootdir} {
-    set matchingDirs {}
-    set matchDirList {}
-    # Find the matching directories in tcltest::testsDirectory and then
-    # remove the ones that match the skip pattern
-    foreach match $tcltest::matchDirectories {
-	foreach file [glob -nocomplain [file join $rootdir $match]] {
-	    if {([file isdirectory $file]) && ($file != $rootdir)} {
-		set matchDirList [concat $matchDirList \
-			[tcltest::getMatchingDirectories $file]]
-		if {[file exists [file join $file all.tcl]]} {
-		    set matchDirList [concat $matchDirList $file]
-		}
-	    }
-	}
-    }
-    if {$tcltest::skipDirectories != {}} {
-	set skipDirs {} 
-	foreach skip $tcltest::skipDirectories {
-	    set skipDirs [concat $skipDirs \
-		    [glob -nocomplain [file join $tcltest::testsDirectory \
-			$skip]]]
-	}
-	foreach dir $matchDirList {
-	    # Only include directories that don't match the skip pattern
-	    if {[lsearch -exact $skipDirs $dir] == -1} {
-		lappend matchingDirs $dir
-	    }
-	}
-    } else {
-	set matchingDirs [concat $matchingDirs $matchDirList]
-    }
-    if {$matchingDirs == {}} {
-	DebugPuts 1 "No test directories remain after applying match and skip patterns!"
-    }
-    return $matchingDirs
-}
-
-# tcltest::runAllTests --
-#
-#	prints output and sources test files according to the match and skip
-#       patterns provided.  after sourcing test files, it goes on to source
-#       all.tcl files in matching test subdirectories.
-#
-# Arguments:
-#	shell being tested
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::runAllTests { {shell ""} } {
-    global argv
-
-    if {[llength [info level 0]] == 1} {
-	set shell [tcltest::interpreter]
-    }
-
-    set tcltest::testSingleFile false
-
-    puts [outputChannel] "Tests running in interp:  $shell"
-    puts [outputChannel] "Tests located in:  $tcltest::testsDirectory"
-    puts [outputChannel] "Tests running in:  [tcltest::workingDirectory]"
-    puts [outputChannel] "Temporary files stored in $tcltest::temporaryDirectory"
-    if {[tcltest::singleProcess]} {
-	puts [outputChannel] "Test files sourced into current interpreter"
-    } else {
-	puts [outputChannel] "Test files run in separate interpreters"
-    }
-    if {[llength $tcltest::skip] > 0} {
-	puts [outputChannel] "Skipping tests that match:  $tcltest::skip"
-    }
-    if {[llength $tcltest::match] > 0} {
-	puts [outputChannel] "Only running tests that match:  $tcltest::match"
-    }
-
-    if {[llength $tcltest::skipFiles] > 0} {
-	puts [outputChannel] "Skipping test files that match:  $tcltest::skipFiles"
-    }
-    if {[llength $tcltest::matchFiles] > 0} {
-	puts [outputChannel] "Only running test files that match:  $tcltest::matchFiles"
-    }
-
-    set timeCmd {clock format [clock seconds]}
-    puts [outputChannel] "Tests began at [eval $timeCmd]"
-
-    # Run each of the specified tests
-    foreach file [lsort [tcltest::getMatchingFiles]] {
-	set tail [file tail $file]
-	puts [outputChannel] $tail
-
-	if {$tcltest::singleProcess} {
-	    incr tcltest::numTestFiles
-	    uplevel [list source $file]
-	} else {
-	    # Change to the tests directory so the value of the following
-	    # variable is set correctly when we spawn the child test processes
-	    cd $tcltest::testsDirectory
-	    set cmd [concat [list | $shell $file] [split $argv]]
-	    if {[catch {
-		incr tcltest::numTestFiles
-		set pipeFd [open $cmd "r"] 
-		while {[gets $pipeFd line] >= 0} {
-		    if {[regexp {^([^:]+):\tTotal\t([0-9]+)\tPassed\t([0-9]+)\tSkipped\t([0-9]+)\tFailed\t([0-9]+)} $line null testFile Total Passed Skipped Failed]} {
-			foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-			    incr tcltest::numTests($index) [set $index]
-			}
-			if {$Failed > 0} {
-			    lappend tcltest::failFiles $testFile
-			}
-		    } elseif {[regexp {^Number of tests skipped for each constraint:|^\t(\d+)\t(.+)$} $line match skipped constraint]} {
-			if {$match != "Number of tests skipped for each constraint:"} {
-			    tcltest::AddToSkippedBecause $constraint $skipped
-			}
-		    } else {
-			puts [outputChannel] $line
-		    }
-		}
-		close $pipeFd
-	    } msg]} {
-		# Print results to tcltest::outputChannel.
-		puts [outputChannel] "Test file error: $msg"
-		# append the name of the test to a list to be reported later
-		lappend testFileFailures $file 
-	    }
-	}
-    }
-
-    # cleanup
-    puts [outputChannel] "\nTests ended at [eval $timeCmd]"
-    tcltest::cleanupTests 1
-    if {[info exists testFileFailures]} {
-	puts [outputChannel] "\nTest files exiting with errors:  \n"
-	foreach file $testFileFailures {
-	    puts "  [file tail $file]\n"
-	}
-    }
-
-    # Checking for subdirectories in which to run tests
-    foreach directory [tcltest::getMatchingDirectories $tcltest::testsDirectory] {
-	set dir [file tail $directory]
-	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-	puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
-	
-	uplevel "source [file join $directory all.tcl]"
-	
-	set endTime [eval $timeCmd]
-	puts [outputChannel] "\n$dir test ended at $endTime"
-	puts [outputChannel] "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
-    }
-    return
-}
-
-#####################################################################
-
-# Test utility procs - not used in tcltest, but may be useful for testing.
-
-# tcltest::loadTestedCommands --
-#
-#     Uses the specified script to load the commands to test. Allowed to
-#     be empty, as the tested commands could have been compiled into the
-#     interpreter.
-#
-# Arguments
-#     none
-#
-# Results
-#     none
-# 
-# Side Effects: 
-#     none.
-
-proc tcltest::loadTestedCommands {} {
-    if {$tcltest::loadScript == {}} {
-	return
-    }
-    
-    return [uplevel $tcltest::loadScript]
-}
-
-# tcltest::saveState --
-#
-#	Save information regarding what procs and variables exist.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Modifies the variable tcltest::saveState
-#
-# Side effects:
-#	None.
-
-proc tcltest::saveState {} {
-    uplevel {set tcltest::saveState [list [info procs] [info vars]]}
-    DebugPuts  2 "tcltest::saveState: $tcltest::saveState"
-    return
-}
-
-# tcltest::restoreState --
-#
-#	Remove procs and variables that didn't exist before the call to
-#       tcltest::saveState.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Removes procs and variables from your environment if they don't exist
-#       in the tcltest::saveState variable.
-#
-# Side effects:
-#	None.
-
-proc tcltest::restoreState {} {
-    foreach p [info procs] {
-	if {([lsearch [lindex $tcltest::saveState 0] $p] < 0) && \
-		(![string match "*tcltest::$p" [namespace origin $p]])} {
-	    
-	    DebugPuts 2 "tcltest::restoreState: Removing proc $p"
-	    rename $p {}
-	}
-    }
-    foreach p [uplevel {info vars}] {
-	if {[lsearch [lindex $tcltest::saveState 1] $p] < 0} {
-	    DebugPuts 2 "tcltest::restoreState: Removing variable $p"
-	    uplevel "catch {unset $p}"
-	}
-    }
-    return
-}
-
-# tcltest::normalizeMsg --
-#
-#	Removes "extra" newlines from a string.
-#
-# Arguments:
-#	msg        String to be modified
-#
-# Results:
-#	string with extra newlines removed
-#
-# Side effects:
-#	None.
-
-proc tcltest::normalizeMsg {msg} {
-    regsub "\n$" [string tolower $msg] "" msg
-    regsub -all "\n\n" $msg "\n" msg
-    regsub -all "\n\}" $msg "\}" msg
-    return $msg
-}
-
-# tcltest::makeFile --
-#
-# Create a new file with the name <name>, and write <contents> to it.
-#
-# If this file hasn't been created via makeFile since the last time
-# cleanupTests was called, add it to the $filesMade list, so it will
-# be removed by the next call to cleanupTests.
-#
-# Arguments:
-#	contents        content of the new file
-#       name            name of the new file
-#       directory       directory name for new file 
-#
-# Results:
-#	absolute path to the file created
-#
-# Side effects:
-#	None.
-
-proc tcltest::makeFile {contents name {directory ""}} {
-    global tcl_platform
-
-    if {[llength [info level 0]] == 3} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    
-    set fullName [file join $directory $name]
-
-    DebugPuts 3 "tcltest::makeFile: putting $contents into $fullName"
-
-    set fd [open $fullName w]
-
-    fconfigure $fd -translation lf
-
-    if {[string equal [string index $contents end] "\n"]} {
-	puts -nonewline $fd $contents
-    } else {
-	puts $fd $contents
-    }
-    close $fd
-
-    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
-	lappend tcltest::filesMade $fullName
-    }
-    return $fullName
-}
-
-# tcltest::removeFile --
-#
-#	Removes the named file from the filesystem
-#
-# Arguments:
-#	name          file to be removed
-#       directory     directory from which to remove file
-#
-# Results:
-#	return value from [file delete]
-#
-# Side effects:
-#	None.
-
-proc tcltest::removeFile {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::removeFile: removing $fullName"
-    return [file delete $fullName]
-}
-
-# tcltest::makeDirectory --
-#
-# Create a new dir with the name <name>.
-#
-# If this dir hasn't been created via makeDirectory since the last time
-# cleanupTests was called, add it to the $directoriesMade list, so it will
-# be removed by the next call to cleanupTests.
-#
-# Arguments:
-#       name            name of the new directory
-#       directory       directory in which to create new dir
-#
-# Results:
-#	absolute path to the directory created
-#
-# Side effects:
-#	None.
-
-proc tcltest::makeDirectory {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::makeDirectory: creating $fullName"
-    file mkdir $fullName
-    if {[lsearch -exact $tcltest::filesMade $fullName] == -1} {
-	lappend tcltest::filesMade $fullName
-    }
-    return $fullName
-}
-
-# tcltest::removeDirectory --
-#
-#	Removes a named directory from the file system.
-#
-# Arguments:
-#	name          Name of the directory to remove
-#       directory     Directory from which to remove
-#
-# Results:
-#	return value from [file delete]
-#
-# Side effects:
-#	None
-
-proc tcltest::removeDirectory {name {directory ""}} {
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "tcltest::removeDirectory: deleting $fullName"
-    return [file delete -force $fullName]
-}
-
-# tcltest::viewFile --
-#
-#	reads the content of a file and returns it
-#
-# Arguments:
-#	name of the file to read
-#       directory in which file is located
-#
-# Results:
-#	content of the named file
-#
-# Side effects:
-#	None.
-
-proc tcltest::viewFile {name {directory ""}} {
-    global tcl_platform
-    if {[llength [info level 0]] == 2} {
-	set directory [tcltest::temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    if {([string equal $tcl_platform(platform) "macintosh"]) || \
-	    ([tcltest::testConstraint unixExecs] == 0)} {
-	set f [open $fullName]
-	set data [read -nonewline $f]
-	close $f
-	return $data
-    } else {
-	return [exec cat $fullName]
-    }
-    return
-}
-
-# tcltest::bytestring --
-#
-# Construct a string that consists of the requested sequence of bytes,
-# as opposed to a string of properly formed UTF-8 characters.  
-# This allows the tester to 
-# 1. Create denormalized or improperly formed strings to pass to C procedures 
-#    that are supposed to accept strings with embedded NULL bytes.
-# 2. Confirm that a string result has a certain pattern of bytes, for instance
-#    to confirm that "\xe0\0" in a Tcl script is stored internally in 
-#    UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
-#
-# Generally, it's a bad idea to examine the bytes in a Tcl string or to
-# construct improperly formed strings in this manner, because it involves
-# exposing that Tcl uses UTF-8 internally.
-#
-# Arguments:
-#	string being converted
-#
-# Results:
-#	result fom encoding
-#
-# Side effects:
-#	None
-
-proc tcltest::bytestring {string} {
-    return [encoding convertfrom identity $string]
-}
-
-# tcltest::openfiles --
-#
-#	used in io tests, uses testchannel
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	???
-#
-# Side effects:
-#	None.
-
-proc tcltest::openfiles {} {
-    if {[catch {testchannel open} result]} {
-	return {}
-    }
-    return $result
-}
-
-# tcltest::leakfiles --
-#
-#	used in io tests, uses testchannel
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	???
-#
-# Side effects:
-#	None.
-
-proc tcltest::leakfiles {old} {
-    if {[catch {testchannel open} new]} {
-	return {}
-    }
-    set leak {}
-    foreach p $new {
-	if {[lsearch $old $p] < 0} {
-	    lappend leak $p
-	}
-    }
-    return $leak
-}
-
-#
-# Internationalization / ISO support procs     -- dl
-#
-
-# tcltest::set_iso8859_1_locale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::set_iso8859_1_locale {} {
-    if {[info commands testlocale] != ""} {
-	set tcltest::previousLocale [testlocale ctype]
-	testlocale ctype $tcltest::isoLocale
-    }
-    return
-}
-
-# tcltest::restore_locale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::restore_locale {} {
-    if {[info commands testlocale] != ""} {
-	testlocale ctype $tcltest::previousLocale
-    }
-    return
-}
-
-# tcltest::threadReap --
-#
-#	Kill all threads except for the main thread.
-#	Do nothing if testthread is not defined.
-#
-# Arguments:
-#	none.
-#
-# Results:
-#	Returns the number of existing threads.
-# 
-# Side Effects: 
-#       none.
-#
-
-proc tcltest::threadReap {} {
-    if {[info commands testthread] != {}} {
-
-	# testthread built into tcltest
-
-	testthread errorproc ThreadNullError
-	while {[llength [testthread names]] > 1} {
-	    foreach tid [testthread names] {
-		if {$tid != $tcltest::mainThread} {
-		    catch {testthread send -async $tid {testthread exit}}
-		}
-	    }
-	    ## Enter a bit a sleep to give the threads enough breathing
-	    ## room to kill themselves off, otherwise the end up with a
-	    ## massive queue of repeated events
-	    after 1
-	}
-	testthread errorproc ThreadError
-	return [llength [testthread names]]
-    } elseif {[info commands thread::id] != {}} {
-	
-	# Thread extension
-
-	thread::errorproc ThreadNullError
-	while {[llength [thread::names]] > 1} {
-	    foreach tid [thread::names] {
-		if {$tid != $tcltest::mainThread} {
-		    catch {thread::send -async $tid {thread::exit}}
-		}
-	    }
-	    ## Enter a bit a sleep to give the threads enough breathing
-	    ## room to kill themselves off, otherwise the end up with a
-	    ## massive queue of repeated events
-	    after 1
-	}
-	thread::errorproc ThreadError
-	return [llength [thread::names]]
-    } else {
-	return 1
-    }
-    return 0
-}
-
-# Initialize the constraints and set up command line arguments 
-namespace eval tcltest {
-    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
-    set ::auto_path [list [info library]]
-
-    tcltest::initConstraints
-    if {[namespace children [namespace current]] == {}} {
-	tcltest::processCmdLineArgs
-    }
-
-    # Save the names of files that already exist in
-    # the output directory.
-    foreach file [glob -nocomplain \
-	    [file join $tcltest::temporaryDirectory *]] {
-	lappend tcltest::filesExisted [file tail $file]
-    }
-}
-
-package provide tcltest 2.0
-