Implementation of TIP 508: [array default]

10 files changed, 813 insertions, 62 deletions

diff --git a/doc/append.n b/doc/append.n
index e3bf224..99b4ece 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -20,6 +20,11 @@ Append all of the \fIvalue\fR arguments to the current value
 of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
 it is given a value equal to the concatenation of all the
 \fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the concatenation of the default value and all the
+\fIvalue\fR arguments will be stored in the array element.
+.VE TIP508
 The result of this command is the new value stored in variable
 \fIvarName\fR.
 This command provides an efficient way to build up long
@@ -44,6 +49,7 @@ puts $var
 concat(n), lappend(n)
 .SH KEYWORDS
 append, variable
-'\" Local Variables:
-'\" mode: nroff
-'\" End:
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/array.n b/doc/array.n
index d6d4dff..bbfcd9f 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-.TH array n 8.3 Tcl "Tcl Built-In Commands"
+.TH array n 8.7 Tcl "Tcl Built-In Commands"
 .so man.macros
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
@@ -36,6 +36,53 @@ with an empty name, since the return value from
 \fBarray nextelement\fR will not indicate whether the search
 has been completed.
 .TP
+\fBarray default \fIsubcommand arrayName args...\fR
+.VS TIP508
+Manages the default value of the array. Arrays initially have no default
+value, but this command allows you to set one; the default value will be
+returned when reading from an element of the array \farrayName\fR if the read
+would otherwise result in an error. Note that this may cause the \fBappend\fR,
+\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
+relation to non-existing array elements.
+.RS
+.PP
+The \fIsubcommand\fR argument controls what exact operation will be performed
+on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
+.VE TIP508
+.TP
+\fBarray default exists \fIarrayName\fR
+.VS TIP508
+This returns a boolean value indicating whether a default value has been set
+for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
+not exist. Raises an error if \fIarrayName\fR is an existing variable that is
+not an array.
+.VE TIP508
+.TP
+\fBarray default get \fIarrayName\fR
+.VS TIP508
+This returns the current default value for the array \fIarrayName\fR.  Raises
+an error if \fIarrayName\fR is an existing variable that is not an array, or
+if \fIarrayName\fR is an array without a default value.
+.VE TIP508
+.TP
+\fBarray default set \fIarrayName value\fR
+.VS TIP508
+This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
+Returns the empty string. Raises an error if \fIarrayName\fR is an existing
+variable that is not an array, or if \fIarrayName\fR is an illegal name for an
+array. If \fIarrayName\fR does not currently exist, it is created as an empty
+array as well as having its default value set.
+.VE TIP508
+.TP
+\fBarray default unset \fIarrayName\fR
+.VS TIP508
+This removes the default value for the array \fIarrayName\fR and returns the
+empty string. Does nothing if \fIarrayName\fR does not have a default
+value. Raises an error if \fIarrayName\fR is an existing variable that is not
+an array.
+.VE TIP508
+.RE
+.TP
 \fBarray donesearch \fIarrayName searchId\fR
 This command terminates an array search and destroys all the
 state associated with that search.  \fISearchId\fR indicates
@@ -194,3 +241,7 @@ foreach color [lsort [\fBarray names\fR colorcount]] {
 list(n), string(n), variable(n), trace(n), foreach(n)
 .SH KEYWORDS
 array, element names, search
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/dict.n b/doc/dict.n
index cd7e94c..1829768 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -27,6 +27,11 @@ key maps to in the dictionary value contained in the given variable,
 writing the resulting dictionary value back to that variable.
 Non-existent keys are treated as if they map to an empty string. The
 updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the appending operation.
+.VE TIP508
 .TP
 \fBdict create \fR?\fIkey value ...\fR?
 .
@@ -124,6 +129,11 @@ resulting dictionary value back to that variable. Non-existent keys
 are treated as if they map to 0. It is an error to increment a value
 for an existing key if that value is not an integer. The updated
 dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the incrementing operation.
+.VE TIP508
 .TP
 \fBdict info \fIdictionaryValue\fR
 .
@@ -149,6 +159,11 @@ keys are treated as if they map to an empty list, and it is legal for
 there to be no items to append to the list. It is an error for the
 value that the key maps to to not be representable as a list. The
 updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the list-appending operation.
+.VE TIP508
 .TP
 \fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
 .
@@ -206,6 +221,11 @@ value and places an updated dictionary value in that variable
 containing a mapping from the given key to the given value. When
 multiple keys are present, this operation creates or updates a chain
 of nested dictionaries. The updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value insert/update operation.
+.VE TIP508
 .TP
 \fBdict size \fIdictionaryValue\fR
 .
@@ -221,6 +241,11 @@ through nested dictionaries to the mapping to remove. At least one key
 must be specified, but the last key on the key-path need not exist.
 All other components on the path must exist. The updated dictionary
 value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value remove operation.
+.VE TIP508
 .TP
 \fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
 .
@@ -236,6 +261,11 @@ are silently discarded), even if the result of \fIbody\fR is an error
 or some other kind of exceptional exit. The result of \fBdict
 update\fR is (unless some kind of error occurs) the result of the
 evaluation of \fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the update operation.
