Tcl Source Code

Check-in [847fa2261d]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:[1b0266d8bb] Make [dict replace] and [dict remove] have canonicalization semantics close to [lrange] and [lreplace]. [dict merge] is also improved, but is not as strict.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: 847fa2261d016aac0c70ea1c39075827f50e3603
User & Date: dkf 2014-06-15 16:14:18
Context
2014-06-15
16:50
[cb042d294e] Improve consistency of [dict] wrong-args error messages. check-in: 968e9ac311 user: dkf tags: trunk
16:14
[1b0266d8bb] Make [dict replace] and [dict remove] have canonicalization semantics close to [lrange]... check-in: 847fa2261d user: dkf tags: trunk, potential incompatibility
16:11
Some more cleaning up Closed-Leaf check-in: fd9995590d user: dkf tags: bug-1b0266d8bb
2014-06-05
19:13
Tests socket*-2.12 test for DiscardOutput() updates. check-in: 39da5e7464 user: dgp tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclDictObj.c.

   150    150       int epoch;			/* Epoch counter */
   151    151       int refcount;		/* Reference counter (see above) */
   152    152       Tcl_Obj *chain;		/* Linked list used for invalidating the
   153    153   				 * string representations of updated nested
   154    154   				 * dictionaries. */
   155    155   } Dict;
   156    156   
          157  +/*
          158  + * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
          159  + * must be assignable as well as readable.
          160  + */
          161  +
          162  +#define DICT(dictObj)   (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
          163  +
   157    164   /*
   158    165    * The structure below defines the dictionary object type by means of
   159    166    * functions that can be invoked by generic object code.
   160    167    */
   161    168   
   162    169   const Tcl_ObjType tclDictType = {
   163    170       "dict",
................................................................................
   308    315       ChainEntry *cPtr = (ChainEntry *)
   309    316   	    Tcl_FindHashEntry(&dict->table, keyPtr);
   310    317   
   311    318       if (cPtr == NULL) {
   312    319   	return 0;
   313    320       } else {
   314    321   	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
          322  +
   315    323   	TclDecrRefCount(valuePtr);
   316    324       }
   317    325   
   318    326       /*
   319    327        * Unstitch from the chain.
   320    328        */
   321    329   
................................................................................
   357    365    */
   358    366   
   359    367   static void
   360    368   DupDictInternalRep(
   361    369       Tcl_Obj *srcPtr,
   362    370       Tcl_Obj *copyPtr)
   363    371   {
   364         -    Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
          372  +    Dict *oldDict = DICT(srcPtr);
   365    373       Dict *newDict = ckalloc(sizeof(Dict));
   366    374       ChainEntry *cPtr;
   367    375   
   368    376       /*
   369    377        * Copy values across from the old hash table.
   370    378        */
   371    379   
................................................................................
   392    400       newDict->chain = NULL;
   393    401       newDict->refcount = 1;
   394    402   
   395    403       /*
   396    404        * Store in the object.
   397    405        */
   398    406   
   399         -    copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
          407  +    DICT(copyPtr) = newDict;
   400    408       copyPtr->typePtr = &tclDictType;
   401    409   }
   402    410   
   403    411   /*
   404    412    *----------------------------------------------------------------------
   405    413    *
   406    414    * FreeDictInternalRep --
................................................................................
   418    426    *----------------------------------------------------------------------
   419    427    */
   420    428   
   421    429   static void
   422    430   FreeDictInternalRep(
   423    431       Tcl_Obj *dictPtr)
   424    432   {
   425         -    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
          433  +    Dict *dict = DICT(dictPtr);
   426    434   
   427    435       dict->refcount--;
   428    436       if (dict->refcount <= 0) {
   429    437   	DeleteDict(dict);
   430    438       }
   431    439       dictPtr->typePtr = NULL;
   432    440   }
................................................................................
   483    491   
   484    492   static void
   485    493   UpdateStringOfDict(
   486    494       Tcl_Obj *dictPtr)
   487    495   {
   488    496   #define LOCAL_SIZE 20
   489    497       int localFlags[LOCAL_SIZE], *flagPtr = NULL;
   490         -    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
          498  +    Dict *dict = DICT(dictPtr);
   491    499       ChainEntry *cPtr;
   492    500       Tcl_Obj *keyPtr, *valuePtr;
   493    501       int i, length, bytesNeeded = 0;
   494    502       const char *elem;
   495    503       char *dst;
   496    504       const int maxFlags = UINT_MAX / sizeof(int);
   497    505   
................................................................................
   596    604   
   597    605   static int
   598    606   SetDictFromAny(
   599    607       Tcl_Interp *interp,
   600    608       Tcl_Obj *objPtr)
   601    609   {
   602    610       Tcl_HashEntry *hPtr;
   603         -    int isNew, result;
          611  +    int isNew;
   604    612       Dict *dict = ckalloc(sizeof(Dict));
   605    613   
   606    614       InitChainTable(dict);
   607    615   
   608    616       /*
   609    617        * Since lists and dictionaries have very closely-related string
   610    618        * representations (i.e. the same parsing code) we can safely special-case
................................................................................
   647    655   	const char *limit = (nextElem + length);
   648    656   
   649    657   	while (nextElem < limit) {
   650    658   	    Tcl_Obj *keyPtr, *valuePtr;
   651    659   	    const char *elemStart;
   652    660   	    int elemSize, literal;
   653    661   
   654         -	    result = TclFindElement(interp, nextElem, (limit - nextElem),
   655         -		    &elemStart, &nextElem, &elemSize, &literal);
   656         -	    if (result != TCL_OK) {
   657         -		goto errorExit;
          662  +	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
          663  +		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
          664  +		goto errorInFindDictElement;
   658    665   	    }
   659    666   	    if (elemStart == limit) {
   660    667   		break;
   661    668   	    }
   662    669   	    if (nextElem == limit) {
   663    670   		goto missingValue;
   664    671   	    }
................................................................................
   669    676   		/* Avoid double copy */
   670    677   		TclNewObj(keyPtr);
   671    678   		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
   672    679   		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
   673    680   			keyPtr->bytes);
   674    681   	    }
   675    682   
   676         -	    result = TclFindElement(interp, nextElem, (limit - nextElem),
   677         -		    &elemStart, &nextElem, &elemSize, &literal);
   678         -	    if (result != TCL_OK) {
          683  +	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
          684  +		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
   679    685   		TclDecrRefCount(keyPtr);
   680         -		goto errorExit;
          686  +		goto errorInFindDictElement;
   681    687   	    }
   682    688   
   683    689   	    if (literal) {
   684    690   		TclNewStringObj(valuePtr, elemStart, elemSize);
   685    691   	    } else {
   686    692   		/* Avoid double copy */
   687    693   		TclNewObj(valuePtr);
................................................................................
   709    715        * Tcl_GetStringFromObj, to use that old internalRep.
   710    716        */
   711    717   
   712    718       TclFreeIntRep(objPtr);
   713    719       dict->epoch = 0;
   714    720       dict->chain = NULL;
   715    721       dict->refcount = 1;
   716         -    objPtr->internalRep.twoPtrValue.ptr1 = dict;
          722  +    DICT(objPtr) = dict;
   717    723       objPtr->typePtr = &tclDictType;
   718    724       return TCL_OK;
   719    725   
   720    726     missingValue:
   721    727       if (interp != NULL) {
   722    728   	Tcl_SetObjResult(interp, Tcl_NewStringObj(
   723    729   		"missing value to go with key", -1));
   724    730   	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
   725    731       }
   726         -    result = TCL_ERROR;
   727         -
   728         -  errorExit:
   729         -    if (interp != NULL) {
   730         -	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
   731         -    }
          732  +  errorInFindDictElement:
   732    733       DeleteChainTable(dict);
   733    734       ckfree(dict);
   734         -    return result;
          735  +    return TCL_ERROR;
   735    736   }
   736    737   
   737    738   /*
   738    739    *----------------------------------------------------------------------
   739    740    *
   740    741    * TclTraceDictPath --
   741    742    *
................................................................................
   773    774       int keyc,
   774    775       Tcl_Obj *const keyv[],
   775    776       int flags)
   776    777   {
   777    778       Dict *dict, *newDict;
   778    779       int i;
   779    780   
   780         -    if (dictPtr->typePtr != &tclDictType) {
   781         -	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
   782         -	    return NULL;
   783         -	}
          781  +    if (dictPtr->typePtr != &tclDictType
          782  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
          783  +	return NULL;
   784    784       }
   785         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
          785  +    dict = DICT(dictPtr);
   786    786       if (flags & DICT_PATH_UPDATE) {
   787    787   	dict->chain = NULL;
   788    788       }
   789    789   
   790    790       for (i=0 ; i<keyc ; i++) {
   791    791   	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
   792    792   	Tcl_Obj *tmpObj;
................................................................................
   814    814   
   815    815   	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
   816    816   	    tmpObj = Tcl_NewDictObj();
   817    817   	    Tcl_IncrRefCount(tmpObj);
   818    818   	    Tcl_SetHashValue(hPtr, tmpObj);
   819    819   	} else {
   820    820   	    tmpObj = Tcl_GetHashValue(hPtr);
   821         -	    if (tmpObj->typePtr != &tclDictType) {
   822         -		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
   823         -		    return NULL;
   824         -		}
          821  +	    if (tmpObj->typePtr != &tclDictType
          822  +		    && SetDictFromAny(interp, tmpObj) != TCL_OK) {
          823  +		return NULL;
   825    824   	    }
   826    825   	}
   827    826   
   828         -	newDict = tmpObj->internalRep.twoPtrValue.ptr1;
          827  +	newDict = DICT(tmpObj);
   829    828   	if (flags & DICT_PATH_UPDATE) {
   830    829   	    if (Tcl_IsShared(tmpObj)) {
   831    830   		TclDecrRefCount(tmpObj);
   832    831   		tmpObj = Tcl_DuplicateObj(tmpObj);
   833    832   		Tcl_IncrRefCount(tmpObj);
   834    833   		Tcl_SetHashValue(hPtr, tmpObj);
   835    834   		dict->epoch++;
   836         -		newDict = tmpObj->internalRep.twoPtrValue.ptr1;
          835  +		newDict = DICT(tmpObj);
   837    836   	    }
   838    837   
   839    838   	    newDict->chain = dictPtr;
   840    839   	}
   841    840   	dict = newDict;
   842    841   	dictPtr = tmpObj;
   843    842       }
................................................................................
   864    863    *----------------------------------------------------------------------
   865    864    */
   866    865   
   867    866   static void
   868    867   InvalidateDictChain(
   869    868       Tcl_Obj *dictObj)
   870    869   {
   871         -    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
          870  +    Dict *dict = DICT(dictObj);
   872    871   
   873    872       do {
   874    873   	TclInvalidateStringRep(dictObj);
   875    874   	dict->epoch++;
   876    875   	dictObj = dict->chain;
   877    876   	if (dictObj == NULL) {
   878    877   	    break;
   879    878   	}
   880    879   	dict->chain = NULL;
   881         -	dict = dictObj->internalRep.twoPtrValue.ptr1;
          880  +	dict = DICT(dictObj);
   882    881       } while (dict != NULL);
   883    882   }
   884    883   
   885    884   /*
   886    885    *----------------------------------------------------------------------
   887    886    *
   888    887    * Tcl_DictObjPut --
................................................................................
   912    911       Tcl_HashEntry *hPtr;
   913    912       int isNew;
   914    913   
   915    914       if (Tcl_IsShared(dictPtr)) {
   916    915   	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
   917    916       }
   918    917   
   919         -    if (dictPtr->typePtr != &tclDictType) {
   920         -	int result = SetDictFromAny(interp, dictPtr);
   921         -
   922         -	if (result != TCL_OK) {
   923         -	    return result;
   924         -	}
          918  +    if (dictPtr->typePtr != &tclDictType
          919  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
          920  +	return TCL_ERROR;
   925    921       }
   926    922   
   927    923       if (dictPtr->bytes != NULL) {
   928    924   	TclInvalidateStringRep(dictPtr);
   929    925       }
   930         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
          926  +    dict = DICT(dictPtr);
   931    927       hPtr = CreateChainEntry(dict, keyPtr, &isNew);
   932    928       Tcl_IncrRefCount(valuePtr);
   933    929       if (!isNew) {
   934    930   	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
   935    931   
   936    932   	TclDecrRefCount(oldValuePtr);
   937    933       }
................................................................................
   966    962       Tcl_Obj *dictPtr,
   967    963       Tcl_Obj *keyPtr,
   968    964       Tcl_Obj **valuePtrPtr)
   969    965   {
   970    966       Dict *dict;
   971    967       Tcl_HashEntry *hPtr;
   972    968   
   973         -    if (dictPtr->typePtr != &tclDictType) {
   974         -	int result = SetDictFromAny(interp, dictPtr);
   975         -	if (result != TCL_OK) {
   976         -	    *valuePtrPtr = NULL;
   977         -	    return result;
   978         -	}
          969  +    if (dictPtr->typePtr != &tclDictType
          970  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
          971  +	*valuePtrPtr = NULL;
          972  +	return TCL_ERROR;
   979    973       }
   980    974   
   981         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
          975  +    dict = DICT(dictPtr);
   982    976       hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
   983    977       if (hPtr == NULL) {
   984    978   	*valuePtrPtr = NULL;
   985    979       } else {
   986    980   	*valuePtrPtr = Tcl_GetHashValue(hPtr);
   987    981       }
   988    982       return TCL_OK;
................................................................................
  1015   1009   {
  1016   1010       Dict *dict;
  1017   1011   
  1018   1012       if (Tcl_IsShared(dictPtr)) {
  1019   1013   	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
  1020   1014       }
  1021   1015   
  1022         -    if (dictPtr->typePtr != &tclDictType) {
  1023         -	int result = SetDictFromAny(interp, dictPtr);
  1024         -	if (result != TCL_OK) {
  1025         -	    return result;
  1026         -	}
         1016  +    if (dictPtr->typePtr != &tclDictType
         1017  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         1018  +	return TCL_ERROR;
  1027   1019       }
  1028   1020   
  1029         -    if (dictPtr->bytes != NULL) {
  1030         -	TclInvalidateStringRep(dictPtr);
  1031         -    }
  1032         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         1021  +    dict = DICT(dictPtr);
  1033   1022       if (DeleteChainEntry(dict, keyPtr)) {
         1023  +	if (dictPtr->bytes != NULL) {
         1024  +	    TclInvalidateStringRep(dictPtr);
         1025  +	}
  1034   1026   	dict->epoch++;
  1035   1027       }
  1036   1028       return TCL_OK;
  1037   1029   }
  1038   1030   
  1039   1031   /*
  1040   1032    *----------------------------------------------------------------------
................................................................................
  1058   1050   Tcl_DictObjSize(
  1059   1051       Tcl_Interp *interp,
  1060   1052       Tcl_Obj *dictPtr,
  1061   1053       int *sizePtr)
  1062   1054   {
  1063   1055       Dict *dict;
  1064   1056   
  1065         -    if (dictPtr->typePtr != &tclDictType) {
  1066         -	int result = SetDictFromAny(interp, dictPtr);
  1067         -	if (result != TCL_OK) {
  1068         -	    return result;
  1069         -	}
         1057  +    if (dictPtr->typePtr != &tclDictType
         1058  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         1059  +	return TCL_ERROR;
  1070   1060       }
  1071   1061   
  1072         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         1062  +    dict = DICT(dictPtr);
  1073   1063       *sizePtr = dict->table.numEntries;
  1074   1064       return TCL_OK;
  1075   1065   }
  1076   1066   
  1077   1067   /*
  1078   1068    *----------------------------------------------------------------------
  1079   1069    *
................................................................................
  1112   1102   				 * written into when there are no further
  1113   1103   				 * values in the dictionary, or a 0
  1114   1104   				 * otherwise. */
  1115   1105   {
  1116   1106       Dict *dict;
  1117   1107       ChainEntry *cPtr;
  1118   1108   
  1119         -    if (dictPtr->typePtr != &tclDictType) {
  1120         -	int result = SetDictFromAny(interp, dictPtr);
  1121         -
  1122         -	if (result != TCL_OK) {
  1123         -	    return result;
  1124         -	}
         1109  +    if (dictPtr->typePtr != &tclDictType
         1110  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         1111  +	return TCL_ERROR;
  1125   1112       }
  1126   1113   
  1127         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         1114  +    dict = DICT(dictPtr);
  1128   1115       cPtr = dict->entryChainHead;
  1129   1116       if (cPtr == NULL) {
  1130   1117   	searchPtr->epoch = -1;
  1131   1118   	*donePtr = 1;
  1132   1119       } else {
  1133   1120   	*donePtr = 0;
  1134   1121   	searchPtr->dictionaryPtr = (Tcl_Dict) dict;
................................................................................
  1295   1282       }
  1296   1283   
  1297   1284       dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
  1298   1285       if (dictPtr == NULL) {
  1299   1286   	return TCL_ERROR;
  1300   1287       }
  1301   1288   
  1302         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         1289  +    dict = DICT(dictPtr);
  1303   1290       hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
  1304   1291       Tcl_IncrRefCount(valuePtr);
  1305   1292       if (!isNew) {
  1306   1293   	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
         1294  +
  1307   1295   	TclDecrRefCount(oldValuePtr);
  1308   1296       }
  1309   1297       Tcl_SetHashValue(hPtr, valuePtr);
  1310   1298       InvalidateDictChain(dictPtr);
  1311   1299   
  1312   1300       return TCL_OK;
  1313   1301   }
................................................................................
  1351   1339       }
  1352   1340   
  1353   1341       dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
  1354   1342       if (dictPtr == NULL) {
  1355   1343   	return TCL_ERROR;
  1356   1344       }
  1357   1345   
  1358         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         1346  +    dict = DICT(dictPtr);
  1359   1347       DeleteChainEntry(dict, keyv[keyc-1]);
  1360   1348       InvalidateDictChain(dictPtr);
  1361   1349       return TCL_OK;
  1362   1350   }
  1363   1351   
  1364   1352   /*
  1365   1353    *----------------------------------------------------------------------
................................................................................
  1397   1385       TclNewObj(dictPtr);
  1398   1386       TclInvalidateStringRep(dictPtr);
  1399   1387       dict = ckalloc(sizeof(Dict));
  1400   1388       InitChainTable(dict);
  1401   1389       dict->epoch = 0;
  1402   1390       dict->chain = NULL;
  1403   1391       dict->refcount = 1;
  1404         -    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
         1392  +    DICT(dictPtr) = dict;
  1405   1393       dictPtr->typePtr = &tclDictType;
  1406   1394       return dictPtr;
  1407   1395   #endif
  1408   1396   }
  1409   1397   
  1410   1398   /*
  1411   1399    *----------------------------------------------------------------------
................................................................................
  1446   1434       TclDbNewObj(dictPtr, file, line);
  1447   1435       TclInvalidateStringRep(dictPtr);
  1448   1436       dict = ckalloc(sizeof(Dict));
  1449   1437       InitChainTable(dict);
  1450   1438       dict->epoch = 0;
  1451   1439       dict->chain = NULL;
  1452   1440       dict->refcount = 1;
  1453         -    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
         1441  +    DICT(dictPtr) = dict;
  1454   1442       dictPtr->typePtr = &tclDictType;
  1455   1443       return dictPtr;
  1456   1444   #else /* !TCL_MEM_DEBUG */
  1457   1445       return Tcl_NewDictObj();
  1458   1446   #endif
  1459   1447   }
  1460   1448   
