Tcl Source Code

Artifact [b79a2be444]
Login

Artifact b79a2be44459af399348fdc6972ebb9c042d996e:

Attachment "960560.patch" to ticket [960560ffff] added by dgp 2004-05-26 22:07:47.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1453.2.260
diff -u -r1.1453.2.260 ChangeLog
--- ChangeLog	25 May 2004 22:50:46 -0000	1.1453.2.260
+++ ChangeLog	26 May 2004 15:01:23 -0000
@@ -1,3 +1,10 @@
+2004-05-26  Don Porter  <[email protected]>
+
+	* library/tcltest/tcltest.tcl:	Correction to debug prints and testing
+	* library/tcltest/pkgIndex.tcl:	if TCLTEST_OPTIONS value.  Updated
+	* tests/tcltest.test:		tcltest-19.1 to tcltest 2.1 behavior.
+					Bumped to tcltest 2.2.6.
+
 2004-05-25  Jeff Hobbs  <[email protected]>
 
 	* doc/http.n (http::config): add -urlencoding option (default utf-8)
Index: library/tcltest/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tcltest/pkgIndex.tcl,v
retrieving revision 1.14.2.3
diff -u -r1.14.2.3 pkgIndex.tcl
--- library/tcltest/pkgIndex.tcl	3 Feb 2004 18:49:29 -0000	1.14.2.3
+++ library/tcltest/pkgIndex.tcl	26 May 2004 15:01:24 -0000
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded tcltest 2.2.5 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.2.6 [list source [file join $dir tcltest.tcl]]
Index: library/tcltest/tcltest.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tcltest/tcltest.tcl,v
retrieving revision 1.78.2.8
diff -u -r1.78.2.8 tcltest.tcl
--- library/tcltest/tcltest.tcl	18 Feb 2004 01:43:49 -0000	1.78.2.8
+++ library/tcltest/tcltest.tcl	26 May 2004 15:01:24 -0000
@@ -24,7 +24,7 @@
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.2.5
+    variable Version 2.2.6
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -1499,8 +1499,8 @@
 	DebugPuts 2 \
 		"    ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
     }
-    if {[info exists argv]} {
-	DebugPuts 2 "    argv: $argv"
+    if {[info exists ::argv]} {
+	DebugPuts 2 "    argv: $::argv"
     }
     DebugPuts    2 "tcltest::debug              = [debug]"
     DebugPuts    2 "tcltest::testsDirectory     = [testsDirectory]"
@@ -3287,7 +3287,7 @@
 		    Tcl list: $msg"
 	    return
 	}
-	if {[llength $::env(TCLTEST_OPTIONS)] < 2} {
+	if {[llength $::env(TCLTEST_OPTIONS)] % 2} {
 	    Warn "invalid TCLTEST_OPTIONS: \"$options\":\n  should be\
 		    -option value ?-option value ...?"
 	    return
Index: tests/tcltest.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tcltest.test,v
retrieving revision 1.37.2.2
diff -u -r1.37.2.2 tcltest.test
--- tests/tcltest.test	4 May 2004 19:50:41 -0000	1.37.2.2
+++ tests/tcltest.test	26 May 2004 15:01:24 -0000
@@ -1082,38 +1082,36 @@
 removeDirectory dirtestdir
 
 # TCLTEST_OPTIONS
-test tcltest-19.1 {TCLTEST_OPTIONS default} {
-    -constraints {unixOrPc singleTestInterp}
-    -setup {
+test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
 	if {[info exists ::env(TCLTEST_OPTIONS)]} {
 	    set oldoptions $::env(TCLTEST_OPTIONS)
-	    unset ::env(TCLTEST_OPTIONS)
 	} else {
 	    set oldoptions none
 	}
 	# set this to { } instead of just {} to get around quirk in
 	# Windows env handling that removes empty elements from env array.
 	set ::env(TCLTEST_OPTIONS) { }
-	set olddebug [debug]
-	debug 2
-    }
-    -cleanup {
+	interp create slave1
+	slave1 eval [list set argv {-debug 2}]
+	slave1 alias puts puts
+	interp create slave2
+	slave2 alias puts puts
+    } -cleanup {
+	interp delete slave2
+	interp delete slave1
 	if {$oldoptions == "none"} {
 	    unset ::env(TCLTEST_OPTIONS) 
 	} else {
 	    set ::env(TCLTEST_OPTIONS) $oldoptions
 	}
-	debug $olddebug
-    }
-    -body {
-	::tcltest::ProcessCmdLineArgs
+    } -body {
+	slave1 eval [package ifneeded tcltest [package provide tcltest]]
+	slave1 eval tcltest::debug
 	set ::env(TCLTEST_OPTIONS) "-debug 3"
-	::tcltest::ProcessCmdLineArgs
-    }
-    -result {^$}
-    -match regexp
-    -output {tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
-}
+	slave2 eval [package ifneeded tcltest [package provide tcltest]]
+	slave2 eval tcltest::debug
+    } -result {^3$} -match regexp -output\
+{tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
 
 # Begin testing of tcltest procs ...