diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2018-10-27 22:05:34 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2018-10-27 22:05:34 (GMT) |
| commit | 3dc41c544f318f7d4ebc0a3f15f2d6b3476ef4a0 (patch) | |
| tree | cd076cbf428a096a16329bd3123e8578733bdf66 /generic/tclOO.c | |
| parent | 7ecdd17b4d021a420e4eb9996208dcdf54061703 (diff) | |
| download | tcl-3dc41c544f318f7d4ebc0a3f15f2d6b3476ef4a0.zip tcl-3dc41c544f318f7d4ebc0a3f15f2d6b3476ef4a0.tar.gz tcl-3dc41c544f318f7d4ebc0a3f15f2d6b3476ef4a0.tar.bz2 | |
Core machinery for implementing TIP 524; still needs user-facing access commands
Diffstat (limited to 'generic/tclOO.c')
| -rw-r--r-- | generic/tclOO.c | 34 |
1 files changed, 30 insertions, 4 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index 2491c2f..1860796 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -456,16 +456,24 @@ InitClassSystemRoots( /* Corresponding TclOODecrRefCount in KillFoudation */ AddRef(fPtr->objectCls->thisPtr); - /* This is why it is unnecessary in this routine to replace the + /* + * This is why it is unnecessary in this routine to replace the * incremented reference count of fPtr->objectCls that was swallowed by - * fakeObject. */ + * fakeObject. + */ + fPtr->objectCls->superclasses.num = 0; ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; - /* special initialization for the primordial objects */ + /* + * Special initialization for the primordial objects. + */ + fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; + TclNewLiteralStringObj(fPtr->objectCls->objDefinitionNs, "::oo::objdefine"); + Tcl_IncrRefCount(fPtr->objectCls->objDefinitionNs); fPtr->classCls = TclOOAllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); @@ -480,7 +488,10 @@ InitClassSystemRoots( * KillFoundation. */ - /* Rewire bootstrapped objects. */ + /* + * Rewire bootstrapped objects. + */ + fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; AddRef(fPtr->classCls->thisPtr); TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); @@ -491,6 +502,8 @@ InitClassSystemRoots( fPtr->classCls->thisPtr->flags |= ROOT_CLASS; fPtr->classCls->flags |= ROOT_CLASS; + TclNewLiteralStringObj(fPtr->objectCls->clsDefinitionNs, "::oo::define"); + Tcl_IncrRefCount(fPtr->objectCls->clsDefinitionNs); /* Standard initialization for new Objects */ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); @@ -959,6 +972,19 @@ TclOOReleaseClassContents( } /* + * Stop using the class for definition information. + */ + + if (clsPtr->clsDefinitionNs) { + Tcl_DecrRefCount(clsPtr->clsDefinitionNs); + clsPtr->clsDefinitionNs = NULL; + } + if (clsPtr->objDefinitionNs) { + Tcl_DecrRefCount(clsPtr->objDefinitionNs); + clsPtr->objDefinitionNs = NULL; + } + + /* * Squelch method implementation chain caches. */ |