diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 37 | ||||
| -rw-r--r-- | tests/trace.test | 18 |
3 files changed, 36 insertions, 25 deletions
@@ -1,3 +1,9 @@ +2007-08-09 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c (INST_STORE_ARRAY): + * tests/trace.test (trace-2.6): whole array write traces on + compiled local variables were not firing [Bug 1770591] + 2007-08-08 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclProc.c (InitLocalCache): reference firstLocalPtr via diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ebbd040..abb30e8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.311 2007/08/08 20:52:20 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.312 2007/08/09 12:20:07 msofer Exp $ */ #include "tclInt.h" @@ -2314,16 +2314,14 @@ TclExecuteByteCode( TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_READ)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); - if (varPtr) { - if (TclIsVarDirectReadable(varPtr)) { - /* - * No errors, no traces: just get the value. - */ + if (varPtr && TclIsVarDirectReadable(varPtr)) { + /* + * No errors, no traces: just get the value. + */ - objResultPtr = varPtr->value.objPtr; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(pcAdjustment, 1, 1); - } + objResultPtr = varPtr->value.objPtr; + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(pcAdjustment, 1, 1); } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, @@ -2433,13 +2431,11 @@ TclExecuteByteCode( } if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_WRITE)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); - if (varPtr) { - if (TclIsVarDirectWritable(varPtr)) { - tosPtr--; - Tcl_DecrRefCount(OBJ_AT_TOS); - OBJ_AT_TOS = valuePtr; - goto doStoreVarDirect; - } + if (varPtr && TclIsVarDirectWritable(varPtr)) { + tosPtr--; + Tcl_DecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = valuePtr; + goto doStoreVarDirect; } } cleanup = 2; @@ -2596,13 +2592,6 @@ TclExecuteByteCode( varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (varPtr) { - if ((storeFlags == TCL_LEAVE_ERR_MSG) && TclIsVarDirectWritable(varPtr)) { - tosPtr--; - Tcl_DecrRefCount(OBJ_AT_TOS); - OBJ_AT_TOS = valuePtr; - goto doStoreVarDirect; - } - part1Ptr = NULL; goto doCallPtrSetVar; } else { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); diff --git a/tests/trace.test b/tests/trace.test index a736228..c2d7b17 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.56 2007/06/27 18:21:52 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.57 2007/08/09 12:20:08 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -231,6 +231,22 @@ test trace-2.5 {trace variable writes} { unset x set info } {} +test trace-2.6 {trace variable writes on compiled local} { + # + # Check correct function of whole array traces on compiled local + # arrays [Bug 1770591]. The corresponding function for read traces is + # already indirectly tested in trace-1.7 + # + catch {unset x} + set info {} + proc p {} { + trace add variable x write traceArray + set x(X) willy + } + p + set info +} {x X write 0 willy} + # append no longer triggers read traces when fetching the old values of # variables before doing the append operation. However, lappend _does_ |