Merge trunk. Just keep some shortcuts, no longer guarantee that SetListFromAny() really returns a list type. Still experimental.

11 files changed, 68 insertions, 39 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b4d0a7b..63c5590 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6055,7 +6055,7 @@ TclNREvalObjEx(
         TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
 		objPtr, NULL);
 
-	ListObjGetElements(listPtr, objc, objv);
+	TclListObjGetElements(NULL, listPtr, &objc, &objv);
 	return TclNREvalObjv(interp, objc, objv, flags, NULL);
     }
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 23e6bd1..ba1fc41 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -989,8 +989,11 @@ TclNRSourceObjCmd(
 {
     const char *encodingName = NULL;
     Tcl_Obj *fileName;
+    int result;
+    void **pkgFiles = NULL;
+    void *names = NULL;
 
-    if (objc != 2 && objc !=4) {
+    if (objc < 2 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
 	return TCL_ERROR;
     }
@@ -1008,9 +1011,30 @@ TclNRSourceObjCmd(
 	    return TCL_ERROR;
 	}
 	encodingName = TclGetString(objv[2]);
-    }
+    } else if (objc == 3) {
+	/* Handle undocumented -nopkg option. This should only be
+	 * used by the internal ::tcl::Pkg::source utility function. */
+	static const char *const nopkgoptions[] = {
+	    "-nopkg", NULL
+	};
+	int index;
 
-    return TclNREvalFile(interp, fileName, encodingName);
+	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
+		"option", TCL_EXACT, &index)) {
+	    return TCL_ERROR;
+	}
+	pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+	/* Make sure that during the following TclNREvalFile no filenames
+	 * are recorded for inclusion in the "package files" command */
+	names = *pkgFiles;
+	*pkgFiles = NULL;
+    }
+    result = TclNREvalFile(interp, fileName, encodingName);
+    if (pkgFiles) {
+	/* restore "tclPkgFiles" assocdata to how it was. */
+	*pkgFiles = names;
+    }
+    return result;
 }
 
 /*
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 1115999..970978f 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -506,7 +506,7 @@ UpdateStringOfDict(
 
     /* Handle empty list case first, simplifies what follows */
     if (numElems == 0) {
-	dictPtr->bytes = tclEmptyStringRep;
+	dictPtr->bytes = &tclEmptyString;
 	dictPtr->length = 0;
 	return;
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5074378..4b87962 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2745,7 +2745,6 @@ MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
  * shared by all new objects allocated by Tcl_NewObj.
  */
 
-MODULE_SCOPE char *	tclEmptyStringRep;
 MODULE_SCOPE char	tclEmptyString;
 
 /*
@@ -4066,7 +4065,7 @@ typedef const char *TclDTraceStr;
     TclIncrObjsAllocated(); \
     TclAllocObjStorage(objPtr); \
     (objPtr)->refCount = 0; \
-    (objPtr)->bytes    = tclEmptyStringRep; \
+    (objPtr)->bytes    = &tclEmptyString; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
     TCL_DTRACE_OBJ_CREATE(objPtr)
@@ -4083,7 +4082,7 @@ typedef const char *TclDTraceStr;
 	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
 	    TCL_DTRACE_OBJ_FREE(objPtr); \
 	    if ((objPtr)->bytes \
-		    && ((objPtr)->bytes != tclEmptyStringRep)) { \
+		    && ((objPtr)->bytes != &tclEmptyString)) { \
 		ckfree((objPtr)->bytes); \
 	    } \
 	    (objPtr)->length = -1; \
@@ -4244,7 +4243,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 
 #define TclInitStringRep(objPtr, bytePtr, len) \
     if ((len) == 0) { \
-	(objPtr)->bytes	 = tclEmptyStringRep; \
+	(objPtr)->bytes	 = &tclEmptyString; \
 	(objPtr)->length = 0; \
     } else { \
 	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
@@ -4302,7 +4301,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 
 #define TclInvalidateStringRep(objPtr) \
     if ((objPtr)->bytes != NULL) { \
-	if ((objPtr)->bytes != tclEmptyStringRep) { \
+	if ((objPtr)->bytes != &tclEmptyString) { \
 	    ckfree((objPtr)->bytes); \
 	} \
 	(objPtr)->bytes = NULL; \
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 3369902..e29e547 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -374,7 +374,7 @@ Tcl_SetListObj(
 	listRepPtr = NewListIntRep(objc, objv, 1);
 	ListSetIntRep(objPtr, listRepPtr);
     } else {
-	objPtr->bytes = tclEmptyStringRep;
+	objPtr->bytes = &tclEmptyString;
 	objPtr->length = 0;
     }
 }
@@ -407,6 +407,7 @@ TclListObjCopy(
 				 * to be returned. */
 {
     Tcl_Obj *copyPtr;
+    int length;
 
     if (listPtr->typePtr != &tclListType) {
 	if (SetListFromAny(interp, listPtr) != TCL_OK) {
@@ -415,10 +416,11 @@ TclListObjCopy(
     }
 
     TclNewObj(copyPtr);
-    if (ListRepPtr(listPtr)->elemCount > 0) {
+    TclListObjLength(NULL, listPtr, &length);
+    if (length > 0) {
 	TclInvalidateStringRep(copyPtr);
+	DupListInternalRep(listPtr, copyPtr);
     }
-    DupListInternalRep(listPtr, copyPtr);
     return copyPtr;
 }
 
@@ -467,15 +469,15 @@ Tcl_ListObjGetElements(
     if (listPtr->typePtr != &tclListType) {
 	int result;
 
-	if (listPtr->bytes && !listPtr->bytes[0]) {
-	    *objcPtr = 0;
-	    *objvPtr = NULL;
-	    return TCL_OK;
-	}
 	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
+	if (listPtr->bytes == &tclEmptyString) {
+	    *objcPtr = 0;
+	    *objvPtr = NULL;
+	    return TCL_OK;
+	}
     }
     listRepPtr = ListRepPtr(listPtr);
     *objcPtr = listRepPtr->elemCount;
@@ -577,7 +579,7 @@ Tcl_ListObjAppendElement(
     if (listPtr->typePtr != &tclListType) {
 	int result;
 
-	if (listPtr->bytes && !listPtr->bytes[0]) {
+	if (listPtr->bytes == &tclEmptyString) {
 	    Tcl_SetListObj(listPtr, 1, &objPtr);
 	    return TCL_OK;
 	}
@@ -741,7 +743,7 @@ Tcl_ListObjIndex(
     if (listPtr->typePtr != &tclListType) {
 	int result;
 
-	if (listPtr->bytes && !listPtr->bytes[0]) {
+	if (listPtr->bytes == &tclEmptyString) {
 	    *objPtrPtr = NULL;
 	    return TCL_OK;
 	}
@@ -794,7 +796,7 @@ Tcl_ListObjLength(
     if (listPtr->typePtr != &tclListType) {
 	int result;
 
-	if (listPtr->bytes && !listPtr->bytes[0]) {
+	if (listPtr->bytes == &tclEmptyString) {
 	    *intPtr = 0;
 	    return TCL_OK;
 	}
@@ -865,7 +867,7 @@ Tcl_ListObjReplace(
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
     }
     if (listPtr->typePtr != &tclListType) {
-	if (listPtr->bytes && !listPtr->bytes[0]) {
+	if (listPtr->bytes == &tclEmptyString) {
 	    if (!objc) {
 		return TCL_OK;
 	    }
@@ -1652,7 +1654,7 @@ TclListObjSetElement(
     if (listPtr->typePtr != &tclListType) {
 	int result;
 
-	if (listPtr->bytes && !listPtr->bytes[0]) {
+	if (listPtr->bytes == &tclEmptyString) {
 	    if (interp != NULL) {
 		Tcl_SetObjResult(interp,
 			Tcl_NewStringObj("list index out of range", -1));
@@ -1873,6 +1875,7 @@ SetListFromAny(
 	int estCount, length;
 	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
 
+	if (length == 0) return TCL_OK;
 	/*
 	 * Allocate enough space to hold a (Tcl_Obj *) for each
 	 * (possible) list element.
@@ -1981,7 +1984,7 @@ UpdateStringOfList(
      */
 
     if (numElems == 0) {
-	listPtr->bytes = tclEmptyStringRep;
+	listPtr->bytes = &tclEmptyString;
 	listPtr->length = 0;
 	return;
     }
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 90df579..1abbb31 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -49,7 +49,6 @@ Tcl_Mutex tclObjMutex;
  */
 
 char tclEmptyString = '\0';
-char *tclEmptyStringRep = &tclEmptyString;
 
 #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
 /*
@@ -1060,7 +1059,7 @@ TclDbInitNewObj(
 				 * debugging. */
 {
     objPtr->refCount = 0;
-    objPtr->bytes = tclEmptyStringRep;
+    objPtr->bytes = &tclEmptyString;
     objPtr->length = 0;
     objPtr->typePtr = NULL;
 
@@ -3395,7 +3394,7 @@ GetBignumFromObj(
 		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 		objPtr->typePtr = NULL;
 		if (objPtr->bytes == NULL) {
-		    TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+		    TclInitStringRep(objPtr, &tclEmptyString, 0);
 		}
 	    }
 	    return TCL_OK;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 68ec2c4..0053041 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -2608,7 +2608,7 @@ UpdateStringOfFsPath(
 
     pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
     pathPtr->length = cwdLen;
-    copy->bytes = tclEmptyStringRep;
+    copy->bytes = &tclEmptyString;
     copy->length = 0;
     TclDecrRefCount(copy);
 }
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 42dd08d..0759faa 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -17,6 +17,10 @@
 
 #include "tclInt.h"
 
+MODULE_SCOPE char *tclEmptyStringRep;
+
+char *tclEmptyStringRep = &tclEmptyString;
+
 /*
  * Each invocation of the "package ifneeded" command creates a structure of
  * the following type, which is used to load the package into the interpreter
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 6346636..ddf764b 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1015,11 +1015,11 @@ ResetObjResult(
 	Tcl_IncrRefCount(objResultPtr);
 	iPtr->objResultPtr = objResultPtr;
     } else {
-	if (objResultPtr->bytes != tclEmptyStringRep) {
+	if (objResultPtr->bytes != &tclEmptyString) {
 	    if (objResultPtr->bytes) {
 		ckfree(objResultPtr->bytes);
 	    }
-	    objResultPtr->bytes = tclEmptyStringRep;
+	    objResultPtr->bytes = &tclEmptyString;
 	    objResultPtr->length = 0;
 	}
 	TclFreeIntRep(objResultPtr);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 046f07d..c45baa1 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -136,7 +136,7 @@ GrowStringBuffer(
     char *ptr = NULL;
     int attempt;
 
-    if (objPtr->bytes == tclEmptyStringRep) {
+    if (objPtr->bytes == &tclEmptyString) {
 	objPtr->bytes = NULL;
     }
     if (flag == 0 || stringPtr->allocated > 0) {
@@ -767,7 +767,7 @@ Tcl_SetObjLength(
 	    /*
 	     * Need to enlarge the buffer.
 	     */
-	    if (objPtr->bytes == tclEmptyStringRep) {
+	    if (objPtr->bytes == &tclEmptyString) {
 		objPtr->bytes = ckalloc(length + 1);
 	    } else {
 		objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
@@ -873,7 +873,7 @@ Tcl_AttemptSetObjLength(
 
 	    char *newBytes;
 
-	    if (objPtr->bytes == tclEmptyStringRep) {
+	    if (objPtr->bytes == &tclEmptyString) {
 		newBytes = attemptckalloc(length + 1);
 	    } else {
 		newBytes = attemptckrealloc(objPtr->bytes, length + 1);
@@ -1202,7 +1202,7 @@ Tcl_AppendObjToObj(
      * that appending nothing to anything leaves that starting anything...
      */
 
-    if (appendObjPtr->bytes && !appendObjPtr->bytes[0]) {
+    if (appendObjPtr->bytes == &tclEmptyString) {
 	return;
     }
 
@@ -1213,7 +1213,7 @@ Tcl_AppendObjToObj(
      * information; this is a special-case optimization only.
      */
 
-    if ((TclIsPureByteArray(objPtr) || (objPtr->bytes && !objPtr->bytes[0]))
+    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
 	    && TclIsPureByteArray(appendObjPtr)) {
 
 	/*
@@ -3603,7 +3603,7 @@ UpdateStringOfString(
     stringPtr->allocated = 0;
 
     if (stringPtr->numChars == 0) {
-	TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+	TclInitStringRep(objPtr, &tclEmptyString, 0);
     } else {
 	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
 		stringPtr->numChars);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 198c9fc..a4d523a 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1384,7 +1384,7 @@ TclConvertElement(
      */
 
     if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
-	src = tclEmptyStringRep;
+	src = &tclEmptyString;
 	length = 0;
 	conversion = CONVERT_BRACE;
     }
@@ -2954,7 +2954,7 @@ Tcl_DStringGetResult(
 
     if (!iPtr->result[0] && iPtr->objResultPtr
 	    && !Tcl_IsShared(iPtr->objResultPtr)) {
-	if (iPtr->objResultPtr->bytes && !iPtr->objResultPtr->bytes[0]) {
+	if (iPtr->objResultPtr->bytes == &tclEmptyString) {
 	    dsPtr->string = dsPtr->staticSpace;
 	    dsPtr->string[0] = 0;
 	    dsPtr->length = 0;
@@ -2964,7 +2964,7 @@ Tcl_DStringGetResult(
 	    dsPtr->length = iPtr->objResultPtr->length;
 	    dsPtr->spaceAvl = dsPtr->length + 1;
 	    TclFreeIntRep(iPtr->objResultPtr);
-	    iPtr->objResultPtr->bytes = tclEmptyStringRep;
+	    iPtr->objResultPtr->bytes = &tclEmptyString;
 	    iPtr->objResultPtr->length = 0;
 	}
 	return;