From 83f6cc3841131f68cf0b1b4bb410ce6b52157629 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 30 Mar 2019 12:41:59 +0000
Subject: Tests, and reduce number of copies.

---
 generic/tclCmdIL.c | 36 +++++++++++++++++++++++++++++-------
 tests/cmdIL.test   | 51 ++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 77 insertions(+), 10 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 0e36455..441090c 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2743,9 +2743,13 @@ Tcl_LremoveObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, idxc;
-    list_index_t listLen, *idxv, prevIdx;
+    list_index_t listLen, *idxv, prevIdx, first, num;
     Tcl_Obj *listObj;
 
+    /*
+     * Parse the arguments.
+     */
+
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
 	return TCL_ERROR;
@@ -2780,13 +2784,14 @@ Tcl_LremoveObjCmd(
     }
 
     /*
-     * Make our working copy, then do the actual removes piecemeal. It would
-     * be more efficient to do range coalescing; contributions accepted!
+     * Make our working copy, then do the actual removes piecemeal.
      */
 
     if (Tcl_IsShared(listObj)) {
 	listObj = TclListObjCopy(NULL, listObj);
     }
+    num = 0;
+    first = listLen;
     for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
 	list_index_t idx = idxv[i];
 
@@ -2803,12 +2808,29 @@ Tcl_LremoveObjCmd(
 	}
 
 	/*
-	 * Note that this operation can't fail now; we know we have a list and
-	 * we're only ever contracting that list.
+	 * Coalesce adjacent removes to reduce the number of copies.
 	 */
 
-	(void) Tcl_ListObjReplace(interp, listObj, idx, 1, 0, NULL);
-	listLen--;
+	if (num == 0) {
+	    num = 1;
+	    first = idx;
+	} else if (idx + 1 == first) {
+	    num++;
+	    first = idx;
+	} else {
+	    /*
+	     * Note that this operation can't fail now; we know we have a list
+	     * and we're only ever contracting that list.
+	     */
+
+	    (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
+	    listLen -= num;
+	    num = 1;
+	    first = idx;
+	}
+    }
+    if (num != 0) {
+	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
     }
     ckfree(idxv);
     Tcl_SetObjResult(interp, listObj);
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index e4931a4..215796f 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -19,7 +19,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Used for constraining memory leak tests
 testConstraint memory [llength [info commands memory]]
 testConstraint testobj [llength [info commands testobj]]
-
+
 test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
     lsort
 } -result {wrong # args: should be "lsort ?-option value ...? list"}
@@ -774,6 +774,52 @@ test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
     rename K {}
 } -result 1
 
+test cmdIL-8.1 {lremove command: error path} -returnCodes error -body {
+    lremove
+} -result {wrong # args: should be "lremove list ?index ...?"}
+test cmdIL-8.2 {lremove command: error path} -returnCodes error -body {
+    lremove {{}{}}
+} -result {list element in braces followed by "{}" instead of space}
+test cmdIL-8.3 {lremove command: error path} -returnCodes error -body {
+    lremove {a b c} gorp
+} -result {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}
+test cmdIL-8.4 {lremove command: no indices} -body {
+    lremove {a b c}
+} -result {a b c}
+test cmdIL-8.5 {lremove command: before start} -body {
+    lremove {a b c} -1
+} -result {a b c}
+test cmdIL-8.6 {lremove command: after end} -body {
+    lremove {a b c} 3
+} -result {a b c}
+test cmdIL-8.7 {lremove command} -body {
+    lremove {a b c} 0
+} -result {b c}
+test cmdIL-8.8 {lremove command} -body {
+    lremove {a b c} 1
+} -result {a c}
+test cmdIL-8.9 {lremove command} -body {
+    lremove {a b c} end
+} -result {a b}
+test cmdIL-8.10 {lremove command} -body {
+    lremove {a b c} end-1
+} -result {a c}
+test cmdIL-8.11 {lremove command} -body {
+    lremove {a b c d e} 1 3
+} -result {a c e}
+test cmdIL-8.12 {lremove command} -body {
+    lremove {a b c d e} 3 1
+} -result {a c e}
+test cmdIL-8.13 {lremove command: same index twice} -body {
+    lremove {a b c d e} 2 2
+} -result {a b d e}
+test cmdIL-8.14 {lremove command: same index twice} -body {
+    lremove {a b c d e} 3 end-1
+} -result {a b c e}
+test cmdIL-8.15 {lremove command: many indices} -body {
+    lremove {a b c d e} 1 3 1 4 0
+} -result {c}
+
 # This belongs in info test, but adding tests there breaks tests
 # that compute source file line numbers.
 test info-20.6 {Bug 3587651} -setup {
@@ -782,8 +828,7 @@ test info-20.6 {Bug 3587651} -setup {
     }}}} -body {    namespace eval my {expr {"demo" in [info functions]}}} -cleanup {
     namespace delete my
 } -result 1
-
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
-- 
cgit v0.12