Attachment "procns2.patch" to
ticket [944803ffff]
added by
coldstore
2004-08-23 08:09:31.
Index: tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.103
diff -u -r1.103 tclBasic.c
--- tclBasic.c 25 May 2004 08:37:31 -0000 1.103
+++ tclBasic.c 23 Aug 2004 01:05:57 -0000
@@ -2064,6 +2064,26 @@
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
/*
+ * This command may be associated with a proc ... we know this if
+ * the command deletion implies a proc deletion (which is a bit of a hack)
+ * If this is a proc command, renaming the command might change the namespace
+ * scope of the proc, in which case we need to reflect the change in Proc's record
+ * of its namespace.
+ */
+ if ((cmdPtr->deleteProc == TclProcDeleteProc)
+ && (cmdPtr->nsPtr != cmdNsPtr)) {
+ /* this command is associated with a proc,
+ whose namespace must change to reflect this renaming */
+ Proc *proc = (Proc *)cmdPtr->objClientData;
+
+ if (proc->proc2ns) {
+ TclNsDeref(proc->proc2ns); /* release reference to old Namespace */
+ }
+ proc->proc2ns = cmdPtr->nsPtr;
+ proc->proc2ns->refCount++; /* Proc holds a ref to new Namespace */
+ }
+
+ /*
* Script for rename traces can delete the command "oldName".
* Therefore increment the reference count for cmdPtr so that
* it's Command structure is freed only towards the end of this
Index: tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.66
diff -u -r1.66 tclCompile.c
--- tclCompile.c 16 May 2004 17:25:48 -0000 1.66
+++ tclCompile.c 23 Aug 2004 01:05:59 -0000
@@ -930,7 +930,7 @@
isFirstCmd = 1;
if (envPtr->procPtr != NULL) {
- cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+ cmdNsPtr = envPtr->procPtr->proc2ns;
} else {
cmdNsPtr = NULL; /* use current NS */
}
Index: tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.161
diff -u -r1.161 tclInt.h
--- tclInt.h 20 May 2004 13:04:11 -0000 1.161
+++ tclInt.h 23 Aug 2004 01:06:01 -0000
@@ -640,7 +640,7 @@
* to the procedure that is currently
* active. This structure can be freed
* when refCount becomes zero. */
- struct Command *cmdPtr; /* Points to the Command structure for
+ struct Namespace *proc2ns; /* points to the NS for this proc's scope for
* this procedure. This is used to get
* the namespace in which to execute
* the procedure. */
@@ -1794,6 +1794,7 @@
int objc, Tcl_Obj *CONST objv[],
Tcl_Obj **optionsPtrPtr, int *codePtr,
int *levelPtr));
+EXTERN void TclNsDeref _ANSI_ARGS_((Namespace *ns));
EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src,
int numBytes, int *readPtr, char *dst));
EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes,
Index: tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.40
diff -u -r1.40 tclNamesp.c
--- tclNamesp.c 25 May 2004 19:45:14 -0000 1.40
+++ tclNamesp.c 23 Aug 2004 01:06:04 -0000
@@ -3979,6 +3979,32 @@
/*
*----------------------------------------------------------------------
*
+ * TclNsDeref --
+ *
+ * Decrements references to Namespace
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Decrements the ref count of Namespace structure
+ * If there are no more references to the namespace,
+ * it's structure will be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void TclNsDeref (Namespace *ns)
+{
+ ns->refCount--;
+ if ((ns->refCount == 0) && (ns->flags & NS_DEAD)) {
+ NamespaceFree(ns);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DupNsNameInternalRep --
*
* Initializes the internal representation of a nsName object to a copy
Index: tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.52
diff -u -r1.52 tclProc.c
--- tclProc.c 4 May 2004 03:20:22 -0000 1.52
+++ tclProc.c 23 Aug 2004 01:06:05 -0000
@@ -146,8 +146,8 @@
* namespace if the proc was renamed into a different namespace.
*/
- procPtr->cmdPtr = (Command *) cmd;
-
+ procPtr->proc2ns = ((Command *) cmd)->nsPtr;
+ procPtr->proc2ns->refCount++;
/*
* Optimize for noop procs: if the body is not precompiled (like a TclPro
@@ -892,7 +892,7 @@
Tcl_Obj *CONST objv[]; /* Argument value objects. */
{
register Proc *procPtr = (Proc *) clientData;
- Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
+ Namespace *nsPtr = procPtr->proc2ns;
CallFrame frame;
register CallFrame *framePtr = &frame;
register Var *varPtr;
@@ -1402,6 +1402,12 @@
ckfree((char *) localPtr);
localPtr = nextPtr;
}
+
+ /* we hold a reference to a Namespace, which must be decremented */
+ if (procPtr->proc2ns) {
+ TclNsDeref(procPtr->proc2ns);
+ }
+
ckfree((char *) procPtr);
}
