Diff
Not logged in

Differences From Artifact [76200165a1]:

To Artifact [177689a261]:


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
276
277
278
279

280
281
282
283
284
285
286
287
288

289
290
291

292
293
294


295
296
297


298
299
300
301
302
303
304
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
276
277
278

279
280
281
282
283
284
285
286
287

288
289
290

291
292


293
294
295


296
297
298
299
300
301
302
303
304







-
+









-
+

-
-
-
-
+
+
+
+








-
+








-
+


-
+

-
-
+
+

-
-
+
+








static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL,
    TCL_OBJTYPE_V0
};

#define LocalSetInternalRep(objPtr, index, namePtr) \
#define LocalSetInternalRep(objPtr, index, namePtr)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetInternalRep(objPtr, index, name) \
#define LocalGetInternalRep(objPtr, index, name)				\
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &localVarNameType);	\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;	\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &localVarNameType);		\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE;	\
    } while (0)

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

#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
#define ParsedSetInternalRep(objPtr, arrayPtr, elem)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\
	if (ptr1) {Tcl_IncrRefCount(ptr1);}				\
	if (ptr2) {Tcl_IncrRefCount(ptr2);}				\
	ir.twoPtrValue.ptr1 = ptr1;					\
	ir.twoPtrValue.ptr2 = ptr2;					\
	Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir);	\
	Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir);		\
    } while (0)

