diff options
| author | apnadkarni <apnmbx-wits@yahoo.com> | 2022-09-27 03:02:16 (GMT) |
|---|---|---|
| committer | apnadkarni <apnmbx-wits@yahoo.com> | 2022-09-27 03:02:16 (GMT) |
| commit | b9209ab689797e5b663cde94d13a41a42243fa2d (patch) | |
| tree | 5b3f1b1f776ea2444cc7e13451e634b3ba4c6cf6 | |
| parent | 3636d805fcf6da495f444297a7159347ff1ed3a0 (diff) | |
| parent | 04723a6f3ec693a032d5a4d211a2c8d55df6e8b3 (diff) | |
| download | tcl-b9209ab689797e5b663cde94d13a41a42243fa2d.zip tcl-b9209ab689797e5b663cde94d13a41a42243fa2d.tar.gz tcl-b9209ab689797e5b663cde94d13a41a42243fa2d.tar.bz2 | |
TIP 631
| -rw-r--r-- | doc/interp.n | 20 | ||||
| -rw-r--r-- | doc/lappend.n | 2 | ||||
| -rw-r--r-- | doc/lassign.n | 2 | ||||
| -rw-r--r-- | doc/ledit.n | 91 | ||||
| -rw-r--r-- | doc/lindex.n | 2 | ||||
| -rw-r--r-- | doc/linsert.n | 2 | ||||
| -rw-r--r-- | doc/list.n | 2 | ||||
| -rw-r--r-- | doc/llength.n | 2 | ||||
| -rw-r--r-- | doc/lmap.n | 2 | ||||
| -rw-r--r-- | doc/lpop.n | 2 | ||||
| -rw-r--r-- | doc/lrange.n | 2 | ||||
| -rw-r--r-- | doc/lremove.n | 2 | ||||
| -rw-r--r-- | doc/lrepeat.n | 2 | ||||
| -rw-r--r-- | doc/lreplace.n | 2 | ||||
| -rw-r--r-- | doc/lreverse.n | 2 | ||||
| -rw-r--r-- | doc/lsearch.n | 2 | ||||
| -rw-r--r-- | doc/lset.n | 2 | ||||
| -rw-r--r-- | doc/lsort.n | 2 | ||||
| -rw-r--r-- | generic/tclBasic.c | 1 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 117 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | tests/lreplace.test | 295 |
22 files changed, 533 insertions, 26 deletions
diff --git a/doc/interp.n b/doc/interp.n index 2943404..b3cc918 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -591,16 +591,16 @@ built-in commands: \fBflush\fR \fBfor\fR \fBforeach\fR \fBformat\fR \fBgets\fR \fBglobal\fR \fBif\fR \fBincr\fR \fBinfo\fR \fBinterp\fR \fBjoin\fR \fBlappend\fR -\fBlassign\fR \fBlindex\fR \fBlinsert\fR \fBlist\fR -\fBllength\fR \fBlrange\fR \fBlrepeat\fR \fBlreplace\fR -\fBlsearch\fR \fBlset\fR \fBlsort\fR \fBnamespace\fR -\fBpackage\fR \fBpid\fR \fBproc\fR \fBputs\fR -\fBread\fR \fBregexp\fR \fBregsub\fR \fBrename\fR -\fBreturn\fR \fBscan\fR \fBseek\fR \fBset\fR -\fBsplit\fR \fBstring\fR \fBsubst\fR \fBswitch\fR -\fBtell\fR \fBtime\fR \fBtrace\fR \fBunset\fR -\fBupdate\fR \fBuplevel\fR \fBupvar\fR \fBvariable\fR -\fBvwait\fR \fBwhile\fR +\fBlassign\fR \fBledit\fR \fBlindex\fR \fBlinsert\fR +\fBlist\fR \fBllength\fR \fBlrange\fR \fBlrepeat\fR +\fBlreplace\fR \fBlsearch\fR \fBlset\fR \fBlsort\fR +\fBnamespace\fR \fBpackage\fR \fBpid\fR \fBproc\fR +\fBputs\fR \fBread\fR \fBregexp\fR \fBregsub\fR +\fBrename\fR \fBreturn\fR \fBscan\fR \fBseek\fR +\fBset\fR \fBsplit\fR \fBstring\fR \fBsubst\fR +\fBswitch\fR \fBtell\fR \fBtime\fR \fBtrace\fR +\fBunset\fR \fBupdate\fR \fBuplevel\fR \fBupvar\fR +\fBvariable\fR \fBvwait\fR \fBwhile\fR .DE The following commands are hidden by \fBinterp create\fR when it creates a safe interpreter: diff --git a/doc/lappend.n b/doc/lappend.n index 89b6909..3ddb36c 100644 --- a/doc/lappend.n +++ b/doc/lappend.n @@ -49,7 +49,7 @@ Using \fBlappend\fR to build up a list of numbers. 1 2 3 4 5 .CE .SH "SEE ALSO" -list(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/lassign.n b/doc/lassign.n index 67048ba..ac53322 100644 --- a/doc/lassign.n +++ b/doc/lassign.n @@ -52,7 +52,7 @@ command in many shell languages like this: set ::argv [\fBlassign\fR $::argv argumentToReadOff] .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/ledit.n b/doc/ledit.n new file mode 100644 index 0000000..f7704ed --- /dev/null +++ b/doc/ledit.n @@ -0,0 +1,91 @@ +'\" +'\" Copyright (c) 2022 Ashok P. Nadkarni <apnmbx-public@yahoo.com>. All rights reserved. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH ledit n 8.7 Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +ledit \- Replace elements of a list stored in variable +.SH SYNOPSIS +\fBledit \fIlistVar first last \fR?\fIvalue value ...\fR? +.BE +.SH DESCRIPTION +.PP +The command fetches the list value in variable \fIlistVar\fR and replaces the +elements in the range given by indices \fIfirst\fR to \fIlast\fR (inclusive) +with the \fIvalue\fR arguments. The resulting list is then stored back in +\fIlistVar\fR and returned as the result of the command. +.PP +Arguments \fIfirst\fR and \fIlast\fR are index values specifying the first and +last elements of the range to replace. They 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. The index 0 refers to the first element of the +list, and \fBend\fR refers to the last element of the list. +.PP +If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered to +refer to the position before the first element of the list. This allows +elements to be prepended. +.PP +If either \fIfirst\fR or \fIlast\fR indicates a position greater than the +index of the last element of the list, it is treated as if it is an +index one greater than the last element. This allows elements to be appended. +.PP +If \fIlast\fR is less than \fIfirst\fR, then any specified elements +will be inserted into the list before the element specified by \fIfirst\fR +with no elements being deleted. +.PP +The \fIvalue\fR arguments specify zero or more new elements to +be added to the list in place of those that were deleted. +Each \fIvalue\fR argument will become a separate element of +the list. If no \fIvalue\fR arguments are specified, then the elements +between \fIfirst\fR and \fIlast\fR are simply deleted. +.SH EXAMPLES +.PP +Prepend to a list. +.PP +.CS +% set lst {c d e f g} +c d e f g +% ledit lst -1 -1 a b +a b c d e f g +.CE +.PP +Append to the list. +.PP +.CS +% ledit lst end+1 end+1 h i +a b c d e f g h i +.CE +.PP +Delete third and fourth elements. +.PP +.CS +% ledit lst 2 3 +a b e f g h i +.CE +.PP +Replace two elements with three. +.PP +.CS +% ledit lst 2 3 x y z +a b x y z g h i +% set lst +a b x y z g h i +.CE +.PP +.SH "SEE ALSO" +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n), +string(n) +.SH KEYWORDS +element, list, replace +.\" Local variables: +.\" mode: nroff +.\" fill-column: 78 +.\" End: diff --git a/doc/lindex.n b/doc/lindex.n index 75fe5e8..0ba30a4 100644 --- a/doc/lindex.n +++ b/doc/lindex.n @@ -115,7 +115,7 @@ set idx 3 \fI\(-> f\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) diff --git a/doc/linsert.n b/doc/linsert.n index 3179256..685b563 100644 --- a/doc/linsert.n +++ b/doc/linsert.n @@ -45,7 +45,7 @@ set newList [\fBlinsert\fR $midList end-1 lazy] set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) @@ -46,7 +46,7 @@ while \fBconcat\fR with the same arguments will return \fBa b c d e f {g h}\fR .CE .SH "SEE ALSO" -lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/llength.n b/doc/llength.n index 26824a0..7a3e6de 100644 --- a/doc/llength.n +++ b/doc/llength.n @@ -49,7 +49,7 @@ An empty list is not necessarily an empty string: 1,0 .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS @@ -78,7 +78,7 @@ set prefix [\fBlmap\fR x $values {expr { .CE .SH "SEE ALSO" break(n), continue(n), for(n), foreach(n), while(n), -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS @@ -86,7 +86,7 @@ The indicated value becomes the new value of \fIx\fR. \fI\(-> {{a b} {c d}} {{e f} h}\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) diff --git a/doc/lrange.n b/doc/lrange.n index 0d4b261..c0434bb 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -71,7 +71,7 @@ elements to {elements to} .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) diff --git a/doc/lremove.n b/doc/lremove.n index 59d261b..e71f607 100644 --- a/doc/lremove.n +++ b/doc/lremove.n @@ -46,7 +46,7 @@ Removing the same element indicated in two different ways: a b d e .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/lrepeat.n b/doc/lrepeat.n index 9a3fc88..de7ba54 100644 --- a/doc/lrepeat.n +++ b/doc/lrepeat.n @@ -32,7 +32,7 @@ is identical to \fBlist element ...\fR. \fI\(-> {a a} b c {a a} b c {a a} b c\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n), lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/lreplace.n b/doc/lreplace.n index bc9d7ca..6694ad7 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -95,7 +95,7 @@ a b c d e f g h i .CE .VE TIP505 .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreverse(n), lsearch(n), lset(n), lsort(n), string(n) diff --git a/doc/lreverse.n b/doc/lreverse.n index e2e3b69..0f0b6d6 100644 --- a/doc/lreverse.n +++ b/doc/lreverse.n @@ -25,7 +25,7 @@ input list, \fIlist\fR, except with the elements in the reverse order. \fI\(-> f e {c d} b a\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS diff --git a/doc/lsearch.n b/doc/lsearch.n index c5dc98f..85b8609 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -229,7 +229,7 @@ The same thing for a flattened list: .CE .SH "SEE ALSO" foreach(n), -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lset(n), lsort(n), string(n) @@ -136,7 +136,7 @@ The indicated return value also becomes the new value of \fIx\fR. \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lsort(n) string(n) diff --git a/doc/lsort.n b/doc/lsort.n index 2018e30..ddf9ed1 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -264,7 +264,7 @@ More complex sorting using a comparison function: {1 dingo} {2 banana} {0x2 carrot} {3 apple} .CE .SH "SEE ALSO" -list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n), llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), lreverse(n), lsearch(n), lset(n) .SH KEYWORDS diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 83111b1..73b997d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -325,6 +325,7 @@ static const CmdInfo builtInCmds[] = { {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 9430eb5..5e13754 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4961,6 +4961,123 @@ Tcl_LsortObjCmd( /* *---------------------------------------------------------------------- * + * Tcl_LeditObjCmd -- + * + * This procedure is invoked to process the "ledit" Tcl command. See the + * user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_LeditObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument values. */ +{ + Tcl_Obj *listPtr; /* Pointer to the list being altered. */ + Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ + int createdNewObj; + int result; + int first; + int last; + int listLen; + int numToDelete; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "listVar first last ?element ...?"); + return TCL_ERROR; + } + + listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + if (listPtr == NULL) { + return TCL_ERROR; + } + + /* + * TODO - refactor the index extraction into a common function shared + * by Tcl_{Lrange,Lreplace,Ledit}ObjCmd + */ + + result = TclListObjLengthM(interp, listPtr, &listLen); + if (result != TCL_OK) { + return result; + } + + result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first); + if (result != TCL_OK) { + return result; + } + + result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last); + if (result != TCL_OK) { + return result; + } + + if (first == TCL_INDEX_NONE) { + first = 0; + } else if (first > listLen) { + first = listLen; + } + + if (last >= listLen) { + last = listLen - 1; + } + if (first <= last) { + numToDelete = last - first + 1; + } else { + numToDelete = 0; + } + + if (Tcl_IsShared(listPtr)) { + listPtr = TclListObjCopy(NULL, listPtr); + createdNewObj = 1; + } else { + createdNewObj = 0; + } + + result = + Tcl_ListObjReplace(interp, listPtr, first, numToDelete, objc - 4, objv + 4); + if (result != TCL_OK) { + if (createdNewObj) { + Tcl_DecrRefCount(listPtr); + } + return result; + } + + /* + * Tcl_ObjSetVar2 mau return a value different from listPtr in the + * presence of traces etc.. Note that finalValuePtr will always have a + * reference count of at least 1 corresponding to the reference from the + * var. If it is same as listPtr, then ref count will be at least 2 + * since we are incr'ing the latter below (safer when calling + * Tcl_ObjSetVar2 which can release it in some cases). Note that we + * leave the incrref of listPtr this late because we want to pass it as + * unshared to Tcl_ListObjReplace above if possible. + */ + Tcl_IncrRefCount(listPtr); + finalValuePtr = + Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG); + Tcl_DecrRefCount(listPtr); /* safe irrespective of createdNewObj */ + if (finalValuePtr == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, finalValuePtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * MergeLists - * * This procedure combines two sorted lists of SortElement structures diff --git a/generic/tclInt.h b/generic/tclInt.h index db0b4f7..bc605db 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3689,6 +3689,9 @@ MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LeditObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/tests/lreplace.test b/tests/lreplace.test index 0b26e86..2952899 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -236,6 +236,301 @@ apply {{} { } }} +# Essentially same tests as above but for ledit +test ledit-1.1 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 0 0 a] $l +} {{a 2 3 4 5} {a 2 3 4 5}} +test ledit-1.2 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 1 1 a] $l +} {{1 a 3 4 5} {1 a 3 4 5}} +test ledit-1.3 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 2 2 a] $l +} {{1 2 a 4 5} {1 2 a 4 5}} +test ledit-1.4 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 3 3 a] $l +} {{1 2 3 a 5} {1 2 3 a 5}} +test ledit-1.5 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 4 4 a] $l +} {{1 2 3 4 a} {1 2 3 4 a}} +test ledit-1.6 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 4 5 a] $l +} {{1 2 3 4 a} {1 2 3 4 a}} +test ledit-1.7 {ledit command} { + set l {1 2 3 4 5} + list [ledit l -1 -1 a] $l +} {{a 1 2 3 4 5} {a 1 2 3 4 5}} +test ledit-1.8 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 2 end a b c d] $l +} {{1 2 a b c d} {1 2 a b c d}} +test ledit-1.9 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 0 3] $l +} {5 5} +test ledit-1.10 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 0 4] $l +} {{} {}} +test ledit-1.11 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 0 1] $l +} {{3 4 5} {3 4 5}} +test ledit-1.12 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 2 3] $l +} {{1 2 5} {1 2 5}} +test ledit-1.13 {ledit command} { + set l {1 2 3 4 5} + list [ledit l 3 end] $l +} {{1 2 3} {1 2 3}} +test ledit-1.14 {ledit command} { + set l {1 2 3 4 5} + list [ledit l -1 4 a b c] $l +} {{a b c} {a b c}} +test ledit-1.15 {ledit command} { + set l {a b "c c" d e f} + list [ledit l 3 3] $l +} {{a b {c c} e f} {a b {c c} e f}} +test ledit-1.16 {ledit command} { + set l { 1 2 3 4 5} + list [ledit l 0 0 a] $l +} {{a 2 3 4 5} {a 2 3 4 5}} +test ledit-1.17 {ledit command} { + set l {1 2 3 4 "5 6"} + list [ledit l 4 4 a] $l +} {{1 2 3 4 a} {1 2 3 4 a}} +test ledit-1.18 {ledit command} { + set l {1 2 3 4 {5 6}} + list [ledit l 4 4 a] $l +} {{1 2 3 4 a} {1 2 3 4 a}} +test ledit-1.19 {ledit command} { + set l {1 2 3 4} + list [ledit l 2 end x y z] $l +} {{1 2 x y z} {1 2 x y z}} +test ledit-1.20 {ledit command} { + set l {1 2 3 4} + list [ledit l end end a] $l +} {{1 2 3 a} {1 2 3 a}} +test ledit-1.21 {ledit command} { + set l {1 2 3 4} + list [ledit l end 3 a] $l +} {{1 2 3 a} {1 2 3 a}} +test ledit-1.22 {ledit command} { + set l {1 2 3 4} + list [ledit l end end] $l +} {{1 2 3} {1 2 3}} +test ledit-1.23 {ledit command} { + set l {1 2 3 4} + list [ledit l 2 -1 xy] $l +} {{1 2 xy 3 4} {1 2 xy 3 4}} +test ledit-1.24 {ledit command} { + set l {1 2 3 4} + list [ledit l end -1 z] $l +} {{1 2 3 z 4} {1 2 3 z 4}} +test ledit-1.25 {ledit command} { + set l {\}\ hello} + concat \"[ledit l end end]\" $l +} {"\}\ " \}\ } +test ledit-1.26 {ledit command} { + catch {unset foo} + set foo {a b} + list [ledit foo end end] $foo \ + [ledit foo end end] $foo \ + [ledit foo end end] $foo +} {a a {} {} {} {}} +test ledit-1.27 {lsubset command} -body { + set l x + list [ledit l 1 1] $l +} -result {x x} +test ledit-1.28 {ledit command} -body { + set l x + list [ledit l 1 1 y] $l +} -result {{x y} {x y}} +test ledit-1.29 {ledit command} -body { + set l x + ledit l 1 1 [error foo] +} -returnCodes 1 -result {foo} +test ledit-1.30 {ledit command} -body { + set l {not {}alist} + ledit l 0 0 [error foo] +} -returnCodes 1 -result {foo} +test ledit-1.31 {ledit command} -body { + unset -nocomplain arr + set arr(x) {a b} + list [ledit arr(x) 0 0 c] $arr(x) +} -result {{c b} {c b}} + +test ledit-2.1 {ledit errors} -body { + list [catch ledit msg] $msg +} -result {1 {wrong # args: should be "ledit listVar first last ?element ...?"}} +test ledit-2.2 {ledit errors} -body { + unset -nocomplain x + list [catch {ledit l b} msg] $msg +} -result {1 {wrong # args: should be "ledit listVar first last ?element ...?"}} +test ledit-2.3 {ledit errors} -body { + set x {} + list [catch {ledit x a 10} msg] $msg +} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} +test ledit-2.4 {ledit errors} -body { + set l {} + list [catch {ledit l 10 x} msg] $msg +} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} +test ledit-2.5 {ledit errors} -body { + set l {} + list [catch {ledit l 10 1x} msg] $msg +} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} +test ledit-2.6 {ledit errors} -body { + set l x + list [catch {ledit l 3 2} msg] $msg +} -result {0 x} +test ledit-2.7 {ledit errors} -body { + set l x + list [catch {ledit l 2 2} msg] $msg +} -result {0 x} +test ledit-2.8 {ledit errors} -body { + unset -nocomplain l + ledit l 0 0 x +} -returnCodes error -result {can't read "l": no such variable} +test ledit-2.9 {ledit errors} -body { + unset -nocomplain arr + ledit arr(x) 0 0 x +} -returnCodes error -result {can't read "arr(x)": no such variable} +test ledit-2.10 {ledit errors} -body { + unset -nocomplain arr + set arr(y) y + ledit arr(x) 0 0 x +} -returnCodes error -result {can't read "arr(x)": no such element in array} + +test ledit-3.1 {ledit won't modify shared argument objects} { + proc p {} { + set l "a b c" + ledit l 1 1 "x y" + # The literal in locals table should be unmodified + return [list "a b c" $l] + } + p +} {{a b c} {a {x y} c}} + +# Following bugs were in lreplace. Make sure ledit does not have them +test ledit-4.1 {Bug ccc2c2cc98: lreplace edge case} { + set l {} + list [ledit l 1 1] $l +} {{} {}} +test ledit-4.2 {Bug ccc2c2cc98: lreplace edge case} { + set l { } + list [ledit l 1 1] $l +} {{} {}} +test ledit-4.3 {lreplace edge case} { + set l {1 2 3} + ledit l 2 0 +} {1 2 3} +test ledit-4.4 {ledit edge case} { + set l {1 2 3 4 5} + list [ledit l 3 1] $l +} {{1 2 3 4 5} {1 2 3 4 5}} +test lreplace-4.5 {lreplace edge case} { + lreplace {1 2 3 4 5} 3 0 _ +} {1 2 3 _ 4 5} +test ledit-4.6 {ledit end-x: bug a4cb3f06c4} { + set l {0 1 2 3 4} + list [ledit l 0 end-2] $l +} {{3 4} {3 4}} +test ledit-4.6.1 {ledit end-x: bug a4cb3f06c4} { + set l {0 1 2 3 4} + list [ledit l 0 end-2 a b c] $l +} {{a b c 3 4} {a b c 3 4}} +test ledit-4.7 {ledit with two end-indexes: increasing} { + set l {0 1 2 3 4} + list [ledit l end-2 end-1] $l +} {{0 1 4} {0 1 4}} +test ledit-4.7.1 {ledit with two end-indexes: increasing} { + set l {0 1 2 3 4} + list [ledit l end-2 end-1 a b c] $l +} {{0 1 a b c 4} {0 1 a b c 4}} +test ledit-4.8 {ledit with two end-indexes: equal} { + set l {0 1 2 3 4} + list [ledit l end-2 end-2] $l +} {{0 1 3 4} {0 1 3 4}} +test ledit-4.8.1 {ledit with two end-indexes: equal} { + set l {0 1 2 3 4} + list [ledit l end-2 end-2 a b c] $l +} {{0 1 a b c 3 4} {0 1 a b c 3 4}} +test ledit-4.9 {ledit with two end-indexes: decreasing} { + set l {0 1 2 3 4} + list [ledit l end-2 end-3] $l +} {{0 1 2 3 4} {0 1 2 3 4}} +test ledit-4.9.1 {ledit with two end-indexes: decreasing} { + set l {0 1 2 3 4} + list [ledit l end-2 end-3 a b c] $l +} {{0 1 a b c 2 3 4} {0 1 a b c 2 3 4}} +test ledit-4.10 {ledit with two equal indexes} { + set l {0 1 2 3 4} + list [ledit l 2 2] $l +} {{0 1 3 4} {0 1 3 4}} +test ledit-4.10.1 {ledit with two equal indexes} { + set l {0 1 2 3 4} + list [ledit l 2 2 a b c] $l +} {{0 1 a b c 3 4} {0 1 a b c 3 4}} +test ledit-4.11 {ledit end index first} { + set l {0 1 2 3 4} + list [ledit l end-2 1 a b c] $l +} {{0 1 a b c 2 3 4} {0 1 a b c 2 3 4}} +test ledit-4.12 {ledit end index first} { + set l {0 1 2 3 4} + list [ledit l end-2 2 a b c] $l +} {{0 1 a b c 3 4} {0 1 a b c 3 4}} +test ledit-4.13 {ledit empty list} { + set l {} + list [ledit l 1 1 1] $l +} {1 1} +test ledit-4.14 {ledit empty list} { + set l {} + list [ledit l 2 2 2] $l +} {2 2} + +test ledit-5.1 {compiled lreplace: Bug 47ac84309b} { + apply {x { + ledit x end 0 + }} {a b c} +} {a b c} +test ledit-5.2 {compiled lreplace: Bug 47ac84309b} { + apply {x { + ledit x end 0 A + }} {a b c} +} {a b A c} + +# Testing for compiled behaviour. Far too many variations to check with +# spelt-out tests. Note that this *just* checks whether the compiled version +# and the interpreted version are the same, not whether the interpreted +# version is correct. +apply {{} { + set lss {{} {a} {a b c} {a b c d}} + set ins {{} A {A B}} + set idxs {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2} + set lreplace lreplace + + foreach ls $lss { + foreach a $idxs { + foreach b $idxs { + foreach i $ins { + set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m] + set tester [list ledit ls $a $b {*}$i] + set script [list catch $tester m] + set script "list \[$script\] \$m" + test ledit-6.[incr n] {ledit battery} -body \ + [list apply [list {ls} $script] $ls] -result $expected + } + } + } + } +}} + # cleanup catch {unset foo} ::tcltest::cleanupTests |
