* generic/tkConfig.c: Added another dimension of refCounting to the

        * generic/tkInt.c:      "option" Tcl_ObjType to improve memory troubles
        * generic/tkObj.c:      detailed in [Bug 2492179].  Also removed
        registration of the "option" Tcl_ObjType.
        *** POTENTIAL INCOMPATIBILITY *** for callers of
        Tcl_GetObjType("option") which must now handle a NULL return.

4 files changed, 60 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 67022b7..23f5e8a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2009-12-15  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tkConfig.c:	Added another dimension of refCounting to the
+	* generic/tkInt.c:	"option" Tcl_ObjType to improve memory troubles
+	* generic/tkObj.c:	detailed in [Bug 2492179].  Also removed
+	registration of the "option" Tcl_ObjType.
+	*** POTENTIAL INCOMPATIBILITY *** for callers of
+	Tcl_GetObjType("option") which must now handle a NULL return.
+
 2009-12-15  Donal K. Fellows  <dkf@users.sf.net>
 
 	* library/demos/unicodeout.tcl (usePresentationFormsFor): Split out
diff --git a/generic/tkConfig.c b/generic/tkConfig.c
index ccdfdb0..d220423 100644
--- a/generic/tkConfig.c
+++ b/generic/tkConfig.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkConfig.c,v 1.31 2009/06/30 00:56:29 das Exp $
+ * RCS: @(#) $Id: tkConfig.c,v 1.32 2009/12/15 18:12:07 dgp Exp $
  */
 
 /*
@@ -102,6 +102,8 @@ typedef struct OptionTable {
 				 * chain. */
     int numOptions;		/* The number of items in the options array
 				 * below. */
+    int refCount2; /* Reference counter for controlling the freeing
+                    * of the memory occupied by this OptionTable */
     Option options[1];		/* Information about the individual options in
 				 * the table. This must be the last field in
 				 * the structure: the actual size of the array
@@ -127,6 +129,7 @@ static Option *		GetOption(const char *name, OptionTable *tablePtr);
 static Option *		GetOptionFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, OptionTable *tablePtr);
 static int		ObjectIsEmpty(Tcl_Obj *objPtr);
+static void		FreeOptionInternalRep(Tcl_Obj *objPtr);
 static int		SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
@@ -136,9 +139,9 @@ static int		SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  * the internalPtr2 field points to the entry that matched.
  */
 
-const Tcl_ObjType tkOptionObjType = {
+static const Tcl_ObjType optionObjType = {
     "option",			/* name */
-    NULL,			/* freeIntRepProc */
+    FreeOptionInternalRep,	/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     NULL,			/* updateStringProc */
     SetOptionFromAny		/* setFromAnyProc */
@@ -222,6 +225,7 @@ Tk_CreateOptionTable(
     tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable)
 	    + (numOptions * sizeof(Option))));
     tablePtr->refCount = 1;
+    tablePtr->refCount2 = 1;
     tablePtr->hashEntryPtr = hashEntryPtr;
     tablePtr->nextPtr = NULL;
     tablePtr->numOptions = numOptions;
@@ -357,7 +361,10 @@ Tk_DeleteOptionTable(
 	}
     }
     Tcl_DeleteHashEntry(tablePtr->hashEntryPtr);
-    ckfree((char *) tablePtr);
+    tablePtr->refCount2--;
+    if (tablePtr->refCount2 <= 0) {
+	ckfree((char *) tablePtr);
+    }
 }
 
 /*
@@ -1130,7 +1137,7 @@ GetOptionFromObj(
      * First, check to see if the object already has the answer cached.
      */
 
-    if (objPtr->typePtr == &tkOptionObjType) {
+    if (objPtr->typePtr == &optionObjType) {
 	if (objPtr->internalRep.twoPtrValue.ptr1 == (void *) tablePtr) {
 	    return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
 	}
@@ -1152,7 +1159,8 @@ GetOptionFromObj(
     }
     objPtr->internalRep.twoPtrValue.ptr1 = (void *) tablePtr;
     objPtr->internalRep.twoPtrValue.ptr2 = (void *) bestPtr;
-    objPtr->typePtr = &tkOptionObjType;
+    objPtr->typePtr = &optionObjType;
+    tablePtr->refCount2++;
     return bestPtr;
 
   error:
@@ -1229,6 +1237,41 @@ SetOptionFromAny(
 	    NULL);
     return TCL_ERROR;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeOptionInternalRep --
+ *
+ *	Part of the option Tcl object type implementation. Frees the storage
+ *	associated with a option object's internal representation unless it
+ *	is still in use.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The option object's internal rep is marked invalid and its memory
+ *	gets freed unless it is still in use somewhere. In that case the
+ *	cleanup is delayed until the last reference goes away.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeOptionInternalRep(
+    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
+{
+    register OptionTable *tablePtr = (OptionTable *) objPtr->internalRep.twoPtrValue.ptr1;
+
+    tablePtr->refCount2--;
+    if (tablePtr->refCount2 <= 0) {
+	ckfree((char *)tablePtr);
+    }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+}
 
 /*
  *--------------------------------------------------------------
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 81e3967..ee9441e 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: $Id: tkInt.h,v 1.114 2009/12/09 10:45:30 dkf Exp $
+ * RCS: $Id: tkInt.h,v 1.115 2009/12/15 18:12:07 dgp Exp $
  */
 
 #ifndef _TKINT
@@ -926,7 +926,6 @@ MODULE_SCOPE const Tcl_ObjType tkBitmapObjType;
 MODULE_SCOPE const Tcl_ObjType tkColorObjType;
 MODULE_SCOPE const Tcl_ObjType tkCursorObjType;
 MODULE_SCOPE const Tcl_ObjType tkFontObjType;
-MODULE_SCOPE const Tcl_ObjType tkOptionObjType;
 MODULE_SCOPE const Tcl_ObjType tkStateKeyObjType;
 MODULE_SCOPE const Tcl_ObjType tkTextIndexType;
 
diff --git a/generic/tkObj.c b/generic/tkObj.c
index d3ce270..e78d7d2 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.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: tkObj.c,v 1.26 2009/02/03 23:55:47 nijtmans Exp $
+ * RCS: @(#) $Id: tkObj.c,v 1.27 2009/12/15 18:12:07 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -1075,7 +1075,6 @@ TkRegisterObjTypes(void)
     Tcl_RegisterObjType(&tkCursorObjType);
     Tcl_RegisterObjType(&tkFontObjType);
     Tcl_RegisterObjType(&mmObjType);
-    Tcl_RegisterObjType(&tkOptionObjType);
     Tcl_RegisterObjType(&pixelObjType);
     Tcl_RegisterObjType(&tkStateKeyObjType);
     Tcl_RegisterObjType(&windowObjType);