diff options
| -rw-r--r-- | ChangeLog | 20 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 33 | ||||
| -rw-r--r-- | tests/cmdIL.test | 6 |
3 files changed, 38 insertions, 21 deletions
@@ -1,16 +1,22 @@ +2007-03-09 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss + * tests/cmdIL.test (cmdIL-1.29): of list rep during sorting due + to shimmering. [Bug 1675116] + 2007-03-09 Kevin B. Kenny <kennykb@acm.org> - * library/clock.tcl (ReadZoneinfoFile): Added Y2038 compliance to - the code for version-2 'zoneinfo' files. + * library/clock.tcl (ReadZoneinfoFile): Added Y2038 compliance to the + code for version-2 'zoneinfo' files. * tests/clock.test (clock-56.3): Added a test case for Y2038 and - 'zoneinfo'. Modified test initialisation to use the - 'loadTestedCommands' function of tcltest to bring in the - correct path for the registry library. - + 'zoneinfo'. Modified test initialisation to use the + 'loadTestedCommands' function of tcltest to bring in the correct path + for the registry library. + 2007-03-08 Don Porter <dgp@users.sourceforge.net> * generic/tclListObj.c (TclLsetList): Rewrite so that the routine - itself does not do any direct intrep surgery. Better isolates those + itself does not do any direct intrep surgery. Better isolates those things into the implementation of the "list" Tcl_ObjType. 2007-03-08 Donal K. Fellows <donal.k.fellows@man.ac.uk> diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 18de024..e71f043 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.108 2007/03/08 11:19:32 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.109 2007/03/09 16:40:21 dkf Exp $ */ #include "tclInt.h" @@ -3862,12 +3862,9 @@ Tcl_LsortObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument values. */ { - int i, index, unique, indices; - Tcl_Obj *resultPtr; - int length; - Tcl_Obj *cmdPtr, **listObjPtrs; - SortElement *elementArray; - SortElement *elementPtr; + int i, index, unique, indices, length; + Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj; + SortElement *elementArray, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ static CONST char *switches[] = { @@ -4001,6 +3998,7 @@ Tcl_LsortObjCmd( break; } } + listObj = objv[objc-1]; if (sortInfo.sortMode == SORTMODE_COMMAND) { /* @@ -4024,9 +4022,18 @@ Tcl_LsortObjCmd( } Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj()); sortInfo.compareCmdPtr = newCommandPtr; + + /* + * When sorting using a command, we are reentrant and therefore might + * have the representation of the list being sorted shimmered out from + * underneath our feet. Take a copy (cheap) to prevent this. [Bug + * 1675116] + */ + + listObj = Tcl_DuplicateObj(listObj); } - sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1], + sortInfo.resultCode = Tcl_ListObjGetElements(interp, listObj, &length, &listObjPtrs); if (sortInfo.resultCode != TCL_OK || length <= 0) { goto done; @@ -4045,27 +4052,26 @@ Tcl_LsortObjCmd( if (indices) { for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){ if (elementPtr->count == 0) { - Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(elementPtr - &elementArray[0])); } } } else { for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) { if (elementPtr->count == 0) { - Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_ListObjAppendElement(NULL, resultPtr, elementPtr->objPtr); } } } } else if (indices) { for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { - Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(elementPtr - &elementArray[0])); } } else { for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) { - Tcl_ListObjAppendElement(interp, resultPtr, - elementPtr->objPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, elementPtr->objPtr); } } Tcl_SetObjResult(interp, resultPtr); @@ -4075,6 +4081,7 @@ Tcl_LsortObjCmd( done: if (sortInfo.sortMode == SORTMODE_COMMAND) { Tcl_DecrRefCount(sortInfo.compareCmdPtr); + Tcl_DecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } if (sortInfo.indexc > 1) { diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 083d393..d8e956f 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.31 2007/03/02 17:56:27 dgp Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.32 2007/03/09 16:40:21 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -118,6 +118,10 @@ test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} { test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} { lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6} } {2 3 0} +test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} { + set l {1 2 3} + string length [lsort -command {apply {args {string length $::l}}} $l] +} 5 # Can't think of any good tests for the MergeSort and MergeLists # procedures, except a bunch of random lists to sort. |