+.VE TIP508
 .RS
 .PP
 Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
@@ -270,6 +300,11 @@ dictionary be discarded, and this also happens if the contents of
 dictionaries no longer exists. The result of \fBdict with\fR is
 (unless some kind of error occurs) the result of the evaluation of
 \fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the updating operation.
+.VE TIP508
 .RS
 .PP
 The variables are mapped in the scope enclosing the \fBdict with\fR;
diff --git a/doc/incr.n b/doc/incr.n
index b4be95c..f491903 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -27,6 +27,11 @@ and also returned as result.
 Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
 to \fBincr\fR may be unset, and in that case, it will be set to
 the value \fIincrement\fR or to the default increment value of \fB1\fR.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the sum of the default value and the \fIincrement\fR (or
+1) will be stored in the array element.
+.VE TIP508
 .SH EXAMPLES
 .PP
 Add one to the contents of the variable \fIx\fR:
@@ -59,3 +64,7 @@ an error if it is not):
 expr(n), set(n)
 .SH KEYWORDS
 add, increment, variable, value
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/lappend.n b/doc/lappend.n
index 80d075a..66bea5f 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -22,6 +22,12 @@ and appends each of the \fIvalue\fR arguments to that list as a separate
 element, with spaces between elements.
 If \fIvarName\fR does not exist, it is created as a list with elements
 given by the \fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, list that is comprised of the default value with all the
+\fIvalue\fR arguments appended as elements will be stored in the array
+element.
+.VE TIP508
 \fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
 are appended as list elements rather than raw text.
 This command provides a relatively efficient way to build up
@@ -47,3 +53,7 @@ list(n), lindex(n), linsert(n), llength(n), lset(n),
 lsort(n), lrange(n)
 .SH KEYWORDS
 append, element, list, variable
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cc4da9b..c553dea 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4070,10 +4070,7 @@ TEBCresume(
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
-	    TclSetVarArray(varPtr);
-	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
-	    TclInitVarHashTable(varPtr->value.tablePtr,
-		    TclGetVarNsPtr(varPtr));
+	    TclInitArrayVar(varPtr);
 #ifdef TCL_COMPILE_DEBUG
 	    TRACE_APPEND(("done\n"));
 	} else {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 761baf7..d4992dc 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4138,6 +4138,13 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
 			    Tcl_Obj **errorObjPtr);
 
 /*
+ * TIP #508: [array default]
+ */
+
+MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
+MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);
+
+/*
  * Utility routines for encoding index values as integers. Used by both
  * some of the command compilers and by [lsort] and [lsearch].
  */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index ca92803..cafa6a3 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -165,6 +165,18 @@ typedef struct ArraySearch {
 } ArraySearch;
 
 /*
+ * TIP #508: [array default]
+ *
+ * The following structure extends the regular TclVarHashTable used by array
+ * variables to store their optional default value.
+ */
+
+typedef struct ArrayVarHashTable {
+    TclVarHashTable table;
+    Tcl_Obj *defaultObj;
+} ArrayVarHashTable;
+
+/*
  * Forward references to functions defined later in this file:
  */
 
@@ -198,6 +210,16 @@ static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
 			    Tcl_Obj *part2Ptr, int flags, int index);
 
 /*
+ * TIP #508: [array default]
+ */
+
+static int		ArrayDefaultCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static void		DeleteArrayVar(Var *arrayPtr);
+static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);
+
+/*
  * 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.
  */
@@ -236,7 +258,6 @@ static const Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
     FreeParsedVarName, DupParsedVarName, NULL, NULL
 };
