Complete implementation, tests and documentation

4 files changed, 58 insertions, 13 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ed3d9a5..7f2a2f3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -989,8 +989,11 @@ TclNRSourceObjCmd(
 {
     const char *encodingName = NULL;
     Tcl_Obj *fileName;
+    int result;
+    void **pkgFiles = NULL;
+    void *names = NULL;
 
-    if (objc != 2 && objc !=4) {
+    if (objc < 2 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
 	return TCL_ERROR;
     }
@@ -1008,8 +1011,28 @@ TclNRSourceObjCmd(
 	    return TCL_ERROR;
 	}
 	encodingName = TclGetString(objv[2]);
+    } else if (objc == 3) {
+	static const char *const nopkgoptions[] = {
+	    "-nopkg", NULL
+	};
+	int index;
+
+	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
+		"option", TCL_EXACT, &index)) {
+	    return TCL_ERROR;
+	}
+	pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+	/* Make sure that during the following TclNREvalFile no filenames
+	 * are recorded for inclusion in the "package files" command */
+	names = *pkgFiles;
+	*pkgFiles = NULL;
     }
-    return TclNREvalFile(interp, fileName, encodingName);
+    result = TclNREvalFile(interp, fileName, encodingName);
+    if (pkgFiles) {
+	/* restore "tclPkgFiles" assocdata to how it was. */
+	*pkgFiles = names;
+    }
+    return result;
 }
 
 /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index bfcd002..9422a03 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3101,6 +3101,7 @@ 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 void *TclInitPkgFiles(Tcl_Interp *interp);
 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/tclInterp.c b/generic/tclInterp.c
index 1bfe76a..7874de9 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -331,13 +331,24 @@ TclSetPreInitScript(
  *----------------------------------------------------------------------
  */
 
+typedef struct PkgName {
+    struct PkgName *nextPtr;	/* Next in list of package names being initialized. */
+    char name[4];
+} PkgName;
+
 int
 Tcl_Init(
     Tcl_Interp *interp)		/* Interpreter to initialize. */
 {
+    PkgName pkgName = {NULL, "Tcl"};
+    PkgName **names = TclInitPkgFiles(interp);
+    int result = TCL_ERROR;
+
+    pkgName.nextPtr = *names;
+    *names = &pkgName;
     if (tclPreInitScript != NULL) {
 	if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
-	    return TCL_ERROR;
+	    goto end;
 	}
     }
 
@@ -382,7 +393,7 @@ Tcl_Init(
      * alternate tclInit command before calling Tcl_Init().
      */
 
-    return Tcl_EvalEx(interp,
+    result = Tcl_EvalEx(interp,
 "if {[namespace which -command tclInit] eq \"\"} {\n"
 "  proc tclInit {} {\n"
 "    global tcl_libPath tcl_library env tclDefaultLibrary\n"
@@ -445,6 +456,10 @@ Tcl_Init(
 "  }\n"
 "}\n"
 "tclInit", -1, 0);
+
+end:
+    *names = (*names)->nextPtr;
+    return result;
 }
 
 /*
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index c258987..c3cc54e 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -38,7 +38,7 @@ typedef struct PkgName {
 } PkgName;
 
 typedef struct PkgFiles {
-    PkgName *names;		/* Package names being initialized. */
+    PkgName *names;		/* Package names being initialized. Must be first field*/
     Tcl_HashTable table;	/* Table which contains files for each package */
 } PkgFiles;
 
@@ -222,6 +222,19 @@ static void PkgFilesCleanupProc(ClientData clientData,
     return;
 }
 
+void *TclInitPkgFiles(Tcl_Interp *interp)
+{
+    /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
+    PkgFiles *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);
+    }
+    return pkgFiles;
+}
+
 void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName)
 {
     PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
@@ -549,14 +562,7 @@ PkgRequireCore(
 	    pkgPtr->clientData = versionToProvide;
 	    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);
-	    }
+	    pkgFiles = TclInitPkgFiles(interp);
 	    /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
 	    pkgName = ckalloc(sizeof(PkgName) + strlen(name));
 	    pkgName->nextPtr = pkgFiles->names;