unversioned the tcltest directory

FossilOrigin-Name: 2041a671c94a9ec4c9f61257b1e891d757c44722

2 files changed, 0 insertions, 3498 deletions

diff --git a/library/tcltest1.0/pkgIndex.tcl b/library/tcltest1.0/pkgIndex.tcl
deleted file mode 100644
index da93644..0000000
--- a/library/tcltest1.0/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex -direct" command
-# and sourced either when an application starts up or
-# by a "package unknown" script.  It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands.  When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-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
deleted file mode 100644
index c58c0da..0000000
--- a/library/tcltest1.0/tcltest.tcl
+++ /dev/null
@@ -1,3487 +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: tcltest.tcl,v 1.29 2000/10/28 00:00:00 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 {
-	    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
-