-
 
 Var *
 TclVarHashCreateVar(
@@ -1019,8 +1040,6 @@ TclLookupArrayElement(
 {
     int isNew;
     Var *varPtr;
-    TclVarHashTable *tablePtr;
-    Namespace *nsPtr;
 
     /*
      * We're dealing with an array element. Make sure the variable is an array
@@ -1053,16 +1072,7 @@ TclLookupArrayElement(
 	    return NULL;
 	}
 
-	TclSetVarArray(arrayPtr);
-	tablePtr = ckalloc(sizeof(TclVarHashTable));
-	arrayPtr->value.tablePtr = tablePtr;
-
-	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
-	    nsPtr = TclGetVarNsPtr(arrayPtr);
-	} else {
-	    nsPtr = NULL;
-	}
-	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
+	TclInitArrayVar(arrayPtr);
     } else if (!TclIsVarArray(arrayPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
@@ -1412,6 +1422,28 @@ TclPtrGetVarIdx(
 	return varPtr->value.objPtr;
     }
 
+    /*
+     * Return the array default value if any.
+     */
+
+    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
+	return TclGetArrayDefault(arrayPtr);
+    }
+    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
+	/*
+	 * UGLY! Peek inside the implementation of things. This lets us get
+	 * the default of an array even when we've been [upvar]ed to just an
+	 * element of the array.
+	 */
+
+	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
+		((VarInHash *) varPtr)->entry.tablePtr;
+
+	if (avhtPtr->defaultObj) {
+	    return avhtPtr->defaultObj;
+	}
+    }
+
     if (flags & TCL_LEAVE_ERR_MSG) {
 	if (TclIsVarUndefined(varPtr) && arrayPtr
 		&& !TclIsVarUndefined(arrayPtr)) {
@@ -1772,6 +1804,130 @@ TclPtrSetVar(
 /*
  *----------------------------------------------------------------------
  *
+ * ListAppendInVar, StringAppendInVar --
+ *
+ *	Support functions for TclPtrSetVarIdx that implement various types of
+ *	appending operations.
+ *
+ * Results:
+ *	ListAppendInVar returns a Tcl result code (from the core list append
+ *	operation). StringAppendInVar has no return value.
+ *
+ * Side effects:
+ *	The variable or element of the array is updated. This may make the
+ *	variable/element exist. Reference counts of values may be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ListAppendInVar(
+    Tcl_Interp *interp,
+    Var *varPtr,
+    Var *arrayPtr,
+    Tcl_Obj *oldValuePtr,
+    Tcl_Obj *newValuePtr)
+{
+    if (oldValuePtr == NULL) {
+	/*
+	 * No previous value. Check for defaults if there's an array we can
+	 * ask this of.
+	 */
+
+	if (arrayPtr) {
+	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+	    if (defValuePtr) {
+		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
+	    }
+	}
+
+	if (oldValuePtr == NULL) {
+	    /*
+	     * No default. [lappend] semantics say this is like being an empty
+	     * string.
+	     */
+
+	    TclNewObj(oldValuePtr);
+	}
+	varPtr->value.objPtr = oldValuePtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
+    } else if (Tcl_IsShared(oldValuePtr)) {
+	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+	TclDecrRefCount(oldValuePtr);
+	oldValuePtr = varPtr->value.objPtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
+    }
+
+    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
+}
+
+static inline void
+StringAppendInVar(
+    Var *varPtr,
+    Var *arrayPtr,
+    Tcl_Obj *oldValuePtr,
+    Tcl_Obj *newValuePtr)
+{
+    /*
+     * If there was no previous value, either we use the array's default (if
+     * this is an array with a default at all) or we treat this as a simple
+     * set.
+     */
+
+    if (oldValuePtr == NULL) {
+	if (arrayPtr) {
+	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+	    if (defValuePtr) {
+		/*
+		 * This is *almost* the same as the shared path below, except
+		 * that the original value reference in defValuePtr is not
+		 * decremented.
+		 */
+
+		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);
+
+		varPtr->value.objPtr = valuePtr;
+		TclContinuationsCopy(valuePtr, defValuePtr);
+		Tcl_IncrRefCount(valuePtr);
+		Tcl_AppendObjToObj(valuePtr, newValuePtr);
+		if (newValuePtr->refCount == 0) {
+		    Tcl_DecrRefCount(newValuePtr);
+		}
+		return;
+	    }
+	}
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);
+	return;
+    }
+
+    /*
+     * We append newValuePtr's bytes but don't change its ref count. Unless
+     * the reference is shared, when we have to duplicate in order to be safe
+     * to modify at all.
+     */
+
+    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
+	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
+
+	TclDecrRefCount(oldValuePtr);
+	oldValuePtr = varPtr->value.objPtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
+    }
+
+    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+    if (newValuePtr->refCount == 0) {
+	Tcl_DecrRefCount(newValuePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclPtrSetVarIdx --
  *
  *	This function is the same as Tcl_SetVar2Ex above, except that it
@@ -1884,44 +2040,13 @@ TclPtrSetVarIdx(
     }
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
 	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
-	    if (oldValuePtr == NULL) {
-		TclNewObj(oldValuePtr);
-		varPtr->value.objPtr = oldValuePtr;
-		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
-	    } else if (Tcl_IsShared(oldValuePtr)) {
-		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-		TclDecrRefCount(oldValuePtr);
-		oldValuePtr = varPtr->value.objPtr;
-		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
-	    }
-	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
+	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
 		    newValuePtr);
 	    if (result != TCL_OK) {
 		goto earlyError;
 	    }
 	} else {				/* Append string. */
-	    /*
-	     * We append newValuePtr's bytes but don't change its ref count.
-	     */
-
-	    if (oldValuePtr == NULL) {
-		varPtr->value.objPtr = newValuePtr;
-		Tcl_IncrRefCount(newValuePtr);
-	    } else {
-		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
-		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-
-		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
-
-		    TclDecrRefCount(oldValuePtr);
-		    oldValuePtr = varPtr->value.objPtr;
-		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
-		}
-		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
-		if (newValuePtr->refCount == 0) {
-		    Tcl_DecrRefCount(newValuePtr);
-		}
-	    }
+	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
 	}
     } else if (newValuePtr != oldValuePtr) {
 	/*
@@ -4078,9 +4203,7 @@ ArraySetCmd(
 	    return TCL_ERROR;
 	}
     }
-    TclSetVarArray(varPtr);
-    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
-    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+    TclInitArrayVar(varPtr);
     return TCL_OK;
 }
 
@@ -4360,6 +4483,7 @@ TclInitArrayCmd(
 {
     static const EnsembleImplMap arrayImplMap[] = {
 	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
 	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
 	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
@@ -5550,8 +5674,7 @@ DeleteArray(
 
 	TclClearVarNamespaceVar(elPtr);
     }
-    VarHashDeleteTable(varPtr->value.tablePtr);
-    ckfree(varPtr->value.tablePtr);
+    DeleteArrayVar(varPtr);
 }
 
 /*
@@ -6467,6 +6590,264 @@ CompareVarKeys(
     return ((l1 == l2) && !memcmp(p1, p2, l1));
 }
 
+/*----------------------------------------------------------------------
+ *
+ * ArrayDefaultCmd --
+ *
+ *	This function implements the 'array default' Tcl command.
+ *	Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+ArrayDefaultCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *const options[] = {
+	"get", "set", "exists", "unset", NULL
+    };
+    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
+    Tcl_Obj *arrayNameObj, *defaultValueObj;
+    Var *varPtr, *arrayPtr;
+    int isArray, option;
+
+    /*
+     * Parse arguments.
+     */
+
+    if (objc != 3 && objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
+	    0, &option) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    arrayNameObj = objv[2];
+
+    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
+	return TCL_ERROR;
+    }
+
+    switch (option) {
+    case OPT_GET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
+	    return NotArrayError(interp, arrayNameObj);
+	}
+
+	defaultValueObj = TclGetArrayDefault(varPtr);
+	if (!defaultValueObj) {
+	    /* Array default must exist. */
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "array has no default value", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, defaultValueObj);
+	return TCL_OK;
+
+    case OPT_SET:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Attempt to create array if needed.
+	 */
+	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
+		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	if (varPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (arrayPtr) {
+	    /*
+	     * Not a valid array name.
+	     */
+
+	    CleanupVar(varPtr, arrayPtr);
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+		    needArray, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(arrayNameObj), NULL);
+	    return TCL_ERROR;
+	}
+	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	    /*
+	     * Not an array.
+	     */
+
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+		    needArray, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+	    return TCL_ERROR;
+	}
+
+	if (!TclIsVarArray(varPtr)) {
+	    TclInitArrayVar(varPtr);
+	}
+	defaultValueObj = objv[3];
+	SetArrayDefault(varPtr, defaultValueObj);
+	return TCL_OK;
+
+    case OPT_EXISTS:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Undefined variables (whether or not they have storage allocated) do
+	 * not have defaults, and this is not an error case.
+	 */
+
+	if (!varPtr || TclIsVarUndefined(varPtr)) {
+	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+	} else if (!isArray) {
+	    return NotArrayError(interp, arrayNameObj);
+	} else {
+	    defaultValueObj = TclGetArrayDefault(varPtr);
+	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
+	}
+	return TCL_OK;
+
+    case OPT_UNSET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+
+	if (varPtr && !TclIsVarUndefined(varPtr)) {
+	    if (!isArray) {
+		return NotArrayError(interp, arrayNameObj);
+	    }
+	    SetArrayDefault(varPtr, NULL);
+	}
+	return TCL_OK;
+    }
+
+    /* Unreached */
+    return TCL_ERROR;
+}
+
+/*
+ * Initialize array variable.
+ */
+
+void
+TclInitArrayVar(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));
+
+    /*
+     * Mark the variable as an array.
+     */
+
+    TclSetVarArray(arrayPtr);
+
+    /*
+     * Regular TclVarHashTable initialization.
+     */
+
+    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
+    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));
+
+    /*
+     * Default value initialization.
+     */
+
+    tablePtr->defaultObj = NULL;
+}
+
+/*
+ * Cleanup array variable.
+ */
+
+static void
+DeleteArrayVar(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    /*
+     * Default value cleanup.
+     */
+
+    SetArrayDefault(arrayPtr, NULL);
+
+    /*
+     * Regular TclVarHashTable cleanup.
+     */
+
+    VarHashDeleteTable(arrayPtr->value.tablePtr);
+    ckfree(tablePtr);
+}
+
+/*
+ * Get array default value if any.
+ */
+
+Tcl_Obj *
+TclGetArrayDefault(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    return tablePtr->defaultObj;
+}
+
+/*
+ * Set/replace/unset array default value.
+ */
+
+static void
+SetArrayDefault(
+    Var *arrayPtr,
+    Tcl_Obj *defaultObj)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    /*
+     * Increment/decrement refcount twice to ensure that the object is shared,
+     * so that it doesn't get modified accidentally by the folling code:
+     *
+     *      array default set v 1
+     *      lappend v(a) 2; # returns a new object {1 2}
+     *      set v(b); # returns the original default object "1"
+     */
+
+    if (tablePtr->defaultObj) {
+        Tcl_DecrRefCount(tablePtr->defaultObj);
+        Tcl_DecrRefCount(tablePtr->defaultObj);
+    }
+    tablePtr->defaultObj = defaultObj;
+    if (tablePtr->defaultObj) {
+        Tcl_IncrRefCount(tablePtr->defaultObj);
+        Tcl_IncrRefCount(tablePtr->defaultObj);
+    }
+}
+
 /*
  * Local Variables:
  * mode: c
diff --git a/tests/set-old.test b/tests/set-old.test
index b2e7aa6..ea5155b 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -340,7 +340,7 @@ test set-old-8.6 {array command} {
     catch {unset a}
     set a(22) 3
     list [catch {array gorp a} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
 test set-old-8.7 {array command, anymore option} {
     catch {unset a}
     list [catch {array anymore a x} msg] $msg
@@ -700,7 +700,7 @@ test set-old-9.1 {ids for array enumeration} {
     catch {unset a}
     set a(a) 1
     list [array star a] [array star a] [array done a s-1-a; array star a] \
-	    [array done a s-2-a; array d a s-3-a; array start a]
+	    [array done a s-2-a; array do a s-3-a; array start a]
 } {s-1-a s-2-a s-3-a s-1-a}
 test set-old-9.2 {array enumeration} {
     catch {unset a}
diff --git a/tests/var.test b/tests/var.test
index 7b7fc25..36beb3a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -1046,7 +1046,7 @@ test var-22.2 {leak in parsedVarName} -constraints memory -body {
 } -cleanup {
     unset -nocomplain i x
 } -result 0
-
+
 unset -nocomplain a k v
 test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
     array for {k v} c d e {}
@@ -1202,6 +1202,261 @@ test var-23.14 {array for, shared arguments} -setup {
 } -cleanup {
     unset -nocomplain $vn vn
 } -result {}
+
+test var-24.1 {array default set and get: interpreted} -setup {
+    unset -nocomplain ary
+} -body {
+    array set ary {a 3}
+    array default set ary 7
+    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+	[array default get ary]
+} -cleanup {
+    unset -nocomplain ary
+} -result {3 7 1 0 7}
+test var-24.2 {array default set and get: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+	    [array default get ary]
+    }}
+} {3 7 1 0 7}
+test var-24.3 {array default unset: interpreted} -setup {
+    unset -nocomplain ary
+} -body {
+    array set ary {a 3}
+    array default set ary 7
+    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
+} -cleanup {
+    unset -nocomplain ary
+} -result {3 7 {} 3 1}
+test var-24.4 {array default unset: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
+	    [catch {set ary(b)}]
+    }}
+} {3 7 {} 3 1}
+test var-24.5 {array default exists: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array set ary {a 3}
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default set ary 7
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default unset ary
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    unset ary
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default set ary 11
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+} -cleanup {
+    unset -nocomplain ary result
+} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.6 {array default exists: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default set ary 7
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default unset ary
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	unset ary
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default set ary 11
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+    }}
+} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.7 {array default and append: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary grill
+    lappend result [array size ary] [info exist ary(x)]
+    append ary(x) abc
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    append ary(x) def
+    append ary(y) ghi
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.8 {array default and append: compiled} {
+    apply {{} {
+	array default set ary grill
+	lappend result [array size ary] [info exist ary(x)]
+	append ary(x) abc
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	append ary(x) def
+	append ary(y) ghi
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.9 {array default and lappend: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary grill
+    lappend result [array size ary] [info exist ary(x)]
+    lappend ary(x) abc
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    lappend ary(x) def
+    lappend ary(y) ghi
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.10 {array default and lappend: compiled} {
+    apply {{} {
+	array default set ary grill
+	lappend result [array size ary] [info exist ary(x)]
+	lappend ary(x) abc
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	lappend ary(x) def
+	lappend ary(y) ghi
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.11 {array default and incr: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary 7
+    lappend result [array size ary] [info exist ary(x)]
+    incr ary(x) 11
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    incr ary(x)
+    incr ary(y)
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 18 2 19 1}
+test var-24.12 {array default and incr: compiled} {
+    apply {{} {
+	array default set ary 7
+	lappend result [array size ary] [info exist ary(x)]
+	incr ary(x) 11
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	incr ary(x)
+	incr ary(y)
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 18 2 19 1}
+test var-24.13 {array default and dict: interpreted} -setup {
+    unset -nocomplain ary x y z
+} -body {
+    array default set ary {x y}
+    dict lappend ary(p) x z
+    dict update ary(q) x y {
+	set y z
+    }
+    dict with ary(r) {
+	set x 123
+    }
+    lsort -stride 2 -index 0 [array get ary]
+} -cleanup {
+    unset -nocomplain ary x y z
+} -result {p {x {y z}} q {x z} r {x 123}}
+test var-24.14 {array default and dict: compiled} {
+    lsort -stride 2 -index 0 [apply {{} {
+	array default set ary {x y}
+	dict lappend ary(p) x z
+	dict update ary(q) x y {
+	    set y z
+	}
+	dict with ary(r) {
+	    set x 123
+	}
+	array get ary
+    }}]
+} {p {x {y z}} q {x z} r {x 123}}
+test var-24.15 {array default set and get: two-level} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	apply {{} {
+	    upvar 1 ary ary ary(c) c
+	    lappend result $ary(a) $ary(b) $c
+	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
+	    lappend result [array default get ary]
+	}}
+    }}
+} {3 7 7 1 0 0 7}
+test var-24.16 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default set ary 7
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {can't array default set "ary": variable isn't array}
+test var-24.17 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default set ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.18 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default set ary x y
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.19 {array default get: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default get ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.20 {array default get: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default get ary x y
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.21 {array default exists: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default exists ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.22 {array default exists: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default exists ary x
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.23 {array default unset: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default unset ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.24 {array default unset: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default unset ary x
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
 
 catch {namespace delete ns}
 catch {unset arr}