From 200652b205a0115c80b4a03b815da7024e84e50e Mon Sep 17 00:00:00 2001 From: aspect Date: Sat, 11 Feb 2017 07:21:02 +0000 Subject: Apply ferrieux' shimmer-alex.patch from ticket [738900] --- generic/tclListObj.c | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index e1dba8c..1ba019a 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1665,6 +1665,32 @@ DupListInternalRep( ListSetIntRep(copyPtr, listRepPtr); } + +static Tcl_Obj * +TclDupShaved( + Tcl_Obj *objPtr) /* The object to duplicate. */ +{ + Tcl_Obj *dupPtr; + const Tcl_ObjType *typePtr = objPtr->typePtr; + + TclNewObj(dupPtr); + dupPtr->bytes = NULL; + if (typePtr) { + if (typePtr->dupIntRepProc) { + typePtr->dupIntRepProc((objPtr), (dupPtr)); + } else { + (dupPtr)->internalRep = (objPtr)->internalRep; + (dupPtr)->typePtr = typePtr; + } + } else { + Tcl_Panic("Attempting to shave a pure string: %p", objPtr); + } + + return dupPtr; +} + + + /* *---------------------------------------------------------------------- * @@ -1734,6 +1760,34 @@ SetListFromAny( Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } + + } else if ((objPtr->typePtr == &tclIntType) +#ifndef TCL_WIDE_INT_IS_LONG + || (objPtr->typePtr == &tclWideIntType) +#endif + || (objPtr->typePtr == &tclBooleanType) + || (objPtr->typePtr == &tclDoubleType) + || (objPtr->typePtr == &tclBignumType) + || (objPtr->typePtr == &tclEndOffsetType) +/* || (objPtr->typePtr == &tclOneWordHashKeyType) ?? */ + ) { + + Tcl_Obj *newElem; + /* + * create a new list consisting of only one element, + * which is the original object + */ + + listRepPtr = AttemptNewList(interp, 1, NULL); + if (listRepPtr == NULL) { + return TCL_ERROR; + } + listRepPtr->elemCount = 1; + newElem = TclDupShaved(objPtr); + elemPtrs = &listRepPtr->elements; + elemPtrs[0] = newElem; + Tcl_IncrRefCount(newElem); + } else { int estCount, length; const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); -- cgit v0.12