summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--doc/array.n10
-rw-r--r--generic/tclVar.c23
-rw-r--r--tests/set-old.test31
4 files changed, 62 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index f2b1679..44a25cd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2000-05-08 Eric Melski <ericm@scriptics.com>
+
+ * tests/set-old.test:
+ * doc/array.n:
+ * generic/tclVar.c: Added [array statistics] command [RFE: 4557]
+
2000-05-06 Andreas Kupries <a.kupries@westend.com>
operating as proxy for David Gravereaux <davygrvy@pobox.com>
diff --git a/doc/array.n b/doc/array.n
index 2a5b1fc..e61403c 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: array.n,v 1.4 1999/09/21 04:20:35 hobbs Exp $
+'\" RCS: @(#) $Id: array.n,v 1.5 2000/05/08 21:25:30 ericm Exp $
'\"
.so man.macros
.TH array n 8.3 Tcl "Tcl Built-In Commands"
@@ -111,6 +111,14 @@ The return value is a
search identifier that must be used in \fBarray nextelement\fR
and \fBarray donesearch\fR commands; it allows multiple
searches to be underway simultaneously for the same array.
+.VS 8.4
+.TP
+\fBarray statistics \fIarrayName\fR
+Returns statistics about the distribution of data within the hashtable
+that represents the array. This information includes the number of
+entries in the table, the number of buckets, and the utilization of
+the buckets.
+.VE 8.4
.VS 8.3
.TP
\fBarray unset \fIarrayName\fR ?\fIpattern\fR?
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;
diff --git a/tests/set-old.test b/tests/set-old.test
index 76ebe19..888a6aa 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: set-old.test,v 1.8 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: set-old.test,v 1.9 2000/05/08 21:25:31 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -296,7 +296,7 @@ test set-old-8.6 {array command} {
catch {unset a}
set a(22) 3
list [catch {array gorp a} msg] $msg
-} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, or unset}}
+} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
catch {unset a}
list [catch {array anymore a x} msg] $msg
@@ -564,11 +564,36 @@ test set-old-8.47 {array command, startsearch option, array doesn't exist yet bu
}
list [catch {p 1} msg] $msg
} {1 {"a" isn't an array}}
+test set-old-8.48 {array command, statistics option} {
+ catch {unset a}
+ set a(abc) 1
+ set a(def) 2
+ set a(ghi) 3
+ set a(jkl) 4
+ set a(mno) 5
+ set a(pqr) 6
+ set a(stu) 7
+ set a(vwx) 8
+ set a(yz) 9
+ array statistics a
+} "9 entries in table, 4 buckets
+number of buckets with 0 entries: 0
+number of buckets with 1 entries: 0
+number of buckets with 2 entries: 3
+number of buckets with 3 entries: 1
+number of buckets with 4 entries: 0
+number of buckets with 5 entries: 0
+number of buckets with 6 entries: 0
+number of buckets with 7 entries: 0
+number of buckets with 8 entries: 0
+number of buckets with 9 entries: 0
+number of buckets with 10 or more entries: 0
+average search distance for entry: 1.7"
test set-old-9.1 {ids for array enumeration} {
catch {unset a}
set a(a) 1
- list [array st a] [array st a] [array done a s-1-a; array st a] \
+ list [array star a] [array star a] [array done a s-1-a; array star a] \
[array done a s-2-a; array d a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {