diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclConfig.c | 37 |
2 files changed, 32 insertions, 11 deletions
@@ -1,8 +1,12 @@ 2007-11-28 Don Porter <dgp@users.sourceforge.net> + * generic/tclConfig.c: Corrected failure of the [::foo::pkgconfig] + command to clean up registered configuration data when the query + command is deleted from the interp. [Bug 983501]. + * generic/tclNamesp.c (Tcl_SetEnsembleMappingDict): Added checks that the dict value passed in is in the format required to make the - internals of ensembles work. + internals of ensembles work. [Bug 1436096] * generic/tclIO.c: Simplify test and improve accuracy of error message in latest changes. diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 2acffe2..0466a85 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclConfig.c,v 1.17 2007/11/20 10:59:09 dkf Exp $ + * RCS: @(#) $Id: tclConfig.c,v 1.18 2007/11/28 19:22:54 dgp Exp $ */ #include "tclInt.h" @@ -28,6 +28,17 @@ #define ASSOC_KEY "tclPackageAboutDict" /* + * A ClientData struct for the QueryConfig command. Store the two bits + * of data we need; the package name for which we store a config dict, + * and the (Tcl_Interp *) in which it is stored. + */ + +typedef struct QCCD { + Tcl_Obj *pkg; + Tcl_Interp *interp; +} QCCD; + +/* * Static functions in this file: */ @@ -66,12 +77,14 @@ Tcl_RegisterConfig( CONST char *valEncoding) /* Name of the encoding used to store the * configuration values, ASCII, thus UTF-8. */ { - Tcl_Obj *pDB, *pkg, *pkgDict; + Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; Tcl_Config *cfg; Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding); + QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); - pkg = Tcl_NewStringObj(pkgName, -1); + cdPtr->interp = interp; + cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of @@ -86,7 +99,7 @@ Tcl_RegisterConfig( * Note, the created command will have a reference through its clientdata. */ - Tcl_IncrRefCount(pkg); + Tcl_IncrRefCount(cdPtr->pkg); /* * For venc == NULL aka bogus encoding we skip the step setting up the @@ -100,7 +113,7 @@ Tcl_RegisterConfig( pDB = GetConfigDict(interp); - if (Tcl_DictObjGet(interp, pDB, pkg, &pkgDict) != TCL_OK + if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK || (pkgDict == NULL)) { pkgDict = Tcl_NewDictObj(); } else if (Tcl_IsShared(pkgDict)) { @@ -136,7 +149,7 @@ Tcl_RegisterConfig( * Write the changes back into the overall database. */ - Tcl_DictObjPut(interp, pDB, pkg, pkgDict); + Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); } /* @@ -166,7 +179,7 @@ Tcl_RegisterConfig( Tcl_DStringAppend(&cmdName, "::pkgconfig", -1); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), - QueryConfigObjCmd, (ClientData) pkg, QueryConfigDelete) == NULL) { + QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) { Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } @@ -198,7 +211,8 @@ QueryConfigObjCmd( int objc, struct Tcl_Obj *CONST *objv) { - Tcl_Obj *pkgName = (Tcl_Obj *) clientData; + QCCD *cdPtr = (QCCD *) clientData; + Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; int n, index; static CONST char *subcmdStrings[] = { @@ -308,9 +322,12 @@ static void QueryConfigDelete( ClientData clientData) { - Tcl_Obj *pkgName = (Tcl_Obj *) clientData; - + QCCD *cdPtr = (QCCD *) clientData; + Tcl_Obj *pkgName = cdPtr->pkg; + Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); + Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); + ckfree((char *)cdPtr); } /* |