diff options
| author | ericm <ericm> | 2000-05-08 21:25:30 (GMT) |
|---|---|---|
| committer | ericm <ericm> | 2000-05-08 21:25:30 (GMT) |
| commit | 63adaf2eb6d8949c310ea3f93c699ed6dd1c8839 (patch) | |
| tree | f9e4cc25a6c9937d5d35ace7dde71abce54375d9 /generic/tclVar.c | |
| parent | a761496cfa5e3457e53d62de2e940dabff44e63f (diff) | |
| download | tcl-63adaf2eb6d8949c310ea3f93c699ed6dd1c8839.zip tcl-63adaf2eb6d8949c310ea3f93c699ed6dd1c8839.tar.gz tcl-63adaf2eb6d8949c310ea3f93c699ed6dd1c8839.tar.bz2 | |
* tests/set-old.test:
* doc/array.n:
* generic/tclVar.c: Added [array statistics] command [RFE: 4557]
Diffstat (limited to 'generic/tclVar.c')
| -rw-r--r-- | generic/tclVar.c | 23 |
1 files changed, 19 insertions, 4 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 834a8dc..f9d5e32 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.16 2000/01/21 03:29:14 ericm Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.17 2000/05/08 21:25:31 ericm Exp $ */ #include "tclInt.h" @@ -2861,10 +2861,10 @@ 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, ARRAY_UNSET}; + ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; static char *arrayOptions[] = { "anymore", "donesearch", "exists", "get", "names", "nextelement", - "set", "size", "startsearch", "unset", (char *) NULL + "set", "size", "startsearch", "statistics", "unset", (char *) NULL }; Interp *iPtr = (Interp *) interp; @@ -3178,7 +3178,22 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) varPtr->searchPtr = searchPtr; break; } - case ARRAY_UNSET: { + + case ARRAY_STATISTICS: { + char *stats; + stats = Tcl_HashStats(varPtr->value.tablePtr); + if (stats != NULL) { + Tcl_SetResult(interp, stats, TCL_VOLATILE); + ckfree((void *)stats); + } else { + Tcl_SetResult(interp, "error reading array statistics", + TCL_STATIC); + return TCL_ERROR; + } + break; + } + + case ARRAY_UNSET: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; |