undo subtree

2 files changed, 0 insertions, 3432 deletions

diff --git a/tcl8.6/library/tcltest/pkgIndex.tcl b/tcl8.6/library/tcltest/pkgIndex.tcl
deleted file mode 100644
index 5ac8823..0000000
--- a/tcl8.6/library/tcltest/pkgIndex.tcl
+++ /dev/null
@@ -1,12 +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.
-
-if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]
diff --git a/tcl8.6/library/tcltest/tcltest.tcl b/tcl8.6/library/tcltest/tcltest.tcl
deleted file mode 100644
index cde2660..0000000
--- a/tcl8.6/library/tcltest/tcltest.tcl
+++ /dev/null
@@ -1,3420 +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
-# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
-# All rights reserved.
-
-package require Tcl 8.5		;# -verbose line uses [info frame]
-namespace eval tcltest {
-
-    # When the version number changes, be sure to update the pkgIndex.tcl file,
-    # and the install directory in the Makefiles.  When the minor version
-    # changes (new feature) be sure to update the man page as well.
-    variable Version 2.4.0
-
-    # Compatibility support for dumb variables defined in tcltest 1
-    # Do not use these.  Call [package provide Tcl] and [info patchlevel]
-    # yourself.  You don't need tcltest to wrap it for you.
-    variable version [package provide Tcl]
-    variable patchLevel [info patchlevel]
-
-##### Export the public tcltest procs; several categories
-    #
-    # Export the main functional commands that do useful things
-    namespace export cleanupTests loadTestedCommands makeDirectory \
-	makeFile removeDirectory removeFile runAllTests test
-
-    # Export configuration commands that control the functional commands
-    namespace export configure customMatch errorChannel interpreter \
-	    outputChannel testConstraint
-
-    # Export commands that are duplication (candidates for deprecation)
-    namespace export bytestring		;# dups [encoding convertfrom identity]
-    namespace export debug		;#	[configure -debug]
-    namespace export errorFile		;#	[configure -errfile]
-    namespace export limitConstraints	;#	[configure -limitconstraints]
-    namespace export loadFile		;#	[configure -loadfile]
-    namespace export loadScript		;#	[configure -load]
-    namespace export match		;#	[configure -match]
-    namespace export matchFiles		;#	[configure -file]
-    namespace export matchDirectories	;#	[configure -relateddir]
-    namespace export normalizeMsg	;#	application of [customMatch]
-    namespace export normalizePath	;#	[file normalize] (8.4)
-    namespace export outputFile		;#	[configure -outfile]
-    namespace export preserveCore	;#	[configure -preservecore]
-    namespace export singleProcess	;#	[configure -singleproc]
-    namespace export skip		;#	[configure -skip]
-    namespace export skipFiles		;#	[configure -notfile]
-    namespace export skipDirectories	;#	[configure -asidefromdir]
-    namespace export temporaryDirectory	;#	[configure -tmpdir]
-    namespace export testsDirectory	;#	[configure -testdir]
-    namespace export verbose		;#	[configure -verbose]
-    namespace export viewFile		;#	binary encoding [read]
-    namespace export workingDirectory	;#	[cd] [pwd]
-
-    # Export deprecated commands for tcltest 1 compatibility
-    namespace export getMatchingFiles mainThread restoreState saveState \
-	    threadReap
-
-    # 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 - name of variable containing path to modify.
-    #
-    # Results
-    #     The path is modified in place.
-    #
-    # Side Effects:
-    #     None.
-    #
-    proc normalizePath {pathVar} {
-	upvar 1 $pathVar path
-	set oldpwd [pwd]
-	catch {cd $path}
-	set path [pwd]
-	cd $oldpwd
-	return $path
-    }
-
-##### Verification commands used to test values of variables and options
-    #
-    # Verification command that accepts everything
-    proc AcceptAll {value} {
-	return $value
-    }
-
-    # Verification command that accepts valid Tcl lists
-    proc AcceptList { list } {
-	return [lrange $list 0 end]
-    }
-
-    # Verification command that accepts a glob pattern
-    proc AcceptPattern { pattern } {
-	return [AcceptAll $pattern]
-    }
-
-    # Verification command that accepts integers
-    proc AcceptInteger { level } {
-	return [incr level 0]
-    }
-
-    # Verification command that accepts boolean values
-    proc AcceptBoolean { boolean } {
-	return [expr {$boolean && $boolean}]
-    }
-
-    # Verification command that accepts (syntactically) valid Tcl scripts
-    proc AcceptScript { script } {
-	if {![info complete $script]} {
-	    return -code error "invalid Tcl script: $script"
-	}
-	return $script
-    }
-
-    # Verification command that accepts (converts to) absolute pathnames
-    proc AcceptAbsolutePath { path } {
-	return [file join [pwd] $path]
-    }
-
-    # Verification command that accepts existing readable directories
-    proc AcceptReadable { path } {
-	if {![file readable $path]} {
-	    return -code error "\"$path\" is not readable"
-	}
-	return $path
-    }
-    proc AcceptDirectory { directory } {
-	set directory [AcceptAbsolutePath $directory]
-	if {![file exists $directory]} {
-	    return -code error "\"$directory\" does not exist"
-	}
-	if {![file isdir $directory]} {
-	    return -code error "\"$directory\" is not a directory"
-	}
-	return [AcceptReadable $directory]
-    }
-
-##### Initialize internal arrays of tcltest, but only if the caller
-    # has not already pre-initialized them.  This is done to support
-    # compatibility with older tests that directly access internals
-    # rather than go through command interfaces.
-    #
-    proc ArrayDefault {varName value} {
-	variable $varName
-	if {[array exists $varName]} {
-	    return
-	}
-	if {[info exists $varName]} {
-	    # Pre-initialized value is a scalar: destroy it!
-	    unset $varName
-	}
-	array set $varName $value
-    }
-
-    # save the original environment so that it can be restored later
-    ArrayDefault originalEnv [array get ::env]
-
-    # initialize numTests array to keep track of the number of tests
-    # that pass, fail, and are skipped.
-    ArrayDefault numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
-
-    # createdNewFiles will store test files as indices and the list of
-    # files (that should not have been) left behind by the test files
-    # as values.
-    ArrayDefault createdNewFiles {}
-
-    # initialize 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.
-    ArrayDefault skippedBecause {}
-
-    # initialize the testConstraints array to keep track of valid
-    # predefined constraints (see the explanation for the
-    # InitConstraints proc for more details).
-    ArrayDefault testConstraints {}
-
-##### Initialize internal variables of tcltest, but only if the caller
-    # has not already pre-initialized them.  This is done to support
-    # compatibility with older tests that directly access internals
-    # rather than go through command interfaces.
-    #
-    proc Default {varName value {verify AcceptAll}} {
-	variable $varName
-	if {![info exists $varName]} {
-	    variable $varName [$verify $value]
-	} else {
-	    variable $varName [$verify [set $varName]]
-	}
-    }
-
-    # Save any arguments that we might want to pass through to other
-    # programs.  This is used by the -args flag.
-    # FINDUSER
-    Default 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.
-    Default numTestFiles 0 AcceptInteger
-    Default testSingleFile true AcceptBoolean
-    Default currentFailure false AcceptBoolean
-    Default failFiles {} AcceptList
-
-    # Tests should remove all files they create.  The test suite will
-    # check the current working dir for files created by the tests.
-    # filesMade keeps track of such files created using the makeFile and
-    # makeDirectory procedures.  filesExisted stores the names of
-    # pre-existing files.
-    #
-    # Note that $filesExisted lists only those files that exist in
-    # the original [temporaryDirectory].
-    Default filesMade {} AcceptList
-    Default filesExisted {} AcceptList
-    proc FillFilesExisted {} {
-	variable filesExisted
-
-	# Save the names of files that already exist in the scratch directory.
-	foreach file [glob -nocomplain -directory [temporaryDirectory] *] {
-	    lappend filesExisted [file tail $file]
-	}
-
-	# After successful filling, turn this into a no-op.
-	proc FillFilesExisted args {}
-    }
-
-    # Kept only for compatibility
-    Default constraintsSpecified {} AcceptList
-    trace add variable constraintsSpecified read [namespace code {
-	    set constraintsSpecified [array names testConstraints] ;#}]
-
-    # tests that use threads need to know which is the main thread
-    Default mainThread 1
-    variable mainThread
-    if {[info commands thread::id] ne {}} {
-	set mainThread [thread::id]
-    } elseif {[info commands testthread] ne {}} {
-	set mainThread [testthread id]
-    }
-
-    # Set workingDirectory to [pwd]. The default output directory for
-    # Tcl tests is the working directory.  Whenever this value changes
-    # change to that directory.
-    variable workingDirectory
-    trace add variable workingDirectory write \
-	    [namespace code {cd $workingDirectory ;#}]
-
-    Default workingDirectory [pwd] AcceptAbsolutePath
-    proc workingDirectory { {dir ""} } {
-	variable workingDirectory
-	if {[llength [info level 0]] == 1} {
-	    return $workingDirectory
-	}
-	set workingDirectory [AcceptAbsolutePath $dir]
-    }
-
-    # Set the location of the execuatble
-    Default tcltest [info nameofexecutable]
-    trace add variable tcltest write [namespace code {testConstraint stdio \
-	    [eval [ConstraintInitializer stdio]] ;#}]
-
-    # save the platform information so it can be restored later
-    Default originalTclPlatform [array get ::tcl_platform]
-
-    # If a core file exists, save its modification time.
-    if {[file exists [file join [workingDirectory] core]]} {
-	Default coreModTime \
-		[file mtime [file join [workingDirectory] core]]
-    }
-
-    # stdout and stderr buffers for use when we want to store them
-    Default outData {}
-    Default errData {}
-
-    # keep track of test level for nested test commands
-    variable testLevel 0
-
-    # the variables and procs that existed when saveState was called are
-    # stored in a variable of the same name
-    Default saveState {}
-
-    # Internationalization support -- used in [SetIso8859_1_Locale] and
-    # [RestoreLocale]. Those commands are used in cmdIL.test.
-
-    if {![info exists [namespace current]::isoLocale]} {
-	variable isoLocale fr
-	switch -- $::tcl_platform(platform) {
-	    "unix" {
-
-		# Try some 'known' values for some platforms:
-
-		switch -exact -- $::tcl_platform(os) {
-		    "FreeBSD" {
-			set isoLocale fr_FR.ISO_8859-1
-		    }
-		    HP-UX {
-			set isoLocale fr_FR.iso88591
-		    }
-		    Linux -
-		    IRIX {
-			set 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 isoLocale iso_8859_1
-		    }
-		}
-	    }
-	    "windows" {
-		set isoLocale French
-	    }
-	}
-    }
-
-    variable ChannelsWeOpened; array set ChannelsWeOpened {}
-    # output goes to stdout by default
-    Default outputChannel stdout
-    proc outputChannel { {filename ""} } {
-	variable outputChannel
-	variable ChannelsWeOpened
-
-	# This is very subtle and tricky, so let me try to explain.
-	# (Hopefully this longer comment will be clear when I come
-	# back in a few months, unlike its predecessor :) )
-	#
-	# The [outputChannel] command (and underlying variable) have to
-	# be kept in sync with the [configure -outfile] configuration
-	# option ( and underlying variable Option(-outfile) ).  This is
-	# accomplished with a write trace on Option(-outfile) that will
-	# update [outputChannel] whenver a new value is written.  That
-	# much is easy.
-	#
-	# The trick is that in order to maintain compatibility with
-	# version 1 of tcltest, we must allow every configuration option
-	# to get its inital value from command line arguments.  This is
-	# accomplished by setting initial read traces on all the
-	# configuration options to parse the command line option the first
-	# time they are read.  These traces are cancelled whenever the
-	# program itself calls [configure].
-	#
-	# OK, then so to support tcltest 1 compatibility, it seems we want
-	# to get the return from [outputFile] to trigger the read traces,
-	# just in case.
-	#
-	# BUT!  A little known feature of Tcl variable traces is that
-	# traces are disabled during the handling of other traces.  So,
-	# if we trigger read traces on Option(-outfile) and that triggers
-	# command line parsing which turns around and sets an initial
-	# value for Option(-outfile) -- <whew!> -- the write trace that
-	# would keep [outputChannel] in sync with that new initial value
-	# would not fire!
-	#
-	# SO, finally, as a workaround, instead of triggering read traces
-	# by invoking [outputFile], we instead trigger the same set of
-	# read traces by invoking [debug].  Any command that reads a
-	# configuration option would do.  [debug] is just a handy one.
-	# The end result is that we support tcltest 1 compatibility and
-	# keep outputChannel and -outfile in sync in all cases.
-	debug
-
-	if {[llength [info level 0]] == 1} {
-	    return $outputChannel
-	}
-	if {[info exists ChannelsWeOpened($outputChannel)]} {
-	    close $outputChannel
-	    unset ChannelsWeOpened($outputChannel)
-	}
-	switch -exact -- $filename {
-	    stderr -
-	    stdout {
-		set outputChannel $filename
-	    }
-	    default {
-		set outputChannel [open $filename a]
-		set ChannelsWeOpened($outputChannel) 1
-
-		# If we created the file in [temporaryDirectory], then
-		# [cleanupTests] will delete it, unless we claim it was
-		# already there.
-		set outdir [normalizePath [file dirname \
-			[file join [pwd] $filename]]]
-		if {$outdir eq [temporaryDirectory]} {
-		    variable filesExisted
-		    FillFilesExisted
-		    set filename [file tail $filename]
-		    if {$filename ni $filesExisted} {
-			lappend filesExisted $filename
-		    }
-		}
-	    }
-	}
-	return $outputChannel
-    }
-
-    # errors go to stderr by default
-    Default errorChannel stderr
-    proc errorChannel { {filename ""} } {
-	variable errorChannel
-	variable ChannelsWeOpened
-
-	# This is subtle and tricky.  See the comment above in
-	# [outputChannel] for a detailed explanation.
-	debug
-
-	if {[llength [info level 0]] == 1} {
-	    return $errorChannel
-	}
-	if {[info exists ChannelsWeOpened($errorChannel)]} {
-	    close $errorChannel
-	    unset ChannelsWeOpened($errorChannel)
-	}
-	switch -exact -- $filename {
-	    stderr -
-	    stdout {
-		set errorChannel $filename
-	    }
-	    default {
-		set errorChannel [open $filename a]
-		set ChannelsWeOpened($errorChannel) 1
-
-		# If we created the file in [temporaryDirectory], then
-		# [cleanupTests] will delete it, unless we claim it was
-		# already there.
-		set outdir [normalizePath [file dirname \
-			[file join [pwd] $filename]]]
-		if {$outdir eq [temporaryDirectory]} {
-		    variable filesExisted
-		    FillFilesExisted
-		    set filename [file tail $filename]
-		    if {$filename ni $filesExisted} {
-			lappend filesExisted $filename
-		    }
-		}
-	    }
-	}
-	return $errorChannel
-    }
-
-##### Set up the configurable options
-    #
-    # The configurable options of the package
-    variable Option; array set Option {}
-
-    # Usage strings for those options
-    variable Usage; array set Usage {}
-
-    # Verification commands for those options
-    variable Verify; array set Verify {}
-
-    # Initialize the default values of the configurable options that are
-    # historically associated with an exported variable.  If that variable
-    # is already set, support compatibility by accepting its pre-set value.
-    # Use [trace] to establish ongoing connection between the deprecated
-    # exported variable and the modern option kept as a true internal var.
-    # Also set up usage string and value testing for the option.
-    proc Option {option value usage {verify AcceptAll} {varName {}}} {
-	variable Option
-	variable Verify
-	variable Usage
-	variable OptionControlledVariables
-	variable DefaultValue
-	set Usage($option) $usage
-	set Verify($option) $verify
-	set DefaultValue($option) $value
-	if {[catch {$verify $value} msg]} {
-	    return -code error $msg
-	} else {
-	    set Option($option) $msg
-	}
-	if {[string length $varName]} {
-	    variable $varName
-	    if {[info exists $varName]} {
-		if {[catch {$verify [set $varName]} msg]} {
-		    return -code error $msg
-		} else {
-		    set Option($option) $msg
-		}
-		unset $varName
-	    }
-	    namespace eval [namespace current] \
-	    	    [list upvar 0 Option($option) $varName]
-	    # Workaround for Bug (now Feature Request) 572889.  Grrrr....
-	    # Track all the variables tied to options
-	    lappend OptionControlledVariables $varName
-	    # Later, set auto-configure read traces on all
-	    # of them, since a single trace on Option does not work.
-	    proc $varName {{value {}}} [subst -nocommands {
-		if {[llength [info level 0]] == 2} {
-		    Configure $option [set value]
-		}
-		return [Configure $option]
-	    }]
-	}
-    }
-
-    proc MatchingOption {option} {
-	variable Option
-	set match [array names Option $option*]
-	switch -- [llength $match] {
-	    0 {
-		set sorted [lsort [array names Option]]
-		set values [join [lrange $sorted 0 end-1] ", "]
-		append values ", or [lindex $sorted end]"
-		return -code error "unknown option $option: should be\
-			one of $values"
-	    }
-	    1 {
-		return [lindex $match 0]
-	    }
-	    default {
-		# Exact match trumps ambiguity
-		if {$option in $match} {
-		    return $option
-		}
-		set values [join [lrange $match 0 end-1] ", "]
-		append values ", or [lindex $match end]"
-		return -code error "ambiguous option $option:\
-			could match $values"
-	    }
-	}
-    }
-
-    proc EstablishAutoConfigureTraces {} {
-	variable OptionControlledVariables
-	foreach varName [concat $OptionControlledVariables Option] {
-	    variable $varName
-	    trace add variable $varName read [namespace code {
-		    ProcessCmdLineArgs ;#}]
-	}
-    }
-
-    proc RemoveAutoConfigureTraces {} {
-	variable OptionControlledVariables
-	foreach varName [concat $OptionControlledVariables Option] {
-	    variable $varName
-	    foreach pair [trace info variable $varName] {
-		lassign $pair op cmd
-		if {($op eq "read") &&
-			[string match *ProcessCmdLineArgs* $cmd]} {
-		    trace remove variable $varName $op $cmd
-		}
-	    }
-	}
-	# Once the traces are removed, this can become a no-op
-	proc RemoveAutoConfigureTraces {} {}
-    }
-
-    proc Configure args {
-	variable Option
-	variable Verify
-	set n [llength $args]
-	if {$n == 0} {
-	    return [lsort [array names Option]]
-	}
-	if {$n == 1} {
-	    if {[catch {MatchingOption [lindex $args 0]} option]} {
-		return -code error $option
-	    }
-	    return $Option($option)
-	}
-	while {[llength $args] > 1} {
-	    if {[catch {MatchingOption [lindex $args 0]} option]} {
-		return -code error $option
-	    }
-	    if {[catch {$Verify($option) [lindex $args 1]} value]} {
-		return -code error "invalid $option\
-			value \"[lindex $args 1]\": $value"
-	    }
-	    set Option($option) $value
-	    set args [lrange $args 2 end]
-	}
-	if {[llength $args]} {
-	    if {[catch {MatchingOption [lindex $args 0]} option]} {
-		return -code error $option
-	    }
-	    return -code error "missing value for option $option"
-	}
-    }
-    proc configure args {
-	if {[llength $args] > 1} {
-	    RemoveAutoConfigureTraces
-	}
-	set code [catch {Configure {*}$args} msg]
-	return -code $code $msg
-    }
-
-    proc AcceptVerbose { level } {
-	set level [AcceptList $level]
-	set levelMap {
-	    l list
-	    p pass
-	    b body
-	    s skip
-	    t start
-	    e error
-	    l line
-	    m msec
-	    u usec
-	}
-	set levelRegexp "^([join [dict values $levelMap] |])\$"
-	if {[llength $level] == 1} {
-	    if {![regexp $levelRegexp $level]} {
-		# translate single characters abbreviations to expanded list
-		set level [string map $levelMap [split $level {}]]
-	    }
-	}
-	set valid [list]
-	foreach v $level {
-	    if {[regexp $levelRegexp $v]} {
-		lappend valid $v
-	    }
-	}
-	return $valid
-    }
-
-    proc IsVerbose {level} {
-	variable Option
-	return [expr {[lsearch -exact $Option(-verbose) $level] != -1}]
-    }
-
-    # Default verbosity is to show bodies of failed tests
-    Option -verbose {body error} {
-	Takes any combination of the values 'p', 's', 'b', 't', 'e' and 'l'.
-	Test suite will display all passed tests if 'p' is specified, all
-	skipped tests if 's' is specified, the bodies of failed tests if
-	'b' is specified, and when tests start if 't' is specified.
-	ErrorInfo is displayed if 'e' is specified. Source file line
-	information of failed tests is displayed if 'l' is specified.
-    } AcceptVerbose verbose
-
-    # 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.
-    Option -match * {
-	Run all tests within the specified files that match one of the
-	list of glob patterns given.
-    } AcceptList match
-
-    Option -skip {} {
-	Skip all tests within the specified tests (via -match) and files
-	that match one of the list of glob patterns given.
-    } AcceptList skip
-
-    Option -file *.test {
-	Run tests in all test files that match the glob pattern given.
-    } AcceptPattern matchFiles
-
-    # By default, skip files that appear to be SCCS lock files.
-    Option -notfile l.*.test {
-	Skip all test files that match the glob pattern given.
-    } AcceptPattern skipFiles
-
-    Option -relateddir * {
-	Run tests in directories that match the glob pattern given.
-    } AcceptPattern matchDirectories
-
-    Option -asidefromdir {} {
-	Skip tests in directories that match the glob pattern given.
-    } AcceptPattern skipDirectories
-
-    # By default, don't save core files
-    Option -preservecore 0 {
-	If 2, save any core files produced during testing in the directory
-	specified by -tmpdir. If 1, notify the user if core files are
-	created.
-    } AcceptInteger preserveCore
-
-    # 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.
-    Option -debug 0 {
-	Internal debug level
-    } AcceptInteger debug
-
-    proc SetSelectedConstraints args {
-	variable Option
-	foreach c $Option(-constraints) {
-	    testConstraint $c 1
-	}
-    }
-    Option -constraints {} {
-	Do not skip the listed constraints listed in -constraints.
-    } AcceptList
-    trace add variable Option(-constraints) write \
-	    [namespace code {SetSelectedConstraints ;#}]
-
-    # Don't run only the "-constraint" specified tests by default
-    proc ClearUnselectedConstraints args {
-	variable Option
-	variable testConstraints
-	if {!$Option(-limitconstraints)} {return}
-	foreach c [array names testConstraints] {
-	    if {$c ni $Option(-constraints)} {
-		testConstraint $c 0
-	    }
-	}
-    }
-    Option -limitconstraints 0 {
-	whether to run only tests with the constraints
-    } AcceptBoolean limitConstraints
-    trace add variable Option(-limitconstraints) write \
-	    [namespace code {ClearUnselectedConstraints ;#}]
-
-    # A test application has to know how to load the tested commands
-    # into the interpreter.
-    Option -load {} {
-	Specifies the script to load the tested commands.
-    } AcceptScript loadScript
-
-    # Default is to run each test file in a separate process
-    Option -singleproc 0 {
-	whether to run all tests in one process
-    } AcceptBoolean singleProcess
-
-    proc AcceptTemporaryDirectory { directory } {
-	set directory [AcceptAbsolutePath $directory]
-	if {![file exists $directory]} {
-	    file mkdir $directory
-	}
-	set directory [AcceptDirectory $directory]
-	if {![file writable $directory]} {
-	    if {[workingDirectory] eq $directory} {
-		# Special exception: accept the default value
-		# even if the directory is not writable
-		return $directory
-	    }
-	    return -code error "\"$directory\" is not writeable"
-	}
-	return $directory
-    }
-
-    # Directory where files should be created
-    Option -tmpdir [workingDirectory] {
-	Save temporary files in the specified directory.
-    } AcceptTemporaryDirectory temporaryDirectory
-    trace add variable Option(-tmpdir) write \
-	    [namespace code {normalizePath Option(-tmpdir) ;#}]
-
-    # Tests should not rely on the current working directory.
-    # Files that are part of the test suite should be accessed relative
-    # to [testsDirectory]
-    Option -testdir [workingDirectory] {
-	Search tests in the specified directory.
-    } AcceptDirectory testsDirectory
-    trace add variable Option(-testdir) write \
-	    [namespace code {normalizePath Option(-testdir) ;#}]
-
-    proc AcceptLoadFile { file } {
-	if {$file eq {}} {return $file}
-	set file [file join [temporaryDirectory] $file]
-	return [AcceptReadable $file]
-    }
-    proc ReadLoadScript {args} {
-	variable Option
-	if {$Option(-loadfile) eq {}} {return}
-	set tmp [open $Option(-loadfile) r]
-	loadScript [read $tmp]
-	close $tmp
-    }
-    Option -loadfile {} {
-	Read the script to load the tested commands from the specified file.
-    } AcceptLoadFile loadFile
-    trace add variable Option(-loadfile) write [namespace code ReadLoadScript]
-
-    proc AcceptOutFile { file } {
-	if {[string equal stderr $file]} {return $file}
-	if {[string equal stdout $file]} {return $file}
-	return [file join [temporaryDirectory] $file]
-    }
-
-    # output goes to stdout by default
-    Option -outfile stdout {
-	Send output from test runs to the specified file.
-    } AcceptOutFile outputFile
-    trace add variable Option(-outfile) write \
-	    [namespace code {outputChannel $Option(-outfile) ;#}]
-
-    # errors go to stderr by default
-    Option -errfile stderr {
-	Send errors from test runs to the specified file.
-    } AcceptOutFile errorFile
-    trace add variable Option(-errfile) write \
-	    [namespace code {errorChannel $Option(-errfile) ;#}]
-
-    proc loadIntoSlaveInterpreter {slave args} {
-	variable Version
-	interp eval $slave [package ifneeded tcltest $Version]
-	interp eval $slave "tcltest::configure {*}{$args}"
-	interp alias $slave ::tcltest::ReportToMaster \
-	    {} ::tcltest::ReportedFromSlave
-    }
-    proc ReportedFromSlave {total passed skipped failed because newfiles} {
-	variable numTests
-	variable skippedBecause
-	variable createdNewFiles
-	incr numTests(Total)   $total
-	incr numTests(Passed)  $passed
-	incr numTests(Skipped) $skipped
-	incr numTests(Failed)  $failed
-	foreach {constraint count} $because {
-	    incr skippedBecause($constraint) $count
-	}
-	foreach {testfile created} $newfiles {
-	    lappend createdNewFiles($testfile) {*}$created
-	}
-	return
-    }
-}
-
-#####################################################################
-
-# 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 1 $arrayvar $arrayvar}
-	parray $arrayvar
-    }
-    return
-}
-
-# Define our own [parray] in ::tcltest that will inherit use of the [puts]
-# defined in ::tcltest.  NOTE: Ought to construct with [info args] and
-# [info default], but can't be bothered now.  If [parray] changes, then
-# this will need changing too.
-auto_load ::parray
-proc tcltest::parray {a {pattern *}} [info body ::parray]
-
-# 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 1 $script
-    }
-    return
-}
-
-#####################################################################
-
-proc tcltest::Warn {msg} {
-    puts [outputChannel] "WARNING: $msg"
-}
-
-# tcltest::mainThread
-#
-#     Accessor command for tcltest variable mainThread.
-#
-proc tcltest::mainThread { {new ""} } {
-    variable mainThread
-    if {[llength [info level 0]] == 1} {
-	return $mainThread
-    }
-    set mainThread $new
-}
-
-# 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:
-#	none
-
-proc tcltest::testConstraint {constraint {value ""}} {
-    variable testConstraints
-    variable Option
-    DebugPuts 3 "entering testConstraint $constraint $value"
-    if {[llength [info level 0]] == 2} {
-	return $testConstraints($constraint)
-    }
-    # Check for boolean values
-    if {[catch {expr {$value && $value}} msg]} {
-	return -code error $msg
-    }
-    if {[limitConstraints] && ($constraint ni $Option(-constraints))} {
-	set value 0
-    }
-    set testConstraints($constraint) $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 ""} } {
-    variable tcltest
-    if {[llength [info level 0]] == 1} {
-	return $tcltest
-    }
-    set tcltest $interp
-}
-
-#####################################################################
-
-# 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
-    variable skippedBecause
-
-    if {[info exists skippedBecause($constraint)]} {
-	incr skippedBecause($constraint) $value
-    } else {
-	set 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 - $InitialMsgLen)} {
-	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 ne "end"} {
-	    puts -nonewline [errorChannel] \
-		    [string repeat " " $InitialMsgLen]
-	    if {($endingIndex - $beginningIndex)
-		    < (80 - $InitialMsgLen)} {
-		puts [errorChannel] [string trim \
-			[string range $errorMsg $beginningIndex end]]
-		break
-	    } else {
-		set newEndingIndex [expr {[string last " " \
-			[string range $errorMsg $beginningIndex \
-				[expr {$beginningIndex
-					+ (80 - $InitialMsgLen)}]
-		]] + $beginningIndex}]
-		if {($newEndingIndex <= 0)
-			|| ($newEndingIndex <= $beginningIndex)} {
-		    set newEndingIndex end
-		}
-		puts [errorChannel] [string trim \
-			[string range $errorMsg \
-			    $beginningIndex $newEndingIndex]]
-		set beginningIndex $newEndingIndex
-	    }
-	}
-    }
-    flush [errorChannel]
-    return
-}
-
-# tcltest::SafeFetch --
-#
-#	 The following trace procedure makes it so that we can safely
-#        refer to non-existent members of the 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
-#        testConstraints("X") is defined.
-#
-# Arguments:
-#	n1 - name of the array (testConstraints)
-#       n2 - array key value (constraint name)
-#       op - operation performed on testConstraints (generally r)
-#
-# Results:
-#	none
-#
-# Side effects:
-#	sets testConstraints($n2) to 0 if it's referenced but never
-#       before used
-
-proc tcltest::SafeFetch {n1 n2 op} {
-    variable testConstraints
-    DebugPuts 3 "entering SafeFetch $n1 $n2 $op"
-    if {$n2 eq {}} {return}
-    if {![info exists testConstraints($n2)]} {
-	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
-	    testConstraint $n2 0
-	}
-    }
-}
-
-# tcltest::ConstraintInitializer --
-#
-#	Get or set a script that when evaluated in the tcltest namespace
-#	will return a boolean value with which to initialize the
-#	associated constraint.
-#
-# Arguments:
-#	constraint - name of the constraint initialized by the script
-#	script - the initializer script
-#
-# Results
-#	boolean value of the constraint - enabled or disabled
-#
-# Side effects:
-#	Constraint is initialized for future reference by [test]
-proc tcltest::ConstraintInitializer {constraint {script ""}} {
-    variable ConstraintInitializer
-    DebugPuts 3 "entering ConstraintInitializer $constraint $script"
-    if {[llength [info level 0]] == 2} {
-	return $ConstraintInitializer($constraint)
-    }
-    # Check for boolean values
-    if {![info complete $script]} {
-	return -code error "ConstraintInitializer must be complete script"
-    }
-    set ConstraintInitializer($constraint) $script
-}
-
-# tcltest::InitConstraints --
-#
-# Call all registered constraint initializers to force initialization
-# of all known constraints.
-# See the tcltest man page for the list of built-in constraints defined
-# in this procedure.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	The testConstraints array is reset to have an index for each
-#	built-in test constraint.
-#
-# Side Effects:
-#       None.
-#
-
-proc tcltest::InitConstraints {} {
-    variable ConstraintInitializer
-    initConstraintsHook
-    foreach constraint [array names ConstraintInitializer] {
-	testConstraint $constraint
-    }
-}
-
-proc tcltest::DefineConstraintInitializers {} {
-    ConstraintInitializer singleTestInterp {singleProcess}
-
-    # All the 'pc' constraints are here for backward compatibility and
-    # are not documented.  They have been replaced with equivalent 'win'
-    # constraints.
-
-    ConstraintInitializer unixOnly \
-	    {string equal $::tcl_platform(platform) unix}
-    ConstraintInitializer macOnly \
-	    {string equal $::tcl_platform(platform) macintosh}
-    ConstraintInitializer pcOnly \
-	    {string equal $::tcl_platform(platform) windows}
-    ConstraintInitializer winOnly \
-	    {string equal $::tcl_platform(platform) windows}
-
-    ConstraintInitializer unix {testConstraint unixOnly}
-    ConstraintInitializer mac {testConstraint macOnly}
-    ConstraintInitializer pc {testConstraint pcOnly}
-    ConstraintInitializer win {testConstraint winOnly}
-
-    ConstraintInitializer unixOrPc \
-	    {expr {[testConstraint unix] || [testConstraint pc]}}
-    ConstraintInitializer macOrPc \
-	    {expr {[testConstraint mac] || [testConstraint pc]}}
-    ConstraintInitializer unixOrWin \
-	    {expr {[testConstraint unix] || [testConstraint win]}}
-    ConstraintInitializer macOrWin \
-	    {expr {[testConstraint mac] || [testConstraint win]}}
-    ConstraintInitializer macOrUnix \
-	    {expr {[testConstraint mac] || [testConstraint unix]}}
-
-    ConstraintInitializer nt {string equal $::tcl_platform(os) "Windows NT"}
-    ConstraintInitializer 95 {string equal $::tcl_platform(os) "Windows 95"}
-    ConstraintInitializer 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.
-
-    ConstraintInitializer tempNotPc {expr {![testConstraint pc]}}
-    ConstraintInitializer tempNotWin {expr {![testConstraint win]}}
-    ConstraintInitializer tempNotMac {expr {![testConstraint mac]}}
-    ConstraintInitializer tempNotUnix {expr {![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.
-
-    ConstraintInitializer pcCrash {expr {![testConstraint pc]}}
-    ConstraintInitializer winCrash {expr {![testConstraint win]}}
-    ConstraintInitializer macCrash {expr {![testConstraint mac]}}
-    ConstraintInitializer unixCrash {expr {![testConstraint unix]}}
-
-    # Skip empty tests
-
-    ConstraintInitializer emptyTest {format 0}
-
-    # By default, tests that expose known bugs are skipped.
-
-    ConstraintInitializer knownBug {format 0}
-
-    # By default, non-portable tests are skipped.
-
-    ConstraintInitializer nonPortable {format 0}
-
-    # Some tests require user interaction.
-
-    ConstraintInitializer userInteraction {format 0}
-
-    # Some tests must be skipped if the interpreter is not in
-    # interactive mode
-
-    ConstraintInitializer interactive \
-	    {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
-
-    # 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.
-
-    ConstraintInitializer root {expr \
-	    {($::tcl_platform(platform) eq "unix") &&
-		    ($::tcl_platform(user) in {root {}})}}
-    ConstraintInitializer notRoot {expr {![testConstraint root]}}
-
-    # Set nonBlockFiles constraint: 1 means this platform supports
-    # setting files into nonblocking mode.
-
-    ConstraintInitializer nonBlockFiles {
-	    set code [expr {[catch {set f [open defs r]}]
-		    || [catch {chan configure $f -blocking off}]}]
-	    catch {close $f}
-	    set code
-    }
-
-    # 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).
-
-    ConstraintInitializer asyncPipeClose {expr {
-	    !([string equal unix $::tcl_platform(platform)]
-	    && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}}
-
-    # Test to see if we have a broken version of sprintf with respect
-    # to the "e" format of floating-point numbers.
-
-    ConstraintInitializer eformat {string equal [format %g 5e-5] 5e-05}
-
-    # Test to see if execed commands such as cat, echo, rm and so forth
-    # are present on this machine.
-
-    ConstraintInitializer unixExecs {
-	set code 1
-        if {$::tcl_platform(platform) eq "macintosh"} {
-	    set code 0
-        }
-        if {$::tcl_platform(platform) eq "windows"} {
-	    if {[catch {
-	        set file _tcl_test_remove_me.txt
-	        makeFile {hello} $file
-	    }]} {
-	        set code 0
-	    } elseif {
-	        [catch {exec cat $file}] ||
-	        [catch {exec echo hello}] ||
-	        [catch {exec sh -c echo hello}] ||
-	        [catch {exec wc $file}] ||
-	        [catch {exec sleep 1}] ||
-	        [catch {exec echo abc > $file}] ||
-	        [catch {exec chmod 644 $file}] ||
-	        [catch {exec rm $file}] ||
-	        [llength [auto_execok mkdir]] == 0 ||
-	        [llength [auto_execok fgrep]] == 0 ||
-	        [llength [auto_execok grep]] == 0 ||
-	        [llength [auto_execok ps]] == 0
-	    } {
-	        set code 0
-	    }
-	    removeFile $file
-        }
-	set code
-    }
-
-    ConstraintInitializer stdio {
-	set code 0
-	if {![catch {set f [open "|[list [interpreter]]" w]}]} {
-	    if {![catch {puts $f exit}]} {
-		if {![catch {close $f}]} {
-		    set code 1
-		}
-	    }
-	}
-	set code
-    }
-
-    # Deliberately call socket with the wrong number of arguments.  The
-    # error message you get will indicate whether sockets are available
-    # on this system.
-
-    ConstraintInitializer socket {
-	catch {socket} msg
-	string compare $msg "sockets are not available on this system"
-    }
-
-    # Check for internationalization
-    ConstraintInitializer hasIsoLocale {
-	if {[llength [info commands testlocale]] == 0} {
-	    set code 0
-	} else {
-	    set code [string length [SetIso8859_1_Locale]]
-	    RestoreLocale
-	}
-	set code
-    }
-
-}
-#####################################################################
-
-# Usage and command line arguments processing.
-
-# tcltest::PrintUsageInfo
-#
-#	Prints out the usage information for package tcltest.  This can
-#	be customized with the redefinition of [PrintUsageInfoHook].
-#
-# Arguments:
-#	none
-#
-# Results:
-#       none
-#
-# Side Effects:
-#       none
-proc tcltest::PrintUsageInfo {} {
-    puts [Usage]
-    PrintUsageInfoHook
-}
-
-proc tcltest::Usage { {option ""} } {
-    variable Usage
-    variable Verify
-    if {[llength [info level 0]] == 1} {
-	set msg "Usage: [file tail [info nameofexecutable]] script "
-	append msg "?-help? ?flag value? ... \n"
-	append msg "Available flags (and valid input values) are:"
-
-	set max 0
-	set allOpts [concat -help [Configure]]
-	foreach opt $allOpts {
-	    set foo [Usage $opt]
-	    lassign $foo x type($opt) usage($opt)
-	    set line($opt) "  $opt $type($opt)  "
-	    set length($opt) [string length $line($opt)]
-	    if {$length($opt) > $max} {set max $length($opt)}
-	}
-	set rest [expr {72 - $max}]
-	foreach opt $allOpts {
-	    append msg \n$line($opt)
-	    append msg [string repeat " " [expr {$max - $length($opt)}]]
-	    set u [string trim $usage($opt)]
-	    catch {append u "  (default: \[[Configure $opt]])"}
-	    regsub -all {\s*\n\s*} $u " " u
-	    while {[string length $u] > $rest} {
-		set break [string wordstart $u $rest]
-		if {$break == 0} {
-		    set break [string wordend $u 0]
-		}
-		append msg [string range $u 0 [expr {$break - 1}]]
-		set u [string trim [string range $u $break end]]
-		append msg \n[string repeat " " $max]
-	    }
-	    append msg $u
-	}
-	return $msg\n
-    } elseif {$option eq "-help"} {
-	return [list -help "" "Display this usage information."]
-    } else {
-	set type [lindex [info args $Verify($option)] 0]
-	return [list $option $type $Usage($option)]
-    }
-}
-
-# 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 {"-help" in $flagArray} {
-	PrintUsageInfo
-	exit 1
-    }
-
-    if {[llength $flagArray] == 0} {
-	RemoveAutoConfigureTraces
-    } else {
-	set args $flagArray
-	while {[llength $args] > 1 && [catch {configure {*}$args} msg]} {
-
-	    # Something went wrong parsing $args for tcltest options
-	    # Check whether the problem is "unknown option"
-	    if {[regexp {^unknown option (\S+):} $msg -> option]} {
-		# Could be this is an option the Hook knows about
-		set moreOptions [processCmdLineArgsAddFlagsHook]
-		if {$option ni $moreOptions} {
-		    # Nope.  Report the error, including additional options,
-		    # but keep going
-		    if {[llength $moreOptions]} {
-			append msg ", "
-			append msg [join [lrange $moreOptions 0 end-1] ", "]
-			append msg "or [lindex $moreOptions end]"
-		    }
-		    Warn $msg
-		}
-	    } else {
-		# error is something other than "unknown option"
-		# notify user of the error; and exit
-		puts [errorChannel] $msg
-		exit 1
-	    }
-
-	    # To recover, find that unknown option and remove up to it.
-	    # then retry
-	    while {[lindex $args 0] ne $option} {
-		set args [lrange $args 2 end]
-	    }
-	    set args [lrange $args 2 end]
-	}
-	if {[llength $args] == 1} {
-	    puts [errorChannel] \
-		    "missing value for option [lindex $args 0]"
-	    exit 1
-	}
-    }
-
-    # Call the hook
-    catch {
-        array set flag $flagArray
-        processCmdLineArgsHook [array get flag]
-    }
-    return
-}
-
-# tcltest::ProcessCmdLineArgs --
-#
-#       This procedure must be run after constraint initialization is
-#	set up (by [DefineConstraintInitializers]) because some constraints
-#	can be overridden.
-#
-#       Perform configuration according to the command-line options.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Sets the above-named variables in the tcltest namespace.
-#
-# Side Effects:
-#       None.
-#
-
-proc tcltest::ProcessCmdLineArgs {} {
-    variable originalEnv
-    variable testConstraints
-
-    # The "argv" var doesn't exist in some cases, so use {}.
-    if {![info exists ::argv]} {
-	ProcessFlags {}
-    } else {
-	ProcessFlags $::argv
-    }
-
-    # 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              = [debug]"
-    DebugPuts    2 "tcltest::testsDirectory     = [testsDirectory]"
-    DebugPuts    2 "tcltest::workingDirectory   = [workingDirectory]"
-    DebugPuts    2 "tcltest::temporaryDirectory = [temporaryDirectory]"
-    DebugPuts    2 "tcltest::outputChannel      = [outputChannel]"
-    DebugPuts    2 "tcltest::errorChannel       = [errorChannel]"
-    DebugPuts    2 "Original environment (tcltest::originalEnv):"
-    DebugPArray  2 originalEnv
-    DebugPuts    2 "Constraints:"
-    DebugPArray  2 testConstraints
-}
-
-#####################################################################
-
-# 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 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 outputChannel and errorChannel
-#	does not get sent to the normal puts function.
-namespace eval tcltest::Replace {
-    namespace export puts
-}
-proc tcltest::Replace::puts {args} {
-    variable [namespace parent]::outData
-    variable [namespace parent]::errData
-    switch [llength $args] {
-	1 {
-	    # Only the string to be printed is specified
-	    append outData [lindex $args 0]\n
-	    return
-	    # return [Puts [lindex $args 0]]
-	}
-	2 {
-	    # Either -nonewline or channelId has been specified
-	    if {[lindex $args 0] eq "-nonewline"} {
-		append outData [lindex $args end]
-		return
-		# return [Puts -nonewline [lindex $args end]]
-	    } else {
-		set channel [lindex $args 0]
-		set newline \n
-	    }
-	}
-	3 {
-	    if {[lindex $args 0] eq "-nonewline"} {
-		# Both -nonewline and channelId are specified, unless
-		# it's an error.  -nonewline is supposed to be argv[0].
-		set channel [lindex $args 1]
-		set newline ""
-	    }
-	}
-    }
-
-    if {[info exists channel]} {
-	if {$channel in [list [[namespace parent]::outputChannel] stdout]} {
-	    append outData [lindex $args end]$newline
-	    return
-	} elseif {$channel in [list [[namespace parent]::errorChannel] stderr]} {
-	    append errData [lindex $args end]$newline
-	    return
-	}
-    }
-
-    # If we haven't returned by now, we don't know how to handle the
-    # input.  Let puts handle it.
-    return [Puts {*}$args]
-}
-
-# tcltest::Eval --
-#
-#	Evaluate the script in the test environment.  If ignoreOutput is
-#       false, store data sent to stderr and stdout in outData and
-#       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 outData and errData before running a
-#	test if ignoreOutput is set to 0.
-
-proc tcltest::Eval {script {ignoreOutput 1}} {
-    variable outData
-    variable errData
-    DebugPuts 3 "[lindex [info level 0] 0] called"
-    if {!$ignoreOutput} {
-	set outData {}
-	set errData {}
-	rename ::puts [namespace current]::Replace::Puts
-	namespace eval :: [list namespace import [namespace origin Replace::puts]]
-	namespace import Replace::puts
-    }
-    set result [uplevel 1 $script]
-    if {!$ignoreOutput} {
-	namespace forget puts
-	namespace eval :: namespace forget puts
-	rename [namespace current]::Replace::Puts ::puts
-    }
-    return $result
-}
-
-# tcltest::CompareStrings --
-#
-#	compares the expected answer to the actual answer, depending on
-#	the mode provided.  Mode determines whether a regexp, exact,
-#	glob or custom 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} {
-    variable CustomMatch
-    if {![info exists CustomMatch($mode)]} {
-        return -code error "No matching command registered for `-match $mode'"
-    }
-    set match [namespace eval :: $CustomMatch($mode) [list $expected $actual]]
-    if {[catch {expr {$match && $match}} result]} {
-	return -code error "Invalid result from `-match $mode' command: $result"
-    }
-    return $match
-}
-
-# tcltest::customMatch --
-#
-#	registers a command to be called when a particular type of
-#	matching is required.
-#
-# Arguments:
-#	nickname - Keyword for the type of matching
-#	cmd - Incomplete command that implements that type of matching
-#		when completed with expected string and actual string
-#		and then evaluated.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	Sets the variable tcltest::CustomMatch
-
-proc tcltest::customMatch {mode script} {
-    variable CustomMatch
-    if {![info complete $script]} {
-	return -code error \
-		"invalid customMatch script; can't evaluate after completion"
-    }
-    set CustomMatch($mode) $script
-}
-
-# 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
-    # separated 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 ne {}} {
-            # 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 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
-# match variable, if it matches an element in 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
-#			"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 a string
-#			previously registered by a call to [customMatch].
-#			The strings exact, glob, and regexp are pre-registered
-#			by the tcltest package.  Default value 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:
-#	None.
-#
-# Side effects:
-#       Just about anything is possible depending on the test.
-#
-
-proc tcltest::test {name description args} {
-    global tcl_platform
-    variable testLevel
-    variable coreModTime
-    DebugPuts 3 "test $name $args"
-    DebugDo 1 {
-	variable TestNames
-	catch {
-	    puts "test name '$name' re-used; prior use in $TestNames($name)"
-	}
-	set TestNames($name) [info script]
-    }
-
-    FillFilesExisted
-    incr 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.
-    lassign {} constraints setup cleanup body result returnCodes match
-
-    # 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 {[string match -* [lindex $args 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(-$item)]} {
-		    set testAttributes(-$item) [uplevel 1 \
-			    ::concat $testAttributes(-$item)]
-		}
-	    }
-	} else {
-	    array set testAttributes $args
-	}
-
-	set validFlags {-setup -cleanup -body -result -returnCodes \
-		-match -output -errorOutput -constraints}
-
-	foreach flag [array names testAttributes] {
-	    if {$flag ni $validFlags} {
-		incr testLevel -1
-		set sorted [lsort $validFlags]
-		set options [join [lrange $sorted 0 end-1] ", "]
-		append options ", or [lindex $sorted end]"
-		return -code error "bad option \"$flag\": must be $options"
-	    }
-	}
-
-	# store whatever the user gave us
-	foreach item [array names testAttributes] {
-	    set [string trimleft $item "-"] $testAttributes($item)
-	}
-
-	# Check the values supplied for -match
-	variable CustomMatch
-	if {$match ni [array names CustomMatch]} {
-	    incr testLevel -1
-	    set sorted [lsort [array names CustomMatch]]
-	    set values [join [lrange $sorted 0 end-1] ", "]
-	    append values ", or [lindex $sorted end]"
-	    return -code error "bad -match value \"$match\":\
-		    must be $values"
-	}
-
-	# Replace symbolic valies supplied for -returnCodes
-	foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
-	    set returnCodes [string map -nocase [list $strcode $numcode] $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 {
-	    incr testLevel -1
-	    return -code error "wrong # args:\
-		    should be \"test name desc ?options?\""
-	}
-    }
-
-    if {[Skipped $name $constraints]} {
-	incr testLevel -1
-	return
-    }
-
-    # Save information about the core file.
-    if {[preserveCore]} {
-	if {[file exists [file join [workingDirectory] core]]} {
-	    set coreModTime [file mtime [file join [workingDirectory] core]]
-	}
-    }
-
-    # First, run the setup script
-    set code [catch {uplevel 1 $setup} setupMsg]
-    if {$code == 1} {
-	set errorInfo(setup) $::errorInfo
-	set errorCode(setup) $::errorCode
-    }
-    set setupFailure [expr {$code != 0}]
-
-    # Only run the test body if the setup was successful
-    if {!$setupFailure} {
-
-	# Register startup time
-	if {[IsVerbose msec] || [IsVerbose usec]} {
-	    set timeStart [clock microseconds]
-	}
-
-	# Verbose notification of $body start
-	if {[IsVerbose start]} {
-	    puts [outputChannel] "---- $name start"
-	    flush [outputChannel]
-	}
-
-	set command [list [namespace origin RunTest] $name $body]
-	if {[info exists output] || [info exists errorOutput]} {
-	    set testResult [uplevel 1 [list [namespace origin Eval] $command 0]]
-	} else {
-	    set testResult [uplevel 1 [list [namespace origin Eval] $command 1]]
-	}
-	lassign $testResult actualAnswer returnCode
-	if {$returnCode == 1} {
-	    set errorInfo(body) $::errorInfo
-	    set errorCode(body) $::errorCode
-	}
-    }
-
-    # check if the return code matched the expected return code
-    set codeFailure 0
-    if {!$setupFailure && ($returnCode ni $returnCodes)} {
-	set codeFailure 1
-    }
-
-    # If expected output/error strings exist, we have to compare
-    # them.  If the comparison fails, then so did the test.
-    set outputFailure 0
-    variable outData
-    if {[info exists output] && !$codeFailure} {
-	if {[set outputCompare [catch {
-	    CompareStrings $outData $output $match
-	} outputMatch]] == 0} {
-	    set outputFailure [expr {!$outputMatch}]
-	} else {
-	    set outputFailure 1
-	}
-    }
-
-    set errorFailure 0
-    variable errData
-    if {[info exists errorOutput] && !$codeFailure} {
-	if {[set errorCompare [catch {
-	    CompareStrings $errData $errorOutput $match
-	} errorMatch]] == 0} {
-	    set errorFailure [expr {!$errorMatch}]
-	} else {
-	    set errorFailure 1
-	}
-    }
-
-    # check if the answer matched the expected answer
-    # Only check if we ran the body of the test (no setup failure)
-    if {$setupFailure || $codeFailure} {
-	set scriptFailure 0
-    } elseif {[set scriptCompare [catch {
-	CompareStrings $actualAnswer $result $match
-    } scriptMatch]] == 0} {
-	set scriptFailure [expr {!$scriptMatch}]
-    } else {
-	set scriptFailure 1
-    }
-
-    # Always run the cleanup script
-    set code [catch {uplevel 1 $cleanup} cleanupMsg]
-    if {$code == 1} {
-	set errorInfo(cleanup) $::errorInfo
-	set errorCode(cleanup) $::errorCode
-    }
-    set cleanupFailure [expr {$code != 0}]
-
-    set coreFailure 0
-    set coreMsg ""
-    # check for a core file first - if one was created by the test,
-    # then the test failed
-    if {[preserveCore]} {
-	if {[file exists [file join [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 [workingDirectory] core]]} {
-		    set coreFailure 1
-		}
-	    } else {
-		set coreFailure 1
-	    }
-
-	    if {([preserveCore] > 1) && ($coreFailure)} {
-		append coreMsg "\nMoving file to:\
-		    [file join [temporaryDirectory] core-$name]"
-		catch {file rename -force -- \
-		    [file join [workingDirectory] core] \
-		    [file join [temporaryDirectory] core-$name]
-		} msg
-		if {$msg ne {}} {
-		    append coreMsg "\nError:\
-			Problem renaming core file: $msg"
-		}
-	    }
-	}
-    }
-
-    if {[IsVerbose msec] || [IsVerbose usec]} {
-	set t [expr {[clock microseconds] - $timeStart}]
-	if {[IsVerbose usec]} {
-	    puts [outputChannel] "++++ $name took $t μs"
-	}
-	if {[IsVerbose msec]} {
-	    puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms"
-	}
-    }
-
-    # if we didn't experience any failures, then we passed
-    variable numTests
-    if {!($setupFailure || $cleanupFailure || $coreFailure
-	    || $outputFailure || $errorFailure || $codeFailure
-	    || $scriptFailure)} {
-	if {$testLevel == 1} {
-	    incr numTests(Passed)
-	    if {[IsVerbose pass]} {
-		puts [outputChannel] "++++ $name PASSED"
-	    }
-	}
-	incr testLevel -1
-	return
-    }
-
-    # We know the test failed, tally it...
-    if {$testLevel == 1} {
-	incr numTests(Failed)
-    }
-
-    # ... then report according to the type of failure
-    variable currentFailure true
-    if {![IsVerbose body]} {
-	set body ""
-    }
-    puts [outputChannel] "\n"
-    if {[IsVerbose line]} {
-	if {![catch {set testFrame [info frame -1]}] &&
-		[dict get $testFrame type] eq "source"} {
-	    set testFile [dict get $testFrame file]
-	    set testLine [dict get $testFrame line]
-	} else {
-	    set testFile [file normalize [uplevel 1 {info script}]]
-	    if {[file readable $testFile]} {
-		set testFd [open $testFile r]
-		set testLine [expr {[lsearch -regexp \
-			[split [read $testFd] "\n"] \
-			"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
-		close $testFd
-	    }
-	}
-	if {[info exists testLine]} {
-	    puts [outputChannel] "$testFile:$testLine: error: test failed:\
-		    $name [string trim $description]"
-	}
-    }
-    puts [outputChannel] "==== $name\
-	    [string trim $description] FAILED"
-    if {[string length $body]} {
-	puts [outputChannel] "==== Contents of test case:"
-	puts [outputChannel] $body
-    }
-    if {$setupFailure} {
-	puts [outputChannel] "---- Test setup\
-		failed:\n$setupMsg"
-	if {[info exists errorInfo(setup)]} {
-	    puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)"
-	    puts [outputChannel] "---- errorCode(setup): $errorCode(setup)"
-	}
-    }
-    if {$scriptFailure} {
-	if {$scriptCompare} {
-	    puts [outputChannel] "---- Error testing result: $scriptMatch"
-	} else {
-	    puts [outputChannel] "---- Result was:\n$actualAnswer"
-	    puts [outputChannel] "---- Result should have been\
-		    ($match matching):\n$result"
-	}
-    }
-    if {$codeFailure} {
-	switch -- $returnCode {
-	    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: $returnCode"
-	puts [outputChannel] "---- Return code should have been\
-		one of: $returnCodes"
-	if {[IsVerbose error]} {
-	    if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
-		puts [outputChannel] "---- errorInfo: $errorInfo(body)"
-		puts [outputChannel] "---- errorCode: $errorCode(body)"
-	    }
-	}
-    }
-    if {$outputFailure} {
-	if {$outputCompare} {
-	    puts [outputChannel] "---- Error testing output: $outputMatch"
-	} else {
-	    puts [outputChannel] "---- Output was:\n$outData"
-	    puts [outputChannel] "---- Output should have been\
-		    ($match matching):\n$output"
-	}
-    }
-    if {$errorFailure} {
-	if {$errorCompare} {
-	    puts [outputChannel] "---- Error testing errorOutput: $errorMatch"
-	} else {
-	    puts [outputChannel] "---- Error output was:\n$errData"
-	    puts [outputChannel] "---- Error output should have\
-		    been ($match matching):\n$errorOutput"
-	}
-    }
-    if {$cleanupFailure} {
-	puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
-	if {[info exists errorInfo(cleanup)]} {
-	    puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)"
-	    puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)"
-	}
-    }
-    if {$coreFailure} {
-	puts [outputChannel] "---- Core file produced while running\
-		test!  $coreMsg"
-    }
-    puts [outputChannel] "==== $name FAILED\n"
-
-    incr testLevel -1
-    return
-}
-
-# Skipped --
-#
-# Given a test name and it constraints, returns a boolean indicating
-# whether the current configuration says the test should be skipped.
-#
-# Side Effects:  Maintains tally of total tests seen and tests skipped.
-#
-proc tcltest::Skipped {name constraints} {
-    variable testLevel
-    variable numTests
-    variable testConstraints
-
-    if {$testLevel == 1} {
-	incr numTests(Total)
-    }
-    # skip the test if it's name matches an element of skip
-    foreach pattern [skip] {
-	if {[string match $pattern $name]} {
-	    if {$testLevel == 1} {
-		incr numTests(Skipped)
-		DebugDo 1 {AddToSkippedBecause userSpecifiedSkip}
-	    }
-	    return 1
-	}
-    }
-    # skip the test if it's name doesn't match any element of match
-    set ok 0
-    foreach pattern [match] {
-	if {[string match $pattern $name]} {
-	    set ok 1
-	    break
-	}
-    }
-    if {!$ok} {
-	if {$testLevel == 1} {
-	    incr numTests(Skipped)
-	    DebugDo 1 {AddToSkippedBecause userSpecifiedNonMatch}
-	}
-	return 1
-    }
-    if {$constraints eq {}} {
-	# If we're limited to the listed constraints and there aren't
-	# any listed, then we shouldn't run the test.
-	if {[limitConstraints]} {
-	    AddToSkippedBecause userSpecifiedLimitConstraint
-	    if {$testLevel == 1} {
-		incr numTests(Skipped)
-	    }
-	    return 1
-	}
-    } 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 [list expr $constraints]]}
-	} elseif {[regexp {[^.:_a-zA-Z0-9 \n\r\t]+} $constraints] != 0} {
-	    # something like {a || b} should be turned into
-	    # $testConstraints(a) || $testConstraints(b).
-	    regsub -all {[.\w]+} $constraints {$testConstraints(&)} c
-	    catch {set doTest [eval [list expr $c]]}
-	} elseif {![catch {llength $constraints}]} {
-	    # just simple constraints such as {unixOnly fonts}.
-	    set doTest 1
-	    foreach constraint $constraints {
-		if {(![info exists testConstraints($constraint)]) \
-			|| (!$testConstraints($constraint))} {
-		    set doTest 0
-
-		    # store the constraint that kept the test from
-		    # running
-		    set constraints $constraint
-		    break
-		}
-	    }
-	}
-
-	if {!$doTest} {
-	    if {[IsVerbose skip]} {
-		puts [outputChannel] "++++ $name SKIPPED: $constraints"
-	    }
-
-	    if {$testLevel == 1} {
-		incr numTests(Skipped)
-		AddToSkippedBecause $constraints
-	    }
-	    return 1
-	}
-    }
-    return 0
-}
-
-# RunTest --
-#
-# This is where the body of a test is evaluated.  The combination of
-# [RunTest] and [Eval] allows the output and error output of the test
-# body to be captured for comparison against the expected values.
-
-proc tcltest::RunTest {name script} {
-    DebugPuts 3 "Running $name {$script}"
-
-    # If there is no "memory" command (because memory debugging isn't
-    # enabled), then don't attempt to use the command.
-
-    if {[llength [info commands memory]] == 1} {
-	memory tag $name
-    }
-
-    set code [catch {uplevel 1 $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 {[llength [info commands tcltest::cleanupTestsHook]] == 0} {
-    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}} {
-    variable filesMade
-    variable filesExisted
-    variable createdNewFiles
-    variable testSingleFile
-    variable numTests
-    variable numTestFiles
-    variable failFiles
-    variable skippedBecause
-    variable currentFailure
-    variable originalEnv
-    variable originalTclPlatform
-    variable coreModTime
-
-    FillFilesExisted
-    set testFileName [file tail [info script]]
-
-    # Hook to handle reporting to a parent interpreter
-    if {[llength [info commands [namespace current]::ReportToMaster]]} {
-	ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
-	    $numTests(Failed) [array get skippedBecause] \
-	    [array get createdNewFiles]
-	set testSingleFile false
-    }
-
-    # Call the cleanup hook
-    cleanupTestsHook
-
-    # Remove files and directories created by the makeFile and
-    # makeDirectory procedures.  Record the names of files in
-    # workingDirectory that were not pre-existing, and associate them
-    # with the test file that created them.
-
-    if {!$calledFromAllFile} {
-	foreach file $filesMade {
-	    if {[file exists $file]} {
-		DebugDo 1 {Warn "cleanupTests deleting $file..."}
-		catch {file delete -force -- $file}
-	    }
-	}
-	set currentFiles {}
-	foreach file [glob -nocomplain \
-		-directory [temporaryDirectory] *] {
-	    lappend currentFiles [file tail $file]
-	}
-	set newFiles {}
-	foreach file $currentFiles {
-	    if {$file ni $filesExisted} {
-		lappend newFiles $file
-	    }
-	}
-	set filesExisted $currentFiles
-	if {[llength $newFiles] > 0} {
-	    set createdNewFiles($testFileName) $newFiles
-	}
-    }
-
-    if {$calledFromAllFile || $testSingleFile} {
-
-	# print stats
-
-	puts -nonewline [outputChannel] "$testFileName:"
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    puts -nonewline [outputChannel] \
-		    "\t$index\t$numTests($index)"
-	}
-	puts [outputChannel] ""
-
-	# print number test files sourced
-	# print names of files that ran tests which failed
-
-	if {$calledFromAllFile} {
-	    puts [outputChannel] \
-		    "Sourced $numTestFiles Test Files."
-	    set numTestFiles 0
-	    if {[llength $failFiles] > 0} {
-		puts [outputChannel] \
-			"Files with failing tests: $failFiles"
-		set failFiles {}
-	    }
-	}
-
-	# if any tests were skipped, print the constraints that kept
-	# them from running.
-
-	set constraintList [array names skippedBecause]
-	if {[llength $constraintList] > 0} {
-	    puts [outputChannel] \
-		    "Number of tests skipped for each constraint:"
-	    foreach constraint [lsort $constraintList] {
-		puts [outputChannel] \
-			"\t$skippedBecause($constraint)\t$constraint"
-		unset skippedBecause($constraint)
-	    }
-	}
-
-	# report the names of test files in createdNewFiles, and reset
-	# the array to be empty.
-
-	set testFilesThatTurded [lsort [array names createdNewFiles]]
-	if {[llength $testFilesThatTurded] > 0} {
-	    puts [outputChannel] "Warning: files left behind:"
-	    foreach testFile $testFilesThatTurded {
-		puts [outputChannel] \
-			"\t$testFile:\t$createdNewFiles($testFile)"
-		unset createdNewFiles($testFile)
-	    }
-	}
-
-	# reset filesMade, filesExisted, and numTests
-
-	set filesMade {}
-	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
-	    set numTests($index) 0
-	}
-
-	# exit only if running Tk in non-interactive mode
-	# This should be changed to determine if an event
-	# loop is running, which is the real issue.
-	# Actually, this doesn't belong here at all.  A package
-	# really has no business [exit]-ing an application.
-	if {![catch {package present Tk}] && ![testConstraint 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
-
-	if {$currentFailure && ($testFileName ni $failFiles)} {
-	    lappend failFiles $testFileName
-	}
-	set 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 originalEnv($index)]} {
-		lappend newEnv $index
-		unset ::env($index)
-	    }
-	}
-	foreach index [array names originalEnv] {
-	    if {![info exists ::env($index)]} {
-		lappend removedEnv $index
-		set ::env($index) $originalEnv($index)
-	    } elseif {$::env($index) ne $originalEnv($index)} {
-		lappend changedEnv $index
-		set ::env($index) $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 originalTclPlatform] {
-	    if {$::tcl_platform($index) \
-		    != $originalTclPlatform($index)} {
-		lappend changedTclPlatform $index
-		set ::tcl_platform($index) $originalTclPlatform($index)
-	    }
-	}
-	if {[llength $changedTclPlatform] > 0} {
-	    puts [outputChannel] "tcl_platform array elements\
-		    changed:\t$changedTclPlatform"
-	}
-
-	if {[file exists [file join [workingDirectory] core]]} {
-	    if {[preserveCore] > 1} {
-		puts "rename core file (> 1)"
-		puts [outputChannel] "produced core file! \
-			Moving file to: \
-			[file join [temporaryDirectory] core-$testFileName]"
-		catch {file rename -force -- \
-			[file join [workingDirectory] core] \
-			[file join [temporaryDirectory] core-$testFileName]
-		} msg
-		if {$msg ne {}} {
-		    PrintError "Problem renaming file: $msg"
-		}
-	    } else {
-		# Print a message if there is a core file and (1) there
-		# previously wasn't one or (2) the new one is different
-		# from the old one.
-
-		if {[info exists coreModTime]} {
-		    if {$coreModTime != [file mtime \
-			    [file join [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
-
-# a lower case version is needed for compatibility with tcltest 1.0
-proc tcltest::getMatchingFiles args {GetMatchingFiles {*}$args}
-
-proc tcltest::GetMatchingFiles { args } {
-    if {[llength $args]} {
-	set dirList $args
-    } else {
-	# Finding tests only in [testsDirectory] is normal operation.
-	# This procedure is written to accept multiple directory arguments
-	# only to satisfy version 1 compatibility.
-	set dirList [list [testsDirectory]]
-    }
-
-    set matchingFiles [list]
-    foreach directory $dirList {
-
-	# List files in $directory that match patterns to run.
-	set matchFileList [list]
-	foreach match [matchFiles] {
-	    set matchFileList [concat $matchFileList \
-		    [glob -directory $directory -types {b c f p s} \
-		    -nocomplain -- $match]]
-	}
-
-	# List files in $directory that match patterns to skip.
-	set skipFileList [list]
-	foreach skip [skipFiles] {
-	    set skipFileList [concat $skipFileList \
-		    [glob -directory $directory -types {b c f p s} \
-		    -nocomplain -- $skip]]
-	}
-
-	# Add to result list all files in match list and not in skip list
-	foreach file $matchFileList {
-	    if {$file ni $skipFileList} {
-		lappend matchingFiles $file
-	    }
-	}
-    }
-
-    if {[llength $matchingFiles] == 0} {
-	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.
-#
-# Side Effects:
-#       None.
-
-proc tcltest::GetMatchingDirectories {rootdir} {
-
-    # Determine the skip list first, to avoid [glob]-ing over subdirectories
-    # we're going to throw away anyway.  Be sure we skip the $rootdir if it
-    # comes up to avoid infinite loops.
-    set skipDirs [list $rootdir]
-    foreach pattern [skipDirectories] {
-	set skipDirs [concat $skipDirs [glob -directory $rootdir -types d \
-		-nocomplain -- $pattern]]
-    }
-
-    # Now step through the matching directories, prune out the skipped ones
-    # as you go.
-    set matchDirs [list]
-    foreach pattern [matchDirectories] {
-	foreach path [glob -directory $rootdir -types d -nocomplain -- \
-		$pattern] {
-	    if {$path ni $skipDirs} {
-		set matchDirs [concat $matchDirs [GetMatchingDirectories $path]]
-		if {[file exists [file join $path all.tcl]]} {
-		    lappend matchDirs $path
-		}
-	    }
-	}
-    }
-
-    if {[llength $matchDirs] == 0} {
-	DebugPuts 1 "No test directories remain after applying match\
-		and skip patterns!"
-    }
-    return [lsort $matchDirs]
-}
-
-# 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 ""} } {
-    variable testSingleFile
-    variable numTestFiles
-    variable numTests
-    variable failFiles
-    variable DefaultValue
-
-    FillFilesExisted
-    if {[llength [info level 0]] == 1} {
-	set shell [interpreter]
-    }
-
-    set testSingleFile false
-
-    puts [outputChannel] "Tests running in interp:  $shell"
-    puts [outputChannel] "Tests located in:  [testsDirectory]"
-    puts [outputChannel] "Tests running in:  [workingDirectory]"
-    puts [outputChannel] "Temporary files stored in\
-	    [temporaryDirectory]"
-
-    # [file system] first available in Tcl 8.4
-    if {![catch {file system [testsDirectory]} result]
-	    && ([lindex $result 0] ne "native")} {
-	# If we aren't running in the native filesystem, then we must
-	# run the tests in a single process (via 'source'), because
-	# trying to run then via a pipe will fail since the files don't
-	# really exist.
-	singleProcess 1
-    }
-
-    if {[singleProcess]} {
-	puts [outputChannel] \
-		"Test files sourced into current interpreter"
-    } else {
-	puts [outputChannel] \
-		"Test files run in separate interpreters"
-    }
-    if {[llength [skip]] > 0} {
-	puts [outputChannel] "Skipping tests that match:  [skip]"
-    }
-    puts [outputChannel] "Running tests that match:  [match]"
-
-    if {[llength [skipFiles]] > 0} {
-	puts [outputChannel] \
-		"Skipping test files that match:  [skipFiles]"
-    }
-    if {[llength [matchFiles]] > 0} {
-	puts [outputChannel] \
-		"Only running test files that match:  [matchFiles]"
-    }
-
-    set timeCmd {clock format [clock seconds]}
-    puts [outputChannel] "Tests began at [eval $timeCmd]"
-
-    # Run each of the specified tests
-    foreach file [lsort [GetMatchingFiles]] {
-	set tail [file tail $file]
-	puts [outputChannel] $tail
-	flush [outputChannel]
-
-	if {[singleProcess]} {
-	    incr numTestFiles
-	    uplevel 1 [list ::source $file]
-	} else {
-	    # Pass along our configuration to the child processes.
-	    # EXCEPT for the -outfile, because the parent process
-	    # needs to read and process output of children.
-	    set childargv [list]
-	    foreach opt [Configure] {
-		if {$opt eq "-outfile"} {continue}
-		set value [Configure $opt]
-		# Don't bother passing default configuration options
-		if {$value eq $DefaultValue($opt)} {
-			continue
-		}
-		lappend childargv $opt $value
-	    }
-	    set cmd [linsert $childargv 0 | $shell $file]
-	    if {[catch {
-		incr numTestFiles
-		set pipeFd [open $cmd "r"]
-		while {[gets $pipeFd line] >= 0} {
-		    if {[regexp [join {
-			    {^([^:]+):\t}
-			    {Total\t([0-9]+)\t}
-			    {Passed\t([0-9]+)\t}
-			    {Skipped\t([0-9]+)\t}
-			    {Failed\t([0-9]+)}
-			    } ""] $line null testFile \
-			    Total Passed Skipped Failed]} {
-			foreach index {Total Passed Skipped Failed} {
-			    incr numTests($index) [set $index]
-			}
-			if {$Failed > 0} {
-			    lappend failFiles $testFile
-			}
-		    } elseif {[regexp [join {
-			    {^Number of tests skipped }
-			    {for each constraint:}
-			    {|^\t(\d+)\t(.+)$}
-			    } ""] $line match skipped constraint]} {
-			if {[string match \t* $match]} {
-			    AddToSkippedBecause $constraint $skipped
-			}
-		    } else {
-			puts [outputChannel] $line
-		    }
-		}
-		close $pipeFd
-	    } msg]} {
-		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]"
-    cleanupTests 1
-    if {[info exists testFileFailures]} {
-	puts [outputChannel] "\nTest files exiting with errors:  \n"
-	foreach file $testFileFailures {
-	    puts [outputChannel] "  [file tail $file]\n"
-	}
-    }
-
-    # Checking for subdirectories in which to run tests
-    foreach directory [GetMatchingDirectories [testsDirectory]] {
-	set dir [file tail $directory]
-	puts [outputChannel] [string repeat ~ 44]
-	puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
-
-	uplevel 1 [list ::source [file join $directory all.tcl]]
-
-	set endTime [eval $timeCmd]
-	puts [outputChannel] "\n$dir test ended at $endTime"
-	puts [outputChannel] ""
-	puts [outputChannel] [string repeat ~ 44]
-    }
-    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 {} {
-    return [uplevel 1 [loadScript]]
-}
-
-# tcltest::saveState --
-#
-#	Save information regarding what procs and variables exist.
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Modifies the variable saveState
-#
-# Side effects:
-#	None.
-
-proc tcltest::saveState {} {
-    variable saveState
-    uplevel 1 [list ::set [namespace which -variable saveState]] \
-	    {[::list [::info procs] [::info vars]]}
-    DebugPuts  2 "[lindex [info level 0] 0]: $saveState"
-    return
-}
-
-# tcltest::restoreState --
-#
-#	Remove procs and variables that didn't exist before the call to
-#       [saveState].
-#
-# Arguments:
-#	none
-#
-# Results:
-#	Removes procs and variables from your environment if they don't
-#	exist in the saveState variable.
-#
-# Side effects:
-#	None.
-
-proc tcltest::restoreState {} {
-    variable saveState
-    foreach p [uplevel 1 {::info procs}] {
-	if {($p ni [lindex $saveState 0]) && ("[namespace current]::$p" ne
-		[uplevel 1 [list ::namespace origin $p]])} {
-
-	    DebugPuts 2 "[lindex [info level 0] 0]: Removing proc $p"
-	    uplevel 1 [list ::catch [list ::rename $p {}]]
-	}
-    }
-    foreach p [uplevel 1 {::info vars}] {
-	if {$p ni [lindex $saveState 1]} {
-	    DebugPuts 2 "[lindex [info level 0] 0]:\
-		    Removing variable $p"
-	    uplevel 1 [list ::catch [list ::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
-    set msg [string map [list "\n\n" "\n"] $msg]
-    return [string map [list "\n\}" "\}"] $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 ""}} {
-    variable filesMade
-    FillFilesExisted
-
-    if {[llength [info level 0]] == 3} {
-	set directory [temporaryDirectory]
-    }
-
-    set fullName [file join $directory $name]
-
-    DebugPuts 3 "[lindex [info level 0] 0]:\
-	     putting ``$contents'' into $fullName"
-
-    set fd [open $fullName w]
-    chan configure $fd -translation lf
-    if {[string index $contents end] eq "\n"} {
-	puts -nonewline $fd $contents
-    } else {
-	puts $fd $contents
-    }
-    close $fd
-
-    if {$fullName ni $filesMade} {
-	lappend 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 ""}} {
-    variable filesMade
-    FillFilesExisted
-    if {[llength [info level 0]] == 2} {
-	set directory [temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName"
-    set idx [lsearch -exact $filesMade $fullName]
-    set filesMade [lreplace $filesMade $idx $idx]
-    if {$idx == -1} {
-	DebugDo 1 {
-	    Warn "removeFile removing \"$fullName\":\n  not created by makeFile"
-	}
-    }
-    if {![file isfile $fullName]} {
-	DebugDo 1 {
-	    Warn "removeFile removing \"$fullName\":\n  not a file"
-	}
-    }
-    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 ""}} {
-    variable filesMade
-    FillFilesExisted
-    if {[llength [info level 0]] == 2} {
-	set directory [temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName"
-    file mkdir $fullName
-    if {$fullName ni $filesMade} {
-	lappend 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 ""}} {
-    variable filesMade
-    FillFilesExisted
-    if {[llength [info level 0]] == 2} {
-	set directory [temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    DebugPuts 3 "[lindex [info level 0] 0]: deleting $fullName"
-    set idx [lsearch -exact $filesMade $fullName]
-    set filesMade [lreplace $filesMade $idx $idx]
-    if {$idx == -1} {
-	DebugDo 1 {
-	    Warn "removeDirectory removing \"$fullName\":\n  not created\
-		    by makeDirectory"
-	}
-    }
-    if {![file isdirectory $fullName]} {
-	DebugDo 1 {
-	    Warn "removeDirectory removing \"$fullName\":\n  not a directory"
-	}
-    }
-    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 ""}} {
-    FillFilesExisted
-    if {[llength [info level 0]] == 2} {
-	set directory [temporaryDirectory]
-    }
-    set fullName [file join $directory $name]
-    set f [open $fullName]
-    set data [read -nonewline $f]
-    close $f
-    return $data
-}
-
-# 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 {$p ni $old} {
-	    lappend leak $p
-	}
-    }
-    return $leak
-}
-
-#
-# Internationalization / ISO support procs     -- dl
-#
-
-# tcltest::SetIso8859_1_Locale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::SetIso8859_1_Locale {} {
-    variable previousLocale
-    variable isoLocale
-    if {[info commands testlocale] != ""} {
-	set previousLocale [testlocale ctype]
-	testlocale ctype $isoLocale
-    }
-    return
-}
-
-# tcltest::RestoreLocale --
-#
-#	used in cmdIL.test, uses testlocale
-#
-# Arguments:
-#	None.
-#
-# Results:
-#	None.
-#
-# Side effects:
-#	None.
-
-proc tcltest::RestoreLocale {} {
-    variable previousLocale
-    if {[info commands testlocale] != ""} {
-	testlocale ctype $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] ne {}} {
-
-	# testthread built into tcltest
-
-	testthread errorproc ThreadNullError
-	while {[llength [testthread names]] > 1} {
-	    foreach tid [testthread names] {
-		if {$tid != [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] ne {}} {
-
-	# Thread extension
-
-	thread::errorproc ThreadNullError
-	while {[llength [thread::names]] > 1} {
-	    foreach tid [thread::names] {
-		if {$tid != [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 {
-    # Define initializers for all the built-in contraint definitions
-    DefineConstraintInitializers
-
-    # Set up the constraints in the testConstraints array to be lazily
-    # initialized by a registered initializer, or by "false" if no
-    # initializer is registered.
-    trace add variable testConstraints read [namespace code SafeFetch]
-
-    # Only initialize constraints at package load time if an
-    # [initConstraintsHook] has been pre-defined.  This is only
-    # for compatibility support.  The modern way to add a custom
-    # test constraint is to just call the [testConstraint] command
-    # straight away, without all this "hook" nonsense.
-    if {[namespace current] eq
-	    [namespace qualifiers [namespace which initConstraintsHook]]} {
-	InitConstraints
-    } else {
-	proc initConstraintsHook {} {}
-    }
-
-    # Define the standard match commands
-    customMatch exact	[list string equal]
-    customMatch glob	[list string match]
-    customMatch regexp	[list regexp --]
-
-    # If the TCLTEST_OPTIONS environment variable exists, configure
-    # tcltest according to the option values it specifies.  This has
-    # the effect of resetting tcltest's default configuration.
-    proc ConfigureFromEnvironment {} {
-	upvar #0 env(TCLTEST_OPTIONS) options
-	if {[catch {llength $options} msg]} {
-	    Warn "invalid TCLTEST_OPTIONS \"$options\":\n  invalid\
-		    Tcl list: $msg"
-	    return
-	}
-	if {[llength $options] % 2} {
-	    Warn "invalid TCLTEST_OPTIONS: \"$options\":\n  should be\
-		    -option value ?-option value ...?"
-	    return
-	}
-	if {[catch {Configure {*}$options} msg]} {
-	    Warn "invalid TCLTEST_OPTIONS: \"$options\":\n  $msg"
-	    return
-	}
-    }
-    if {[info exists ::env(TCLTEST_OPTIONS)]} {
-	ConfigureFromEnvironment
-    }
-
-    proc LoadTimeCmdLineArgParsingRequired {} {
-	set required false
-	if {[info exists ::argv] && ("-help" in $::argv)} {
-	    # The command line asks for -help, so give it (and exit)
-	    # right now.  ([configure] does not process -help)
-	    set required true
-	}
-	foreach hook { PrintUsageInfoHook processCmdLineArgsHook
-			processCmdLineArgsAddFlagsHook } {
-	    if {[namespace current] eq
-		    [namespace qualifiers [namespace which $hook]]} {
-		set required true
-	    } else {
-		proc $hook args {}
-	    }
-	}
-	return $required
-    }
-
-    # Only initialize configurable options from the command line arguments
-    # at package load time if necessary for backward compatibility.  This
-    # lets the tcltest user call [configure] for themselves if they wish.
-    # Traces are established for auto-configuration from the command line
-    # if any configurable options are accessed before the user calls
-    # [configure].
-    if {[LoadTimeCmdLineArgParsingRequired]} {
-	ProcessCmdLineArgs
-    } else {
-	EstablishAutoConfigureTraces
-    }
-
-    package provide [namespace tail [namespace current]] $Version
-}