Tcl Source Code

Changes On Branch tip-508
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-508 Excluding Merge-Ins

This is equivalent to a diff from a5de190036 to f0dd67ee95

2018-09-26
23:17
Implementation of TIP 508: [array default] check-in: f2890e3bd5 user: dkf tags: core-8-branch
19:38
Improvements for zipfs. Document that TclZipfs_AppHook only works on Windows in UNICODE mode. Also, ... check-in: ca34f32cb7 user: jan.nijtmans tags: core-8-branch
13:09
Improved comment. Closed-Leaf check-in: f0dd67ee95 user: dkf tags: tip-508
13:08
Make defaults work even when [upvar]ed to just a non-existent element. check-in: 6faaafb401 user: dkf tags: tip-508
09:47
merge core-8-branch check-in: 4c46bf91dd user: dkf tags: tip-508
2018-09-25
21:18
Merge 8.7 check-in: 784c4133aa user: jan.nijtmans tags: trunk
21:18
merge 8.6 check-in: a5de190036 user: jan.nijtmans tags: core-8-branch
21:16
Contributed patch from Gustaf Neumann, preventing problems where "localCachePtr" can be NULL check-in: 4515cab12b user: jan.nijtmans tags: core-8-6-branch
2018-09-24
23:24
More fixes in Tcl_WinTChar2Utf: Don't restart loop when output contains null-byte. check-in: 050b7ee0e1 user: jan.nijtmans tags: core-8-branch

Changes to doc/append.n.

    16     16   .BE
    17     17   .SH DESCRIPTION
    18     18   .PP
    19     19   Append all of the \fIvalue\fR arguments to the current value
    20     20   of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
    21     21   it is given a value equal to the concatenation of all the
    22     22   \fIvalue\fR arguments.
           23  +.VS TIP508
           24  +If \fIvarName\fR indicate an element that does not exist of an array that has
           25  +a default value set, the concatenation of the default value and all the
           26  +\fIvalue\fR arguments will be stored in the array element.
           27  +.VE TIP508
    23     28   The result of this command is the new value stored in variable
    24     29   \fIvarName\fR.
    25     30   This command provides an efficient way to build up long
    26     31   variables incrementally.
    27     32   For example,
    28     33   .QW "\fBappend a $b\fR"
    29     34   is much more efficient than
................................................................................
    40     45   puts $var
    41     46   # Prints 0,1,2,3,4,5,6,7,8,9,10
    42     47   .CE
    43     48   .SH "SEE ALSO"
    44     49   concat(n), lappend(n)
    45     50   .SH KEYWORDS
    46     51   append, variable
    47         -'\" Local Variables:
    48         -'\" mode: nroff
    49         -'\" End:
           52  +.\" Local variables:
           53  +.\" mode: nroff
           54  +.\" fill-column: 78
           55  +.\" End:

Changes to doc/array.n.

     1      1   '\"
     2      2   '\" Copyright (c) 1993-1994 The Regents of the University of California.
     3      3   '\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
     4      4   '\"
     5      5   '\" See the file "license.terms" for information on usage and redistribution
     6      6   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     7      7   '\"
     8         -.TH array n 8.3 Tcl "Tcl Built-In Commands"
            8  +.TH array n 8.7 Tcl "Tcl Built-In Commands"
     9      9   .so man.macros
    10     10   .BS
    11     11   '\" Note:  do not modify the .SH NAME line immediately below!
    12     12   .SH NAME
    13     13   array \- Manipulate array variables
    14     14   .SH SYNOPSIS
    15     15   \fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
................................................................................
    31     31   \fISearchId\fR indicates which search on \fIarrayName\fR to
    32     32   check, and must have been the return value from a previous
    33     33   invocation of \fBarray startsearch\fR.
    34     34   This option is particularly useful if an array has an element
    35     35   with an empty name, since the return value from
    36     36   \fBarray nextelement\fR will not indicate whether the search
    37     37   has been completed.
           38  +.TP
           39  +\fBarray default \fIsubcommand arrayName args...\fR
           40  +.VS TIP508
           41  +Manages the default value of the array. Arrays initially have no default
           42  +value, but this command allows you to set one; the default value will be
           43  +returned when reading from an element of the array \farrayName\fR if the read
           44  +would otherwise result in an error. Note that this may cause the \fBappend\fR,
           45  +\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
           46  +relation to non-existing array elements.
           47  +.RS
           48  +.PP
           49  +The \fIsubcommand\fR argument controls what exact operation will be performed
           50  +on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
           51  +.VE TIP508
           52  +.TP
           53  +\fBarray default exists \fIarrayName\fR
           54  +.VS TIP508
           55  +This returns a boolean value indicating whether a default value has been set
           56  +for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
           57  +not exist. Raises an error if \fIarrayName\fR is an existing variable that is
           58  +not an array.
           59  +.VE TIP508
           60  +.TP
           61  +\fBarray default get \fIarrayName\fR
           62  +.VS TIP508
           63  +This returns the current default value for the array \fIarrayName\fR.  Raises
           64  +an error if \fIarrayName\fR is an existing variable that is not an array, or
           65  +if \fIarrayName\fR is an array without a default value.
           66  +.VE TIP508
           67  +.TP
           68  +\fBarray default set \fIarrayName value\fR
           69  +.VS TIP508
           70  +This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
           71  +Returns the empty string. Raises an error if \fIarrayName\fR is an existing
           72  +variable that is not an array, or if \fIarrayName\fR is an illegal name for an
           73  +array. If \fIarrayName\fR does not currently exist, it is created as an empty
           74  +array as well as having its default value set.
           75  +.VE TIP508
           76  +.TP
           77  +\fBarray default unset \fIarrayName\fR
           78  +.VS TIP508
           79  +This removes the default value for the array \fIarrayName\fR and returns the
           80  +empty string. Does nothing if \fIarrayName\fR does not have a default
           81  +value. Raises an error if \fIarrayName\fR is an existing variable that is not
           82  +an array.
           83  +.VE TIP508
           84  +.RE
    38     85   .TP
    39     86   \fBarray donesearch \fIarrayName searchId\fR
    40     87   This command terminates an array search and destroys all the
    41     88   state associated with that search.  \fISearchId\fR indicates
    42     89   which search on \fIarrayName\fR to destroy, and must have
    43     90   been the return value from a previous invocation of
    44     91   \fBarray startsearch\fR.  Returns an empty string.
................................................................................
   190    237       number of buckets with 10 or more entries: 0
   191    238       average search distance for entry: 1.2
   192    239   .CE
   193    240   .SH "SEE ALSO"
   194    241   list(n), string(n), variable(n), trace(n), foreach(n)
   195    242   .SH KEYWORDS
   196    243   array, element names, search
          244  +.\" Local variables:
          245  +.\" mode: nroff
          246  +.\" fill-column: 78
          247  +.\" End:

