From 0254080ca07929caa2f2b25206928d5559048aff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 Mar 2018 22:53:00 +0000 Subject: Fix the "package files" command. Due to the NRE enabling of "package" it always started to return an empty list. --- generic/tclPkg.c | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 6c5b827..e8c2801 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -728,12 +728,23 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { */ char *versionToProvide = bestPtr->version; + PkgFiles *pkgFiles; + PkgName *pkgName; + Tcl_Preserve(versionToProvide); pkgPtr->clientData = versionToProvide; if (bestPtr->pkgIndex) { TclPkgFileSeen(interp, bestPtr->pkgIndex); } reqPtr->versionToProvide = versionToProvide; + + pkgFiles = TclInitPkgFiles(interp); + /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ + pkgName = ckalloc(sizeof(PkgName) + strlen(name)); + pkgName->nextPtr = pkgFiles->names; + strcpy(pkgName->name, name); + pkgFiles->names = pkgName; + Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]); Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL); } @@ -747,20 +758,14 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name; char *versionToProvide = reqPtr->versionToProvide; - + void *toBeRemoved; PkgFiles *pkgFiles; - PkgName *pkgName; pkgFiles = TclInitPkgFiles(interp); - /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = ckalloc(sizeof(PkgName) + strlen(name)); - pkgName->nextPtr = pkgFiles->names; - strcpy(pkgName->name, name); - pkgFiles->names = pkgName; - /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ - pkgFiles->names = pkgName->nextPtr; - ckfree(pkgName); + toBeRemoved = pkgFiles->names; + pkgFiles->names = pkgFiles->names->nextPtr; + ckfree(toBeRemoved); reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { -- cgit v0.12