................................................................................
  1500   1488       }
  1501   1489   
  1502   1490       dictObj = Tcl_NewDictObj();
  1503   1491       for (i=1 ; i<objc ; i+=2) {
  1504   1492   	/*
  1505   1493   	 * The next command is assumed to never fail...
  1506   1494   	 */
  1507         -	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
         1495  +	Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
  1508   1496       }
  1509   1497       Tcl_SetObjResult(interp, dictObj);
  1510   1498       return TCL_OK;
  1511   1499   }
  1512   1500   
  1513   1501   /*
  1514   1502    *----------------------------------------------------------------------
................................................................................
  1625   1613   DictReplaceCmd(
  1626   1614       ClientData dummy,
  1627   1615       Tcl_Interp *interp,
  1628   1616       int objc,
  1629   1617       Tcl_Obj *const *objv)
  1630   1618   {
  1631   1619       Tcl_Obj *dictPtr;
  1632         -    int i, result;
  1633         -    int allocatedDict = 0;
         1620  +    int i;
  1634   1621   
  1635   1622       if ((objc < 2) || (objc & 1)) {
  1636   1623   	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
  1637   1624   	return TCL_ERROR;
  1638   1625       }
  1639   1626   
  1640   1627       dictPtr = objv[1];
         1628  +    if (dictPtr->typePtr != &tclDictType
         1629  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         1630  +	return TCL_ERROR;
         1631  +    }
  1641   1632       if (Tcl_IsShared(dictPtr)) {
  1642   1633   	dictPtr = Tcl_DuplicateObj(dictPtr);
  1643         -	allocatedDict = 1;
         1634  +    }
         1635  +    if (dictPtr->bytes != NULL) {
         1636  +	TclInvalidateStringRep(dictPtr);
  1644   1637       }
  1645   1638       for (i=2 ; i<objc ; i+=2) {
  1646         -	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
  1647         -	if (result != TCL_OK) {
  1648         -	    if (allocatedDict) {
  1649         -		TclDecrRefCount(dictPtr);
  1650         -	    }
  1651         -	    return TCL_ERROR;
  1652         -	}
         1639  +	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
  1653   1640       }
  1654   1641       Tcl_SetObjResult(interp, dictPtr);
  1655   1642       return TCL_OK;
  1656   1643   }
  1657   1644   
  1658   1645   /*
  1659   1646    *----------------------------------------------------------------------
................................................................................
  1677   1664   DictRemoveCmd(
  1678   1665       ClientData dummy,
  1679   1666       Tcl_Interp *interp,
  1680   1667       int objc,
  1681   1668       Tcl_Obj *const *objv)
  1682   1669   {
  1683   1670       Tcl_Obj *dictPtr;
  1684         -    int i, result;
  1685         -    int allocatedDict = 0;
         1671  +    int i;
  1686   1672   
  1687   1673       if (objc < 2) {
  1688   1674   	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
  1689   1675   	return TCL_ERROR;
  1690   1676       }
  1691   1677   
  1692   1678       dictPtr = objv[1];
         1679  +    if (dictPtr->typePtr != &tclDictType
         1680  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         1681  +	return TCL_ERROR;
         1682  +    }
  1693   1683       if (Tcl_IsShared(dictPtr)) {
  1694   1684   	dictPtr = Tcl_DuplicateObj(dictPtr);
  1695         -	allocatedDict = 1;
         1685  +    }
         1686  +    if (dictPtr->bytes != NULL) {
         1687  +	TclInvalidateStringRep(dictPtr);
  1696   1688       }
  1697   1689       for (i=2 ; i<objc ; i++) {
  1698         -	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
  1699         -	if (result != TCL_OK) {
  1700         -	    if (allocatedDict) {
  1701         -		TclDecrRefCount(dictPtr);
  1702         -	    }
  1703         -	    return TCL_ERROR;
  1704         -	}
         1690  +	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
  1705   1691       }
  1706   1692       Tcl_SetObjResult(interp, dictPtr);
  1707   1693       return TCL_OK;
  1708   1694   }
  1709   1695   
  1710   1696   /*
  1711   1697    *----------------------------------------------------------------------
................................................................................
  1746   1732       }
  1747   1733   
  1748   1734       /*
  1749   1735        * Make sure first argument is a dictionary.
  1750   1736        */
  1751   1737   
  1752   1738       targetObj = objv[1];
  1753         -    if (targetObj->typePtr != &tclDictType) {
  1754         -	if (SetDictFromAny(interp, targetObj) != TCL_OK) {
  1755         -	    return TCL_ERROR;
  1756         -	}
         1739  +    if (targetObj->typePtr != &tclDictType
         1740  +	    && SetDictFromAny(interp, targetObj) != TCL_OK) {
         1741  +	return TCL_ERROR;
  1757   1742       }
  1758   1743   
  1759   1744       if (objc == 2) {
  1760   1745   	/*
  1761   1746   	 * Single argument, return it.
  1762   1747   	 */
  1763   1748   
................................................................................
  1831   1816   
  1832   1817       /*
  1833   1818        * A direct check that we have a dictionary. We don't start the iteration
  1834   1819        * yet because that might allocate memory or set locks that we do not
  1835   1820        * need. [Bug 1705778, leak K04]
  1836   1821        */
  1837   1822   
  1838         -    if (objv[1]->typePtr != &tclDictType) {
  1839         -	int result = SetDictFromAny(interp, objv[1]);
  1840         -
  1841         -	if (result != TCL_OK) {
  1842         -	    return result;
  1843         -	}
         1823  +    if (objv[1]->typePtr != &tclDictType
         1824  +	    && SetDictFromAny(interp, objv[1]) != TCL_OK) {
         1825  +	return TCL_ERROR;
  1844   1826       }
  1845   1827   
  1846   1828       if (objc == 3) {
  1847   1829   	pattern = TclGetString(objv[2]);
  1848   1830       }
  1849   1831       listPtr = Tcl_NewListObj(0, NULL);
  1850   1832       if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
................................................................................
  2052   2034   
  2053   2035       if (objc != 2) {
  2054   2036   	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
  2055   2037   	return TCL_ERROR;
  2056   2038       }
  2057   2039   
  2058   2040       dictPtr = objv[1];
  2059         -    if (dictPtr->typePtr != &tclDictType) {
  2060         -	int result = SetDictFromAny(interp, dictPtr);
  2061         -	if (result != TCL_OK) {
  2062         -	    return result;
  2063         -	}
         2041  +    if (dictPtr->typePtr != &tclDictType
         2042  +	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
         2043  +	return TCL_ERROR;
  2064   2044       }
  2065         -    dict = dictPtr->internalRep.twoPtrValue.ptr1;
         2045  +    dict = DICT(dictPtr);
  2066   2046   
  2067   2047       statsStr = Tcl_HashStats(&dict->table);
  2068   2048       Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
  2069   2049       ckfree(statsStr);
  2070   2050       return TCL_OK;
  2071   2051   }
  2072   2052   
................................................................................
  2148   2128   	    } else {
  2149   2129   		/*
  2150   2130   		 * Remember to dispose with the bignum as we're not actually
  2151   2131   		 * using it directly. [Bug 2874678]
  2152   2132   		 */
  2153   2133   
  2154   2134   		mp_clear(&increment);
  2155         -		Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
         2135  +		Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
  2156   2136   	    }
  2157   2137   	} else {
  2158         -	    Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
         2138  +	    Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1));
  2159   2139   	}
  2160   2140       } else {
  2161   2141   	/*
  2162   2142   	 * Key in dictionary. Increment its value with minimum dup.
  2163   2143   	 */
  2164   2144   
  2165   2145   	if (Tcl_IsShared(valuePtr)) {
  2166   2146   	    valuePtr = Tcl_DuplicateObj(valuePtr);
  2167         -	    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
         2147  +	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
  2168   2148   	}
  2169   2149   	if (objc == 4) {
  2170   2150   	    code = TclIncrObj(interp, valuePtr, objv[3]);
  2171   2151   	} else {
  2172   2152   	    Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
  2173   2153   
  2174   2154   	    Tcl_IncrRefCount(incrPtr);
  2175   2155   	    code = TclIncrObj(interp, valuePtr, incrPtr);
  2176         -	    Tcl_DecrRefCount(incrPtr);
         2156  +	    TclDecrRefCount(incrPtr);
  2177   2157   	}
  2178   2158       }
  2179   2159       if (code == TCL_OK) {
  2180   2160   	TclInvalidateStringRep(dictPtr);
  2181   2161   	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
  2182   2162   		dictPtr, TCL_LEAVE_ERR_MSG);
  2183   2163   	if (valuePtr == NULL) {
  2184   2164   	    code = TCL_ERROR;
  2185   2165   	} else {
  2186   2166   	    Tcl_SetObjResult(interp, valuePtr);
  2187   2167   	}
  2188   2168       } else if (dictPtr->refCount == 0) {
  2189         -	Tcl_DecrRefCount(dictPtr);
         2169  +	TclDecrRefCount(dictPtr);
  2190   2170       }
  2191   2171       return code;
  2192   2172   }
  2193   2173   
  2194   2174   /*
  2195   2175    *----------------------------------------------------------------------
  2196   2176    *
................................................................................
  2260   2240   		}
  2261   2241   		return TCL_ERROR;
  2262   2242   	    }
  2263   2243   	}
  2264   2244       }
  2265   2245   
  2266   2246       if (allocatedValue) {
  2267         -	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
         2247  +	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
  2268   2248       } else if (dictPtr->bytes != NULL) {
  2269   2249   	TclInvalidateStringRep(dictPtr);
  2270   2250       }
  2271   2251   
  2272   2252       resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
  2273   2253   	    TCL_LEAVE_ERR_MSG);
  2274   2254       if (resultPtr == NULL) {
................................................................................
  2325   2305   	    TclDecrRefCount(dictPtr);
  2326   2306   	}
  2327   2307   	return TCL_ERROR;
  2328   2308       }
  2329   2309   
  2330   2310       if (valuePtr == NULL) {
  2331   2311   	TclNewObj(valuePtr);
  2332         -    } else {
  2333         -	if (Tcl_IsShared(valuePtr)) {
  2334         -	    valuePtr = Tcl_DuplicateObj(valuePtr);
  2335         -	}
         2312  +    } else if (Tcl_IsShared(valuePtr)) {
         2313  +	valuePtr = Tcl_DuplicateObj(valuePtr);
  2336   2314       }
  2337   2315   
  2338   2316       for (i=3 ; i<objc ; i++) {
  2339   2317   	Tcl_AppendObjToObj(valuePtr, objv[i]);
  2340   2318       }
  2341   2319   
  2342         -    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
         2320  +    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
  2343   2321   
  2344   2322       resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
  2345   2323   	    TCL_LEAVE_ERR_MSG);
  2346   2324       if (resultPtr == NULL) {
  2347   2325   	return TCL_ERROR;
  2348   2326       }
  2349   2327       Tcl_SetObjResult(interp, resultPtr);
................................................................................
  2393   2371   
  2394   2372       if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
  2395   2373   	return TCL_ERROR;
  2396   2374       }
  2397   2375       if (varc != 2) {
  2398   2376   	Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2399   2377   		"must have exactly two variable names", -1));
         2378  +	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
  2400   2379   	return TCL_ERROR;
  2401   2380       }
  2402   2381       searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
  2403   2382       if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
  2404   2383   	    &done) != TCL_OK) {
  2405   2384   	TclStackFree(interp, searchPtr);
  2406   2385   	return TCL_ERROR;
................................................................................
  2426   2405   
  2427   2406       /*
  2428   2407        * Stop the value from getting hit in any way by any traces on the key
  2429   2408        * variable.
  2430   2409        */
  2431   2410   
  2432   2411       Tcl_IncrRefCount(valueObj);
  2433         -    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
         2412  +    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
         2413  +	    TCL_LEAVE_ERR_MSG) == NULL) {
  2434   2414   	TclDecrRefCount(valueObj);
  2435   2415   	goto error;
  2436   2416       }
  2437   2417       TclDecrRefCount(valueObj);
  2438         -    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
         2418  +    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
         2419  +	    TCL_LEAVE_ERR_MSG) == NULL) {
  2439   2420   	goto error;
  2440   2421       }
  2441   2422   
  2442   2423       /*
  2443   2424        * Run the script.
  2444   2425        */
  2445   2426   
