diff options
| -rw-r--r-- | ChangeLog | 45 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 92 | ||||
| -rw-r--r-- | tests/cmdIL.test | 5 |
3 files changed, 79 insertions, 63 deletions
@@ -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 { |