Made [incr] able to accept and work with wide increments [Bug 728838]

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.