summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-24 16:20:05 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-24 16:20:05 (GMT)
commitdb2389176bddb30734048a790ac9e6c6f2ec5d45 (patch)
tree0a0acdf3a4e09c9b148d7b3d391ea5344ff805c3 /generic
parentd38a0b78165c57c6689c651906b1306d53f6e2fa (diff)
downloadtcl-db2389176bddb30734048a790ac9e6c6f2ec5d45.zip
tcl-db2389176bddb30734048a790ac9e6c6f2ec5d45.tar.gz
tcl-db2389176bddb30734048a790ac9e6c6f2ec5d45.tar.bz2
Starting implementing the "package files" command. TIP still to be written.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclLoad.c8
-rw-r--r--generic/tclPkg.c92
3 files changed, 91 insertions, 10 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4257ea1..bfcd002 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3100,6 +3100,7 @@ MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
+MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
MODULE_SCOPE char * TclpReadlink(const char *fileName,
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index be296b3..184c158 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -397,6 +397,12 @@ Tcl_LoadObjCmd(
goto done;
}
+ if (target == interp) {
+ /* Only register the file if the load is done in the
+ * current interpreter */
+ TclPkgFileSeen(target, Tcl_GetString(objv[1]));
+ }
+
/*
* Create a new record to describe this package.
*/
@@ -998,7 +1004,7 @@ Tcl_StaticPackage(
}
/*
- * Package isn't loade in the current interp yet. Mark it as now being
+ * Package isn't loaded in the current interp yet. Mark it as now being
* loaded.
*/
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 244eb94..3d052a6 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -32,6 +32,17 @@ typedef struct PkgAvail {
* same package. */
} PkgAvail;
+typedef struct PkgName {
+ struct PkgName *nextPtr; /* Next in list of package names being initialized. */
+ char name[1];
+} PkgName;
+
+typedef struct PkgFiles {
+ PkgName *names; /* Package names being initialized. */
+ Tcl_HashTable table; /* Table which contains files for each package */
+} PkgFiles;
+
+
/*
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
@@ -81,7 +92,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
((v) = ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
do { \
- unsigned local__len = (unsigned) (strlen(s) + 1); \
+ size_t local__len = strlen(s) + 1; \
DupBlock((v),(s),local__len); \
} while (0)
@@ -189,6 +200,29 @@ Tcl_PkgProvideEx(
*----------------------------------------------------------------------
*/
+static void PkgFilesCleanupProc(ClientData clientData,
+ Tcl_Interp *interp)
+{
+ PkgFiles *pkgFiles = (PkgFiles *) clientData;
+
+ while (pkgFiles->names) {
+ PkgName *name = pkgFiles->names;
+ pkgFiles->names = name->nextPtr;
+ ckfree(name);
+ }
+ Tcl_DeleteHashTable(&pkgFiles->table);
+ return;
+}
+
+void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName)
+{
+ PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ if (pkgFiles) {
+ const char *name = pkgFiles->names->name;
+ printf("Seen %s for package %s\n", fileName, name);
+ }
+}
+
#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
@@ -489,12 +523,31 @@ PkgRequireCore(
*/
char *versionToProvide = bestPtr->version;
+ PkgFiles *pkgFiles;
+ PkgName *pkgName;
script = bestPtr->script;
pkgPtr->clientData = versionToProvide;
- Tcl_Preserve(script);
Tcl_Preserve(versionToProvide);
+ Tcl_Preserve(script);
+ /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
+ pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ if (!pkgFiles) {
+ pkgFiles = ckalloc(sizeof(PkgFiles));
+ pkgFiles->names = NULL;
+ Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
+ }
+ /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
+ pkgName = ckalloc(sizeof(PkgName) + strlen(name));
+ pkgName->nextPtr = pkgFiles->names;
+ strcpy(pkgName->name, name);
+ pkgFiles->names = pkgName;
code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
+ /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
+ pkgName = pkgFiles->names;
+ pkgFiles->names = pkgFiles->names->nextPtr;
+ ckfree(pkgName);
Tcl_Release(script);
pkgPtr = FindPackage(interp, name);
@@ -764,14 +817,14 @@ Tcl_PackageObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const pkgOptions[] = {
- "forget", "ifneeded", "names", "prefer", "present",
- "provide", "require", "unknown", "vcompare", "versions",
- "vsatisfies", NULL
+ "files", "forget", "ifneeded", "names", "prefer",
+ "present", "provide", "require", "unknown", "vcompare",
+ "versions", "vsatisfies", NULL
};
enum pkgOptions {
- PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT,
- PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
- PKG_VSATISFIES
+ PKG_FILES, PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER,
+ PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
+ PKG_VERSIONS, PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
int optionIndex, exact, i, satisfies;
@@ -794,6 +847,27 @@ Tcl_PackageObjCmd(
return TCL_ERROR;
}
switch ((enum pkgOptions) optionIndex) {
+ case PKG_FILES: {
+ const char *keyString;
+ Tcl_Obj *result = Tcl_NewObj();
+
+ for (i = 2; i < objc; i++) {
+ keyString = TclGetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
+ if (hPtr == NULL) {
+ continue;
+ }
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ availPtr = pkgPtr->availPtr;
+ while (availPtr != NULL) {
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(availPtr->script, -1));
+ availPtr = availPtr->nextPtr;
+ }
+ ckfree(pkgPtr);
+ }
+ Tcl_SetObjResult(interp, result);
+ break;
+ }
case PKG_FORGET: {
const char *keyString;
@@ -1220,7 +1294,7 @@ FindPackage(
void
TclFreePackageInfo(
- Interp *iPtr) /* Interpereter that is being deleted. */
+ Interp *iPtr) /* Interpreter that is being deleted. */
{
Package *pkgPtr;
Tcl_HashSearch search;