summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-04-28 12:34:21 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-04-28 12:34:21 (GMT)
commit9fe48f681df7e7a45aee145405151f0bef5d5808 (patch)
treea7dfc6ac4db8ceaa9a7d3fceccf59bbe274caa74 /generic/tclVar.c
parent270dd26ada27456d73cfdcaf7623fee880227569 (diff)
downloadtcl-9fe48f681df7e7a45aee145405151f0bef5d5808.zip
tcl-9fe48f681df7e7a45aee145405151f0bef5d5808.tar.gz
tcl-9fe48f681df7e7a45aee145405151f0bef5d5808.tar.bz2
Made [incr] able to accept and work with wide increments [Bug 728838]
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c159
1 files changed, 158 insertions, 1 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 2d36e3a..aab35cc 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.71 2003/04/16 23:33:44 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.72 2003/04/28 12:34:31 dkf Exp $
*/
#include "tclInt.h"
@@ -1876,6 +1876,163 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
/*
*----------------------------------------------------------------------
*
+ * TclIncrWideVar2 --
+ *
+ * Given a two-part variable name, which may refer either to a scalar
+ * variable or an element of an array, increment the Tcl object value
+ * of the variable by a specified amount.
+ *
+ * Results:
+ * Returns a pointer to the Tcl_Obj holding the new value of the
+ * variable. If the specified variable doesn't exist, or there is a
+ * clash in array usage, or an error occurs while executing variable
+ * traces, then NULL is returned and a message will be left in
+ * the interpreter's result.
+ *
+ * Side effects:
+ * The value of the given variable is incremented by the specified
+ * amount. If either the array or the entry didn't exist then a new
+ * variable is created. The ref count for the returned object is _not_
+ * incremented to reflect the returned reference; if you want to keep a
+ * reference to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
+ Tcl_Interp *interp; /* Command interpreter in which variable is
+ * to be found. */
+ Tcl_Obj *part1Ptr; /* Points to an object holding the name of
+ * an array (if part2 is non-NULL) or the
+ * name of a variable. */
+ Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
+ * the name of an element in the array
+ * part1Ptr. */
+ Tcl_WideInt incrAmount; /* Amount to be added to variable. */
+ int flags; /* Various flags that tell how to incr value:
+ * any of TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+ * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+{
+ Var *varPtr, *arrayPtr;
+ char *part1, *part2;
+
+ part1 = TclGetString(part1Ptr);
+ part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
+
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
+ 0, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (reading value of variable to increment)", -1);
+ return NULL;
+ }
+ return TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2,
+ incrAmount, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrIncrWideVar --
+ *
+ * Given the pointers to a variable and possible containing array,
+ * increment the Tcl object value of the variable by a specified
+ * amount.
+ *
+ * Results:
+ * Returns a pointer to the Tcl_Obj holding the new value of the
+ * variable. If the specified variable doesn't exist, or there is a
+ * clash in array usage, or an error occurs while executing variable
+ * traces, then NULL is returned and a message will be left in
+ * the interpreter's result.
+ *
+ * Side effects:
+ * The value of the given variable is incremented by the specified
+ * amount. If either the array or the entry didn't exist then a new
+ * variable is created. The ref count for the returned object is _not_
+ * incremented to reflect the returned reference; if you want to keep a
+ * reference to the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
+ Tcl_Interp *interp; /* Command interpreter in which variable is
+ * to be found. */
+ Var *varPtr;
+ Var *arrayPtr;
+ CONST char *part1; /* Points to an object holding the name of
+ * an array (if part2 is non-NULL) or the
+ * name of a variable. */
+ CONST char *part2; /* If non-null, points to an object holding
+ * the name of an element in the array
+ * part1Ptr. */
+ CONST Tcl_WideInt incrAmount;
+ /* Amount to be added to variable. */
+ CONST int flags; /* Various flags that tell how to incr value:
+ * any of TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+ * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+{
+ register Tcl_Obj *varValuePtr;
+ int createdNewObj; /* Set 1 if var's value object is shared
+ * so we must increment a copy (i.e. copy
+ * on write). */
+ Tcl_WideInt wide;
+
+ varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+
+ if (varValuePtr == NULL) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (reading value of variable to increment)", -1);
+ return NULL;
+ }
+
+ /*
+ * Increment the variable's value. If the object is unshared we can
+ * modify it directly, otherwise we must create a new copy to modify:
+ * this is "copy on write". Then free the variable's old string
+ * representation, if any, since it will no longer be valid.
+ */
+
+ createdNewObj = 0;
+ if (Tcl_IsShared(varValuePtr)) {
+ varValuePtr = Tcl_DuplicateObj(varValuePtr);
+ createdNewObj = 1;
+ }
+ if (varValuePtr->typePtr == &tclWideIntType) {
+ TclGetWide(wide, varValuePtr);
+ Tcl_SetWideIntObj(varValuePtr, wide + incrAmount);
+ } else if (varValuePtr->typePtr == &tclIntType) {
+ long i = varValuePtr->internalRep.longValue;
+ Tcl_SetWideIntObj(varValuePtr, Tcl_LongAsWide(i) + incrAmount);
+ } else {
+ /*
+ * Not an integer or wide internal-rep...
+ */
+ if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
+ if (createdNewObj) {
+ Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+ }
+ return NULL;
+ }
+ Tcl_SetWideIntObj(varValuePtr, wide + incrAmount);
+ }
+
+ /*
+ * Store the variable's new value and run any write traces.
+ */
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
+ varValuePtr, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_UnsetVar --
*
* Delete a variable, so that it may not be accessed anymore.