diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclOO.c | 31 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 4 |
2 files changed, 23 insertions, 12 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index de0b36b..73b1034 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.4 2008/05/31 11:42:16 dkf Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.5 2008/05/31 22:29:45 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -276,6 +276,8 @@ InitFoundation( fPtr->classCls->thisPtr->selfCls = fPtr->classCls; TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); + AddRef(fPtr->objectCls->thisPtr); + AddRef(fPtr->objectCls); /* * Basic method declarations for the core classes. @@ -299,6 +301,7 @@ InitFoundation( namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL); argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1); + Tcl_IncrRefCount(argsPtr); bodyPtr = Tcl_NewStringObj( "if {[catch {define [self] $definitionScript} msg opt]} {\n" "set ei [split [dict get $opt -errorinfo] \\n]\n" @@ -308,6 +311,7 @@ InitFoundation( "return -options $opt $msg", -1); fPtr->classCls->constructorPtr = TclOONewProcMethod(interp, fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL); + Tcl_DecrRefCount(argsPtr); /* * Create non-object commands and plug ourselves into the Tcl [info] @@ -346,6 +350,8 @@ KillFoundation( { Foundation *fPtr = GetFoundation(interp); + DelRef(fPtr->objectCls->thisPtr); + DelRef(fPtr->objectCls); Tcl_DecrRefCount(fPtr->unknownMethodNameObj); Tcl_DecrRefCount(fPtr->constructorName); Tcl_DecrRefCount(fPtr->destructorName); @@ -472,7 +478,7 @@ AllocObject( /* * Access the namespace command table directly when creating "my" to avoid - * a bottleneck in string manipulation. + * a bottleneck in string manipulation. */ { @@ -541,7 +547,7 @@ ObjectRenamedTrace( AddRef(oPtr); oPtr->flags |= OBJECT_DELETED; - if (!Tcl_InterpDeleted(interp)) { + if (!(flags & TCL_INTERP_DESTROYED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR); if (contextPtr != NULL) { @@ -613,7 +619,8 @@ ReleaseClassContents( AddRef(list[i]); } for (i=0 ; i<n ; i++) { - if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) { + if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) { + list[i]->thisPtr->flags |= OBJECT_DELETED; Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command); } DelRef(list[i]); @@ -631,7 +638,8 @@ ReleaseClassContents( AddRef(list[i]); } for (i=0 ; i<n ; i++) { - if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) { + if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) { + list[i]->thisPtr->flags |= OBJECT_DELETED; Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command); } DelRef(list[i]); @@ -649,7 +657,8 @@ ReleaseClassContents( AddRef(insts[i]); } for (i=0 ; i<n ; i++) { - if (!(insts[i]->flags & OBJECT_DELETED) && interp != NULL) { + if (!(insts[i]->flags & OBJECT_DELETED)) { + insts[i]->flags |= OBJECT_DELETED; Tcl_DeleteCommandFromToken(interp, insts[i]->command); } DelRef(insts[i]); @@ -660,9 +669,11 @@ ReleaseClassContents( if (clsPtr->constructorChainPtr) { TclOODeleteChain(clsPtr->constructorChainPtr); + clsPtr->constructorChainPtr = NULL; } if (clsPtr->destructorChainPtr) { TclOODeleteChain(clsPtr->destructorChainPtr); + clsPtr->destructorChainPtr = NULL; } if (clsPtr->classChainCache) { FOREACH_HASH_DECLS; @@ -673,6 +684,7 @@ ReleaseClassContents( } Tcl_DeleteHashTable(clsPtr->classChainCache); ckfree((char *) clsPtr->classChainCache); + clsPtr->classChainCache = NULL; } if (clsPtr->filters.num) { @@ -790,7 +802,7 @@ ObjectNamespaceDeleted( oPtr->metadataPtr = NULL; } - if (clsPtr != NULL && !(oPtr->flags & ROOT_OBJECT)) { + if (clsPtr != NULL) { Class *superPtr, *mixinPtr; if (clsPtr->metadataPtr != NULL) { @@ -806,7 +818,6 @@ ObjectNamespaceDeleted( clsPtr->metadataPtr = NULL; } - clsPtr->flags |= OBJECT_DELETED; FOREACH(filterObj, clsPtr->filters) { Tcl_DecrRefCount(filterObj); } @@ -815,7 +826,7 @@ ObjectNamespaceDeleted( clsPtr->filters.num = 0; } FOREACH(mixinPtr, clsPtr->mixins) { - if (!(mixinPtr->flags & OBJECT_DELETED)) { + if (!(mixinPtr->thisPtr->flags & OBJECT_DELETED)) { TclOORemoveFromMixinSubs(clsPtr, mixinPtr); } } @@ -824,7 +835,7 @@ ObjectNamespaceDeleted( clsPtr->mixins.num = 0; } FOREACH(superPtr, clsPtr->superclasses) { - if (!(superPtr->flags & OBJECT_DELETED)) { + if (!(superPtr->thisPtr->flags & OBJECT_DELETED)) { TclOORemoveFromSubclasses(clsPtr, superPtr); } } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index f190533..21e0869 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOMethod.c,v 1.1 2008/05/31 11:42:19 dkf Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.2 2008/05/31 22:29:46 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -235,7 +235,7 @@ void TclOODelMethodRef( Method *mPtr) { - if ((mPtr != NULL) && (--mPtr->refCount < 0)) { + if ((mPtr != NULL) && (--mPtr->refCount <= 0)) { if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } |