merge pyk-listdictstringreppyk_trunk

8 files changed, 184 insertions, 35 deletions

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 428173d..613cdc8 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -62,6 +62,8 @@ static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
 static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
 static void		InvalidateDictChain(Tcl_Obj *dictObj);
+static void		InvalidateListRep(Tcl_Obj *dictObj);
+static void		InvalidateOtherReps(Tcl_Obj *dictObj);
 static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
 static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
@@ -426,6 +428,7 @@ FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
     Dict *dict = DICT(dictPtr);
+    InvalidateListRep(dictPtr);
 
     dict->refcount--;
     if (dict->refcount <= 0) {
@@ -497,13 +500,24 @@ UpdateStringOfDict(
     const char *elem;
     char *dst;
     const int maxFlags = UINT_MAX / sizeof(int);
+    Tcl_Obj *listObj;
+    int numElems;
+
+    if (dictPtr->internalRep.twoPtrValue.ptr2 != NULL) {
+	listObj = dictPtr->internalRep.twoPtrValue.ptr2;
+	TclGetString(listObj);
+	dictPtr->bytes = listObj->bytes;
+	dictPtr->length = listObj->length;
+	listObj->bytes = NULL;
+	return;
+    }
 
     /*
      * This field is the most useful one in the whole hash structure, and it
      * is not exposed by any API function...
      */
 
-    int numElems = dict->table.numEntries * 2;
+    numElems = dict->table.numEntries * 2;
 
     /* Handle empty list case first, simplifies what follows */
     if (numElems == 0) {
@@ -603,8 +617,9 @@ SetDictFromAny(
     Tcl_Obj *objPtr)
 {
     Tcl_HashEntry *hPtr;
-    int isNew;
+    int isNew, needlist = 0;
     Dict *dict = ckalloc(sizeof(Dict));
+    Tcl_Obj *listObj;
 
     InitChainTable(dict);
 
@@ -614,12 +629,14 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (objPtr->typePtr == &tclListType) {
+
+    listObj = TclObjLookupTyped(objPtr, &tclListType);
+    if (listObj != NULL) {
 	int objc, i;
 	Tcl_Obj **objv;
 
 	/* Cannot fail, we already know the Tcl_ObjType is "list". */
-	TclListObjGetElements(NULL, objPtr, &objc, &objv);
+	TclListObjGetElements(NULL, listObj, &objc, &objv);
 	if (objc & 1) {
 	    goto missingValue;
 	}
@@ -630,16 +647,8 @@ SetDictFromAny(
 	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
 	    if (!isNew) {
 		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
-
-		/*
-		 * Not really a well-formed dictionary as there are duplicate
-		 * keys, so better get the string rep here so that we can
-		 * convert back.
-		 */
-
-		(void) Tcl_GetString(objPtr);
-
-		TclDecrRefCount(discardedValue);
+		needlist = 1;
+		Tcl_DecrRefCount(discardedValue);
 	    }
 	    Tcl_SetHashValue(hPtr, objv[i+1]);
 	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
@@ -710,12 +719,21 @@ SetDictFromAny(
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    TclFreeIntRep(objPtr);
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
+    if (needlist) {
+	/* squirrel the list intrep away for use by SetListFromAny  */
+	listObj = Tcl_DuplicateObj(listObj);
+	Tcl_IncrRefCount(listObj);
+    }
+    TclFreeIntRep(objPtr);
+    if (needlist) {
+	objPtr->internalRep.twoPtrValue.ptr2 = listObj;
+    } else {
+	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    }
     DICT(objPtr) = dict;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclDictType;
     return TCL_OK;
 
@@ -866,7 +884,7 @@ InvalidateDictChain(
     Dict *dict = DICT(dictObj);
 
     do {
-	TclInvalidateStringRep(dictObj);
+	InvalidateOtherReps(dictObj);
 	dict->epoch++;
 	dictObj = dict->chain;
 	if (dictObj == NULL) {
@@ -877,6 +895,25 @@ InvalidateDictChain(
     } while (dict != NULL);
 }
 
+static void InvalidateListRep(
+    Tcl_Obj *dictObj
+) {
+    Tcl_Obj *listObj;
+
+    if (dictObj->internalRep.twoPtrValue.ptr2 != NULL) {
+	listObj = dictObj->internalRep.twoPtrValue.ptr2;
+	Tcl_DecrRefCount(listObj);
+	dictObj->internalRep.twoPtrValue.ptr2 = NULL;
+    }
+}
+
+static void InvalidateOtherReps(
+    Tcl_Obj * dictObj
+) {
+    TclInvalidateStringRep(dictObj);
+    InvalidateListRep(dictObj);
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -917,7 +954,7 @@ Tcl_DictObjPut(
     }
 
     if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
     dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
@@ -1017,7 +1054,7 @@ Tcl_DictObjRemove(
     dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
 	if (dictPtr->bytes != NULL) {
-	    TclInvalidateStringRep(dictPtr);
+	    InvalidateOtherReps(dictPtr);
 	}
 	dict->epoch++;
     }
@@ -1631,7 +1668,7 @@ DictReplaceCmd(
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
     if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
     for (i=2 ; i<objc ; i+=2) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
@@ -1681,9 +1718,7 @@ DictRemoveCmd(
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    InvalidateOtherReps(dictPtr);
     for (i=2 ; i<objc ; i++) {
 	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
@@ -2155,7 +2190,7 @@ DictIncrCmd(
 	}
     }
     if (code == TCL_OK) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
 	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
 		dictPtr, TCL_LEAVE_ERR_MSG);
 	if (valuePtr == NULL) {
@@ -2244,7 +2279,7 @@ DictLappendCmd(
     if (allocatedValue) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
     } else if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
 
     resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4cf86c4..d5c4345 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -883,6 +883,7 @@ typedef struct VarInHash {
     (TclIsVarDirectModifyable(varPtr) &&\
 	(!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
 
+
 /*
  *----------------------------------------------------------------
  * Data structures related to procedures. These are used primarily in
@@ -2424,6 +2425,7 @@ typedef struct List {
 #define TclListObjIsCanonical(listPtr) \
     (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
 
+
 /*
  * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
  * TclNRLmapCmd and their compilations.
@@ -2510,6 +2512,28 @@ typedef struct List {
 
 #define DICT_PATH_NON_EXISTENT	((Tcl_Obj *) (void *) 1)
 
+/* 
+ * Macros for tclStringType objects
+ */
+
+#define TclStringGetPrev(objPtr)					    \
+    ((Tcl_Obj *)((objPtr)->internalRep.twoPtrValue.ptr2))
+#define TclStringSetPrev(objPtr,prevPtr)				    \
+    do {								    \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (prevPtr);   \
+    } while (0)
+#define TclStringInvalidatePrev(objPtr)				    \
+    do {								    \
+	if (TclStringGetPrev((objPtr)) != NULL) {			    \
+	    Tcl_DecrRefCount(TclStringGetPrev((objPtr)));		    \
+	}								    \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = NULL;		    \
+    } while (0)
+
+#define TclStringPrevIs(objPtr, checkTypePtr) \
+    (TclStringGetPrev((objPtr))->typePtr == &(checkTypePtr))
+
+
 /*
  *----------------------------------------------------------------
  * Data structures related to the filesystem internals
@@ -3042,6 +3066,7 @@ MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[],
 			    Tcl_Namespace *nsPtr, int flags);
+MODULE_SCOPE Tcl_Obj *	TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typeptr);
 MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
 			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
 MODULE_SCOPE int	TclParseBackslash(const char *src,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 14b8a14..0852c8c 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -13,6 +13,7 @@
 
 #include "tclInt.h"
 
+#define LIST(listObj)    ((List *)(listObj)->internalRep.twoPtrValue.ptr1)
 /*
  * Prototypes for functions defined later in this file:
  */
@@ -20,8 +21,8 @@
 static List *		AttemptNewList(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 static List *		NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
-static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void		FreeListInternalRep(Tcl_Obj *listPtr);
+static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfList(Tcl_Obj *listPtr);
 
@@ -1822,18 +1823,28 @@ SetListFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     Tcl_Obj *objPtr)		/* The object to convert. */
 {
+    Tcl_Obj *listPtr;
     List *listRepPtr;
     Tcl_Obj **elemPtrs;
 
     /*
-     * Dictionaries are a special case; they have a string representation such
-     * that *all* valid dictionaries are valid lists. Hence we can convert
-     * more directly. Only do this when there's no existing string rep; if
-     * there is, it is the string rep that's authoritative (because it could
-     * describe duplicate keys).
+     * Dictionaries are a special case; they may have stored a previous list
+     * representation
      */
 
-    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+     listPtr = TclObjLookupTyped(objPtr, &tclListType);
+     if (listPtr != NULL) {
+	Tcl_IncrRefCount(listPtr);
+	TclFreeIntRep(objPtr);
+	DupListInternalRep(listPtr, objPtr); 
+	Tcl_DecrRefCount(listPtr);
+	objPtr->typePtr = &tclListType;
+	/* To Do: Maybe keep the dict intrep around in case this object is
+	 * used as a dict again */
+	return TCL_OK;
+     }
+
+    if (objPtr->typePtr == &tclDictType) {
 	Tcl_Obj *keyPtr, *valuePtr;
 	Tcl_DictSearch search;
 	int done, size;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index df17f13..ea1e5ae 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4492,6 +4492,46 @@ Tcl_RepresentationCmd(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupObjTyped  --
+ *
+ *	Given a Tcl_Obj, find an corresponding object, if one exists, of a
+ *	given type.
+ *
+ * Results:
+ *	The found object, or, if no such corresponding object was found, NULL.
+ *	
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typePtr) {
+    Tcl_Obj *foundPtr;
+    if (typePtr == objPtr->typePtr) {
+	return objPtr;
+    }
+    if (objPtr->typePtr == &tclStringType) {
+	foundPtr = TclStringGetPrev(objPtr);
+	if (foundPtr == NULL) {
+	    return NULL;
+	}
+	return TclObjLookupTyped(foundPtr, typePtr);
+    }
+    if (typePtr == &tclListType) {
+	if (objPtr->typePtr == &tclDictType && objPtr->internalRep.twoPtrValue.ptr2 != NULL) {
+	    /* A usable list representation exists.  */
+	    return objPtr->internalRep.twoPtrValue.ptr2;
+	}
+    }
+    return NULL;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 6b850e3..2cf8b4a 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -379,6 +379,7 @@ Tcl_NewUnicodeObj(
     Tcl_Obj *objPtr;
 
     TclNewObj(objPtr);
+    TclStringSetPrev(objPtr, NULL); 
     SetUnicodeObj(objPtr, unicode, numChars);
     return objPtr;
 }
@@ -987,11 +988,17 @@ Tcl_SetUnicodeObj(
     int numChars)		/* Number of characters in the unicode
 				 * string. */
 {
+    Tcl_Obj *prevPtr = NULL;
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
     }
+    if (objPtr->typePtr != NULL && objPtr->typePtr != &tclStringType) {
+	prevPtr = Tcl_DuplicateObj(objPtr);
+	Tcl_IncrRefCount(prevPtr);
+    }
     TclFreeIntRep(objPtr);
     SetUnicodeObj(objPtr, unicode, numChars);
+    TclStringSetPrev(objPtr, prevPtr); 
 }
 
 static int
@@ -1037,7 +1044,6 @@ SetUnicodeObj(
     stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
     stringPtr->hasUnicode = 1;
-
     TclInvalidateStringRep(objPtr);
     stringPtr->allocated = 0;
 }
@@ -1373,6 +1379,9 @@ AppendUnicodeToUnicodeRep(
     }
 
     SetStringFromAny(NULL, objPtr);
+    if (appendNumChars > 0) {
+	TclStringInvalidatePrev(objPtr);
+    }
     stringPtr = GET_STRING(objPtr);
 
     /*
@@ -1526,6 +1535,7 @@ AppendUtfToUtfRep(
     if (numBytes == 0) {
 	return;
     }
+    TclStringInvalidatePrev(objPtr);
 
     /*
      * Copy the new string onto the end of the old string, then add the
@@ -2827,6 +2837,9 @@ ExtendUnicodeRepWithString(
     if (numAppendChars == -1) {
 	TclNumUtfChars(numAppendChars, bytes, numBytes);
     }
+    if (numAppendChars > 0) {
+	TclStringInvalidatePrev(objPtr);
+    }
     needed = numOrigChars + numAppendChars;
     stringCheckLimits(needed);
 
@@ -2874,6 +2887,7 @@ DupStringInternalRep(
 {
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
+    Tcl_Obj *prevPtr;
 
     if (srcStringPtr->numChars == -1) {
 	/*
@@ -2915,10 +2929,15 @@ DupStringInternalRep(
      * code, so it doesn't contain any extra bytes that might exist in the
      * source object.
      */
-
     copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
 
     SET_STRING(copyPtr, copyStringPtr);
+    prevPtr = TclStringGetPrev(srcPtr);
+    if (prevPtr != NULL) {
+	prevPtr = Tcl_DuplicateObj(prevPtr);
+	Tcl_IncrRefCount(prevPtr);
+    }
+    TclStringSetPrev(copyPtr, prevPtr);
     copyPtr->typePtr = &tclStringType;
 }
 
@@ -2946,6 +2965,8 @@ SetStringFromAny(
 {
     if (objPtr->typePtr != &tclStringType) {
 	String *stringPtr = stringAlloc(0);
+	Tcl_Obj *prevPtr = Tcl_DuplicateObj(objPtr);
+	Tcl_IncrRefCount(prevPtr);
 
 	/*
 	 * Convert whatever we have into an untyped value. Just A String.
@@ -2964,6 +2985,7 @@ SetStringFromAny(
 	stringPtr->maxChars = 0;
 	stringPtr->hasUnicode = 0;
 	SET_STRING(objPtr, stringPtr);
+	TclStringSetPrev(objPtr, prevPtr);
 	objPtr->typePtr = &tclStringType;
     }
     return TCL_OK;
@@ -3022,6 +3044,7 @@ ExtendStringRepWithUnicode(
     if (numChars == 0) {
 	return 0;
     }
+    TclStringInvalidatePrev(objPtr);
 
     if (objPtr->bytes == NULL) {
 	objPtr->length = 0;
@@ -3083,10 +3106,23 @@ static void
 FreeStringInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
+    Tcl_Obj * prevPtr = TclStringGetPrev(objPtr);
+    if (prevPtr != NULL) {
+	Tcl_DecrRefCount(prevPtr);
+    }
     ckfree(GET_STRING(objPtr));
     objPtr->typePtr = NULL;
 }
 
+static void InvalidateCachedReps(
+    Tcl_Obj *objPtr
+) {
+    Tcl_Obj * prevPtr = TclStringGetPrev(objPtr);
+    if (prevPtr != NULL) {
+	Tcl_DecrRefCount(TclStringGetPrev(objPtr));
+    }
+}
+
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 018f006..12ce1c3 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -624,6 +624,7 @@ TclThreadFreeObj(
 
     GETCACHE(cachePtr);
 
+
     /*
      * Get this thread's list and push on the free Tcl_Obj.
      */
diff --git a/unix/Makefile.in b/unix/Makefile.in
index eb083e0..7d967e3 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -718,6 +718,7 @@ gdb-test: ${TCLTEST_EXE}
 	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
 	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
 	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
+	@echo "$(GDBSCRIPT)" >> gdb.run
 	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
 	rm gdb.run
 
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index f5aa84e..29bc0f5 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -734,7 +734,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
     AC_MSG_CHECKING([for build with symbols])
     AC_ARG_ENABLE(symbols,
 	AC_HELP_STRING([--enable-symbols],
-	    [build with debugging symbols (default: off)]),
+	    [build with debugging symbols (all, compile, or mem) (default: off)]),
 	[tcl_ok=$enableval], [tcl_ok=no])
 # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
     DBGX=""