Tcl Source Code

Artifact 0f358cee01eb5d19ba0323b985d52daf14fe5cc2:

Attachment "lrange_cleanup.patch" to ticket [1890831fff] added by ferrieux 2008-02-11 06:30:17.

---

diff -aburN tcl8.5.1-orig/generic/tclCmdIL.c tcl8.5.1/generic/tclCmdIL.c
--- tcl8.5.1-orig/generic/tclCmdIL.c	Tue Jan 22 11:38:33 2008
+++ tcl8.5.1/generic/tclCmdIL.c	Sun Feb 10 22:30:25 2008
@@ -2325,52 +2325,65 @@
     register Tcl_Obj *CONST objv[])
 				/* Argument objects. */
 {
-    Tcl_Obj *listPtr, **elemPtrs;
-    int listLen, first, result;
+    Tcl_Obj **elemPtrs;
+    int listLen, first, last, result;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	return TCL_ERROR;
     }
 
-    /*
-     * Make sure the list argument is a list object and get its length and a
-     * pointer to its array of element pointers.
-     */
-
-    listPtr = TclListObjCopy(interp, objv[1]);
-    if (listPtr == NULL) {
-	return TCL_ERROR;
+    result = TclListObjLength(interp, objv[1], &listLen);
+    if (result != TCL_OK) {
+	return result;
     }
-    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
 
     result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
 	    &first);
-    if (result == TCL_OK) {
-	int last;
-
+    if (result != TCL_OK) {
+	return result;
+    }
 	if (first < 0) {
 	    first = 0;
 	}
 
 	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
 		&last);
-	if (result == TCL_OK) {
+    if (result != TCL_OK) {
+	return result;
+    }
 	    if (last >= listLen) {
 		last = (listLen - 1);
 	    }
 
-	    if (first <= last) {
-		int numElems = (last - first + 1);
+    if (first>last) {
+	/* returning an empty list is easy */
+	return TCL_OK;
+    }
 
-		Tcl_SetObjResult(interp,
-			Tcl_NewListObj(numElems, &(elemPtrs[first])));
+    result=TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
 	    }
+
+    if (Tcl_IsShared(objv[1])||(((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1))
+	{
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewListObj(last - first + 1, &(elemPtrs[first])));
 	}
+    else
+	{
+	    /* in-place is possible */
+	    if (last<(listLen-1))
+		Tcl_ListObjReplace(interp,objv[1], last+1, listLen-1-last, 0, NULL);
+	    /* this one is not conditioned on (first>0) in order to
+	     * preserve the string-canonizing effect of [lrange 0 end] */
+	    Tcl_ListObjReplace(interp,objv[1], 0, first, 0, NULL);
+	    Tcl_SetObjResult(interp,objv[1]);
     }
 
-    Tcl_DecrRefCount(listPtr);
-    return result;
+
+    return TCL_OK;
 }
 
 /*