................................................................................
  2584   2565   
  2585   2566       if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
  2586   2567   	return TCL_ERROR;
  2587   2568       }
  2588   2569       if (varc != 2) {
  2589   2570   	Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2590   2571   		"must have exactly two variable names", -1));
         2572  +	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
  2591   2573   	return TCL_ERROR;
  2592   2574       }
  2593   2575       storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
  2594   2576       if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
  2595   2577   	    &valueObj, &done) != TCL_OK) {
  2596   2578   	TclStackFree(interp, storagePtr);
  2597   2579   	return TCL_ERROR;
................................................................................
  2945   2927   		 * since we are not exhausing the search. [Bug 1705778, leak
  2946   2928   		 * K05]
  2947   2929   		 */
  2948   2930   
  2949   2931   		Tcl_DictObjDone(&search);
  2950   2932   		Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
  2951   2933   		if (valueObj != NULL) {
  2952         -		    Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
         2934  +		    Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj);
  2953   2935   		}
  2954   2936   	    } else {
  2955   2937   		while (!done) {
  2956   2938   		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
  2957         -			Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
         2939  +			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
  2958   2940   		    }
  2959   2941   		    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
  2960   2942   		}
  2961   2943   	    }
  2962   2944   	} else {
  2963   2945   	    /*
  2964   2946   	     * Can't optimize this match for trivial globbing: would disturb
................................................................................
  2968   2950   	    resultObj = Tcl_NewDictObj();
  2969   2951   	    while (!done) {
  2970   2952   		int i;
  2971   2953   
  2972   2954   		for (i=3 ; i<objc ; i++) {
  2973   2955   		    pattern = TclGetString(objv[i]);
  2974   2956   		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
  2975         -			Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
         2957  +			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
  2976   2958   			break;		/* stop inner loop */
  2977   2959   		    }
  2978   2960   		}
  2979   2961   		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
  2980   2962   	    }
  2981   2963   	}
  2982   2964   	Tcl_SetObjResult(interp, resultObj);
