summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lrange.n2
-rw-r--r--doc/lremove.n55
-rw-r--r--doc/lreplace.n2
-rw-r--r--generic/tclBasic.c1
-rw-r--r--generic/tclCmdIL.c136
-rw-r--r--generic/tclInt.h3
-rw-r--r--tests/cmdIL.test51
7 files changed, 245 insertions, 5 deletions
diff --git a/doc/lrange.n b/doc/lrange.n
index ba068f6..a4fd98b 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -72,7 +72,7 @@ elements to
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
-lset(n), lreplace(n), lsort(n),
+lset(n), lremove(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
diff --git a/doc/lremove.n b/doc/lremove.n
new file mode 100644
index 0000000..b947863
--- /dev/null
+++ b/doc/lremove.n
@@ -0,0 +1,55 @@
+'\"
+'\" Copyright (c) 2019 Donal K. Fellows.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH lremove n 8.7 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lremove \- Remove elements from a list by index
+.SH SYNOPSIS
+\fBlremove \fIlist\fR ?\fIindex ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+\fBlremove\fR returns a new list formed by simultaneously removing zero or
+more elements of \fIlist\fR at each of the indices given by an arbirary number
+of \fIindex\fR arguments. The indices may be in any order and may be repeated;
+the element at index will only be removed once. The index values are
+interpreted the same as index values for the command \fBstring index\fR,
+supporting simple index arithmetic and indices relative to the end of the
+list. 0 refers to the first element of the list, and \fBend\fR refers to the
+last element of the list.
+.SH EXAMPLES
+.PP
+Removing the third element of a list:
+.PP
+.CS
+% \fBlremove\fR {a b c d e} 2
+a b d e
+.CE
+.PP
+Removing two elements from a list:
+.PP
+.CS
+% \fBlremove\fR {a b c d e} end-1 1
+a c e
+.CE
+.PP
+Removing the same element indicated in two different ways:
+.PP
+.CS
+% \fBlremove\fR {a b c d e} 2 end-2
+a b d e
+.CE
+.SH "SEE ALSO"
+list(n), lrange(n), lsearch(n), lsearch(n)
+.SH KEYWORDS
+element, list, remove
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/lreplace.n b/doc/lreplace.n
index 32b7356..68cddfe 100644
--- a/doc/lreplace.n
+++ b/doc/lreplace.n
@@ -96,7 +96,7 @@ a b c d e f g h i
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
-lset(n), lrange(n), lsort(n),
+lset(n), lrange(n), lremove(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1806557..e377951 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -262,6 +262,7 @@ static const CmdInfo builtInCmds[] = {
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
{"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE},
+ {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index a1a7f3e..441090c 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2704,6 +2704,142 @@ Tcl_LrangeObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_LremoveObjCmd --
+ *
+ * This procedure is invoked to process the "lremove" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef int list_index_t;
+
+static int
+LremoveIndexCompare(
+ const void *el1Ptr,
+ const void *el2Ptr)
+{
+ list_index_t idx1 = *((const list_index_t *) el1Ptr);
+ list_index_t idx2 = *((const list_index_t *) el2Ptr);
+
+ /*
+ * This will put the larger element first.
+ */
+
+ return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
+}
+
+int
+Tcl_LremoveObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i, idxc;
+ 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;
+ }
+
+ listObj = objv[1];
+ if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ idxc = objc - 2;
+ if (idxc == 0) {
+ Tcl_SetObjResult(interp, listObj);
+ return TCL_OK;
+ }
+ idxv = ckalloc((objc - 2) * sizeof(list_index_t));
+ for (i = 2; i < objc; i++) {
+ if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
+ &idxv[i - 2]) != TCL_OK) {
+ ckfree(idxv);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Sort the indices, large to small so that when we remove an index we
+ * don't change the indices still to be processed.
+ */
+
+ if (idxc > 1) {
+ qsort(idxv, idxc, sizeof(list_index_t), LremoveIndexCompare);
+ }
+
+ /*
+ * 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];
+
+ /*
+ * Repeated index and sanity check.
+ */
+
+ if (idx == prevIdx) {
+ continue;
+ }
+ prevIdx = idx;
+ if (idx < 0 || idx >= listLen) {
+ continue;
+ }
+
+ /*
+ * Coalesce adjacent removes to reduce the number of copies.
+ */
+
+ 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);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LrepeatObjCmd --
*
* This procedure is invoked to process the "lrepeat" Tcl command. See
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 89d7ff9..4b8d1ec 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3471,6 +3471,9 @@ MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_LremoveObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
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
generated by cgit v0.12 at 2024-11-17 01:54:27 (GMT)