#define ParsedGetInternalRep(objPtr, parsed, array, elem) \
#define ParsedGetInternalRep(objPtr, parsed, array, elem)			\
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType);	\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType);		\
	(parsed) = (irPtr != NULL);					\
	(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;	\
	(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;	\
	(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)

Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541
542
543

544
545
546

547
548
549
550
551
552
553
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540
541
542

543
544
545

546
547
548
549
550
551
552
553







-
+









-
+


-
+







 *
 *----------------------------------------------------------------------
 */

Var *
TclObjLookupVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *part1Ptr,		/* If part2 isn't NULL, this is the name of an
    Tcl_Obj *part1Ptr,	/* If part2 isn't NULL, this is the name of an
				 * array. Otherwise, this is a full variable
				 * name that could include a parenthesized
				 * array element. */
    const char *part2,		/* Name of element within array, or NULL. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * and TCL_LEAVE_ERR_MSG bits matter. */
    const char *msg,		/* Verb to use in error messages, e.g. "read"
				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
				 * is set in flags. */
    int createPart1,		/* If 1, create hash table entry for part 1 of
    int createPart1,	/* If 1, create hash table entry for part 1 of
				 * name, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    int createPart2,		/* If 1, create hash table entry for part 2 of
    int createPart2,	/* If 1, create hash table entry for part 2 of
				 * name, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
586
587
588
589
590
591
592
593

594
595
596

597
598
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
586
587
588
589
590
591
592

593
594
595

596
597
598
599
600
601
602
603
604
605

606
607
608
609
610
611
612
613







-
+


-
+









-
+







				 * parenthesized array element. */
    Tcl_Obj *part2Ptr,		/* Name of element within array, or NULL. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * and TCL_LEAVE_ERR_MSG bits matter. */
    const char *msg,		/* Verb to use in error messages, e.g. "read"
				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
				 * is set in flags. */
    int createPart1,		/* If 1, create hash table entry for part 1 of
    int createPart1,	/* If 1, create hash table entry for part 1 of
				 * name, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    int createPart2,		/* If 1, create hash table entry for part 2 of
    int createPart2,	/* If 1, create hash table entry for part 2 of
				 * name, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;		/* Points to the variable's in-frame Var
    Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;
    int index, parsed = 0;

    Tcl_Size localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

822
823
824
825
826
827
828
829

830
831
832
833
834
835
836
822
823
824
825
826
827
828

829
830
831
832
833
834
835
836







-
+







TclLookupSimpleVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
				 * represent a scalar or an array. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
				 * bits matter. */
    int create,			/* If 1, create hash table entry for varname,
    int create,		/* If 1, create hash table entry for varname,
				 * if it doesn't already exist. If 0, return
				 * error if it doesn't exist. */
    const char **errMsgPtr,
    int *indexPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1020
1021
1022
1023
1024
1025
1026

1027
1028
1029
1030
1031
1032
1033
1034







-
+







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

1063
1064
1065
1066

1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065

1066
1067
1068
1069

1070
1071
1072
1073
1074
1075
1076
1077







-
+



-
+



-
+








Var *
TclLookupArrayElement(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *arrayNamePtr,	/* This is the name of the array, or NULL if
				 * index>= 0. */
    Tcl_Obj *elNamePtr,		/* Name of element within array. */
    int flags,			/* Only TCL_LEAVE_ERR_MSG bit matters. */
    int flags,		/* Only TCL_LEAVE_ERR_MSG bit matters. */
    const char *msg,		/* Verb to use in error messages, e.g. "read"
				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
				 * is set in flags. */
    int createArray,		/* If 1, transform arrayName to be an array if
    int createArray,	/* If 1, transform arrayName to be an array if
				 * it isn't one yet and the transformation is
				 * possible. If 0, return error if it isn't
				 * already an array. */
    int createElem,		/* If 1, create hash table entry for the
    int createElem,	/* If 1, create hash table entry for the
				 * 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;
1272
1273
1274
1275
1276
1277
1278
1279

1280
1281
1282

1283
1284
1285
1286
1287
1288
1289
1272
1273
1274
1275
1276
1277
1278

1279
1280
1281

1282
1283
1284
1285
1286
1287
1288
1289







-
+


-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjGetVar2(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
    Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
    Tcl_Obj *part2Ptr,	/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    Var *varPtr, *arrayPtr;

1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343
1344
1345
1331
1332
1333
1334
1335
1336
1337

1338
1339
1340
1341
1342
1343
1344
1345







-
+







    Tcl_Var varPtr,		/* The variable to be read.*/
    Tcl_Var arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
    int flags)		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
1370
1371
1372
1373
1374
1375
1376
1377

1378
1379
1380
1381
1382
1383
1384

1385
1386
1387
1388
1389
1390
1391
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1391







-
+






-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrGetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Var *varPtr,		/* The variable to be read.*/
    Var *varPtr,	/* The variable to be read.*/
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY, and
    int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Interp *iPtr = (Interp *) interp;
    const char *msg;
1478
1479
1480
1481
1482
1483
1484
1485

1486
1487
1488
1489
1490
1491
1492

1493
1494
1495
1496
1497
1498
1499
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491

1492
1493
1494
1495
1496
1497
1498
1499







-
+






-
+







 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varValueObj);
	return TCL_OK;
    } else if (objc == 3) {
	varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
1655
1656
1657
1658
1659
1660
1661
1662

1663
1664
1665

1666
1667
1668
1669
1670
1671
1672
1655
1656
1657
1658
1659
1660
1661

1662
1663
1664

1665
1666
1667
1668
1669
1670
1671
1672







-
+


-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjSetVar2(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be found. */
    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
    Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, points to an object holding
    Tcl_Obj *part2Ptr,	/* If non-NULL, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
				 * TCL_LEAVE_ERR_MSG. */
1726
1727
1728
1729
1730
1731
1732
1733

1734
1735
1736
1737
1738
1739
1740
1726
1727
1728
1729
1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1740







-
+







				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
    int flags)		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
1895
1896
1897
1898
1899
1900
1901
1902

1903
1904
1905
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915
1916
1917
1918
1919
1895
1896
1897
1898
1899
1900
1901

1902
1903
1904
1905
1906
1907
1908
1909
1910
1911

1912
1913
1914
1915
1916
1917
1918
1919







-
+









-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrSetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Var *varPtr,		/* Reference to the variable to set. */
    Var *varPtr,	/* Reference to the variable to set. */
    Var *arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. NULL if the 'index'
				 * parameter is >= 0 */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY, and
    int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index of local var where part1 is to be
				 * found. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;
1944
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963

1964
1965
1966
1967
1968
1969
1970
1944
1945
1946
1947
1948
1949
1950

1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962

1963
1964
1965
1966
1967
1968
1969
1970







-
+











-
+







    }

    /*
     * It's an error to try to set a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST, index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY, index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
	}
	goto earlyError;
    }

    TclVarFindHiddenArray(varPtr, arrayPtr);

2164
2165
2166
2167
2168
2169
2170
2171

2172
2173
2174
2175
2176
2177
2178
2164
2165
2166
2167
2168
2169
2170

2171
2172
2173
2174
2175
2176
2177
2178







-
+







				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    int flags)			/* Various flags that tell how to incr value:
    int flags)		/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
2220
2221
2222
2223
2224
2225
2226
2227

2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242

2243
2244
2245
2246
2247
2248
2249
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241

2242
2243
2244
2245
2246
2247
2248
2249







-
+














-
+







				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    int flags,			/* Various flags that tell how to incr value:
    int flags,		/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Tcl_Obj *varValuePtr;

    /*
     * It's an error to try to increment a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST, index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	return NULL;
    }

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
2409
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2409
2410
2411
2412
2413
2414
2415

2416
2417
2418
2419
2420
2421
2422
2423







-
+







    Tcl_Var varPtr,		/* The variable to be unset. */
    Tcl_Var arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of any of
    int flags)		/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
2472
2473
2474
2475
2476
2477
2478
2479

2480
2481
2482
2483
2484
2485
2486
2472
2473
2474
2475
2476
2477
2478

2479
2480
2481
2482
2483
2484
2485
2486







-
+







    Var *initialArrayPtr = arrayPtr;

    /*
     * It's an error to try to unset a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST, index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Keep the variable alive until we're done with it. We used to
2500
2501
2502
2503
2504
2505
2506
2507

2508
2509
2510
2511
2512
2513
2514
2515
2500
2501
2502
2503
2504
2505
2506

2507

2508
2509
2510
2511
2512
2513
2514







-
+
-







    /*
     * It's an error to unset an undefined variable.
     */

    if (result != TCL_OK) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
		    ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT),
              ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL);
	}
    }

    /*
     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628












2629
2630
2631
2632

2633
2634
2635
2636
2637
2638
2639
2609
2610
2611
2612
2613
2614
2615












2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630

2631
2632
2633
2634
2635
2636
2637
2638







-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



-
+







		Tcl_SetHashValue(tPtr, tracePtr);
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {

	    /*
	     * Pass the array element name to TclObjCallVarTraces(), because
	     * it cannot be determined from dummyVar. Alternatively, indicate
	     * via flags whether the variable involved in the code that caused
	     * the trace to be triggered was an array element, for the correct
	     * formatting of error messages.
	     */
	    if (part2Ptr) {
		flags |= VAR_ARRAY_ELEMENT;
	    } else if (TclIsVarArrayElement(varPtr)) {
		part2Ptr = VarHashGetKey(varPtr);
	    }
            /*
             * Pass the array element name to TclObjCallVarTraces(), because
             * it cannot be determined from dummyVar. Alternatively, indicate
             * via flags whether the variable involved in the code that caused
             * the trace to be triggered was an array element, for the correct
             * formatting of error messages.
             */
            if (part2Ptr) {
                flags |= VAR_ARRAY_ELEMENT;
            } else if (TclIsVarArrayElement(varPtr)) {
                part2Ptr = VarHashGetKey(varPtr);
            }

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
              (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, index);

	    /*
	     * The traces that we just called may have triggered a change in
	     * the set of traces. If so, reload the traces to manipulate.
	     */
2809
2810
2811
2812
2813
2814
2815
2816

2817
2818
2819
2820
2821
2822
2823
2808
2809
2810
2811
2812
2813
2814

