Check in stash. This code probably does not compile as-is. Changes intended to address possible segfault on termination of search.

doc/ArraySet.3

@@ -0,0 +1,333 @@
+'\"
+'\" Copyright (c) 2016 Andy Goth
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_ArraySet 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_ArraySet, Tcl_ArrayUnset, Tcl_ArrayGet, Tcl_ArrayNames, Tcl_ArraySize, Tcl_ArrayExists, Tcl_ArraySearchStart, Tcl_ArraySearchPeek, Tcl_ArraySearchNext, Tcl_ArraySearchDone, Tcl_ArrayStatistics \- manipulate Tcl array variables
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ArraySet\fR(\fIinterp, part1Ptr, dictPtr, flags\fR)
+.sp
+int
+\fBTcl_ArrayUnset\fR(\fIinterp, part1Ptr, part2Ptr, flags\fR)
+.sp
+int
+\fBTcl_ArrayGet\fR(\fIinterp, part1Ptr, part2Ptr, dictPtr, flags\fR)
+.sp
+int
+\fBTcl_ArrayNames\fR(\fIinterp, part1Ptr, part2Ptr, listPtr, flags\fR)
+.sp
+int
+\fBTcl_ArraySize\fR(\fIinterp, part1Ptr, part2Ptr, intPtr, flags\fR)
+.sp
+int
+\fBTcl_ArrayExists\fR(\fIinterp, part1Ptr, part2ptr, intPtr, flags\fR)
+.sp
+Tcl_ArraySearch
+\fBTcl_ArraySearchStart\fR(\fIinterp, part1Ptr, part2Ptr, flags\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ArraySearchPeek\fR(\fIsearch\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ArraySearchNext\fR(\fIsearch\fR)
+.sp
+void
+\fBTcl_ArraySearchDone\fR(\fIsearch\fR)
+.sp
+int
+\fBTcl_ArrayStatistics\fR(\fIinterp, part1Ptr, stringPtr, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_ArraySearch search
+.AP Tcl_Interp *interp in
+Interpreter containing the variable.  If an error occurs, an error message is
+left in the interpreter's result.
+.AP Tcl_Obj *part1Ptr in
+Points to a Tcl value containing the array variable's name.  The name may
+include a series of \fB::\fR namespace qualifiers to specify a variable in a
+particular namespace.
+.AP Tcl_Obj *part2Ptr in
+If non-NULL, points to a Tcl value containing an array element name filter
+specification.  The format and interpretation of \fIpart2Ptr\fR are determined
+by the \fIflags\fR argument.
+.AP int flags in
+OR-ed combination of bits providing additional information.  See below for valid
+values.
+.AP Tcl_Obj *dictPtr in/out
+Points to the dictionary value to be read or manipulated.  If \fIdictPtr\fR does
+not already point to a dictionary value, an attempt will be made to convert it
+to one.  \fBTcl_ArraySet\fR allows \fIdictPtr\fR to be NULL, in which case it
+creates an empty array if the array does not already exist.
+.AP Tcl_Obj *listPtr in/out
+Points to the list value to be manipulated.  If \fIlistPtr\fR does not already
+point to a list value, an attempt will be made to convert it to one.
+.AP Tcl_Obj *stringPtr in/out
+Points to the string value to be manipulated.
+.AP int *intPtr out
+Points to location where \fBTcl_ArrayExists\fR stores the array existence flag
+or \fBTcl_ArraySize\fR stores the number of matching array elements.
+.AP Tcl_ArraySearch search in/out
+Token for tracking the progress of enumerating array elements.
+.BE
+.SH DESCRIPTION
+.PP
+These functions are used to create, modify, enumerate, analyze, read, and delete
+Tcl array variables from C code.
+.PP
+The \fBTcl_ArraySet\fR, \fBTcl_ArrayUnset\fR, \fBTcl_ArrayGet\fR,
+\fBTcl_ArrayNames\fR, \fBTcl_ArraySize\fR, \fBTcl_ArrayExists\fR, and
+\fBTcl_ArrayStatistics\fR functions return \fBTCL_OK\fR on success and
+\fBTCL_ERROR\fR on error.  If an error occurs, an error message is left in the
+interpreter's result.  The possible errors are caused by format (invalid list,
+dictionary, or regular expression) and traces (array, read, write, or unset).
+.PP
+Except for \fBTcl_ArraySet\fR, \fBTcl_ArraySearchStart\fR (not listed above),
+and \fBTcl_ArrayStatistics\fR, the array functions do not consider it an error
+for a namespace or variable to not exist or a variable to be a scalar or array
+element instead of an array.  \fBTcl_ArraySet\fR allows the array variable to
+not exist, in which case it creates it, but it returns \fBTCL_ERROR\fR in all
+the other situations listed in the previous sentence.
+.PP
+Array functions trigger array traces in the same manner as the \fBarray\fR
+command.  After the completion of any array traces, for each accessed array
+element, \fBTcl_ArraySet\fR triggers write traces, \fBTcl_ArrayUnset\fR triggers
+unset traces, and \fBTcl_ArrayGet\fR triggers read traces.  As discussed above,
+an error encountered during the execution of a trace causes the function to
+place error information in the interpreter's result and return \fBTCL_ERROR\fR.
+.PP
+The \fBTcl_ArraySet\fR, \fBTcl_ArrayUnset\fR, \fBTcl_ArrayGet\fR,
+\fBTcl_ArrayNames\fR, \fBTcl_ArraySize\fR, \fBTcl_ArrayExists\fR,
+\fBTcl_ArraySearchStart\fR, and \fBTcl_ArrayStatistics\fR functions accept a
+\fIflags\fR argument to control the scope of the variable lookup and to specify
+the interpretation of \fIpart2Ptr\fR.  It consists of an OR-ed combination of
+zero or more of the following bits.
+.TP
+\fBTCL_GLOBAL_ONLY\fR
+Under normal circumstances the functions look up variables as follows.  If a
+procedure call is active in \fIinterp\fR, the array variable is looked up at the
+current level of procedure call.  Otherwise, the array variable is looked up
+first in the current namespace, then in the global namespace.  However, if this
+bit is set in \fIflags\fR then the array variable is looked up only in the
+global namespace even if there is a procedure call active.  If both
+\fBTCL_GLOBAL_ONLY\fR and \fBTCL_NAMESPACE_ONLY\fR are given,
+\fBTCL_GLOBAL_ONLY\fR is ignored.
+.TP
+\fBTCL_NAMESPACE_ONLY\fR
+If this bit is set in \fIflags\fR then the array variable is looked up only in
+the current namespace.  If a procedure is active, its variables are ignored, and
+the global namespace is also ignored unless it is the current namespace.
+.PP
+With the exception of \fBTcl_ArraySet\fR and \fBTcl_ArrayStatistics\fR which do
+not support filtering, the \fIflags\fR argument is also OR-ed with zero or one
+of the following values to select the type of filtering applied by
+\fIpart2Ptr\fR.  Setting more than one filter type may cause \fBTcl_Panic\fR to
+be called.  The filter type is ignored if \fIpart2Ptr\fR is NULL, in which case
+no filtering is applied and all array elements are matched.
+.TP
+\fBTCL_MATCH_EXACT\fR
+\fIpart2Ptr\fR is an array element name.  The filter matches at most a single
+array element whose name is exactly equal to the value of \fIpart2Ptr\fR.  If no
+filter type is explicitly specified in \fIflags\fR, \fBTCL_MATCH_EXACT\fR is
+used by default.  This differs from the \fBarray\fR commands which default to
+\fB\-glob\fR.
+.TP
+\fBTCL_MATCH_GLOB\fR
+\fIpart2Ptr\fR is a glob pattern, and it matches array element names according
+to the rules of \fBstring match\fR.  \fIpart2Ptr\fR must match the entire array
+element name from beginning to end.  To match substrings, place \fB*\fR at
+either end of \fIpart2Ptr\fR.
+.TP
+\fBTCL_MATCH_REGEXP\fR
+\fIpart2Ptr\fR is a regular expression, and it matches array element names
+according to the rules of \fBregexp\fR.  Unless anchored by the \fB^\fR and
+\fB$\fR constraints, \fIpart2Ptr\fR matches substrings.  Thus, an empty
+\fIpart2Ptr\fR matches every possible array element name.  It is an error for
+\fIpart2Ptr\fR to not be a valid regular expression, but this error is only
+detected and reported when \fIpart1Ptr\fR names a non-empty array.
+.PP
+The \fBTcl_ArraySet\fR, \fBTcl_ArrayGet\fR, and \fBTcl_ArrayNames\fR functions
+accept \fIdictPtr\fR and \fIlistPtr\fR arguments referencing dictionary and list
+values, respectively.  If these values are not already dictionary and list
+values, an attempt will be made to convert them.  If the conversion fails,
+\fBTCL_ERROR\fR will be returned and an error message will be left in the
+interpreter's result.
+.PP
+\fBTcl_ArraySet\fR sets the values of zero or more elements in the array named
+by \fIpart1Ptr\fR.  If not NULL, \fIdictPtr\fR must be a valid dictionary, i.e.
+it must be a list consisting of an even number of elements alternating between
+key and value.  Each key in \fIdictPtr\fR is treated as an element name within
+the array, and its associated value is used as the new value for that array
+element.  If the variable named by \fIpart1Ptr\fR does not already exist and
+\fIdictPtr\fR is empty or NULL, the variable is created as an empty array.  It
+is an error for \fIpart1Ptr\fR to name a scalar (non-array) variable or an array
+element, or for it to reference a nonexistent namespace.
+.PP
+\fBTcl_ArrayUnset\fR unsets all elements in the array named by \fIpart1Ptr\fR
+that match the filter specified by \fIpart2Ptr\fR and \fIflags\fR.  It is not an
+error for \fIpart1Ptr\fR to not name an array or for there to be no matching
+elements in the array.  If \fIpart2Ptr\fR is NULL and \fIpart1Ptr\fR names an
+array, the entire array is unset, and future calls to \fBTcl_ArrayExists\fR will
+report it as not existing.  This is distinct from unsetting each element of the
+array (e.g. if \fIpart2Ptr\fR is \fB*\fR and \fIflags\fR is
+\fBTCL_MATCH_GLOB\fR), which does not cause future calls to
+\fBTcl_ArrayExists\fR to report the array as not existing.
+.PP
+\fBTcl_ArrayGet\fR loads the contents of the array named by \fIpart1Ptr\fR into
+the \fIdictPtr\fR dictionary object.  The array element names and values are
+used as the dictionary keys and values, respectively.  If \fIpart2Ptr\fR is not
+NULL, \fIpart2Ptr\fR and \fIflags\fR specify a filter used to limit which array
+elements are loaded into \fIdictPtr\fR.  If \fIpart1Ptr\fR does not name an
+array or if there are no matching elements, \fIdictPtr\fR is not modified.
+If \fIdictPtr\fR is not empty prior to calling \fBTcl_ArrayGet\fR, the array
+data is merged into \fIdictPtr\fR.  If an array element has the same name as an
+existing dictionary key, the array element value replaces the existing
+dictionary value.
+.PP
+\fBTcl_ArrayNames\fR loads the element names of the array named by
+\fIpart1Ptr\fR into the \fIlistPtr\fR list object.  If \fIpart2Ptr\fR is not
+NULL, \fIpart2Ptr\fR and \fIflags\fR specify a filter used to limit which array
+element names are loaded into \fIlistPtr\fR.  If \fIpart1Ptr\fR does not name an
+array or if there are no matching elements, \fIlistPtr\fR is not modified.  If
+\fIlistPtr\fR is not empty prior to calling \fBTcl_ArrayNames\fR, the array
+element names are appended to \fIlistPtr\fR.
+.PP
+\fBTcl_ArraySize\fR stores the number of elements in the array named by
+\fIpart1Ptr\fR into the address \fIintPtr\fR.  If \fIpart2Ptr\fR is not NULL,
+\fIpart2Ptr\fR and \fIflags\fR specify a filter used to limit which array
+elements count toward the total number of elements.  
+.PP
+\fBTcl_ArrayExists\fR checks for the existence of an array variable named
+\fIpart1Ptr\fR or (if \fIpart2Ptr\fR is not NULL) an array element within
+matching the filter specified by \fIpart2Ptr\fR and \fIflags\fR.  If the array
+variable or array element exists, the value \fB1\fR is stored into the location
+\fIintPtr\fR, even if the array is empty.  If \fIpart1Ptr\fR does not name an
+array variable (the variable does not exist, it is a scalar variable or array
+element, or it references a nonexistent namespace), or if \fIpart2Ptr\fR is not
+NULL and no elements match the filter, the value \fB0\fR is stored into the
+location \fIintPtr\fR.
+.PP
+\fBTcl_ArraySearchStart\fR initiates an array search, i.e. an array element
+enumeration yielding one element at a time.  \fIpart1Ptr\fR must name an array.
+If \fIpart2Ptr\fR is not NULL, \fIpart2Ptr\fR and \fIflags\fR specify a filter
+used to limit which array elements are included in the enumeration.  The return
+value is a token used to track the progress of the search, and it is to be
+passed to the \fBTcl_ArraySearchPeek\fR, \fBTcl_ArraySearchNext\fR, and
+\fBTcl_ArraySearchDone\fR functions.  If there is an error looking up the
+variable, executing an array trace, or validating a regular expression filter,
+NULL is returned and error information is placed in the interpreter result.
+.PP
+\fBTcl_ArraySearchPeek\fR and \fBTcl_ArraySearchNext\fR return the next array
+element name in the search identified by the \fIsearch\fR argument.  If there
+are no remaining element names, NULL is returned.  \fBTcl_ArraySearchPeek\fR
+does not advance the enumeration, whereas \fBTcl_ArraySearchNext\fR does, so
+\fBTcl_ArraySearchPeek\fR will return the same value each time it is called if
+there are no intervening calls to \fBTcl_ArraySearchNext\fR with the same
+\fIsearch\fR argument.
+.PP
+\fBTcl_ArraySearchDone\fR completes the search identified by the \fIsearch\fR
+argument and deallocates associated resources.  To avoid memory leaks,
+\fBTcl_ArraySearchDone\fR must be called once for each search token returned by
+\fBTcl_ArraySearchStart\fR.
+.PP
+\fBTcl_ArrayStatistics\fR produces statistics about the distribution of data
+within the hash table underlying the array named by \fIpart1Ptr\fR.  This
+information includes the number of entries in the table, the number of buckets,
+and the utilization of the buckets.  The statistics information is appended to
+the string value \fIstringPtr\fR.
+.SH EXAMPLES
+.PP
+Common initialization used for subsequent examples:
+.PP
+.CS
+int size, i;
+Tcl_Obj *obj, **objPtr;
+Tcl_Obj *varNameObj = Tcl_NewStringObj("colorcount", -1);
+Tcl_Channel outChan = Tcl_GetChannel(interp, "stdout", NULL);
+.CE
+.PP
+Create an array:
+.PP
+.CS
+obj = Tcl_NewStringObj(
+        " red   1"
+        " green 5"
+        " blue  4"
+        " white 9", -1);
+\fBTcl_ArraySet\fR(interp, varNameObj, obj, 0);
+.CE
+.PP
+Load the full contents of an array into a single object:
+.PP
+.CS
+Tcl_SetStringObj(obj, NULL, 0);
+\fBTcl_ArrayGet\fR(interp, varNameObj, NULL, obj, 0);
+Tcl_ListObjGetElements(interp, obj, &size, &objPtr);
+for (i = 0; i < size; i += 2, objPtr += 2) {
+    Tcl_WriteChars(outChan, "Color: ", -1);
+    Tcl_WriteObj(outChan, objPtr[0]);
+    Tcl_WriteChars(outChan, " Count: ", -1);
+    Tcl_WriteObj(outChan, objPtr[1]);
+    Tcl_WriteChars(outChan, "\\n", -1);
+}
+  \fB\(->\fR Color: blue Count: 4
+    Color: white Count: 9
+    Color: green Count: 5
+    Color: red Count: 1
+.CE
+.PP
+Get an array element name list then individually look up each element value:
+.PP
+.CS
+Tcl_SetStringObj(obj, NULL, 0);
+\fBTcl_ArrayNames\fR(interp, varNameObj, NULL, obj, 0);
+Tcl_ListObjGetElements(interp, obj, &size, &objPtr);
+for (i = 0; i < size; ++i, ++objPtr) {
+    Tcl_WriteChars(outChan, "Color: ", -1);
+    Tcl_WriteObj(outChan, *objPtr);
+    Tcl_WriteChars(outChan, " Count: ", -1);
+    Tcl_WriteObj(outChan, Tcl_ObjGetVar2(
+            interp, varNameObj, *objPtr, 0));
+    Tcl_WriteChars(outChan, "\\n", -1);
+}
+  \fB\(->\fR Color: blue Count: 4
+    Color: white Count: 9
+    Color: green Count: 5
+    Color: red Count: 1
+.CE
+.PP
+Get array hash table statistics:
+.PP
+.CS
+Tcl_SetStringObj(obj, NULL, 0);
+\fBTcl_ArrayStatistics\fR(interp, varNameObj, obj, 0);
+Tcl_WriteObj(outChan, obj);
+Tcl_WriteChars(outChan, "\\n", -1);
+  \fB\(->\fR 4 entries in table, 4 buckets
+    number of buckets with 0 entries: 1
+    number of buckets with 1 entries: 2
+    number of buckets with 2 entries: 1
+    number of buckets with 3 entries: 0
+    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.2
+.CE
+.SH "SEE ALSO"
+array(n), Tcl_NewObj(3), Tcl_NewListObj(3), Tcl_NewDictObj(3),
+Tcl_ObjGetVar2(3), Tcl_GetObjResult(3), Tcl_TraceVar2(3)
+.SH KEYWORDS
+array, dict, dict value, dictionary, get variable, hash table, iteration,
+interpreter, set, unset, value, variable

doc/array.n

@@ -22,6 +22,42 @@ Unless otherwise specified for individual commands below,
 \fIarrayName\fR must be the name of an existing array variable.
 The \fIoption\fR argument determines what action is carried
 out by the command.
+.PP
+Many array commands accept \fImode\fR and \fIpattern\fR arguments.  These
+arguments specify a filter to limit which array elements are included in the
+operation.  If neither argument is specified, no filtering is applied, and the
+entire array is processed.  If only one argument is specified, it is used as the
+\fIpattern\fR argument, and \fB\-glob\fR is used as the default value for
+\fImode\fR.  If both arguments are specified, the first is used as \fImode\fR
+and the second as \fIpattern\fR.  The \fImode\fR argument designates which
+matching rules to use to match \fIpattern\fR against the names of the elements
+in the array.  The legal \fImode\fR values are:
+.TP
+\fB\-exact\fR
+.
+\fIPattern\fR is a literal string that is compared for exact equality against
+each array element name.  This mode has limited utility because all uses of the
+\fBarray\fR command with \fB-exact\fR matching can be implemented by operating
+directly on the array element with standard \fIname\fB(\fIindex\fB)\fR notation.
+.TP
+\fB\-glob\fR
+.
+\fIPattern\fR is a glob-style pattern which is matched against each array
+element name using the same rules as the \fBstring match\fR command.
+\fIPattern\fR must match the entire array element name from beginning to end.
+To match substrings, place \fB*\fR at either end of \fIpattern\fR.  This mode is
+the default if no \fImode\fR is specified.
+.TP
+\fB\-regexp\fR
+.
+\fIPattern\fR is treated as a regular expression and matched against each array
+element name using the rules described in the \fBre_syntax\fR reference page.
+Unless anchored by the \fB^\fR and \fB$\fR constraints, \fIpattern\fR matches
+substrings.  Thus, an empty \fIpattern\fR matches every possible array element
+name.  It is an error for \fIpattern\fR to not be a valid regular expression,
+but this error condition is only detected and reported when \fIarrayName\fR is a
+non-empty array.
+.PP
 The legal \fIoptions\fR (which may be abbreviated) are:
 .TP
 \fBarray anymore \fIarrayName searchId\fR
@@ -43,20 +79,20 @@ which search on \fIarrayName\fR to destroy, and must have
 been the return value from a previous invocation of
 \fBarray startsearch\fR.  Returns an empty string.
 .TP
-\fBarray exists \fIarrayName\fR
+\fBarray exists \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
 Returns 1 if \fIarrayName\fR is an array variable, 0 if there
 is no variable by that name or if it is a scalar variable.
+If \fIpattern\fR is specified, this command instead checks if one or more
+elements of \fIarrayName\fR match the filter defined by \fImode\fR and
+\fIpattern\fR, returning 1 or 0 if the match succeeds or fails, respectively.
 .TP
-\fBarray get \fIarrayName\fR ?\fIpattern\fR?
+\fBarray get \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
 Returns a list containing pairs of elements.  The first
 element in each pair is the name of an element in \fIarrayName\fR
 and the second element of each pair is the value of the
 array element.  The order of the pairs is undefined.
-If \fIpattern\fR is not specified, then all of the elements of the
-array are included in the result.
-If \fIpattern\fR is specified, then only those elements whose names
-match \fIpattern\fR (using the matching rules of
-\fBstring match\fR) are included.
+The \fImode\fR and \fIpattern\fR arguments can be used to limit which array
+elements are included in the result.
 If \fIarrayName\fR is not the name of an array variable, or if
 the array contains no elements, then an empty list is returned.
 If traces on the array modify the list of elements, the elements
@@ -65,15 +101,10 @@ returned are those that exist both before and after the call to
 .TP
 \fBarray names \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
 Returns a list containing the names of all of the elements in
-the array that match \fIpattern\fR.  \fIMode\fR may be one of
-\fB\-exact\fR, \fB\-glob\fR, or \fB\-regexp\fR.  If specified, \fImode\fR
-designates which matching rules to use to match \fIpattern\fR against
-the names of the elements in the array.  If not specified, \fImode\fR
-defaults to \fB\-glob\fR.  See the documentation for \fBstring match\fR
-for information on glob style matching, and the documentation for
-\fBregexp\fR for information on regexp matching.
-If \fIpattern\fR is omitted then the command returns all of
-the element names in the array.  If there are no (matching) elements
+the array.
+The \fImode\fR and \fIpattern\fR arguments can be used to limit which array
+element names are included in the result.
+If there are no (matching) elements
 in the array, or if \fIarrayName\fR is not the name of an array
 variable, then an empty string is returned.
 .TP
@@ -99,16 +130,20 @@ If the variable \fIarrayName\fR does not already exist
 and \fIlist\fR is empty,
 \fIarrayName\fR is created with an empty array value.
 .TP
-\fBarray size \fIarrayName\fR
-Returns a decimal string giving the number of elements in the
+\fBarray size \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
+Returns an integer giving the number of elements in the
 array.
+The \fImode\fR and \fIpattern\fR arguments can be used to limit which array
+elements are counted toward the result.
 If \fIarrayName\fR is not the name of an array then 0 is returned.
 .TP
-\fBarray startsearch \fIarrayName\fR
+\fBarray startsearch \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
 This command initializes an element-by-element search through the
 array given by \fIarrayName\fR, such that invocations of the
 \fBarray nextelement\fR command will return the names of the
 individual elements in the array.
+The \fImode\fR and \fIpattern\fR arguments can be used to limit which array
+element names are returned by future invocations of \fBarray nextelement\fR.
 When the search has been completed, the \fBarray donesearch\fR
 command should be invoked.
 The return value is a
@@ -126,9 +161,10 @@ that represents the array.  This information includes the number of
 entries in the table, the number of buckets, and the utilization of
 the buckets.
 .TP
-\fBarray unset \fIarrayName\fR ?\fIpattern\fR?
-Unsets all of the elements in the array that match \fIpattern\fR (using the
-matching rules of \fBstring match\fR).  If \fIarrayName\fR is not the name
+\fBarray unset \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
+Unsets all of the elements in the array that match the filter specified by the
+\fImode\fR and \fIpattern\fR arguments.
+If \fIarrayName\fR is not the name
 of an array variable or there are no matching elements in the array, no
 error will be raised.  If \fIpattern\fR is omitted and \fIarrayName\fR is
 an array variable, then the command unsets the entire array.

generic/tcl.decls

@@ -2326,6 +2326,51 @@ declare 630 {
 
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
+# TIP #XXX
+declare 631 {
+    int Tcl_ArraySet(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *dictPtr,
+	int flags)
+}
+declare 632 {
+    int Tcl_ArrayUnset(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+	int flags)
+}
+declare 633 {
+    int Tcl_ArrayGet(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+	Tcl_Obj *dictPtr, int flags)
+}
+declare 634 {
+    int Tcl_ArrayNames(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+	Tcl_Obj *listPtr, int flags)
+}
+declare 635 {
+    int Tcl_ArraySize(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+	int *intPtr, int flags)
+}
+declare 636 {
+    int Tcl_ArrayExists(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+	Tcl_Obj *part2Ptr, int *intPtr, int flags)
+}
+declare 637 {
+    Tcl_ArraySearch Tcl_ArraySearchStart(Tcl_Interp *interp,
+	Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags)
+}
+declare 638 {
+    int Tcl_ArraySearchPeek(Tcl_Interp *interp, Tcl_ArraySearch search,
+	Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr)
+}
+declare 639 {
+    int Tcl_ArraySearchNext(Tcl_Interp *interp, Tcl_ArraySearch search,
+	Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr)
+}
+declare 640 {
+    int Tcl_ArraySearchDone(Tcl_Interp *interp, Tcl_ArraySearch search)
+}
+declare 641 {
+   int Tcl_ArrayStatistics(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+         Tcl_Obj *stringPtr, int flags)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only

generic/tcl.h

@@ -532,6 +532,7 @@ typedef struct Tcl_Interp
 #endif /* TCL_NO_DEPRECATED */
 Tcl_Interp;
 
+typedef struct Tcl_ArraySearch_ *Tcl_ArraySearch;
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
 typedef struct Tcl_Channel_ *Tcl_Channel;
 typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
@@ -1083,9 +1084,10 @@ typedef struct Tcl_DString {
 /*
  * Flag values passed to variable-related functions.
  * WARNING: these bit choices must not conflict with the bit choice for
- * TCL_CANCEL_UNWIND, above.
+ * TCL_CANCEL_UNWIND, above, or TCL_VAR_CREATE (0x4000) in tclVar.c.
  */
 
+#define TCL_MATCH_EXACT		 0
 #define TCL_GLOBAL_ONLY		 1
 #define TCL_NAMESPACE_ONLY	 2
 #define TCL_APPEND_VALUE	 4
@@ -1096,14 +1098,19 @@ typedef struct Tcl_DString {
 #define TCL_TRACE_DESTROYED	 0x80
 #define TCL_INTERP_DESTROYED	 0x100
 #define TCL_LEAVE_ERR_MSG	 0x200
+/* Value 0x400 is reserved for TCL_PARSE_PART1, conditionally defined below. */
 #define TCL_TRACE_ARRAY		 0x800
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
 /* Required to support old variable/vdelete/vinfo traces. */
 #define TCL_TRACE_OLD_STYLE	 0x1000
 #endif
+#define TCL_MATCH_REGEXP	 0x2000
+/* Value 0x4000 is reserved for TCL_VAR_CREATE, defined in tclVar.c. */
 /* Indicate the semantics of the result of a trace. */
 #define TCL_TRACE_RESULT_DYNAMIC 0x8000
 #define TCL_TRACE_RESULT_OBJECT  0x10000
+#define TCL_MATCH_GLOB		 0x20000
+/* Value 0x100000 is reserved for TCL_CANCEL_UNWIND, defined above. */
 
 /*
  * Flag values for ensemble commands.

generic/tclDecls.h

@@ -1816,6 +1816,46 @@ EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
 EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 				Tcl_ZlibStream zhandle,
 				Tcl_Obj *compressionDictionaryObj);
+/* 631 */
+EXTERN int		Tcl_ArraySet(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *dictPtr, int flags);
+/* 632 */
+EXTERN int		Tcl_ArrayUnset(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, int flags);
+/* 633 */
+EXTERN int		Tcl_ArrayGet(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, Tcl_Obj *dictPtr,
+				int flags);
+/* 634 */
+EXTERN int		Tcl_ArrayNames(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, Tcl_Obj *listPtr,
+				int flags);
+/* 635 */
+EXTERN int		Tcl_ArraySize(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, int *intPtr, int flags);
+/* 636 */
+EXTERN int		Tcl_ArrayExists(Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+				int *intPtr, int flags);
+/* 637 */
+EXTERN Tcl_ArraySearch	Tcl_ArraySearchStart(Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+				int flags);
+/* 638 */
+EXTERN int		Tcl_ArraySearchPeek(Tcl_Interp *interp,
+				Tcl_ArraySearch search, Tcl_Obj **keyPtrPtr,
+				Tcl_Obj **valuePtrPtr);
+/* 639 */
+EXTERN int		Tcl_ArraySearchNext(Tcl_Interp *interp,
+				Tcl_ArraySearch search, Tcl_Obj **keyPtrPtr,
+				Tcl_Obj **valuePtrPtr);
+/* 640 */
+EXTERN int		Tcl_ArraySearchDone(Tcl_Interp *interp,
+				Tcl_ArraySearch search);
+/* 641 */
+EXTERN int		Tcl_ArrayStatistics(Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *stringPtr,
+				int flags);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2482,6 +2522,17 @@ typedef struct TclStubs {
     void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
+    int (*tcl_ArraySet) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *dictPtr, int flags); /* 631 */
+    int (*tcl_ArrayUnset) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 632 */
+    int (*tcl_ArrayGet) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *dictPtr, int flags); /* 633 */
+    int (*tcl_ArrayNames) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *listPtr, int flags); /* 634 */
+    int (*tcl_ArraySize) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int *intPtr, int flags); /* 635 */
+    int (*tcl_ArrayExists) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int *intPtr, int flags); /* 636 */
+    Tcl_ArraySearch (*tcl_ArraySearchStart) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 637 */
+    int (*tcl_ArraySearchPeek) (Tcl_Interp *interp, Tcl_ArraySearch search, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr); /* 638 */
+    int (*tcl_ArraySearchNext) (Tcl_Interp *interp, Tcl_ArraySearch search, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr); /* 639 */
+    int (*tcl_ArraySearchDone) (Tcl_Interp *interp, Tcl_ArraySearch search); /* 640 */
+    int (*tcl_ArrayStatistics) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *stringPtr, int flags); /* 641 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3774,6 +3825,28 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
 #define Tcl_ZlibStreamSetCompressionDictionary \
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
+#define Tcl_ArraySet \
+	(tclStubsPtr->tcl_ArraySet) /* 631 */
+#define Tcl_ArrayUnset \
+	(tclStubsPtr->tcl_ArrayUnset) /* 632 */
+#define Tcl_ArrayGet \
+	(tclStubsPtr->tcl_ArrayGet) /* 633 */
+#define Tcl_ArrayNames \
+	(tclStubsPtr->tcl_ArrayNames) /* 634 */
+#define Tcl_ArraySize \
+	(tclStubsPtr->tcl_ArraySize) /* 635 */
+#define Tcl_ArrayExists \
+	(tclStubsPtr->tcl_ArrayExists) /* 636 */
+#define Tcl_ArraySearchStart \
+	(tclStubsPtr->tcl_ArraySearchStart) /* 637 */
+#define Tcl_ArraySearchPeek \
+	(tclStubsPtr->tcl_ArraySearchPeek) /* 638 */
+#define Tcl_ArraySearchNext \
+	(tclStubsPtr->tcl_ArraySearchNext) /* 639 */
+#define Tcl_ArraySearchDone \
+	(tclStubsPtr->tcl_ArraySearchDone) /* 640 */
+#define Tcl_ArrayStatistics \
+	(tclStubsPtr->tcl_ArrayStatistics) /* 641 */
 
 #endif /* defined(USE_TCL_STUBS) */
 

generic/tclExecute.c

@@ -4034,12 +4034,13 @@ TEBCresume(
 	}
 	TRACE(("%s %u \"%.30s\" => ",
 		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
-	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
+	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
+		&& !TclIsVarArraySearched(arrayPtr)) {
 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
 	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
 		/*
-		 * No nasty traces and element exists, so we can proceed to
-		 * unset it. Might still not exist though...
+		 * No nasty traces or searchesw and element exists, so we can
+		 * proceed to unset it. Might still not exist though...
 		 */
 
 		if (!TclIsVarUndefined(varPtr)) {

generic/tclInt.h

@@ -804,6 +804,7 @@ typedef struct VarInHash {
  * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
  * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
  * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarArraySearched(Var *varPtr);
  */
 
 #define TclIsVarScalar(varPtr) \
@@ -845,6 +846,9 @@ typedef struct VarInHash {
 #define TclIsVarDeadHash(varPtr) \
     ((varPtr)->flags & VAR_DEAD_HASH)
 
+#define TclIsVarArraySearched(varPtr) \
+    ((varPtr)->flags & VAR_SEARCH_ACTIVE)
+
 #define TclGetVarNsPtr(varPtr) \
     (TclIsVarInHash(varPtr) \
 	? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \

generic/tclStubInit.c

@@ -1416,6 +1416,17 @@ const TclStubs tclStubs = {
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+    Tcl_ArraySet, /* 631 */
+    Tcl_ArrayUnset, /* 632 */
+    Tcl_ArrayGet, /* 633 */
+    Tcl_ArrayNames, /* 634 */
+    Tcl_ArraySize, /* 635 */
+    Tcl_ArrayExists, /* 636 */
+    Tcl_ArraySearchStart, /* 637 */
+    Tcl_ArraySearchPeek, /* 638 */
+    Tcl_ArraySearchNext, /* 639 */
+    Tcl_ArraySearchDone, /* 640 */
+    Tcl_ArrayStatistics, /* 641 */
 };
 
 /* !END!: Do not edit above this line. */

tests/array.test

@@ -0,0 +1,888 @@
+# Commands covered:  array
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2016 Andy Goth
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] < 0} {
+    package require tcltest 2
+}
+::tcltest::loadTestedCommands
+catch {package require -exact Tcltest [info patchlevel]}
+set namespaces [namespace children]
+set procs [info procs]
+set vars [info vars]
+
+# test set   chapter title
+# ---------  -----------------------
+# array-1.*  subcommand dispatch
+# array-2.*  common argument parsing
+# array-3.*  array set
+# array-4.*  array unset
+# array-5.*  array statistics
+# array-6.*  array exists|size|names|get
+# array-7.*  array anymore|donesearch|nextelement|startsearch
+
+# test set   [array] subcommand  arrayName             mode and filter
+# ---------  ------------------  --------------------  ---------------
+# array-7.*  anymore             array required        not allowed
+# array-7.*  donesearch          array required        not allowed
+# array-6.*  exists              anything              optional
+# array-6.*  get                 anything              optional
+# array-6.*  names               anything              optional
+# array-7.*  nextelement         array required        not allowed
+# array-3.*  set                 array or nonexistent  not allowed
+# array-6.*  size                anything              optional
+# array-7.*  startsearch         array required        optional
+# array-5.*  statistics          array required        not allowed
+# array-4.*  unset               anything              optional
+# array-1.*  (unique abbrev)     (see above)           (see above)
+# array-1.*  (ambiguous abbrev)  (error)               (error)
+# array-1.*  (invalid)           (error)               (error)
+
+# oxfordJoin --
+# and --
+# or --
+# Joins a list by commas, a conjunction, or both, using Oxford comma rules,
+# matching Tcl's internal algorithm for displaying lists in error messages.
+proc oxfordJoin {conjunction list} {
+    if {[llength $list] > 1} {
+        lset list end "$conjunction [lindex $list end]"
+    }
+    if {[llength $list] < 3} {
+        join $list " "
+    } else {
+        join $list ", "
+    }
+}
+interp alias {} and {} oxfordJoin and
+interp alias {} or {} oxfordJoin or
+
+# samples --
+# Produces a list of sample arguments, given a list of parameters.
+# Customizations can be applied via $args.
+proc samples {params args} {
+    set map [dict merge {
+        arrayName   a
+        searchId    s-1-a
+        ?mode?      -exact
+        ?pattern?   hello
+        list        {hello world}
+    } $args]
+    lmap param $params {dict get $map $param}
+}
+
+# test --
+# Wrapper around [::tcltest::test] with additional features:
+#
+# - Single-argument block design gives a cleaner visual presentation.
+# - All script execution is performed in a new stack frame.
+# - Script variables are shared across scripts via a temporary namespace.
+# - All definition values (except scripts) are [subst]'ed.
+#
+# The $def argument is a dict which defines the test.  Its possible keys are:
+#
+# - name | desc
+#   Test name and description.
+#
+# - {scalar name} | {array name}
+#   The name component of the key is the name of a scalar or array variable, and
+#   the value is the initial scalar value or array dictionary value.  These
+#   variables are shared across the setup, body, and cleanup scripts.
+#
+# - link
+#   Uninitialized variables shared across the setup, body, and cleanup scripts.
+#
+# - setup | body | cleanup
+#   The scripts are modified to include variable initialization, linkage, and
+#   finalization and to be executed inside new stack frames.
+#
+# - constraints | result | output | errorOutput | returnCodes | match
+#   See tcltest(n) for the purpose of these keys.
+proc test {def} {
+    # Perform uplevel substitutions, and process scalar and array arguments.
+    set scalars {}
+    set arrays {}
+    dict for {key val} $def {
+        if {$key ni {setup body cleanup}} {
+            dict set def $key [set val [uplevel [list subst $val]]]
+        }
+        if {[llength $key] == 2} {
+            if {[lindex $key 0] eq "scalar"} {
+                dict set scalars [lindex $key 1] $val
+                dict unset def $key
+            } elseif {[lindex $key 0] eq "array"} {
+                dict set arrays [lindex $key 1] $val
+                dict unset def $key
+            }
+        }
+    }
+
+    # Augment scripts with variable initialization, linkage, and finalization.
+    dict lappend def link {*}[dict keys $scalars] {*}[dict keys $arrays]
+    if {[llength [dict get $def link]]} {
+        # Ensure all three scripts exist, even if empty.
+        foreach key {setup body cleanup} {
+            dict append def $key
+        }
+
+        # Build variable initialization, linkage, and finalization snippets.
+        set initial [list namespace eval ::TestVars [join [list\
+            [list variable {*}$scalars]\
+            {*}[lmap {var val} $arrays {list variable $var}]\
+            {*}[lmap {var val} $arrays {list array set $var $val}]] \n]]
+        set linkage [join [lmap var [dict get $def link]\
+            {list variable ::TestVars::$var}] \n]
+        set final [list namespace delete ::TestVars]
+
+        # Update scripts.
+        dict set def setup $initial\n$linkage\n[dict get $def setup]
+        dict set def body $linkage\n[dict get $def body]
+        dict set def cleanup $linkage\n[dict get $def cleanup]\n$final
+    }
+    dict unset def link
+
+    # Convert scripts to zero-argument lambda invocations.
+    foreach key {setup body cleanup} {
+        if {[dict exists $def $key]} {
+            dict set def $key [list apply [list {} [dict get $def $key]]]
+        }
+    }
+
+    # Assemble the Tcltest command.
+    set command [list ::tcltest::test [dict get $def name] [dict get $def desc]]
+    dict unset def name
+    dict unset def desc
+    foreach key {constraints setup body cleanup result output errorOutput
+            returnCodes match} {
+        if {[dict exists $def $key]} {
+            lappend command -$key [dict get $def $key]
+            dict unset def $key
+        }
+    }
+
+    # Complain if there are any invalid test definition keys.
+    if {[dict size $def]} {
+        error "bad test definition key(s): [and [dict keys $def]]"
+    }
+
+    # Run the Tcltest command.
+    tailcall {*}$command
+}
+
+# Formal parameters for each array subcommand.
+set params {
+    anymore     {arrayName searchId}
+    donesearch  {arrayName searchId}
+    exists      {arrayName ?mode? ?pattern?}
+    get         {arrayName ?mode? ?pattern?}
+    names       {arrayName ?mode? ?pattern?}
+    nextelement {arrayName searchId}
+    set         {arrayName list}
+    size        {arrayName ?mode? ?pattern?}
+    startsearch {arrayName ?mode? ?pattern?}
+    statistics  {arrayName}
+    unset       {arrayName ?mode? ?pattern?}
+}
+
+# List of array subcommands.
+set commands [lsort [dict keys $params]]
+
+# Ambiguous and unambiguous abbreviations of array subcommands.
+foreach cmd $commands {
+    for {set i 0} {$i < [string length $cmd] - 1} {incr i} {
+        set abbrev [string range $cmd 0 $i]
+        if {$abbrev in $commands
+         || [llength [lsearch -all $commands $abbrev*]] == 1} {
+            dict lappend abbrevs $cmd $abbrev
+        } else {
+            dict set ambig $abbrev {}
+        }
+    }
+}
+set ambig [lsort [dict keys $ambig]]
+
+# List of valid array filter mode options.
+set modes [lsort {-exact -glob -regexp}]
+
+######################## array-1.*: subcommand dispatch ########################
+test {
+    name array-1.1
+    desc {no subcommand}
+    body {array}
+    returnCodes error
+    result {wrong # args: should be "array subcommand ?arg ...?"}
+}
+test {
+    name array-1.2
+    desc {empty subcommand}
+    body {array {}}
+    returnCodes error
+    result {unknown or ambiguous subcommand "": must be [or $commands]}
+}
+test {
+    name array-1.3
+    desc {invalid subcommand}
+    body {array gorp}
+    returnCodes error
+    result {unknown or ambiguous subcommand "gorp": must be [or $commands]}
+}
+foreach cmd $ambig {
+    test {
+        name array-1.4.$cmd
+        desc {ambiguous subcommand: \[array $cmd\]}
+        {scalar cmd} $cmd
+        body {array $cmd}
+        returnCodes error
+        result {unknown or ambiguous subcommand "$cmd": must be [or $commands]}
+    }
+}
+foreach cmd $commands {
+    test {
+        name array-1.5.$cmd
+        desc {formal parameter lists: \[array $cmd\]}
+        {scalar cmd} $cmd
+        body {array $cmd}
+        returnCodes error
+        result {wrong # args: should be "array $cmd [dict get $params $cmd]"}
+    }
+}
+
+###################### array-2.*: common argument parsing ######################
+foreach {cmd    code    resultPattern} {
+    anymore     error   "\"%VAR%\" %MSG%"
+    donesearch  error   "\"%VAR%\" %MSG%"
+    exists      ok      0
+    get         ok      {}
+    names       ok      {}
+    nextelement error   "\"%VAR%\" %MSG%"
+    set         error   "can't set \"%VAR%%ELEM%\": %MSG%"
+    size        ok      0
+    startsearch error   "\"%VAR%\" %MSG%"
+    statistics  error   "\"%VAR%\" %MSG%"
+    unset       ok      {}
+} {
+    test {
+        name array-2.1.$cmd
+        desc {too many arguments: \[array $cmd\]}
+        {scalar cmd} $cmd
+        {scalar args} {[lmap param [dict get $params $cmd] {samples $param}]}
+        body {array $cmd {*}$args extra}
+        returnCodes error
+        result {wrong # args: should be "array $cmd [dict get $params $cmd]"}
+    }
+    if {"?mode?" in [dict get $params $cmd]} {
+        test {
+            name array-2.2.$cmd
+            desc {ambiguous mode: \[array $cmd\]"}
+            {scalar cmd} $cmd
+            {array a} {}
+            body {array $cmd a {} {}}
+            returnCodes error
+            result {ambiguous option "": must be [or $modes]}
+        }
+        test {
+            name array-2.3.$cmd
+            desc {invalid mode: \[array $cmd\]}
+            {scalar cmd} $cmd
+            {array a} {}
+            body {array $cmd a INVALID {}}
+            returnCodes error
+            result {bad option "INVALID": must be [or $modes]}
+        }
+        test {
+            name array-2.4.$cmd
+            desc {invalid regexp: \[array $cmd\]}
+            {scalar cmd} $cmd
+            {array a} {e 1}
+            body {array $cmd a -regexp *}
+            returnCodes error
+            result {couldn't compile regular expression pattern:\
+                quantifier operand invalid}
+        }
+    }
+    test {
+        name array-2.5.$cmd
+        desc {array trace error during variable lookup: \[array $cmd\]}
+        {scalar cmd} $cmd
+        {scalar args} {[lmap param [dict get $params $cmd] {samples $param}]}
+        link a
+        setup {trace add variable a array {apply {{args} {error $args}}}}
+        body {array $cmd {*}$args}
+        returnCodes error
+        result {can't trace array "a": a {} array}
+    }
+    if {$cmd eq "set"} {
+        set nonArray "variable isn't array"
+        set nonNamespace "parent namespace doesn't exist"
+    } else {
+        set nonArray "isn't an array"
+        set nonNamespace "isn't an array"
+    }
+    foreach {
+        desc                                skip    setup
+        name        msg             var     elem    extra
+    } {
+        "nonexistent array"                 set     {}
+        array-2.6   nonArray        a       {}      {}
+
+        "element of proc-slot-only array"   set     {}
+        array-2.7   nonArray        a       {}      {set a(hello) 123}
+
+        "scalar variable"                   {}      {{scalar a} {}}
+        array-2.8   nonArray        a       (hello) {}
+
+        "element of empty array"            {}      {{array a} {}}
+        array-2.9   nonArray        a(x)    {}      {}
+
+        "element of nonexistent array"      {}      {}
+        array-2.10  nonArray        a(x)    {}      {}
+
+        "element of scalar variable"        {}      {{scalar a} {}}
+        array-2.11  nonArray        a(x)    {}      {}
+
+        "existing element of array"         {}      {{scalar a} {x 123}}
+        array-2.12  nonArray        a(x)    {}      {}
+
+        "nonexistent element of array"      {}      {{array a} {}}
+        array-2.13  nonArray        a(x)    {}      {}
+
+        "bad namespace"                     {}      {}
+        array-2.14  nonNamespace    ::X::a  {}      {}
+    } {
+        if {$cmd ni $skip} {
+            set map [list %VAR% $var %MSG% [set $msg] %ELEM% $elem]
+            test [string map [list %SETUP% $setup %EXTRA% $extra] {
+                name $name.$cmd
+                desc {$desc: \[array $cmd\]}
+                {scalar cmd} $cmd
+                {scalar args} {[samples [dict get $params $cmd] arrayName $var]}
+                %SETUP%
+                body {set result [array $cmd {*}$args]; %EXTRA%; return $result}
+                returnCodes $code
+                result {[string map $map $resultPattern]}
+            }]
+        }
+    }
+}
+
+############################# array-3.*: array set #############################
+test {
+    name array-3.1
+    desc {empty}
+    body {array set a {}; list [array exists a] [array get a]}
+    result {1 {}}
+}
+test {
+    name array-3.2
+    desc {one array element}
+    body {array set a {e 1}; array get a}
+    result {e 1}
+}
+test {
+    name array-3.3
+    desc {missing value}
+    body {array set a e}
+    returnCodes error
+    result {list must have an even number of elements}
+}
+test {
+    name array-3.4
+    desc {duplicate key}
+    body {array set a {e 0 e 1}; array get a}
+    result {e 1}
+}
+test {
+    name array-3.5
+    desc {invalid list}
+    body {array set a \{\}x}
+    returnCodes error
+    result {list element in braces followed by "x" instead of space}
+}
+test {
+    name array-3.6
+    desc {invalid list part 2}
+    body {array set a \"\"x}
+    returnCodes error
+    result {list element in quotes followed by "x" instead of space}
+}
+test {
+    name array-3.7
+    desc {invalid list part 3}
+    body {array set a \{}
+    returnCodes error
+    result {unmatched open brace in list}
+}
+test {
+    name array-3.8
+    desc {invalid list part 4}
+    body {array set a \"}
+    returnCodes error
+    result {unmatched open quote in list}
+}
+test {
+    name array-3.9
+    desc {hash order}
+    body {array set a {f 2 e 1}; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-3.10
+    desc {adding elements}
+    body {array set a {f 2}; array set a {e 1}; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-3.11
+    desc {adding elements, hash order}
+    body {array set a {e 1}; array set a {f 2}; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-3.12
+    desc {replacing elements}
+    body {array set a {e 1}; array set a {e 2}; array get a}
+    result {e 2}
+}
+test {
+    name array-3.13
+    desc {adding and replacing elements}
+    body {array set a {e 1}; array set a {f 3 e 2}; array get a}
+    result {e 2 f 3}
+}
+test {
+    name array-3.14
+    desc {former scalar}
+    {scalar a} xxx
+    body {unset a; array set a {e 1}; array get a}
+    result {e 1}
+}
+test {
+    name array-3.15
+    desc {weird names}
+    body {array set a {{ a  b } 1 ) 2 ( 3 )( 4 () 5 {} 6}; array get a}
+    result {{} 6 ( 3 () 5 )( 4 ) 2 { a  b } 1}
+}
+
+############################ array-4.*: array unset ############################
+test {
+    name array-4.1
+    desc {unset empty array}
+    {array a} {}
+    body {array unset a; info exists a}
+    result 0
+}
+test {
+    name array-4.2
+    desc {unset non-empty array}
+    {array a} {e 1}
+    body {array unset a; info exists a}
+    result 0
+}
+test {
+    name array-4.3
+    desc {unset scalar}
+    {scalar a} x
+    body {array unset a; return $a}
+    result x
+}
+test {
+    name array-4.4
+    desc {unset all elements of empty array}
+    {array a} {}
+    body {array unset a *; list [info exists a] [array size a]}
+    result {1 0}
+}
+test {
+    name array-4.5
+    desc {unset all elements of non-empty array}
+    {array a} {e 1}
+    body {array unset a *; list [info exists a] [array size a]}
+    result {1 0}
+}
+test {
+    name array-4.6
+    desc {unset all elements of scalar array}
+    {scalar a} x
+    body {array unset a *; return $a}
+    result x
+}
+test {
+    name array-4.7
+    desc {unset single existing element using -exact}
+    {array a} {f 2 e 1}
+    body {array unset a -exact e; array get a}
+    result {f 2}
+}
+test {
+    name array-4.8
+    desc {unset single nonexistent element using -exact}
+    {array a} {f 2 e 1}
+    body {array unset a -exact d; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-4.9
+    desc {unset single existing element using default mode}
+    {array a} {f 2 e 1}
+    body {array unset a e; array get a}
+    result {f 2}
+}
+test {
+    name array-4.10
+    desc {unset single nonexistent element using default mode}
+    {array a} {f 2 e 1}
+    body {array unset a d; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-4.11
+    desc {unset single existing element using -glob}
+    {array a} {f 2 e 1}
+    body {array unset a -glob {[e]}; array get a}
+    result {f 2}
+}
+test {
+    name array-4.12
+    desc {unset single nonexistent element using -glob}
+    {array a} {f 2 e 1}
+    body {array unset a -glob {[d]}; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-4.13
+    desc {unset single existing element using -regexp}
+    {array a} {f 2 e 1}
+    body {array unset a -regexp {^[e]}; array get a}
+    result {f 2}
+}
+test {
+    name array-4.14
+    desc {unset single nonexistent element using -regexp}
+    {array a} {f 2 e 1}
+    body {array unset a -regexp {^[d]}; array get a}
+    result {e 1 f 2}
+}
+test {
+    name array-4.15
+    desc {confirm unset -exact does not match substrings}
+    {array a} {abc 1}
+    body {array unset a -exact b; array get a}
+    result {abc 1}
+}
+test {
+    name array-4.16
+    desc {confirm unset -glob does not match substrings}
+    {array a} {abc 1}
+    body {array unset a -glob b; array get a}
+    result {abc 1}
+}
+test {
+    name array-4.17
+    desc {confirm unset -regexp does match substrings}
+    {array a} {abc 1}
+    body {array unset a -regexp b; array get a}
+    result {}
+}
+
+######################### array-5.*: array statistics ##########################
+# Note: array-5.3 expected results obtained from Tcl version 8.5.7
+test {
+    name array-5.1
+    desc {empty array}
+    {array a} {}
+    body {array statistics a}
+    result
+{0 entries in table, 4 buckets
+number of buckets with 0 entries: 4
+number of buckets with 1 entries: 0
+number of buckets with 2 entries: 0
+number of buckets with 3 entries: 0
+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: 0.0}
+}
+test {
+    name array-5.2
+    desc {single-element array}
+    {array a} {e 1}
+    body {array statistics a}
+    result
+{1 entries in table, 4 buckets
+number of buckets with 0 entries: 3
+number of buckets with 1 entries: 1
+number of buckets with 2 entries: 0
+number of buckets with 3 entries: 0
+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.0}
+}
+test {
+    name array-5.3
+    desc {thousand-element array}
+    link a
+    setup {for {set i 0} {$i < 1000} {incr i} {set a($i) $i}}
+    body {array statistics a}
+    result
+{1000 entries in table, 1024 buckets
+number of buckets with 0 entries: 285
+number of buckets with 1 entries: 520
+number of buckets with 2 entries: 180
+number of buckets with 3 entries: 36
+number of buckets with 4 entries: 3
+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.3}
+}
+test {
+    name array-5.4
+    desc {collision attack}
+    link a
+    setup {
+        for {set i 16} {$i < 29} {incr i} {
+            set a([binary format cc $i [expr {-$i * 9}]]) $i
+        }
+    }
+    body {array statistics a}
+    result
+{13 entries in table, 16 buckets
+number of buckets with 0 entries: 15
+number of buckets with 1 entries: 0
+number of buckets with 2 entries: 0
+number of buckets with 3 entries: 0
+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: 1
+average search distance for entry: 7.0}
+}
+
+################### array-6.*: array exists|size|names|get #####################
+foreach {
+    desc
+    name        dict        args            exists  size    names   get
+} {
+    "empty array"
+    array-6.1   {}          {}              1       0       {}      {}
+
+    "non-empty array"
+    array-6.2   {e 1}       {}              1       1       {e}     {e 1}
+
+    "nonexistent element using default mode"
+    array-6.3   {e 1}       {[d]}           0       0       {}      {}
+
+    "existing element using default mode"
+    array-6.4   {e 1}       {[e]}           1       1       {e}     {e 1}
+
+    "multiple elements using default mode"
+    array-6.5   {e 1 f 2}   {[ef]}          1       2       {e f}   {e 1 f 2}
+
+    "nonexistent element using -glob"
+    array-6.6   {e 1}       {-glob [d]}     0       0       {}      {}
+
+    "existing element using -glob"
+    array-6.7   {e 1}       {-glob [e]}     1       1       {e}     {e 1}
+
+    "multiple elements using -glob"
+    array-6.8   {e 1 f 2}   {-glob [ef]}    1       2       {e f}   {e 1 f 2}
+
+    "nonexistent element using -exact"
+    array-6.9   {e 1}       {-exact d}      0       0       {}      {}
+
+    "existing element using -exact"
+    array-6.10  {e 1}       {-exact e}      1       1       {e}     {e 1}
+
+    "nonexistent element using -regexp"
+    array-6.11  {e 1}       {-regexp ^[d]}  0       0       {}      {}
+
+    "existing element using -regexp"
+    array-6.12  {e 1}       {-regexp ^[e]}  1       1       {e}     {e 1}
+
+    "multiple elements using -regexp"
+    array-6.13  {e 1 f 2}   {-regexp ^[ef]} 1       2       {e f}   {e 1 f 2}
+} {
+    foreach cmd {exists size names get} {
+        test [string map [list %RESULT% [set $cmd]] {
+            name $name.$cmd
+            desc {$desc: \[array $cmd\]}
+            {scalar cmd} $cmd
+            {scalar args} $args
+            {array a} $dict
+            body {array $cmd a {*}$args}
+            result {%RESULT%}
+        }]
+    }
+}
+foreach {
+    cmd     small   large
+} {
+    exists  1       1
+    size    1       2
+    names   {e}     {e f}
+    get     {e 1}   {e 1 f 2}
+} {
+    test {
+        name array-6.14.$cmd
+        desc {increasing array size: \[array $cmd\]}
+        {scalar cmd} $cmd
+        {array a} {e 1}
+        body {list [array $cmd a][set a(f) 2; list] [array $cmd a]}
+        result {[list $small $large]}
+    }
+    test {
+        name array-6.15.$cmd
+        desc {decreasing array size: \[array $cmd\]}
+        {scalar cmd} $cmd
+        {array a} {e 1 f 2}
+        body {list [array $cmd a][unset a(f)] [array $cmd a]}
+        result {[list $large $small]}
+    }
+}
+
+######### array-7.*: array anymore|donesearch|nextelement|startsearch ##########
+foreach cmd {anymore donesearch nextelement} {
+    test {
+        name array-7.1.$cmd
+        desc {nonexistent search token}
+        {scalar cmd} $cmd
+        {array a} {}
+        body {array $cmd a s-1-a}
+        returnCodes error
+        result {couldn't find search "s-1-a"}
+    }
+}
+foreach {
+    desc
+    name        dict        args            result
+} {
+    "no filter, empty array"
+    array-7.2   {}          {}              {}
+
+    "no filter, single element"
+    array-7.3   {e 1}       {}              {e}
+
+    "no filter, two elements"
+    array-7.4   {f 2 e 1}   {}              {e f}
+
+    "default filter, matches nothing"
+    array-7.5   {f 2 e 1}   {[g]}           {}
+
+    "default filter, matches one item"
+    array-7.6   {f 2 e 1}   {[f]}           {f}
+
+    "default filter, matches two items"
+    array-7.7   {f 2 e 1}   {[ef]}          {e f}
+
+    "-glob filter, matches nothing"
+    array-7.8   {f 2 e 1}   {-glob [g]}     {}
+
+    "-glob filter, matches one item"
+    array-7.9   {f 2 e 1}   {-glob [f]}     {f}
+
+    "-glob filter, matches two items"
+    array-7.10  {f 2 e 1}   {-glob [ef]}    {e f}
+
+    "-exact filter, matches nothing"
+    array-7.11  {f 2 e 1}   {-exact g}      {}
+
+    "-exact filter, matches one item"
+    array-7.12  {f 2 e 1}   {-exact f}      {f}
+
+    "-regexp filter, matches nothing"
+    array-7.13  {f 2 e 1}   {-regexp ^[g]}  {}
+
+    "-regexp filter, matches one item"
+    array-7.14  {f 2 e 1}   {-regexp ^[f]}  {f}
+
+    "-regexp filter, matches two items"
+    array-7.15  {f 2 e 1}   {-regexp ^[ef]} {e f}
+} {
+    test {
+        name $name
+        desc $desc
+        {scalar args} $args
+        {array a} $dict
+        body {
+            set result {}
+            set s [array startsearch a {*}$args]
+            while {[array anymore a $s]} {
+                lappend result [array nextelement a $s]
+            }
+            array donesearch a $s
+            return $result
+        }
+        result $result
+    }
+}
+test {
+    name array-7.16
+    desc {unset visited element during search, bug 46a2410650, s/a var-13.2}
+    {array a} {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
+    body {
+        set s [array startsearch a]
+        unset a([array nextelement a $s])
+        array anymore a $s
+    }
+    returnCodes error
+    result {couldn't find search "s-1-a"}
+}
+test {
+    name array-7.17
+    desc {unset future element during search, bug 46a2410650, s/a var-13.3}
+    {array a} {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
+    body {
+        set result {}
+        set s [array startsearch a]
+        unset a(ee)
+        array anymore a $s
+    }
+    returnCodes error
+    result {couldn't find search "s-1-a"}
+}
+
+# Cleanup.
+foreach namespace [namespace children] {
+    if {$namespace ni $namespaces} {
+        namespace delete $namespace
+    }
+}
+foreach proc [info procs] {
+    if {$proc ni $procs} {
+        rename $proc {}
+    }
+}
+foreach var [info vars] {
+    if {$var ne "vars" && $var ni $vars} {
+        unset $var
+    }
+}
+unset -nocomplain var vars
+::tcltest::cleanupTests
+return
+
+# vim: set sts=4 sw=4 tw=80 et ft=tcl:
+# Local Variables:
+# mode: tcl
+# End:

tests/set-old.test

@@ -369,7 +369,7 @@ test set-old-8.10 {array command, donesearch option, array doesn't exist yet but
 } {1 {"a" isn't an array}}
 test set-old-8.11 {array command, exists option} {
     list [catch {array exists a b} msg] $msg
-} {1 {wrong # args: should be "array exists arrayName"}}
+} {0 0}
 test set-old-8.12 {array command, exists option} {
     catch {unset a}
     array exists a
@@ -390,10 +390,10 @@ test set-old-8.14 {array command, exists option, array doesn't exist yet but has
 } {0 0}
 test set-old-8.15 {array command, get option} {
     list [catch {array get} msg] $msg
-} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
+} {1 {wrong # args: should be "array get arrayName ?mode? ?pattern?"}}
 test set-old-8.16 {array command, get option} {
     list [catch {array get a b c} msg] $msg
-} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
+} {1 {bad option "b": must be -exact, -glob, or -regexp}}
 test set-old-8.17 {array command, get option} {
     catch {unset a}
     array get a
@@ -560,7 +560,7 @@ test set-old-8.39 {array command, size option} {
 } {0}
 test set-old-8.40 {array command, size option} {
     list [catch {array size a 4} msg] $msg
-} {1 {wrong # args: should be "array size arrayName"}}
+} {0 0}
 test set-old-8.41 {array command, size option} {
     catch {unset a}
     array size a
@@ -592,8 +592,9 @@ test set-old-8.45 {array command, size option, array doesn't exist yet but has c
     list [catch {foo 1} msg] $msg
 } {0 0}
 test set-old-8.46 {array command, startsearch option} {
+    catch {unset a}
     list [catch {array startsearch a b} msg] $msg
-} {1 {wrong # args: should be "array startsearch arrayName"}}
+} {1 {"a" isn't an array}}
 test set-old-8.47 {array command, startsearch option} {
     catch {unset a}
     list [catch {array startsearch a} msg] $msg
@@ -809,10 +810,12 @@ test set-old-9.12 {array enumeration with traced undefined elements} {
 
 test set-old-10.1 {array enumeration errors} {
     list [catch {array start} msg] $msg
-} {1 {wrong # args: should be "array startsearch arrayName"}}
-test set-old-10.2 {array enumeration errors} {
-    list [catch {array start a b} msg] $msg
-} {1 {wrong # args: should be "array startsearch arrayName"}}
+} {1 {wrong # args: should be "array startsearch arrayName ?mode? ?pattern?"}}
+test set-old-10.2 {array command, startsearch option} {
+    # Note: appears to be almost identical to set-old-8.47
+    catch {unset a}
+    list [catch {array start a} msg] $msg
+} {1 {"a" isn't an array}}
 test set-old-10.3 {array enumeration errors} {
     catch {unset a}
     list [catch {array start a} msg] $msg

tests/var.test

@@ -746,7 +746,7 @@ test var-11.3 {array unset errors} -setup {
 } -returnCodes error -body {
     array set a { 1,1 a 1,2 b }
     array unset a pattern too
-} -result {wrong # args: should be "array unset arrayName ?pattern?"}
+} -result {bad option "pattern": must be -exact, -glob, or -regexp}
 
 test var-12.1 {TclFindCompiledLocals, {} array name} {
     namespace eval n {
@@ -778,6 +778,24 @@ test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
     set x "If you see this, it worked"
 } -result "If you see this, it worked"
 
+test var-13.2 {unset array with search, bug 46a2410650} -body {
+    apply {{} {
+	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
+	set s [array startsearch a]
+	unset a([array nextelement a $s])
+	array nextelement a $s
+    }}
+} -returnCodes error -result {couldn't find search "s-1-a"}
+
+test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
+    apply {{} {
+	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
+	set s [array startsearch a]
+        unset a(ff)
+	array nextelement a $s
+    }}
+} -returnCodes error -result {couldn't find search "s-1-a"}
+
 test var-14.1 {array names syntax} -body {
     array names foo bar baz snafu
 } -returnCodes 1 -match glob -result *