Attachment "upvartraces.patch" to
ticket [2969488fff]
added by
ferrieux
2010-03-13 07:18:30.
Index: doc/upvar.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/upvar.n,v
retrieving revision 1.21
diff -u -p -r1.21 upvar.n
--- doc/upvar.n 20 Jan 2010 13:42:17 -0000 1.21
+++ doc/upvar.n 13 Mar 2010 00:16:55 -0000
@@ -100,12 +100,6 @@ set originalVar 1
trace variable originalVar w \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
-.PP
-If \fIotherVar\fR refers to an element of an array, then variable
-traces set for the entire array will not be invoked when \fImyVar\fR
-is accessed (but traces on the particular element will still be
-invoked). In particular, if the array is \fBenv\fR, then changes
-made to \fImyVar\fR will not be passed to subprocesses correctly.
.SH EXAMPLE
A \fBdecr\fR command that works like \fBincr\fR except it subtracts
the value from the variable instead of adding it:
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.464
diff -u -p -r1.464 tclInt.h
--- generic/tclInt.h 5 Mar 2010 14:34:04 -0000 1.464
+++ generic/tclInt.h 13 Mar 2010 00:17:01 -0000
@@ -191,15 +191,16 @@ typedef struct Tcl_Ensemble Tcl_Ensemble
typedef struct NamespacePathEntry NamespacePathEntry;
/*
- * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
- * field added at the end: in this way variables can find their namespace
- * without having to copy a pointer in their struct: they can access it via
- * their hPtr->tablePtr.
+ * Special hashtable for variables: this is just a Tcl_HashTable with nsPtr
+ * and arrayPtr fields added at the end: in this way variables can find their
+ * namespace and possibly containing array without having to copy a pointer in
+ * their struct: they can access them via their hPtr->tablePtr.
*/
typedef struct TclVarHashTable {
Tcl_HashTable table;
struct Namespace *nsPtr;
+ struct Var *arrayPtr;
} TclVarHashTable;
/*
@@ -831,6 +832,14 @@ typedef struct VarInHash {
* MODULE_SCOPE int TclIsVarResolved(Var *varPtr);
*/
+#define TclVarFindHiddenArray(varPtr,arrayPtrVar) \
+ do { \
+ if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \
+ (TclVarParentArray(varPtr) != NULL)) { \
+ arrayPtr = TclVarParentArray(varPtr); \
+ } \
+ } while(0)
+
#define TclIsVarScalar(varPtr) \
!((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
@@ -875,6 +884,9 @@ typedef struct VarInHash {
? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
: NULL)
+#define TclVarParentArray(varPtr) \
+ ((TclVarHashTable *) ((VarInHash *) (varPtr))->entry.tablePtr)->arrayPtr
+
#define VarHashRefCount(varPtr) \
((VarInHash *) (varPtr))->refCount
@@ -882,19 +894,26 @@ typedef struct VarInHash {
* Macros for direct variable access by TEBC.
*/
-#define TclIsVarDirectReadable(varPtr) \
- ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
- && (varPtr)->value.objPtr)
+#define TclIsVarTricky(varPtr,trickyFlags) \
+ ( \
+ ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \
+ || (TclIsVarInHash(varPtr) \
+ && (TclVarParentArray(varPtr) != NULL) \
+ && (TclVarParentArray(varPtr)->flags & (trickyFlags))))
+
+#define TclIsVarDirectReadable(varPtr) \
+ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \
+ && (varPtr)->value.objPtr)
#define TclIsVarDirectWritable(varPtr) \
- !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))
-
+ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH))
+
#define TclIsVarDirectUnsettable(varPtr) \
- !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_UNSET|VAR_DEAD_HASH))
+ (!TclIsVarTricky(varPtr,VAR_TRACED_UNSET|VAR_DEAD_HASH))
#define TclIsVarDirectModifyable(varPtr) \
- ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
- && (varPtr)->value.objPtr)
+ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE)) \
+ && (varPtr)->value.objPtr)
#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
(TclIsVarDirectReadable(varPtr) &&\
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.198
diff -u -p -r1.198 tclVar.c
--- generic/tclVar.c 5 Mar 2010 14:34:04 -0000 1.198
+++ generic/tclVar.c 13 Mar 2010 00:17:07 -0000
@@ -1147,6 +1147,7 @@ TclLookupArrayElement(
nsPtr = NULL;
}
TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
+ tablePtr->arrayPtr = arrayPtr;
} else if (!TclIsVarArray(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
@@ -1432,6 +1433,8 @@ TclPtrGetVar(
Interp *iPtr = (Interp *) interp;
const char *msg;
+ TclVarFindHiddenArray(varPtr, arrayPtr);
+
/*
* Invoke any read traces that have been set for the variable.
*/
@@ -1865,6 +1868,8 @@ TclPtrSetVar(
goto earlyError;
}
+ TclVarFindHiddenArray(varPtr, arrayPtr);
+
/*
* Invoke any read traces that have been set for the variable if it is
* requested; this is only done in the core by the INST_LAPPEND_*
@@ -2338,6 +2343,8 @@ TclPtrUnsetVar(
VarHashRefCount(varPtr)++;
}
+ TclVarFindHiddenArray(varPtr, arrayPtr);
+
UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
/*
@@ -2993,6 +3000,7 @@ TclArraySet(
varPtr->value.tablePtr = (TclVarHashTable *)
ckalloc(sizeof(TclVarHashTable));
TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+ varPtr->value.tablePtr->arrayPtr = varPtr;
return TCL_OK;
}
@@ -6362,6 +6370,7 @@ TclInitVarHashTable(
Tcl_InitCustomHashTable(&tablePtr->table,
TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType);
tablePtr->nsPtr = nsPtr;
+ tablePtr->arrayPtr = NULL;
}
static Tcl_HashEntry *
