* Corrected faulty variable initialization. [Bug 534845]

1 files changed, 47 insertions, 110 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 6cb60c3..87cb023 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -13,7 +13,7 @@
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.39 2002/03/25 19:20:03 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.40 2002/03/25 20:55:16 dgp Exp $
 
 # create the "tcltest" namespace for all testing variables and procedures
 
@@ -35,54 +35,36 @@ namespace eval tcltest {
 	namespace export $proc
     }
 
-    # tcltest::verbose defaults to {body}
-    if {![info exists verbose]} {
-	variable verbose {body}
+    proc Default {varName value} {
+	variable $varName
+	if {![info exists $varName]} {
+	    variable $varName $value
+	}
     }
 
+    # tcltest::verbose defaults to {body}
+    Default verbose body
+
     # Match and skip patterns default to the empty list, except for
     # matchFiles, which defaults to all .test files in the testsDirectory and
     # matchDirectories, which defaults to all directories.
-
-    if {![info exists match]} {
-	variable match {}
-    }
-    if {![info exists skip]} {
-	variable skip {}
-    }
-    if {![info exists matchFiles]} {
-	variable matchFiles {*.test}
-    }
-    if {![info exists skipFiles]} {
-	variable skipFiles {}
-    }
-    if {![info exists matchDirectories]} {
-	variable matchDirectories {*}
-    }
-    if {![info exists skipDirectories]} {
-	variable skipDirectories {}
-    }
+    Default match {}
+    Default skip {}
+    Default matchFiles {*.test}
+    Default skipFiles {}
+    Default matchDirectories {*}
+    Default skipDirectories {}
 
     # By default, don't save core files
-    if {![info exists preserveCore]} {
-	variable preserveCore 0
-    }
+    Default preserveCore 0
 
     # output goes to stdout by default
-    if {![info exists outputChannel]} {
-	variable outputChannel stdout
-    }
-    if {![info exists outputFile]} {
-	variable outputFile stdout
-    }
+    Default outputChannel stdout
+    Default outputFile stdout
 
     # errors go to stderr by default
-    if {![info exists errorChannel]} {
-	variable errorChannel stderr
-    }
-    if {![info exists errorFile]} {
-	variable errorFile stderr
-    }
+    Default errorChannel stderr
+    Default errorFile stderr
 
     # debug output doesn't get printed by default; debug level 1 spits
     # up only the tests that were skipped because they didn't match or were 
@@ -90,15 +72,11 @@ namespace eval 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
-    }
+    Default 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 {}
-    }
+    Default parameters {}
 
     # Count the number of files tested (0 if runAllTests wasn't called).
     # runAllTests will set testSingleFile to false, so stats will
@@ -106,37 +84,23 @@ 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.
-
-    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 {}
-    }
+    Default numTestFiles 0
+    Default testSingleFile true
+    Default currentFailure false
+    Default failFiles {}
 
     # Tests should remove all files they create.  The test suite will
     # check the current working dir for files created by the tests.
     # tcltest::filesMade keeps track of such files created using the
     # tcltest::makeFile and tcltest::makeDirectory procedures.
     # tcltest::filesExisted stores the names of pre-existing files.
-
-    if {![info exists filesMade]} {
-	variable filesMade {}
-    }
-    if {![info exists filesExisted]} {
-	variable filesExisted {}
-    }
+    Default filesMade {}
+    Default filesExisted {}
 
     # tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
 
