summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-05 11:55:56 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-05 11:55:56 (GMT)
commit435cd89eb85511e1dea7303fdaeef4a863e5a19c (patch)
tree72eac7cc10c5256c66609a08c44196e94e1c5f91
parent9f5fab9296c69ae125f5d288a5cca0d1dc3321ec (diff)
parent52862763d3a3bc08041532e0afc9bf27ef9abbe0 (diff)
downloadtcl-435cd89eb85511e1dea7303fdaeef4a863e5a19c.zip
tcl-435cd89eb85511e1dea7303fdaeef4a863e5a19c.tar.gz
tcl-435cd89eb85511e1dea7303fdaeef4a863e5a19c.tar.bz2
Merge trunk. Improve test-case. Bring back "source -nopkg", but only as undocumented internal helper for ::tcl::Pkg::source.
-rw-r--r--.fossil-settings/ignore-glob4
-rw-r--r--generic/tclCmdMZ.c30
-rw-r--r--library/init.tcl8
-rw-r--r--library/package.tcl2
-rw-r--r--tests/package.test10
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