* Implementation of TIP 101. Adds and exports a [configure] command

        from tcltest.

4 files changed, 749 insertions, 848 deletions

diff --git a/ChangeLog b/ChangeLog
index c7e853d..db05d56 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-06-24  Don Porter  <dgp@users.sourceforge.net>
+
+	* library/tcltest/tcltest.tcl:	Implementation of TIP 101.  Adds
+	* tests/parseOld.test:		and exports a [configure] command
+	* tests/tcltest.test:		from tcltest.
+
 2002-06-22  Don Porter  <dgp@users.sourceforge.net>
 
 	* changes: updated changes file for 8.4b1 release.
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index b2b020b..095a40f 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -13,36 +13,146 @@
 # 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.
 #
-# RCS: @(#) $Id: tcltest.tcl,v 1.55 2002/06/22 04:19:46 dgp Exp $
-
-# create the "tcltest" namespace for all testing variables and
-# procedures
-
-package require Tcl 8.3
+# RCS: @(#) $Id: tcltest.tcl,v 1.56 2002/06/25 01:13:38 dgp Exp $
 
+package require Tcl 8.3		;# uses [glob -directory]
 namespace eval tcltest {
+    variable Version 2.1
+
+    # 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
-    namespace export bytestring cleanupTests customMatch debug errorChannel \
-	    errorFile interpreter limitConstraints loadFile loadScript \
-	    loadTestedCommands makeDirectory makeFile match \
-	    matchDirectories matchFiles normalizeMsg normalizePath \
-	    outputChannel outputFile preserveCore removeDirectory \
-	    removeFile runAllTests singleProcess skip skipDirectories \
-	    skipFiles temporaryDirectory test testConstraint \
-	    testsDirectory verbose viewFile workingDirectory
-    # Export the tcltest 1 compatibility procs
+##### 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		;#	bizarre [read]-ish thing
+    namespace export workingDirectory	;#	[cd] [pwd]
+
+    # Export deprecated commands for tcltest 1 compatibility
     namespace export getMatchingFiles mainThread restoreState saveState \
 	    threadReap
 
-    proc Default {varName value} {
-	variable $varName
-	if {![info exists $varName]} {
-	    variable $varName $value
+    # 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 $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]} {
@@ -55,41 +165,48 @@ namespace eval tcltest {
 	array set $varName $value
     }
 
-    # verbose defaults to {body}
-    Default verbose body
+    # save the original environment so that it can be restored later
+    ArrayDefault originalEnv [array get ::env]
 
-    # 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.
-    Default match {}
-    Default skip {}
-    Default matchFiles {*.test}
-    Default skipFiles {}
-    Default matchDirectories {*}
-    Default skipDirectories {}
+    # initialize numTests array to keep track fo the number of tests
+    # that pass, fail, and are skipped.
+    ArrayDefault numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
 
-    # By default, don't save core files
-    Default preserveCore 0
+    # numTests will store test files as indices and the list of files
+    # (that should not have been) left behind by the test files.
+    ArrayDefault createdNewFiles {}
 
-    # output goes to stdout by default
-    Default outputChannel stdout
-    Default outputFile stdout
+    # 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 {}
 
-    # errors go to stderr by default
-    Default errorChannel stderr
-    Default errorFile stderr
+    # initialize the testConstraints array to keep track of valid
+    # predefined constraints (see the explanation for the
+    # InitConstraints proc for more details).
+    ArrayDefault testConstraints {}
 
-    # 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.
-    Default debug 0
+##### 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).
@@ -98,57 +215,36 @@ namespace eval tcltest {
     # 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
-    Default testSingleFile true
-    Default currentFailure false
-    Default failFiles {}
+    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.
-    Default filesMade {}
-    Default filesExisted {}
-
-    # numTests will store test files as indices and the list of files
-    # (that should not have been) left behind by the test files.
-    ArrayDefault createdNewFiles {}
-
-    # initialize numTests array to keep track fo the number of tests
-    # that pass, fail, and are skipped.
-    ArrayDefault numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
-
-    # 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 {}
+    Default filesMade {} AcceptList
+    Default filesExisted {} AcceptList
+    variable FilesExistedFilled 0
+    proc FillFilesExisted {} {
+	variable FilesExistedFilled
+	if {$FilesExistedFilled} {return}
+	variable filesExisted
 
-    # initialize the testConstraints array to keep track of valid
-    # predefined constraints (see the explanation for the
-    # InitConstraints proc for more details).
-    ArrayDefault testConstraints {}
-    Default ConstraintsSpecifiedByCommandLineArgument {}
+	# Save the names of files that already exist in the scratch directory.
+	foreach file [glob -nocomplain -directory [temporaryDirectory] *] {
+	    lappend filesExisted [file tail $file]
+	}
+	set FilesExistedFilled 1
+    }
 
     # Kept only for compatibility
-    Default constraintsSpecified {}
+    Default constraintsSpecified {} AcceptList
     trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \
 		[array names ::tcltest::testConstraints] ;# }
 
-    # Don't run only the "-constraint" specified tests by default
-    Default limitConstraints false
-
-    # A test application has to know how to load the tested commands
-    # into the interpreter.
-    Default loadScript {}
-
-    # and the filename of the script file, if it exists
-    Default loadFile {}
-
     # tests that use threads need to know which is the main thread
     Default mainThread 1
     variable mainThread
@@ -158,49 +254,40 @@ namespace eval tcltest {
 	set mainThread [testthread id]
     }
 
-    # save the original environment so that it can be restored later
-    ArrayDefault originalEnv [array get ::env]
-
     # Set workingDirectory to [pwd]. The default output directory for
-    # Tcl tests is the working directory.
-    Default workingDirectory [pwd]
-    Default temporaryDirectory $workingDirectory
+    # Tcl tests is the working directory.  Whenever this value changes
+    # change to that directory.
+    variable workingDirectory
+    trace variable workingDirectory w \
+	    [namespace code {cd $workingDirectory ;#}]
 
-    # tcltest::normalizePath --
-    #
-    #     This procedure resolves any symlinks in the path thus creating
-    #     a path without internal redirection. It assumes that the
-    #     incoming path is absolute.
-    #
-    # Arguments
-    #     pathVar contains the name of the variable containing the path
-    #     to modify.
-    #
-    # Results
-    #     The path is modified in place.
-    #
-    # Side Effects:
-    #     None.
-    #
-    proc normalizePath {pathVar} {
-	upvar $pathVar path
-	set oldpwd [pwd]
-	catch {cd $path}
-	set path [pwd]
-	cd $oldpwd
-	return $path
+    Default workingDirectory [pwd] AcceptAbsolutePath
+    proc workingDirectory { {dir ""} } {
+	variable workingDirectory
+	if {[llength [info level 0]] == 1} {
+	    return $workingDirectory
+	}
+	set workingDirectory [AcceptAbsolutePath $dir]
     }
 
-    # Tests should not rely on the current working directory.
-    # Files that are part of the test suite should be accessed relative
-    # to tcltest::testsDirectory.
-    Default testsDirectory [file join \
-	    [file dirname [info script]] .. .. tests]
-    variable testsDirectory
-    normalizePath testsDirectory
+    # Set the location of the execuatble
+    Default tcltest [info nameofexecutable]
 
-    # Default is to run each test file in a separate process
-    Default singleProcess 0
+    # 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
@@ -243,25 +330,377 @@ namespace eval tcltest {
 	}
     }
 
-    # Set the location of the execuatble
-    Default tcltest [info nameofexecutable]
+    # output goes to stdout by default
+    Default outputChannel stdout
+    proc outputChannel { {filename ""} } {
+	variable outputChannel
+
+	# Trigger auto-configuration of -outfile option, if needed.
+	# This is tricky because we have to trigger a trace on $debug
+	# so that traces attached to $outputFile are not disabled.
+	# We need them enabled to reflect changes back to outputChannel
+	set dummy [debug]
+
+	if {[llength [info level 0]] == 1} {
+	    return $outputChannel
+	}
+	switch -exact -- $filename {
+	    stderr -
+	    stdout {
+		set outputChannel $filename
+	    }
+	    default {
+		set outputChannel [open $filename a]
+	    }
+	}
+	return $outputChannel
+    }
 
-    # save the platform information so it can be restored later
-    Default originalTclPlatform [array get tcl_platform]
+    # errors go to stderr by default
+    Default errorChannel stderr
+    proc errorChannel { {filename ""} } {
+	variable errorChannel
+
+	# Trigger auto-configuration of -errfile option, if needed.
+	# This is tricky because we have to trigger a trace on $debug
+	# so that traces attached to $outputFile are not disabled.
+	# We need them enabled to reflect changes back to outputChannel
+	set dummy [debug]
+
+	if {[llength [info level 0]] == 1} {
+	    return $errorChannel
+	}
+	switch -exact -- $filename {
+	    stderr -
+	    stdout {
+		set errorChannel $filename
+	    }
+	    default {
+		set errorChannel [open $filename a]
+	    }
+	}
+	return $errorChannel
+    }
 
-    # If a core file exists, save its modification time.
-    variable workingDirectory
-    if {[file exists [file join $workingDirectory core]]} {
-	Default coreModTime \
-		[file mtime [file join $workingDirectory core]]
+##### 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
+	set Usage($option) $usage
+	set Verify($option) $verify
+	set Option($option) [$verify $value]
+	if {[string length $varName]} {
+	    variable $varName
+	    if {[info exists $varName]} {
+		set Option($option) [$verify [set $varName]]
+		unset $varName
+	    }
+	    namespace eval [namespace current] \
+	    	    [list upvar 0 Option($option) $varName]
+	    # Workaround for Bug 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]
+	    }]
+	}
     }
 
-    # stdout and stderr buffers for use when we want to store them
-    Default outData {}
-    Default errData {}
+    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 {[lsearch -exact $match $option] >= 0} {
+		    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 variable $varName r [namespace code {ProcessCmdLineArgs ;#}]
+	}
+    }
+
+    proc RemoveAutoConfigureTraces {} {
+	variable OptionControlledVariables
+	foreach varName [concat $OptionControlledVariables Option] {
+	    variable $varName
+	    foreach pair [trace vinfo $varName] {
+		foreach {op cmd} $pair break
+		if {[string equal r $op]
+			&& [string match *ProcessCmdLineArgs* $cmd]} {
+		    trace vdelete $varName $op $cmd
+		}
+	    }
+	}
+	# One 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 {
+	RemoveAutoConfigureTraces
+	set code [catch {eval Configure $args} msg]
+	return -code $code $msg
+    }
+    
+    proc AcceptVerbose { level } {
+	set level [AcceptList $level]
+	if {[llength $level] == 1} {
+	    if {![regexp {^(pass|body|skip|start|error)$} $level]} {
+		# translate single characters abbreviations to expanded list
+		set level [string map {p pass b body s skip t start e error} \
+			[split $level {}]]
+	    }
+	}
+	set valid [list]
+	foreach v $level {
+	    if {[regexp {^(pass|body|skip|start|error)$} $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 {
+	Takes any combination of the values 'p', 's', 'b', 't' and 'e'.
+	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.
+    } 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
+
+    Option -notfile {} {
+	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 variable Option(-constraints) w \
+	    [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 {[lsearch -exact $Option(-constraints) $c] == -1} {
+		testConstraint $elt 0
+	    }
+	}
+    }
+    Option -limitconstraints false {
+	whether to run only tests with the constraints
+    } AcceptBoolean limitConstraints 
+    trace variable Option(-limitconstraints) w \
+	    [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]} {
+	    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 variable Option(-tmpdir) w \
+	    [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 [file join [file dirname [info script]] .. ..  tests] {
+	Search tests in the specified directory.
+    } AcceptDirectory testsDirectory
+    trace variable Option(-testdir) w \
+	    [namespace code {normalizePath Option(-testdir) ;#}]
+
+    proc AcceptLoadFile { file } {
+	if {[string equal "" $file]} {return $file}
+	set file [file join [temporaryDirectory] $file]
+	return [AcceptReadable $file]
+    }
+    proc ReadLoadScript {args} {
+	variable Option
+	if {[string equal "" $Option(-loadfile)]} {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 variable Option(-loadfile) w [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 variable Option(-outfile) w \
+	    [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 variable Option(-errfile) w \
+	    [namespace code {errorChannel $Option(-errfile) ;#}]
 
-    # keep track of test level for nested test commands
-    variable testLevel 0
 }
 
 #####################################################################
@@ -357,305 +796,16 @@ proc tcltest::DebugDo {level script} {
 
 #####################################################################
 
-# tcltest::CheckDirectory --
-#
-#     This procedure checks whether the specified path is a readable
-#     and/or writable directory. If one of the conditions is not
-#     satisfied an error is printed and the application aborted. The
-#     procedure assumes that the caller already checked the existence
-#     of the path.
-#
-# Arguments
-#     rw      Information what attributes to check. Allowed values:
-#             r, w, rw, wr. If 'r' is part of the value the directory
-#             must be readable. 'w' associates to 'writable'.
-#     dir     The directory to check.
-#     errMsg  The string to prepend to the actual error message before
-#             printing it.
-#
-# Results
-#     none
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::CheckDirectory {rw dir errMsg} {
-    # Allowed values for 'rw': r, w, rw, wr
-
-    if {![file isdir $dir]} {
-	return -code error "$errMsg \"$dir\" is not a directory"
-    } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
-	return -code error "$errMsg \"$dir\" is not writeable"
-    } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
-	return -code error "$errMsg \"$dir\" is not readable"
-    }
-    return
-}
-
-# tcltest::MakeAbsolutePath --
-#
-#     This procedure checks whether the incoming path is absolute or
-#     not.  Makes it absolute if it was not.
-#
-# Arguments
-#     pathVar contains the name of the variable containing the path to
-#             modify.
-#     prefix  is optional, contains the path to use to make the other an
-#             absolute one. The current working directory is used if it
-#             was not specified.
-#
-# Results
-#     The path is modified in place.
-#
-# Side Effects:
-#     None.
-#
-
-proc tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
-    upvar $pathVar path
-
-    if {![string equal [file pathtype $path] "absolute"]} {
-	if {[string equal {} $prefix]} {
-	    set prefix [pwd]
-	}
-
-	set path [file join $prefix $path]
-    }
-    return $path
-}
-
-#####################################################################
-
-# tcltest::<variableName>
-#
-#     Accessor functions for tcltest variables that can be modified
-#     externally.  These are vars that could otherwise be modified
-#     using command line arguments to tcltest.
-
-#     Many of them are all the same boilerplate:
-
-namespace eval tcltest {
-    variable var
-    foreach var {
-	    match skip matchFiles skipFiles matchDirectories
-	    skipDirectories preserveCore debug loadScript singleProcess
-	    mainThread ConstraintsSpecifiedByCommandLineArgument
-    } {
-	proc $var { {new ""} } [subst -nocommands {
-	    variable $var
-	    if {[llength [info level 0]] == 1} {
-		return [set $var]
-	    }
-	    set $var \$new
-	}]
-    }
-    unset var
-}
-
-#     The rest have something special to deal with:
-
-# tcltest::verbose --
+# tcltest::mainThread
 #
-#	Set or return the verbosity level (tcltest::verbose) for tests.
-#       This determines what gets printed to the screen and when, with
-#       regard to the running of the tests.  The proc does not check for
-#       invalid values.  It assumes that a string that doesn't match its
-#       predefined keywords is a string containing letter-specified
-#       verbosity levels.
-#
-# Arguments:
-#	A string containing any combination of 'pbste' or a list of
-#       keywords (listed in parens)
-#          p = print output whenever a test passes (pass)
-#          b = print the body of the test when it fails (body)
-#          s = print when a test is skipped (skip)
-#          t = print when a test starts (start)
-#          e = print errorInfo and errorCode when a test encounters an
-#              error (error)
+#     Accessor command for tcltest variable mainThread.
 #
-# Results:
-#	content of tcltest::verbose
-#
-# Side effects:
-#	None.
-
-proc tcltest::verbose { {level ""} } {
-    variable verbose
-    if {[llength [info level 0]] == 1} {
-	return $verbose
-    }
-    if {[llength $level] > 1} {
-  	set verbose $level
-    } else {
-	if {[regexp {pass|body|skip|start|error} $level]} {
-	    set verbose $level
-	} else {
-	    set levelList [split $level {}]
-	    set verbose [string map \
-		    {p pass b body s skip t start e error} $levelList]
-	}
-    }
-    return $verbose
-}
-
-# tcltest::IsVerbose --
-#
-#	Returns true if argument is one of the verbosity levels
-#       currently being used; returns false otherwise.
-#
-# Arguments:
-#	level
-#
-# Results:
-#	boolean 1 (true) or 0 (false), depending on whether or not the
-#       level provided is one of the ones stored in tcltest::verbose.
-#
-# Side effects:
-#	None.
-
-proc tcltest::IsVerbose {level} {
-    if {[lsearch -exact [verbose] $level] == -1} {
-	return 0
-    }
-    return 1
-}
-
-# tcltest::outputChannel --
-#
-#	set or return the output file descriptor based on the supplied
-#       file name (where tcltest puts all of its output)
-#
-# Arguments:
-#	output file descriptor
-#
-# Results:
-#	file descriptor corresponding to supplied file name (or
-#       currently set file descriptor, if no new filename was supplied)
-#       - this is the content of tcltest::outputChannel
-#
-# Side effects:
-#	None.
-
-proc tcltest::outputChannel { {filename ""} } {
-    variable outputChannel
-    if {[llength [info level 0]] == 1} {
-	return $outputChannel
-    }
-    switch -exact -- $filename {
-	stderr -
-	stdout {
-	    set outputChannel $filename
-	}
-	default {
-	    set outputChannel [open $filename w]
-	}
-    }
-    return $outputChannel
-}
-
-# tcltest::outputFile --
-#
-#	set or return the output file name (where tcltest puts all of
-#       its output); calls [outputChannel] to set the corresponding
-#       file descriptor
-#
-# Arguments:
-#	output file name
-#
-# Results:
-#       file name corresponding to supplied file name (or currently set
-#       file name, if no new filename was supplied) - this is the
-#       content of tcltest::outputFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute
-#       with respect to the predefined temporaryDirectory
-
-proc tcltest::outputFile { {filename ""} } {
-    variable outputFile
-    if {[llength [info level 0]] == 1} {
-	return $outputFile
-    }
-    switch -exact -- $filename {
-	stderr -
-	stdout {
-	    # do nothing
-	}
-	default {
-	    MakeAbsolutePath filename [temporaryDirectory]
-	}
-    }
-    outputChannel $filename
-    set outputFile $filename
-}
-
-# tcltest::errorChannel --
-#
-#	set or return the error file descriptor based on the supplied
-#       file name (where tcltest sends all its errors)
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	file descriptor corresponding to the supplied file name (or
-#       currently set file descriptor, if no new filename was supplied)
-#       - this is the content of tcltest::errorChannel
-#
-# Side effects:
-#	opens the descriptor in w mode unless the filename is set to
-#       stderr or stdout
-
-proc tcltest::errorChannel { {filename ""} } {
-    variable errorChannel
-    if {[llength [info level 0]] == 1} {
-	return $errorChannel
-    }
-    switch -exact -- $filename {
-	stderr -
-	stdout {
-	    set errorChannel $filename
-	}
-	default {
-	    set errorChannel [open $filename w]
-	}
-    }
-    return $errorChannel
-}
-
-# tcltest::errorFile --
-#
-#	set or return the error file name; calls [errorChannel] to set
-#       the corresponding file descriptor
-#
-# Arguments:
-#	error file name
-#
-# Results:
-#	content of tcltest::errorFile
-#
-# Side effects:
-#	if the file name supplied is relative, it will be made absolute
-#       with respect to the predefined temporaryDirectory
-
-proc tcltest::errorFile { {filename ""} } {
-    variable errorFile
+proc tcltest::mainThread { {new ""} } {
+    variable mainThread
     if {[llength [info level 0]] == 1} {
-	return $errorFile
-    }
-    switch -exact -- $filename {
-	stderr -
-	stdout {
-	    # do nothing
-	}
-	default {
-	    MakeAbsolutePath filename [temporaryDirectory]
-	}
+	return $mainThread
     }
-    set errorFile $filename
-    errorChannel $errorFile
-    return $errorFile
+    set mainThread $new
 }
 
 # tcltest::testConstraint --
@@ -691,168 +841,6 @@ proc tcltest::testConstraint {constraint {value ""}} {
     set testConstraints($constraint) $value
 }
 
-# tcltest::limitConstraints --
-#
-#	sets/gets flag indicating whether tests run are limited only
-#	to those matching constraints specified by the -constraints
-#	command line option.
-#
-# Arguments:
-#	new boolean value for the flag
-#
-# Results:
-#	content of tcltest::limitConstraints
-#
-# Side effects:
-#	None.
-
-proc tcltest::limitConstraints { {value ""} } {
-    variable testConstraints
-    variable limitConstraints
-    DebugPuts 3 "entering limitConstraints $value"
-    if {[llength [info level 0]] == 1} {
-	return $limitConstraints
-    }
-    # Check for boolean values
-    if {[catch {expr {$value && $value}} msg]} {
-	return -code error $msg
-    }
-    set limitConstraints $value
-    if {!$limitConstraints} {return $limitConstraints}
-    foreach elt [array names testConstraints] {
-	if {[lsearch -exact [ConstraintsSpecifiedByCommandLineArgument] $elt] 
-		== -1} {
-	    testConstraint $elt 0
-	}
-    }
-    return $limitConstraints
-}
-
-# tcltest::loadFile --
-#
-#	set the load file (containing the load script);
-#       put the content of the load file into loadScript
-#
-# Arguments:
-#	script's file name
-#
-# Results:
-#	content of tcltest::loadFile
-#
-# Side effects:
-#	None.
-
-proc tcltest::loadFile { {scriptFile ""} } {
-    variable loadFile
-    if {[llength [info level 0]] == 1} {
-	return $loadFile
-    }
-    MakeAbsolutePath scriptFile [temporaryDirectory]
-    set tmp [open $scriptFile r]
-    loadScript [read $tmp]
-    close $tmp
-    set loadFile $scriptFile
-}
-
-# tcltest::workingDirectory --
-#
-#	set workingDirectory to the given path.  If the path is
-#       relative, make it absolute.  Change directory to the stated
-#       working directory, if resetting the value
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::workingDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::workingDirectory { {dir ""} } {
-    variable workingDirectory
-    if {[llength [info level 0]] == 1} {
-	return $workingDirectory
-    }
-    set workingDirectory $dir
-    MakeAbsolutePath workingDirectory
-    cd $workingDirectory
-    return $workingDirectory
-}
-
-# tcltest::temporaryDirectory --
-#
-#     Set temporaryDirectory to the given path.  If the path is
-#     relative, make it absolute.  If the file exists but is not a dir,
-#     then return an error.
-#
-#     If temporaryDirectory does not already exist, create it.  If you
-#     cannot create it, then return an error (the file mkdir isn't
-#     caught and will propagate).
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::temporaryDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::temporaryDirectory { {dir ""} } {
-    variable temporaryDirectory
-    if {[llength [info level 0]] == 1} {
-	return $temporaryDirectory
-    }
-    set temporaryDirectory $dir
-    MakeAbsolutePath temporaryDirectory
-
-    if {[file exists $temporaryDirectory]} {
-	CheckDirectory rw $temporaryDirectory \
-		{bad argument for temporary directory: }
-    } else {
-	file mkdir $temporaryDirectory
-    }
-
-    normalizePath temporaryDirectory
-}
-
-# tcltest::testsDirectory --
-#
-#     Set testsDirectory to the given path.  If the path is relative,
-#     make it absolute.  If the file exists but is not a dir, then
-#     return an error.
-#
-#     If testsDirectory does not already exist, return an error.
-#
-# Arguments:
-#	directory name
-#
-# Results:
-#	content of tcltest::testsDirectory
-#
-# Side effects:
-#	None.
-
-proc tcltest::testsDirectory { {dir ""} } {
-    variable testsDirectory
-    if {[llength [info level 0]] == 1} {
-	return $testsDirectory
-    }
-
-    set testsDirectory $dir
-    MakeAbsolutePath testsDirectory
-    set testDirError "bad argument for tests directory: "
-    if {[file exists $testsDirectory]} {
-	CheckDirectory r $testsDirectory $testDirError
-    } else {
-	return -code error \
-		"$testDirError \"$testsDirectory\" does not exist"
-    }
-
-    normalizePath testsDirectory
-}
-
 # tcltest::interpreter --
 #
 #	the interpreter name stored in tcltest::tcltest
@@ -1242,15 +1230,6 @@ proc tcltest::DefineConstraintInitializers {} {
 # Handle command line arguments (from argv) and default arg settings
 # (in TCLTEST_OPTIONS).
 
-# tcltest::PrintUsageInfoHook
-#
-#       Hook used for customization of display of usage information.
-#
-
-if {[llength [info commands tcltest::PrintUsageInfoHook]] == 0} {
-    proc tcltest::PrintUsageInfoHook {} {}
-}
-
 # tcltest::PrintUsageInfo
 #
 #	Prints out the usage information for package tcltest.  This can
@@ -1265,93 +1244,54 @@ if {[llength [info commands tcltest::PrintUsageInfoHook]] == 0} {
 # Side Effects:
 #       none
 proc tcltest::PrintUsageInfo {} {
-    puts "Usage: [file tail [info nameofexecutable]]\
-	script ?-help? ?flag value? ... \n\
-	Available flags (and valid input values) are:\n\
-	-help          		 Display this usage information.\n\
-	-verbose level 		 Takes any combination of the values\n\
-	\t                 'p', 's', 'b', 't' and 'e'. \
-			   Test suite will\n\
-	\t                 display all passed tests if 'p' is\n\
-	\t                 specified, all skipped tests if 's'\n\
-	\t                 is specified, the bodies of\n\
-	\t                 failed tests if 'b' is specified,\n\
-	\t                 and when tests start if 't' is specified.\n\
-	\t                 ErrorInfo is displayed\
-			   if 'e' is specified.\n\
-	\t                 The default value is 'b'.\n\
-	-constraints list	 Do not skip the listed constraints\n\
-	-limitconstraints bool	 Only run tests with the constraints\n\
-	\t                 listed in -constraints.\n\
-	-match pattern 		 Run all tests within the specified\n\
-	\t                 files that match the glob pattern\n\
-	\t                 given.\n\
-	-skip pattern  		 Skip all tests within the set of\n\
-	\t                 specified tests (via -match) and\n\
-	\t                 files that match the glob pattern\n\
-	\t                 given.\n\
-	-file pattern  		 Run tests in all test files that\n\
-	\t                 match the glob pattern given.\n\
-	-notfile pattern	 Skip all test files that match the\n\
-	\t                 glob pattern given.\n\
-	-relateddir pattern	 Run tests in directories that match\n\
-	\t                 the glob pattern given.\n\
-	-asidefromdir pattern	 Skip tests in directories that match\n\
-	\t                 the glob pattern given.\n\
-	-preservecore level 	 If 2, save any core files produced\n\
-	\t                 during testing in the directory\n\
-	\t                 specified by -tmpdir. If 1, notify the\n\
-	\t                 user if core files are created. \
-			   The default\n\
-	\t                 is [preserveCore].\n\
-	-tmpdir directory	 Save temporary files\
-			   in the specified\n\
-	\t                 directory.  The default value is\n\
-	\t                 [temporaryDirectory]\n\
-	-testdir directories	 Search tests in the specified\n\
-	\t                 directories.  The default value is\n\
-	\t                 [testsDirectory].\n\
-	-outfile file    	 Send output from test runs to the\n\
-	\t                 specified file.  The default is\n\
-	\t                 stdout.\n\
-	-errfile file    	 Send errors from test runs to the\n\
-	\t                 specified file.  The default is\n\
-	\t                 stderr.\n\
-	-loadfile file   	 Read the script to load the tested\n\
-	\t                 commands from the specified file.\n\
-	-load script     	 Specifies the script\
-			   to load the tested\n\
-	\t                 commands.\n\
-	-debug level     	 Internal debug flag."
+    puts [Usage]
     PrintUsageInfoHook
-    return
 }
 
-# tcltest::processCmdLineArgsFlagsHook --
-#
-#	This hook is used to add to the list of command line arguments
-#	that are processed by tcltest::ProcessFlags.   It is called at
-#	the beginning of ProcessFlags.
-#
-
-if {[llength [info commands \
-	tcltest::processCmdLineArgsAddFlagsHook]] == 0} {
-    proc tcltest::processCmdLineArgsAddFlagsHook {} {}
+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]
+	    foreach [list x type($opt) usage($opt)] $foo break
+	    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 {[string equal -help $option]} {
+	return [list -help "" "Display this usage information."]
+    } else {
+	set type [lindex [info args $Verify($option)] 0]
+	return [list $option $type $Usage($option)]
+    }
 }
 
-# tcltest::processCmdLineArgsHook --
-#
-#	This hook is used to actually process the flags added by
-#       tcltest::processCmdLineArgsAddFlagsHook.  It is called at the
-#	end of ProcessFlags.
-#
-# Arguments:
-#	flags      The flags that have been pulled out of argv
-#
-
-if {[llength [info commands tcltest::processCmdLineArgsHook]] == 0} {
-    proc tcltest::processCmdLineArgsHook {flag} {}
-}
 
 # tcltest::ProcessFlags --
 #
@@ -1376,125 +1316,39 @@ proc tcltest::ProcessFlags {flagArray} {
 	exit 1
     }
 
-    catch {array set flag $flagArray}
-
-    # -help is not listed since it has already been processed
-    lappend defaultFlags -verbose -match -skip -constraints \
-	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints -testdir \
-	    -load -loadfile -asidefromdir \
-	    -relateddir -singleproc
-    set defaultFlags \
-	    [concat $defaultFlags [processCmdLineArgsAddFlagsHook]]
-
-    # Set verbose to the arg of the -verbose flag, if given
-    if {[info exists flag(-verbose)]} {
-	verbose $flag(-verbose)
-    }
-
-    # Set match to the arg of the -match flag, if given.
-    if {[info exists flag(-match)]} {
-	match $flag(-match)
-    }
-
-    # Set skip to the arg of the -skip flag, if given
-    if {[info exists flag(-skip)]} {
-	skip $flag(-skip)
-    }
-
-    # Handle the -file and -notfile flags
-    if {[info exists flag(-file)]} {
-	matchFiles $flag(-file)
-    }
-    if {[info exists flag(-notfile)]} {
-	skipFiles $flag(-notfile)
-    }
-
-    # Handle -relateddir and -asidefromdir flags
-    if {[info exists flag(-relateddir)]} {
-	matchDirectories $flag(-relateddir)
-    }
-    if {[info exists flag(-asidefromdir)]} {
-	skipDirectories $flag(-asidefromdir)
-    }
-
-    # Use the -constraints flag, if given, to turn on constraints that
-    # are turned off by default: userInteractive knownBug nonPortable.
-
-    if {[info exists flag(-constraints)]} {
-	foreach elt $flag(-constraints) {
-	    testConstraint $elt 1
-	}
-	ConstraintsSpecifiedByCommandLineArgument $flag(-constraints)
-    }
+    if {[llength $flagArray] == 0} {
+	RemoveAutoConfigureTraces
+    } else {
+	set args $flagArray
+	while {[llength $args] && [catch {eval 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
+		if {[lsearch -exact \
+			[processCmdLineArgsAddFlagHook] $option] == -1} {
+		    # Nope.  Report the error, but keep going
+		    puts [errorChannel] "WARNING: $msg"
+		}
+	    } else {
+		# error is something other than "unknown option"
+		# notify user of the error; and exit
+		puts [errorChannel] $msg
+		exit 1
+	    }
 
-    # Use the -limitconstraints flag, if given, to tell the harness to
-    # limit tests run to those that were specified using the
-    # -constraints flag.  If the -constraints flag was not specified,
-    # print out an error and exit.
-    if {[info exists flag(-limitconstraints)]} {
-	if {![info exists flag(-constraints)]} {
-	    error "-limitconstraints flag can only\
-		    be used with -constraints"
+	    # To recover, find that unknown option and remove up to it.
+	    # then retry
+	    while {![string equal [lindex $args 0] $option]} {
+		set args [lrange $args 2 end]
+	    }
+	    set args [lrange $args 2 end]
 	}
-	limitConstraints $flag(-limitconstraints)
-    }
-
-    # Set the temporaryDirectory to the arg of -tmpdir, if given.
-
-    if {[info exists flag(-tmpdir)]} {
-	temporaryDirectory $flag(-tmpdir)
-    }
-
-    # Set the testsDirectory to the arg of -testdir, if given.
-
-    if {[info exists flag(-testdir)]} {
-	testsDirectory $flag(-testdir)
-    }
-
-    # If an alternate error or output files are specified, change the
-    # default channels.
-
-    if {[info exists flag(-outfile)]} {
-	outputFile $flag(-outfile)
-    }
-
-    if {[info exists flag(-errfile)]} {
-	errorFile $flag(-errfile)
-    }
-
-    # If a load script was specified, either directly or through
-    # a file, remember it for later usage.
-
-    if {[info exists flag(-load)] &&  \
-	    ([lsearch -exact $flagArray -load] > \
-		[lsearch -exact $flagArray -loadfile])} {
-	loadScript $flag(-load)
-    }
-
-    if {[info exists flag(-loadfile)] && \
-	    ([lsearch -exact $flagArray -loadfile] > \
-		[lsearch -exact $flagArray -load]) } {
-	loadFile $flag(-loadfile)
-    }
-
-    # If the user specifies debug testing, print out extra information
-    # during the run.
-    if {[info exists flag(-debug)]} {
-	debug $flag(-debug)
-    }
-
-    # Handle -preservecore
-    if {[info exists flag(-preservecore)]} {
-	preserveCore $flag(-preservecore)
-    }
-
-    # Handle -singleproc flag
-    if {[info exists flag(-singleproc)]} {
-	singleProcess $flag(-singleproc)
     }
 
     # Call the hook
+    array set flag $flagArray
     processCmdLineArgsHook [array get flag]
     return
 }
@@ -1898,6 +1752,7 @@ proc tcltest::test {name description args} {
     variable testLevel
     DebugPuts 3 "test $name $args"
 
+    FillFilesExisted
     incr testLevel
 
     # Pre-define everything to null except output and errorOutput.  We
@@ -2239,8 +2094,6 @@ proc tcltest::RunTest {
 } {
     variable testLevel
     variable numTests
-    variable skip
-    variable match
     variable testConstraints
     variable originalTclPlatform
     variable coreModTime
@@ -2250,7 +2103,7 @@ proc tcltest::RunTest {
     }
 
     # skip the test if it's name matches an element of skip
-    foreach pattern $skip {
+    foreach pattern [skip] {
 	if {[string match $pattern $name]} {
 	    if {$testLevel == 1} {
 		incr numTests(Skipped)
@@ -2261,9 +2114,9 @@ proc tcltest::RunTest {
     }
 
     # skip the test if it's name doesn't match any element of match
-    if {[llength $match] > 0} {
+    if {[llength [match]] > 0} {
 	set ok 0
-	foreach pattern $match {
+	foreach pattern [match] {
 	    if {[string match $pattern $name]} {
 		set ok 1
 		break
@@ -2417,6 +2270,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
     variable originalTclPlatform
     variable coreModTime
 
+    FillFilesExisted
     set testFileName [file tail [info script]]
 
     # Call the cleanup hook
@@ -2651,7 +2505,7 @@ proc tcltest::GetMatchingFiles { {searchDirectory ""} } {
 	    set matchFileList [concat $matchFileList \
 		    [glob -directory $directory -nocomplain -- $match]]
 	}
-	if {[string compare {} $tcltest::skipFiles]} {
+	if {[string compare {} [skipFiles]]} {
 	    set skipFileList {}
 	    foreach skip [skipFiles] {
 		set skipFileList [concat $skipFileList \
@@ -2749,12 +2603,12 @@ proc tcltest::GetMatchingDirectories {rootdir} {
 #	None.
 
 proc tcltest::runAllTests { {shell ""} } {
-    global argv
     variable testSingleFile
     variable numTestFiles
     variable numTests
     variable failFiles
 
+    FillFilesExisted
     if {[llength [info level 0]] == 1} {
 	set shell [interpreter]
     }
@@ -2807,12 +2661,21 @@ proc tcltest::runAllTests { {shell ""} } {
     foreach file [lsort [GetMatchingFiles]] {
 	set tail [file tail $file]
 	puts [outputChannel] $tail
+	flush [outputChannel]
 
 	if {[singleProcess]} {
 	    incr numTestFiles
 	    uplevel 1 [list ::source $file]
 	} else {
-	    set cmd [linsert $argv 0 | $shell $file]
+	    # 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 {[string equal $opt -outfile]} {continue}
+		lappend childargv $opt [Configure $opt]
+	    }
+	    set cmd [linsert $childargv 0 | $shell $file]
 	    if {[catch {
 		incr numTestFiles
 		set pipeFd [open $cmd "r"]
@@ -3007,6 +2870,7 @@ proc tcltest::normalizeMsg {msg} {
 proc tcltest::makeFile {contents name {directory ""}} {
     global tcl_platform
     variable filesMade
+    FillFilesExisted
 
     if {[llength [info level 0]] == 3} {
 	set directory [temporaryDirectory]
@@ -3049,6 +2913,7 @@ proc tcltest::makeFile {contents name {directory ""}} {
 #	None.
 
 proc tcltest::removeFile {name {directory ""}} {
+    FillFilesExisted
     if {[llength [info level 0]] == 2} {
 	set directory [temporaryDirectory]
     }
@@ -3077,6 +2942,7 @@ proc tcltest::removeFile {name {directory ""}} {
 
 proc tcltest::makeDirectory {name {directory ""}} {
     variable filesMade
+    FillFilesExisted
     if {[llength [info level 0]] == 2} {
 	set directory [temporaryDirectory]
     }
@@ -3104,6 +2970,7 @@ proc tcltest::makeDirectory {name {directory ""}} {
 #	None
 
 proc tcltest::removeDirectory {name {directory ""}} {
+    FillFilesExisted
     if {[llength [info level 0]] == 2} {
 	set directory [temporaryDirectory]
     }
@@ -3128,6 +2995,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
 
 proc tcltest::viewFile {name {directory ""}} {
     global tcl_platform
+    FillFilesExisted
     if {[llength [info level 0]] == 2} {
 	set directory [temporaryDirectory]
     }
@@ -3348,21 +3216,47 @@ namespace eval tcltest {
     } else {
 	proc initConstraintsHook {} {}
     }
-    ProcessCmdLineArgs
-
-    # Save the names of files that already exist in
-    # the output directory.
-    variable file {}
-    foreach file [glob -nocomplain -directory [temporaryDirectory] *] {
-	lappend filesExisted [file tail $file]
-    }
 
     # Define the standard match commands
     customMatch exact	[list string equal]
     customMatch glob	[list string match]
     customMatch regexp	[list regexp --]
-    unset file
-}
 
-package provide tcltest 2.1
+    proc LoadTimeConfigurationRequired {} {
+	set required false
+	if {[info exists ::env(TCLTEST_OPTIONS)]} {
+	    # Respect the environment variable at package load time,
+	    # so that it effectively establishes new defaults.
+	    set required true
+	}
+	if {[info exists ::argv] && [lsearch -exact $::argv -help]} {
+	    # 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
+			processCmdLineArgsAddFlagHook } {
+	    if {[string equal [namespace current] [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.
+    # Traves are established for auto-configuration from the command line
+    # if any configurable options are accessed before the user calls
+    # [configure].
+    if {[LoadTimeConfigurationRequired]} {
+	ProcessCmdLineArgs
+    } else {
+	EstablishAutoConfigureTraces
+    }
+
+    package provide [namespace tail [namespace current]] $Version
+}
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 2c597bc..80e6338 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: parseOld.test,v 1.10 2001/08/02 01:20:05 hobbs Exp $
+# RCS: @(#) $Id: parseOld.test,v 1.11 2002/06/25 01:13:38 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -23,6 +23,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 tcltest::testConstraint testwordend \
 	[string equal "testwordend" [info commands testwordend]]
 
+# Save the argv value for restoration later
+set savedArgv $argv
+
 proc fourArgs {a b c d} {
     global arg1 arg2 arg3 arg4
     set arg1 $a
@@ -536,6 +539,7 @@ test parseOld-15.5 {TclScriptEnd procedure} {
 } {0}
 
 # cleanup
+set argv $savedArgv
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 7bfdb66..0e4b36c 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -6,7 +6,7 @@
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.26 2002/06/07 19:48:41 dgp Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.27 2002/06/25 01:13:38 dgp Exp $
 
 # Note that there are several places where the value of 
 # tcltest::currentFailure is stored/reset in the -setup/-cleanup
@@ -64,7 +64,7 @@ test tcltest-1.2 {tcltest -help -something} {unixOrPc} {
 test tcltest-1.3 {tcltest -h} {unixOrPc} {
     set result [catch {exec [interpreter] test.tcl -h} msg]
     list $result [regexp Usage $msg]
-} {0 0} 
+} {1 0} 
 
 # -verbose, implicit & explicit testing of [verbose]
 test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
@@ -141,7 +141,7 @@ test tcltest-2.7 {tcltest::verbose}  {
 	verbose $oldVerbosity
 	list $currentVerbosity $newVerbosity 
     }
-    -result {{body a r} {f o o}}
+    -result {body {}}
 }
 
 test tcltest-2.8 {tcltest -verbose 'error'} {
@@ -497,12 +497,10 @@ test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
     -constraints unixOrPc
     -body {
 	catch {exec [interpreter] a.tcl -tmpdir thisdirectoryisafile} msg
-	# The join is necessary because the message can be split on multiple
-	# lines 
-	join $msg
+	set msg
     }
-    -result {not a directory}
-    -match regexp
+    -result {*not a directory*}
+    -match glob
 }
 
 # Test non-writeable directories, non-readable directories with directory flags
@@ -524,14 +522,12 @@ switch $tcl_platform(platform) {
 
 test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
     catch {exec [interpreter] a.tcl -tmpdir $notReadableDir} msg 
-    # The join is necessary because the message can be split on multiple lines
-    list [regexp {not readable} [join $msg]]
+    string match {*not readable*} $msg
 } {1}
 
 test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
     catch {exec [interpreter] a.tcl -tmpdir $notWriteableDir} msg
-    # The join is necessary because the message can be split on multiple lines
-    list [regexp {not writeable} [join $msg]]
+    string match {*not writeable*} $msg
 } {1}
 
 test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
@@ -576,19 +572,17 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
 test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
     file delete -force thisdirectorydoesnotexist
     catch {exec [interpreter] a.tcl -testdir thisdirectorydoesnotexist}  msg
-    list [regexp "does not exist" [join $msg]]
+    string match "*does not exist*" $msg
 } {1}
 
 test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
     catch {exec [interpreter] a.tcl -testdir thisdirectoryisafile} msg
-    # The join is necessary because the message can be split on multiple lines
-    list [regexp "not a directory" [join $msg]] 
+    string match "*not a directory*" $msg 
 } {1}
 
 test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
     catch {exec [interpreter] a.tcl -testdir $notReadableDir} msg 
-    # The join is necessary because the message can be split on multiple lines
-    list [regexp {not readable} [join $msg]]
+    string match {*not readable*} $msg
 } {1}
 
 
@@ -733,16 +727,19 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
 	    [regexp "core-" $msg] [file delete core-makecore]
 } {1 1 1 {}}
 
-test tcltest-10.5 {preserveCore} {
-    -body {
-	set old [preserveCore]
-	set result [preserveCore foo]
-	set result2 [preserveCore]
-	preserveCore $old
-	list $result $result2
-    }
-    -result {foo foo}
-}
+# Removing this test.  It makes no sense to test the ability of
+# [preserveCore] to accept an invalid value that will cause errors
+# in other parts of tcltests' operation.
+#test tcltest-10.5 {preserveCore} {
+#    -body {
+#	set old [preserveCore]
+#	set result [preserveCore foo]
+#	set result2 [preserveCore]
+#	preserveCore $old
+#	list $result $result2
+#    }
+#    -result {foo foo}
+#}
 
 # -load, -loadfile, [loadScript], [loadFile]
 set loadfile [makeFile { 
@@ -1005,7 +1002,7 @@ test tcltest-15.7 {skipDirectories} {
 
 # TCLTEST_OPTIONS
 test tcltest-19.1 {TCLTEST_OPTIONS default} {
-    -constraints {unixOrPc}
+    -constraints {unixOrPc singleTestInterp}
     -setup {
 	if {[info exists ::env(TCLTEST_OPTIONS)]} {
 	    set oldoptions $::env(TCLTEST_OPTIONS)