................................................................................
  2994   2976   	resultObj = Tcl_NewDictObj();
  2995   2977   	while (!done) {
  2996   2978   	    int i;
  2997   2979   
  2998   2980   	    for (i=3 ; i<objc ; i++) {
  2999   2981   		pattern = TclGetString(objv[i]);
  3000   2982   		if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
  3001         -		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
         2983  +		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
  3002   2984   		    break;		/* stop inner loop */
  3003   2985   		}
  3004   2986   	    }
  3005   2987   	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
  3006   2988   	}
  3007   2989   	Tcl_SetObjResult(interp, resultObj);
  3008   2990   	return TCL_OK;
................................................................................
  3022   3004   
  3023   3005   	if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
  3024   3006   	    return TCL_ERROR;
  3025   3007   	}
  3026   3008   	if (varc != 2) {
  3027   3009   	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  3028   3010   		    "must have exactly two variable names", -1));
         3011  +	    Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
  3029   3012   	    return TCL_ERROR;
  3030   3013   	}
  3031   3014   	keyVarObj = varv[0];
  3032   3015   	valueVarObj = varv[1];
  3033   3016   	scriptObj = objv[4];
  3034   3017   
  3035   3018   	/*
................................................................................
  3060   3043   	     * key variable.
  3061   3044   	     */
  3062   3045   
  3063   3046   	    Tcl_IncrRefCount(keyObj);
  3064   3047   	    Tcl_IncrRefCount(valueObj);
  3065   3048   	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
  3066   3049   		    TCL_LEAVE_ERR_MSG) == NULL) {
  3067         -		Tcl_ResetResult(interp);
  3068         -		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  3069         -			"couldn't set key variable: \"%s\"",
  3070         -			TclGetString(keyVarObj)));
         3050  +		Tcl_AddErrorInfo(interp, 
         3051  +			"\n    (\"dict filter\" filter script key variable)");
  3071   3052   		result = TCL_ERROR;
  3072   3053   		goto abnormalResult;
  3073   3054   	    }
  3074   3055   	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
  3075   3056   		    TCL_LEAVE_ERR_MSG) == NULL) {
  3076         -		Tcl_ResetResult(interp);
  3077         -		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  3078         -			"couldn't set value variable: \"%s\"",
  3079         -			TclGetString(valueVarObj)));
         3057  +		Tcl_AddErrorInfo(interp, 
         3058  +			"\n    (\"dict filter\" filter script value variable)");
  3080   3059   		result = TCL_ERROR;
  3081   3060   		goto abnormalResult;
  3082   3061   	    }
  3083   3062   
  3084   3063   	    /*
  3085   3064   	     * TIP #280. Make invoking context available to loop body.
  3086   3065   	     */
