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 ...