summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.decls3
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclAbstractList.c36
-rw-r--r--generic/tclAbstractList.h3
-rw-r--r--generic/tclCmdIL.c9
-rw-r--r--generic/tclDecls.h7
-rw-r--r--generic/tclListObj.c18
-rw-r--r--generic/tclStubInit.c1
-rw-r--r--tests/lseq.test6
9 files changed, 77 insertions, 8 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 459534a..75eac1e 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2564,6 +2564,9 @@ declare 689 {
declare 690 {
void *Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr)
}
+declare 691 {
+ Tcl_Obj *Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indicies, Tcl_Obj *valueObj)
+}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
diff --git a/generic/tcl.h b/generic/tcl.h
index 535ae39..00c0462 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -743,7 +743,7 @@ typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr
int *objcptr, struct Tcl_Obj ***objvptr);
typedef void (Tcl_ALFreeConcreteRep) (struct Tcl_Obj *listPtr);
typedef void (Tcl_ALToStringRep) (struct Tcl_Obj *listPtr);
-typedef int (Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+typedef struct Tcl_Obj* (Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
struct Tcl_Obj *indicies,
struct Tcl_Obj *valueObj);
diff --git a/generic/tclAbstractList.c b/generic/tclAbstractList.c
index 5f9466d..209e9ac 100644
--- a/generic/tclAbstractList.c
+++ b/generic/tclAbstractList.c
@@ -628,6 +628,42 @@ void* Tcl_AbstractListGetConcreteRep(
return objPtr->internalRep.twoPtrValue.ptr2;
}
+/* Replace or add the element in the list @indicies with the given new value
+ */
+Tcl_Obj *
+Tcl_AbstractListSetElement(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Obj *indicies,
+ Tcl_Obj *valueObj)
+{
+ Tcl_Obj *returnObj = NULL;
+
+ if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
+ Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr);
+ if (TclAbstractListHasProc(objPtr, TCL_ABSL_SETELEMENT)) {
+ returnObj = typePtr->setElementProc(interp, objPtr, indicies, valueObj);
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_NewStringObj("SetElement not supported!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ returnObj = NULL;
+ }
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(
+ interp,
+ Tcl_ObjPrintf("value is not an abstract list"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
+ }
+ returnObj = NULL;
+ }
+ return returnObj;
+}
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclAbstractList.h b/generic/tclAbstractList.h
index 561d7ba..1c92b42 100644
--- a/generic/tclAbstractList.h
+++ b/generic/tclAbstractList.h
@@ -41,7 +41,8 @@ int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, int
Tcl_Obj ***objvPtr);
Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
-
+Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Obj *indicies, Tcl_Obj *valueObj);
#endif
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 23fca3f..2ce9779 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -4390,11 +4390,16 @@ Tcl_LsetObjCmd(
* unshared copy of it.
*/
- if (objc == 4) {
+ if (TclHasInternalRep(listPtr,&tclAbstractListType) &&
+ TclAbstractListHasProc(listPtr, TCL_ABSL_SETELEMENT) &&
+ objc == 4) {
+ finalValuePtr = Tcl_AbstractListSetElement(interp, listPtr, objv[2], objv[3]);
+ if (finalValuePtr) Tcl_IncrRefCount(finalValuePtr);
+ } else if (objc == 4) {
finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
} else {
finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
- objv[objc-1]);
+ objv[objc-1]);
}
/*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index a4ea41f..8432945 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -2040,6 +2040,10 @@ EXTERN Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp,
Tcl_Obj *listPtr);
/* 690 */
EXTERN void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
+/* 691 */
+EXTERN Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, Tcl_Obj *indicies,
+ Tcl_Obj *valueObj);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2766,6 +2770,7 @@ typedef struct TclStubs {
int (*tcl_AbstractListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 688 */
Tcl_Obj * (*tcl_AbstractListObjCopy) (Tcl_Interp *interp, Tcl_Obj *listPtr); /* 689 */
void * (*tcl_AbstractListGetConcreteRep) (Tcl_Obj *objPtr); /* 690 */
+ Tcl_Obj * (*tcl_AbstractListSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indicies, Tcl_Obj *valueObj); /* 691 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -4176,6 +4181,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_AbstractListObjCopy) /* 689 */
#define Tcl_AbstractListGetConcreteRep \
(tclStubsPtr->tcl_AbstractListGetConcreteRep) /* 690 */
+#define Tcl_AbstractListSetElement \
+ (tclStubsPtr->tcl_AbstractListSetElement) /* 691 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 24082ec..5fe3819 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2761,12 +2761,22 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
- if (!TclHasInternalRep(indexArgObj, &tclListType)
- && TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
- == TCL_OK) {
+ if (!TclHasInternalRep(indexArgObj, &tclListType) &&
+ TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
+ == TCL_OK) {
+
+ if (TclHasInternalRep(listObj,&tclAbstractListType) &&
+ TclAbstractListHasProc(listObj, TCL_ABSL_SETELEMENT)) {
+ Tcl_Obj *returnValue =
+ Tcl_AbstractListSetElement(interp, listObj, indexArgObj, valueObj);
+ if (returnValue) Tcl_IncrRefCount(returnValue);
+ return returnValue;
+ }
+
/* indexArgPtr designates a single index. */
- /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
+ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
+
}
indexListCopy = TclListObjCopy(NULL, indexArgObj);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index c2b83a8..c1d288e 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -2056,6 +2056,7 @@ const TclStubs tclStubs = {
Tcl_AbstractListObjGetElements, /* 688 */
Tcl_AbstractListObjCopy, /* 689 */
Tcl_AbstractListGetConcreteRep, /* 690 */
+ Tcl_AbstractListSetElement, /* 691 */
};
/* !END!: Do not edit above this line. */
diff --git a/tests/lseq.test b/tests/lseq.test
index 2e5d7e1..c5adbae 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -510,6 +510,12 @@ test lseq-4.5 {lindex off by one} -body {
unset res
} -result {4 3}
+test lseq-4.6 {lset shimmer} -body {
+ set l [lseq 15]
+ lappend res $l [lindex [tcl::unsupported::representation $l] 3]
+ lset l 3 25
+ lappend res $l [lindex [tcl::unsupported::representation $l] 3]
+} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries {0 1 2 25 4 5 6 7 8 9 10 11 12 13 14} list}
# cleanup
::tcltest::cleanupTests
generated by cgit v0.12 at 2024-12-24 17:48:54 (GMT)