* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a

variable named ::tcltest::parameters based on whatever's being
sent in as the argument to the -args flag.  Modified tcltest so
that tcltest namespace variables are only initialized to their
default values if they did not previously exist.  Modified the
::tcltest::testConstraints variable so that it isn't unset every
time ::tcltest::initConstraints is called.  Modified command line
processing so that they are only processed if ::tcltest doesn't
have a child namespace (if there is a child namespace, then the
command line arguments *must* be processed in that namespace).

2 files changed, 300 insertions, 146 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 039c560..dd2f175 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -12,7 +12,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.9 1999/07/30 01:35:27 jenn Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.9.4.1 1999/09/22 21:05:50 jenn Exp $
 
 package provide tcltest 1.0
 
@@ -26,43 +26,62 @@ namespace eval tcltest {
     # Export the public tcltest procs
     set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingTestFiles]
+	    viewFile bytestring safeFetch threadReap getMatchingFiles]
     foreach proc $procList {
 	namespace export $proc
     }
 
     # ::tcltest::verbose defaults to "b"
-
-    variable verbose "b"
+    if {![info exists verbose]} {
+	variable verbose "b"
+    }
 
     # Match and skip patterns default to the empty list, except for
     # matchFiles, which defaults to all .test files in the testsDirectory
 
-    variable match {}
-    variable skip {}
-
-    variable matchFiles {*.test}
-    variable skipFiles {}
+    if {![info exists match]} {
+	variable match {}
+    }
+    if {![info exists skip]} {
+	variable skip {}
+    }
+    if {![info exists matchFiles]} {
+	variable matchFiles {*.test}
+    }
+    if {![info exists skipFiles]} {
+	variable skipFiles {}
+    }
 
     # By default, don't save core files
-    variable preserveCore 0
+    if {![info exists preserveCore]} {
+	variable preserveCore 0
+    }
 
     # output goes to stdout by default
-
-    variable outputChannel stdout
+    if {![info exists outputChannel]} {
+	variable outputChannel stdout
+    }
 
     # errors go to stderr by default
-
-    variable errorChannel stderr
+    if {![info exists errorChannel]} {
+	variable errorChannel stderr
+    }
 
     # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tets that were skipped because they didn't match or were 
+    # up only the tests that were skipped because they didn't match or were 
     # specifically skipped.  A debug level of 2 would spit up the tcltest
     # variables and flags provided; a debug level of 3 causes some additional
     # output regarding operations of the test harness.  The tcltest package
     # currently implements only up to debug level 3.
+    if {![info exists debug]} {
+	variable debug 0
+    }
 
-    variable debug 0
+    # Save any arguments that we might want to pass through to other programs. 
+    # This is used by the -args flag.
+    if {![info exists parameters]} {
+	variable parameters {}
+    }
 
     # Count the number of files tested (0 if all.tcl wasn't called).
     # The all.tcl file will set testSingleFile to false, so stats will