Changes to doc/dict.n.

    23     23   \fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
    24     24   .
    25     25   This appends the given string (or strings) to the value that the given
    26     26   key maps to in the dictionary value contained in the given variable,
    27     27   writing the resulting dictionary value back to that variable.
    28     28   Non-existent keys are treated as if they map to an empty string. The
    29     29   updated dictionary value is returned.
           30  +.VS TIP508
           31  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
           32  +array that has a default value set, the default value and will be used as the
           33  +value of the dictionary prior to the appending operation.
           34  +.VE TIP508
    30     35   .TP
    31     36   \fBdict create \fR?\fIkey value ...\fR?
    32     37   .
    33     38   Return a new dictionary that contains each of the key/value mappings
    34     39   listed as arguments (keys and values alternating, with each key being
    35     40   followed by its associated value.)
    36     41   .TP
................................................................................
   120    125   This adds the given increment value (an integer that defaults to 1 if
   121    126   not specified) to the value that the given key maps to in the
   122    127   dictionary value contained in the given variable, writing the
   123    128   resulting dictionary value back to that variable. Non-existent keys
   124    129   are treated as if they map to 0. It is an error to increment a value
   125    130   for an existing key if that value is not an integer. The updated
   126    131   dictionary value is returned.
          132  +.VS TIP508
          133  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          134  +array that has a default value set, the default value and will be used as the
          135  +value of the dictionary prior to the incrementing operation.
          136  +.VE TIP508
   127    137   .TP
   128    138   \fBdict info \fIdictionaryValue\fR
   129    139   .
   130    140   This returns information (intended for display to people) about the
   131    141   given dictionary though the format of this data is dependent on the
   132    142   implementation of the dictionary. For dictionaries that are
   133    143   implemented by hash tables, it is expected that this will return the
................................................................................
   145    155   This appends the given items to the list value that the given key maps
   146    156   to in the dictionary value contained in the given variable, writing
   147    157   the resulting dictionary value back to that variable. Non-existent
   148    158   keys are treated as if they map to an empty list, and it is legal for
   149    159   there to be no items to append to the list. It is an error for the
   150    160   value that the key maps to to not be representable as a list. The
   151    161   updated dictionary value is returned.
          162  +.VS TIP508
          163  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          164  +array that has a default value set, the default value and will be used as the
          165  +value of the dictionary prior to the list-appending operation.
          166  +.VE TIP508
   152    167   .TP
   153    168   \fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
   154    169   .
   155    170   This command applies a transformation to each element of a dictionary,
   156    171   returning a new dictionary. It takes three arguments: the first is a
   157    172   two-element list of variable names (for the key and value respectively of each
   158    173   mapping in the dictionary), the second the dictionary value to iterate across,
................................................................................
   202    217   \fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
   203    218   .
   204    219   This operation takes the name of a variable containing a dictionary
   205    220   value and places an updated dictionary value in that variable
   206    221   containing a mapping from the given key to the given value. When
   207    222   multiple keys are present, this operation creates or updates a chain
   208    223   of nested dictionaries. The updated dictionary value is returned.
          224  +.VS TIP508
          225  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          226  +array that has a default value set, the default value and will be used as the
          227  +value of the dictionary prior to the value insert/update operation.
          228  +.VE TIP508
   209    229   .TP
   210    230   \fBdict size \fIdictionaryValue\fR
   211    231   .
   212    232   Return the number of key/value mappings in the given dictionary value.
   213    233   .TP
   214    234   \fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
   215    235   .
................................................................................
   217    237   variable containing a dictionary value and places an updated
   218    238   dictionary value in that variable that does not contain a mapping for
   219    239   the given key. Where multiple keys are present, this describes a path
   220    240   through nested dictionaries to the mapping to remove. At least one key
   221    241   must be specified, but the last key on the key-path need not exist.
   222    242   All other components on the path must exist. The updated dictionary
   223    243   value is returned.
          244  +.VS TIP508
          245  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          246  +array that has a default value set, the default value and will be used as the
          247  +value of the dictionary prior to the value remove operation.
          248  +.VE TIP508
   224    249   .TP
   225    250   \fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
   226    251   .
   227    252   Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
   228    253   (as found by reading the dictionary value in \fIdictionaryVariable\fR)
   229    254   mapped to the variable \fIvarName\fR. There may be multiple
   230    255   \fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping,