-    if {![info exists createdNewFiles]} {
+    if {![info exists [namespace current]::createdNewFiles]} {
 	variable createdNewFiles
 	array set tcltest::createdNewFiles {}
     }
@@ -144,7 +108,7 @@ namespace eval tcltest {
     # initialize tcltest::numTests array to keep track fo the number of
     # tests that pass, fail, and are skipped.
 
-    if {![info exists numTests]} {
+    if {![info exists [namespace current]::numTests]} {
 	variable numTests
 	array set tcltest::numTests \
 		[list Total 0 Passed 0 Skipped 0 Failed	0] 
@@ -158,7 +122,7 @@ namespace eval tcltest {
     # both of these constraints are counted only if tcltest::debug is set to
     # true. 
 
-    if {![info exists skippedBecause]} {
+    if {![info exists [namespace current]::skippedBecause]} {
 	variable skippedBecause
 	array set tcltest::skippedBecause {}
     }
@@ -167,36 +131,25 @@ namespace eval tcltest {
     # predefined constraints (see the explanation for the
     # tcltest::initConstraints proc for more details).
 
-    if {![info exists testConstraints]} {
+    if {![info exists [namespace current]::testConstraints]} {
 	variable testConstraints
 	array set tcltest::testConstraints {}
     }
-
-    if {![info exists constraintsSpecified]} {
-	variable constraintsSpecified {}
-    }
+    Default constraintsSpecified {}
 
     # Don't run only the constrained tests by default
-
-    if {![info exists limitConstraints]} {
-	variable limitConstraints false
-    }
+    Default limitConstraints false
 
     # A test application has to know how to load the tested commands into
     # the interpreter.
-
-    if {![info exists loadScript]} {
-	variable loadScript {}
-    }
+    Default loadScript {}
 
     # and the filename of the script file, if it exists
-    if {![info exists loadFile]} {
-	variable loadFile {}
-    }
+    Default loadFile {}
 
     # tests that use threads need to know which is the main thread
 
-    if {![info exists mainThread]} {
+    if {![info exists [namespace current]::mainThread]} {
 	variable mainThread 1
 	if {[info commands thread::id] != {}} {
 	    set mainThread [thread::id]
@@ -207,7 +160,7 @@ namespace eval tcltest {
 
     # save the original environment so that it can be restored later
     
-    if {![info exists originalEnv]} {
+    if {![info exists [namespace current]::originalEnv]} {
 	variable originalEnv
 	array set tcltest::originalEnv [array get ::env]
     }
@@ -215,18 +168,14 @@ namespace eval tcltest {
     # Set tcltest::workingDirectory to [pwd]. The default output directory
     # for Tcl tests is the working directory.
 
-    if {![info exists workingDirectory]} {
-	variable workingDirectory [pwd]
-    }
-    if {![info exists temporaryDirectory]} {
-	variable temporaryDirectory $workingDirectory
-    }
+    Default workingDirectory [pwd]
+    Default temporaryDirectory $workingDirectory
 
     # Tests should not rely on the current working directory.
     # Files that are part of the test suite should be accessed relative to 
     # tcltest::testsDirectory.
 
-    if {![info exists testsDirectory]} {
+    if {![info exists [namespace current]::testsDirectory]} {
 	set oldpwd [pwd]
 	catch {cd [file join [file dirname [info script]] .. .. tests]}
 	variable testsDirectory [pwd]
@@ -235,15 +184,11 @@ namespace eval tcltest {
     }
 
     # Default is to run each test file in a separate process
-    if {![info exists singleProcess]} {
-	variable singleProcess 0
-    }
+    Default singleProcess 0
 
     # the variables and procs that existed when tcltest::saveState was
     # called are stored in a variable of the same name
-    if {![info exists saveState]} {
-	variable saveState {}
-    }
+    Default saveState {}
 
     # Internationalization support -- used in tcltest::set_iso8859_1_locale
     # and tcltest::restore_locale. Those commands are used in cmdIL.test.
@@ -286,14 +231,10 @@ namespace eval tcltest {
     }
 
     # Set the location of the execuatble
-    if {![info exists tcltest]} {
-	variable tcltest [info nameofexecutable]
-    }	
+    Default tcltest [info nameofexecutable]
 
     # save the platform information so it can be restored later
-    if {![info exists originalTclPlatform]} {
-	variable originalTclPlatform [array get tcl_platform]
-    }
+    Default originalTclPlatform [array get tcl_platform]
 
     # If a core file exists, save its modification time.
     if {![info exists coreModificationTime]} {
@@ -304,12 +245,8 @@ namespace eval tcltest {
     }
 
     # stdout and stderr buffers for use when we want to store them
-    if {![info exists outData]} {
-	variable outData {}
-    }
-    if {![info exists errData]} {
-	variable errData {}
-    }
+    Default outData {}
+    Default errData {}
 
     # keep track of test level for nested test commands
     variable testLevel 0