summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-08-09 12:20:04 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-08-09 12:20:04 (GMT)
commitfcd17ae019c89d4f1cd1f82e1c04ba022c275f77 (patch)
tree6a044cff1f717e9615f3588d0aa24be02f7fa9e5
parenta4eeb94ff4ff15234e1513f1535c79690f9ea2bc (diff)
downloadtcl-fcd17ae019c89d4f1cd1f82e1c04ba022c275f77.zip
tcl-fcd17ae019c89d4f1cd1f82e1c04ba022c275f77.tar.gz
tcl-fcd17ae019c89d4f1cd1f82e1c04ba022c275f77.tar.bz2
* 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]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c37
-rw-r--r--tests/trace.test18
3 files changed, 36 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index 704637b..2b13d81 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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_