tclCmdIL bugfixes (info body & lsort -index end-x)

4 files changed, 63 insertions, 32 deletions

diff --git a/ChangeLog b/ChangeLog
index 7593d27..e4d5219 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2001-10-08  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/cmdIL.test: test improvement.
+	* doc/lsort.n: Doc improvement.
+	* generic/tclCmdIL.c (InfoBodyCmd): Strengthened bytecode
+	isolation [fix orig. by Miguel Sofer]
+	(Tcl_LsortObjCmd, SortCompare): Symbolic indexing values plus
+	correct handling of indexing relative to end in [lsort].
+
 2001-10-05  Miguel Sofer  <msofer@users.sourceforge.net>
 	
 	* generic/tclLiteral.c: (TclReleaseLiteral) insured that
diff --git a/doc/lsort.n b/doc/lsort.n
index 761eada..745d567 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -6,7 +6,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: lsort.n,v 1.5.2.1 2001/04/03 22:06:43 hobbs Exp $
+'\" RCS: @(#) $Id: lsort.n,v 1.5.2.2 2001/10/08 15:50:24 dkf Exp $
 '\" 
 .so man.macros
 .TH lsort n 8.3 Tcl "Tcl Built-In Commands"
@@ -65,15 +65,30 @@ Sort the list in decreasing order (``largest'' items first).
 .TP 20
 \fB\-index\0\fIindex\fR
 If this option is specified, each of the elements of \fIlist\fR must
-itself be a proper Tcl sublist.  Instead of sorting based on whole sublists,
-\fBlsort\fR will extract the \fIindex\fR'th element from each sublist
-and sort based on the given element.  The keyword \fBend\fP is allowed
-for the \fIindex\fP to sort on the last sublist element. For example,
+itself be a proper Tcl sublist.  Instead of sorting based on whole
+sublists, \fBlsort\fR will extract the \fIindex\fR'th element from
+each sublist and sort based on the given element.  The keyword
+\fBend\fP is allowed for the \fIindex\fP to sort on the last sublist
+element,
+.VS 8.3.4
+and \fBend-\fIindex\fR sorts on a sublist element offset from
+the end.
+.VE
+For example,
 .RS
 .CS
 lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
 .CE
-returns \fB{Second 18} {First 24} {Third 30}\fR.
+returns \fB{Second 18} {First 24} {Third 30}\fR, and
+.VS 8.3.4
+'\"
+'\" This example is from the test suite!
+'\"
+.CS
+lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
+.CE
+returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR.
+.VE
 This option is much more efficient than using \fB\-command\fR
 to achieve the same effect.
 .RE
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index aa8f74d..2f8362d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,7 +14,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.24.2.2 2001/07/16 23:14:13 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.24.2.3 2001/10/08 15:50:24 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -73,6 +73,13 @@ typedef struct SortInfo {
 #define SORTMODE_DICTIONARY 4
 
 /*
+ * Magic values for the index field of the SortInfo structure.
+ * Note that the index "end-1" will be translated to SORTIDX_END-1, etc.
+ */
+#define SORTIDX_NONE	-1		/* Not indexed; use whole value. */
+#define SORTIDX_END	-2		/* Indexed from end. */
+
+/*
  * Forward declarations for procedures defined in this file:
  */
 
@@ -562,23 +569,17 @@ InfoBodyCmd(dummy, interp, objc, objv)
         return TCL_ERROR;
     }
 
-    /*
-     * We should not return a bytecompiled body.  If it is precompiled,
-     * then the bodyPtr's string representation is bogus, since sources
-     * are not available.  If it was just a bytecompiled body, then it
-     * is likely to not be of any use to the caller, as it was compiled
-     * for a separate procedure context [Bug: 3412], and noone else can
-     * reasonably use it.
-     * In order to make sure that later manipulations of the object do not
-     * invalidate the internal representation, we make a copy of the string
-     * representation and return that one, instead.
+    /* 
+     * Here we used to return procPtr->bodyPtr, except when the body was
+     * bytecompiled - in that case, the return was a copy of the body's
+     * string rep. In order to better isolate the implementation details
+     * of the compiler/engine subsystem, we now always return a copy of 
+     * the string rep. It is important to return a copy so that later 
+     * manipulations of the object do not invalidate the internal rep.
      */
 
     bodyPtr = procPtr->bodyPtr;
-    resultPtr = bodyPtr;
-    if (bodyPtr->typePtr == &tclByteCodeType) {
-	resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-    }
+    resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
     
     Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
@@ -2519,7 +2520,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 
     sortInfo.isIncreasing = 1;
     sortInfo.sortMode = SORTMODE_ASCII;
-    sortInfo.index = -1;
+    sortInfo.index = SORTIDX_NONE;
     sortInfo.interp = interp;
     sortInfo.resultCode = TCL_OK;
     cmdPtr = NULL;
@@ -2560,8 +2561,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 			    -1);
 		    return TCL_ERROR;
 		}
-		if (TclGetIntForIndex(interp, objv[i+1], -2, &sortInfo.index)
-			!= TCL_OK) {
+		if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
+			&sortInfo.index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 		i++;
@@ -2814,20 +2815,20 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 
 	return order;
     }
-    if (infoPtr->index != -1) {
+    if (infoPtr->index != SORTIDX_NONE) {
 	/*
 	 * The "-index" option was specified.  Treat each object as a
 	 * list, extract the requested element from each list, and
-	 * compare the elements, not the lists.  The special index "end"
-	 * is signaled here with a large negative index.
+	 * compare the elements, not the lists.  "end"-relative indices
+	 * are signaled here with large negative values.
 	 */
 
 	if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
 	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
-	if (infoPtr->index < -1) {
-	    index = listLen - 1;
+	if (infoPtr->index < SORTIDX_NONE) {
+	    index = listLen + infoPtr->index + 1;
 	} else {
 	    index = infoPtr->index;
 	}
@@ -2853,8 +2854,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
-	if (infoPtr->index < -1) {
-	    index = listLen - 1;
+	if (infoPtr->index < SORTIDX_NONE) {
+	    index = listLen + infoPtr->index + 1;
 	} else {
 	    index = infoPtr->index;
 	}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index df4b2ce..219b9e5 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.12.2.1 2001/04/03 22:54:38 hobbs Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.12.2.2 2001/10/08 15:50:24 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -98,6 +98,12 @@ test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} {
     rename testcmp ""
     set result
 } [list 0 [list [list a b] [list c d]]]
+# Note that the required order only exists in the end-1'th element;
+# indexing using the end element or any fixed offset from the start
+# will not work...
+test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
+    lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
+} {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
 
 # Can't think of any good tests for the MergeSort and MergeLists
 # procedures, except a bunch of random lists to sort.