Implement TIP 524

1 files changed, 34 insertions, 4 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 01be0fc..0440395 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -26,6 +26,7 @@ static const struct {
     int flag;
 } defineCmds[] = {
     {"constructor", TclOODefineConstructorObjCmd, 0},
+    {"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
     {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
     {"destructor", TclOODefineDestructorObjCmd, 0},
     {"export", TclOODefineExportObjCmd, 0},
@@ -445,6 +446,7 @@ InitClassSystemRoots(
 {
     Class fakeCls;
     Object fakeObject;
+    Tcl_Obj *defNsName;
 
     /* Stand up a phony class for bootstrapping. */
     fPtr->objectCls = &fakeCls;
@@ -456,16 +458,25 @@ 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(defNsName, "::oo::objdefine");
+    fPtr->objectCls->objDefinitionNs = defNsName;
+    Tcl_IncrRefCount(defNsName);
 
     fPtr->classCls = TclOOAllocClass(interp,
 	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
@@ -480,7 +491,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 +505,9 @@ InitClassSystemRoots(
 
     fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
     fPtr->classCls->flags |= ROOT_CLASS;
+    TclNewLiteralStringObj(defNsName, "::oo::define");
+    fPtr->classCls->clsDefinitionNs = defNsName;
+    Tcl_IncrRefCount(defNsName);
 
     /* Standard initialization for new Objects */
     TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
@@ -959,6 +976,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.
      */