* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index

	options are used. Simplified memory handling logic.

3 files changed, 79 insertions, 63 deletions

diff --git a/ChangeLog b/ChangeLog
index 4321eac..c52dd99 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-26  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
+	options are used. Simplified memory handling logic.
+
 2010-12-20  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWin32Dll.c:    [Patch 3059922]: fixes for mingw64 - gcc4.5.1
@@ -5,8 +10,8 @@
 
 2010-12-20  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* win/configure.in:   Explicitely test for intrinsics support in compiler,
-	before assuming only MSVC has it.
+	* win/configure.in:   Explicitely test for intrinsics support in
+	compiler, before assuming only MSVC has it.
 	* win/configure:      (autoconf-2.59)
 	* generic/tclPanic.c:
 
@@ -31,7 +36,7 @@
 
 2010-12-17  Stuart Cassoff  <stwo@users.sourceforge.net>
 
-	* unix/Makefile.in:  Use 'rpmbuild', not 'rpm' [Bug 2537626].
+	* unix/Makefile.in:  [Bug 2537626]: Use 'rpmbuild', not 'rpm'.
 
 2010-12-16  Jan Nijtmans  <nijtmans@users.sf.net>
 
@@ -41,24 +46,25 @@
 2010-12-15  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclPanic.c:    Restore abort() as it was before.
-	* win/tclWinFile.c:      [Patch 3124554] use ExitProcess() here, like
+	* win/tclWinFile.c:      [Patch 3124554]: Use ExitProcess() here, like
 	in wish.
 
 2010-12-14  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tcl.h:	[Bug 3137454]: Tcl CVS HEAD does not build on GCC 3
+	* generic/tcl.h:	[Bug 3137454]: Tcl CVS HEAD does not build
+	on GCC 3.
 
 2010-12-14  Reinhard Max  <max@suse.de>
 
 	* win/tclWinSock.c (CreateSocket):         Swap the loops over
-	* unix/tclUnixSock.c (CreateClientSocket): local and remote
-	addresses, so that the system's address preference for the remote
-	side decides which family gets tried first. Cleanup and clarify
-	some of the comments.
+	* unix/tclUnixSock.c (CreateClientSocket): local and remote addresses,
+	so that the system's address preference for the remote side decides
+	which family gets tried first. Cleanup and clarify some of the
+	comments.
 
 2010-12-13  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tcl.h:    [Bug 3135271] Link error due to hidden
+	* generic/tcl.h:    [Bug 3135271]: Link error due to hidden
 	* unix/tcl.m4:      symbols (CentOS 4.2)
 	* unix/configure:   (autoconf-2.59)
 	* win/tclWinFile.c:  Undocumented feature, only meant to be
@@ -82,7 +88,8 @@
 2010-12-10 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
 	* generic/tclIO.c: Make sure [fcopy -size ... -command ...] always
-	* tests/io.test:   calls the callback asynchronously, even for size zero.
+	* tests/io.test:   calls the callback asynchronously, even for size
+			   zero.
 
 2010-12-10  Jan Nijtmans  <nijtmans@users.sf.net>
 
@@ -94,14 +101,16 @@
 	* generic/tclIndexObj.c:
 	* generic/tclIOCmd.c:
 	* generic/tclVar.c:
-	* win/tcl.m4:               Fix manifest-generation for 64-bit gcc (mingw-w64)
-	* win/configure.in:         Check for availability of intptr_t and uintptr_t
+	* win/tcl.m4:               Fix manifest-generation for 64-bit gcc
+				    (mingw-w64)
+	* win/configure.in:         Check for availability of intptr_t and
+				    uintptr_t
 	* win/configure:            (autoconf-2.59)