................................................................................
   232    257   terminates, any changes made to the \fIvarName\fRs is reflected back
   233    258   to the dictionary within \fIdictionaryVariable\fR (unless
   234    259   \fIdictionaryVariable\fR itself becomes unreadable, when all updates
   235    260   are silently discarded), even if the result of \fIbody\fR is an error
   236    261   or some other kind of exceptional exit. The result of \fBdict
   237    262   update\fR is (unless some kind of error occurs) the result of the
   238    263   evaluation of \fIbody\fR.
          264  +.VS TIP508
          265  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          266  +array that has a default value set, the default value and will be used as the
          267  +value of the dictionary prior to the update operation.
          268  +.VE TIP508
   239    269   .RS
   240    270   .PP
   241    271   Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
   242    272   it is recommended that this command only be used in a local scope
   243    273   (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
   244    274   this, the variables set by \fBdict update\fR will continue to
   245    275   exist after the command finishes (unless explicitly \fBunset\fR).
................................................................................
   266    296   for the execution of \fIbody\fR. As with \fBdict update\fR, making
   267    297   \fIdictionaryVariable\fR unreadable will make the updates to the
   268    298   dictionary be discarded, and this also happens if the contents of
   269    299   \fIdictionaryVariable\fR are adjusted so that the chain of
   270    300   dictionaries no longer exists. The result of \fBdict with\fR is
   271    301   (unless some kind of error occurs) the result of the evaluation of
   272    302   \fIbody\fR.
          303  +.VS TIP508
          304  +If \fIdictionaryVarable\fR indicates an element that does not exist of an
          305  +array that has a default value set, the default value and will be used as the
          306  +value of the dictionary prior to the updating operation.
          307  +.VE TIP508
   273    308   .RS
   274    309   .PP
   275    310   The variables are mapped in the scope enclosing the \fBdict with\fR;
   276    311   it is recommended that this command only be used in a local scope
   277    312   (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
   278    313   this, the variables set by \fBdict with\fR will continue to
   279    314   exist after the command finishes (unless explicitly \fBunset\fR).

Changes to doc/incr.n.

    23     23   1 is added to \fIvarName\fR.
    24     24   The new value is stored as a decimal string in variable \fIvarName\fR
    25     25   and also returned as result.
    26     26   .PP
    27     27   Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
    28     28   to \fBincr\fR may be unset, and in that case, it will be set to
    29     29   the value \fIincrement\fR or to the default increment value of \fB1\fR.
           30  +.VS TIP508
           31  +If \fIvarName\fR indicate an element that does not exist of an array that has
           32  +a default value set, the sum of the default value and the \fIincrement\fR (or
           33  +1) will be stored in the array element.
           34  +.VE TIP508
    30     35   .SH EXAMPLES
    31     36   .PP
    32     37   Add one to the contents of the variable \fIx\fR:
    33     38   .PP
    34     39   .CS
    35     40   \fBincr\fR x
    36     41   .CE
................................................................................
    55     60   .CS
    56     61   \fBincr\fR x 0
    57     62   .CE
    58     63   .SH "SEE ALSO"
    59     64   expr(n), set(n)
    60     65   .SH KEYWORDS
    61     66   add, increment, variable, value
           67  +.\" Local variables:
           68  +.\" mode: nroff
           69  +.\" fill-column: 78
           70  +.\" End:

Changes to doc/lappend.n.

    18     18   .SH DESCRIPTION
    19     19   .PP
    20     20   This command treats the variable given by \fIvarName\fR as a list
    21     21   and appends each of the \fIvalue\fR arguments to that list as a separate
    22     22   element, with spaces between elements.
    23     23   If \fIvarName\fR does not exist, it is created as a list with elements
    24     24   given by the \fIvalue\fR arguments.
           25  +.VS TIP508
           26  +If \fIvarName\fR indicate an element that does not exist of an array that has
           27  +a default value set, list that is comprised of the default value with all the
           28  +\fIvalue\fR arguments appended as elements will be stored in the array
           29  +element.
           30  +.VE TIP508
    25     31   \fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
    26     32   are appended as list elements rather than raw text.
    27     33   This command provides a relatively efficient way to build up
    28     34   large lists.  For example,
    29     35   .QW "\fBlappend a $b\fR"
    30     36   is much more efficient than
    31     37   .QW "\fBset a [concat $a [list $b]]\fR"
................................................................................
    43     49   1 2 3 4 5
    44     50   .CE
    45     51   .SH "SEE ALSO"
    46     52   list(n), lindex(n), linsert(n), llength(n), lset(n),
    47     53   lsort(n), lrange(n)
    48     54   .SH KEYWORDS
    49     55   append, element, list, variable
           56  +.\" Local variables:
           57  +.\" mode: nroff
           58  +.\" fill-column: 78
           59  +.\" End:

Changes to generic/tclExecute.c.

  4066   4066   			"variable isn't array", opnd);
  4067   4067   		DECACHE_STACK_INFO();
  4068   4068   		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
  4069   4069   		CACHE_STACK_INFO();
  4070   4070   		TRACE_ERROR(interp);
  4071   4071   		goto gotError;
  4072   4072   	    }
  4073         -	    TclSetVarArray(varPtr);
  4074         -	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
  4075         -	    TclInitVarHashTable(varPtr->value.tablePtr,
  4076         -		    TclGetVarNsPtr(varPtr));
         4073  +	    TclInitArrayVar(varPtr);
  4077   4074   #ifdef TCL_COMPILE_DEBUG
  4078   4075   	    TRACE_APPEND(("done\n"));
  4079   4076   	} else {
  4080   4077   	    TRACE_APPEND(("nothing to do\n"));
  4081   4078   #endif
  4082   4079   	}
  4083   4080   	NEXT_INST_V(pcAdjustment, cleanup, 0);

Changes to generic/tclInt.h.

  4133   4133   
  4134   4134   MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
  4135   4135   MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
  4136   4136   MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
  4137   4137   			    int *codePtr, Tcl_Obj **msgObjPtr,
  4138   4138   			    Tcl_Obj **errorObjPtr);
  4139   4139   
         4140  +/*
         4141  + * TIP #508: [array default]
         4142  + */
         4143  +
         4144  +MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
         4145  +MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);
         4146  +
  4140   4147   /*
  4141   4148    * Utility routines for encoding index values as integers. Used by both
  4142   4149    * some of the command compilers and by [lsort] and [lsearch].
  4143   4150    */
  4144   4151   
  4145   4152   MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
  4146   4153   			    int before, int after, int *indexPtr);

Changes to generic/tclVar.c.

   160    160   				 * Tcl_NextHashEntry to get value to
   161    161   				 * return. */
   162    162       struct ArraySearch *nextPtr;/* Next in list of all active searches for
   163    163   				 * this variable, or NULL if this is the last
   164    164   				 * one. */
   165    165   } ArraySearch;
   166    166   
          167  +/*
          168  + * TIP #508: [array default]
          169  + *
          170  + * The following structure extends the regular TclVarHashTable used by array
          171  + * variables to store their optional default value.
          172  + */
          173  +
          174  +typedef struct ArrayVarHashTable {
          175  +    TclVarHashTable table;
          176  +    Tcl_Obj *defaultObj;
          177  +} ArrayVarHashTable;
          178  +
   167    179   /*
   168    180    * Forward references to functions defined later in this file:
   169    181    */
   170    182   
   171    183   static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
   172    184   			    Tcl_Obj *patternPtr, int includeLinks);
   173    185   static void		ArrayPopulateSearch(Tcl_Interp *interp,
................................................................................
   193    205   			    Tcl_Obj *myNamePtr, int myFlags, int index);
   194    206   static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
   195    207   			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
   196    208   static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
   197    209   			    Interp *iPtr, Tcl_Obj *part1Ptr,
   198    210   			    Tcl_Obj *part2Ptr, int flags, int index);
   199    211   
          212  +/*
          213  + * TIP #508: [array default]
          214  + */
          215  +
          216  +static int		ArrayDefaultCmd(ClientData clientData,
          217  +			    Tcl_Interp *interp, int objc,
          218  +			    Tcl_Obj *const objv[]);
          219  +static void		DeleteArrayVar(Var *arrayPtr);
          220  +static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);
          221  +
   200    222   /*
   201    223    * Functions defined in this file that may be exported in the future for use
   202    224    * by the bytecode compiler and engine or to the public interface.
   203    225    */
   204    226   
   205    227   MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
   206    228   			    Tcl_Obj *varNamePtr, int flags, const int create,
................................................................................
   232    254       FreeLocalVarName, DupLocalVarName, NULL, NULL
   233    255   };
   234    256   
   235    257   static const Tcl_ObjType tclParsedVarNameType = {
   236    258       "parsedVarName",
   237    259       FreeParsedVarName, DupParsedVarName, NULL, NULL
   238    260   };
   239         -
   240    261   
   241    262   Var *
   242    263   TclVarHashCreateVar(
   243    264       TclVarHashTable *tablePtr,
   244    265       const char *key,
   245    266       int *newPtr)
   246    267   {
................................................................................
  1015   1036   				 * element, if it doesn't already exist. If 0,
  1016   1037   				 * return error if it doesn't exist. */
  1017   1038       Var *arrayPtr,		/* Pointer to the array's Var structure. */
  1018   1039       int index)			/* If >=0, the index of the local array. */
  1019   1040   {
  1020   1041       int isNew;
  1021   1042       Var *varPtr;
  1022         -    TclVarHashTable *tablePtr;
  1023         -    Namespace *nsPtr;
  1024   1043   
  1025   1044       /*
  1026   1045        * We're dealing with an array element. Make sure the variable is an array
  1027   1046        * and look up the element (create the element if desired).
  1028   1047        */
  1029   1048   
  1030   1049       if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
................................................................................
  1049   1068   			danglingVar, index);
  1050   1069   		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
  1051   1070   			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
  1052   1071   	    }
  1053   1072   	    return NULL;
  1054   1073   	}
  1055   1074   
  1056         -	TclSetVarArray(arrayPtr);
  1057         -	tablePtr = ckalloc(sizeof(TclVarHashTable));
  1058         -	arrayPtr->value.tablePtr = tablePtr;
  1059         -
  1060         -	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
  1061         -	    nsPtr = TclGetVarNsPtr(arrayPtr);
  1062         -	} else {
  1063         -	    nsPtr = NULL;
  1064         -	}
  1065         -	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
         1075  +	TclInitArrayVar(arrayPtr);
  1066   1076       } else if (!TclIsVarArray(arrayPtr)) {
  1067   1077   	if (flags & TCL_LEAVE_ERR_MSG) {
  1068   1078   	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
  1069   1079   		    index);
  1070   1080   	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
  1071   1081   		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
  1072   1082   	}
