Starting implementing the "package files" command. TIP still to be written.

4 files changed, 92 insertions, 11 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;
diff --git a/tests/package.test b/tests/package.test
index 49346d8..99f9f06 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -832,7 +832,7 @@ test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 } {0}
 test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
     package foo
-} -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
+} -returnCodes error -result {bad option "foo": must be files, forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
 test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
     package vsatisfies 2.1 2.1-3.2-4.5
 } -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}