Tcl Source Code

'\"
'\" 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

.PP
This command performs one of several operations on the
variable given by \fIarrayName\fR.
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
Returns 1 if there are any more elements left to be processed
in an array search, 0 if all elements have already been
returned.
\fISearchId\fR indicates which search on \fIarrayName\fR to

\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search.  \fISearchId\fR indicates
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 ?\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 ?\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.
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
returned are those that exist both before and after the call to
\fBarray get\fR.
.TP
\fBarray names \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
Returns a list containing the names of all of the elements in
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
\fBarray nextelement \fIarrayName searchId\fR
Returns the name of the next element in \fIarrayName\fR, or
an empty string if all elements of \fIarrayName\fR have
already been returned in this search.  The \fIsearchId\fR

Each odd-numbered element in \fIlist\fR is treated as an element
name within \fIarrayName\fR, and the following element in \fIlist\fR
is used as a new value for that array element.
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 ?\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 ?\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
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.
It is currently more efficient and easier to use either the \fBarray
get\fR or \fBarray names\fR, together with \fBforeach\fR, to iterate
over all but very large arrays.  See the examples below for how to do
this.
.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.
.TP
\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.
The command always returns an empty string.
.SH EXAMPLES
.CS
\fBarray set\fR colorcount {

# TIP #400
declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# ----- 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
# available on the designated platform.

interface tclPlat

#else
    int errorLineDontUse; /* Don't use in extensions! */
#endif
}
#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;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
typedef struct Tcl_EncodingState_ *Tcl_EncodingState;

#define TCL_VOLATILE		((Tcl_FreeProc *) 1)
#define TCL_STATIC		((Tcl_FreeProc *) 0)
#define TCL_DYNAMIC		((Tcl_FreeProc *) 3)

/*
 * Flag values passed to variable-related functions.
 * WARNING: these bit choices must not conflict with the bit choice for
 * 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
#define TCL_LIST_ELEMENT	 8
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#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.
 */

#define TCL_ENSEMBLE_PREFIX 0x02/* Flag value to say whether to allow
				 * unambiguous prefixes of commands or to

/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);
/* 630 */
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;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    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;

#ifdef __cplusplus
}
#endif

	(tclStubsPtr->tcl_LoadFile) /* 627 */
#define Tcl_FindSymbol \
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(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) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

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

		if (!TclIsVarUndefined(varPtr)) {
		    TclDecrRefCount(varPtr->value.objPtr);
		    TclSetVarUndefined(varPtr);
		    TclClearVarNamespaceVar(varPtr);
		    TclCleanupVar(varPtr, arrayPtr);

 * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
 * 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) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))

#define TclIsVarLink(varPtr) \
    ((varPtr)->flags & VAR_LINK)

#define TclIsVarInHash(varPtr) \
    ((varPtr)->flags & VAR_IN_HASHTABLE)

#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 \
	: NULL)

#define VarHashRefCount(varPtr) \
    ((VarInHash *) (varPtr))->refCount

    Tcl_CloseEx, /* 624 */
    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    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. */

};

static inline Var *	VarHashCreateVar(TclVarHashTable *tablePtr,
			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);


#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

/*
 * Bit mask matching any of the bits used to select a match filter. AND this
 * mask against a flags value to obtain a value which can be compared against
 * each of the available match modes using the "==" equality operator.
 */

#define TCL_MATCH (TCL_MATCH_EXACT | TCL_MATCH_GLOB | TCL_MATCH_REGEXP)

/*
 * ArrayVar()-specific flag to enable array variable creation.
 */

#define TCL_VAR_CREATE 0x4000

/*
 * NOTE: VarHashCreateVar increments the refcount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in. This requirement
 * can bubble up to callers of callers .... etc.
 */

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,

/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

/*
 * Array search flags.
 */

enum {
    KEEP_ON_ABORT_BIT,
    SEARCH_ABORTED_BIT,

    /*
     * If set, the search structure is not automatically freed when the search
     * terminates early due to an array element being added or removed or the
     * array itself being deleted. In this case, the search structure is kept
     * until the next time a search operation is performed, at which time it is
     * deallocated and an error is reported.
     */

    KEEP_ON_ABORT = 1 << KEEP_ON_ABORT_BIT,

    /*
     * If KEEP_ON_ABORT is set and the search has terminated early, in lieu of
     * immediately freeing the search structure, this bit is set so that it will
     * be freed the next time a search operation is performed.
     */

    SEARCH_ABORTED = 1 << SEARCH_ABORTED_BIT,
};

/*
 * The following structure describes an enumerative search in progress on an
 * array variable. It is used by various Tcl_Array*() functions and their
 * respective [array] script interface commands.
 */

typedef struct Tcl_ArraySearch_ ArraySearch;
struct Tcl_ArraySearch_ {
    Tcl_Obj *name;		/* Name of this search. NULL if this search was
				 * created by Tcl_ArraySearchStart() rather than
				 * the [array startsearch] command. This is done
				 * to prevent C-initiated searches from being
				 * accessed via Tcl commands since they have
				 * different memory management semantics. */
    int id;			/* Integer id used to distinguish among
				 * multiple concurrent searches for the same
				 * array. */
    Tcl_Obj *varNameObj;	/* Name of the array variable. */
    Var *varPtr;		/* Pointer to array variable that's being
				 * searched. */
    Tcl_HashSearch search;	/* Info kept by the hash module about progress
				 * through the array. */
    Var *nextEntry;		/* Non-NULL means this is the next element to
				 * be enumerated (left over from ArrayFirst()

				 * or [array anymore]). NULL means must call
				 * ArrayNext() to get value to return. */

    ArraySearch *nextPtr;	/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
    Tcl_Obj *filterObj;		/* Search filter pattern, or NULL if none. */
    int filterType;		/* TCL_MATCH_EXACT, _GLOB, or _REGEXP. */
    int flags;			/* Search status flags as defined above. */
};

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);

			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);
static Var *		ArrayVar(Tcl_Interp *interp, Tcl_Obj *varNameObj,
			    int *traceFailPtr, int flags);
static int		ArrayVarTrace(Tcl_Interp *interp, Var *varPtr,
			    Tcl_Obj *varNameObj);
static Var *		ArrayFirst(Tcl_Interp *interp, ArraySearch *searchPtr,
			    int *failPtr);
static Var *		ArrayNext(Tcl_Interp *interp, ArraySearch *searchPtr,
			    int *failPtr);
static void		ArrayDone(Tcl_Interp *interp, ArraySearch *searchPtr);
static int  		ArrayAborted(Tcl_Interp *interp,
			    ArraySearch *searchPtr, int dealloc);
static void		ArraySearchFree(ArraySearch *searchPtr);
static int		ArrayNames(Tcl_Interp *interp, Var *varPtr,
			    Tcl_Obj *filterObj, int filterType,
			    Tcl_Obj *listObj);
static int		ArrayArgs(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **varNameObjPtr,
			    Tcl_Obj **patternObjPtr, int *patternTypePtr);

/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */

MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,

    FreeLocalVarName, DupLocalVarName, NULL, NULL
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};


Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{

 *	If the variable (or its containing array) really is dead and in a
 *	hashtable, then its Var structure, and possibly its hash table entry,
 *	is freed up.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupVar(
    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)

	if (VarHashRefCount(arrayPtr) == 0) {
	    ckfree(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}











/*
 *----------------------------------------------------------------------
 *
 * TclLookupVar --
 *
 *	This function is used to locate a variable given its name(s). It has

 * TclLookupArrayElement --
 *
 *	This function is used to locate a variable which is in an array's
 *	hashtable given a pointer to the array's Var structure and the
 *	element's name.
 *
 * Results:
 *	The return value is a pointer to the variable structure, or NULL if
 *	the variable couldn't be found.
 *
 *	If arrayPtr points to a variable that isn't an array and createPart1
 *	is 1, the corresponding variable will be converted to an array.
 *	Otherwise, NULL is returned and an error message is left in the
 *	interp's result if TCL_LEAVE_ERR_MSG is set in flags.
 *

		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), NULL);
	    }
	}
    }
    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayVar --
 *
 *	This function looks up or creates an array variable. The TCL_VAR_CREATE
 *	flag is used to enable creation mode.
 *
 * Results:
 *	If successful, the requested variable is returned. On failure, NULL is
 *	returned, and error information is placed in the interpreter result. If
 *	the error occurred within an array trace and traceFailPtr is not NULL,
 *	*traceFailPtr is set to 1. Non-trace errors are inhibited if flags does
 *	not contain TCL_LEAVE_ERR_MSG.
 *
 * Side effects:
 *	Array traces, if any, are executed. The variable is created if it does
 *	not exist and create mode is enabled.
 *	
 *----------------------------------------------------------------------
 */

static Var *
ArrayVar(
    Tcl_Interp *interp,		/* Command interpreter in which varNamePtr is to
				 * be looked up. */
    Tcl_Obj *varNameObj,	/* Name of array variable in interp. */
    int *traceFailPtr,		/* Unless NULL, set to 1 on trace failure. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY, TCL_LEAVE_ERR_MSG, and
				 * TCL_VAR_CREATE. */
{
    Var *varPtr, *arrayPtr;
    const char *varName;
    int create = !!(flags & TCL_VAR_CREATE);

    /*
     * Strip TCL_VAR_CREATE from flags because no other function recognizes it.
     */

    flags &= ~TCL_VAR_CREATE;

    /*
     * Locate the array variable. Unless in create mode, inhibit the normal
     * variable lookup error messages in favor of the custom messages that will
     * be generated below.
     */

    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL,
	    create ? flags : flags & ~TCL_LEAVE_ERR_MSG, "set",
	    create, create, &arrayPtr);

    /*
     * In create mode with TCL_LEAVE_ERR_MSG set, keep any error messages that
     * were generated. Furthermore, if the variable turned out be an array
     * element, delete it and proceed to the common error routine below.
     */

    if (create) {
	if (!varPtr && (flags & TCL_LEAVE_ERR_MSG)) {
	    return NULL;
	} else if (arrayPtr) {
	    TclCleanupVar(varPtr, arrayPtr);
	    varPtr = NULL;
	}
    }

    if (varPtr) {
	/*
	 * Special array trace used to keep the env array in sync for array
	 * names, array get, etc.
	 */

	if (ArrayVarTrace(interp, varPtr, varNameObj) != TCL_OK) {
	    if (traceFailPtr) {
		*traceFailPtr = 1;
	    }
	    return NULL;
	}

	/*
	 * Verify that it is indeed an array variable. This test comes after the
	 * traces - the variable may actually become an array as an effect of
	 * said traces.
	 */

	if (!create && (!TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	    varPtr = NULL;
	}
    }

    /*
     * Common error generation routine. This handles everything but creation
     * errors (e.g. bad namespace) and traces (handled above).
     */

    if (!varPtr && (flags & TCL_LEAVE_ERR_MSG)) {
	varName = TclGetString(varNameObj);
	if (create) {
	    TclObjVarErrMsg(interp, varNameObj, NULL, "set", needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", varName, NULL);
	} else {
	    Tcl_SetObjResult(interp,
		    Tcl_ObjPrintf("\"%s\" isn't an array", varName));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
	}
    }

    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayVarTrace --
 *
 *	Calls array traces on an array variable.
 *
 * Results:
 *	Returns TCL_OK if the array variable's array traces complete without
 *	error or if the array variable has no array traces. On error, returns
 *	TCL_ERROR and places error information in the interpreter result.
 *
 * Side effects:
 *	Array traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
ArrayVarTrace(
    Tcl_Interp *interp,		/* Interpreter containing the variable. */
    Var *varPtr,		/* Array variable structure pointer. */
    Tcl_Obj *varNameObj)	/* Name of array variable. */
{
    if ((varPtr->flags & VAR_TRACED_ARRAY)
     && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))
     && TclObjCallVarTraces((Interp *)interp, NULL, varPtr, varNameObj,
	    NULL, TCL_LEAVE_ERR_MSG | TCL_TRACE_ARRAY,
	    /*leaveErrMsg*/ 1, -1) != TCL_OK) {
	return TCL_ERROR;
    } else {
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayFirst --
 *
 *	Finds the first element of an array. If a filter is specified, only
 *	elements matching the filter are found.
 *
 * Preconditions:
 *	The interp, varPtr, filterObj, and filterType fields of *searchPtr must
 *	have been initialized.
 *
 * Results:
 *	The first array element is returned, or NULL if there are no matching
 *	elements or on error, in which case *failPtr is set to 1.
 *
 * Side effects:
 *	*searchPtr is updated to track the progress of the enumeration. On
 *	error, detailed error information is placed into the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static Var *
ArrayFirst(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    ArraySearch *searchPtr,	/* Array enumeration state structure. */
    int *failPtr)		/* Set to 1 on error. */
{
    TclVarHashTable *tablePtr = searchPtr->varPtr->value.tablePtr;
    Var *varPtr;

    /*
     * Exact matches and trivial glob matches can be completed immediately since
     * they will only ever match one or zero elements. No need to iterate, just
     * do a direct lookup, then fast-forward to the end of the hash table.
     */

    if (searchPtr->filterObj
     && (searchPtr->filterType == TCL_MATCH_EXACT
      || (searchPtr->filterType == TCL_MATCH_GLOB
       && TclMatchIsTrivial(TclGetString(searchPtr->filterObj))))) {
	varPtr = VarHashFindVar(tablePtr, searchPtr->filterObj);
	searchPtr->search.tablePtr = &tablePtr->table;
	searchPtr->search.nextIndex = tablePtr->table.numBuckets;
	searchPtr->search.nextEntryPtr = NULL;
	searchPtr->nextEntry = NULL;

	if (!varPtr || TclIsVarUndefined(varPtr)) {
	    return NULL;
	} else {
	    return varPtr;
	}
    }

    /*
     * For all other match types, find the first item (which may or may not
     * match the filter) then chain to ArrayNext() to get the real first item.
     */

    searchPtr->nextEntry = VarHashFirstVar(tablePtr, &searchPtr->search);
    return ArrayNext(interp, searchPtr, failPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayNext --
 *
 *	Finds the next element of an array for a given search query.
 *
 *	To peek at the next element without consuming it, copy the returned
 *	element to searchPtr->nextEntry. This causes the next invocation of
 *	ArrayNext() to return the same element again.
 *
 * Preconditions:
 *	ArrayFirst() must have been called on searchPtr.
 *
 * Results:
 *	The next array element is returned, or NULL if there are no matching
 *	elements remaining or on error, in which case *failPtr is set to 1 if
 *	failPtr is not NULL.
 *
 * Side effects:
 *	*searchPtr is updated to track the progress of the enumeration. On
 *	error, detailed error information is placed into the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static Var *
ArrayNext(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    ArraySearch *searchPtr,	/* Array enumeration state structure. */
    int *failPtr)		/* Set to 1 on error. */
{
    Var *varPtr;
    Tcl_Obj *nameObj;
    int matched;

    /*
     * Use the cached nextEntry left over from ArrayFirst() or [array anymore],
     * or else get the next one from the hash table.
     */

    if (searchPtr->nextEntry) {
	varPtr = searchPtr->nextEntry;
	searchPtr->nextEntry = NULL;
    } else {
	varPtr = VarHashNextVar(&searchPtr->search);
    }

    /*
     * Iterate through the hash table until an element matches the filter or the
     * end is reached.
     */

    for (; varPtr; varPtr = VarHashNextVar(&searchPtr->search)) {
	if (!TclIsVarUndefined(varPtr)) {
	    /*
	     * If no filter, accept each defined element regardless of name.
	     */

	    if (!searchPtr->filterObj) {
		return varPtr;
	    }

	    /*
	     * Conditionally accept elements whose names match the filter.
	     */

	    nameObj = VarHashGetKey(varPtr);
	    if (searchPtr->filterType == TCL_MATCH_GLOB) {
		if (Tcl_StringMatch(TclGetString(nameObj),
			TclGetString(searchPtr->filterObj))) {
		    return varPtr;
		}
	    } else if (searchPtr->filterType == TCL_MATCH_REGEXP) {
		matched = Tcl_RegExpMatchObj(interp, nameObj,
			searchPtr->filterObj);
		if (matched < 0) {
		    if (failPtr) {
			*failPtr = 1;
		    }
		    return NULL;
		} else if (matched) {
		    return varPtr;
		}
	    } else if (searchPtr->filterType == TCL_MATCH_EXACT) {
		if (strcmp(TclGetString(nameObj),
			TclGetString(searchPtr->filterObj)) == 0) {
		    return varPtr;
		}
	    } else {
		Tcl_Panic("invalid filter type: %u", searchPtr->filterType);
	    }
	}
    }

    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayDone --
 *
 *	Terminates and cleans up an array search query.
 *
 * Preconditions:
 *	The search argument must be the return value of Tcl_ArraySearchStart()
 *	and must not have been passed to Tcl_ArraySearchDone().
 *
 * Results:
 *	The search query is completed.
 *
 * Side effects:
 *	Resources associated with the search are deallocated.
 *
 *----------------------------------------------------------------------
 */

void
ArrayDone(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    ArraySearch *searchPtr)	/* Array enumeration state structure. */
{
    ArraySearch *prevPtr;
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(
	    &((Interp *)interp)->varSearches, searchPtr->varPtr);

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    if (searchPtr == Tcl_GetHashValue(hPtr)) {
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    searchPtr->varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr = Tcl_GetHashValue(hPtr);; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }

    /*
     * Deallocate the search object.
     */

    ArraySearchFree(searchPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayAborted --
 *
 *	Checks if an array search was aborted due to array elements being added
 *	or removed or the array being unsed. Optionally deallocates it if so.
 *
 * Results:
 *	TCL_OK is returned if the array search did not abort. TCL_ERROR is
 *	returned if the array search did abort, and a message to that effect is
 *	placed in the interpreter result. If the dealloc argument is nonzero,
 *	the array search is also deallocated if it aborted.
 *
 * Side effects:
 *	Memory used by the search may be released to the storage allocator.
 *
 *----------------------------------------------------------------------
 */

int
ArrayAborted(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    ArraySearch *searchPtr,	/* Array enumeration state structure. */
    int dealloc)		/* If nonzero, deallocate aborted searches. */
{
    if (searchPtr->flags & SEARCH_ABORTED) {
	if (dealloc) {
	    ArraySearchFree(searchPtr);
	}
	Tcl_SetResult(interp, "search aborted due to array change", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", "n/a", NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySearchFree --
 *
 *	Deallocates an array search structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory used by the search is released to the storage allocator.
 *
 *----------------------------------------------------------------------
 */

void
ArraySearchFree(
    ArraySearch *searchPtr)	/* Array enumeration state structure. */
{
    if (searchPtr->name) {
	Tcl_DecrRefCount(searchPtr->name);
    }
    Tcl_DecrRefCount(searchPtr->varNameObj);
    if (searchPtr->filterObj) {
	Tcl_DecrRefCount(searchPtr->filterObj);
    }
    ckfree(searchPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayNames --
 *
 *	Obtains a list of array element names, optionally limited by a filter.
 *
 * Results:
 *	Normally, TCL_OK is returned, and the list of matching array element
 *	names is appended to listObj. On error, TCL_ERROR is returned, and the
 *	error information is placed in the interpreter's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayNames(
    Tcl_Interp *interp,		/* Interpreter, used to report regexp errors. */
    Var *varPtr,		/* Array variable. */
    Tcl_Obj *filterObj,		/* Element filter or NULL to accept all. */
    int filterType,		/* TCL_MATCH_EXACT, _GLOB, or _REGEXP. */
    Tcl_Obj *listObj)		/* List to which array names are appended. */
{
    ArraySearch search;
    int fail = 0, oldLen, newLen;

    /*
     * Ensure output object is a list. Also get its length in case there is
     * trouble and changes need to be rolled back. Such a failure should never
     * occur because it requires a regular expression to initially succeed then
     * return error on a subsequent evaluation, but handle it anyway because
     * it's easy to do.
     */

    if (Tcl_ListObjLength(interp, listObj, &oldLen) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Begin the search.
     */

    search.varPtr = varPtr;
    search.filterObj = filterObj;
    search.filterType = filterType;
    search.nextEntry = NULL;
    search.flags = 0;
    varPtr = ArrayFirst(interp, &search, &fail);

    /*
     * Enumerate the array.
     */

    for (; varPtr; varPtr = ArrayNext(interp, &search, &fail)) {
	Tcl_ListObjAppendElement(interp, listObj, VarHashGetKey(varPtr));
    }

    /*
     * On failure, roll back changes to output list.
     */

    if (fail) {
	Tcl_ListObjLength(interp, listObj, &newLen);
	Tcl_ListObjReplace(interp, listObj, oldLen, newLen - oldLen, 0, NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayArgs --
 *
 *	Common argument parser for numerous [array] commands, namely:
 *	startsearch, exists, get, names, size, and unset.
 *
 * Results:
 *	Arguments are parsed, results are written to caller variables, and
 *	TCL_OK is returned. On failure, TCL_ERROR is returned, and error
 *	information is logged to the interpreter.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayArgs(
    Tcl_Interp *interp,		/* Interpreter into which errors are logged. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument vector. */
    Tcl_Obj **varNameObjPtr,	/* Location to write variable name. */
    Tcl_Obj **filterObjPtr,	/* Location to write filter pattern. */
    int *filterTypePtr)		/* Location to write filter type code. */
{
    static const struct {
	const char *name;
	int type;
    } options[] = {
	{"-exact"   , TCL_MATCH_EXACT	},
	{"-glob"    , TCL_MATCH_GLOB	},
	{"-regexp"  , TCL_MATCH_REGEXP	},
	{NULL	    , 0			},
    };
    enum {OPT_EXACT, OPT_GLOB, OPT_REGEXP} mode = OPT_GLOB;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
	return TCL_ERROR;
    }

    if (objc == 4 && Tcl_GetIndexFromObjStruct(interp, objv[2], options,
	    sizeof(*options), "option", 0, (int *)&mode) != TCL_OK) {
	return TCL_ERROR;
    }

    *varNameObjPtr = objv[1];
    *filterObjPtr = objc > 2 ? objv[objc - 1] : NULL;
    *filterTypePtr = options[mode].type;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySet --
 *
 *	Set the elements of an array. If there are no elements to set, create
 *	an empty array.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	A variable will be created if one does not already exist.
 *	Callers must Incr part1Ptr if they plan to Decr it.
 *	Array and variable set traces are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySet(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *part1Ptr,		/* The array name. */
    Tcl_Obj *dictPtr,		/* The array elements list or dict. If this is
				 * NULL, create an empty array. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY. */
{
    Var *varPtr;
    int result, i;

    if (!(varPtr = ArrayVar(interp, part1Ptr, NULL,
	    flags | TCL_LEAVE_ERR_MSG | TCL_VAR_CREATE))) {
	return TCL_ERROR;
    }

    if (dictPtr == NULL) {
	goto ensureArray;
    }

    /*
     * Install the contents of the dictionary or list into the array.
     */

    if (dictPtr->typePtr == &tclDictType) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;

	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (done == 0) {
	    /*
	     * Empty, so we'll just force the array to be properly existing
	     * instead.
	     */

	    goto ensureArray;
	}

	/*
	 * Don't need to look at result of Tcl_DictObjFirst as we've just
	 * successfully used a dictionary operation on the same object.
	 */

	for (Tcl_DictObjFirst(interp, dictPtr, &search,
		&keyPtr, &valuePtr, &done) ; !done ;
		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
	    /*
	     * At this point, it would be nice if the key was directly usable
	     * by the array. This isn't the case though.
	     */

	    Var *elemVarPtr = TclLookupArrayElement(interp, part1Ptr,
		    keyPtr, flags | TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVar(interp, elemVarPtr, varPtr, part1Ptr,
		    keyPtr, valuePtr, flags | TCL_LEAVE_ERR_MSG, -1) == NULL)) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, dictPtr,
		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}

	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVar will return NULL so that we break out of the
	 * loop and return an error.
	 */

	copyListObj = TclListObjCopy(NULL, dictPtr);
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, part1Ptr,
		    elemPtrs[i], flags | TCL_LEAVE_ERR_MSG, "set",
		    1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVar(interp, elemVarPtr, varPtr, part1Ptr,
		    elemPtrs[i],elemPtrs[i + 1],
		    flags | TCL_LEAVE_ERR_MSG, -1) == NULL)) {
		result = TCL_ERROR;
		break;
	    }
	}
	Tcl_DecrRefCount(copyListObj);
	return result;
    }

    /*
     * The list is empty make sure we have an array, or create one if
     * necessary.
     */

  ensureArray:
    if (varPtr != NULL) {
	if (TclIsVarArray(varPtr)) {
	    /*
	     * Already an array, done.
	     */

	    return TCL_OK;
	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, part1Ptr, NULL, "array set", needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclSetVarArray(varPtr);
    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArrayUnset --
 *
 *	Unsets array elements, optionally limited by a filter. It is not an
 *	error for the filter to not match any elements or for the variable to
 *	not exist or not be an array.
 *
 * Results:
 *	The requested array elements are unset, and TCL_OK is returned. On trace
 *	or filter match error, TCL_ERROR is returned and error information is
 *	placed in the interpreter result.
 *
 * Side effects:
 *	Array and unset traces are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArrayUnset(
    Tcl_Interp *interp,		/* Interpreter containing the variable. */
    Tcl_Obj *part1Ptr,		/* Name of the array variable. */
    Tcl_Obj *part2Ptr,		/* Element filter or NULL to unset all. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY, and at most one of
				 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    ArraySearch search;
    int fail = 0, filterType = flags & TCL_MATCH;
    Var *varPtr, *elemPtr, *protectedElemPtr;

    /*
     * Locate the array variable. This has the side effect of executing any
     * array traces. If the variable does not exist, exit successfully.
     */

    if (!(varPtr = ArrayVar(interp, part1Ptr, &fail, 0))) {
	return fail ? TCL_ERROR : TCL_OK;
    }

    /*
     * When no filter is given, unset the whole array.
     */

    if (!part2Ptr) {
	return TclObjUnsetVar2(interp, part1Ptr, NULL, flags);
    }

    /*
     * With an exact match or trivial pattern, unset the single element.
     */

    if (filterType == TCL_MATCH_EXACT || (filterType == TCL_MATCH_GLOB
     && TclMatchIsTrivial(TclGetString(part2Ptr)))) {
	elemPtr = VarHashFindVar(varPtr->value.tablePtr, part2Ptr);
	if (!elemPtr || TclIsVarUndefined(elemPtr)) {
	    return TCL_OK;
	} else {
	    return TclPtrUnsetVar(interp, elemPtr, varPtr,
		    part1Ptr, part2Ptr, 0, -1);
	}
    }

    /*
     * Prepare to iterate through all elements of the array.
     */

    search.varPtr = varPtr;
    search.filterObj = part2Ptr;
    search.filterType = filterType;
    search.flags = 0;
    elemPtr = ArrayFirst(interp, &search, &fail);

    /*
     * Non-trivial case (well, deeply tricky really). We peek inside the hash
     * iterator in order to allow us to guarantee that the following element
     * in the array will not be scrubbed until we have dealt with it. This
     * stops the overall iterator from ending up pointing into deallocated
     * memory. [Bug 2939073]
     */

    protectedElemPtr = NULL;
    for (; elemPtr; elemPtr = ArrayNext(interp, &search, &fail)) {
	/*
	 * Drop the extra ref immediately. We don't need to free it at this
	 * point though; we'll be unsetting it if necessary soon.
	 */

	if (protectedElemPtr == elemPtr) {
	    VarHashRefCount(protectedElemPtr)--;
	}

	/*
	 * Peek ahead at the next item in the search and guard it against being
	 * deallocated in the scenario where the unset trace on the current
	 * element causes the next element to be unset as well.
	 *
	 * Curiosity: each hash table bucket is a linked list to which new items
	 * are prepended, so "next" usually means the latest element in the same
	 * bucket that was set before the current element.
	 */

	if ((search.nextEntry = ArrayNext(interp, &search, &fail))) {
	    VarHashRefCount(protectedElemPtr)++;
	}
	protectedElemPtr = search.nextEntry;

	/*
	 * If the variable is undefined, clean it out as it has been hit by
	 * something else (i.e., an unset trace).
	 */

	if (TclIsVarUndefined(elemPtr)) {
	    TclCleanupVar(elemPtr, varPtr);
	} else if (TclPtrUnsetVar(interp, elemPtr, varPtr, part1Ptr,
		VarHashGetKey(elemPtr), 0, -1) != TCL_OK) {
	    /*
	     * If we incremented a refcount, we must decrement it here as we
	     * will not be coming back properly due to the error.
	     */

	    if (protectedElemPtr) {
		VarHashRefCount(protectedElemPtr)--;
		TclCleanupVar(protectedElemPtr, varPtr);
	    }
	    return TCL_ERROR;
	}
    }

    return fail ? TCL_ERROR : TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArrayGet --
 *
 *	This function loads the contents of an array into a dict. It is not an
 *	error for the variable to not exist or not be an array; in this case,
 *	the dict is not modified, as if the variable were an empty array.
 *
 * Results:
 *	The array is loaded into the specified dict. The array element names and
 *	values become the dict keys and values, respectively. If a filter is
 *	supplied, only the elements whose names match the filter are loaded.
 *
 *	If the output dict isn't initially empty, the new keys and values take
 *	precedence over its initial contents. This can be used to merge multiple
 *	arrays, or multiple collections of elements from a single array obtained
 *	by different filters, into a single dict. There is a mild performance
 *	penalty when the output dict isn't initially empty due to the need to
 *	maintain a rollback dict in case an array trace or read trace unsets the
 *	array during the execution of this function.
 *
 *	The return value is TCL_OK on success and TCL_ERROR on trace or filter
 *	match error.
 *
 * Side effects:
 *	Array and variable read traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArrayGet(
    Tcl_Interp *interp,		/* Interpreter in which to look up variable. */
    Tcl_Obj *part1Ptr,		/* Name of array variable. */
    Tcl_Obj *part2Ptr,		/* Element filter or NULL to read all. */
    Tcl_Obj *dictPtr,		/* Dict object to load array data into. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY, and at most one of
				 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    Tcl_Obj *nameListObj, *rollbackObj, **nameObjPtr, *valueObj;
    Var *varPtr;
    int fail = 0, filterType = flags & TCL_MATCH, i, count, result;

    /*
     * Locate the array variable. Report trace failures as errors. If the
     * variable is a scalar or does not exist, treat it like an empty array.
     */

    if (!(varPtr = ArrayVar(interp, part1Ptr, &fail, flags))) {
	return fail ? TCL_ERROR : TCL_OK;
    }

    /*
     * Confirm the output structure forms a valid dict. It's also important to
     * check whether it's initially empty or not.
     */

    if (Tcl_DictObjSize(interp, dictPtr, &count) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the list of element names matching the filter.
     */

    TclNewObj(nameListObj);
    Tcl_IncrRefCount(nameListObj);
    if (ArrayNames(interp, varPtr, part2Ptr, filterType,
	    nameListObj) != TCL_OK) {
	Tcl_DecrRefCount(nameListObj);
	return TCL_ERROR;
    }

    /*
     * If the output dict wasn't initially empty, prepare to undo any changes
     * made to it in case an error occurs.
     */

    if (count) {
	TclNewObj(rollbackObj);
	Tcl_IncrRefCount(rollbackObj);
    } else {
	rollbackObj = NULL;
    }

    /*
     * Make sure the Var structure of the array is not removed by a trace while
     * we're working.
     */

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }

    /*
     * Load the array keys and values into the output dict.
     */

    Tcl_ListObjGetElements(interp, nameListObj, &count, &nameObjPtr);
    result = TCL_OK;
    for (i = 0; i < count; ++i, ++nameObjPtr) {
	/*
	 * If rollback is enabled, before loading each new value, remember the
	 * old value already present in the output dict.
	 */

	if (rollbackObj) {
	    Tcl_DictObjGet(interp, dictPtr, *nameObjPtr, &valueObj);
	    if (valueObj) {
		Tcl_DictObjPut(interp, rollbackObj, *nameObjPtr, valueObj);
	    }
	}

	/*
	 * Try to get the array element value, but beware of traces.
	 */

	valueObj = Tcl_ObjGetVar2(interp, part1Ptr, *nameObjPtr,
		TCL_LEAVE_ERR_MSG);

	if (valueObj) {
	    /*
	     * If the array element was found, load it into the output dict, an
	     * operation which cannot fail since the output was already
	     * confirmed to be a valid dict.
	     */

	    Tcl_DictObjPut(interp, dictPtr, *nameObjPtr, valueObj);
	} else if (!TclIsVarArray(varPtr)) {
	    /*
	     * On error (specifically, if a trace deleted the array), restore
	     * the output dict to the way it was when this function was called.
	     *
	     * If the element was unset by a trace, proceed as if it never
	     * existed in the first place, provided the array still exists.
	     */

	    if (rollbackObj) {
		count = i;
		nameObjPtr -= i;
		for (i = 0; i < count; ++i, ++nameObjPtr) {
		    Tcl_DictObjGet(interp, rollbackObj, *nameObjPtr, &valueObj);
		    if (valueObj) {
			Tcl_DictObjPut(interp, dictPtr, *nameObjPtr, valueObj);
		    } else {
			Tcl_DictObjRemove(interp, dictPtr, *nameObjPtr);
		    }
		}
	    } else {
		Tcl_SetStringObj(dictPtr, NULL, 0);
	    }

	    result = TCL_ERROR;
	    break;
	}
    }

    /*
     * Clean up internal data structures, then report success or failure.
     */

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    if (rollbackObj) {
	Tcl_DecrRefCount(rollbackObj);
    }
    Tcl_DecrRefCount(nameListObj);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArrayNames --
 *
 *	Obtains a list of array element names, optionally limited by a filter.
 *
 * Results:
 *	Normally, TCL_OK is returned, and the list of matching array element
 *	names is appended to listPtr. On error, TCL_ERROR is returned, and the
 *	error information is placed in the interpreter's result. If part1Ptr
 *	does not name an array, TCL_OK is returned and listPtr is unmodified.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArrayNames(
    Tcl_Interp *interp,		/* Command interpreter in which part1Ptr is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    Tcl_Obj *part2Ptr,		/* Element filter or NULL to accept all. */
    Tcl_Obj *listPtr,		/* List to which array names are appended. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY, and at most one of
				 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    int traceFail = 0;
    Var *varPtr = ArrayVar(interp, part1Ptr, &traceFail, flags);

    if (varPtr) {
	return ArrayNames(interp, varPtr, part2Ptr, flags & TCL_MATCH, listPtr);
    } else if (traceFail) {
	return TCL_ERROR;
    } else {
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySize --
 *
 *	This function reports the number of elements in an array variable. It
 *	provides C-level access to [array size] functionality. If part2Ptr is
 *	not NULL, only array elements whose names match part2Ptr are counted
 *	toward the return value. The interpretation of part2Ptr is controlled by
 *	the TCL_MATCH_* bits within flags.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *intPtr will be set to
 *	the integer count of array elements whose names match the given filter.
 *	If varNamePtr does not name an array, TCL_OK is returned and *intPtr is
 *	set to 0. If an array trace error occurs, or if there is an error in the
 *	filter (e.g. bad regular expression), TCL_ERROR is returned and an error
 *	message is left in the interpreter's result.
 *
 * Side effects:
 *	Array traces, if any, are executed.
 *	
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySize(
    Tcl_Interp *interp,		/* Command interpreter in which part1Ptr is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    Tcl_Obj *part2Ptr,		/* Element filter or NULL to accept all. */
    int *intPtr,		/* Location to which size is written. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY, and at most one of
				 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    Var *varPtr;
    ArraySearch search;
    int fail = 0, size = 0;

    if ((varPtr = ArrayVar(interp, part1Ptr, &fail, flags))) {
	/*
	 * Determine the size by counting the number of times ArrayFirst() or
	 * ArrayNext() returns non-NULL.
	 */

	search.varPtr = varPtr;
	search.filterObj = part2Ptr;
	search.filterType = flags & TCL_MATCH;
	search.flags = 0;
	for (varPtr = ArrayFirst(interp, &search, &fail); varPtr;
		varPtr = ArrayNext(interp, &search, &fail)) {
	    ++size;
	}
    }
	
    if (fail) {
	return TCL_ERROR;
    }

    *intPtr = size;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArrayExists --
 *
 *	This function checks if an array or array element exists. If part2Ptr is
 *	NULL, the existence of the array is checked. If part2Ptr is not NULL,
 *	this function instead checks if at least one array element name matches
 *	the filter specified by part2Ptr and the TCL_MATCH_* bits within flags.
 *
 * Results:
 *	*intPtr is set to 1 or 0 if the array or array element does or does not
 *	exist, and TCL_OK is returned. *intPtr is also set to 0 if a variable
 *	with the given name exists but is not an array, as well as in event of
 *	lookup error such as nonexistent namespace. If an array trace error
 *	occurs, TCL_ERROR is returned and *intPtr is not modified.
 *
 * Side effects:
 *	Array traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArrayExists(
    Tcl_Interp *interp,		/* Interpreter in which to look up variable. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    Tcl_Obj *part2Ptr,		/* Element to check or NULL to check array. */
    int *intPtr,		/* Set to 1 if array exists, 0 if not. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY, and at most one of
				 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    ArraySearch search;
    int fail = 0;
    Var *varPtr = ArrayVar(interp, part1Ptr, &fail, flags);

    /*
     * If the array lookup succeeded and a filter was specified, attempt to find
     * the first element which matches the filter.
     */

    if (varPtr && part2Ptr) {
	search.varPtr = varPtr;
	search.filterObj = part2Ptr;
	search.filterType = flags & TCL_MATCH;
	search.flags = 0;
	varPtr = ArrayFirst(interp, &search, &fail);
    }

    if (varPtr) {
	*intPtr = 1;
    } else if (fail) {
	return TCL_ERROR;
    } else {
	*intPtr = 0;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySearchStart --
 *
 *	This function initiates an array search, i.e. step-by-step array element
 *	enumeration. It provides C-level access to [array startsearch]. The
 *	returned value is used to obtain one array element name at a time. If
 *	part2Ptr is not NULL, only array elements whose names match part2Ptr are
 *	returned by future calls to Tcl_ArraySearchNext(). The interpretation of
 *	part2Ptr is controlled by the TCL_MATCH_* bits within flags.
 *
 * Important note:
 *	Unlike all the other Tcl_Array*() functions, this function reports array
 *	existence errors rather than treating nonexistent and scalar variables
 *	as if they were empty arrays.
 *
 * Results:
 *	A new array search is created and returned. If part1Ptr does not name an
 *	array, if there is a problem with the filter, or if an array trace error
 *	occurred, no search is created, NULL is returned, and error information
 *	is placed in the interpreter.
 *
 * Side effects:
 *	On success, the search is allocated on the heap. To avoid a memory leak,
 *	the search must be deallocated by Tcl_ArraySearchDone() when complete.
 *	Array traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

Tcl_ArraySearch
Tcl_ArraySearchStart(
    Tcl_Interp *interp,		/* Command interpreter in which part1Ptr is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    Tcl_Obj *part2Ptr,		/* Element filter or NULL to accept all. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
                                 * TCL_NAMESPACE_ONLY, and at most one of
                                 * TCL_MATCH_EXACT, _GLOB, and _REGEXP. */
{
    Interp *iPtr = (Interp *)interp;
    Var *varPtr = ArrayVar(interp, part1Ptr, NULL, flags | TCL_LEAVE_ERR_MSG);
    Tcl_HashEntry *hPtr;
    int isNew, fail = 0;
    ArraySearch search, *searchPtr;

    /*
     * Handle the possible error cases before performing any allocations.
     */

    if (!varPtr) {
	return NULL;
    }

    search.nextEntry = ArrayFirst(interp, &search, &fail);
    if (!search.nextEntry && fail) {
	return NULL;
    }
    search.name = NULL;
    search.varNameObj = part1Ptr;
    search.varPtr = varPtr;
    search.filterObj = part2Ptr;
    search.filterType = flags & TCL_MATCH;
    search.flags = KEEP_ON_ABORT;

    /*
     * Make a new array search.
     */

    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	search.id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	search.nextPtr = NULL;
    } else {
	search.id = ((ArraySearch *)Tcl_GetHashValue(hPtr))->id + 1;
	search.nextPtr = Tcl_GetHashValue(hPtr);
    }
    Tcl_IncrRefCount(search.varNameObj);
    if (part2Ptr) {
	Tcl_IncrRefCount(part2Ptr);
    }
    searchPtr = ckalloc(sizeof(*searchPtr));
    *searchPtr = search;
    Tcl_SetHashValue(hPtr, searchPtr);

    return searchPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySearchPeek --
 *
 *	Finds the next element of an array for a given search query. Unlike
 *	Tcl_ArraySearchNext(), the only side effect is array traces, so the
 *	search query state is not advanced and the element is not consumed.
 *
 * Preconditions, results:
 *	Same as Tcl_ArraySearchNext().
 *
 * Side effects:
 *	Array traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySearchPeek(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    Tcl_ArraySearch search,	/* Prior return from Tcl_ArraySearchStart(). */
    Tcl_Obj **keyPtrPtr,	/* Location to which pointer to next array
				 * element name is written. NULL is written when
				 * the end of the array has been encountered. */
    Tcl_Obj **valuePtrPtr)	/* If not NULL, location to which pointer to
				 * next array element value is written. NULL is
				 * written when at the end of the array. */
{
    Tcl_Obj *keyObj, *valueObj;

    /*
     * Report aborted searches.
     */

    if (ArrayAborted(interp, search, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Execute array traces and report any errors that may arise.
     */

    if (ArrayVarTrace(interp, search->varPtr, search->varNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the next array element, but push it back into the nextEntry buffer so
     * that it will be reused when ArrayNext() is called again.
     */

    if ((search->nextEntry = ArrayNext(interp, search, NULL))) {
	/*
	 * If not at the end of the array, get the element name and (if an
	 * output location was given) element value. Report any errors that may
	 * occur due to reading the element value if it is requested.
	 */

	keyObj = VarHashGetKey(search->nextEntry);
	if (valuePtrPtr) {
	    if ((valueObj = Tcl_ObjGetVar2(interp, search->varNameObj, keyObj,
		    TCL_LEAVE_ERR_MSG))) {
		*valuePtrPtr = valueObj;
	    } else {
		return TCL_ERROR;
	    }
	}
	*keyPtrPtr = keyObj;
    } else {
	/*
	 * At the end of the array, store NULL for the element name and (if an
	 * output location was given) element value.
	 */

	*keyPtrPtr = NULL;
	if (valuePtrPtr) {
	    *valuePtrPtr = NULL;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySearchNext --
 *
 *	Finds the next element of an array for a given search query.
 *
 * Preconditions:
 *	The search argument must be the return value of Tcl_ArraySearchStart()
 *	and must not have been passed to Tcl_ArraySearchDone().
 *
 * Results:
 *	The next array element name is written to *keyPtrPtr. If valuePtrPtr is
 *	not NULL, the array element value is written to *valuePtrPtr. If there
 *	are no more array elements, NULL is written instead. If an array trace
 *	or variable read trace error occurs, TCL_ERROR is returned and error
 *	information is placed in the interpreter result.
 *
 * Side effects:
 *	The search data structure is updated such that successive invocations of
 *	this function will return successive array element names.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySearchNext(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    Tcl_ArraySearch search,	/* Prior return from Tcl_ArraySearchStart(). */
    Tcl_Obj **keyPtrPtr,	/* Location to which pointer to next array
				 * element name is written. NULL is written when
				 * the end of the array has been encountered. */
    Tcl_Obj **valuePtrPtr)	/* If not NULL, location to which pointer to
				 * next array element value is written. NULL is
				 * written when at the end of the array. */
{
    /*
     * Let Tcl_ArraySearchPeek() do all the work, then clear the search
     * structure's nextEntry buffer so that the search will advance.
     */

    if (Tcl_ArraySearchPeek(interp, search, keyPtrPtr, valuePtrPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    search->nextEntry = NULL;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySearchDone --
 *
 *	Terminates and cleans up an array search query.
 *
 * Preconditions:
 *	The search argument must be the return value of Tcl_ArraySearchStart()
 *	and must not have been passed to Tcl_ArraySearchDone().
 *
 * Results:
 *	Normally, the search query is completed, and TCL_OK is returned. If an
 *	array trace has an error, TCL_ERROR is returned and error information is
 *	placed in the interpreter result.
 *
 * Side effects:
 *	Resources associated with the search are deallocated. Array traces, if
 *	any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySearchDone(
    Tcl_Interp *interp,		/* Command interpreter in which the array
				 * variable is located. */
    Tcl_ArraySearch search)	/* Prior return from Tcl_ArraySearchStart(). */
{
    /*
     * Report and deallocate aborted searches.
     */

    if (ArrayAborted(interp, search, 1) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Execute array traces and report any errors that may arise.
     */

    if (ArrayVarTrace(interp, search->varPtr, search->varNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    ArrayDone(interp, search);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArrayStatistics --
 *
 *	Returns statistics about the distribution of data within the hash table
 *	that represents the array. This information includes the number of
 *	entries in the table, the number of buckets, and the utilization of the
 *	buckets.
 *
 * Results:
 *	Normally, TCL_OK is returned, and the statistics information is appended
 *	to stringPtr. If part1Ptr does not name an array, or if an array trace
 *	error occurs, TCL_ERROR is returned and error information is left in the
 *	interpreter result.
 *
 * Side effects:
 *	Array traces, if any, are executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ArrayStatistics(
    Tcl_Interp *interp,		/* Interpreter containing the variable. */
    Tcl_Obj *part1Ptr,		/* Name of the array variable. */
    Tcl_Obj *stringPtr,		/* String to which statistics is appended. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_NAMESPACE_ONLY. */
{
    Var *varPtr = ArrayVar(interp, part1Ptr, NULL, flags | TCL_LEAVE_ERR_MSG);
    char *stats;

    if (!varPtr) {
	return TCL_ERROR;
    }

    stats = Tcl_HashStats((Tcl_HashTable *)varPtr->value.tablePtr);
    Tcl_AppendToObj(stringPtr, stats, -1);
    ckfree(stats);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar --
 *
 *	Return the value of a Tcl variable as a string.

     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of
     * its value object, if any, was decremented above.
     */

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
	TclCleanupVar(varPtr, arrayPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

	 * referenced variable if it's no longer needed.
	 */

	Var *linkPtr = dummyVar.value.linkPtr;

	if (TclIsVarInHash(linkPtr)) {
	    VarHashRefCount(linkPtr)--;
	    TclCleanupVar(linkPtr, NULL);
	}
    }

    /*
     * If the variable was a namespace variable, decrement its reference
     * count.
     */

    Tcl_SetObjResult(interp, newValuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *









































































































































































 * ArrayStartSearchCmd --
 *
 *	This object-based function is invoked to process the "array
 *	startsearch" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */















































static int
ArrayStartSearchCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    Tcl_Obj *varNameObj, *filterObj, *tokenObj;


    ArraySearch *searchPtr;
    int filterType;


    if (ArrayArgs(interp, objc, objv, &varNameObj,
	    &filterObj, &filterType) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!(searchPtr = Tcl_ArraySearchStart(interp, varNameObj, filterObj,
	    TCL_LEAVE_ERR_MSG | filterType))) {
	return TCL_ERROR;
    }

    /*
     * Give the search a name so it can be looked up by other array commands.
     */

    tokenObj = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
	    TclGetString(varNameObj));

    searchPtr->name = tokenObj;
    Tcl_IncrRefCount(tokenObj);

    /*
     * Clear the KEEP_ON_ABORT flag which was set by Tcl_ArraySearchStart() so
     * the search structure will automatically be deallocated should the search
     * terminate early due to array elements being added or removed or the array
     * itself being unset.


     */

    searchPtr->flags = 0;





    Tcl_SetObjResult(interp, tokenObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayAnyMoreCmd --

    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;

    ArraySearch *searchPtr;
    int gotValue, fail = 0;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (!(varPtr = ArrayVar(interp, varNameObj, NULL, TCL_LEAVE_ERR_MSG))) {

	return TCL_ERROR;
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Scan forward to find if there are any further matching elements in the
     * array. Put the found element (if any) into searchPtr->nextEntry so that
     * it is not consumed and is available for the next call.
     */


    if ((searchPtr->nextEntry = ArrayNext(interp, searchPtr, &fail))) {


	gotValue = 1;
    } else if (fail) {
	return TCL_ERROR;
    } else {



	gotValue = 0;

    }

    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

static int
ArrayNextElementCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *elemPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (!(varPtr = ArrayVar(interp, varNameObj, NULL, TCL_LEAVE_ERR_MSG))) {

	return TCL_ERROR;
    }

    /*
     * Get the search.
     */

    if (!(searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj))) {

	return TCL_ERROR;
    }

    /*
     * Get the next element from the search, or the empty string on exhaustion.



     */


    if ((elemPtr = ArrayNext(interp, searchPtr, NULL))) {
	Tcl_SetObjResult(interp, VarHashGetKey(elemPtr));




    }






    return TCL_OK;


}

/*
 *----------------------------------------------------------------------
 *
 * ArrayDoneSearchCmd --
 *

static int
ArrayDoneSearchCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    Var *varPtr;

    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (!(varPtr = ArrayVar(interp, varNameObj, NULL, TCL_LEAVE_ERR_MSG))) {

	return TCL_ERROR;
    }

    /*
     * Get the search.
     */

    if (!(searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj))) {

	return TCL_ERROR;
    }

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */


















    ArrayDone(interp, searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayExistsCmd --

ArrayExistsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Obj *varNameObj, *filterObj;
    int exists, filterType;


    if (ArrayArgs(interp, objc, objv, &varNameObj,
	    &filterObj, &filterType) != TCL_OK) {
	return TCL_ERROR;
    }





    if (Tcl_ArrayExists(interp, varNameObj, filterObj, &exists,


	    filterType) != TCL_OK) {










	return TCL_ERROR;
    }








    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[exists]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayGetCmd --

static int
ArrayGetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{


    Tcl_Obj *varNameObj, *filterObj, *resultObj;




    int filterType;













    if (ArrayArgs(interp, objc, objv, &varNameObj,



	    &filterObj, &filterType) != TCL_OK) {













	return TCL_ERROR;
    }















































    TclNewObj(resultObj);


    Tcl_IncrRefCount(resultObj);



    if (Tcl_ArrayGet(interp, varNameObj, filterObj, resultObj,
















	    filterType) != TCL_OK) {


	Tcl_DecrRefCount(resultObj);



















	return TCL_ERROR;

    }








    Tcl_SetObjResult(interp, resultObj);
    Tcl_DecrRefCount(resultObj);
    return TCL_OK;








}

/*
 *----------------------------------------------------------------------
 *
 * ArrayNamesCmd --
 *

static int
ArrayNamesCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{






    Tcl_Obj *varNameObj, *filterObj, *resultObj;



    int filterType;






    if (ArrayArgs(interp, objc, objv, &varNameObj,


























	    &filterObj, &filterType) != TCL_OK) {
	return TCL_ERROR;
    }
















    TclNewObj(resultObj);










    Tcl_IncrRefCount(resultObj);





    if (Tcl_ArrayNames(interp, varNameObj, filterObj, resultObj,



	    filterType) != TCL_OK) {



















	Tcl_DecrRefCount(resultObj);
	return TCL_ERROR;
    }









    Tcl_SetObjResult(interp, resultObj);
    Tcl_DecrRefCount(resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindArrayPtrElements --

static int
ArraySetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{



    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
	return TCL_ERROR;
    }






















    return Tcl_ArraySet(interp, objv[1], objv[2], 0);
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySizeCmd --
 *

static int
ArraySizeCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{


    Tcl_Obj *varNameObj, *filterObj;


    int filterType, size;


    if (ArrayArgs(interp, objc, objv, &varNameObj,
	    &filterObj, &filterType) != TCL_OK) {
	return TCL_ERROR;
    }





    if (Tcl_ArraySize(interp, varNameObj, filterObj, &size,


	    filterType) != TCL_OK) {










	return TCL_ERROR;





















    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
    return TCL_OK;
}

/*

static int
ArrayStatsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{


    Tcl_Obj *resultObj;


    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }





    TclNewObj(resultObj);


    Tcl_IncrRefCount(resultObj);




    if (Tcl_ArrayStatistics(interp, objv[1], resultObj, 0) != TCL_OK) {








	Tcl_DecrRefCount(resultObj);












	return TCL_ERROR;
    }



    Tcl_SetObjResult(interp, resultObj);



    Tcl_DecrRefCount(resultObj);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayUnsetCmd --

static int
ArrayUnsetCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{


    Tcl_Obj *varNameObj, *filterObj;



    int filterType;













    if (ArrayArgs(interp, objc, objv, &varNameObj,



	    &filterObj, &filterType) != TCL_OK) {













	return TCL_ERROR;
    }


















    return Tcl_ArrayUnset(interp, varNameObj, filterObj, filterType);












































































}

/*
 *----------------------------------------------------------------------
 *
 * TclInitArrayCmd --
 *

	linkPtr = varPtr->value.linkPtr;
	if (linkPtr == otherPtr) {
	    return TCL_OK;
	}
	if (TclIsVarInHash(linkPtr)) {
	    VarHashRefCount(linkPtr)--;
	    if (TclIsVarUndefined(linkPtr)) {
		TclCleanupVar(linkPtr, NULL);
	    }
	}
    }
    TclSetVarLink(varPtr);
    varPtr->value.linkPtr = otherPtr;
    if (TclIsVarInHash(otherPtr)) {
	VarHashRefCount(otherPtr)++;

	    if (searchPtr->name == handleObj) {
		return searchPtr;
	    }
	}
	/* Fallback: do string compares. */
	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->name
		    && strcmp(TclGetString(searchPtr->name), handle) == 0) {
		return searchPtr;
	    }
	}
    }
    if ((handle[0] != 's') || (handle[1] != '-')
	    || (strtoul(handle + 2, &end, 10), end == (handle + 2))
	    || (*end != '-')) {

}

/*
 *----------------------------------------------------------------------
 *
 * DeleteSearches --
 *
 *	This function is called to free up all of the searches associated with
 *	an array variable. Any searches with the KEEP_ON_ABORT flag set will not
 *	immediately be freed but will have the SEARCH_ABORTED flag set so they
 *	will be freed the next time a search operation is performed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is released to the storage allocator.
 *

    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    if (searchPtr->flags & KEEP_ON_ABORT) {
		searchPtr->flags |= SEARCH_ABORTED;
	    } else {
		ArraySearchFree(searchPtr);
	    }
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*

# 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:

        }
        set a(x) 123
    }
    list [catch {foo 1} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.11 {array command, exists option} {
    list [catch {array exists a b} msg] $msg
} {0 0}
test set-old-8.12 {array command, exists option} {
    catch {unset a}
    array exists a
} {0}
test set-old-8.13 {array command, exists option} {
    catch {unset a}
    set a(0) 1
    array exists a
} {1}
test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
            return [array exists a]
        }
        set a(x) 123
    }
    list [catch {foo 1} msg] $msg
} {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 ?mode? ?pattern?"}}
test set-old-8.16 {array command, get option} {
    list [catch {array get a b c} msg] $msg
} {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
} {}
test set-old-8.18 {array command, get option} {
    catch {unset a}
    set a(22) 3

} {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}}
test set-old-8.39 {array command, size option} {
    catch {unset a}
    array size a
} {0}
test set-old-8.40 {array command, size option} {
    list [catch {array size a 4} msg] $msg
} {0 0}
test set-old-8.41 {array command, size option} {
    catch {unset a}
    array size a
} {0}
test set-old-8.42 {array command, size option} {
    catch {unset a}
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx

            return [array size a]
        }
        set a(x) 123
    }
    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 {"a" isn't an array}}
test set-old-8.47 {array command, startsearch option} {
    catch {unset a}
    list [catch {array startsearch a} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
    catch {rename p ""}
    proc p {x} {

    trace var a(b) r {}
    set x [array startsearch a]
    lsort [list [array next a $x] [array next a $x]]
} {{} a}

test set-old-10.1 {array enumeration errors} {
    list [catch {array start} msg] $msg
} {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
} {1 {"a" isn't an array}}
test set-old-10.4 {array enumeration errors} {
    catch {unset a}
    set a(a) 1

    array exists a
} -result 0
test var-11.3 {array unset errors} -setup {
    catch {unset a}
} -returnCodes error -body {
    array set a { 1,1 a 1,2 b }
    array unset a pattern too
} -result {bad option "pattern": must be -exact, -glob, or -regexp}

test var-12.1 {TclFindCompiledLocals, {} array name} {
    namespace eval n {
	proc p {} {
	    variable {}
	    set (0) 0
	    set (1) 1

    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    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 *
test var-14.2 {array names -glob} -body {
    array names tcl_platform -glob os
} -result os