Index: .fossil-settings/binary-glob ================================================================== --- .fossil-settings/binary-glob +++ .fossil-settings/binary-glob @@ -22,8 +22,7 @@ *.gif *.gz *.jpg *.lib *.pdf -*.png -*.xlsx +*.png*.xlsx *.zip Index: doc/safe.n ================================================================== --- doc/safe.n +++ doc/safe.n @@ -21,14 +21,17 @@ .sp \fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR .sp \fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR .sp +\fB::safe::setAutoPathSync\fR ?\fInewValue\fR? +.sp \fB::safe::setLogCmd\fR ?\fIcmd arg...\fR? .SS OPTIONS .PP ?\fB\-accessPath\fR \fIpathList\fR? +?\fB\-autoPath\fR \fIpathList\fR? ?\fB\-statics\fR \fIboolean\fR? ?\fB\-noStatics\fR? ?\fB\-nested\fR \fIboolean\fR? ?\fB\-nestedLoadOk\fR? ?\fB\-deleteHook\fR \fIscript\fR? .BE .SH DESCRIPTION @@ -138,10 +141,19 @@ $slave eval [list set tk_library \e [::safe::interpAddToAccessPath $name $tk_library]] .CE .RE .TP +\fB::safe::setAutoPathSync\fR ?\fInewValue\fR? +This command is used to get or set the "Sync Mode" of the Safe Base. +When an argument is supplied, the command returns an error if the argument +is not a boolean value, or if any Safe Base interpreters exist. Typically +the value will be set as part of initialization - boolean true for +"Sync Mode" on (the default), false for "Sync Mode" off. With "Sync Mode" +on, the Safe Base keeps each slave interpreter's ::auto_path synchronized +with its access path. See the section \fBSYNC MODE\fR below for details. +.TP \fB::safe::setLogCmd\fR ?\fIcmd arg...\fR? This command installs a script that will be called when interesting life cycle events occur for a safe interpreter. When called with no arguments, it returns the currently installed script. When called with one argument, an empty string, the currently installed @@ -189,10 +201,17 @@ empty list, the safe interpreter will use the same directories as its master for auto-loading. See the section \fBSECURITY\fR below for more detail about virtual paths, tokens and access control. .TP +\fB\-autoPath\fR \fIdirectoryList\fR +This option sets the list of directories in the safe interpreter's +::auto_path. The option is undefined if the Safe Base has "Sync Mode" on +- in that case the safe interpreter's ::auto_path is managed by the Safe +Base and is a tokenized form of its access path. +See the section \fBSYNC MODE\fR below for details. +.TP \fB\-statics\fR \fIboolean\fR This option specifies if the safe interpreter will be allowed to load statically linked packages (like \fBload {} Tk\fR). The default value is \fBtrue\fR : safe interpreters are allowed to load statically linked packages. @@ -321,11 +340,12 @@ Each element of the initial access path list will be assigned a token that will be set in the slave \fBauto_path\fR and the first element of that list will be set as the \fBtcl_library\fR for that slave. .PP -If the access path argument is not given or is the empty list, +If the access path argument is not given to \fB::safe::interpCreate\fR or +\fB::safe::interpInit\fR or is the empty list, the default behavior is to let the slave access the same packages as the master has access to (Or to be more precise: only packages written in Tcl (which by definition cannot be dangerous as they run in the slave interpreter) and C extensions that provides a _SafeInit entry point). For that purpose, the master's @@ -347,13 +367,124 @@ .PP When the \fIaccessPath\fR is changed after the first creation or initialization (i.e. through \fBinterpConfigure -accessPath \fR\fIlist\fR), an \fBauto_reset\fR is automatically evaluated in the safe interpreter to synchronize its \fBauto_index\fR with the new token list. +.SH SYNC MODE +Before Tcl version 8.6.x, the Safe Base kept each safe interpreter's +::auto_path synchronized with a tokenized form of its access path. +Limitations of Tcl 8.4 and earlier made this feature necessary. This +definition of ::auto_path did not conform its specification in library(n) +and pkg_mkIndex(n), but nevertheless worked perfectly well for the discovery +and loading of packages. The introduction of Tcl modules in Tcl 8.5 added a +large number of directories to the access path, and it is inconvenient to +have these additional directories unnecessarily appended to the ::auto_path. +.PP +In order to preserve compatibility with existing code, this synchronization +of the ::auto_path and access path ("Sync Mode" on) is still the default. +However, the Safe Base offers the option of limiting the safe interpreter's +::auto_path to the much shorter list of directories that is necessary for +it to perform its function ("Sync Mode" off). Use the command +\fB::safe::setAutoPathSync\fR to choose the mode before creating any Safe +Base interpreters. +.PP +In either mode, the most convenient way to initialize a safe interpreter is +to call \fB::safe::interpCreate\fR or \fB::safe::interpInit\fR without the +\fB\-accessPath\fR or \fB\-autoPath\fR options (or with the \fB\-accessPath\fR +option set to the +empty list), which will give the safe interpreter the same access as the +master interpreter to packages, modules, and autoloader files. With +"Sync Mode" off, the ::auto_path will be set to a tokenized form of the master's +::auto_path. +.PP +With "Sync Mode" off, if a value is specified for \fB\-autoPath\fR, even the empty +list, in a call to \fB::safe::interpCreate\fR, \fB::safe::interpInit\fR, or +\fB::safe::interpConfigure\fR, it will be tokenized and used as the safe +interpreter's ::auto_path. Any directories that do not also belong to the +access path cannot be tokenized and will be silently ignored. +.PP +With "Sync Mode" off, if the access path is reset to the values in the +master interpreter by calling \fB::safe::interpConfigure\fR with arguments +\fB\-accessPath\fR {}, then the ::auto_path will also be reset unless the argument +\fB\-autoPath\fR is supplied to specify a different value. +.PP +With "Sync Mode" off, if a non-empty value of \fB\-accessPath\fR is supplied, the +safe interpreter's ::auto_path will be set to {} (by +\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR) or left unchanged +(by \fB::safe::interpConfigure\fR). If the same command specifies a new +value for \fB\-autoPath\fR, it will be applied after the \fB\-accessPath\fR argument has +been processed. + +Examples of use with "Sync Mode" off: any of these commands will set the +::auto_path to a tokenized form of its value in the master interpreter: +.RS +.PP +.CS + safe::interpCreate foo + safe::interpCreate foo -accessPath {} + safe::interpInit bar + safe::interpInit bar -accessPath {} + safe::interpConfigure foo -accessPath {} +.CE +.RE +.TP +Example of use with "Sync Mode" off: when initializing a safe interpreter +with a non-empty access path, the ::auto_path will be set to {} unless its +own value is also specified: +.RS +.PP +.CS + safe::interpCreate foo -accessPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib/tcl8.6/http1.0 + /usr/local/TclHome/lib/tcl8.6/opt0.4 + /usr/local/TclHome/lib/tcl8.6/msgs + /usr/local/TclHome/lib/tcl8.6/encoding + /usr/local/TclHome/lib + } + + # The slave's ::auto_path must be given a suitable value: + + safe::interpConfigure foo -autoPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib + } + + # The two commands can be combined: + + safe::interpCreate foo -accessPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib/tcl8.6/http1.0 + /usr/local/TclHome/lib/tcl8.6/opt0.4 + /usr/local/TclHome/lib/tcl8.6/msgs + /usr/local/TclHome/lib/tcl8.6/encoding + /usr/local/TclHome/lib + } -autoPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib + } +.CE +.RE +.TP +Example of use with "Sync Mode" off: the command +\fBsafe::interpAddToAccessPath\fR does not change the safe interpreter's +::auto_path, and so any necessary change must be made by the script: +.RS +.PP +.CS + safe::interpAddToAccessPath foo /usr/local/TclHome/lib/extras/Img1.4.11 + + lassign [safe::interpConfigure foo -autoPath] DUM slaveAutoPath + lappend slaveAutoPath /usr/local/TclHome/lib/extras/Img1.4.11 + safe::interpConfigure foo -autoPath $slaveAutoPath +.CE +.RE +.TP .SH "SEE ALSO" -interp(n), library(n), load(n), package(n), source(n), unknown(n) +interp(n), library(n), load(n), package(n), pkg_mkIndex(n), source(n), +tm(n), unknown(n) .SH KEYWORDS alias, auto\-loading, auto_mkindex, load, master interpreter, safe interpreter, slave interpreter, source '\" Local Variables: '\" mode: nroff '\" End: Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -2128,10 +2128,26 @@ #endif if (!pc) { /* bytecode is starting from scratch */ pc = codePtr->codeStart; + + /* + * Reset the interp's result to avoid possible duplications of large + * objects [3c6e47363e], [781585], [804681], This can happen by start + * also in nested compiled blocks (enclosed in parent cycle). + * See else branch below for opposite handling by continuation/resume. + */ + + objPtr = iPtr->objResultPtr; + if (objPtr->refCount > 1) { + TclDecrRefCount(objPtr); + TclNewObj(objPtr); + Tcl_IncrRefCount(objPtr); + iPtr->objResultPtr = objPtr; + } + goto cleanup0; } else { /* resume from invocation */ CACHE_STACK_INFO(); @@ -2167,11 +2183,11 @@ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", objc, cmdNameBuf), Tcl_GetObjResult(interp)); /* - * Reset the interp's result to avoid possible duplications of large + * Obtain and reset interp's result to avoid possible duplications of * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any * side effects caused by the resetting of errorInfo and errorCode * [Bug 804681], which are not needed here. We chose instead to * manipulate the interp's object result directly. * Index: library/safe.tcl ================================================================== --- library/safe.tcl +++ library/safe.tcl @@ -76,22 +76,33 @@ # #### # Interface/entry point function and front end for "Create" proc ::safe::interpCreate {args} { + variable AutoPathSync + if {$AutoPathSync} { + set autoPath {} + } set Args [::tcl::OptKeyParse ::safe::interpCreate $args] + + set withAutoPath [::tcl::OptProcArgGiven -autoPath] InterpCreate $slave $accessPath \ - [InterpStatics] [InterpNested] $deleteHook + [InterpStatics] [InterpNested] $deleteHook $autoPath $withAutoPath } proc ::safe::interpInit {args} { + variable AutoPathSync + if {$AutoPathSync} { + set autoPath {} + } set Args [::tcl::OptKeyParse ::safe::interpIC $args] if {![::interp exists $slave]} { return -code error "\"$slave\" is not an interpreter" } + set withAutoPath [::tcl::OptProcArgGiven -autoPath] InterpInit $slave $accessPath \ - [InterpStatics] [InterpNested] $deleteHook + [InterpStatics] [InterpNested] $deleteHook $autoPath $withAutoPath } # Check that the given slave is "one of us" proc ::safe::CheckInterp {slave} { namespace upvar ::safe S$slave state @@ -113,10 +124,11 @@ # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 # (hopefully for tcl8.1 ?) proc ::safe::interpConfigure {args} { + variable AutoPathSync switch [llength $args] { 1 { # If we have exactly 1 argument the semantic is to return all # the current configuration. We still call OptKeyParse though # we know that "slave" is our given argument because it also @@ -123,15 +135,21 @@ # checks for the "-help" option. set Args [::tcl::OptKeyParse ::safe::interpIC $args] CheckInterp $slave namespace upvar ::safe S$slave state - return [join [list \ + set TMP [list \ [list -accessPath $state(access_path)] \ [list -statics $state(staticsok)] \ [list -nested $state(nestedok)] \ - [list -deleteHook $state(cleanupHook)]]] + [list -deleteHook $state(cleanupHook)] \ + ] + if {!$AutoPathSync} { + set SLAP [DetokPath $slave [$slave eval set ::auto_path]] + lappend TMP [list -autoPath $SLAP] + } + return [join $TMP] } 2 { # If we have exactly 2 arguments the semantic is a "configure # get" lassign $args slave arg @@ -151,10 +169,18 @@ set item [::tcl::OptCurDesc $desc] set name [::tcl::OptName $item] switch -exact -- $name { -accessPath { return [list -accessPath $state(access_path)] + } + -autoPath { + if {$AutoPathSync} { + return -code error "unknown flag $name (bug)" + } else { + set SLAP [DetokPath $slave [$slave eval set ::auto_path]] + return [list -autoPath $SLAP] + } } -statics { return [list -statics $state(staticsok)] } -nested { @@ -190,14 +216,21 @@ namespace upvar ::safe S$slave state # Get the current (and not the default) values of whatever has # not been given: if {![::tcl::OptProcArgGiven -accessPath]} { - set doreset 1 + set doreset 0 set accessPath $state(access_path) } else { - set doreset 0 + set doreset 1 + } + if {(!$AutoPathSync) && (![::tcl::OptProcArgGiven -autoPath])} { + set SLAP [DetokPath $slave [$slave eval set ::auto_path]] + set autoPath $SLAP + } elseif {$AutoPathSync} { + set autoPath {} + } else { } if { ![::tcl::OptProcArgGiven -statics] && ![::tcl::OptProcArgGiven -noStatics] } then { @@ -215,18 +248,40 @@ } if {![::tcl::OptProcArgGiven -deleteHook]} { set deleteHook $state(cleanupHook) } # we can now reconfigure : - InterpSetConfig $slave $accessPath $statics $nested $deleteHook - # auto_reset the slave (to completly synch the new access_path) + set withAutoPath [::tcl::OptProcArgGiven -autoPath] + set slave_tm_rel [InterpSetConfig $slave $accessPath $statics $nested $deleteHook $autoPath $withAutoPath] + + # auto_reset the slave (to completely synch the new access_path) tests safe-9.8 safe-9.9 if {$doreset} { if {[catch {::interp eval $slave {auto_reset}} msg]} { Log $slave "auto_reset failed: $msg" } else { Log $slave "successful auto_reset" NOTICE } + + # Sync the paths used to search for Tcl modules. + ::interp eval $slave {tcl::tm::path remove {*}[tcl::tm::list]} + if {[llength $state(tm_path_slave)] > 0} { + ::interp eval $slave [list \ + ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] + } + + # Wherever possible, refresh package/module data. + # - Ideally [package ifneeded $pkg $ver {}] would clear the + # stale data from the interpreter, but instead it sets a + # nonsense empty script. + # - We cannot purge stale package data, but we can overwrite + # it where we have fresh data. Any remaining stale data will + # do no harm but the error messages may be cryptic. + ::interp eval $slave [list catch {package require NOEXIST}] + foreach rel $slave_tm_rel { + set cmd [list package require [string map {/ ::} $rel]::NOEXIST] + ::interp eval $slave [list catch $cmd] + } } } } } @@ -247,23 +302,26 @@ # Returns the slave name. # # Optional Arguments : # + slave name : if empty, generated name will be used # + access_path: path list controlling where load/source can occur, -# if empty: the master auto_path will be used. +# if empty: the master auto_path and its subdirectories will be +# used. # + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx) # if 1 :static packages are ok. -# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub) +# + nestedok : flag, if 0 :no loading to sub-sub interps (load xx xx sub) # if 1 : multiple levels are ok. # use the full name and no indent so auto_mkIndex can find us proc ::safe::InterpCreate { slave access_path staticsok nestedok deletehook + autoPath + withAutoPath } { # Create the slave. if {$slave ne ""} { ::interp create -safe $slave } else { @@ -271,24 +329,29 @@ set slave [::interp create -safe] } Log $slave "Created" NOTICE # Initialize it. (returns slave name) - InterpInit $slave $access_path $staticsok $nestedok $deletehook + InterpInit $slave $access_path $staticsok $nestedok $deletehook $autoPath $withAutoPath } # # InterpSetConfig (was setAccessPath) : -# Sets up slave virtual auto_path and corresponding structure within +# Sets up slave virtual access path and corresponding structure within # the master. Also sets the tcl_library in the slave to be the first # directory in the path. # NB: If you change the path after the slave has been initialized you # probably need to call "auto_reset" in the slave in order that it gets # the right auto_index() array values. +# +# It is the caller's responsibility, if it supplies a non-empty value for +# access_path, to make the first directory in the path suitable for use as +# tcl_library, and (if ![setAutoPathSync]), to set the slave's ::auto_path. -proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { +proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook autoPath withAutoPath} { global auto_path + variable AutoPathSync # determine and store the access path if empty if {$access_path eq ""} { set access_path $auto_path @@ -306,34 +369,46 @@ [lreplace $access_path $where $where] \ 0 [info library]] Log $slave "tcl_libray was not in first in auto_path,\ moved it to front of slave's access_path" NOTICE } + + set raw_auto_path $access_path # Add 1st level sub dirs (will searched by auto loading from tcl # code in the slave using glob and thus fail, so we add them here # so by default it works the same). set access_path [AddSubDirs $access_path] + } else { + set raw_auto_path $autoPath + } + + if {$withAutoPath} { + set raw_auto_path $autoPath } Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\ nestedok=$nestedok deletehook=($deletehook)" NOTICE + if {!$AutoPathSync} { + Log $slave "Setting auto_path=($raw_auto_path)" NOTICE + } namespace upvar ::safe S$slave state # clear old autopath if it existed # build new one # Extend the access list with the paths used to look for Tcl Modules. # We save the virtual form separately as well, as syncing it with the # slave has to be defered until the necessary commands are present for # setup. - set norm_access_path {} set slave_access_path {} set map_access_path {} set remap_access_path {} set slave_tm_path {} + set slave_tm_roots {} + set slave_tm_rel {} set i 0 foreach dir $access_path { set token [PathToken $i] lappend slave_access_path $token @@ -341,39 +416,85 @@ lappend remap_access_path $dir $token lappend norm_access_path [file normalize $dir] incr i } + # Set the slave auto_path to a tokenized raw_auto_path. + # Silently ignore any directories that are not in the access path. + # If [setAutoPathSync], SyncAccessPath will overwrite this value with the + # full access path. + # If ![setAutoPathSync], Safe Base code will not change this value. + set tokens_auto_path {} + foreach dir $raw_auto_path { + if {[dict exists $remap_access_path $dir]} { + lappend tokens_auto_path [dict get $remap_access_path $dir] + } + } + ::interp eval $slave [list set auto_path $tokens_auto_path] + + # Add the tcl::tm directories to the access path. set morepaths [::tcl::tm::list] + set firstpass 1 while {[llength $morepaths]} { set addpaths $morepaths set morepaths {} foreach dir $addpaths { # Prevent the addition of dirs on the tm list to the # result if they are already known. if {[dict exists $remap_access_path $dir]} { + if {$firstpass} { + # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. + # Later passes handle subdirectories, which belong in the + # access path but not in the module path. + lappend slave_tm_path [dict get $remap_access_path $dir] + lappend slave_tm_roots [file normalize $dir] [file normalize $dir] + } continue } set token [PathToken $i] lappend access_path $dir lappend slave_access_path $token lappend map_access_path $token $dir lappend remap_access_path $dir $token lappend norm_access_path [file normalize $dir] - lappend slave_tm_path $token + if {$firstpass} { + # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. + # Later passes handle subdirectories, which belong in the + # access path but not in the module path. + lappend slave_tm_path $token + lappend slave_tm_roots [file normalize $dir] [file normalize $dir] + } incr i # [Bug 2854929] # Recursively find deeper paths which may contain # modules. Required to handle modules with names like # 'platform::shell', which translate into # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. - lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] + set next [glob -nocomplain -directory $dir -type d *] + lappend morepaths {*}$next + foreach sub $next { + lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] + set lenny [string length [dict get $slave_tm_roots $dir]] + set relpath [string range [file normalize $sub] $lenny+1 end] + if {$relpath ni $slave_tm_rel} { + lappend slave_tm_rel $relpath + } + } + foreach sub [glob -nocomplain -directory $dir -type d *] { + lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] + set lenny [string length [dict get $slave_tm_roots $dir]] + set relpath [string range [file normalize $sub] $lenny+1 end] + if {$relpath ni $slave_tm_rel} { + lappend slave_tm_rel $relpath + } + } } + set firstpass 0 } set state(access_path) $access_path set state(access_path,map) $map_access_path set state(access_path,remap) $remap_access_path @@ -383,26 +504,52 @@ set state(staticsok) $staticsok set state(nestedok) $nestedok set state(cleanupHook) $deletehook SyncAccessPath $slave + + return $slave_tm_rel +} + + +# +# DetokPath: +# Convert tokens to directories where possible. +# Leave undefined tokens unconverted. They are +# nonsense in both the slave and the master. +# +proc ::safe::DetokPath {slave tokenPath} { + namespace upvar ::safe S$slave state + + set slavePath {} + foreach token $tokenPath { + if {[dict exists $state(access_path,map) $token]} { + lappend slavePath [dict get $state(access_path,map) $token] + } else { + lappend slavePath $token + } + } + return $slavePath } # # -# FindInAccessPath: +# interpFindInAccessPath: # Search for a real directory and returns its virtual Id (including the # "$") +# +# When debugging, use TranslatePath for the inverse operation. proc ::safe::interpFindInAccessPath {slave path} { namespace upvar ::safe S$slave state if {![dict exists $state(access_path,remap) $path]} { - return -code error "$path not found in access path $access_path" + return -code error "$path not found in access path" } return [dict get $state(access_path,remap) $path] } + # # addToAccessPath: # add (if needed) a real directory to access path and return its # virtual token (including the "$"). @@ -435,13 +582,15 @@ slave access_path staticsok nestedok deletehook + autoPath + withAutoPath } { # Configure will generate an access_path when access_path is empty. - InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook + InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook $autoPath $withAutoPath # NB we need to add [namespace current], aliases are always absolute # paths. # These aliases let the slave load files to define new commands @@ -542,10 +691,21 @@ proc ::safe::interpDelete {slave} { Log $slave "About to delete" NOTICE namespace upvar ::safe S$slave state + + # When an interpreter is deleted with [interp delete], any sub-interpreters + # are deleted automatically, but this leaves behind their data in the Safe + # Base. To clean up properly, we call safe::interpDelete recursively on each + # Safe Base sub-interpreter, so each one is deleted cleanly and not by + # the automatic mechanism built into [interp delete]. + foreach sub [interp slaves $slave] { + if {[info exists ::safe::S[list $slave $sub]]} { + ::safe::interpDelete [list $slave $sub] + } + } # If the slave has a cleanup hook registered, call it. Check the # existance because we might be called to delete an interp which has # not been registered with us at all @@ -609,28 +769,32 @@ } # ------------------- END OF PUBLIC METHODS ------------ # -# Sets the slave auto_path to the master recorded value. Also sets -# tcl_library to the first token of the virtual path. +# Sets the slave auto_path to its recorded access path. Also sets +# tcl_library to the first token of the access path. # proc ::safe::SyncAccessPath {slave} { + variable AutoPathSync namespace upvar ::safe S$slave state set slave_access_path $state(access_path,slave) - ::interp eval $slave [list set auto_path $slave_access_path] + if {$AutoPathSync} { + ::interp eval $slave [list set auto_path $slave_access_path] - Log $slave "auto_path in $slave has been set to $slave_access_path"\ - NOTICE + Log $slave "auto_path in $slave has been set to $slave_access_path"\ + NOTICE + } # This code assumes that info library is the first element in the - # list of auto_path's. See -> InterpSetConfig for the code which + # list of access path's. See -> InterpSetConfig for the code which # ensures this condition. ::interp eval $slave [list \ set tcl_library [lindex $slave_access_path 0]] + return } # Returns the virtual token for directory number N. proc ::safe::PathToken {n} { # We need to have a ":" in the token string so [file join] on the @@ -686,10 +850,11 @@ } # AliasGlob is the target of the "glob" alias in safe interpreters. proc ::safe::AliasGlob {slave args} { + variable AutoPathSync Log $slave "GLOB ! $args" NOTICE set cmd {} set at 0 array set got { -directory 0 @@ -708,14 +873,18 @@ set dir {} set virtualdir {} while {$at < [llength $args]} { switch -glob -- [set opt [lindex $args $at]] { - -nocomplain - -- - -join - -tails { + -nocomplain - -- - -tails { lappend cmd $opt set got($opt) 1 incr at + } + -join { + set got($opt) 1 + incr at } -types - -type { lappend cmd -types [lindex $args [incr at]] incr at } @@ -727,19 +896,24 @@ set got($opt) 1 set virtualdir [lindex $args [incr at]] incr at } pkgIndex.tcl { - # Oops, this is globbing a subdirectory in regular package - # search. That is not wanted. Abort, handler does catch - # already (because glob was not defined before). See - # package.tcl, lines 484ff in tclPkgUnknown. - return -code error "unknown command glob" + if {$AutoPathSync} { + # Oops, this is globbing a subdirectory in regular package + # search. That is not wanted. Abort, handler does catch + # already (because glob was not defined before). See + # package.tcl, lines 484ff in tclPkgUnknown. + return -code error "unknown command glob" + } else { + break + } } -* { Log $slave "Safe base rejecting glob option '$opt'" return -code error "Safe base rejecting glob option '$opt'" + # unsafe/unnecessary options rejected: -path } default { break } } @@ -759,11 +933,11 @@ return -code error "permission denied" } lappend cmd -directory $dir } - # Apply the -join semantics ourselves + # Apply the -join semantics ourselves (hence -join not copied to $cmd) if {$got(-join)} { set args [lreplace $args $at end [join [lrange $args $at end] "/"]] } # Process remaining pattern arguments @@ -1052,20 +1226,25 @@ #### # # Setup the arguments parsing # #### + variable AutoPathSync # Share the descriptions - set temp [::tcl::OptKeyRegister { + set OptList { {-accessPath -list {} "access path for the slave"} {-noStatics "prevent loading of statically linked pkgs"} {-statics true "loading of statically linked pkgs"} {-nestedLoadOk "allow nested loading"} {-nested false "nested loading"} {-deleteHook -script {} "delete hook"} - }] + } + if {!$AutoPathSync} { + lappend OptList {-autoPath -list {} "::auto_path for the slave"} + } + set temp [::tcl::OptKeyRegister $OptList] # create case (slave is optional) ::tcl::OptKeyRegister { {?slave? -name {} "name of the slave (optional)"} } ::safe::interpCreate @@ -1097,13 +1276,77 @@ # Log eventually. # To enable error logging, set Log to {puts stderr} for instance, # via setLogCmd. return } + +# Accessor method for ::safe::AutoPathSync +# Usage: ::safe::setAutoPathSync ?newValue? +# Respond to changes by calling Setup again, precerving any +# caller-defined logging. This allows complete equivalence with +# prior Safe Base behavior if AutoPathSync is true. +# +# >>> WARNING <<< +# +# DO NOT CHANGE AutoPathSync EXCEPT BY THIS COMMAND - IT IS VITAL THAT WHENEVER +# THE VALUE CHANGES, THE EXISTING PARSE TOKENS ARE DELETED AND Setup IS CALLED +# AGAIN. +# (The initialization of AutoPathSync at the end of this file is acceptable +# because Setup has not yet been called.) + +proc ::safe::setAutoPathSync {args} { + variable AutoPathSync + + if {[llength $args] == 0} { + } elseif {[llength $args] == 1} { + set newValue [lindex $args 0] + if {![string is boolean -strict $newValue]} { + return -code error "new value must be a valid boolean" + } + set args [expr {$newValue && $newValue}] + if {([info vars ::safe::S*] ne {}) && ($args != $AutoPathSync)} { + return -code error \ + "cannot set new value while Safe Base slaves exist" + } + if {($args != $AutoPathSync)} { + set AutoPathSync {*}$args + ::tcl::OptKeyDelete ::safe::interpCreate + ::tcl::OptKeyDelete ::safe::interpIC + set TmpLog [setLogCmd] + Setup + setLogCmd $TmpLog + } + } else { + set msg {wrong # args: should be "safe::setAutoPathSync ?newValue?"} + return -code error $msg + } + + return $AutoPathSync +} namespace eval ::safe { - # internal variables + # internal variables (must not begin with "S") + + # AutoPathSync + # + # Set AutoPathSync to 0 to give a slave's ::auto_path the same meaning as + # for an unsafe interpreter: the package command will search its directories + # and first-level subdirectories for pkgIndex.tcl files; the auto-loader + # will search its directories for tclIndex files. The access path and + # module path will be maintained as separate values, and ::auto_path will + # not be updated when the user calls ::safe::interpAddToAccessPath to add to + # the access path. If the user specifies an access path when calling + # interpCreate, interpInit or interpConfigure, it is the user's + # responsibility to define the slave's auto_path. If these commands are + # called with no (or empty) access path, the slave's auto_path will be set + # to a tokenized form of the master's auto_path, and these directories and + # their first-level subdirectories will be added to the access path. + # + # Set to 1 for "traditional" behavior: a slave's entire access path and + # module path are copied to its ::auto_path, which is updated whenever + # the user calls ::safe::interpAddToAccessPath to add to the access path. + variable AutoPathSync 1 # Log command, set via 'setLogCmd'. Logging is disabled when empty. variable Log {} # The package maintains a state array per slave interp under its @@ -1121,8 +1364,12 @@ # access_path,remap : dict ( path -> token ) # tm_path_slave : List of TM root directories, as tokens seen by the slave. # staticsok : Value of option -statics # nestedok : Value of option -nested # cleanupHook : Value of option -deleteHook + # + # Because the slave can change its value of ::auto_path, the value of + # option -autoPath is not stored in the array but must be obtained from + # the slave. } ::safe::Setup Index: library/tclIndex ================================================================== --- library/tclIndex +++ library/tclIndex @@ -59,10 +59,11 @@ 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(::safe::setAutoPathSync) [list 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]] ADDED tests/auto-files.zip Index: tests/auto-files.zip ================================================================== --- /dev/null +++ tests/auto-files.zip cannot compute difference between binary files ADDED tests/auto0/auto1/file1.tcl Index: tests/auto0/auto1/file1.tcl ================================================================== --- /dev/null +++ tests/auto0/auto1/file1.tcl @@ -0,0 +1,3 @@ +proc report1 {args} { + return ok1 +} ADDED tests/auto0/auto1/package1.tcl Index: tests/auto0/auto1/package1.tcl ================================================================== --- /dev/null +++ tests/auto0/auto1/package1.tcl @@ -0,0 +1,5 @@ +proc HeresPackage1 {args} { + return OK1 +} + +package provide SafeTestPackage1 1.2.3 ADDED tests/auto0/auto1/pkgIndex.tcl Index: tests/auto0/auto1/pkgIndex.tcl ================================================================== --- /dev/null +++ tests/auto0/auto1/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]] ADDED tests/auto0/auto1/tclIndex Index: tests/auto0/auto1/tclIndex ================================================================== --- /dev/null +++ tests/auto0/auto1/tclIndex @@ -0,0 +1,9 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(report1) [list source [file join $dir file1.tcl]] ADDED tests/auto0/auto2/file2.tcl Index: tests/auto0/auto2/file2.tcl ================================================================== --- /dev/null +++ tests/auto0/auto2/file2.tcl @@ -0,0 +1,3 @@ +proc report2 {args} { + return ok2 +} ADDED tests/auto0/auto2/package2.tcl Index: tests/auto0/auto2/package2.tcl ================================================================== --- /dev/null +++ tests/auto0/auto2/package2.tcl @@ -0,0 +1,5 @@ +proc HeresPackage2 {args} { + return OK2 +} + +package provide SafeTestPackage2 2.3.4 ADDED tests/auto0/auto2/pkgIndex.tcl Index: tests/auto0/auto2/pkgIndex.tcl ================================================================== --- /dev/null +++ tests/auto0/auto2/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]] ADDED tests/auto0/auto2/tclIndex Index: tests/auto0/auto2/tclIndex ================================================================== --- /dev/null +++ tests/auto0/auto2/tclIndex @@ -0,0 +1,9 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(report2) [list source [file join $dir file2.tcl]] ADDED tests/auto0/modules/mod1/test1-1.0.tm Index: tests/auto0/modules/mod1/test1-1.0.tm ================================================================== --- /dev/null +++ tests/auto0/modules/mod1/test1-1.0.tm @@ -0,0 +1,5 @@ +namespace eval mod1::test1 {} + +proc mod1::test1::try1 args { + return res1 +} ADDED tests/auto0/modules/mod2/test2-2.0.tm Index: tests/auto0/modules/mod2/test2-2.0.tm ================================================================== --- /dev/null +++ tests/auto0/modules/mod2/test2-2.0.tm @@ -0,0 +1,5 @@ +namespace eval mod2::test2 {} + +proc mod2::test2::try2 args { + return res2 +} ADDED tests/auto0/modules/test0-0.5.tm Index: tests/auto0/modules/test0-0.5.tm ================================================================== --- /dev/null +++ tests/auto0/modules/test0-0.5.tm @@ -0,0 +1,5 @@ +namespace eval test0 {} + +proc test0::try0 args { + return res0 +} Index: tests/pkgIndex.tcl ================================================================== --- tests/pkgIndex.tcl +++ tests/pkgIndex.tcl Index: tests/safe.test ================================================================== --- tests/safe.test +++ tests/safe.test @@ -15,18 +15,96 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } +testConstraint AutoSyncDefined 1 + foreach i [interp slaves] { interp delete $i } set saveAutoPath $::auto_path set ::auto_path [info library] -# Force actual loading of the safe package because we use un exported (and +# The defunct package http 1.0 was convenient for testing package loading. +# - Replaced here with tests using example packages provided in subdirectory +# auto0 of the tests directory, which are independent of any changes +# made to the packages provided with Tcl. +# - These are tests 7.1 7.2 7.4 9.10 9.12 18.1 18.2 18.4 +# - Tests 7.0[a-f] test the example packages themselves before they +# are used to test Safe Base interpreters. +# - Alternatively use packages opt and (from cookiejar) tcl::idna. +# - These alternative tests have suffix "opt". +# - These are 7.[124]opt, 9.1[02]opt, 18.[124]opt. +# - Tests 7.[124]opt, 9.1[02]opt, 18.[124]opt use "package require opt". +# - Tests 9.1[02]opt also use "package require tcl::idna". +# +# When using package opt for testing positive/negative package search: +# - The directory location and the error message depend on whether +# and how the package is installed. + +# Error message for tests 7.2opt, 18.2opt for "package require opt". +if {[string match *zipfs:/* [info library]]} { + # pkgIndex.tcl is in [info library] + # file to be sourced is in [info library]/opt* + set pkgOptErrMsg {permission denied} +} else { + # pkgIndex.tcl and file to be sourced are + # both in [info library]/opt* + set pkgOptErrMsg {can't find package opt} +} + +# Directory of opt for tests 7.4opt, 9.10opt, 9.12opt, 18.4opt +# for "package require opt". +if {[file exists [file join [info library] opt0.4]]} { + # Installed files in lib8.7/opt0.4 + set pkgOptDir opt0.4 +} elseif {[file exists [file join [info library] opt]]} { + # Installed files in zipfs, or source files used by "make test" + set pkgOptDir opt +} else { + error {cannot find opt library} +} + +# Directory of cookiejar for tests 9.10opt, 9.12opt +# for "package require tcl::idna". +if {[file exists [file join [info library] cookiejar0.2]]} { + # Installed files in lib8.7/cookiejar0.2 + set pkgJarDir cookiejar0.2 +} elseif {[file exists [file join [info library] cookiejar]]} { + # Installed files in zipfs, or source files used by "make test" + set pkgJarDir cookiejar +} else { + error {cannot find cookiejar library} +} + +set TestsDir [file normalize [file dirname [info script]]] +set ZipMountPoint [zipfs root]auto-files +zipfs mount $ZipMountPoint [file join $TestsDir auto-files.zip] + +set PathMapp {} +lappend PathMapp [file join [info library] $pkgOptDir] TCLLIB/OPTDIR +lappend PathMapp [file join [info library] $pkgJarDir] TCLLIB/JARDIR +lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR $ZipMountPoint ZIPDIR + +proc mapList {map listIn} { + set listOut {} + foreach element $listIn { + lappend listOut [string map $map $element] + } + return $listOut +} +proc mapAndSortList {map listIn} { + set listOut {} + foreach element $listIn { + lappend listOut [string map $map $element] + } + lsort $listOut +} + +# Force actual loading of the safe package because we use un-exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) @@ -177,40 +255,541 @@ } {byteOrder engine pathSeparator platform pointerSize wordSize} # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... +# Tests 7.0* test the example files before using them to test safe interpreters. + +test safe-7.0a {example tclIndex commands, test in master interpreter} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + set ::auto_path $tmpAutoPath + auto_reset +} -match glob -result {0 ok1 0 ok2} +test safe-7.0az {example tclIndex commands, test in master interpreter; zipfs} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + set ::auto_path $tmpAutoPath + auto_reset +} -match glob -result {0 ok1 0 ok2} +test safe-7.0b {example tclIndex commands, negative test in master interpreter} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + set ::auto_path $tmpAutoPath + auto_reset +} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}} +test safe-7.0bz {example tclIndex commands, negative test in master interpreter; zipfs} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $ZipMountPoint auto0] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + set ::auto_path $tmpAutoPath + auto_reset +} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}} +test safe-7.0c {example pkgIndex.tcl packages, test in master interpreter, child directories} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + set code4 [catch {package require SafeTestPackage2} msg4] + set code5 [catch HeresPackage1 msg5] + set code6 [catch HeresPackage2 msg6] + + list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 +} -cleanup { + set ::auto_path $tmpAutoPath + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + catch {rename HeresPackage1 {}} + catch {rename HeresPackage2 {}} +} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} +test safe-7.0cz {example pkgIndex.tcl packages, test in master interpreter, child directories; zipfs} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $ZipMountPoint auto0] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + set code4 [catch {package require SafeTestPackage2} msg4] + set code5 [catch HeresPackage1 msg5] + set code6 [catch HeresPackage2 msg6] + list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 +} -cleanup { + set ::auto_path $tmpAutoPath + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + catch {rename HeresPackage1 {}} + catch {rename HeresPackage2 {}} +} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} +test safe-7.0d {example pkgIndex.tcl packages, test in master interpreter, main directories} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + set code4 [catch {package require SafeTestPackage2} msg4] + set code5 [catch HeresPackage1 msg5] + set code6 [catch HeresPackage2 msg6] + + list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 +} -cleanup { + set ::auto_path $tmpAutoPath + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + catch {rename HeresPackage1 {}} + catch {rename HeresPackage2 {}} +} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} +test safe-7.0dz {example pkgIndex.tcl packages, test in master interpreter, main directories; zipfs} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + set code4 [catch {package require SafeTestPackage2} msg4] + set code5 [catch HeresPackage1 msg5] + set code6 [catch HeresPackage2 msg6] + list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6 +} -cleanup { + set ::auto_path $tmpAutoPath + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + catch {rename HeresPackage1 {}} + catch {rename HeresPackage2 {}} +} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} +test safe-7.0e {example modules packages, test in master interpreter, replace path} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + set out0 [test0::try0] + set out1 [mod1::test1::try1] + set out2 [mod2::test2::try2] + + list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + catch {namespace delete ::test0} + catch {namespace delete ::mod1} +} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} +test safe-7.0ez {example modules packages, test in master interpreter, replace path; zipfs} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + set out0 [test0::try0] + set out1 [mod1::test1::try1] + set out2 [mod2::test2::try2] + list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + catch {namespace delete ::test0} + catch {namespace delete ::mod1} +} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} +test safe-7.0f {example modules packages, test in master interpreter, append to path} -setup { + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + set out0 [test0::try0] + set out1 [mod1::test1::try1] + set out2 [mod2::test2::try2] + + list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + catch {namespace delete ::test0} + catch {namespace delete ::mod1} +} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} +test safe-7.0fz {example modules packages, test in master interpreter, append to path; zipfs} -setup { + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + set out0 [test0::try0] + set out1 [mod1::test1::try1] + set out2 [mod2::test2::try2] + list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + catch {namespace delete ::test0} + catch {namespace delete ::mod1} +} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} + +# high level general test +# Use example packages not tcl8.x/opt +test safe-7.1 {tests that everything works at high level with conventional AutoPathSync} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0] + set i [safe::interpCreate] + set ::auto_path $tmpAutoPath +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i {HeresPackage1} + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 1.2.3 +# high level general test +# Use zipped example packages not tcl8.x/opt +test safe-7.1z {tests that everything works at high level with conventional AutoPathSync; zipfs} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $ZipMountPoint auto0] + set i [safe::interpCreate] + set ::auto_path $tmpAutoPath +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i {HeresPackage1} + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 1.2.3 # high level general test -test safe-7.1 {tests that everything works at high level} -body { +test safe-7.1opt {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set i [safe::interpCreate] +} -body { # no error shall occur: # (because the default access_path shall include 1st level sub dirs so # package require in a slave works like in the master) - set v [interp eval $i {package require http 2}] + set v [interp eval $i {package require opt}] # no error shall occur: - interp eval $i {http::config} - safe::interpDelete $i + interp eval $i {::tcl::Lempty {a list}} set v -} -match glob -result 2.* -test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 0.4.* +test safe-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $token1 $token2 $token3 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ + 1 {can't find package SafeTestPackage1} --\ + {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}} +test safe-7.2z {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync; zipfs} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $token1 $token2 $token3 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ + 1 {can't find package SafeTestPackage1} --\ + {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}} +test safe-7.2opt {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync, use pkg opt} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] - # should add as p1 + # should add as p* (not p1 if master has a module path) set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] - # an error shall occur (http is not anymore in the secure 0-level + # an error shall occur (opt is not anymore in the secure 0-level # provided deep path) - list $token1 $token2 \ - [catch {interp eval $i {package require http 1}} msg] $msg \ - [safe::interpConfigure $i]\ - [safe::interpDelete $i] -} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + list $token1 $token2 -- \ + [catch {interp eval $i {package require opt}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package opt} --\ + {TCLLIB */dummy/unixlike/test/path} -- {}} test safe-7.3 {check that safe subinterpreters work} { + set g [interp slaves] + if {$g ne {}} { + append g { -- residue of an earlier test} + } + set h [info vars ::safe::S*] + if {$h ne {}} { + append h { -- residue of an earlier test} + } set i [safe::interpCreate] set j [safe::interpCreate [list $i x]] - list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] -} {ok {} 0} + list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] [info vars ::safe::S*] +} {{} {} ok {} 0 {}} +test safe-7.4 {tests specific path and positive search with conventional AutoPathSync} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # this time, unlike test safe-7.2, SafeTestPackage1 should be found + list $token1 $token2 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] + # Note that the glob match elides directories (those from the module path) + # other than the first and last in the access path. +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ + {TCLLIB * TESTSDIR/auto0/auto1} -- {}} +test safe-7.4z {tests specific path and positive search with conventional AutoPathSync; zipfs} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # this time, unlike test safe-7.2, SafeTestPackage1 should be found + list $token1 $token2 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] + # Note that the glob match elides directories (those from the module path) + # other than the first and last in the access path. +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ + {TCLLIB * ZIPDIR/auto0/auto1} -- {}} +test safe-7.4opt {tests specific path and positive search with conventional AutoPathSync, use pkg opt} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } else { + set SyncVal_TMP 1 + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # this time, unlike test safe-7.2opt, opt should be found + list $token1 $token2 -- \ + [catch {interp eval $i {package require opt}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] + # Note that the glob match elides directories (those from the module path) + # other than the first and last in the access path. +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\ + {TCLLIB * TCLLIB/OPTDIR} -- {}} + +test safe-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + + set i [safe::interpCreate] + + interp eval $i { + package forget platform::shell + package forget platform + catch {namespace delete ::platform} + } +} -body { + # Should raise an error (module ancestor directory issue) + set code1 [catch {interp eval $i {package require shell}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require platform::shell}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -result {1 {can't find package shell} 0} # test source control on file name set i "a" test safe-8.1 {safe source control on file} -setup { catch {safe::interpDelete $i} @@ -401,11 +980,1262 @@ [safe::interpConfigure $i -DEL]\ [safe::interpConfigure $i -accessPath /blah -statics 1 safe::interpConfigure $i]\ [safe::interpConfigure $i -deleteHook toto -nosta -nested 0 safe::interpConfigure $i] +} -cleanup { + safe::interpDelete $i +} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}} +test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { + # this test shall work, believed equivalent to 9.6 + set i [safe::interpCreate \ + -noStatics \ + -nestedLoadOk \ + -deleteHook {foo bar} \ + ] + + safe::interpConfigure $i -accessPath /foo/bar + set a [safe::interpConfigure $i] + set b [safe::interpConfigure $i -aCCess] + set c [safe::interpConfigure $i -nested] + set d [safe::interpConfigure $i -statics] + set e [safe::interpConfigure $i -DEL] + safe::interpConfigure $i -accessPath /blah -statics 1 + set f [safe::interpConfigure $i] + safe::interpConfigure $i -deleteHook toto -nosta -nested 0 + set g [safe::interpConfigure $i] + + list $a $b $c $d $e $f $g +} -cleanup { + safe::interpDelete $i } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}} +test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Load and run the commands. + # This guarantees the test will pass even if the tokens are swapped. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} + +test safe-9.8z {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Load and run the commands. + # This guarantees the test will pass even if the tokens are swapped. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto2] \ + [file join $ZipMountPoint auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ + {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} + +test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Do not load the commands. With the tokens swapped, the test + # will pass only if the Safe Base has called auto_reset. + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load and run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} + +test safe-9.9z {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Do not load the commands. With the tokens swapped, the test + # will pass only if the Safe Base has called auto_reset. + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto2] \ + [file join $ZipMountPoint auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load and run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 ok1 0 ok2 --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ + {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} +test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + # For complete correspondence to safe-9.10opt, include auto0 in access path. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. + # This would have no effect because the records in Pkg of these directories + # were from access as children of {$p(:1:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + 0 OK1 0 OK2} +test safe-9.10z {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + # For complete correspondence to safe-9.10opt, include auto0 in access path. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0] \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. + # This would have no effect because the records in Pkg of these directories + # were from access as children of {$p(:1:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0] \ + [file join $ZipMountPoint auto0 auto2] \ + [file join $ZipMountPoint auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ + {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ + {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\ + 0 OK1 0 OK2} +test safe-9.10opt {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $tcl_library $pkgOptDir] \ + [file join $tcl_library $pkgJarDir]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] + set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + # This has no effect because the records in Pkg of these directories were from access as children of {$p(:0:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $tcl_library $pkgJarDir] \ + [file join $tcl_library $pkgOptDir]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] + set path4 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require tcl::idna}} msg3] + set code4 [catch {interp eval $i {package require opt}} msg4] + set code5 [catch {interp eval $i {::tcl::Lempty {a list}}} msg5] + set code6 [catch {interp eval $i {::tcl::idna::IDNAencode example.com}} msg6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\ + {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\ + {TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\ + 0 0 0 example.com} +test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- \ + $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + 0 OK1 0 OK2} +test safe-9.11z {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto2] \ + [file join $ZipMountPoint auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 1.2.3 0 2.3.4 --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ + {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\ + 0 OK1 0 OK2} +test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] + set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] + + # Try to load the packages. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] + set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] + + list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ + 1 {* not found in access path} -- 1 1 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}} +test safe-9.12z {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set code4 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]} path4] + set code5 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]} path5] + + # Try to load the packages. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] + set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] + + list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ + $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ + 1 {* not found in access path} -- 1 1 --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}} +test safe-9.12opt {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $tcl_library $pkgOptDir] \ + [file join $tcl_library $pkgJarDir]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] + set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set code4 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]} path4] + set code5 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]} path5] + + # Try to load the packages. + set code3 [catch {interp eval $i {package require opt}} msg3] + set code6 [catch {interp eval $i {package require tcl::idna}} msg6] + + list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ + $mappA -- $mappB +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ + 1 {* not found in access path} -- 1 1 --\ + {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}} +test safe-9.20 {check module loading} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} -- res0 res1 res2} +# - The command safe::InterpSetConfig adds the master's [tcl::tm::list] in +# tokenized form to the slave's access path, and then adds all the +# descendants, discovered recursively by using glob. +# - The order of the directories in the list returned by glob is system-dependent, +# and therefore this is true also for (a) the order of token assignment to +# descendants of the [tcl::tm::list] roots; and (b) the order of those same +# directories in the access path. Both those things must be sorted before +# comparing with expected results. The test is therefore not totally strict, +# but will notice missing or surplus directories. +test safe-9.20z {check module loading; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ + ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Load pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.21z {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Load pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ + ZIPDIR/auto0/modules/mod2} --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ + ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.22z {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ + ZIPDIR/auto0/modules/mod2} --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ + ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Refresh stale pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 + +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.23z {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Refresh stale pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ + ZIPDIR/auto0/modules/mod2} --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ + ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-9.24z {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 1 + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $ZipMountPoint auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $ZipMountPoint auto0 auto1] \ + [file join $ZipMountPoint auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $ZipMountPoint auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ + ZIPDIR/auto0/modules/mod2} --\ + {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ + ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { @@ -606,10 +2436,19 @@ upvar 1 testdir testdir testdir2 testdir2 testfile testfile set testdir [makeDirectory deletethisdir] set testdir2 [makeDirectory deletemetoo $testdir] set testfile [makeFile {} $filename $testdir2] } +proc buildEnvironment2 {filename} { + upvar 1 testdir testdir testdir2 testdir2 testfile testfile + upvar 1 testdir3 testdir3 testfile2 testfile2 + set testdir [makeDirectory deletethisdir] + set testdir2 [makeDirectory deletemetoo $testdir] + set testfile [makeFile {} $filename $testdir2] + set testdir3 [makeDirectory deleteme $testdir] + set testfile2 [makeFile {} $filename $testdir3] +} #### New tests for Safe base glob, with patches @ Bug 2964715 test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { $i eval glob * @@ -677,25 +2516,37 @@ glob -nocomplain -directory $testdir [file join deletemetoo *.tm] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} -test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup { +test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment pkgIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 - string map [list $safeTD EXPECTED] [$i eval [list \ + mapList [list $safeTD EXPECTED] [$i eval [list \ + glob -directory $safeTD -join * pkgIndex.tcl]] +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {EXPECTED/deletemetoo/pkgIndex.tcl} +test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { + set i [safe::interpCreate] + buildEnvironment2 pkgIndex.tcl +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + ::safe::interpAddToAccessPath $i $testdir3 + mapAndSortList [list $safeTD EXPECTED] [$i eval [list \ glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir -} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}} -# Note the extra {} around the result above; that's *expected* because of the -# format of virtual path roots. -test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup { +} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl} +# See comments on lsort after test safe-9.20. +test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment notIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 @@ -729,10 +2580,11 @@ } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} rename buildEnvironment {} +rename buildEnvironment2 {} #### Test for the module path test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { @@ -825,14 +2677,492 @@ ::safe::interpAddToAccessPath $i $~$tcl_platform(user) $i eval [list glob -nocomplain ~$tcl_platform(user)/*] } -cleanup { safe::interpDelete $i } -result {} - + +### 17. The first element in a slave's ::auto_path and access path must be [info library]. + +test safe-17.1 {Check that first element of slave auto_path (and access path) is Tcl Library} -setup { + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + return [list [lindex $accessList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i +} -result [list [info library] [info library]] + +test safe-17.2 {Check that first element of slave auto_path (and access path) is Tcl Library, even if not true for master} -setup { + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib2 $lib1] + # Unexpected order, should be reversed in the slave + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + + return [list [lindex $accessList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i +} -result [list [info library] [info library]] + +### 18. Tests for AutoSyncDefined without conventional AutoPathSync, i.e. with AutoPathSync off. + +test safe-18.1 {cf. safe-7.1 - tests that everything works at high level without conventional AutoPathSync} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } + + # Without AutoPathSync, we need a more complete auto_path, + # because the slave will use the same value. + set lib1 [info library] + set lib2 [file join $TestsDir auto0] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i HeresPackage1 + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 1.2.3 +test safe-18.1z {cf. safe-7.1 - tests that everything works at high level without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } + + # Without AutoPathSync, we need a more complete auto_path, + # because the slave will use the same value. + set lib1 [info library] + set lib2 [file join $ZipMountPoint auto0] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i HeresPackage1 + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 1.2.3 +test safe-18.1opt {cf. safe-7.1opt - tests that everything works at high level without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } + + # Without AutoPathSync, we need a more complete auto_path, + # because the slave will use the same value. + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require opt}] + # no error shall occur: + interp eval $i {::tcl::Lempty {a list}} + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result 0.4.* +test safe-18.2 {cf. safe-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + set auto1 [interp eval $i {set ::auto_path}] + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $auto1 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)}\ + 1 {can't find package SafeTestPackage1}\ + {-accessPath {[list $tcl_library \ + */dummy/unixlike/test/path \ + $TestsDir/auto0]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}" +test safe-18.2z {cf. safe-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + set auto1 [interp eval $i {set ::auto_path}] + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $auto1 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)}\ + 1 {can't find package SafeTestPackage1}\ + {-accessPath {[list $tcl_library \ + */dummy/unixlike/test/path \ + $ZipMountPoint/auto0]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}" +test safe-18.2opt {cf. safe-7.2opt - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + set auto1 [interp eval $i {set ::auto_path}] + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # an error shall occur (opt is not anymore in the secure 0-level + # provided deep path) + list $auto1 $token1 $token2 \ + [catch {interp eval $i {package require opt}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} 1 {$pkgOptErrMsg}\ + {-accessPath {[list $tcl_library */dummy/unixlike/test/path]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}" +test safe-18.3 {Check that default auto_path is the same as in the master interpreter without conventional AutoPathSync} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } + + set i [safe::interpCreate] + +} -body { + # This file's header sets auto_path to a single directory [info library], + # which is the one required by Safe Base to be present & first in the list. + + set ap {} + foreach token [$i eval set ::auto_path] { + lappend ap [dict get [set ::safe::S${i}(access_path,map)] $token] + } + return $ap +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -result $::auto_path +test safe-18.4 {cf. safe-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]] + + # This time, unlike test safe-18.2 and the try above, SafeTestPackage1 should be found: + list $auto1 $auto2 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3\ + {-accessPath {[list $tcl_library *$TestsDir/auto0 $TestsDir/auto0/auto1]}\ + -statics 0 -nested 1 -deleteHook {}\ + -autoPath {[list $tcl_library $TestsDir/auto0]}} {}" +test safe-18.4z {cf. safe-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]] + + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]] + + # This time, unlike test safe-18.2 and the try above, SafeTestPackage1 should be found: + list $auto1 $auto2 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3\ + {-accessPath {[list $tcl_library *$ZipMountPoint/auto0 $ZipMountPoint/auto0/auto1]}\ + -statics 0 -nested 1 -deleteHook {}\ + -autoPath {[list $tcl_library $ZipMountPoint/auto0]}} {}" +test safe-18.4opt {cf. safe-7.4opt - tests specific path and positive search and auto_path without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + # This time, unlike test safe-18.2opt and the try above, opt should be found: + list $auto1 $auto2 $token1 $token2 \ + [catch {interp eval $i {package require opt}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} 0 0.4.*\ + {-accessPath {[list $tcl_library *$tcl_library/$pkgOptDir]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}" +test safe-18.5 {cf. safe-7.5 - tests positive and negative module loading without conventional AutoPathSync} -setup { + # All ::safe commands are loaded at start of file. + set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}] + + if {$SyncExists} { + set SyncVal_TMP [safe::setAutoPathSync] + safe::setAutoPathSync 0 + } else { + error {This test is meaningful only if the command ::safe::setAutoPathSync is defined} + } + + set i [safe::interpCreate] + + interp eval $i { + package forget platform::shell + package forget platform + catch {namespace delete ::platform} + } +} -body { + # Should raise an error (tests module ancestor directory rule) + set code1 [catch {interp eval $i {package require shell}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require platform::shell}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setAutoPathSync $SyncVal_TMP + } +} -result {1 {can't find package shell} 0} + + + +### 19. Test tokenization of directories available to a slave. + +test safe-19.1 {Check that each directory of the default auto_path is a valid token} -setup { + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {set ::auto_path}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i +} -result {} + +test safe-19.2 {Check that each directory of the module path is a valid token} -setup { + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {::tcl::tm::path list}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i +} -result {} + + set ::auto_path $saveAutoPath +zipfs unmount ${ZipMountPoint} +unset pkgOptErrMsg pkgOptDir pkgJarDir saveAutoPath TestsDir ZipMountPoint PathMapp +rename mapList {} +rename mapAndSortList {} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: