[Bug 2918962]: Stop crash when -index and -stride are used together in [lsort].

3 files changed, 51 insertions, 34 deletions

diff --git a/ChangeLog b/ChangeLog
index 7817c07..c047d4f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,30 +1,37 @@
+2009-12-22  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when
+	-index and -stride are used together.
+
 2009-12-21  Jan Nijtmans  <nijtmans@users.sf.net>
 
-    * generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on cygwin
-                                  warning: missing initializer
-    * generic/tclOOInt.h:         prevent conflict with DUPLICATE
-                                  definition in WINAPI's nb30.h
-    * generic/rege_dfa.c:         Fix macro conflict on CYGWIN: don't use "small".
-    * generic/tcl.h               Include <winsock2.h> before <stdio.h> on CYGWIN
-    * generic/tclPathObj.c
-    * generic/tclPort.h
-    * tests/env.test:             Don't unset WINDIR and TERM, it has a special meaning
-                                  on CYGWIN (both in UNIX and WIN32 mode!)
-    * generic/tclPlatDecls.h:     Include <tchar.h> through tclPlatDecls.h
-    * win/tclWinPort.h            stricmp -> strcasecmp
-    * win/tclWinDde.c             _wcsicmp -> wcscasecmp
-    * win/tclWinFile.c
-    * win/tclWinPipe.c
-    * win/tclWinSock.c
-    * unix/tcl.m4                 Add dynamic loading support to CYGWIN
-    * unix/configure (regenerated)
-    * unix/Makefile.in
+	* generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on
+				      cygwin: missing initializer
+	* generic/tclOOInt.h:	      Prevent conflict with DUPLICATE
+				      definition in WINAPI's nb30.h
+	* generic/rege_dfa.c:	      Fix macro conflict on CYGWIN: don't use
+				      "small".
+	* generic/tcl.h		      Include <winsock2.h> before <stdio.h> on
+				      CYGWIN
+	* generic/tclPathObj.c
+	* generic/tclPort.h
+	* tests/env.test:	      Don't unset WINDIR and TERM, it has a
+				      special meaning on CYGWIN (both in UNIX
+				      and WIN32 mode!)
+	* generic/tclPlatDecls.h:     Include <tchar.h> through tclPlatDecls.h
+	* win/tclWinPort.h	      stricmp -> strcasecmp
+	* win/tclWinDde.c	      _wcsicmp -> wcscasecmp
+	* win/tclWinFile.c
+	* win/tclWinPipe.c
+	* win/tclWinSock.c
+	* unix/tcl.m4:		      Add dynamic loading support to CYGWIN
+	* unix/configure (regenerated)
+	* unix/Makefile.in
 
 2009-12-19  Miguel Sofer  <msofer@users.sf.net>
 
-	* generic/tclBasic.c:	Fix for bad cmd resolution by coroutines
-	* tests/coroutine.test: [Bug #2917627]. Thanks to schelte for
-	finding it.
+	* generic/tclBasic.c:	[Bug 2917627]: Fix for bad cmd resolution by
+	* tests/coroutine.test:	coroutines. Thanks to schelte for finding it.
 
 2009-12-16  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 9f9fdda..313c368 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.175 2009/12/07 20:49:28 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.176 2009/12/22 19:49:29 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3526,7 +3526,7 @@ Tcl_LsortObjCmd(
     Tcl_Obj *const objv[])	/* Argument values. */
 {
     int i, j, index, indices, length, nocase = 0, sortMode, indexc;
-    int group, groupSize, groupOffset, idx;
+    int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
     Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
     SortElement *elementArray, *elementPtr;
     SortInfo sortInfo;		/* Information about this sort that needs to
@@ -3640,6 +3640,9 @@ Tcl_LsortObjCmd(
 	    default:
 		sortInfo.indexv =
 			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+		allocatedIndexVector = 1;	/* Cannot use indexc field, as
+						 * it might be decreased by 1
+						 * later. */
 	    }
 
 	    /*
@@ -3782,16 +3785,16 @@ Tcl_LsortObjCmd(
 		sortInfo.indexc = 0;
 		sortInfo.indexv = NULL;
 	    } else {
-		int *new_indexv;
-
 		sortInfo.indexc--;
-		new_indexv =
-			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+
+		/*
+		 * Do not shrink the actual memory block used; that doesn't
+		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
+		 */
+
 		for (i = 0; i < sortInfo.indexc; i++) {
-		    new_indexv[i] = sortInfo.indexv[i+1];
+		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
 		}
-		TclStackFree(interp, sortInfo.indexv);
-		sortInfo.indexv = new_indexv;
 	    }
 	}
     }
@@ -3857,7 +3860,8 @@ Tcl_LsortObjCmd(
 	} else if (sortInfo.sortMode == SORTMODE_REAL) {
 	    double a;
 
-	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
+		    &a) != TCL_OK) {
 		sortInfo.resultCode = TCL_ERROR;
 		goto done1;
 	    }
@@ -3957,7 +3961,7 @@ Tcl_LsortObjCmd(
 	sortInfo.compareCmdPtr = NULL;
     }
   done2:
-    if (sortInfo.indexc > 1) {
+    if (allocatedIndexVector) {
 	TclStackFree(interp, sortInfo.indexv);
     }
     return sortInfo.resultCode;
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 17b0d9e..ca81ea5 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.42 2008/09/29 13:33:17 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.43 2009/12/22 19:49:29 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -140,6 +140,12 @@ test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
 test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
     lsort -stride 2 -index 3 {a b c d}
 } -result {when used with "-stride", the leading "-index" value must be within the group}
+test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
+    lsort -stride 2 -index {0 1} {
+	{{c o d e} 54321} {{b l a h} 94729}
+	{{b i g} 12345} {{d e m o} 34512}
+    }
+} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
 
 # Can't think of any good tests for the MergeSort and MergeLists procedures,
 # except a bunch of random lists to sort.