From 83102e6f2f98d36d59b7b69132074e9724dc2feb Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 21 Jun 2011 14:09:31 +0000 Subject: 3317466 Prevent multiple Tcl_LinkVar() links to a single Tcl variable. --- ChangeLog | 5 +++++ generic/tclLink.c | 8 ++++++++ 2 files changed, 13 insertions(+) diff --git a/ChangeLog b/ChangeLog index da20558..aebd347 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2011-06-21 Don Porter + + * generic/tclLink.c: Prevent multiple links to a single Tcl + variable when calling Tcl_LinkVar(). [Bug 3317466] + 2011-06-13 Don Porter * generic/tclStrToD.c: [Bug 3315098] Mem leak fix from Gustaf Neumann. diff --git a/generic/tclLink.c b/generic/tclLink.c index df8b16a..f7911a4 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -112,6 +112,14 @@ Tcl_LinkVar( Link *linkPtr; int code; + linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, + LinkTraceProc, (ClientData) NULL); + if (linkPtr != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "variable '%s' is already linked", varName)); + return TCL_ERROR; + } + linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->varName = Tcl_NewStringObj(varName, -1); -- cgit v0.12 From f271c4ad0a19d06b3f42aa7ab22f92a4ebc0879e Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 21 Jun 2011 16:28:34 +0000 Subject: Backport tcltest 2.3.3 for release with Tcl 8.5.* --- ChangeLog | 8 ++++++++ library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 33 ++++++++++++++++++++++++++++++++- tests/init.test | 29 +++++++++++++---------------- tests/pkg.test | 7 +++---- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 7 files changed, 61 insertions(+), 26 deletions(-) diff --git a/ChangeLog b/ChangeLog index aebd347..b0fcbe2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ 2011-06-21 Don Porter + * library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): + * library/tcltest/pkgIndex.tcl: Backport tcltest 2.3.3 for release + * unix/Makefile.in: with Tcl 8.5.*. + * win/Makefile.in: + + * tests/init.test: Update test files to use new command. + * tests/pkg.test: + * generic/tclLink.c: Prevent multiple links to a single Tcl variable when calling Tcl_LinkVar(). [Bug 3317466] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index fe80272..2eb43a6 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.3.2 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.3.3 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 15b7293..ad61f9c 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # 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.3.2 + variable Version 2.3.3 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -795,6 +795,29 @@ namespace eval tcltest { trace variable Option(-errfile) w \ [namespace code {errorChannel $Option(-errfile) ;#}] + proc loadIntoSlaveInterpreter {slave args} { + variable Version + interp eval $slave [list set ::argv $args] + interp eval $slave [list package require tcltest $Version] + interp alias $slave ::tcltest::ReportToMaster \ + {} ::tcltest::ReportedFromSlave + } + proc ReportedFromSlave {total passed skipped failed because newfiles} { + variable numTests + variable skippedBecause + variable createdNewFiles + incr numTests(Total) $total + incr numTests(Passed) $passed + incr numTests(Skipped) $skipped + incr numTests(Failed) $failed + foreach {constraint count} $because { + incr skippedBecause($constraint) $count + } + foreach {testfile created} $newfiles { + lappend createdNewFiles($testfile) {*}$created + } + return + } } ##################################################################### @@ -2354,6 +2377,14 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { FillFilesExisted set testFileName [file tail [info script]] + # Hook to handle reporting to a parent interpreter + if {[llength [info commands [namespace current]::ReportToMaster]]} { + ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \ + $numTests(Failed) [array get skippedBecause] \ + [array get createdNewFiles] + set testSingleFile false + } + # Call the cleanup hook cleanupTestsHook diff --git a/tests/init.test b/tests/init.test index 7bdbd82..aaa4c4f 100644 --- a/tests/init.test +++ b/tests/init.test @@ -53,21 +53,18 @@ test init-1.7 {auto_qualify - multiples colons 1} { test init-1.8 {auto_qualify - multiple colons 2} { auto_qualify :::foo ::bar } foo - + # we use a sub interp and auto_reset and double the tests because there is 2 # places where auto_loading occur (before loading the indexes files and after) set testInterp [interp create] -interp eval $testInterp [list set argv $argv] -interp eval $testInterp [list package require tcltest] -interp eval $testInterp [list namespace import -force ::tcltest::*] - +tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv interp eval $testInterp { - -auto_reset -catch {rename parray {}} - + namespace import -force ::tcltest::* + auto_reset + catch {rename parray {}} + test init-2.0 {load parray - stage 1} { set ret [catch {parray} error] rename parray {} ; # remove it, for the next test - that should not fail. @@ -148,12 +145,12 @@ test init-3.0 {random stuff in the auto_index, should still work} { set count 0 foreach arg [subst -nocommands -novariables { - c - {argument + c + {argument which spans multiple lines} - {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack} - {argument which spans multiple lines + {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack} + {argument which spans multiple lines and is long enough to be truncated and " <- includes a false lead in the prune point search and must be longer still to force truncation} @@ -162,13 +159,13 @@ foreach arg [subst -nocommands -novariables { error stack cannot be uniquely determined. foo bar foo "} - {contrived example: rare circumstance + {contrived example: rare circumstance where the point at which to prune the error stack cannot be uniquely determined. foo bar "} - {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} - }] { + {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} + }] { ;# emacs needs -> " test init-4.$count.0 {::errorInfo produced by [unknown]} { auto_reset diff --git a/tests/pkg.test b/tests/pkg.test index 7d818d4..62075f3 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -19,11 +19,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Do all this in a slave interp to avoid garbaging the # package list set i [interp create] -interp eval $i [list set argv $argv] -interp eval $i [list package require tcltest 2] -interp eval $i [list namespace import -force ::tcltest::*] -interp eval $i { +tcltest::loadIntoSlaveInterpreter $i {*}$argv +interp eval $i { +namespace import -force ::tcltest::* package forget {*}[package names] set oldPkgUnknown [package unknown] package unknown {} diff --git a/unix/Makefile.in b/unix/Makefile.in index 96d5062..82578f6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -780,8 +780,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs done; @echo "Installing package msgcat 1.4.4 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm; - @echo "Installing package tcltest 2.3.2 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm; + @echo "Installing package tcltest 2.3.3 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.3.tm; @echo "Installing package platform 1.0.9 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.9.tm; diff --git a/win/Makefile.in b/win/Makefile.in index 97a7e7b..6308165 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -647,8 +647,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.4.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm; - @echo "Installing package tcltest 2.3.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.2.tm; + @echo "Installing package tcltest 2.3.3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.3.tm; @echo "Installing package platform 1.0.9 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.9.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; -- cgit v0.12 From 8d94e515a1b9ff2044435c145b20d5bb66c24b43 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 21 Jun 2011 16:45:17 +0000 Subject: tcltest 2.3.3 fixes: * Use [package ifneeded] so slave gets exactly same tcltest version as master * Use [configure] command instead of legacy ::argv magic to pass tcltest configuration options to slave interp. Test files using the new [loadIntoSlaveInterpreter] command updated to declare their need for tcltest 2.3.3 as minimum acceptable release. --- library/tcltest/tcltest.tcl | 4 ++-- tests/init.test | 2 +- tests/pkg.test | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index ad61f9c..af809f6 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -797,8 +797,8 @@ namespace eval tcltest { proc loadIntoSlaveInterpreter {slave args} { variable Version - interp eval $slave [list set ::argv $args] - interp eval $slave [list package require tcltest $Version] + interp eval $slave [package ifneeded tcltest $Version] + interp eval $slave "tcltest::configure {*}{$args}" interp alias $slave ::tcltest::ReportToMaster \ {} ::tcltest::ReportedFromSlave } diff --git a/tests/init.test b/tests/init.test index aaa4c4f..0af94ea 100644 --- a/tests/init.test +++ b/tests/init.test @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 + package require tcltest 2.3.3 namespace import -force ::tcltest::* } diff --git a/tests/pkg.test b/tests/pkg.test index 62075f3..a073d25 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 + package require tcltest 2.3.3 namespace import -force ::tcltest::* } -- cgit v0.12 From 97a44d320d35cebb0ed167cd420005f24a5c4dff Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 21 Jun 2011 16:57:11 +0000 Subject: changes update for 8.5.10 --- ChangeLog | 2 ++ changes | 3 +++ 2 files changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index b0fcbe2..3f4037d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,7 @@ 2011-06-21 Don Porter + * changes: Update for 8.5.10 release. + * library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): * library/tcltest/pkgIndex.tcl: Backport tcltest 2.3.3 for release * unix/Makefile.in: with Tcl 8.5.*. diff --git a/changes b/changes index e1c5fb6..a37d785 100644 --- a/changes +++ b/changes @@ -7538,4 +7538,7 @@ memory with buffer backup (ferrieux) 2011-06-13 (bug fix)[3315098] mem leak generating double string rep (neumann) +2011-06-21 (new cmd) [tcltest::loadIntoSlaveInterpreter] (fellows) +=> tcltest 2.3.3 + --- Released 8.5.10, June 22, 2011 --- See ChangeLog for details --- -- cgit v0.12