Merge trunk. Improve test-case. Bring back "source -nopkg", but only as undocumented internal helper for ::tcl::Pkg::source.

5 files changed, 40 insertions, 14 deletions

diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
index 2f93505..2126c62 100644
--- a/.fossil-settings/ignore-glob
+++ b/.fossil-settings/ignore-glob
@@ -6,6 +6,7 @@
 *.lib
 *.o
 *.obj
+*.pdb
 *.res
 *.sl
 *.so
@@ -17,6 +18,7 @@
 */tclsh*
 */tcltest*
 */versions.vc
+html
 libtommath/bn.ilg
 libtommath/bn.ind
 libtommath/pretty.build
@@ -38,5 +40,7 @@ unix/dltest.marker
 unix/tcl.pc
 unix/tclIndex
 unix/pkgs/*
+win/Debug_VC*
+win/Release_VC*
 win/pkgs/*
 win/tcl.hpj
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 23e6bd1..ba1fc41 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,9 +1011,30 @@ TclNRSourceObjCmd(
 	    return TCL_ERROR;
 	}
 	encodingName = TclGetString(objv[2]);
-    }
+    } else if (objc == 3) {
+	/* Handle undocumented -nopkg option. This should only be
+	 * used by the internal ::tcl::Pkg::source utility function. */
+	static const char *const nopkgoptions[] = {
+	    "-nopkg", NULL
+	};
+	int index;
 
-    return TclNREvalFile(interp, fileName, encodingName);
+	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;
+    }
+    result = TclNREvalFile(interp, fileName, encodingName);
+    if (pkgFiles) {
+	/* restore "tclPkgFiles" assocdata to how it was. */
+	*pkgFiles = names;
+    }
+    return result;
 }
 
 /*
diff --git a/library/init.tcl b/library/init.tcl
index 9101e35..d642f05 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -472,11 +472,7 @@ proc ::tcl::Pkg::source {filename} {
     if {[interp issafe]} {
 	uplevel 1 [list ::source $filename]    
     } else {
-	set f [open $filename]
-	fconfigure $f -eofchar \032
-	set contents [read $f]
-	close $f
-	uplevel 1 [list eval $contents]
+	uplevel 1 [list ::source -nopkg $filename]    
     }
 }
 
@@ -522,7 +518,7 @@ proc auto_load_index {} {
 			}
 			set name [lindex $line 0]
 			set auto_index($name) \
-				"source [file join $dir [lindex $line 1]]"
+				"::tcl::Pkg::source [file join $dir [lindex $line 1]]"
 		    }
 		} else {
 		    error "[file join $dir tclIndex] isn't a proper Tcl index file"
diff --git a/library/package.tcl b/library/package.tcl
index 1cb2d3d..5257cd6 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -506,7 +506,7 @@ proc tclPkgUnknown {name args} {
 	    # safe interps usually don't have "file exists",
 	    if {([interp issafe] || [file exists $file])} {
 		try {
-		    source $file
+		    ::tcl::Pkg::source $file
 		} trap {POSIX EACCES} {} {
 		    # $file was not readable; silently ignore
 		    continue
diff --git a/tests/package.test b/tests/package.test
index 55bba8a..054fe46 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -873,11 +873,13 @@ test package-5.2 {TclFreePackageInfo procedure} -body {
 test package-5.3 {package files} -body {
     interp create foo
     foo eval {
-	package ifneeded t 2.4 {package provide t 2.4;package require http}
+	package require Tcl
+	catch {package require abcdef}
+	package ifneeded t 2.4 {package provide t 2.4;::tcl::HistAdd abc; package require http}
+	package require t 2.4
+	list [package files t] [package files Tcl]
     }
-    foo eval package require t 2.4
-    foo eval {list [package files http] [package files t]}
-} -result {{} {}}
+} -result [list {} [list [file join $tcl_library init.tcl]]]
 
 test package-6.1 {CheckVersion procedure} {
     package vcompare 1 2.1