summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2024-05-26 10:04:31 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2024-05-26 10:04:31 (GMT)
commit1c8e57af313b8a648e803d05a8563cb16c1beec7 (patch)
tree24247fd5b7f78a183bfb1e4786c926d93d5378a7
parenta5d90257c2e0558387e24753ee7bfb86cbf4f353 (diff)
parent872c04a64adaa412f6b8684bb024d000d11a1650 (diff)
downloadtcl-1c8e57af313b8a648e803d05a8563cb16c1beec7.zip
tcl-1c8e57af313b8a648e803d05a8563cb16c1beec7.tar.gz
tcl-1c8e57af313b8a648e803d05a8563cb16c1beec7.tar.bz2
More C functions for working with dicts [656fe3c816]
-rw-r--r--generic/tclCmdMZ.c6
-rw-r--r--generic/tclCompCmds.c15
-rw-r--r--generic/tclCompCmdsSZ.c5
-rw-r--r--generic/tclConfig.c2
-rw-r--r--generic/tclDictObj.c147
-rw-r--r--generic/tclDisassemble.c50
-rw-r--r--generic/tclEncoding.c11
-rw-r--r--generic/tclEnsemble.c5
-rw-r--r--generic/tclEvent.c30
-rw-r--r--generic/tclIOCmd.c3
-rw-r--r--generic/tclInt.h8
-rw-r--r--generic/tclInterp.c41
-rw-r--r--generic/tclMain.c8
-rw-r--r--generic/tclOOInfo.c6
-rw-r--r--generic/tclZlib.c48
15 files changed, 237 insertions, 148 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 41782b0..a6e9ffd 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -5115,12 +5115,10 @@ TryPostBody(
*/
if (code == TCL_ERROR) {
- Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
+ Tcl_Obj *errcode, **bits1, **bits2;
int len1, len2, j;
- TclNewLiteralStringObj(errorCodeName, "-errorcode");
- Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
- Tcl_DecrRefCount(errorCodeName);
+ TclDictGet(NULL, options, "-errorcode", &errcode);
TclListObjGetElements(NULL, info[2], &len1, &bits1);
if (TclListObjGetElements(NULL, errcode, &len2,
&bits2) != TCL_OK) {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index bafcb13..a422072 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2293,8 +2293,7 @@ DisassembleDictUpdateInfo(
Tcl_ListObjAppendElement(NULL, variables,
Tcl_NewIntObj(duiPtr->varIndices[i]));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
- variables);
+ TclDictPut(NULL, dictObj, "variables", variables);
}
/*
@@ -3035,14 +3034,13 @@ DisassembleForeachInfo(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewIntObj(infoPtr->firstValueTemp + i));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
+ TclDictPut(NULL, dictObj, "data", objPtr);
/*
* Loop counter.
*/
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
- Tcl_NewIntObj(infoPtr->loopCtTemp));
+ TclDictPut(NULL, dictObj, "loop", Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
@@ -3058,7 +3056,7 @@ DisassembleForeachInfo(
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+ TclDictPut(NULL, dictObj, "assign", objPtr);
}
static void
@@ -3077,8 +3075,7 @@ DisassembleNewForeachInfo(
* Jump offset.
*/
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
- Tcl_NewIntObj(infoPtr->loopCtTemp));
+ TclDictPut(NULL, dictObj, "jumpOffset", Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
@@ -3094,7 +3091,7 @@ DisassembleNewForeachInfo(
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+ TclDictPut(NULL, dictObj, "assign", objPtr);
}
/*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index a7db705..4f2ee70 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2574,10 +2574,9 @@ DisassembleJumptableInfo(
for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
offset = PTR2INT(Tcl_GetHashValue(hPtr));
- Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
- Tcl_NewIntObj(offset));
+ TclDictPut(NULL, mapping, keyPtr, Tcl_NewIntObj(offset));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
+ TclDictPut(NULL, dictObj, "mapping", mapping);
}
/*
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index a1a53bc..8fe8fc9 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -128,7 +128,7 @@ Tcl_RegisterConfig(
*/
for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
- Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
+ TclDictPut(interp, pkgDict, cfg->key,
Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value)));
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index de3547e..3cd9f43 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1440,6 +1440,153 @@ Tcl_DbNewDictObj(
#endif
}
+/***** START OF FUNCTIONS ACTING AS HELPERS *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictGet --
+ *
+ * Given a key, get its value from the dictionary (or NULL if key is not
+ * found in dictionary.)
+ *
+ * Results:
+ * A standard Tcl result. The variable pointed to by valuePtrPtr is
+ * updated with the value for the key. Note that it is not an error for
+ * the key to have no mapping in the dictionary.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictGet(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ Tcl_Obj **valuePtrPtr) /* Where to write the value. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ code = Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr);
+ Tcl_DecrRefCount(keyPtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictPut --
+ *
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
+ *
+ * If valuePtr is a zero-count object and is not written into the
+ * dictionary because of an error, it is freed by this routine. The caller
+ * does NOT need to do reference count management.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictPut(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ Tcl_Obj *valuePtr) /* The value to write in. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ code = Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ Tcl_DecrRefCount(valuePtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictPutString --
+ *
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictPutString(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ const char *value) /* The value in a C string. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ Tcl_Obj *valuePtr = Tcl_NewStringObj(value, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ code = Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ Tcl_DecrRefCount(valuePtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictRemove --
+ *
+ * Remove the key,value pair with the given key from the dictionary; the
+ * key does not need to be present in the dictionary.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictRemove(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key) /* The key in a C string. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ code = Tcl_DictObjRemove(interp, dictPtr, keyPtr);
+ Tcl_DecrRefCount(keyPtr);
+ return code;
+}
+
/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/
/*
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 9597beb..a66b6a9 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -1113,7 +1113,7 @@ DisassembleByteCodeAsDicts(
Tcl_Obj *desc;
TclNewObj(desc);
- Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
+ TclDictPut(NULL, desc, "name", auxDesc);
auxDesc = desc;
auxData->type->disassembleProc(auxData->clientData, auxDesc,
codePtr, 0);
@@ -1180,23 +1180,21 @@ DisassembleByteCodeAsDicts(
sourceOffset += Decode(srcOffPtr);
sourceLength = Decode(srcLenPtr);
TclNewObj(cmd);
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
- Tcl_NewIntObj(codeOffset));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
- Tcl_NewIntObj(codeOffset + codeLength - 1));
+ TclDictPut(NULL, cmd, "codefrom", Tcl_NewIntObj(codeOffset));
+ TclDictPut(NULL, cmd, "codeto", Tcl_NewIntObj(
+ codeOffset + codeLength - 1));
/*
* Convert byte offsets to character offsets; important if multibyte
* characters are present in the source!
*/
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
- Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
- sourceOffset)));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
- Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ TclDictPut(NULL, cmd, "scriptfrom", Tcl_NewIntObj(
+ Tcl_NumUtfChars(codePtr->source, sourceOffset)));
+ TclDictPut(NULL, cmd, "scriptto", Tcl_NewIntObj(
+ Tcl_NumUtfChars(codePtr->source,
sourceOffset + sourceLength - 1)));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
+ TclDictPut(NULL, cmd, "script",
Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
Tcl_ListObjAppendElement(NULL, commands, cmd);
}
@@ -1215,32 +1213,26 @@ DisassembleByteCodeAsDicts(
*/
TclNewObj(description);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
- literals);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
- variables);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
- instructions);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
- commands);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
+ TclDictPut(NULL, description, "literals", literals);
+ TclDictPut(NULL, description, "variables", variables);
+ TclDictPut(NULL, description, "exception", exn);
+ TclDictPut(NULL, description, "instructions", instructions);
+ TclDictPut(NULL, description, "auxiliary", aux);
+ TclDictPut(NULL, description, "commands", commands);
+ TclDictPut(NULL, description, "script",
Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
+ TclDictPut(NULL, description, "namespace",
Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
+ TclDictPut(NULL, description, "stackdepth",
Tcl_NewIntObj(codePtr->maxStackDepth));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
+ TclDictPut(NULL, description, "exceptdepth",
Tcl_NewIntObj(codePtr->maxExceptDepth));
if (line > -1) {
- Tcl_DictObjPut(NULL, description,
- Tcl_NewStringObj("initiallinenumber", -1),
+ TclDictPut(NULL, description, "initiallinenumber",
Tcl_NewIntObj(line));
}
if (file) {
- Tcl_DictObjPut(NULL, description,
- Tcl_NewStringObj("sourcefile", -1), file);
+ TclDictPut(NULL, description, "sourcefile", file);
}
return description;
}
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index ba9f811..bbcaeb9 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1494,8 +1494,7 @@ OpenEncodingFileChannel(
const char *name) /* The name of the encoding file on disk and
* also the name for new encoding. */
{
- Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
- Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
+ Tcl_Obj *fileNameObj = Tcl_NewStringObj(name, -1);
Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
Tcl_Obj **dir, *path, *directory = NULL;
@@ -1503,10 +1502,9 @@ OpenEncodingFileChannel(
int i, numDirs;
TclListObjGetElements(NULL, searchPath, &numDirs, &dir);
- Tcl_IncrRefCount(nameObj);
Tcl_AppendToObj(fileNameObj, ".enc", -1);
Tcl_IncrRefCount(fileNameObj);
- Tcl_DictObjGet(NULL, map, nameObj, &directory);
+ TclDictGet(NULL, map, name, &directory);
/*
* Check that any cached directory is still on the encoding search path.
@@ -1535,7 +1533,7 @@ OpenEncodingFileChannel(
*/
map = Tcl_DuplicateObj(map);
- Tcl_DictObjRemove(NULL, map, nameObj);
+ TclDictRemove(NULL, map, name);
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
directory = NULL;
}
@@ -1569,7 +1567,7 @@ OpenEncodingFileChannel(
*/
map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
- Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
+ TclDictPut(NULL, map, name, dir[i]);
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
}
}
@@ -1580,7 +1578,6 @@ OpenEncodingFileChannel(
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
Tcl_DecrRefCount(fileNameObj);
- Tcl_DecrRefCount(nameObj);
Tcl_DecrRefCount(searchPath);
return chan;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f1d7134..dea3bed 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1586,17 +1586,16 @@ TclMakeEnsemble(
*/
if (ensemble != NULL) {
- Tcl_Obj *mapDict, *fromObj, *toObj;
+ Tcl_Obj *mapDict, *toObj;
Command *cmdPtr;
TclDStringAppendLiteral(&buf, "::");
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
- fromObj = Tcl_NewStringObj(map[i].name, -1);
TclNewStringObj(toObj, Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf));
Tcl_AppendToObj(toObj, map[i].name, -1);
- Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+ TclDictPut(NULL, mapDict, map[i].name, toObj);
if (map[i].proc || map[i].nreProc) {
/*
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index c2e71ec..49880b6 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -263,13 +263,9 @@ HandleBgErrors(
if (errChannel != NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr = NULL;
-
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ Tcl_Obj *valuePtr = NULL;
+ TclDictGet(NULL, options, "-errorinfo", &valuePtr);
Tcl_WriteChars(errChannel,
"error in background error handler:\n", -1);
if (valuePtr) {
@@ -313,7 +309,7 @@ TclDefaultBgErrorHandlerObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_Obj *valuePtr;
Tcl_Obj *tempObjv[2];
int result, code, level;
Tcl_InterpState saved;
@@ -327,10 +323,7 @@ TclDefaultBgErrorHandlerObjCmd(
* Check for a valid return options dictionary.
*/
- TclNewLiteralStringObj(keyPtr, "-level");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-level", &valuePtr);
if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
@@ -340,10 +333,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
return TCL_ERROR;
}
- TclNewLiteralStringObj(keyPtr, "-code");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-code", &valuePtr);
if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
@@ -405,18 +395,12 @@ TclDefaultBgErrorHandlerObjCmd(
Tcl_SetObjResult(interp, tempObjv[1]);
}
- TclNewLiteralStringObj(keyPtr, "-errorcode");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-errorcode", &valuePtr);
if (result == TCL_OK && valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
}
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-errorinfo", &valuePtr);
if (result == TCL_OK && valuePtr != NULL) {
Tcl_AppendObjToErrorInfo(interp, valuePtr);
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 5127b99..cdcef10 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -2005,8 +2005,7 @@ TclInitChanCmd(
* Can assume that reference counts are all incremented.
*/
- Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1),
- Tcl_NewStringObj(extras[i+1], -1));
+ TclDictPutString(NULL, mapObj, extras[i], extras[i + 1]);
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
return ensemble;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5890bcb..df3d7c8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2918,6 +2918,14 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
+MODULE_SCOPE int TclDictGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, Tcl_Obj **valuePtrPtr);
+MODULE_SCOPE int TclDictPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, Tcl_Obj *valuePtr);
+MODULE_SCOPE int TclDictPutString(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, const char *value);
+MODULE_SCOPE int TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index ddca212..2c0035c 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -4441,8 +4441,7 @@ ChildCommandLimitCmd(
if (hPtr != NULL) {
limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
- limitCBPtr->scriptObj);
+ TclDictPut(NULL, dictPtr, options[0], limitCBPtr->scriptObj);
} else {
goto putEmptyCommandInDict;
}
@@ -4451,22 +4450,19 @@ ChildCommandLimitCmd(
putEmptyCommandInDict:
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[0], -1), empty);
+ TclDictPut(NULL, dictPtr, options[0], empty);
}
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp,
- TCL_LIMIT_COMMANDS)));
+ TclDictPut(NULL, dictPtr, options[1], Tcl_NewIntObj(
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS)));
if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewIntObj(Tcl_LimitGetCommands(childInterp)));
+ TclDictPut(NULL, dictPtr, options[2], Tcl_NewIntObj(
+ Tcl_LimitGetCommands(childInterp)));
} else {
Tcl_Obj *empty;
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[2], -1), empty);
+ TclDictPut(NULL, dictPtr, options[2], empty);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -4629,8 +4625,7 @@ ChildTimeLimitCmd(
if (hPtr != NULL) {
limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
- limitCBPtr->scriptObj);
+ TclDictPut(NULL, dictPtr, options[0], limitCBPtr->scriptObj);
} else {
goto putEmptyCommandInDict;
}
@@ -4638,29 +4633,25 @@ ChildTimeLimitCmd(
Tcl_Obj *empty;
putEmptyCommandInDict:
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[0], -1), empty);
+ TclDictPut(NULL, dictPtr, options[0], empty);
}
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp,
- TCL_LIMIT_TIME)));
+ TclDictPut(NULL, dictPtr, options[1], Tcl_NewIntObj(
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME)));
if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
Tcl_Time limitMoment;
Tcl_LimitGetTime(childInterp, &limitMoment);
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewLongObj(limitMoment.usec/1000));
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
+ TclDictPut(NULL, dictPtr, options[2],
+ Tcl_NewLongObj(limitMoment.usec / 1000));
+ TclDictPut(NULL, dictPtr, options[3],
Tcl_NewLongObj(limitMoment.sec));
} else {
Tcl_Obj *empty;
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[2], -1), empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[3], -1), empty);
+ TclDictPut(NULL, dictPtr, options[2], empty);
+ TclDictPut(NULL, dictPtr, options[3], empty);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 4f31924..d2ab04a 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -405,13 +405,9 @@ Tcl_MainEx(
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr;
-
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ Tcl_Obj *valuePtr = NULL;
+ TclDictGet(NULL, options, "-errorinfo", &valuePtr);
if (valuePtr) {
Tcl_WriteObj(chan, valuePtr);
}
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 081dd5b..8f544e1 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -116,10 +116,8 @@ TclOOInitInfo(
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
if (infoCmd) {
Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
- Tcl_NewStringObj("::oo::InfoObject", -1));
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
- Tcl_NewStringObj("::oo::InfoClass", -1));
+ TclDictPutString(NULL, mapDict, "object", "::oo::InfoObject");
+ TclDictPutString(NULL, mapDict, "class", "::oo::InfoClass");
Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
}
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 4b0332b..e043212 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -385,7 +385,7 @@ ConvertErrorToList(
* GenerateHeader --
*
* Function for creating a gzip header from the contents of a dictionary
- * (as described in the documentation). GetValue is a helper function.
+ * (as described in the documentation).
*
* Results:
* A Tcl result code.
@@ -398,20 +398,6 @@ ConvertErrorToList(
*----------------------------------------------------------------------
*/
-static inline int
-GetValue(
- Tcl_Interp *interp,
- Tcl_Obj *dictObj,
- const char *nameStr,
- Tcl_Obj **valuePtrPtr)
-{
- Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
- int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);
-
- TclDecrRefCount(name);
- return result;
-}
-
static int
GenerateHeader(
Tcl_Interp *interp, /* Where to put error messages. */
@@ -438,7 +424,7 @@ GenerateHeader(
Tcl_Panic("no latin-1 encoding");
}
- if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "comment", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
Tcl_EncodingState state;
@@ -465,14 +451,14 @@ GenerateHeader(
}
}
- if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "crc", &value) != TCL_OK) {
goto error;
} else if (value != NULL &&
Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
goto error;
}
- if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "filename", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
Tcl_EncodingState state;
@@ -499,7 +485,7 @@ GenerateHeader(
}
}
- if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "os", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetIntFromObj(interp, value,
&headerPtr->header.os) != TCL_OK) {
@@ -511,14 +497,14 @@ GenerateHeader(
* input data.
*/
- if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "time", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetLongFromObj(interp, value,
(long *) &headerPtr->header.time) != TCL_OK) {
goto error;
}
- if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "type", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
"type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
@@ -548,9 +534,6 @@ GenerateHeader(
*----------------------------------------------------------------------
*/
-#define SetValue(dictObj, key, value) \
- Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
-
static void
ExtractHeader(
gz_header *headerPtr, /* The gzip header to extract from. */
@@ -573,9 +556,9 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
&tmp);
- SetValue(dictObj, "comment", TclDStringToObj(&tmp));
+ TclDictPut(NULL, dictObj, "comment", TclDStringToObj(&tmp));
}
- SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
+ TclDictPut(NULL, dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
if (headerPtr->name != Z_NULL) {
if (latin1enc == NULL) {
/*
@@ -590,17 +573,18 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
&tmp);
- SetValue(dictObj, "filename", TclDStringToObj(&tmp));
+ TclDictPut(NULL, dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
- SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ TclDictPut(NULL, dictObj, "os", Tcl_NewIntObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
- SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
+ TclDictPut(NULL, dictObj, "time",
+ Tcl_NewLongObj((long) headerPtr->time));
}
if (headerPtr->text != Z_UNKNOWN) {
- SetValue(dictObj, "type",
- Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
+ TclDictPutString(NULL, dictObj, "type",
+ headerPtr->text ? "text" : "binary");
}
if (latin1enc != NULL) {
@@ -1889,7 +1873,7 @@ Tcl_ZlibInflate(
Tcl_SetByteArrayLength(obj, stream.total_out);
if (headerPtr != NULL) {
ExtractHeader(&header, gzipHeaderDictObj);
- SetValue(gzipHeaderDictObj, "size",
+ TclDictPut(NULL, gzipHeaderDictObj, "size",
Tcl_NewLongObj(stream.total_out));
ckfree(nameBuf);
ckfree(commentBuf);