................................................................................
  3095   3074   			&satisfied) != TCL_OK) {
  3096   3075   		    TclDecrRefCount(boolObj);
  3097   3076   		    result = TCL_ERROR;
  3098   3077   		    goto abnormalResult;
  3099   3078   		}
  3100   3079   		TclDecrRefCount(boolObj);
  3101   3080   		if (satisfied) {
  3102         -		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
         3081  +		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
  3103   3082   		}
  3104   3083   		break;
  3105   3084   	    case TCL_BREAK:
  3106   3085   		/*
  3107   3086   		 * Force loop termination by calling Tcl_DictObjDone; this
  3108   3087   		 * makes the next Tcl_DictObjNext say there is nothing more to
  3109   3088   		 * do.
................................................................................
  3283   3262        * an instruction to remove the key.
  3284   3263        */
  3285   3264   
  3286   3265       Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
  3287   3266       for (i=0 ; i<objc ; i+=2) {
  3288   3267   	objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
  3289   3268   	if (objPtr == NULL) {
  3290         -	    Tcl_DictObjRemove(interp, dictPtr, objv[i]);
         3269  +	    Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
  3291   3270   	} else if (objPtr == dictPtr) {
  3292   3271   	    /*
  3293   3272   	     * Someone is messing us around, trying to build a recursive
  3294   3273   	     * structure. [Bug 1786481]
  3295   3274   	     */
  3296   3275   
  3297         -	    Tcl_DictObjPut(interp, dictPtr, objv[i],
  3298         -		    Tcl_DuplicateObj(objPtr));
         3276  +	    Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
  3299   3277   	} else {
  3300   3278   	    /* Shouldn't fail */
  3301         -	    Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
         3279  +	    Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
  3302   3280   	}
  3303   3281       }
  3304   3282       TclDecrRefCount(argsObj);
  3305   3283   
  3306   3284       /*
  3307   3285        * Write the dictionary back to its variable.
  3308   3286        */

Changes to generic/tclInt.h.

  2877   2877   			    int start, int *clNext);
  2878   2878   MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
  2879   2879   MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
  2880   2880   			    Tcl_Obj *originObjPtr);
  2881   2881   MODULE_SCOPE int	TclConvertElement(const char *src, int length,
  2882   2882   			    char *dst, int flags);
  2883   2883   MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
         2884  +MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
         2885  +			    const char *dict, int dictLength,
         2886  +			    const char **elementPtr, const char **nextPtr,
         2887  +			    int *sizePtr, int *literalPtr);
  2884   2888   /* TIP #280 - Modified token based evulation, with line information. */
  2885   2889   MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
  2886   2890   			    int numBytes, int flags, int line,
  2887   2891   			    int *clNextOuter, const char *outerScript);
  2888   2892   MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
  2889   2893   MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
  2890   2894   MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;

Changes to generic/tclUtil.c.

   107    107   static void		ClearHash(Tcl_HashTable *tablePtr);
   108    108   static void		FreeProcessGlobalValue(ClientData clientData);
   109    109   static void		FreeThreadHash(ClientData clientData);
   110    110   static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
   111    111   static int		SetEndOffsetFromAny(Tcl_Interp *interp,
   112    112   			    Tcl_Obj *objPtr);
   113    113   static void		UpdateStringOfEndOffset(Tcl_Obj *objPtr);
   114         -
          114  +static int		FindElement(Tcl_Interp *interp, const char *string,
          115  +			    int stringLength, const char *typeStr,
          116  +			    const char *typeCode, const char **elementPtr,
          117  +			    const char **nextPtr, int *sizePtr,
          118  +			    int *literalPtr);
   115    119   /*
   116    120    * The following is the Tcl object type definition for an object that
   117    121    * represents a list index in the form, "end-offset". It is used as a
   118    122    * performance optimization in TclGetIntForIndex. The internal rep is an
   119    123    * integer, so no memory management is required for it.
   120    124    */
   121    125   
................................................................................
   233    237    *
   234    238    *   NOTE: Any element value can be represented by this style of formatting,
   235    239    *   given suitable choice of backslash escape sequences, with one exception.
   236    240    *   The empty string cannot be represented as a list element without the use
   237    241    *   of either braces or quotes to delimit it.
   238    242    *
   239    243    * This collection of parsing rules is implemented in the routine
   240         - * TclFindElement().
          244  + * FindElement().
   241    245    *
   242    246    * In order to produce lists that can be parsed by these rules, we need the
   243    247    * ability to distinguish between characters that are part of a list element
   244    248    * value from characters providing syntax that define the structure of the
   245    249    * list. This means that our code that generates lists must at a minimum be
   246    250    * able to produce escape sequences for the 10 characters identified above
   247    251    * that have significance to a list parser.
................................................................................
   501    505       int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
   502    506   				 * indicate that the substring of *sizePtr
   503    507   				 * bytes starting at **elementPtr is/is not
   504    508   				 * the literal list element and therefore
   505    509   				 * does not/does require a call to 
   506    510   				 * TclCopyAndCollapse() by the caller. */
   507    511   {
   508         -    const char *p = list;
          512  +    return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
          513  +	    nextPtr, sizePtr, literalPtr);
          514  +}
          515  +
          516  +int
          517  +TclFindDictElement(
          518  +    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
          519  +				 * NULL, then no error message is left after
          520  +				 * errors. */
          521  +    const char *dict,		/* Points to the first byte of a string
          522  +				 * containing a Tcl dictionary with zero or
          523  +				 * more keys and values (possibly in
          524  +				 * braces). */
          525  +    int dictLength,		/* Number of bytes in the dict's string. */
          526  +    const char **elementPtr,	/* Where to put address of first significant
          527  +				 * character in the first element (i.e., key
          528  +				 * or value) of dict. */
          529  +    const char **nextPtr,	/* Fill in with location of character just
          530  +				 * after all white space following end of
          531  +				 * element (next arg or end of list). */
          532  +    int *sizePtr,		/* If non-zero, fill in with size of
          533  +				 * element. */
          534  +    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
          535  +				 * indicate that the substring of *sizePtr
          536  +				 * bytes starting at **elementPtr is/is not
          537  +				 * the literal key or value and therefore
          538  +				 * does not/does require a call to 
          539  +				 * TclCopyAndCollapse() by the caller. */
          540  +{
          541  +    return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
          542  +	    elementPtr, nextPtr, sizePtr, literalPtr);
          543  +}
          544  +
          545  +static int
          546  +FindElement(
          547  +    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
          548  +				 * NULL, then no error message is left after
          549  +				 * errors. */
          550  +    const char *string,		/* Points to the first byte of a string
          551  +				 * containing a Tcl list or dictionary with
          552  +				 * zero or more elements (possibly in
          553  +				 * braces). */
          554  +    int stringLength,		/* Number of bytes in the string. */
          555  +    const char *typeStr,	/* The name of the type of thing we are
          556  +				 * parsing, for error messages. */
          557  +    const char *typeCode,	/* The type code for thing we are parsing, for
          558  +				 * error messages. */
          559  +    const char **elementPtr,	/* Where to put address of first significant
          560  +				 * character in first element. */
          561  +    const char **nextPtr,	/* Fill in with location of character just
          562  +				 * after all white space following end of
          563  +				 * argument (next arg or end of list/dict). */
          564  +    int *sizePtr,		/* If non-zero, fill in with size of
          565  +				 * element. */
          566  +    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
          567  +				 * indicate that the substring of *sizePtr
          568  +				 * bytes starting at **elementPtr is/is not
          569  +				 * the literal list/dict element and therefore
          570  +				 * does not/does require a call to 
          571  +				 * TclCopyAndCollapse() by the caller. */
          572  +{
          573  +    const char *p = string;
   509    574       const char *elemStart;	/* Points to first byte of first element. */
   510         -    const char *limit;		/* Points just after list's last byte. */
          575  +    const char *limit;		/* Points just after list/dict's last byte. */
   511    576       int openBraces = 0;		/* Brace nesting level during parse. */
   512    577       int inQuotes = 0;
   513    578       int size = 0;		/* lint. */
   514    579       int numChars;
   515    580       int literal = 1;
   516    581       const char *p2;
   517    582   
   518    583       /*
   519    584        * Skim off leading white space and check for an opening brace or quote.
   520         -     * We treat embedded NULLs in the list as bytes belonging to a list
   521         -     * element.
          585  +     * We treat embedded NULLs in the list/dict as bytes belonging to a list 
          586  +     * element (or dictionary key or value).
   522    587        */
   523    588   
   524         -    limit = (list + listLength);
          589  +    limit = (string + stringLength);
   525    590       while ((p < limit) && (TclIsSpaceProc(*p))) {
   526    591   	p++;
   527    592       }
   528    593       if (p == limit) {		/* no element found */
   529    594   	elemStart = limit;
   530    595   	goto done;
   531    596       }
................................................................................
   578    643   		if (interp != NULL) {
   579    644   		    p2 = p;
   580    645   		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
   581    646   			    && (p2 < p+20)) {
   582    647   			p2++;
   583    648   		    }
   584    649   		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
   585         -			    "list element in braces followed by \"%.*s\" "
   586         -			    "instead of space", (int) (p2-p), p));
   587         -		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
          650  +			    "%s element in braces followed by \"%.*s\" "
          651  +			    "instead of space", typeStr, (int) (p2-p), p));
          652  +		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
   588    653   			    NULL);
   589    654   		}
   590    655   		return TCL_ERROR;
   591    656   	    }
   592    657   	    break;
   593    658   
   594    659   	    /*
................................................................................
   647    712   		if (interp != NULL) {
   648    713   		    p2 = p;
   649    714   		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
   650    715   			    && (p2 < p+20)) {
   651    716   			p2++;
   652    717   		    }
   653    718   		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
   654         -			    "list element in quotes followed by \"%.*s\" "
   655         -			    "instead of space", (int) (p2-p), p));
   656         -		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
          719  +			    "%s element in quotes followed by \"%.*s\" "
          720  +			    "instead of space", typeStr, (int) (p2-p), p));
          721  +		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
   657    722   			    NULL);
   658    723   		}
   659    724   		return TCL_ERROR;
   660    725   	    }
   661    726   	    break;
   662    727   	}
   663    728   	p++;
   664    729       }
   665    730   
   666    731       /*
   667         -     * End of list: terminate element.
          732  +     * End of list/dict: terminate element.
   668    733        */
   669    734   
   670    735       if (p == limit) {
   671    736   	if (openBraces != 0) {
   672    737   	    if (interp != NULL) {
   673         -		Tcl_SetObjResult(interp, Tcl_NewStringObj(
   674         -			"unmatched open brace in list", -1));
   675         -		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
          738  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          739  +			"unmatched open brace in %s", typeStr));
          740  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
   676    741   			NULL);
   677    742   	    }
   678    743   	    return TCL_ERROR;
   679    744   	} else if (inQuotes) {
   680    745   	    if (interp != NULL) {
   681         -		Tcl_SetObjResult(interp, Tcl_NewStringObj(
   682         -			"unmatched open quote in list", -1));
   683         -		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
          746  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          747  +			"unmatched open quote in %s", typeStr));
          748  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
   684    749   			NULL);
   685    750   	    }
   686    751   	    return TCL_ERROR;
   687    752   	}
   688    753   	size = (p - elemStart);
   689    754       }
   690    755   

