diff options
Diffstat (limited to 'generic/tclVar.c')
| -rw-r--r-- | generic/tclVar.c | 64 |
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); |