From b7baefb37be1711dc8aefbbed9e9670b0926e1be Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2013 07:42:53 +0000 Subject: Proposed solution for [9b2e636361] --- generic/tclConfig.c | 44 +++++++++++++++++++------------------------- generic/tclMain.c | 5 +++-- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 28549ed..ffed6f2 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -26,14 +26,15 @@ #define ASSOC_KEY "tclPackageAboutDict" /* - * A ClientData struct for the QueryConfig command. Store the two bits + * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, - * and the (Tcl_Interp *) in which it is stored. + * the (Tcl_Interp *) in which it is stored, and the encoding. */ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; + CONST char *encoding; } QCCD; /* @@ -78,10 +79,10 @@ Tcl_RegisterConfig( Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; Tcl_Config *cfg; - Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding); QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; + cdPtr->encoding = valEncoding; cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* @@ -104,7 +105,6 @@ Tcl_RegisterConfig( * dictionaries visible at Tcl level. I.e. they are not filled */ - if (venc != NULL) { /* * Retrieve package specific configuration... */ @@ -123,32 +123,15 @@ Tcl_RegisterConfig( */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { - Tcl_DString conv; - CONST char *convValue = - Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv); - - /* - * We know that the keys are in ASCII/UTF-8, so for them is no - * conversion required. - */ - Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), - Tcl_NewStringObj(convValue, -1)); - Tcl_DStringFree(&conv); + Tcl_NewStringObj(cfg->value, -1)); } /* - * We're now done with the encoding, so drop it. - */ - - Tcl_FreeEncoding(venc); - - /* * Write the changes back into the overall database. */ Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); - } /* * Now create the interface command for retrieval of the package @@ -219,6 +202,9 @@ QueryConfigObjCmd( enum subcmds { CFG_GET, CFG_LIST }; + Tcl_DString conv; + Tcl_Encoding venc = NULL; + CONST char *value; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?"); @@ -237,7 +223,7 @@ QueryConfigObjCmd( * present. */ - Tcl_SetResult(interp, "package not known", TCL_STATIC); + Tcl_SetResult(interp, "package not known", TCL_STATIC); return TCL_ERROR; } @@ -254,7 +240,15 @@ QueryConfigObjCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, val); + if (cdPtr->encoding) { + venc = Tcl_GetEncoding(interp, cdPtr->encoding); + if (!venc) { + return TCL_ERROR; + } + } + value = Tcl_ExternalToUtfDString(venc, Tcl_GetString(val), -1, &conv); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); + Tcl_DStringFree(&conv); return TCL_OK; case CFG_LIST: @@ -361,7 +355,7 @@ GetConfigDict( * * This function is associated with the "Package About dict" assoc data * for an interpreter; it is invoked when the interpreter is deleted in - * order to free the information assoicated with any pending error + * order to free the information associated with any pending error * reports. * * Results: diff --git a/generic/tclMain.c b/generic/tclMain.c index 7a19a38..5e5109b 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -342,9 +342,10 @@ Tcl_Main( Tcl_Interp *interp; Tcl_DString appName; - Tcl_FindExecutable(argv[0]); - interp = Tcl_CreateInterp(); + TclpSetInitialEncodings(); + TclpFindExecutable(argv[0]); + Tcl_InitMemory(interp); /* -- cgit v0.12 From e0e8990257bc75fdafa895f309145353c400923e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2013 08:10:36 +0000 Subject: Allocate encoding name, so caller of Tcl_RegisterConfig() doesn't need to keep it forever. Fix some comments. --- generic/tclConfig.c | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index ffed6f2..702ab82 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -34,7 +34,7 @@ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; - CONST char *encoding; + char *encoding; } QCCD; /* @@ -82,15 +82,20 @@ Tcl_RegisterConfig( QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; - cdPtr->encoding = valEncoding; + if (valEncoding) { + cdPtr->encoding = ckalloc(strlen(valEncoding)+1); + strcpy(cdPtr->encoding, valEncoding); + } else { + cdPtr->encoding = NULL; + } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of - * package meta data. Only if we have an ok encoding. + * package meta data. * * Phase II: Create a command for querying this database, specific to the - * package registerting its configuration. This is the approved interface + * 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 * packages, and not a structure tied to one package. @@ -313,6 +318,9 @@ QueryConfigDelete( Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); + if (cdPtr->encoding) { + ckfree((char *)cdPtr->encoding); + } ckfree((char *)cdPtr); } -- cgit v0.12