diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclConfig.c | 63 |
2 files changed, 41 insertions, 27 deletions
@@ -1,3 +1,8 @@ +2013-06-27 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs initialized + * generic/tclMain.c: encodings. + 2013-06-18 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread issue. diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 702ab82..0bbac5b 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -97,7 +97,7 @@ Tcl_RegisterConfig( * Phase II: Create a command for querying this database, specific to the * package registering its configuration. This is the approved interface * in TIP 59. In the future a more general interface should be done, as - * followup to TIP 59. Simply because our database is now general across + * follow-up to TIP 59. Simply because our database is now general across * packages, and not a structure tied to one package. * * Note, the created command will have a reference through its clientdata. @@ -110,33 +110,35 @@ Tcl_RegisterConfig( * dictionaries visible at Tcl level. I.e. they are not filled */ - /* - * Retrieve package specific configuration... - */ + pDB = GetConfigDict(interp); - pDB = GetConfigDict(interp); + /* + * Retrieve package specific configuration... + */ - if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK + if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK || (pkgDict == NULL)) { - pkgDict = Tcl_NewDictObj(); - } else if (Tcl_IsShared(pkgDict)) { - pkgDict = Tcl_DuplicateObj(pkgDict); - } + pkgDict = Tcl_NewDictObj(); + } else if (Tcl_IsShared(pkgDict)) { + pkgDict = Tcl_DuplicateObj(pkgDict); + } - /* - * Extend the package configuration... - */ + /* + * Extend the package configuration... + * We cannot assume that the encodings are initialized, therefore + * store the value as-is in a byte array. See Bug [9b2e636361]. + */ - for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { - Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), - Tcl_NewStringObj(cfg->value, -1)); - } + for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { + Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), + Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value))); + } - /* - * Write the changes back into the overall database. - */ + /* + * Write the changes back into the overall database. + */ - Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); + Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); /* * Now create the interface command for retrieval of the package @@ -166,7 +168,7 @@ Tcl_RegisterConfig( if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) { - Tcl_Panic("%s: %s", "Tcl_RegisterConfig", + Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } @@ -201,7 +203,7 @@ QueryConfigObjCmd( Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; int n, index; - static const char *subcmdStrings[] = { + static CONST char *subcmdStrings[] = { "get", "list", NULL }; enum subcmds { @@ -223,7 +225,7 @@ QueryConfigObjCmd( pDB = GetConfigDict(interp); if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK || pkgDict == NULL) { - /* + /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ @@ -239,7 +241,7 @@ QueryConfigObjCmd( return TCL_ERROR; } - if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK + if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { Tcl_SetResult(interp, "key not known", TCL_STATIC); return TCL_ERROR; @@ -251,8 +253,14 @@ QueryConfigObjCmd( return TCL_ERROR; } } - value = Tcl_ExternalToUtfDString(venc, Tcl_GetString(val), -1, &conv); - Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); + /* + * Value is stored as-is in a byte array, see Bug [9b2e636361], + * so we have to decode it first. + */ + value = (const char *) Tcl_GetByteArrayFromObj(val, &n); + value = Tcl_ExternalToUtfDString(venc, value, n, &conv); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, + Tcl_DStringLength(&conv))); Tcl_DStringFree(&conv); return TCL_OK; @@ -316,6 +324,7 @@ QueryConfigDelete( QCCD *cdPtr = (QCCD *) clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); + Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { |