summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-02-08 11:42:12 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-02-08 11:42:12 (GMT)
commit8eedc41ff2550dbd1882d89dd2770074fcfd4bcd (patch)
treed17d54594683cbfd66d649b89cf7b6afbe31597b
parentdf69e84a53cae6ab03b1ca685e630716f86348ce (diff)
downloadtcl-8eedc41ff2550dbd1882d89dd2770074fcfd4bcd.zip
tcl-8eedc41ff2550dbd1882d89dd2770074fcfd4bcd.tar.gz
tcl-8eedc41ff2550dbd1882d89dd2770074fcfd4bcd.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?" package_files
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.
-rw-r--r--generic/tclPkg.c18
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);