packages/tcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
tcl/Fix-for-issue-9fd5c629c1-TclOO-aborts-when-a-trace-o.patch
overweight fe90c77fc4 Package init
2019-09-30 11:18:08 -04:00

295 lines
12 KiB
Diff
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

From cb0d0668227042f07802ebd4e713577cdf85a116 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 30 Oct 2017 05:19:55 +0000
Subject: [PATCH 0634/1800] Fix for issue 9fd5c629c1, TclOO - aborts when a
trace on command deletion deletes the object's namespace.
---
generic/tclBasic.c | 8 ++++----
generic/tclFileName.c | 2 +-
generic/tclOO.c | 35 ++++++++++++++++++++++++++---------
generic/tclOOCall.c | 8 ++++----
generic/tclOOInt.h | 16 ++++++++--------
tests/oo.test | 12 ++++++++++++
6 files changed, 55 insertions(+), 26 deletions(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d4fa8330b..e6022ac6b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3112,7 +3112,7 @@ Tcl_DeleteCommandFromToken(
/*
* We must delete this command, even though both traces and delete procs
* may try to avoid this (renaming the command etc). Also traces and
- * delete procs may try to delete the command themsevles. This flag
+ * delete procs may try to delete the command themselves. This flag
* declares that a delete is in progress and that recursive deletes should
* be ignored.
*/
@@ -7722,8 +7722,8 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
- * Take into consideration the thread this interp is running in order
- * to insure different seeds in different threads (bug #416643)
+ * To ensure different seeds in different threads (bug #416643),
+ * take into consideration the thread this interp is running in.
*/
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
@@ -9091,7 +9091,7 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
- /* insure that the command is looked up in the correct namespace */
+ /* ensure that the command is looked up in the correct namespace */
iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
iPtr->numLevels--;
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 150fb8c4d..15fcde74a 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1904,7 +1904,7 @@ TclGlob(
}
/*
- * To process a [glob] invokation, this function may be called multiple
+ * To process a [glob] invocation, this function may be called multiple
* times. Each time, the previously discovered filenames are in the
* interpreter result. We stash that away here so the result is free for
* error messsages.
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 73acce844..e9ef2ce29 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -880,7 +880,7 @@ ObjectRenamedTrace(
* 2950259]
*/
- if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
+ if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
Tcl_DeleteNamespace(oPtr->namespacePtr);
}
if (oPtr->classPtr) {
@@ -1168,7 +1168,7 @@ ObjectNamespaceDeleted(
Class *clsPtr = oPtr->classPtr, *mixinPtr;
Method *mPtr;
Tcl_Obj *filterObj, *variableObj;
- int i;
+ int deleteAlreadyInProgress = 0, i;
/*
* Instruct everyone to no longer use any allocated fields of the object.
@@ -1178,6 +1178,14 @@ ObjectNamespaceDeleted(
*/
if (oPtr->command) {
+ if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
+ /*
+ * Namespace deletion must have been triggered by a trace on command
+ * deletion , meaning that
+ */
+ deleteAlreadyInProgress = 1;
+ }
+
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
}
if (oPtr->myCommand) {
@@ -1273,14 +1281,17 @@ ObjectNamespaceDeleted(
if (clsPtr->subclasses.list) {
ckfree(clsPtr->subclasses.list);
+ clsPtr->subclasses.list = NULL;
clsPtr->subclasses.num = 0;
}
if (clsPtr->instances.list) {
ckfree(clsPtr->instances.list);
+ clsPtr->instances.list = NULL;
clsPtr->instances.num = 0;
}
if (clsPtr->mixinSubs.list) {
ckfree(clsPtr->mixinSubs.list);
+ clsPtr->mixinSubs.list = NULL;
clsPtr->mixinSubs.num = 0;
}
@@ -1305,7 +1316,13 @@ ObjectNamespaceDeleted(
* Delete the object structure itself.
*/
- DelRef(oPtr);
+ if (deleteAlreadyInProgress) {
+ oPtr->classPtr = NULL;
+ oPtr->namespacePtr = NULL;
+ } else {
+ DelRef(oPtr);
+ }
+
}
/*
@@ -2433,7 +2450,7 @@ Tcl_ObjectSetMetadata(
*
* PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
*
- * Main entry point for object invokations. The Public* and Private*
+ * Main entry point for object invocations. The Public* and Private*
* wrapper functions (implementations of both object instance commands
* and [my]) are just thin wrappers round the main TclOOObjectCmdCore
* function. Note that the core is function is NRE-aware.
@@ -2518,8 +2535,8 @@ TclOOInvokeObject(
*
* TclOOObjectCmdCore, FinalizeObjectCall --
*
- * Main function for object invokations. Does call chain creation,
- * management and invokation. The function FinalizeObjectCall exists to
+ * Main function for object invocations. Does call chain creation,
+ * management and invocation. The function FinalizeObjectCall exists to
* clean up after the non-recursive processing of TclOOObjectCmdCore.
*
* ----------------------------------------------------------------------
@@ -2531,7 +2548,7 @@ TclOOObjectCmdCore(
Tcl_Interp *interp, /* The interpreter containing the object. */
int objc, /* How many arguments are being passed in. */
Tcl_Obj *const *objv, /* The array of arguments. */
- int flags, /* Whether this is an invokation through the
+ int flags, /* Whether this is an invocation through the
* public or the private command interface. */
Class *startCls) /* Where to start in the call chain, or NULL
* if we are to start at the front with
@@ -2720,7 +2737,7 @@ Tcl_ObjectContextInvokeNext(
* call context while we process the body. However, need to adjust the
* argument-skip control because we're guaranteed to have a single prefix
* arg (i.e., 'next') and not the variable amount that can happen because
- * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * method invocations (i.e., '$obj meth' and 'my meth'), constructors
* (i.e., '$cls new' and '$cls create obj') and destructors (no args at
* all) come through the same code.
*/
@@ -2789,7 +2806,7 @@ TclNRObjectContextInvokeNext(
* call context while we process the body. However, need to adjust the
* argument-skip control because we're guaranteed to have a single prefix
* arg (i.e., 'next') and not the variable amount that can happen because
- * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * method invocations (i.e., '$obj meth' and 'my meth'), constructors
* (i.e., '$cls new' and '$cls create obj') and destructors (no args at
* all) come through the same code.
*/
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 3e4f561d2..d4e1e34d5 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -233,7 +233,7 @@ FreeMethodNameRep(
* TclOOInvokeContext --
*
* Invokes a single step along a method call-chain context. Note that the
- * invokation of a step along the chain can cause further steps along the
+ * invocation of a step along the chain can cause further steps along the
* chain to be invoked. Note that this function is written to be as light
* in stack usage as possible.
*
@@ -830,7 +830,7 @@ AddMethodToCallChain(
* Call chain semantics states that methods come as *late* in the
* call chain as possible. This is done by copying down the
* following methods. Note that this does not change the number of
- * method invokations in the call chain; it just rearranges them.
+ * method invocations in the call chain; it just rearranges them.
*/
Class *declCls = callPtr->chain[i].filterDeclarer;
@@ -935,7 +935,7 @@ IsStillValid(
* TclOOGetCallContext --
*
* Responsible for constructing the call context, an ordered list of all
- * method implementations to be called as part of a method invokation.
+ * method implementations to be called as part of a method invocation.
* This method is central to the whole operation of the OO system.
*
* ----------------------------------------------------------------------
@@ -1517,7 +1517,7 @@ TclOORenderCallChain(
/*
* Do the actual construction of the descriptions. They consist of a list
* of triples that describe the details of how a method is understood. For
- * each triple, the first word is the type of invokation ("method" is
+ * each triple, the first word is the type of invocation ("method" is
* normal, "unknown" is special because it adds the method name as an
* extra argument when handled by some method types, and "filter" is
* special because it's a filter method). The second word is the name of
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 476446dbb..11ba698a3 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -149,8 +149,8 @@ typedef struct Object {
struct Foundation *fPtr; /* The basis for the object system. Putting
* this here allows the avoidance of quite a
* lot of hash lookups on the critical path
- * for object invokation and creation. */
- Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
+ * for object invocation and creation. */
+ Tcl_Namespace *namespacePtr;/* This object's namespace. */
Tcl_Command command; /* Reference to this object's public
* command. */
Tcl_Command myCommand; /* Reference to this object's internal
@@ -162,12 +162,12 @@ typedef struct Object {
/* Classes mixed into this object. */
LIST_STATIC(Tcl_Obj *) filters;
/* List of filter names. */
- struct Class *classPtr; /* All classes have this non-NULL; it points
- * to the class structure. Everything else has
- * this NULL. */
+ struct Class *classPtr; /* This is non-NULL for all classes, and NULL
+ * for everything else. It points to the class
+ * structure. */
int refCount; /* Number of strong references to this object.
* Note that there may be many more weak
- * references; this mechanism is there to
+ * references; this mechanism exists to
* avoid Tcl_Preserve. */
int flags;
int creationEpoch; /* Unique value to make comparisons of objects
@@ -323,7 +323,7 @@ typedef struct Foundation {
} Foundation;
/*
- * A call context structure is built when a method is called. They contain the
+ * A call context structure is built when a method is called. It contains the
* chain of method implementations that are to be invoked by a particular
* call, and the process of calling walks the chain, with the [next] command
* proceeding to the next entry in the chain.
@@ -334,7 +334,7 @@ typedef struct Foundation {
struct MInvoke {
Method *mPtr; /* Reference to the method implementation
* record. */
- int isFilter; /* Whether this is a filter invokation. */
+ int isFilter; /* Whether this is a filter invocation. */
Class *filterDeclarer; /* What class decided to add the filter; if
* NULL, it was added by the object. */
};
diff --git a/tests/oo.test b/tests/oo.test
index 2a6eb8003..6268dc6e0 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1482,6 +1482,18 @@ test oo-11.4 {OO: cleanup} {
lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
[oo::object create bar2] [bar2 destroy]
} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+test oo-11.5 {OO: cleanup} {
+ oo::class create obj1
+
+ trace add command obj1 delete {apply {{name1 name2 action} {
+ set namespace [info object namespace $name1]
+ namespace delete $namespace
+ }}}
+
+ rename obj1 {}
+ # No segmentation fault
+ return done
+} done
test oo-12.1 {OO: filters} {
oo::class create Aclass
--
2.19.1
Reference in New Issue View Git Blame Copy Permalink