diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | generic/tclCompile.c | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 10 | ||||
| -rw-r--r-- | generic/tclIOSock.c | 8 | ||||
| -rw-r--r-- | tests/subst.test | 26 | ||||
| -rw-r--r-- | tests/winPipe.test | 27 |
6 files changed, 73 insertions, 20 deletions
@@ -1,3 +1,19 @@ +2010-10-09 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: fix overallocation of exec stack in TEBC + (mixing numwords and numbytes) + +2010-10-08 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclIOSock.c: On Windows, use gai_strerrorA + +2010-10-06 Don Porter <dgp@users.sourceforge.net> + + * tests/winPipe.test: Test hygiene with makeFile and removeFile. + + * generic/tclCompile.c: Prevent writing to the intrep fields of a + * tests/subst.test: freed Tcl_Obj. [Bug 3081065] + 2010-10-06 Kevin B. Kenny <kennykb@acm.org> [dogeen-assembler-branch] diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 4584d78..519bf01 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.187.2.1 2010/09/27 20:33:37 kennykb Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.187.2.2 2010/10/09 17:53:16 kennykb Exp $ */ #include "tclInt.h" @@ -1050,12 +1050,12 @@ FreeSubstCodeInternalRep( { register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr; + objPtr->typePtr = NULL; + objPtr->internalRep.otherValuePtr = NULL; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } - objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3f7c420..65bd9a2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.494.2.5 2010/10/02 16:04:29 kennykb Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.494.2.6 2010/10/09 17:53:16 kennykb Exp $ */ #include "tclInt.h" @@ -1883,6 +1883,10 @@ TclNRExecuteByteCode( { Interp *iPtr = (Interp *) interp; BottomData *BP; + int size = sizeof(BottomData) + sizeof(CmdFrame) + + + (codePtr->maxStackDepth + codePtr->maxExceptDepth) + *(sizeof(Tcl_Obj *)); + int numWords = (size + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *); if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; @@ -1902,9 +1906,7 @@ TclNRExecuteByteCode( * execution stack is large enough to execute this ByteCode. */ - BP = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr, - sizeof(BottomData) + codePtr->maxExceptDepth + sizeof(CmdFrame) - + codePtr->maxStackDepth, 0); + BP = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0); esPtr->tosPtr = initTosPtr; BP->codePtr = codePtr; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 8ae2dcf..451357d 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -8,10 +8,16 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOSock.c,v 1.11.10.1 2010/09/28 15:43:01 kennykb Exp $ + * RCS: @(#) $Id: tclIOSock.c,v 1.11.10.2 2010/10/09 17:53:17 kennykb Exp $ */ #include "tclInt.h" + +#if defined(_WIN32) && defined(UNICODE) +/* On Windows, we always need the ASCII version. */ +# undef gai_strerror +# define gai_strerror gai_strerrorA +#endif /* *--------------------------------------------------------------------------- diff --git a/tests/subst.test b/tests/subst.test index 1b9ccf6..9af2609 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: subst.test,v 1.20 2010/04/08 13:26:25 dkf Exp $ +# RCS: @(#) $Id: subst.test,v 1.20.2.1 2010/10/09 17:53:17 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -271,6 +271,30 @@ test subst-12.7 {nasty case with compilation} { set y unset list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y } {1 1 1} + +test subst-13.1 {Bug 3081065} -setup { + set script [makeFile { + proc demo {string} { + subst $string + } + demo name2 + } subst13.tcl] +} -body { + interp create slave + slave eval [list source $script] + interp delete slave + interp create slave + slave eval { + set count 400 + while {[incr count -1]} { + lappend bloat [expr {rand()}] + } + } + slave eval [list source $script] + interp delete slave +} -cleanup { + removeFile subst13.tcl +} # cleanup ::tcltest::cleanupTests diff --git a/tests/winPipe.test b/tests/winPipe.test index a2df9b6..c5fb814 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winPipe.test,v 1.33 2006/11/03 15:31:26 dkf Exp $ +# RCS: @(#) $Id: winPipe.test,v 1.33.10.1 2010/10/09 17:53:17 kennykb Exp $ package require tcltest namespace import -force ::tcltest::* @@ -70,15 +70,15 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} { list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} { - exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr) + exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} { - exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr) + exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} { - exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr) + exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.6 {32 bit comprehensive tests: from console} \ @@ -173,7 +173,6 @@ test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} { exec command.com /c dir /b set result 1 } 1 -file delete more test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { proc readResults {f} { @@ -187,7 +186,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { } } - set f [open "|[list $cat32] < big 2> $path(stderr)" r] + set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r] fconfigure $f -buffering none -blocking 0 fileevent $f readable "readResults $f" set x 0 @@ -236,7 +235,7 @@ set env(TEMP) c:/ test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} { set x {} set existing [glob -nocomplain c:/tcl*.tmp] - exec [interpreter] < nothing + exec [interpreter] < $path(nothing) foreach p [glob -nocomplain c:/tcl*.tmp] { if {[lsearch $existing $p] == -1} { lappend x $p @@ -249,7 +248,7 @@ test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} { set temp $env(TEMP) unset env(TMP) unset env(TEMP) - exec [interpreter] < nothing + exec [interpreter] < $path(nothing) set env(TMP) $tmp set env(TEMP) $temp set x {} @@ -258,7 +257,7 @@ test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \ {win exec } { set tmp $env(TMP) set env(TMP) snarky - exec [interpreter] < nothing + exec [interpreter] < $path(nothing) set env(TMP) $tmp set x {} } {} @@ -268,7 +267,7 @@ test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \ set temp $env(TEMP) unset env(TMP) set env(TEMP) snarky - exec [interpreter] < nothing + exec [interpreter] < $path(nothing) set env(TMP) $tmp set env(TEMP) $temp set x {} @@ -441,6 +440,12 @@ if {[catch {set env(TEMP) $env_temp}]} { } # cleanup -file delete big little stdout stderr nothing echoArgs.tcl +removeFile little +removeFile big +removeFile more +removeFile stdout +removeFile stderr +removeFile nothing +removeFile echoArgs.tcl ::tcltest::cleanupTests return |