-	* generic/tclInt.decls:     Change first parameter of TclSockMinimumBuffers to
-	* generic/tclIntDecls.h:    ClientData, and TclWin(Get|Set)SockOpt to SOCKET,
-	* generic/tclIntPlatDecls.h:because on Win64 those are 64-bit, which does not fit.
-	* generic/tclIOSock.c:
-	* win/tclWinSock.c:      
+	* generic/tclInt.decls:     Change 1st param of TclSockMinimumBuffers
+	* generic/tclIntDecls.h:    to ClientData, and TclWin(Get|Set)SockOpt
+	* generic/tclIntPlatDecls.h:to SOCKET, because on Win64 those are
+	* generic/tclIOSock.c:	    64-bit, which does not fit.
+	* win/tclWinSock.c:
 	* unix/tclUnixSock.c:
 
 2010-12-09  Donal K. Fellows  <dkf@users.sf.net>
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 8872a7b..5cef561 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.186 2010/12/10 13:08:53 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.187 2010/12/27 00:01:07 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3640,6 +3640,7 @@ Tcl_LsortObjCmd(
     group = 0;
     groupSize = 1;
     groupOffset = 0;
+    indexPtr = NULL;
     for (i = 1; i < objc-1; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
 		&index) != TCL_OK) {
@@ -3672,66 +3673,40 @@ Tcl_LsortObjCmd(
 	    sortInfo.isIncreasing = 1;
 	    break;
 	case LSORT_INDEX: {
+            int indexc, dummy;
 	    Tcl_Obj **indexv;
 
-	    /* === START SPECIAL CASE ===
-	     *
-	     * When reviewing code flow in this function, note that from here
-	     * to the line a bit below (END SPECIAL CASE) the contents of the
-	     * indexc and indexv fields of the sortInfo structure may not be
-	     * matched, so jumping to the done2 label to exit is wrong.
-	     */
-
-	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
-	    }
 	    if (i == objc-2) {
 		Tcl_AppendResult(interp, "\"-index\" option must be "
 			"followed by list index", NULL);
-		return TCL_ERROR;
+                sortInfo.resultCode = TCL_ERROR;
+                goto done2;
 	    }
-
-	    /*
-	     * Take copy to prevent shimmering problems.
-	     */
-
-	    if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
+	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
 		    &indexv) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    /* === END SPECIAL CASE === */
-
-	    switch (sortInfo.indexc) {
-	    case 0:
-		sortInfo.indexv = NULL;
-		break;
-	    case 1:
-		sortInfo.indexv = &sortInfo.singleIndex;
-		break;
-	    default:
-		sortInfo.indexv =
-			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
-		allocatedIndexVector = 1;	/* Cannot use indexc field, as
-						 * it might be decreased by 1
-						 * later. */
+                sortInfo.resultCode = TCL_ERROR;
+                goto done2;
 	    }
 
-	    /*
-	     * Fill the array by parsing each index. We don't know whether
-	     * their scale is sensible yet, but we at least perform the
-	     * syntactic check here.
-	     */
+            /*
+             * Check each of the indices for syntactic correctness. Note that
+             * we do not store the converted values here because we do not
+             * know if this is the only -index option yet and so we can't
+             * allocate any space; that happens after the scan through all the
+             * options is done.
+             */
 
-	    for (j=0 ; j<sortInfo.indexc ; j++) {
+	    for (j=0 ; j<indexc ; j++) {
 		if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
-			&sortInfo.indexv[j]) != TCL_OK) {
+			&dummy) != TCL_OK) {
 		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 			    "\n    (-index option item number %d)", j));
 		    sortInfo.resultCode = TCL_ERROR;
 		    goto done2;
 		}
 	    }
-	    i++;
+	    indexPtr = objv[i+1];
+            i++;
 	    break;
 	}
 	case LSORT_INTEGER:
@@ -3775,6 +3750,35 @@ Tcl_LsortObjCmd(
 	sortInfo.sortMode = SORTMODE_ASCII_NC;
     }
 
+    /*
+     * Now extract the -index list for real, if present. No failures are
+     * expected here; the values are all of the right type or convertible to
+     * it.
+     */
+
+    if (indexPtr) {
+        Tcl_Obj **indexv;
+
+        TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
+        switch (sortInfo.indexc) {
+        case 0:
+            sortInfo.indexv = NULL;
+            break;
+        case 1:
+            sortInfo.indexv = &sortInfo.singleIndex;
+            break;
+        default:
+            sortInfo.indexv =
+		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+            allocatedIndexVector = 1;	/* Cannot use indexc field, as it
+                                         * might be decreased by 1 later. */
+        }
+        for (j=0 ; j<sortInfo.indexc ; j++) {
+            TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
+		    &sortInfo.indexv[j]);
+        }
+    }
+
     listObj = objv[objc-1];
 
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index ca81ea5..b806e65 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.43 2009/12/22 19:49:29 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.44 2010/12/27 00:01:07 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -458,6 +458,9 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
 } -result 0 -cleanup {
     rename test_lsort ""
 }
+test cmdIL-5.6 {lsort with multiple list-style index options} {
+    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
+} {{a b} {b e} {c d}}
 
 # Compiled version
 test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {