From 2d455c75b957f96586b3ca1d1b83b4b9a3283c55 Mon Sep 17 00:00:00 2001 From: sbron Date: Wed, 24 Aug 2022 11:18:28 +0000 Subject: Start TIP #634 implementation using modified patch from ticket #2969488 by ferrieux. --- doc/upvar.n | 6 ------ generic/tclInt.h | 40 +++++++++++++++++++++++++++++----------- generic/tclVar.c | 9 +++++++++ 3 files changed, 38 insertions(+), 17 deletions(-) diff --git a/doc/upvar.n b/doc/upvar.n index 91defe6..6ad1237 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -97,12 +97,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: diff --git a/generic/tclInt.h b/generic/tclInt.h index 527572e..f5b25dc 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -215,15 +215,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; /* @@ -813,6 +814,14 @@ typedef struct VarInHash { * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ +#define TclVarFindHiddenArray(varPtr,arrayPtr) \ + do { \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ + } while(0) + #define TclIsVarScalar(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) @@ -857,6 +866,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 @@ -864,19 +876,25 @@ 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_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) + (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|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) &&\ diff --git a/generic/tclVar.c b/generic/tclVar.c index e0f46e7..c88144f 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -998,6 +998,7 @@ TclLookupSimpleVar( if (tablePtr == NULL) { tablePtr = (TclVarHashTable *)Tcl_Alloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); + tablePtr->arrayPtr = varPtr; varFramePtr->varTablePtr = tablePtr; } varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); @@ -1390,6 +1391,8 @@ TclPtrGetVarIdx( Interp *iPtr = (Interp *) interp; const char *msg; + TclVarFindHiddenArray(varPtr, arrayPtr); + /* * Invoke any read traces that have been set for the variable. */ @@ -1952,6 +1955,8 @@ TclPtrSetVarIdx( goto earlyError; } + TclVarFindHiddenArray(varPtr, arrayPtr); + /* * Invoke any read traces that have been set for the variable if it is * requested. This was done for INST_LAPPEND_* but that was inconsistent @@ -2454,6 +2459,8 @@ TclPtrUnsetVarIdx( VarHashRefCount(varPtr)++; } + TclVarFindHiddenArray(varPtr, arrayPtr); + UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index); /* @@ -6340,6 +6347,7 @@ TclInitVarHashTable( Tcl_InitCustomHashTable(&tablePtr->table, TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType); tablePtr->nsPtr = nsPtr; + tablePtr->arrayPtr = NULL; } static Tcl_HashEntry * @@ -6594,6 +6602,7 @@ TclInitArrayVar( arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr; TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr)); + arrayPtr->value.tablePtr->arrayPtr = arrayPtr; /* * Default value initialization. -- cgit v0.12