summaryrefslogtreecommitdiffstats
path: root/generic/tclOO.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2015-09-24 13:48:37 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2015-09-24 13:48:37 (GMT)
commit6f3388528ef453d29fbddba3f5a054d2f5268207 (patch)
tree51b638cc0fe1a9d9ca7a4590d9eb8d38b6f79307 /generic/tclOO.c
parentbf1e2150cc603698bc042d0552c49930e86b2ca9 (diff)
parentf9465250b939d54021e85ba03eaf63f31b4b3037 (diff)
downloadtcl-6f3388528ef453d29fbddba3f5a054d2f5268207.zip
tcl-6f3388528ef453d29fbddba3f5a054d2f5268207.tar.gz
tcl-6f3388528ef453d29fbddba3f5a054d2f5268207.tar.bz2
merge trunk
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r--generic/tclOO.c31
1 files changed, 24 insertions, 7 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 529640f..84bb85a 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -394,6 +394,7 @@ InitFoundation(
fPtr->classCls->flags |= ROOT_CLASS;
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
AddRef(fPtr->objectCls->thisPtr);
AddRef(fPtr->objectCls);
@@ -437,10 +438,12 @@ InitFoundation(
* ensemble.
*/
- Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
- NULL);
- Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
- NULL, NULL);
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+ NULL, TclOONextObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextCmd;
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+ NULL, TclOONextToObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextToCmd;
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
TclOOSelfObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectSelfCmd;
@@ -790,7 +793,7 @@ ObjectRenamedTrace(
ClientData clientData, /* The object being deleted. */
Tcl_Interp *interp, /* The interpreter containing the object. */
const char *oldName, /* What the object was (last) called. */
- const char *newName, /* Always NULL. */
+ const char *newName, /* What it's getting renamed to. (unused) */
int flags) /* Why was the object deleted? */
{
Object *oPtr = clientData;
@@ -1006,6 +1009,12 @@ ReleaseClassContents(
}
if (!Deleted(instancePtr)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
+ /*
+ * Tcl_DeleteCommandFromToken() may have done to whole
+ * job for us. Roll back and check again.
+ */
+ i--;
+ continue;
}
DelRef(instancePtr);
}
@@ -1278,6 +1287,9 @@ TclOORemoveFromInstances(
removeInstance:
if (Deleted(clsPtr->thisPtr)) {
+ if (!IsRootClass(clsPtr)) {
+ DelRef(clsPtr->instances.list[i]);
+ }
clsPtr->instances.list[i] = NULL;
} else {
clsPtr->instances.num--;
@@ -1663,10 +1675,13 @@ Tcl_NewObjectInstance(
/*
* Take care to not delete a deleted object; that would be
- * bad. [Bug 2903011]
+ * bad. [Bug 2903011] Also take care to make sure that we have
+ * the name of the command before we delete it. [Bug
+ * 9dd1bd7a74]
*/
if (!Deleted(oPtr)) {
+ (void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
return NULL;
@@ -1809,10 +1824,12 @@ FinalizeAlloc(
/*
* Take care to not delete a deleted object; that would be bad. [Bug
- * 2903011]
+ * 2903011] Also take care to make sure that we have the name of the
+ * command before we delete it. [Bug 9dd1bd7a74]
*/
if (!Deleted(oPtr)) {
+ (void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
DelRef(oPtr);