2815
2816
2817
2818
2819
2820
2821
2822







-
+








    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	    return TCL_ERROR;
	}
    } else {
	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
4293
4294
4295
4296
4297
4298
4299
4300

4301
4302
4303
4304
4305
4306
4307
4292
4293
4294
4295
4296
4297
4298

4299
4300
4301
4302
4303
4304
4305
4306







-
+







    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    int unsetFlags = 0;		/* Should this be TCL_LEAVE_ERR_MSG? */
    int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
4472
4473
4474
4475
4476
4477
4478
4479

4480
4481
4482
4483
4484
4485
4486
4471
4472
4473
4474
4475
4476
4477

4478
4479
4480
4481
4482
4483
4484
4485







-
+







ObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    CallFrame *framePtr,	/* Call frame containing "other" variable.
				 * NULL means use global :: context. */
    Tcl_Obj *otherP1Ptr,
    const char *otherP2,	/* Two-part name of variable in framePtr. */
    int otherFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
    int otherFlags,	/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of "other" variable. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
4518
4519
4520
4521
4522
4523
4524
4525
4526


4527
4528
4529
4530
4531
4532
4533
4517
4518
4519
4520
4521
4522
4523


4524
4525
4526
4527
4528
4529
4530
4531
4532







-
-
+
+







     * local variable in a procedure. If we allowed this, the local
     * variable in the shorter-lived procedure frame could go away leaving
     * the namespace var's reference invalid.
     */

    if (index < 0) {
	if (!(arrayPtr != NULL
		    ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		    : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
			|| !HasLocalVars(varFramePtr)
			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
	    TclPrintfResult((Tcl_Interp *) iPtr,
		    "bad variable name \"%s\": can't create namespace "
		    "variable that refers to procedure variable",
5326
5327
5328
5329
5330
5331
5332
5333

5334
5335
5336
5337
5338
5339
5340
5325
5326
5327
5328
5329
5330
5331

5332
5333
5334
5335
5336
5337
5338
5339







-
+







 *
 *----------------------------------------------------------------------
 */

static void
DeleteSearches(
    Interp *iPtr,
    Var *arrayVarPtr)		/* Variable whose searches are to be
    Var *arrayVarPtr)	/* Variable whose searches are to be
				 * deleted. */
{
    ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
5599
5600
5601
5602
5603
5604
5605
5606

5607
5608
5609
5610
5611
5612
5613
5598
5599
5600
5601
5602
5603
5604

5605
5606
5607
5608
5609
5610
5611
5612







-
+







	     */

	    if (elPtr->flags & VAR_TRACED_UNSET) {
		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);

		elPtr->flags &= ~VAR_TRACE_ACTIVE;
		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
			elNamePtr, flags, /* leaveErrMsg */ 0, index);
			elNamePtr, flags,/* leaveErrMsg */ 0, index);
	    }
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
6794
6795
6796
6797
6798
6799
6800
6801

6802
6803
6804
6805
6806
6807
6808
6793
6794
6795
6796
6797
6798
6799

6800
6801
6802
6803
6804
6805
6806
6807







-
+







	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,		/* New key to compare. */
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    size_t l1, l2;

7073
7074
7075
7076
7077
7078
7079
7080
7081


7082
7083
7084
7085
7086


7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7072
7073
7074
7075
7076
7077
7078


7079
7080
7081
7082
7083


7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095







-
-
+
+



-
-
+
+










     *
     *      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);
        Tcl_DecrRefCount(tablePtr->defaultObj);
        Tcl_DecrRefCount(tablePtr->defaultObj);
    }
    tablePtr->defaultObj = defaultObj;
    if (tablePtr->defaultObj) {
	Tcl_IncrRefCount(tablePtr->defaultObj);
	Tcl_IncrRefCount(tablePtr->defaultObj);
        Tcl_IncrRefCount(tablePtr->defaultObj);
        Tcl_IncrRefCount(tablePtr->defaultObj);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */