2004-07-21 Kevin Kenny <kennykb@acm.org>

	* generic/tclBasic.c (DeleteInterpProc):
	* generic/tclLiteral.c (TclCleanupLiteralTable):
	* generic/tclInt.h: added a TclCleanupLiteralTable function,
	called from DeleteInterpProc, that frees internal representations
	of shared literals early when an interpreter is being deleted.
	This change corrects a number of memory mismanagement issues in
	the cases where the internal representation of one literal
	contains a reference to another, and avoids conditions such as
	resolved variable names referring to procedure and namespace
	contexts that no longer exist.  [Bug 994838]

3 files changed, 59 insertions, 3 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6e97632..16d5052 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.109 2004/07/12 01:56:12 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.110 2004/07/21 00:42:38 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -1002,6 +1002,7 @@ DeleteInterpProc(interp)
      * table, as it will be freed later in this function without further use.
      */
     
+    TclCleanupLiteralTable(interp, &(iPtr->literalTable));
     TclHandleFree(iPtr->handle);
     TclTeardownNamespace(iPtr->globalNsPtr);
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1526c60..f3db00e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.168 2004/07/07 08:21:26 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.169 2004/07/21 00:42:38 kennykb Exp $
  */
 
 #ifndef _TCLINT
@@ -1717,6 +1717,8 @@ EXTERN int		TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
 EXTERN int		TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *value));
+EXTERN void             TclCleanupLiteralTable _ANSI_ARGS_((
+                            Tcl_Interp* interp, LiteralTable* tablePtr ));
 EXTERN void		TclExpandTokenArray _ANSI_ARGS_((
 			    Tcl_Parse *parsePtr));
 EXTERN int		TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index c887067..58ef176 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -8,11 +8,12 @@
  *	that appears in tclHash.c.
  *
  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLiteral.c,v 1.18 2004/07/15 18:31:34 kennykb Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.19 2004/07/21 00:42:39 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -78,6 +79,58 @@ TclInitLiteralTable(tablePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclCleanupLiteralTable --
+ *
+ *	This procedure frees the internal representation of every
+ *	literal in a literal table.  It is called prior to deleting
+ *	an interp, so that variable refs will be cleaned up properly.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Each literal in the table has its internal representation freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCleanupLiteralTable( interp, tablePtr )
+    Tcl_Interp* interp;		/* Interpreter containing literals to purge */
+    LiteralTable* tablePtr;	/* Points to the literal table being cleaned */
+{
+    int i;
+    LiteralEntry* entryPtr;
+    LiteralEntry* nextPtr;
+    Tcl_Obj* objPtr;
+    Tcl_ObjType* typePtr;
+
+#ifdef TCL_COMPILE_DEBUG
+    TclVerifyGlobalLiteralTable( (Interp*) interp );
+#endif /* TCL_COMPILE_DEBUG */
+
+    for ( i = 0; i < tablePtr->numBuckets; i++ ) {
+	entryPtr = tablePtr->buckets[i];
+	while ( entryPtr != NULL ) {
+	    objPtr = entryPtr->objPtr;
+	    nextPtr = entryPtr->nextPtr;
+	    typePtr = objPtr->typePtr;
+	    if ( ( typePtr != NULL ) && ( typePtr->freeIntRepProc != NULL ) ) {
+		if ( objPtr->bytes == NULL ) {
+		    Tcl_Panic( "literal without a string rep" );
+		}
+		objPtr->typePtr = NULL;
+		typePtr->freeIntRepProc( objPtr );
+	    }
+	    entryPtr = nextPtr;
+	}
+    }
+}
+	    
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclDeleteLiteralTable --
  *
  *	This procedure frees up everything associated with a literal table