diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclVar.c | 6 | ||||
| -rw-r--r-- | tests/trace.test | 16 |
3 files changed, 24 insertions, 4 deletions
@@ -1,3 +1,9 @@ +2001-12-07 Miguel Sofer <msofer@users.sourceforge.net> + + * generic/tclVar.c: + * tests/trace.test: restored consistency in refCount accounting by + array traces [Bug #4484339], submitted by Don Porter. + 2001-12-06 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/parseExpr.test, tests/for.test, tests/expr.test: diff --git a/generic/tclVar.c b/generic/tclVar.c index 401e36b..134ca16 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.43 2001/12/05 20:43:58 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.44 2001/12/07 13:55:59 msofer Exp $ */ #include "tclInt.h" @@ -4514,6 +4514,9 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, resultTypePtr) } varPtr->flags |= VAR_TRACE_ACTIVE; varPtr->refCount++; + if (arrayPtr != NULL) { + arrayPtr->refCount++; + } /* * If the variable name hasn't been parsed into array name and @@ -4556,7 +4559,6 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, resultTypePtr) iPtr->activeTracePtr = &active; Tcl_Preserve((ClientData) iPtr); if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) { - arrayPtr->refCount++; active.varPtr = arrayPtr; for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { diff --git a/tests/trace.test b/tests/trace.test index beab9c6..6a5cc88 100644 --- a/tests/trace.test +++ b/tests/trace.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: trace.test,v 1.15 2001/12/05 20:43:58 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.16 2001/12/07 13:55:59 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -56,6 +56,18 @@ proc traceCommand {oldName newName op} { global info set info [list $oldName $newName $op] } + +test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} { + # You may need Purify or Electric Fence to reliably + # see this one fail. + catch {unset z} + trace add variable z array {set z(foo) 1 ;#} + set res "names: [array names z]" + catch {unset ::z} + trace variable ::z w {unset ::z; error "memory corruption";#} + list [catch {set ::z 1} msg] $msg +} {1 {can't set "::z": memory corruption}} + # Read-tracing on variables test trace-1.1 {trace variable reads} { @@ -913,7 +925,7 @@ test trace-15.3 {special list-handling in trace commands} { trace add variable "x y z(a\n\{)" write traceProc set "x y z(a\n\{)" 33 set info -} "{x y z} a\\n\\{ write" +} "{x y z} a\\n\\\{ write" # Check for proper handling of unsets during traces. |