................................................................................
  1407   1417       /*
  1408   1418        * Return the element if it's an existing scalar variable.
  1409   1419        */
  1410   1420   
  1411   1421       if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
  1412   1422   	return varPtr->value.objPtr;
  1413   1423       }
         1424  +
         1425  +    /*
         1426  +     * Return the array default value if any.
         1427  +     */
         1428  +
         1429  +    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
         1430  +	return TclGetArrayDefault(arrayPtr);
         1431  +    }
         1432  +    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
         1433  +	/*
         1434  +	 * UGLY! Peek inside the implementation of things. This lets us get
         1435  +	 * the default of an array even when we've been [upvar]ed to just an
         1436  +	 * element of the array.
         1437  +	 */
         1438  +
         1439  +	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
         1440  +		((VarInHash *) varPtr)->entry.tablePtr;
         1441  +
         1442  +	if (avhtPtr->defaultObj) {
         1443  +	    return avhtPtr->defaultObj;
         1444  +	}
         1445  +    }
  1414   1446   
  1415   1447       if (flags & TCL_LEAVE_ERR_MSG) {
  1416   1448   	if (TclIsVarUndefined(varPtr) && arrayPtr
  1417   1449   		&& !TclIsVarUndefined(arrayPtr)) {
  1418   1450   	    msg = noSuchElement;
  1419   1451   	} else if (TclIsVarArray(varPtr)) {
  1420   1452   	    msg = isArray;
................................................................................
  1768   1800       return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
  1769   1801   	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
  1770   1802   }
  1771   1803   
  1772   1804   /*
  1773   1805    *----------------------------------------------------------------------
  1774   1806    *
         1807  + * ListAppendInVar, StringAppendInVar --
         1808  + *
         1809  + *	Support functions for TclPtrSetVarIdx that implement various types of
         1810  + *	appending operations.
         1811  + *
         1812  + * Results:
         1813  + *	ListAppendInVar returns a Tcl result code (from the core list append
         1814  + *	operation). StringAppendInVar has no return value.
         1815  + *
         1816  + * Side effects:
         1817  + *	The variable or element of the array is updated. This may make the
         1818  + *	variable/element exist. Reference counts of values may be updated.
         1819  + *
         1820  + *----------------------------------------------------------------------
         1821  + */
         1822  +
         1823  +static inline int
         1824  +ListAppendInVar(
         1825  +    Tcl_Interp *interp,
         1826  +    Var *varPtr,
         1827  +    Var *arrayPtr,
         1828  +    Tcl_Obj *oldValuePtr,
         1829  +    Tcl_Obj *newValuePtr)
         1830  +{
         1831  +    if (oldValuePtr == NULL) {
         1832  +	/*
         1833  +	 * No previous value. Check for defaults if there's an array we can
         1834  +	 * ask this of.
         1835  +	 */
         1836  +
         1837  +	if (arrayPtr) {
         1838  +	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
         1839  +
         1840  +	    if (defValuePtr) {
         1841  +		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
         1842  +	    }
         1843  +	}
         1844  +
         1845  +	if (oldValuePtr == NULL) {
         1846  +	    /*
         1847  +	     * No default. [lappend] semantics say this is like being an empty
         1848  +	     * string.
         1849  +	     */
         1850  +
         1851  +	    TclNewObj(oldValuePtr);
         1852  +	}
         1853  +	varPtr->value.objPtr = oldValuePtr;
         1854  +	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
         1855  +    } else if (Tcl_IsShared(oldValuePtr)) {
         1856  +	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
         1857  +	TclDecrRefCount(oldValuePtr);
         1858  +	oldValuePtr = varPtr->value.objPtr;
         1859  +	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
         1860  +    }
         1861  +
         1862  +    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
         1863  +}
         1864  +
         1865  +static inline void
         1866  +StringAppendInVar(
         1867  +    Var *varPtr,
         1868  +    Var *arrayPtr,
         1869  +    Tcl_Obj *oldValuePtr,
         1870  +    Tcl_Obj *newValuePtr)
         1871  +{
         1872  +    /*
         1873  +     * If there was no previous value, either we use the array's default (if
         1874  +     * this is an array with a default at all) or we treat this as a simple
         1875  +     * set.
         1876  +     */
         1877  +
         1878  +    if (oldValuePtr == NULL) {
         1879  +	if (arrayPtr) {
         1880  +	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
         1881  +
         1882  +	    if (defValuePtr) {
         1883  +		/*
         1884  +		 * This is *almost* the same as the shared path below, except
         1885  +		 * that the original value reference in defValuePtr is not
         1886  +		 * decremented.
         1887  +		 */
         1888  +
         1889  +		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);
         1890  +
         1891  +		varPtr->value.objPtr = valuePtr;
         1892  +		TclContinuationsCopy(valuePtr, defValuePtr);
         1893  +		Tcl_IncrRefCount(valuePtr);
         1894  +		Tcl_AppendObjToObj(valuePtr, newValuePtr);
         1895  +		if (newValuePtr->refCount == 0) {
         1896  +		    Tcl_DecrRefCount(newValuePtr);
         1897  +		}
         1898  +		return;
         1899  +	    }
         1900  +	}
         1901  +	varPtr->value.objPtr = newValuePtr;
         1902  +	Tcl_IncrRefCount(newValuePtr);
         1903  +	return;
         1904  +    }
         1905  +
         1906  +    /*
         1907  +     * We append newValuePtr's bytes but don't change its ref count. Unless
         1908  +     * the reference is shared, when we have to duplicate in order to be safe
         1909  +     * to modify at all.
         1910  +     */
         1911  +
         1912  +    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
         1913  +	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
         1914  +
         1915  +	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
         1916  +
         1917  +	TclDecrRefCount(oldValuePtr);
         1918  +	oldValuePtr = varPtr->value.objPtr;
         1919  +	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
         1920  +    }
         1921  +
         1922  +    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
         1923  +    if (newValuePtr->refCount == 0) {
         1924  +	Tcl_DecrRefCount(newValuePtr);
         1925  +    }
         1926  +}
         1927  +
         1928  +/*
         1929  + *----------------------------------------------------------------------
         1930  + *
  1775   1931    * TclPtrSetVarIdx --
  1776   1932    *
  1777   1933    *	This function is the same as Tcl_SetVar2Ex above, except that it
  1778   1934    *	requires pointers to the variable's Var structs in addition to the
  1779   1935    *	variable names.
  1780   1936    *
  1781   1937    * Results:
................................................................................
  1880   2036   
  1881   2037       oldValuePtr = varPtr->value.objPtr;
  1882   2038       if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
  1883   2039   	varPtr->value.objPtr = NULL;
  1884   2040       }
  1885   2041       if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
  1886   2042   	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
  1887         -	    if (oldValuePtr == NULL) {
  1888         -		TclNewObj(oldValuePtr);
  1889         -		varPtr->value.objPtr = oldValuePtr;
  1890         -		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
  1891         -	    } else if (Tcl_IsShared(oldValuePtr)) {
  1892         -		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
  1893         -		TclDecrRefCount(oldValuePtr);
  1894         -		oldValuePtr = varPtr->value.objPtr;
  1895         -		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
  1896         -	    }
  1897         -	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
         2043  +	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
  1898   2044   		    newValuePtr);
  1899   2045   	    if (result != TCL_OK) {
  1900   2046   		goto earlyError;
  1901   2047   	    }
  1902   2048   	} else {				/* Append string. */
  1903         -	    /*
  1904         -	     * We append newValuePtr's bytes but don't change its ref count.
  1905         -	     */
  1906         -
  1907         -	    if (oldValuePtr == NULL) {
  1908         -		varPtr->value.objPtr = newValuePtr;
  1909         -		Tcl_IncrRefCount(newValuePtr);
  1910         -	    } else {
  1911         -		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
  1912         -		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
  1913         -
  1914         -		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
  1915         -
  1916         -		    TclDecrRefCount(oldValuePtr);
  1917         -		    oldValuePtr = varPtr->value.objPtr;
  1918         -		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
  1919         -		}
  1920         -		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
  1921         -		if (newValuePtr->refCount == 0) {
  1922         -		    Tcl_DecrRefCount(newValuePtr);
  1923         -		}
  1924         -	    }
         2049  +	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
  1925   2050   	}
  1926   2051       } else if (newValuePtr != oldValuePtr) {
  1927   2052   	/*
  1928   2053   	 * In this case we are replacing the value, so we don't need to do
  1929   2054   	 * more than swap the objects.
  1930   2055   	 */
  1931   2056   
................................................................................
  4074   4199   
  4075   4200   	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
  4076   4201   		    needArray, -1);
  4077   4202   	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
  4078   4203   	    return TCL_ERROR;
  4079   4204   	}
  4080   4205       }
  4081         -    TclSetVarArray(varPtr);
  4082         -    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
  4083         -    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
         4206  +    TclInitArrayVar(varPtr);
  4084   4207       return TCL_OK;
  4085   4208   }
  4086   4209   
  4087   4210   /*
  4088   4211    *----------------------------------------------------------------------
  4089   4212    *
  4090   4213    * ArraySizeCmd --
................................................................................
  4356   4479   	/* ARGSUSED */
  4357   4480   Tcl_Command
  4358   4481   TclInitArrayCmd(
  4359   4482       Tcl_Interp *interp)		/* Current interpreter. */
  4360   4483   {
  4361   4484       static const EnsembleImplMap arrayImplMap[] = {
  4362   4485   	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
         4486  +	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
  4363   4487   	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
  4364   4488   	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
  4365   4489   	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
  4366   4490   	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
  4367   4491   	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
  4368   4492   	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
  4369   4493   	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
................................................................................
  5546   5670   	 * variables, some combinations of [upvar] and [variable] may create
  5547   5671   	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
  5548   5672   	 * the corresponding Var struct, and is otherwise harmless.
  5549   5673   	 */
  5550   5674   
  5551   5675   	TclClearVarNamespaceVar(elPtr);
  5552   5676       }
  5553         -    VarHashDeleteTable(varPtr->value.tablePtr);
  5554         -    ckfree(varPtr->value.tablePtr);
         5677  +    DeleteArrayVar(varPtr);
  5555   5678   }
  5556   5679   
  5557   5680   /*
  5558   5681    *----------------------------------------------------------------------
  5559   5682    *
  5560   5683    * TclObjVarErrMsg --
  5561   5684    *
................................................................................
  6462   6585   
  6463   6586       /*
  6464   6587        * Only compare string representations of the same length.
  6465   6588        */
  6466   6589   
  6467   6590       return ((l1 == l2) && !memcmp(p1, p2, l1));
  6468   6591   }
         6592  +
         6593  +/*----------------------------------------------------------------------
         6594  + *
         6595  + * ArrayDefaultCmd --
         6596  + *
         6597  + *	This function implements the 'array default' Tcl command.
         6598  + *	Refer to the user documentation for details on what it does.
         6599  + *
         6600  + * Results:
         6601  + *	Returns a standard Tcl result.
         6602  + *
         6603  + * Side effects:
         6604  + *	See the user documentation.
         6605  + *
         6606  + *----------------------------------------------------------------------
         6607  + */
         6608  +
         6609  +	/* ARGSUSED */
         6610  +static int
         6611  +ArrayDefaultCmd(
         6612  +    ClientData clientData,	/* Not used. */
         6613  +    Tcl_Interp *interp,		/* Current interpreter. */
         6614  +    int objc,			/* Number of arguments. */
         6615  +    Tcl_Obj *const objv[])	/* Argument objects. */
         6616  +{
         6617  +    static const char *const options[] = {
         6618  +	"get", "set", "exists", "unset", NULL
         6619  +    };
         6620  +    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
         6621  +    Tcl_Obj *arrayNameObj, *defaultValueObj;
         6622  +    Var *varPtr, *arrayPtr;
         6623  +    int isArray, option;
         6624  +
         6625  +    /*
         6626  +     * Parse arguments.
         6627  +     */
         6628  +
         6629  +    if (objc != 3 && objc != 4) {
         6630  +	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
         6631  +	return TCL_ERROR;
         6632  +    }
         6633  +    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
         6634  +	    0, &option) != TCL_OK) {
         6635  +	return TCL_ERROR;
         6636  +    }
         6637  +
         6638  +    arrayNameObj = objv[2];
         6639  +
         6640  +    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
         6641  +	return TCL_ERROR;
         6642  +    }
         6643  +
         6644  +    switch (option) {
         6645  +    case OPT_GET:
         6646  +	if (objc != 3) {
         6647  +	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
         6648  +	    return TCL_ERROR;
         6649  +	}
         6650  +	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
         6651  +	    return NotArrayError(interp, arrayNameObj);
         6652  +	}
         6653  +
         6654  +	defaultValueObj = TclGetArrayDefault(varPtr);
         6655  +	if (!defaultValueObj) {
         6656  +	    /* Array default must exist. */
         6657  +	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
         6658  +		    "array has no default value", -1));
         6659  +	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
         6660  +	    return TCL_ERROR;
         6661  +	}
         6662  +	Tcl_SetObjResult(interp, defaultValueObj);
         6663  +	return TCL_OK;
         6664  +
         6665  +    case OPT_SET:
         6666  +	if (objc != 4) {
         6667  +	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
         6668  +	    return TCL_ERROR;
         6669  +	}
         6670  +
         6671  +	/*
         6672  +	 * Attempt to create array if needed.
         6673  +	 */
         6674  +	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
         6675  +		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
         6676  +		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
         6677  +	if (varPtr == NULL) {
         6678  +	    return TCL_ERROR;
         6679  +	}
         6680  +	if (arrayPtr) {
         6681  +	    /*
         6682  +	     * Not a valid array name.
         6683  +	     */
         6684  +
         6685  +	    CleanupVar(varPtr, arrayPtr);
         6686  +	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
         6687  +		    needArray, -1);
         6688  +	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
         6689  +		    TclGetString(arrayNameObj), NULL);
         6690  +	    return TCL_ERROR;
         6691  +	}
         6692  +	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
         6693  +	    /*
         6694  +	     * Not an array.
         6695  +	     */
         6696  +
         6697  +	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
         6698  +		    needArray, -1);
         6699  +	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
         6700  +	    return TCL_ERROR;
         6701  +	}
         6702  +
         6703  +	if (!TclIsVarArray(varPtr)) {
         6704  +	    TclInitArrayVar(varPtr);
         6705  +	}
         6706  +	defaultValueObj = objv[3];
         6707  +	SetArrayDefault(varPtr, defaultValueObj);
         6708  +	return TCL_OK;
         6709  +
         6710  +    case OPT_EXISTS:
         6711  +	if (objc != 3) {
         6712  +	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
         6713  +	    return TCL_ERROR;
         6714  +	}
         6715  +
         6716  +	/*
         6717  +	 * Undefined variables (whether or not they have storage allocated) do
         6718  +	 * not have defaults, and this is not an error case.
         6719  +	 */
         6720  +
         6721  +	if (!varPtr || TclIsVarUndefined(varPtr)) {
         6722  +	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
         6723  +	} else if (!isArray) {
         6724  +	    return NotArrayError(interp, arrayNameObj);
         6725  +	} else {
         6726  +	    defaultValueObj = TclGetArrayDefault(varPtr);
         6727  +	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
         6728  +	}
         6729  +	return TCL_OK;
         6730  +
         6731  +    case OPT_UNSET:
         6732  +	if (objc != 3) {
         6733  +	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
         6734  +	    return TCL_ERROR;
         6735  +	}
         6736  +
         6737  +	if (varPtr && !TclIsVarUndefined(varPtr)) {
         6738  +	    if (!isArray) {
         6739  +		return NotArrayError(interp, arrayNameObj);
         6740  +	    }
         6741  +	    SetArrayDefault(varPtr, NULL);
         6742  +	}
         6743  +	return TCL_OK;
         6744  +    }
         6745  +
         6746  +    /* Unreached */
         6747  +    return TCL_ERROR;
         6748  +}
         6749  +
         6750  +/*
         6751  + * Initialize array variable.
         6752  + */
         6753  +
         6754  +void
         6755  +TclInitArrayVar(
         6756  +    Var *arrayPtr)
         6757  +{
         6758  +    ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));
         6759  +
         6760  +    /*
         6761  +     * Mark the variable as an array.
         6762  +     */
         6763  +
         6764  +    TclSetVarArray(arrayPtr);
         6765  +
         6766  +    /*
         6767  +     * Regular TclVarHashTable initialization.
         6768  +     */
         6769  +
         6770  +    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
         6771  +    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));
         6772  +
         6773  +    /*
         6774  +     * Default value initialization.
         6775  +     */
         6776  +
         6777  +    tablePtr->defaultObj = NULL;
         6778  +}
         6779  +
         6780  +/*
         6781  + * Cleanup array variable.
         6782  + */
         6783  +
         6784  +static void
         6785  +DeleteArrayVar(
         6786  +    Var *arrayPtr)
         6787  +{
         6788  +    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
         6789  +	    arrayPtr->value.tablePtr;
         6790  +
         6791  +    /*
         6792  +     * Default value cleanup.
         6793  +     */
         6794  +
         6795  +    SetArrayDefault(arrayPtr, NULL);
         6796  +
         6797  +    /*
         6798  +     * Regular TclVarHashTable cleanup.
         6799  +     */
         6800  +
         6801  +    VarHashDeleteTable(arrayPtr->value.tablePtr);
         6802  +    ckfree(tablePtr);
         6803  +}
         6804  +
         6805  +/*
         6806  + * Get array default value if any.
         6807  + */
         6808  +
         6809  +Tcl_Obj *
         6810  +TclGetArrayDefault(
         6811  +    Var *arrayPtr)
         6812  +{
         6813  +    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
         6814  +	    arrayPtr->value.tablePtr;
         6815  +
         6816  +    return tablePtr->defaultObj;
         6817  +}
         6818  +
         6819  +/*
         6820  + * Set/replace/unset array default value.
         6821  + */
         6822  +
         6823  +static void
         6824  +SetArrayDefault(
         6825  +    Var *arrayPtr,
         6826  +    Tcl_Obj *defaultObj)
         6827  +{
         6828  +    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
         6829  +	    arrayPtr->value.tablePtr;
         6830  +
         6831  +    /*
         6832  +     * Increment/decrement refcount twice to ensure that the object is shared,
         6833  +     * so that it doesn't get modified accidentally by the folling code:
         6834  +     *
         6835  +     *      array default set v 1
         6836  +     *      lappend v(a) 2; # returns a new object {1 2}
         6837  +     *      set v(b); # returns the original default object "1"
         6838  +     */
         6839  +
         6840  +    if (tablePtr->defaultObj) {
         6841  +        Tcl_DecrRefCount(tablePtr->defaultObj);
         6842  +        Tcl_DecrRefCount(tablePtr->defaultObj);
         6843  +    }
         6844  +    tablePtr->defaultObj = defaultObj;
         6845  +    if (tablePtr->defaultObj) {
         6846  +        Tcl_IncrRefCount(tablePtr->defaultObj);
         6847  +        Tcl_IncrRefCount(tablePtr->defaultObj);
         6848  +    }
         6849  +}
  6469   6850   
  6470   6851   /*
  6471   6852    * Local Variables:
  6472   6853    * mode: c
  6473   6854    * c-basic-offset: 4
  6474   6855    * fill-column: 78
  6475   6856    * End:
  6476   6857    */