Changes to tests/dict.test.

   163    163       dict replace {a a a} a b
   164    164   } -result {missing value to go with key}
   165    165   test dict-4.8 {dict replace command} -returnCodes error -body {
   166    166       dict replace [list a a a] a b
   167    167   } -result {missing value to go with key}
   168    168   test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
   169    169   test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
          170  +test dict-4.11 {dict replace command: canonicality is forced} {
          171  +    dict replace { a b  c d }
          172  +} {a b c d}
          173  +test dict-4.12 {dict replace command: canonicality is forced} {
          174  +    dict replace {a b c d a e}
          175  +} {a e c d}
          176  +test dict-4.13 {dict replace command: type check is mandatory} -body {
          177  +    dict replace { a b c d e }
          178  +} -returnCodes error -result {missing value to go with key}
          179  +test dict-4.13a {dict replace command: type check is mandatory} {
          180  +    catch {dict replace { a b c d e }} -> opt
          181  +    dict get $opt -errorcode
          182  +} {TCL VALUE DICTIONARY}
          183  +test dict-4.14 {dict replace command: type check is mandatory} -body {
          184  +    dict replace { a b {}c d }
          185  +} -returnCodes error -result {dict element in braces followed by "c" instead of space}
          186  +test dict-4.14a {dict replace command: type check is mandatory} {
          187  +    catch {dict replace { a b {}c d }} -> opt
          188  +    dict get $opt -errorcode
          189  +} {TCL VALUE DICTIONARY JUNK}
          190  +test dict-4.15 {dict replace command: type check is mandatory} -body {
          191  +    dict replace { a b ""c d }
          192  +} -returnCodes error -result {dict element in quotes followed by "c" instead of space}
          193  +test dict-4.15a {dict replace command: type check is mandatory} {
          194  +    catch {dict replace { a b ""c d }} -> opt
          195  +    dict get $opt -errorcode
          196  +} {TCL VALUE DICTIONARY JUNK}
          197  +test dict-4.16 {dict replace command: type check is mandatory} -body {
          198  +    dict replace " a b \"c d "
          199  +} -returnCodes error -result {unmatched open quote in dict}
          200  +test dict-4.16a {dict replace command: type check is mandatory} {
          201  +    catch {dict replace " a b \"c d "} -> opt
          202  +    dict get $opt -errorcode
          203  +} {TCL VALUE DICTIONARY QUOTE}
          204  +test dict-4.17 {dict replace command: type check is mandatory} -body {
          205  +    dict replace " a b \{c d "
          206  +} -returnCodes error -result {unmatched open brace in dict}
          207  +test dict-4.17a {dict replace command: type check is mandatory} {
          208  +    catch {dict replace " a b \{c d "} -> opt
          209  +    dict get $opt -errorcode
          210  +} {TCL VALUE DICTIONARY BRACE}
          211  +test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
          212  +    set example { a b  c d }
          213  +    list $example [dict replace $example]
          214  +} {{ a b  c d } {a b c d}}
   170    215   
   171    216   test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
   172    217   test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
   173    218   test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
   174    219   test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
   175    220   test dict-5.5 {dict remove command} {
   176    221       dict remove {a b c d}
   177    222   } {a b c d}
   178    223   test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
   179    224   test dict-5.7 {dict remove command} -returnCodes error -body {
   180    225       dict remove
   181    226   } -result {wrong # args: should be "dict remove dictionary ?key ...?"}
          227  +test dict-5.8 {dict remove command: canonicality is forced} {
          228  +    dict remove { a b  c d }
          229  +} {a b c d}
          230  +test dict-5.9 {dict remove command: canonicality is forced} {
          231  +    dict remove {a b c d a e}
          232  +} {a e c d}
          233  +test dict-5.10 {dict remove command: canonicality forced by update} {
          234  +    dict remove { a b c d } c
          235  +} {a b}
          236  +test dict-5.11 {dict remove command: type check is mandatory} -body {
          237  +    dict remove { a b c d e }
          238  +} -returnCodes error -result {missing value to go with key}
          239  +test dict-5.12 {dict remove command: type check is mandatory} -body {
          240  +    dict remove { a b {}c d }
          241  +} -returnCodes error -result {dict element in braces followed by "c" instead of space}
          242  +test dict-5.13 {dict remove command: canonicality forcing doesn't leak} {
          243  +    set example { a b  c d }
          244  +    list $example [dict remove $example]
          245  +} {{ a b  c d } {a b c d}}
   182    246   
   183    247   test dict-6.1 {dict keys command} {dict keys {a b}} a
   184    248   test dict-6.2 {dict keys command} {dict keys {c d}} c
   185    249   test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c}
   186    250   test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
   187    251   test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
   188    252   test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
................................................................................
  1222   1286   } {a x c y}
  1223   1287   test dict-20.19 {dict merge command} {
  1224   1288       apply {{} {dict merge {a b c d} {c y a x}}}
  1225   1289   } {a x c y}
  1226   1290   test dict-20.20 {dict merge command} {
  1227   1291       apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
  1228   1292   } {a - c d e f 1 - 3 4}
         1293  +test dict-20.21 {dict merge command: canonicality not forced} {
         1294  +    dict merge { a b c d }
         1295  +} { a b c d }
         1296  +test dict-20.22 {dict merge command: canonicality not forced} {
         1297  +    dict merge { a b c d } {}
         1298  +} { a b c d }
         1299  +test dict-20.23 {dict merge command: canonicality forced by update} {
         1300  +    dict merge { a b c d } {a b}
         1301  +} {a b c d}
         1302  +test dict-20.24 {dict merge command: type check is mandatory} -body {
         1303  +    dict merge { a b c d e }
         1304  +} -returnCodes error -result {missing value to go with key}
         1305  +test dict-20.25 {dict merge command: type check is mandatory} -body {
         1306  +    dict merge { a b {}c d }
         1307  +} -returnCodes error -result {dict element in braces followed by "c" instead of space}
  1229   1308   
  1230   1309   test dict-21.1 {dict update command} -returnCodes 1 -body {
  1231   1310       dict update
  1232   1311   } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
  1233   1312   test dict-21.2 {dict update command} -returnCodes 1 -body {
  1234   1313       dict update v
  1235   1314   } -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}