diff options
| -rw-r--r-- | .fossil-settings/ignore-glob | 4 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 30 | ||||
| -rw-r--r-- | library/init.tcl | 8 | ||||
| -rw-r--r-- | library/package.tcl | 2 | ||||
| -rw-r--r-- | tests/package.test | 10 |
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 |