Changes to tests/set-old.test.

   336    336       }
   337    337       foo
   338    338   } {1 {"x" isn't an array}}
   339    339   test set-old-8.6 {array command} {
   340    340       catch {unset a}
   341    341       set a(22) 3
   342    342       list [catch {array gorp a} msg] $msg
   343         -} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
          343  +} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
   344    344   test set-old-8.7 {array command, anymore option} {
   345    345       catch {unset a}
   346    346       list [catch {array anymore a x} msg] $msg
   347    347   } {1 {"a" isn't an array}}
   348    348   test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
   349    349       proc foo {x} {
   350    350           if {$x==1} {
................................................................................
   696    696       }}} msg] $msg
   697    697   } {1 {list must have an even number of elements}}
   698    698   
   699    699   test set-old-9.1 {ids for array enumeration} {
   700    700       catch {unset a}
   701    701       set a(a) 1
   702    702       list [array star a] [array star a] [array done a s-1-a; array star a] \
   703         -	    [array done a s-2-a; array d a s-3-a; array start a]
          703  +	    [array done a s-2-a; array do a s-3-a; array start a]
   704    704   } {s-1-a s-2-a s-3-a s-1-a}
   705    705   test set-old-9.2 {array enumeration} {
   706    706       catch {unset a}
   707    707       set a(a) 1
   708    708       set a(b) 1
   709    709       set a(c) 1
   710    710       set x [array startsearch a]

Changes to tests/var.test.

  1042   1042   } -result 0
  1043   1043   test var-22.2 {leak in parsedVarName} -constraints memory -body {
  1044   1044       set i 0
  1045   1045       leaktest {lappend x($i)}
  1046   1046   } -cleanup {
  1047   1047       unset -nocomplain i x
  1048   1048   } -result 0
  1049         -
         1049  +
  1050   1050   unset -nocomplain a k v
  1051   1051   test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
  1052   1052       array for {k v} c d e {}
  1053   1053   } -result {wrong # args: should be "array for {key value} arrayName script"}
  1054   1054   test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
  1055   1055       array for {k v} {}
  1056   1056   } -result {wrong # args: should be "array for {key value} arrayName script"}
................................................................................
  1198   1198       unset -nocomplain $vn
  1199   1199   } -body {
  1200   1200       array set $vn {a 1 b 2 c 3}
  1201   1201       array for $vn $vn {}
  1202   1202   } -cleanup {
  1203   1203       unset -nocomplain $vn vn
  1204   1204   } -result {}
         1205  +
         1206  +test var-24.1 {array default set and get: interpreted} -setup {
         1207  +    unset -nocomplain ary
         1208  +} -body {
         1209  +    array set ary {a 3}
         1210  +    array default set ary 7
         1211  +    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
         1212  +	[array default get ary]
         1213  +} -cleanup {
         1214  +    unset -nocomplain ary
         1215  +} -result {3 7 1 0 7}
         1216  +test var-24.2 {array default set and get: compiled} {
         1217  +    apply {{} {
         1218  +	array set ary {a 3}
         1219  +	array default set ary 7
         1220  +	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
         1221  +	    [array default get ary]
         1222  +    }}
         1223  +} {3 7 1 0 7}
         1224  +test var-24.3 {array default unset: interpreted} -setup {
         1225  +    unset -nocomplain ary
         1226  +} -body {
         1227  +    array set ary {a 3}
         1228  +    array default set ary 7
         1229  +    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
         1230  +} -cleanup {
         1231  +    unset -nocomplain ary
         1232  +} -result {3 7 {} 3 1}
         1233  +test var-24.4 {array default unset: compiled} {
         1234  +    apply {{} {
         1235  +	array set ary {a 3}
         1236  +	array default set ary 7
         1237  +	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
         1238  +	    [catch {set ary(b)}]
         1239  +    }}
         1240  +} {3 7 {} 3 1}
         1241  +test var-24.5 {array default exists: interpreted} -setup {
         1242  +    unset -nocomplain ary result
         1243  +    set result {}
         1244  +} -body {
         1245  +    array set ary {a 3}
         1246  +    lappend result [info exists ary],[array exists ary],[array default exists ary]
         1247  +    array default set ary 7
         1248  +    lappend result [info exists ary],[array exists ary],[array default exists ary]
         1249  +    array default unset ary
         1250  +    lappend result [info exists ary],[array exists ary],[array default exists ary]
         1251  +    unset ary
         1252  +    lappend result [info exists ary],[array exists ary],[array default exists ary]
         1253  +    array default set ary 11
         1254  +    lappend result [info exists ary],[array exists ary],[array default exists ary]
         1255  +} -cleanup {
         1256  +    unset -nocomplain ary result
         1257  +} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
         1258  +test var-24.6 {array default exists: compiled} {
         1259  +    apply {{} {
         1260  +	array set ary {a 3}
         1261  +	lappend result [info exists ary],[array exists ary],[array default exists ary]
         1262  +	array default set ary 7
         1263  +	lappend result [info exists ary],[array exists ary],[array default exists ary]
         1264  +	array default unset ary
         1265  +	lappend result [info exists ary],[array exists ary],[array default exists ary]
         1266  +	unset ary
         1267  +	lappend result [info exists ary],[array exists ary],[array default exists ary]
         1268  +	array default set ary 11
         1269  +	lappend result [info exists ary],[array exists ary],[array default exists ary]
         1270  +    }}
         1271  +} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
         1272  +test var-24.7 {array default and append: interpreted} -setup {
         1273  +    unset -nocomplain ary result
         1274  +    set result {}
         1275  +} -body {
         1276  +    array default set ary grill
         1277  +    lappend result [array size ary] [info exist ary(x)]
         1278  +    append ary(x) abc
         1279  +    lappend result [array size ary] $ary(x)
         1280  +    array default unset ary
         1281  +    append ary(x) def
         1282  +    append ary(y) ghi
         1283  +    lappend result [array size ary] $ary(x) $ary(y)
         1284  +} -cleanup {
         1285  +    unset -nocomplain ary result
         1286  +} -result {0 0 1 grillabc 2 grillabcdef ghi}
         1287  +test var-24.8 {array default and append: compiled} {
         1288  +    apply {{} {
         1289  +	array default set ary grill
         1290  +	lappend result [array size ary] [info exist ary(x)]
         1291  +	append ary(x) abc
         1292  +	lappend result [array size ary] $ary(x)
         1293  +	array default unset ary
         1294  +	append ary(x) def
         1295  +	append ary(y) ghi
         1296  +	lappend result [array size ary] $ary(x) $ary(y)
         1297  +    }}
         1298  +} {0 0 1 grillabc 2 grillabcdef ghi}
         1299  +test var-24.9 {array default and lappend: interpreted} -setup {
         1300  +    unset -nocomplain ary result
         1301  +    set result {}
         1302  +} -body {
         1303  +    array default set ary grill
         1304  +    lappend result [array size ary] [info exist ary(x)]
         1305  +    lappend ary(x) abc
         1306  +    lappend result [array size ary] $ary(x)
         1307  +    array default unset ary
         1308  +    lappend ary(x) def
         1309  +    lappend ary(y) ghi
         1310  +    lappend result [array size ary] $ary(x) $ary(y)
         1311  +} -cleanup {
         1312  +    unset -nocomplain ary result
         1313  +} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
         1314  +test var-24.10 {array default and lappend: compiled} {
         1315  +    apply {{} {
         1316  +	array default set ary grill
         1317  +	lappend result [array size ary] [info exist ary(x)]
         1318  +	lappend ary(x) abc
         1319  +	lappend result [array size ary] $ary(x)
         1320  +	array default unset ary
         1321  +	lappend ary(x) def
         1322  +	lappend ary(y) ghi
         1323  +	lappend result [array size ary] $ary(x) $ary(y)
         1324  +    }}
         1325  +} {0 0 1 {grill abc} 2 {grill abc def} ghi}
         1326  +test var-24.11 {array default and incr: interpreted} -setup {
         1327  +    unset -nocomplain ary result
         1328  +    set result {}
         1329  +} -body {
         1330  +    array default set ary 7
         1331  +    lappend result [array size ary] [info exist ary(x)]
         1332  +    incr ary(x) 11
         1333  +    lappend result [array size ary] $ary(x)
         1334  +    array default unset ary
         1335  +    incr ary(x)
         1336  +    incr ary(y)
         1337  +    lappend result [array size ary] $ary(x) $ary(y)
         1338  +} -cleanup {
         1339  +    unset -nocomplain ary result
         1340  +} -result {0 0 1 18 2 19 1}
         1341  +test var-24.12 {array default and incr: compiled} {
         1342  +    apply {{} {
         1343  +	array default set ary 7
         1344  +	lappend result [array size ary] [info exist ary(x)]
         1345  +	incr ary(x) 11
         1346  +	lappend result [array size ary] $ary(x)
         1347  +	array default unset ary
         1348  +	incr ary(x)
         1349  +	incr ary(y)
         1350  +	lappend result [array size ary] $ary(x) $ary(y)
         1351  +    }}
         1352  +} {0 0 1 18 2 19 1}
         1353  +test var-24.13 {array default and dict: interpreted} -setup {
         1354  +    unset -nocomplain ary x y z
         1355  +} -body {
         1356  +    array default set ary {x y}
         1357  +    dict lappend ary(p) x z
         1358  +    dict update ary(q) x y {
         1359  +	set y z
         1360  +    }
         1361  +    dict with ary(r) {
         1362  +	set x 123
         1363  +    }
         1364  +    lsort -stride 2 -index 0 [array get ary]
         1365  +} -cleanup {
         1366  +    unset -nocomplain ary x y z
         1367  +} -result {p {x {y z}} q {x z} r {x 123}}
         1368  +test var-24.14 {array default and dict: compiled} {
         1369  +    lsort -stride 2 -index 0 [apply {{} {
         1370  +	array default set ary {x y}
         1371  +	dict lappend ary(p) x z
         1372  +	dict update ary(q) x y {
         1373  +	    set y z
         1374  +	}
         1375  +	dict with ary(r) {
         1376  +	    set x 123
         1377  +	}
         1378  +	array get ary
         1379  +    }}]
         1380  +} {p {x {y z}} q {x z} r {x 123}}
         1381  +test var-24.15 {array default set and get: two-level} {
         1382  +    apply {{} {
         1383  +	array set ary {a 3}
         1384  +	array default set ary 7
         1385  +	apply {{} {
         1386  +	    upvar 1 ary ary ary(c) c
         1387  +	    lappend result $ary(a) $ary(b) $c
         1388  +	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
         1389  +	    lappend result [array default get ary]
         1390  +	}}
         1391  +    }}
         1392  +} {3 7 7 1 0 0 7}
         1393  +test var-24.16 {array default set: errors} -setup {
         1394  +    unset -nocomplain ary
         1395  +} -body {
         1396  +    set ary not-an-array
         1397  +    array default set ary 7
         1398  +} -returnCodes error -cleanup {
         1399  +    unset -nocomplain ary
         1400  +} -result {can't array default set "ary": variable isn't array}
         1401  +test var-24.17 {array default set: errors} -setup {
         1402  +    unset -nocomplain ary
         1403  +} -body {
         1404  +    array default set ary
         1405  +} -returnCodes error -cleanup {
         1406  +    unset -nocomplain ary
         1407  +} -result * -match glob
         1408  +test var-24.18 {array default set: errors} -setup {
         1409  +    unset -nocomplain ary
         1410  +} -body {
         1411  +    array default set ary x y
         1412  +} -returnCodes error -cleanup {
         1413  +    unset -nocomplain ary
         1414  +} -result * -match glob
         1415  +test var-24.19 {array default get: errors} -setup {
         1416  +    unset -nocomplain ary
         1417  +} -body {
         1418  +    set ary not-an-array
         1419  +    array default get ary
         1420  +} -returnCodes error -cleanup {
         1421  +    unset -nocomplain ary
         1422  +} -result {"ary" isn't an array}
         1423  +test var-24.20 {array default get: errors} -setup {
         1424  +    unset -nocomplain ary
         1425  +} -body {
         1426  +    array default get ary x y
         1427  +} -returnCodes error -cleanup {
         1428  +    unset -nocomplain ary
         1429  +} -result * -match glob
         1430  +test var-24.21 {array default exists: errors} -setup {
         1431  +    unset -nocomplain ary
         1432  +} -body {
         1433  +    set ary not-an-array
         1434  +    array default exists ary
         1435  +} -returnCodes error -cleanup {
         1436  +    unset -nocomplain ary
         1437  +} -result {"ary" isn't an array}
         1438  +test var-24.22 {array default exists: errors} -setup {
         1439  +    unset -nocomplain ary
         1440  +} -body {
         1441  +    array default exists ary x
         1442  +} -returnCodes error -cleanup {
         1443  +    unset -nocomplain ary
         1444  +} -result * -match glob
         1445  +test var-24.23 {array default unset: errors} -setup {
         1446  +    unset -nocomplain ary
         1447  +} -body {
         1448  +    set ary not-an-array
         1449  +    array default unset ary
         1450  +} -returnCodes error -cleanup {
         1451  +    unset -nocomplain ary
         1452  +} -result {"ary" isn't an array}
         1453  +test var-24.24 {array default unset: errors} -setup {
         1454  +    unset -nocomplain ary
         1455  +} -body {
         1456  +    array default unset ary x
         1457  +} -returnCodes error -cleanup {
         1458  +    unset -nocomplain ary
         1459  +} -result * -match glob
  1205   1460   
  1206   1461   catch {namespace delete ns}
  1207   1462   catch {unset arr}
  1208   1463   catch {unset v}
  1209   1464   
  1210   1465   catch {rename getbytes ""}
  1211   1466   catch {rename p ""}