summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclOO.c44
-rw-r--r--generic/tclOOInt.h14
-rw-r--r--generic/tclOOMethod.c2
3 files changed, 36 insertions, 24 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 3edca32..5ffe294 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -175,7 +175,7 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
* ROOT_CLASS respectively.
*/
-#define Deleted(oPtr) ((oPtr)->flags & OBJECT_DELETED)
+#define Destructing(oPtr) ((oPtr)->flags & OBJECT_DESTRUCTING)
#define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT)
#define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
@@ -840,7 +840,7 @@ ObjectRenamedTrace(
* 2950259].
*/
- if (!Deleted(oPtr)) {
+ if (!Destructing(oPtr)) {
Tcl_DeleteNamespace(oPtr->namespacePtr);
}
oPtr->command = NULL;
@@ -880,7 +880,7 @@ TclOODeleteDescendants(
* clsPtr
*/
- if (!Deleted(mixinSubclassPtr->thisPtr)
+ if (!Destructing(mixinSubclassPtr->thisPtr)
&& !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
mixinSubclassPtr->thisPtr->command);
@@ -900,7 +900,7 @@ TclOODeleteDescendants(
if (clsPtr->subclasses.num > 0) {
while (clsPtr->subclasses.num > 0) {
subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
- if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
+ if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
&& !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
subclassPtr->thisPtr->command);
@@ -926,7 +926,7 @@ TclOODeleteDescendants(
* This condition also covers the case where instancePtr == oPtr
*/
- if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
+ if (!Destructing(instancePtr) && !IsRoot(instancePtr) &&
!(instancePtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
}
@@ -968,7 +968,7 @@ TclOOReleaseClassContents(
* Sanity check!
*/
- if (!Deleted(oPtr)) {
+ if (!Destructing(oPtr)) {
if (IsRootClass(oPtr)) {
Tcl_Panic("deleting class structure for non-deleted %s",
"::oo::class");
@@ -1087,7 +1087,7 @@ TclOOReleaseClassContents(
Tcl_Free(clsPtr->privateVariables.list);
}
- if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
+ if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
}
}
@@ -1120,7 +1120,7 @@ ObjectNamespaceDeleted(
Tcl_Interp *interp = oPtr->fPtr->interp;
int i;
- if (Deleted(oPtr)) {
+ if (Destructing(oPtr)) {
/*
* TODO: Can ObjectNamespaceDeleted ever be called twice? If not,
* this guard could be removed.
@@ -1135,7 +1135,7 @@ ObjectNamespaceDeleted(
* records. This is the flag that
*/
- oPtr->flags |= OBJECT_DELETED;
+ oPtr->flags |= OBJECT_DESTRUCTING;
/*
* Let the dominoes fall!
@@ -1280,7 +1280,7 @@ ObjectNamespaceDeleted(
* sometimes not go away automatically; we force it here. [Bug 2962664]
*/
- if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
+ if (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr)
&& !Tcl_InterpDeleted(interp)) {
Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
}
@@ -1331,6 +1331,20 @@ TclOODecrRefCount(
/*
* ----------------------------------------------------------------------
*
+ * TclOOObjectDestroyed --
+ *
+ * Returns TCL_OK if an object is entirely deleted, i.e. the destruction
+ * sequence has completed.
+ *
+ * ----------------------------------------------------------------------
+ */
+int TclOOObjectDestroyed(Object *oPtr) {
+ return (oPtr->namespacePtr == NULL);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOORemoveFromInstances --
*
* Utility function to remove an object from the list of instances within
@@ -1473,7 +1487,7 @@ TclOOAddToSubclasses(
* is assumed that the class is not already
* present as a subclass in the superclass. */
{
- if (Deleted(superPtr->thisPtr)) {
+ if (Destructing(superPtr->thisPtr)) {
return;
}
if (superPtr->subclasses.num >= superPtr->subclasses.size) {
@@ -1538,7 +1552,7 @@ TclOOAddToMixinSubs(
* is assumed that the class is not already
* present as a subclass in the superclass. */
{
- if (Deleted(superPtr->thisPtr)) {
+ if (Destructing(superPtr->thisPtr)) {
return;
}
if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
@@ -1847,7 +1861,7 @@ FinalizeAlloc(
* want to lose errors by accident. [Bug 2903011]
*/
- if (result != TCL_ERROR && Deleted(oPtr)) {
+ if (result != TCL_ERROR && Destructing(oPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object deleted in constructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
@@ -1862,7 +1876,7 @@ FinalizeAlloc(
* command before we delete it. [Bug 9dd1bd7a74]
*/
- if (!Deleted(oPtr)) {
+ if (!Destructing(oPtr)) {
(void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
@@ -2007,7 +2021,7 @@ Tcl_CopyObjectInstance(
*/
o2Ptr->flags = oPtr->flags & ~(
- OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+ OBJECT_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
/*
* Copy the object's metadata.
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index fd1b051..54f4476 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -213,14 +213,11 @@ typedef struct Object {
* command. */
} Object;
-#define OBJECT_DELETED 1 /* Flag to say that an object has been
- * destroyed. */
-#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
- * called. */
-#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this
- * object has been deleted, and so the object
- * should not attempt to remove itself from its
- * class. */
+#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has
+ * been destroyed */
+#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor script for the
+ object has began */
+#define OO_UNUSED_4 4 /* No longer used. */
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
@@ -587,6 +584,7 @@ MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp,
const char *nameStr,
const char *nsNameStr);
MODULE_SCOPE int TclOODecrRefCount(Object *oPtr);
+MODULE_SCOPE int TclOOObjectDestroyed(Object *oPtr);
MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 0f3d066..1797c6a 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -683,7 +683,7 @@ InvokeProcedureMethod(
* the next thing in the chain.
*/
- if (!((CallContext *)context)->oPtr->namespacePtr ||
+ if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) ||
Tcl_InterpDeleted(interp)
) {
return TclNRObjectContextInvokeNext(interp, context, objc, objv,
generated by cgit v0.12 at 2024-11-16 11:18:36 (GMT)