diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-02-08 11:42:12 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-02-08 11:42:12 (GMT) |
commit | 8066c6a687d570d513638c2079a6bc8a9a9b364f (patch) | |
tree | d17d54594683cbfd66d649b89cf7b6afbe31597b /generic | |
parent | 4671050f10c550351d45bd50d64ee27272d23159 (diff) | |
download | tcl-8066c6a687d570d513638c2079a6bc8a9a9b364f.zip tcl-8066c6a687d570d513638c2079a6bc8a9a9b364f.tar.gz tcl-8066c6a687d570d513638c2079a6bc8a9a9b364f.tar.bz2 |
FlightAware feedback: "Aside: Any way to find out what the pkgIndex.tcl file a package was defined in was, or does that happen at too high a level?"
Answer: Even though the name of the pkgIndex file is available earlier, it is very well possible to remember it and store it with the other files. This commit does exactly that.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclPkg.c | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 0759faa..9ad3cb7 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -32,6 +32,7 @@ typedef struct PkgAvail { char *script; /* Script to invoke to provide this version of * the package. Malloc'ed and protected by * Tcl_Preserve and Tcl_Release. */ + char *pkgIndex; /* Full file name of pkgIndex file */ struct PkgAvail *nextPtr; /* Next in list of available versions of the * same package. */ } PkgAvail; @@ -573,6 +574,9 @@ PkgRequireCore( pkgName->nextPtr = pkgFiles->names; strcpy(pkgName->name, name); pkgFiles->names = pkgName; + if (bestPtr->pkgIndex) { + TclPkgFileSeen(interp, bestPtr->pkgIndex); + } code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/ pkgFiles->names = pkgName->nextPtr; @@ -921,6 +925,9 @@ Tcl_PackageObjCmd( pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } ckfree(availPtr); } ckfree(pkgPtr); @@ -971,6 +978,9 @@ Tcl_PackageObjCmd( return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } break; } } @@ -981,6 +991,7 @@ Tcl_PackageObjCmd( } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); + availPtr->pkgIndex = 0; DupBlock(availPtr->version, argv3, (unsigned) length + 1); if (prevPtr == NULL) { @@ -991,6 +1002,10 @@ Tcl_PackageObjCmd( prevPtr->nextPtr = availPtr; } } + if (iPtr->scriptFile) { + argv4 = TclGetStringFromObj(iPtr->scriptFile, &length); + DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1); + } argv4 = TclGetStringFromObj(objv[4], &length); DupBlock(availPtr->script, argv4, (unsigned) length + 1); break; @@ -1346,6 +1361,9 @@ TclFreePackageInfo( pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); + if (availPtr->pkgIndex) { + Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); + } ckfree(availPtr); } ckfree(pkgPtr); |