From 707993b1dd4f01322cdbea334c71a1202373fa9b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Jan 2017 15:16:31 +0000 Subject: Fix safe.tcl test-cases: "source -nopkg" is not necessary here: "source" is an alias for "::safe::AliasSource", which doesn't use "source" --- library/init.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/init.tcl b/library/init.tcl index 65a19aa..e3d4ef0 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -486,7 +486,7 @@ proc auto_load_index {} { set dir [lindex $auto_path $i] set f "" if {$issafe} { - catch {source -nopkg [file join $dir tclIndex]} + catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { -- cgit v0.12 From 9f5fab9296c69ae125f5d288a5cca0d1dc3321ec Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Jan 2017 16:23:23 +0000 Subject: In stead of "source -nopkg" use a ::tcl::Pkg::source utility function. --- generic/tclCmdMZ.c | 28 ++---------- library/init.tcl | 24 ++++++++++- library/package.tcl | 2 +- library/tclIndex | 120 +++++++++++++++++++++++++++++----------------------- 4 files changed, 92 insertions(+), 82 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index fbc9d8f..23e6bd1 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -989,11 +989,8 @@ 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; } @@ -1011,28 +1008,9 @@ 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; - } - result = TclNREvalFile(interp, fileName, encodingName); - if (pkgFiles) { - /* restore "tclPkgFiles" assocdata to how it was. */ - *pkgFiles = names; } - return result; + + return TclNREvalFile(interp, fileName, encodingName); } /* diff --git a/library/init.tcl b/library/init.tcl index e3d4ef0..9101e35 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -46,8 +46,6 @@ if {![info exists auto_path]} { } } -source [file join $::tcl_library auto.tcl] - namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -115,6 +113,8 @@ namespace eval tcl { } } +namespace eval tcl::Pkg {} + # Windows specific end of initialization if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { @@ -460,6 +460,26 @@ proc auto_load {cmd {namespace {}}} { return 0 } +# ::tcl::Pkg::source -- +# This procedure provides an alternative "source" command, which doesn't +# register the file for the "package files" command. Safe interpreters +# don't have to do anything special. +# +# Arguments: +# filename + +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] + } +} + # auto_load_index -- # Loads the contents of tclIndex files on the auto_path directory # list. This is usually invoked within auto_load to load the index diff --git a/library/package.tcl b/library/package.tcl index cb1bea6..1cb2d3d 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -488,7 +488,7 @@ proc tclPkgUnknown {name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source -nopkg $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue diff --git a/library/tclIndex b/library/tclIndex index 09aba56..87a2814 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -7,57 +7,69 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(history) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] -set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]] -set auto_index(::pkg::create) [list source [file join $dir package.tcl]] -set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]] -set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]] -set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]] -set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Log) [list source [file join $dir safe.tcl]] -set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] -set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]] -set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] -set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] -set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] -set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] -set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] -set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] -set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]] +set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]] +set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]] +set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]] +set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]] +set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]] +set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] -- cgit v0.12 From 7660a167e1a0bfce591e4b2a7b6b7043e72925af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 5 Jan 2017 13:09:26 +0000 Subject: One more ::tcl::Pkg::source, for the Mac --- library/package.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/package.tcl b/library/package.tcl index 5257cd6..c72fbfb 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -590,7 +590,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { set dir [file dirname $file] if {![info exists procdDirs($dir)]} { try { - source $file + ::tcl::Pkg::source $file } trap {POSIX EACCES} {} { # $file was not readable; silently ignore continue -- cgit v0.12