summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-09-21 04:20:28 (GMT)
committerhobbs <hobbs>1999-09-21 04:20:28 (GMT)
commita583a768fbe40ec2b7d661fe32d8347a34632fcf (patch)
tree8063ba8ff9da4fa71559d95b2c2389d1a8b516c0 /generic/tclVar.c
parent1f66507f55794f140cf5952e6d45da60c066c014 (diff)
downloadtcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.zip
tcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.tar.gz
tcl-a583a768fbe40ec2b7d661fe32d8347a34632fcf.tar.bz2
1999-09-16 Jeff Hobbs <hobbs@scriptics.com>
* tests/timer.test: changed after delay in timer test 6.29 from 1 to 10. [Bug: 2796] * tests/pkg.test: * generic/tclPkg.c: fixed package version check to disallow 1.2..3 [Bug: 2539] * unix/Makefile.in: fixed gendate target - this never worked since RCS was intro'd. * generic/tclGetDate.y: updated to reflect previous changes to tclDate.c (leap year calc) and added CEST and UCT time zone recognition. Fixed 4 missing UCHAR() casts. [Bug: 2717, 954, 1245, 1249] * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719] and changed Tcl_Alloc, et al to not panic when a alloc request for zero came through and NULL was returned (valid on AIX, Tru64) [Bug: 2795, etc] * tests/clock.test: * doc/clock.n: * generic/tclClock.c: added -milliseconds switch to clock clicks to guarantee that the return value of clicks is in the millisecs granularity [Bug: 2682, 1332] 1999-09-15 Jeff Hobbs <hobbs@scriptics.com> * generic/tclIOCmd.c: fixed potential core dump in conjunction with stacked channels with result obj manipulation in Tcl_ReadChars [Bug: 2623] * tests/format.test: * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605] * doc/msgcat.n: fixed \\ bug in example [Bug: 2548] * unix/tcl.m4: * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition [Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610] * doc/array.n: * tests/var.test: * tests/set.test: * generic/tclVar.c: added an array unset operation, with docs and tests. Variation of [Bug: 1775]. Added fix in TclArraySet to check when trying to set in a non-existent namespace. [Bug: 2613] 1999-09-14 Jeff Hobbs <hobbs@scriptics.com> * tests/linsert.test: * doc/linsert.n: * generic/tclCmdIL.c: fixed end-int interpretation of linsert to correctly calculate value for end, added test and docs [Bug: 2693] * doc/regexp.n: * doc/regsub.n: * tests/regexp.test: * generic/tclCmdMZ.c: add -start switch to regexp and regsub with docs and tests * doc/switch.n: added proper use of comments to example. * generic/tclCmdMZ.c: changed switch to complain when an error occurs that seems to be due to a misplaced comment. * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions in regsub [Bug: 2723] * generic/tclCmdMZ.c: changed [string equal] to return an Int type object (was a Boolean)
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c64
1 files changed, 56 insertions, 8 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 67a5cab..f7ceedc 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,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.12 1999/08/10 02:42:14 welch Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.13 1999/09/21 04:20:41 hobbs Exp $
*/
#include "tclInt.h"
@@ -2845,10 +2845,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
- ARRAY_STARTSEARCH};
- static char *arrayOptions[] = {"anymore", "donesearch", "exists",
- "get", "names", "nextelement", "set",
- "size", "startsearch", (char *) NULL};
+ ARRAY_STARTSEARCH, ARRAY_UNSET};
+ static char *arrayOptions[] = {
+ "anymore", "donesearch", "exists", "get", "names", "nextelement",
+ "set", "size", "startsearch", "unset", (char *) NULL
+ };
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
@@ -3161,6 +3162,46 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
varPtr->searchPtr = searchPtr;
break;
}
+ case ARRAY_UNSET: {
+ Tcl_HashSearch search;
+ Var *varPtr2;
+ char *pattern = NULL;
+ char *name;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+ return TCL_ERROR;
+ }
+ if (notArray) {
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ /*
+ * When no pattern is given, just unset the whole array
+ */
+ if (Tcl_UnsetVar2(interp, varName, (char *) NULL, 0)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ pattern = Tcl_GetString(objv[3]);
+ for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
+ &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+ if (TclIsVarUndefined(varPtr2)) {
+ continue;
+ }
+ name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+ if (Tcl_StringMatch(name, pattern) &&
+ (Tcl_UnsetVar2(interp, varName, name, 0)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ break;
+ }
}
return TCL_OK;
@@ -3255,8 +3296,7 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
return TCL_OK;
}
- if (TclIsVarArrayElement(varPtr) ||
- !TclIsVarUndefined(varPtr)) {
+ if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
/*
* Either an array element, or a scalar: lose!
*/
@@ -3269,9 +3309,17 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
* Create variable for new array.
*/
- varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
+ varPtr = TclLookupVar(interp, varName, (char *) NULL,
+ TCL_LEAVE_ERR_MSG, "set",
/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+ /*
+ * Still couldn't do it - this can occur if a non-existent
+ * namespace was specified
+ */
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
}
TclSetVarArray(varPtr);
TclClearVarUndefined(varPtr);