@@ -71,10 +90,18 @@ namespace eval tcltest {
     # current test file has had any failures.  The failFiles list
     # stores the names of test files that had failures.
 
-    variable numTestFiles 0
-    variable testSingleFile true
-    variable currentFailure false
-    variable failFiles {}
+    if {![info exists numTestFiles]} {
+	variable numTestFiles 0
+    }
+    if {![info exists testSingleFile]} {
+	variable testSingleFile true
+    }
+    if {![info exists currentFailure]} {
+	variable currentFailure false
+    }
+    if {![info exists failFiles]} {
+	variable failFiles {}
+    }
 
     # Tests should remove all files they create.  The test suite will
     # check the current working dir for files created by the tests.
@@ -82,18 +109,29 @@ namespace eval tcltest {
     # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
     # ::tcltest::filesExisted stores the names of pre-existing files.
 
-    variable filesMade {}
-    variable filesExisted {}
+    if {![info exists filesMade]} {
+	variable filesMade {}
+    }
+    if {![info exists filesExisted]} {
+	variable filesExisted {}
+    }
 
     # ::tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
 
-    array set ::tcltest::createdNewFiles {}
+    if {![info exists createdNewFiles]} {
+	variable createdNewFiles
+	array set ::tcltest::createdNewFiles {}
+    }
 
     # initialize ::tcltest::numTests array to keep track fo the number of
-    # tests that pass, fial, and are skipped.
+    # tests that pass, fail, and are skipped.
 
-    array set ::tcltest::numTests [list Total 0 Passed 0 Skipped 0 Failed 0] 
+    if {![info exists numTests]} {
+	variable numTests
+	array set ::tcltest::numTests \
+		[list Total 0 Passed 0 Skipped 0 Failed	0] 
+    }
 
     # initialize ::tcltest::skippedBecause array to keep track of
     # constraints that kept tests from running; a constraint name of
@@ -103,49 +141,70 @@ namespace eval tcltest {
     # both of these constraints are counted only if ::tcltest::debug is set to
     # true. 
 
-    array set ::tcltest::skippedBecause {}
+    if {![info exists skippedBecause]} {
+	variable skippedBecause
+	array set ::tcltest::skippedBecause {}
+    }
 
     # initialize the ::tcltest::testConstraints array to keep track of valid
     # predefined constraints (see the explanation for the
     # ::tcltest::initConstraints proc for more details).
 
-    array set ::tcltest::testConstraints {}
+    if {![info exists testConstraints]} {
+	variable testConstraints
+	array set ::tcltest::testConstraints {}
+    }
 
     # Don't run only the constrained tests by default
-    variable limitConstraints false
+    if {![info exists limitConstraints]} {
+	variable limitConstraints false
+    }
 
-    # tests that use thread need to know which is the main thread
+    # tests that use threads need to know which is the main thread
 
-    variable mainThread 1
-    if {[info commands testthread] != {}} {
-	set mainThread [testthread names]
+    if {![info exists mainThread]} {
+	variable mainThread 1
+	if {[info commands testthread] != {}} {
+	    set mainThread [testthread names]
+	}
     }
 
     # save the original environment so that it can be restored later
     
-    array set ::tcltest::originalEnv [array get ::env]
+    if {![info exists originalEnv]} {
+	variable originalEnv
+	array set ::tcltest::originalEnv [array get ::env]
+    }
 
     # Set ::tcltest::workingDirectory to [pwd]. The default output directory
     # for Tcl tests is the working directory.
 
-    variable workingDirectory [pwd]
-    variable temporaryDirectory $workingDirectory
+    if {![info exists workingDirectory]} {
+	variable workingDirectory [pwd]
+    }
+    if {![info exists temporaryDirectory]} {
+	variable temporaryDirectory $workingDirectory
+    }
 
     # Tests should not rely on the current working directory.
     # Files that are part of the test suite should be accessed relative to 
     # ::tcltest::testsDirectory.
 
-    set oDir [pwd]
-    catch {cd [file join [file dirname [info script]] .. .. tests]}
-    variable testsDirectory [pwd]
-    cd $oDir
+    if {![info exists testsDirectory]} {
+	set oDir [pwd]
+	catch {cd [file join [file dirname [info script]] .. .. tests]}
+	variable testsDirectory [pwd]
+	cd $oDir
+    }
 
     # the variables and procs that existed when ::tcltest::saveState was
     # called are stored in a variable of the same name
-    variable saveState {}
+    if {![info exists saveState]} {
+	variable saveState {}
+    }
 
     # Internationalization support
-    if {![info exists ::tcltest::isoLocale]} {
+    if {![info exists isoLocale]} {
 	variable isoLocale fr
         switch $tcl_platform(platform) {
 	    "unix" {
@@ -180,18 +239,22 @@ namespace eval tcltest {
     }
 
     # Set the location of the execuatble
-    variable tcltest [info nameofexecutable]
+    if {![info exists tcltest]} {
+	variable tcltest [info nameofexecutable]
+    }
 
     # save the platform information so it can be restored later
-    variable originalTclPlatform [array get tcl_platform]
-
+    if {![info exists originalTclPlatform]} {
+	variable originalTclPlatform [array get tcl_platform]
+    }
 
     # If a core file exists, save its modification time.
-    if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	variable coreModificationTime [file mtime [file join \
-		$::tcltest::workingDirectory core]]
+    if {![info exists coreModificationTime]} {
+	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	    variable coreModificationTime [file mtime [file join \
+		    $::tcltest::workingDirectory core]]
+	}
     }
-
 }   
 
 # ::tcltest::AddToSkippedBecause --
@@ -207,7 +270,7 @@ namespace eval tcltest {
 #       previously exist - otherwise, it just increments it.
 
 proc ::tcltest::AddToSkippedBecause { constraint } {
-    # add the constraint to the list of constraints the kept tests
+    # add the constraint to the list of constraints that kept tests
     # from running
 
     if {[info exists ::tcltest::skippedBecause($constraint)]} {
@@ -270,7 +333,9 @@ proc ::tcltest::PrintError {errorMsg} {
     return
 }
 
-proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
+    proc ::tcltest::initConstraintsHook {} {}
+}
 
 # ::tcltest::initConstraints --
 #
@@ -291,8 +356,6 @@ proc ::tcltest::initConstraintsHook {} {}
 proc ::tcltest::initConstraints {} {
     global tcl_platform tcl_interactive tk_version
 
-    catch {unset ::tcltest::testConstraints}
-
     # The following trace procedure makes it so that we can safely refer to
     # non-existent members of the ::tcltest::testConstraints array without
     # causing an error.  Instead, reading a non-existent member will return 0.
@@ -339,9 +402,10 @@ proc ::tcltest::initConstraints {} {
     set ::tcltest::testConstraints(win32s) [string equal $tcl_platform(os) \
 	    "Win32s"]
 
-    # 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.
+    # The following Constraints switches are used to mark tests that should
+    # work, but have been temporarily disabled on certain platforms because
+    # they don't and we haven't gotten around to fixing the underlying
+    # problem. 
 
     set ::tcltest::testConstraints(tempNotPc) \
 	    [expr {!$::tcltest::testConstraints(pc)}]
@@ -437,7 +501,7 @@ proc ::tcltest::initConstraints {} {
     # to the "e" format of floating-point numbers.
 
     set ::tcltest::testConstraints(eformat) 1
-    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+    if {![string equal "[format %g 5e-5]" "5e-05"]} {
 	set ::tcltest::testConstraints(eformat) 0
     }
 
@@ -550,7 +614,9 @@ proc ::tcltest::initConstraints {} {
 #       Hook used for customization of display of usage information.
 #
 
-proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
+    proc ::tcltest::PrintUsageInfoHook {} {}
+}
 
 # ::tcltest::PrintUsageInfo
 #
@@ -612,7 +678,9 @@ proc ::tcltest::PrintUsageInfo {} {
 #       processed by ::tcltest::processCmdLineArgs. 
 #
 
-proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+}
 
 # ::tcltest::processCmdLineArgsHook --
 #
@@ -623,7 +691,9 @@ proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
 #	flags      The flags that have been pulled out of argv
 #
 
-proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsHook {flag} {}
+}
 
 # ::tcltest::processCmdLineArgs --
 #
@@ -672,7 +742,7 @@ proc ::tcltest::processCmdLineArgs {} {
     # -help is not listed since it has already been processed
     lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints
+	    -preservecore -limitconstraints -args
     set defaultFlags [concat $defaultFlags \
 	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]
 
@@ -685,6 +755,11 @@ proc ::tcltest::processCmdLineArgs {} {
 	}
     }
 
+    # Set ::tcltest::parameters to the arg of the -args flag, if given
+    if {[info exists flag(-args)]} {
+	set ::tcltest::parameters $flag(-args)
+    }
+
     # Set ::tcltest::verbose to the arg of the -verbose flag, if given
 
     if {[info exists flag(-verbose)]} {
@@ -751,9 +826,9 @@ proc ::tcltest::processCmdLineArgs {} {
     if {[info exists flag(-tmpdir)]} {
 	set ::tcltest::temporaryDirectory $flag(-tmpdir)
 
-	if {[string compare \
+	if {![string equal \
 		[file pathtype $::tcltest::temporaryDirectory] \
-		"absolute"] != 0} { 
+		"absolute"]} { 
 	    set ::tcltest::temporaryDirectory [file join [pwd] \
 		    $::tcltest::temporaryDirectory] 
 	}
@@ -793,7 +868,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-outfile)]} {
 	set tmp $flag(-outfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::outputChannel [open $tmp w]
@@ -801,7 +876,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-errfile)]} {
 	set tmp $flag(-errfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::errorChannel [open $tmp w]
@@ -1050,7 +1125,9 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 #       additional things that should be done at cleanup.
 #
 
-proc ::tcltest::cleanupTestsHook {} {}
+if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
+    proc ::tcltest::cleanupTestsHook {} {}
+}
 
 # test --
 #
@@ -1135,16 +1212,14 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
-
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
 	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
+ 	    regsub -all {[.\w]+} $constraints \
 		    {$::tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
-
 	    set doTest 1
 	    foreach constraint $constraints {
 		if {(![info exists ::tcltest::testConstraints($constraint)]) \
@@ -1191,7 +1266,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     }
 
     set code [catch {uplevel $script} actualAnswer]
-    if {([string compare $actualAnswer $expectedAnswer] == 0) && ($code == 0)} {
+    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
 	incr ::tcltest::numTests(Passed)
 	if {[string first p $::tcltest::verbose] != -1} {
 	    puts $::tcltest::outputChannel "++++ $name PASSED"
@@ -1261,7 +1336,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     }
 }
 
-# ::tcltest::getMatchingTestFiles
+# ::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.
@@ -1379,7 +1454,7 @@ proc ::tcltest::restoreState {} {
 	    if {$::tcltest::debug > 2} {
 		puts "::tcltest::restoreState: Removing variable $p"
 	    }
-	    uplevel #0 "unset $p"
+	    uplevel #0 "catch {unset $p}"
 	}
     }
 }
@@ -1508,7 +1583,7 @@ proc ::tcltest::viewFile {name} {
 # Example:
 #   grep {regexp a} $someList   
 #
-proc ::tcltest:grep { expression searchList } {
+proc ::tcltest::grep { expression searchList } {
     foreach element $searchList {
 	if {[regsub -all CURRENT_ELEMENT $expression $element \
 		newExpression] == 0} { 
@@ -1591,7 +1666,9 @@ proc ::tcltest::threadReap {} {
 # Initialize the constraints and set up command line arguments 
 namespace eval tcltest {
     ::tcltest::initConstraints
-    ::tcltest::processCmdLineArgs
+    if {[namespace children ::tcltest] == {}} {
+	::tcltest::processCmdLineArgs
+    }
 }
 
 return
diff --git a/library/tcltest1.0/tcltest.tcl b/library/tcltest1.0/tcltest.tcl
index 039c560..dd2f175 100644
--- a/library/tcltest1.0/tcltest.tcl
+++ b/library/tcltest1.0/tcltest.tcl
@@ -12,7 +12,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.9 1999/07/30 01:35:27 jenn Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.9.4.1 1999/09/22 21:05:50 jenn Exp $
 
 package provide tcltest 1.0
 
@@ -26,43 +26,62 @@ namespace eval tcltest {
     # Export the public tcltest procs
     set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingTestFiles]
+	    viewFile bytestring safeFetch threadReap getMatchingFiles]
     foreach proc $procList {
 	namespace export $proc
     }
 
     # ::tcltest::verbose defaults to "b"
-
-    variable verbose "b"
+    if {![info exists verbose]} {
+	variable verbose "b"
+    }
 
     # Match and skip patterns default to the empty list, except for
     # matchFiles, which defaults to all .test files in the testsDirectory
 
-    variable match {}
-    variable skip {}
-
-    variable matchFiles {*.test}
-    variable skipFiles {}
+    if {![info exists match]} {
+	variable match {}
+    }
+    if {![info exists skip]} {
+	variable skip {}
+    }
+    if {![info exists matchFiles]} {
+	variable matchFiles {*.test}
+    }
+    if {![info exists skipFiles]} {
+	variable skipFiles {}
+    }
 
     # By default, don't save core files
-    variable preserveCore 0
+    if {![info exists preserveCore]} {
+	variable preserveCore 0
+    }
 
     # output goes to stdout by default
-
-    variable outputChannel stdout
+    if {![info exists outputChannel]} {
+	variable outputChannel stdout
+    }
 
     # errors go to stderr by default
-
-    variable errorChannel stderr
+    if {![info exists errorChannel]} {
+	variable errorChannel stderr
+    }
 
     # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tets that were skipped because they didn't match or were 
+    # up only the tests that were skipped because they didn't match or were 
     # specifically skipped.  A debug level of 2 would spit up the tcltest
     # variables and flags provided; a debug level of 3 causes some additional
     # output regarding operations of the test harness.  The tcltest package
     # currently implements only up to debug level 3.
+    if {![info exists debug]} {
+	variable debug 0
+    }
 
-    variable debug 0
+    # Save any arguments that we might want to pass through to other programs. 
+    # This is used by the -args flag.
+    if {![info exists parameters]} {
+	variable parameters {}
+    }
 
     # Count the number of files tested (0 if all.tcl wasn't called).
     # The all.tcl file will set testSingleFile to false, so stats will
@@ -71,10 +90,18 @@ namespace eval tcltest {
     # current test file has had any failures.  The failFiles list
     # stores the names of test files that had failures.
 
-    variable numTestFiles 0
-    variable testSingleFile true
-    variable currentFailure false
-    variable failFiles {}
+    if {![info exists numTestFiles]} {
+	variable numTestFiles 0
+    }
+    if {![info exists testSingleFile]} {
+	variable testSingleFile true
+    }
+    if {![info exists currentFailure]} {
+	variable currentFailure false
+    }
+    if {![info exists failFiles]} {
+	variable failFiles {}
+    }
 
     # Tests should remove all files they create.  The test suite will
     # check the current working dir for files created by the tests.
@@ -82,18 +109,29 @@ namespace eval tcltest {
     # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
     # ::tcltest::filesExisted stores the names of pre-existing files.
 
-    variable filesMade {}
-    variable filesExisted {}
+    if {![info exists filesMade]} {
+	variable filesMade {}
+    }
+    if {![info exists filesExisted]} {
+	variable filesExisted {}
+    }
 
     # ::tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
 
-    array set ::tcltest::createdNewFiles {}
+    if {![info exists createdNewFiles]} {
+	variable createdNewFiles
+	array set ::tcltest::createdNewFiles {}
+    }
 
     # initialize ::tcltest::numTests array to keep track fo the number of
-    # tests that pass, fial, and are skipped.
+    # tests that pass, fail, and are skipped.
 
-    array set ::tcltest::numTests [list Total 0 Passed 0 Skipped 0 Failed 0] 
+    if {![info exists numTests]} {
+	variable numTests
+	array set ::tcltest::numTests \
+		[list Total 0 Passed 0 Skipped 0 Failed	0] 
+    }
 
     # initialize ::tcltest::skippedBecause array to keep track of
     # constraints that kept tests from running; a constraint name of
@@ -103,49 +141,70 @@ namespace eval tcltest {
     # both of these constraints are counted only if ::tcltest::debug is set to
     # true. 
 
-    array set ::tcltest::skippedBecause {}
+    if {![info exists skippedBecause]} {
+	variable skippedBecause
+	array set ::tcltest::skippedBecause {}
+    }
 
     # initialize the ::tcltest::testConstraints array to keep track of valid
     # predefined constraints (see the explanation for the
     # ::tcltest::initConstraints proc for more details).
 
-    array set ::tcltest::testConstraints {}
+    if {![info exists testConstraints]} {
+	variable testConstraints
+	array set ::tcltest::testConstraints {}
+    }
 
     # Don't run only the constrained tests by default
-    variable limitConstraints false
+    if {![info exists limitConstraints]} {
+	variable limitConstraints false
+    }
 
-    # tests that use thread need to know which is the main thread
+    # tests that use threads need to know which is the main thread
 
-    variable mainThread 1
-    if {[info commands testthread] != {}} {
-	set mainThread [testthread names]
+    if {![info exists mainThread]} {
+	variable mainThread 1
+	if {[info commands testthread] != {}} {
+	    set mainThread [testthread names]
+	}
     }
 
     # save the original environment so that it can be restored later
     
-    array set ::tcltest::originalEnv [array get ::env]
+    if {![info exists originalEnv]} {
+	variable originalEnv
+	array set ::tcltest::originalEnv [array get ::env]
+    }
 
     # Set ::tcltest::workingDirectory to [pwd]. The default output directory
     # for Tcl tests is the working directory.
 
-    variable workingDirectory [pwd]
-    variable temporaryDirectory $workingDirectory
+    if {![info exists workingDirectory]} {
+	variable workingDirectory [pwd]
+    }
+    if {![info exists temporaryDirectory]} {
+	variable temporaryDirectory $workingDirectory
+    }
 
     # Tests should not rely on the current working directory.
     # Files that are part of the test suite should be accessed relative to 
     # ::tcltest::testsDirectory.
 
-    set oDir [pwd]
-    catch {cd [file join [file dirname [info script]] .. .. tests]}
-    variable testsDirectory [pwd]
-    cd $oDir
+    if {![info exists testsDirectory]} {
+	set oDir [pwd]
+	catch {cd [file join [file dirname [info script]] .. .. tests]}
+	variable testsDirectory [pwd]
+	cd $oDir
+    }
 
     # the variables and procs that existed when ::tcltest::saveState was
     # called are stored in a variable of the same name
-    variable saveState {}
+    if {![info exists saveState]} {
+	variable saveState {}
+    }
 
     # Internationalization support
-    if {![info exists ::tcltest::isoLocale]} {
+    if {![info exists isoLocale]} {
 	variable isoLocale fr
         switch $tcl_platform(platform) {
 	    "unix" {
@@ -180,18 +239,22 @@ namespace eval tcltest {
     }
 
     # Set the location of the execuatble
-    variable tcltest [info nameofexecutable]
+    if {![info exists tcltest]} {
+	variable tcltest [info nameofexecutable]
+    }
 
     # save the platform information so it can be restored later
-    variable originalTclPlatform [array get tcl_platform]
-
+    if {![info exists originalTclPlatform]} {
+	variable originalTclPlatform [array get tcl_platform]
+    }
 
     # If a core file exists, save its modification time.
-    if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	variable coreModificationTime [file mtime [file join \
-		$::tcltest::workingDirectory core]]
+    if {![info exists coreModificationTime]} {
+	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	    variable coreModificationTime [file mtime [file join \
+		    $::tcltest::workingDirectory core]]
+	}
     }
-
 }   
 
 # ::tcltest::AddToSkippedBecause --
@@ -207,7 +270,7 @@ namespace eval tcltest {
 #       previously exist - otherwise, it just increments it.
 
 proc ::tcltest::AddToSkippedBecause { constraint } {
-    # add the constraint to the list of constraints the kept tests
+    # add the constraint to the list of constraints that kept tests
     # from running
 
     if {[info exists ::tcltest::skippedBecause($constraint)]} {
@@ -270,7 +333,9 @@ proc ::tcltest::PrintError {errorMsg} {
     return
 }
 
-proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
+    proc ::tcltest::initConstraintsHook {} {}
+}
 
 # ::tcltest::initConstraints --
 #
@@ -291,8 +356,6 @@ proc ::tcltest::initConstraintsHook {} {}
 proc ::tcltest::initConstraints {} {
     global tcl_platform tcl_interactive tk_version
 
-    catch {unset ::tcltest::testConstraints}
-
     # The following trace procedure makes it so that we can safely refer to
     # non-existent members of the ::tcltest::testConstraints array without
     # causing an error.  Instead, reading a non-existent member will return 0.
@@ -339,9 +402,10 @@ proc ::tcltest::initConstraints {} {
     set ::tcltest::testConstraints(win32s) [string equal $tcl_platform(os) \
 	    "Win32s"]
 
-    # 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.
+    # The following Constraints switches are used to mark tests that should
+    # work, but have been temporarily disabled on certain platforms because
+    # they don't and we haven't gotten around to fixing the underlying
+    # problem. 
 
     set ::tcltest::testConstraints(tempNotPc) \
 	    [expr {!$::tcltest::testConstraints(pc)}]
@@ -437,7 +501,7 @@ proc ::tcltest::initConstraints {} {
     # to the "e" format of floating-point numbers.
 
     set ::tcltest::testConstraints(eformat) 1
-    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+    if {![string equal "[format %g 5e-5]" "5e-05"]} {
 	set ::tcltest::testConstraints(eformat) 0
     }
 
@@ -550,7 +614,9 @@ proc ::tcltest::initConstraints {} {
 #       Hook used for customization of display of usage information.
 #
 
-proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
+    proc ::tcltest::PrintUsageInfoHook {} {}
+}
 
 # ::tcltest::PrintUsageInfo
 #
@@ -612,7 +678,9 @@ proc ::tcltest::PrintUsageInfo {} {
 #       processed by ::tcltest::processCmdLineArgs. 
 #
 
-proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+}
 
 # ::tcltest::processCmdLineArgsHook --
 #
@@ -623,7 +691,9 @@ proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
 #	flags      The flags that have been pulled out of argv
 #
 
-proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsHook {flag} {}
+}
 
 # ::tcltest::processCmdLineArgs --
 #
@@ -672,7 +742,7 @@ proc ::tcltest::processCmdLineArgs {} {
     # -help is not listed since it has already been processed
     lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints
+	    -preservecore -limitconstraints -args
     set defaultFlags [concat $defaultFlags \
 	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]
 
@@ -685,6 +755,11 @@ proc ::tcltest::processCmdLineArgs {} {
 	}
     }
 
+    # Set ::tcltest::parameters to the arg of the -args flag, if given
+    if {[info exists flag(-args)]} {
+	set ::tcltest::parameters $flag(-args)
+    }
+
     # Set ::tcltest::verbose to the arg of the -verbose flag, if given
 
     if {[info exists flag(-verbose)]} {
@@ -751,9 +826,9 @@ proc ::tcltest::processCmdLineArgs {} {
     if {[info exists flag(-tmpdir)]} {
 	set ::tcltest::temporaryDirectory $flag(-tmpdir)
 
-	if {[string compare \
+	if {![string equal \
 		[file pathtype $::tcltest::temporaryDirectory] \
-		"absolute"] != 0} { 
+		"absolute"]} { 
 	    set ::tcltest::temporaryDirectory [file join [pwd] \
 		    $::tcltest::temporaryDirectory] 
 	}
@@ -793,7 +868,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-outfile)]} {
 	set tmp $flag(-outfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::outputChannel [open $tmp w]
@@ -801,7 +876,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     if {[info exists flag(-errfile)]} {
 	set tmp $flag(-errfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::errorChannel [open $tmp w]
@@ -1050,7 +1125,9 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 #       additional things that should be done at cleanup.
 #
 
-proc ::tcltest::cleanupTestsHook {} {}
+if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
+    proc ::tcltest::cleanupTestsHook {} {}
+}
 
 # test --
 #
@@ -1135,16 +1212,14 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
-
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
 	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
+ 	    regsub -all {[.\w]+} $constraints \
 		    {$::tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
-
 	    set doTest 1
 	    foreach constraint $constraints {
 		if {(![info exists ::tcltest::testConstraints($constraint)]) \
@@ -1191,7 +1266,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     }
 
     set code [catch {uplevel $script} actualAnswer]
-    if {([string compare $actualAnswer $expectedAnswer] == 0) && ($code == 0)} {
+    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
 	incr ::tcltest::numTests(Passed)
 	if {[string first p $::tcltest::verbose] != -1} {
 	    puts $::tcltest::outputChannel "++++ $name PASSED"
@@ -1261,7 +1336,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     }
 }
 
-# ::tcltest::getMatchingTestFiles
+# ::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.
@@ -1379,7 +1454,7 @@ proc ::tcltest::restoreState {} {
 	    if {$::tcltest::debug > 2} {
 		puts "::tcltest::restoreState: Removing variable $p"
 	    }
-	    uplevel #0 "unset $p"
+	    uplevel #0 "catch {unset $p}"
 	}
     }
 }
@@ -1508,7 +1583,7 @@ proc ::tcltest::viewFile {name} {
 # Example:
 #   grep {regexp a} $someList   
 #
-proc ::tcltest:grep { expression searchList } {
+proc ::tcltest::grep { expression searchList } {
     foreach element $searchList {
 	if {[regsub -all CURRENT_ELEMENT $expression $element \
 		newExpression] == 0} { 
@@ -1591,7 +1666,9 @@ proc ::tcltest::threadReap {} {
 # Initialize the constraints and set up command line arguments 
 namespace eval tcltest {
     ::tcltest::initConstraints
-    ::tcltest::processCmdLineArgs
+    if {[namespace children ::tcltest] == {}} {
+	::tcltest::processCmdLineArgs
+    }
 }
 
 return