Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-508 Through [b7c36daff3] Excluding Merge-Ins
This is equivalent to a diff from 0f532e7ca6 to b7c36daff3
|
2018-09-24
| ||
| 16:19 | merge 8.6 check-in: dad7a5e5dc user: dgp tags: core-8-branch | |
| 08:21 | Add tests. Exposes quite a few bugs in the implementation... check-in: 95ffc97dca user: dkf tags: tip-508 | |
|
2018-09-23
| ||
| 17:29 | Added docs check-in: b7c36daff3 user: dkf tags: tip-508 | |
| 16:42 | merge core-8-branch check-in: 2de5d168ef user: dkf tags: tip-508 | |
| 13:44 | Merge 8.7 Remark: Almost all "http-tip-452.test" test-cases fail, most likely due to the internal ch... Leaf check-in: 3deacfe7db user: jan.nijtmans tags: tip-452 | |
| 13:30 | Merge 8.7 check-in: 16a16279ab user: jan.nijtmans tags: trunk | |
| 13:29 | Merge 8.6 check-in: 0f532e7ca6 user: jan.nijtmans tags: core-8-branch | |
| 13:27 | Give lambda function a name "ReceiveChunked" for easier testing. New function quoteString and code c... check-in: 81db707b5c user: jan.nijtmans tags: core-8-6-branch | |
|
2018-09-22
| ||
| 16:51 | Handle the (unlikely) case that Tcl_DStringSetLength() results in a re-allocation of the buffer check-in: 24aadadf9c user: jan.nijtmans tags: core-8-branch | |
Changes to doc/append.n.
| ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | + + + + + | .BE .SH DESCRIPTION .PP 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 variables incrementally. For example, .QW "\fBappend a $b\fR" is much more efficient than |
| ︙ | |||
40 41 42 43 44 45 46 | 45 46 47 48 49 50 51 52 53 54 55 | - - - + + + + | puts $var # Prints 0,1,2,3,4,5,6,7,8,9,10 .CE .SH "SEE ALSO" concat(n), lappend(n) .SH KEYWORDS append, variable |
Changes to doc/array.n.
1 2 3 4 5 6 7 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | - + | '\" '\" Copyright (c) 1993-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" |
| ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | \fISearchId\fR indicates which search on \fIarrayName\fR to check, and must have been the return value from a previous invocation of \fBarray startsearch\fR. This option is particularly useful if an array has an element 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 which search on \fIarrayName\fR to destroy, and must have been the return value from a previous invocation of \fBarray startsearch\fR. Returns an empty string. |
| ︙ | |||
190 191 192 193 194 195 196 | 237 238 239 240 241 242 243 244 245 246 247 | + + + + |
number of buckets with 10 or more entries: 0
average search distance for entry: 1.2
.CE
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
|
Changes to doc/dict.n.
| ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | + + + + + | \fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR? . This appends the given string (or strings) to the value that the given 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? . Return a new dictionary that contains each of the key/value mappings listed as arguments (keys and values alternating, with each key being followed by its associated value.) .TP |
| ︙ | |||
120 121 122 123 124 125 126 127 128 129 130 131 132 133 | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | + + + + + | This adds the given increment value (an integer that defaults to 1 if not specified) to the value that the given 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 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 . This returns information (intended for display to people) about the given dictionary though the format of this data is dependent on the implementation of the dictionary. For dictionaries that are implemented by hash tables, it is expected that this will return the |
| ︙ | |||
145 146 147 148 149 150 151 152 153 154 155 156 157 158 | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | + + + + + |
This appends the given items to the list value that the given 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 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
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
two-element list of variable names (for the key and value respectively of each
mapping in the dictionary), the second the dictionary value to iterate across,
|
| ︙ | |||
202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | + + + + + + + + + + + + + + + | \fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR . This operation takes the name of a variable containing a dictionary 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 . Return the number of key/value mappings in the given dictionary value. .TP \fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR? . This operation (the companion to \fBdict set\fR) takes the name of a variable containing a dictionary value and places an updated dictionary value in that variable that does not contain a mapping for the given key. Where multiple keys are present, this describes a path 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 . Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR (as found by reading the dictionary value in \fIdictionaryVariable\fR) mapped to the variable \fIvarName\fR. There may be multiple \fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping, that corresponds to an unset \fIvarName\fR. When \fIbody\fR terminates, any changes made to the \fIvarName\fRs is reflected back to the dictionary within \fIdictionaryVariable\fR (unless \fIdictionaryVariable\fR itself becomes unreadable, when all updates 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; it is recommended that this command only be used in a local scope (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of this, the variables set by \fBdict update\fR will continue to exist after the command finishes (unless explicitly \fBunset\fR). |
| ︙ | |||
266 267 268 269 270 271 272 273 274 275 276 277 278 279 | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | + + + + + | for the execution of \fIbody\fR. As with \fBdict update\fR, making \fIdictionaryVariable\fR unreadable will make the updates to the dictionary be discarded, and this also happens if the contents of \fIdictionaryVariable\fR are adjusted so that the chain 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; it is recommended that this command only be used in a local scope (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of this, the variables set by \fBdict with\fR will continue to exist after the command finishes (unless explicitly \fBunset\fR). |
| ︙ |
Changes to doc/incr.n.
| ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | + + + + + | 1 is added to \fIvarName\fR. The new value is stored as a decimal string in variable \fIvarName\fR and also returned as result. .PP 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: .PP .CS \fBincr\fR x .CE |
| ︙ | |||
55 56 57 58 59 60 61 | 60 61 62 63 64 65 66 67 68 69 70 | + + + + | .CS \fBincr\fR x 0 .CE .SH "SEE ALSO" expr(n), set(n) .SH KEYWORDS add, increment, variable, value .\" Local variables: .\" mode: nroff .\" fill-column: 78 .\" End: |
Changes to doc/lappend.n.
| ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | + + + + + + | .SH DESCRIPTION .PP This command treats the variable given by \fIvarName\fR as a list 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 large lists. For example, .QW "\fBlappend a $b\fR" is much more efficient than .QW "\fBset a [concat $a [list $b]]\fR" |
| ︙ | |||
43 44 45 46 47 48 49 | 49 50 51 52 53 54 55 56 57 58 59 | + + + + | 1 2 3 4 5 .CE .SH "SEE ALSO" 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: |
Changes to generic/tclExecute.c.
| ︙ | |||
4066 4067 4068 4069 4070 4071 4072 | 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 | - + - - - | "variable isn't array", opnd); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL); CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } |
| ︙ |
Changes to generic/tclInt.h.
| ︙ | |||
4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 | 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 | + + + + + + | MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp); MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid); MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options, int *codePtr, Tcl_Obj **msgObjPtr, Tcl_Obj **errorObjPtr); /* * TIP #508: [array default] */ MODULE_SCOPE void TclInitArrayVar(Var *arrayPtr); /* * Utility routines for encoding index values as integers. Used by both * some of the command compilers and by [lsort] and [lsearch]. */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, int before, int after, int *indexPtr); |
| ︙ |
Changes to generic/tclVar.c.
| ︙ | |||
193 194 195 196 197 198 199 200 201 202 203 204 205 206 | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | + + + + + + + + + + + | Tcl_Obj *myNamePtr, int myFlags, int index); static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, Tcl_Obj *varNamePtr, Tcl_Obj *handleObj); static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, int index); /* * TIP #508: [array default] */ static int ArrayDefaultCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void DeleteArrayVar(Var *arrayPtr); static Tcl_Obj * GetArrayDefault(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. */ MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp, Tcl_Obj *varNamePtr, int flags, const int create, |
| ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 | - - |
* element, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
Var *arrayPtr, /* Pointer to the array's Var structure. */
int index) /* If >=0, the index of the local array. */
{
int isNew;
Var *varPtr;
|
| ︙ | |||
1045 1046 1047 1048 1049 1050 1051 | 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 | - + - - - - - - - - - | danglingVar, index); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL); } return NULL; } |
| ︙ | |||
1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 | + + + + + + + |
/*
* Return the element if it's an existing scalar variable.
*/
if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
return varPtr->value.objPtr;
}
/*
* Return the array default value if any.
*/
if (arrayPtr && TclIsVarArray(arrayPtr) && GetArrayDefault(arrayPtr)) {
return GetArrayDefault(arrayPtr);
}
if (flags & TCL_LEAVE_ERR_MSG) {
if (TclIsVarUndefined(varPtr) && arrayPtr
&& !TclIsVarUndefined(arrayPtr)) {
msg = noSuchElement;
} else if (TclIsVarArray(varPtr)) {
msg = isArray;
|
| ︙ | |||
4070 4071 4072 4073 4074 4075 4076 | 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 | - + - - |
TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
needArray, -1);
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
return TCL_ERROR;
}
}
|
| ︙ | |||
4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 | 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 | + |
/* ARGSUSED */
Tcl_Command
TclInitArrayCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
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},
{"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0},
|
| ︙ | |||
5542 5543 5544 5545 5546 5547 5548 | 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 | - - + |
* variables, some combinations of [upvar] and [variable] may create
* such beasts - see [Bug 604239]. This is necessary to avoid leaking
* the corresponding Var struct, and is otherwise harmless.
*/
TclClearVarNamespaceVar(elPtr);
}
|
| ︙ | |||
6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 | 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + |
/*
* Only compare string representations of the same length.
*/
return ((l1 == l2) && !memcmp(p1, p2, l1));
}
/*
* 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;
/*----------------------------------------------------------------------
*
* 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 || !isArray) {
return NotArrayError(interp, arrayNameObj);
}
defaultValueObj = GetArrayDefault(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;
}
if (varPtr && !isArray) {
return NotArrayError(interp, arrayNameObj);
}
if (!varPtr) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
} else {
defaultValueObj = GetArrayDefault(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 && !isArray) {
return NotArrayError(interp, arrayNameObj);
}
if (varPtr) {
SetArrayDefault(varPtr, NULL);
}
return TCL_OK;
}
/* Unreached */
return TCL_ERROR;
}
/*
* Initialize array variable.
*/
void
TclInitArrayVar(
Var *arrayPtr)
{
ArrayVarHashTable *tablePtr;
TclSetVarArray(arrayPtr);
tablePtr = ckalloc(sizeof(ArrayVarHashTable));
// 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.
*/
static Tcl_Obj *
GetArrayDefault(
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
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|