diff options
author | dgp <dgp@noemail.net> | 2007-11-28 19:22:51 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2007-11-28 19:22:51 (GMT) |
commit | 5509c8778d1b9e86f8dc1e26f15d91bf0ec35d8c (patch) | |
tree | 6b2177b48343538bf0001648b60b41021b1ac0c2 /generic/tclConfig.c | |
parent | 3c660fb107704be33d6133513a38eba9a65b7214 (diff) | |
download | tcl-5509c8778d1b9e86f8dc1e26f15d91bf0ec35d8c.zip tcl-5509c8778d1b9e86f8dc1e26f15d91bf0ec35d8c.tar.gz tcl-5509c8778d1b9e86f8dc1e26f15d91bf0ec35d8c.tar.bz2 |
* 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].
FossilOrigin-Name: 247f50eb473c8a8318c05ccf70f3422cfdc1a8cb
Diffstat (limited to 'generic/tclConfig.c')
-rw-r--r-- | generic/tclConfig.c | 37 |
1 files changed, 27 insertions, 10 deletions
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); } /* |