summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCmdIL.c91
2 files changed, 33 insertions, 63 deletions
diff --git a/ChangeLog b/ChangeLog
index 547601e..db1ae9a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
2007-03-01 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Rewrite to make an
+ efficient private copy of the list argument, so we can operate on the
+ list elements directly with no fear of shimmering effects. Replaces
+ defensive coding schemes that are otherwise required.
+
* generic/tclCmdAH.c (Tcl_ForeachObjCmd): Rewrite to make
efficient private copies of the variable and value lists, so we can
operate on them without any special shimmer defense coding schemes.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 74e94bc..560c9cf 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.97 2007/02/06 21:15:14 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.98 2007/03/01 17:30:55 dgp Exp $
*/
#include "tclInt.h"
@@ -2526,87 +2526,52 @@ Tcl_LassignObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Obj *valueObj; /* Value to assign to variable, as read from
- * the list object or created in the emptyObj
- * variable. */
- Tcl_Obj *emptyObj = NULL; /* If non-NULL, an empty object created for
- * being assigned to variables once we have
- * run out of values from the list object. */
+ Tcl_Obj *listCopyPtr;
Tcl_Obj **listObjv; /* The contents of the list. */
int listObjc; /* The length of the list. */
- int i;
- Tcl_Obj *resPtr;
+ int code = TCL_OK;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "list varName ?varName ...?");
return TCL_ERROR;
}
- /*
- * First assign values out of the list to variables.
- */
+ listCopyPtr = TclListObjCopy(interp, objv[1]);
+ if (listCopyPtr == NULL) {
+ return TCL_ERROR;
+ }
- for (i=0 ; i+2<objc ; i++) {
- /*
- * We do this each time round the loop because that is robust against
- * shimmering nasties.
- */
+ Tcl_ListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
- if (Tcl_ListObjIndex(interp, objv[1], i, &valueObj) != TCL_OK) {
- return TCL_ERROR;
- }
- if (valueObj == NULL) {
- if (emptyObj == NULL) {
- TclNewObj(emptyObj);
- Tcl_IncrRefCount(emptyObj);
- }
- valueObj = emptyObj;
+ objc -= 2;
+ objv += 2;
+ while (code == TCL_OK && objc > 0 && listObjc > 0) {
+ if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
+ *listObjv++, TCL_LEAVE_ERR_MSG)) {
+ code = TCL_ERROR;
}
+ objc--; listObjc--;
+ }
- /*
- * Make sure the reference count for the value being assigned is
- * greater than one (other reference minimally in the list) so we
- * can't get hammered by shimmering.
- */
-
- Tcl_IncrRefCount(valueObj);
- resPtr = Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
- TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(valueObj);
- if (resPtr == NULL) {
- if (emptyObj != NULL) {
- Tcl_DecrRefCount(emptyObj);
+ if (code == TCL_OK && objc > 0) {
+ Tcl_Obj *emptyObj;
+ TclNewObj(emptyObj);
+ Tcl_IncrRefCount(emptyObj);
+ while (code == TCL_OK && objc-- > 0) {
+ if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
+ emptyObj, TCL_LEAVE_ERR_MSG)) {
+ code = TCL_ERROR;
}
- return TCL_ERROR;
}
- }
- if (emptyObj != NULL) {
Tcl_DecrRefCount(emptyObj);
}
- /*
- * Now place a list of any values left over into the interpreter result.
- *
- * First, figure out how many values were not assigned by getting the
- * length of the list. Note that I do not expect this operation to fail.
- */
-
- if (Tcl_ListObjGetElements(interp, objv[1],
- &listObjc, &listObjv) != TCL_OK) {
- return TCL_ERROR;
- }
-
- if (listObjc > objc-2) {
- /*
- * OK, there were left-overs. Make a list of them and slap that back
- * in the interpreter result.
- */
-
- Tcl_SetObjResult(interp,
- Tcl_NewListObj(listObjc - objc + 2, listObjv + objc - 2));
+ if (code == TCL_OK && listObjc > 0) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
}
- return TCL_OK;
+ Tcl_DecrRefCount(listCopyPtr);
+ return code;
}
/*