Add version number to AbstractList implementation. Make sure lsort and lreplace do not shimer their input argument.

4 files changed, 28 insertions, 1 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index d4d6190..1fd694a 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -736,6 +736,8 @@ typedef enum {
     TCL_ABSL_SLICE, TCL_ABSL_REVERSE
 } Tcl_AbstractListProcType;
 
+typedef struct Tcl_AbstractListVersion_ *Tcl_AbstractListVersion;
+
 
 #ifndef TCL_NO_DEPRECATED
 #   define Tcl_PackageInitProc Tcl_LibraryInitProc
@@ -826,7 +828,11 @@ typedef struct Tcl_Obj {
  *  List for AbstractList types.
  */
 
+#define TCL_ABSTRACTLIST_VERSION_1 ((Tcl_AbstractListVersion) 0x1)
+
 typedef struct AbstractList {
+    Tcl_AbstractListVersion version;/* Structure version */
+    
     size_t repSize;                 /* value size */
     const char *typeName;           /* Custom value reference */
     
diff --git a/generic/tclAbstractList.c b/generic/tclAbstractList.c
index 5ab965a..5d1888d 100644
--- a/generic/tclAbstractList.c
+++ b/generic/tclAbstractList.c
@@ -94,6 +94,7 @@ Tcl_NewAbstractListObj(Tcl_Interp *interp, const char* typeName, size_t required
     TclNewObj(objPtr);
     repSize = sizeof(AbstractList) + requiredSize;
     abstractListRepPtr = (AbstractList*)ckalloc(repSize);
+    abstractListRepPtr->version = TCL_ABSTRACTLIST_VERSION_1;
     abstractListRepPtr->repSize = repSize;
     abstractListRepPtr->typeName = typeName;;
     abstractListRepPtr->newObjProc = NULL;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 2967ea9..d3ba7cd 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -5054,8 +5054,12 @@ Tcl_LsortObjCmd(
 	sortInfo.compareCmdPtr = newCommandPtr;
     }
 
-    sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
+    if (TclHasInternalRep(listObj,&tclAbstractListType)) {
+	sortInfo.resultCode = Tcl_AbstractListObjGetElements(interp, listObj, &length, &listObjPtrs);
+    } else {
+	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
 	    &length, &listObjPtrs);
+    }
     if (sortInfo.resultCode != TCL_OK || length <= 0) {
 	goto done;
     }
diff --git a/tests/lseq.test b/tests/lseq.test
index 06a2467..1d1923a 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -344,6 +344,21 @@ test lseq-3.25 {edge case} {
     llength [lseq 1 to 1 by 1]
 } {1}
 
+test lseq-3.26 {lsort shimmer} arithSeriesShimmer {
+    set r [lseq 15 0]
+    set rep-before [lindex [tcl::unsupported::representation $r] 3]
+    set lexical_sort [lsort $r]
+    set rep-after [lindex [tcl::unsupported::representation $r] 3]
+    list ${rep-before} $lexical_sort ${rep-after}
+} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}
+
+test lseq-3.27 {lreplace shimmer} arithSeriesShimmer {
+    set r [lseq 15 0]
+    set rep-before [lindex [tcl::unsupported::representation $r] 3]
+    set lexical_sort [lreplace $r 3 5 A B C]
+    set rep-after [lindex [tcl::unsupported::representation $r] 3]
+    list ${rep-before} $lexical_sort ${rep-after}
+} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}
 
 # Test lmap
 # Test "in" expression operator
@@ -352,6 +367,7 @@ test lseq-3.25 {edge case} {
 # Test lrange (lrange of a [lseq] list produces another [lseq] list)
 # Test start,end,step expressions
 # Test lreverse
+# Test lsort shimmer
 # Test lsearch
 # Test array for
 # Test join for shimmer.