summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclListObj.c25
-rw-r--r--tests/lset.test84
3 files changed, 99 insertions, 17 deletions
diff --git a/ChangeLog b/ChangeLog
index 324dfba..48873be 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,13 @@
is between n<<DIGIT_BIT and n<<DIGIT_BIT+1. [Bug 2143288]
Thanks to Malcolm Boffey (malcolm.boffey@virgin.net) for
the patch.
+
+ TIP #331 IMPLEMENTATION
+
+ * generic/tclListObj.c (TclLsetFlat):
+ * tests/lset.test: Modified the [lset] command so that it allows
+ for an index of 'end+1', which has the effect of appending an
+ element to the list.
2008-10-04 Jan Nijtmans <nijtmans@users.sf.net>
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index aebaee8..68db503 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.53 2008/09/10 13:03:33 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.54 2008/10/05 22:12:20 kennykb Exp $
*/
#include "tclInt.h"
@@ -1271,7 +1271,7 @@ TclLsetFlat(
/* Index args. */
Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
{
- int index, result;
+ int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
/*
@@ -1335,7 +1335,7 @@ TclLsetFlat(
}
indexArray++;
- if (index < 0 || index >= elemCount) {
+ if (index < 0 || index > elemCount) {
/* ...the index points outside the sublist. */
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
@@ -1352,7 +1352,11 @@ TclLsetFlat(
result = TCL_OK;
if (--indexCount) {
parentList = subListPtr;
- subListPtr = elemPtrs[index];
+ if (index == elemCount) {
+ subListPtr = Tcl_NewObj();
+ } else {
+ subListPtr = elemPtrs[index];
+ }
if (Tcl_IsShared(subListPtr)) {
subListPtr = Tcl_DuplicateObj(subListPtr);
}
@@ -1366,7 +1370,11 @@ TclLsetFlat(
* make and store another copy.
*/
- TclListObjSetElement(NULL, parentList, index, subListPtr);
+ if (index == elemCount) {
+ Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
+ } else {
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
+ }
if (Tcl_IsShared(subListPtr)) {
subListPtr = Tcl_DuplicateObj(subListPtr);
TclListObjSetElement(NULL, parentList, index, subListPtr);
@@ -1428,7 +1436,12 @@ TclLsetFlat(
}
/* Store valuePtr in proper sublist and return */
- TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ Tcl_ListObjLength(NULL, subListPtr, &len);
+ if (index == len) {
+ Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
+ } else {
+ TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ }
Tcl_InvalidateStringRep(subListPtr);
Tcl_IncrRefCount(retValuePtr);
return retValuePtr;
diff --git a/tests/lset.test b/tests/lset.test
index b6d8758..63c0975 100644
--- a/tests/lset.test
+++ b/tests/lset.test
@@ -100,13 +100,19 @@ test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a [list 3] w}
+ testevalex {lset a [list 4] w}
} msg] $msg
} {1 {list index out of range}}
-test lset-4.5 {lset, not compiled, 3 args, index out of range} testevalex {
+test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a [list end--1] w}
+ testevalex {lset a [list end--2] w}
+ } msg] $msg
+} {1 {list index out of range}}
+test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
+ set a {x y z}
+ list [catch {
+ testevalex {lset a [list end+2] w}
} msg] $msg
} {1 {list index out of range}}
test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
@@ -136,13 +142,19 @@ test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a 3 w}
+ testevalex {lset a 4 w}
+ } msg] $msg
+} {1 {list index out of range}}
+test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
+ set a {x y z}
+ list [catch {
+ testevalex {lset a end--2 w}
} msg] $msg
} {1 {list index out of range}}
test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a end--1 w}
+ testevalex {lset a end+2 w}
} msg] $msg
} {1 {list index out of range}}
test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
@@ -275,19 +287,27 @@ test lset-8.6 {lset, not compiled, second index out of range} testevalex {
} {1 {list index out of range}}
test lset-8.7 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a 2 2 h}} msg] $msg
+ list [catch {testevalex {lset a 2 3 h}} msg] $msg
} {1 {list index out of range}}
test lset-8.8 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a {2 2} h}} msg] $msg
+ list [catch {testevalex {lset a {2 3} h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.9a {lset, not compiled, second index out of range} testevalex {
+ set a {{b c} {d e} {f g}}
+ list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
} {1 {list index out of range}}
-test lset-8.9 {lset, not compiled, second index out of range} testevalex {
+test lset-8.9b {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a 2 end--1 h}} msg] $msg
+ list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
} {1 {list index out of range}}
-test lset-8.10 {lset, not compiled, second index out of range} testevalex {
+test lset-8.10a {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a {2 end--1} h}} msg] $msg
+ list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.10b {lset, not compiled, second index out of range} testevalex {
+ set a {{b c} {d e} {f g}}
+ list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
} {1 {list index out of range}}
test lset-8.11 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
@@ -407,6 +427,48 @@ test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {
unset -nocomplain x l
} -result 1
+test lset-16.1 {lset - grow a variable} testevalex {
+ set x {}
+ testevalex {lset x 0 {test 1}}
+ testevalex {lset x 1 {test 2}}
+ set x
+} {{test 1} {test 2}}
+test lset-16.2 {lset - multiple created sublists} testevalex {
+ set x {}
+ testevalex {lset x 0 0 {test 1}}
+} {{{test 1}}}
+test lset-16.3 {lset - sublists 3 deep} testevalex {
+ set x {}
+ testevalex {lset x 0 0 0 {test 1}}
+} {{{{test 1}}}}
+test lset-16.4 {lset - append to inner list} testevalex {
+ set x {test 1}
+ testevalex {lset x 1 1 2}
+ testevalex {lset x 1 2 3}
+ testevalex {lset x 1 2 1 4}
+} {test {1 2 {3 4}}}
+
+test lset-16.5 {lset - grow a variable} testevalex {
+ set x {}
+ testevalex {lset x end+1 {test 1}}
+ testevalex {lset x end+1 {test 2}}
+ set x
+} {{test 1} {test 2}}
+test lset-16.6 {lset - multiple created sublists} testevalex {
+ set x {}
+ testevalex {lset x end+1 end+1 {test 1}}
+} {{{test 1}}}
+test lset-16.7 {lset - sublists 3 deep} testevalex {
+ set x {}
+ testevalex {lset x end+1 end+1 end+1 {test 1}}
+} {{{{test 1}}}}
+test lset-16.8 {lset - append to inner list} testevalex {
+ set x {test 1}
+ testevalex {lset x end end+1 2}
+ testevalex {lset x end end+1 3}
+ testevalex {lset x end end end+1 4}
+} {test {1 2 {3 4}}}
+
catch {unset noRead}
catch {unset noWrite}
catch {rename failTrace {}}
generated by cgit v0.12 at 2024-07-16 08:08:16 (GMT)