summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-12-27 00:01:07 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-12-27 00:01:07 (GMT)
commit6ddeb240a8b2366627697111435c5da9aa575dd0 (patch)
treeb0fb2b3b202993ec577cd54f356cd7f27dff58d3
parent009a146e6edc065f4e9d015ad84a40a14c5a870f (diff)
downloadtcl-6ddeb240a8b2366627697111435c5da9aa575dd0.zip
tcl-6ddeb240a8b2366627697111435c5da9aa575dd0.tar.gz
tcl-6ddeb240a8b2366627697111435c5da9aa575dd0.tar.bz2
* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
options are used. Simplified memory handling logic.
-rw-r--r--ChangeLog45
-rw-r--r--generic/tclCmdIL.c92
-rw-r--r--tests/cmdIL.test5
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 {