summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/safe.n179
-rw-r--r--library/package.tcl10
-rw-r--r--library/safe.tcl454
-rw-r--r--library/tclIndex1
-rw-r--r--library/tm.tcl11
-rw-r--r--tests/auto-files.zipbin0 -> 4447 bytes
-rw-r--r--tests/auto0/auto1/file1.tcl3
-rw-r--r--tests/auto0/auto1/package1.tcl5
-rw-r--r--tests/auto0/auto1/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto1/tclIndex9
-rw-r--r--tests/auto0/auto2/file2.tcl3
-rw-r--r--tests/auto0/auto2/package2.tcl5
-rw-r--r--tests/auto0/auto2/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto2/tclIndex9
-rw-r--r--tests/auto0/modules/mod1/test1-1.0.tm5
-rw-r--r--tests/auto0/modules/mod2/test2-2.0.tm5
-rw-r--r--tests/auto0/modules/test0-0.5.tm5
-rw-r--r--tests/safe-stock87.test450
-rw-r--r--tests/safe-zipfs.test950
-rw-r--r--tests/safe.test2822
20 files changed, 4826 insertions, 122 deletions
diff --git a/doc/safe.n b/doc/safe.n
index b39f2c2..ab424d3 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -23,10 +23,13 @@ safe \- Creating and manipulating safe interpreters
.sp
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
.sp
+\fB::safe::setSyncMode\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?
@@ -72,11 +75,19 @@ See the \fBOPTIONS\fR section below for a description of the
optional arguments.
If the \fIslave\fR argument is omitted, a name will be generated.
\fB::safe::interpCreate\fR always returns the interpreter name.
+.sp
+The interpreter name \fIslave\fR may include namespace separators,
+but may not have leading or trailing namespace separators, or excess
+colon characters in namespace separators. The interpreter name is
+qualified relative to the global namespace ::, not the namespace in which
+the \fB::safe::interpCreate\fR command is evaluated.
.TP
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
This command is similar to \fBinterpCreate\fR except it that does not
create the safe interpreter. \fIslave\fR must have been created by some
-other means, like \fBinterp create\fR \fB\-safe\fR.
+other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter
+name \fIslave\fR may include namespace separators, subject to the same
+restrictions as for \fBinterpCreate\fR.
.TP
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
@@ -140,6 +151,15 @@ $slave eval [list set tk_library \e
.CE
.RE
.TP
+\fB::safe::setSyncMode\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.
@@ -191,6 +211,13 @@ 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).
@@ -323,7 +350,8 @@ 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
@@ -349,8 +377,153 @@ 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 TYPICAL USE
+In many cases, the properties of a Safe Base interpreter can be specified
+when the interpreter is created, and then left unchanged for the lifetime
+of the interpreter.
+.PP
+If you wish to use Safe Base interpreters with "Sync Mode" off, evaluate
+the command
+.RS
+.PP
+.CS
+ safe::setSyncMode 0
+.CE
+.RE
+.PP
+Use \fB::safe::interpCreate\fR or \fB::safe::interpInit\fR to create an
+interpreter with the properties that you require. The simplest way is not
+to specify \fB\-accessPath\fR or \fB\-autoPath\fR, which means the safe
+interpreter will use the same paths as the master interpreter. However,
+if \fB\-accessPath\fR is specified, then \fB\-autoPath\fR must also be
+specified, or else it will be set to {}.
+.PP
+The value of \fB\-autoPath\fR will be that required to access tclIndex
+and pkgIndex.txt files according to the same rules as an unsafe
+interpreter (see pkg_mkIndex(n) and library(n)).
+.PP
+With "Sync Mode" on, the option \fB\-autoPath\fR is undefined, and
+the Safe Base sets the slave's ::auto_path to a tokenized form of the
+access path. In addition to the directories present if "Safe Mode" is off,
+the ::auto_path includes the numerous subdirectories and module paths
+that belong to the access path.
+.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::setSyncMode\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 Safe Base will set the value of \fB\-autoPath\fR to the
+master's ::auto_path, and will set the slave's ::auto_path 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. However, the
+value of \fB\-autoPath\fR will remain as specified, and will be used to
+re-tokenize the slave's ::auto_path if \fB::safe::interpConfigure\fR is called
+to change the value of \fB\-accessPath\fR.
+.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
diff --git a/library/package.tcl b/library/package.tcl
index 6c87ec1..bf3e926 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -479,9 +479,12 @@ proc tclPkgUnknown {name args} {
}
set tclSeenPath($dir) 1
- # we can't use glob in safe interps, so enclose the following in a
- # catch statement, where we get the pkgIndex files out of the
- # subdirectories
+ # Get the pkgIndex.tcl files in subdirectories of auto_path directories.
+ # - Safe Base interpreters have a restricted "glob" command that
+ # works in this case.
+ # - The "catch" was essential when there was no safe glob and every
+ # call in a safe interp failed; it is retained only for corner
+ # cases in which the eventual call to glob returns an error.
catch {
foreach file [glob -directory $dir -join -nocomplain \
* pkgIndex.tcl] {
@@ -593,6 +596,7 @@ proc tcl::MacOSXPkgUnknown {original name args} {
set tclSeenPath($dir) 1
# get the pkgIndex files out of the subdirectories
+ # Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl.
foreach file [glob -directory $dir -join -nocomplain \
* Resources Scripts pkgIndex.tcl] {
set dir [file dirname $file]
diff --git a/library/safe.tcl b/library/safe.tcl
index 470cfa3..b5ee95f 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -78,23 +78,37 @@ proc ::safe::InterpNested {} {
# 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]
+ RejectExcessColons $slave
+
+ 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"
}
+ RejectExcessColons $slave
+
+ 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
+ namespace upvar ::safe [VarName $slave] state
if {![info exists state] || ![::interp exists $slave]} {
return -code error \
"\"$slave\" is not an interpreter managed by ::safe::"
@@ -115,6 +129,7 @@ proc ::safe::CheckInterp {slave} {
# 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
@@ -123,13 +138,18 @@ proc ::safe::interpConfigure {args} {
# checks for the "-help" option.
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $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} {
+ lappend TMP [list -autoPath $state(auto_path)]
+ }
+ return [join $TMP]
}
2 {
# If we have exactly 2 arguments the semantic is a "configure
@@ -146,7 +166,7 @@ proc ::safe::interpConfigure {args} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
CheckInterp $slave
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
set item [::tcl::OptCurDesc $desc]
set name [::tcl::OptName $item]
@@ -154,6 +174,13 @@ proc ::safe::interpConfigure {args} {
-accessPath {
return [list -accessPath $state(access_path)]
}
+ -autoPath {
+ if {$AutoPathSync} {
+ return -code error "unknown flag $name (bug)"
+ } else {
+ return [list -autoPath $state(auto_path)]
+ }
+ }
-statics {
return [list -statics $state(staticsok)]
}
@@ -187,15 +214,21 @@ proc ::safe::interpConfigure {args} {
# create did
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $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 autoPath $state(auto_path)
+ } elseif {$AutoPathSync} {
+ set autoPath {}
+ } else {
}
if {
![::tcl::OptProcArgGiven -statics]
@@ -217,15 +250,36 @@ proc ::safe::interpConfigure {args} {
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]
+ 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)]]
+ }
+
+ # Remove stale "package ifneeded" data for non-loaded packages.
+ # - Not for loaded packages, because "package forget" erases
+ # data from "package provide" as well as "package ifneeded".
+ # - This is OK because the script cannot reload any version of
+ # the package unless it first does "package forget".
+ foreach pkg [::interp eval $slave {package names}] {
+ if {[::interp eval $slave [list package provide $pkg]] eq ""} {
+ ::interp eval $slave [list package forget $pkg]
+ }
+ }
}
+ return
}
}
}
@@ -249,10 +303,11 @@ proc ::safe::interpConfigure {args} {
# 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
@@ -262,10 +317,14 @@ proc ::safe::InterpCreate {
staticsok
nestedok
deletehook
+ autoPath
+ withAutoPath
} {
# Create the slave.
+ # If evaluated in ::safe, the interpreter command for foo is ::foo;
+ # but for foo::bar is safe::foo::bar. So evaluate in :: instead.
if {$slave ne ""} {
- ::interp create -safe $slave
+ namespace eval :: [list ::interp create -safe $slave]
} else {
# empty argument: generate slave name
set slave [::interp create -safe]
@@ -273,20 +332,25 @@ proc ::safe::InterpCreate {
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 ![setSyncMode]), 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 ""} {
@@ -309,16 +373,27 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
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
+ namespace upvar ::safe [VarName $slave] state
# clear old autopath if it existed
# build new one
@@ -326,7 +401,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# 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 {}
@@ -343,7 +417,22 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
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 [setSyncMode], SyncAccessPath will overwrite this value with the
+ # full access path.
+ # If ![setSyncMode], 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 {}
@@ -352,6 +441,12 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# 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]
+ }
continue
}
@@ -361,7 +456,12 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
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
+ }
incr i
# [Bug 2854929]
@@ -372,6 +472,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# subdirectories.
lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
}
+ set firstpass 0
}
set state(access_path) $access_path
@@ -384,24 +485,54 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
set state(nestedok) $nestedok
set state(cleanupHook) $deletehook
+ if {!$AutoPathSync} {
+ set state(auto_path) $raw_auto_path
+ }
+
SyncAccessPath $slave
+ return
+}
+
+
+#
+# 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 [VarName $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
+ CheckInterp $slave
+ namespace upvar ::safe [VarName $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
@@ -409,7 +540,8 @@ proc ::safe::interpFindInAccessPath {slave path} {
proc ::safe::interpAddToAccessPath {slave path} {
# first check if the directory is already in there
# (inlined interpFindInAccessPath).
- namespace upvar ::safe S$slave state
+ CheckInterp $slave
+ namespace upvar ::safe [VarName $slave] state
if {[dict exists $state(access_path,remap) $path]} {
return [dict get $state(access_path,remap) $path]
@@ -437,9 +569,11 @@ proc ::safe::InterpInit {
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.
@@ -506,7 +640,7 @@ proc ::safe::InterpInit {
# Sync the paths used to search for Tcl modules. This can be done only
# now, after tm.tcl was loaded.
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
if {[llength $state(tm_path_slave)] > 0} {
::interp eval $slave [list \
::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
@@ -538,12 +672,27 @@ proc ::safe::AddSubDirs {pathList} {
}
# This procedure deletes a safe slave managed by Safe Tcl and cleans up
-# associated state:
+# associated state.
+# - The command will also delete non-Safe-Base interpreters.
+# - This is regrettable, but to avoid breaking existing code this should be
+# amended at the next major revision by uncommenting "CheckInterp".
proc ::safe::interpDelete {slave} {
Log $slave "About to delete" NOTICE
- namespace upvar ::safe S$slave state
+ # CheckInterp $slave
+ namespace upvar ::safe [VarName $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::[VarName [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
@@ -611,24 +760,28 @@ proc ::safe::setLogCmd {args} {
# ------------------- 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} {
- namespace upvar ::safe S$slave state
+ variable AutoPathSync
+ namespace upvar ::safe [VarName $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.
@@ -642,7 +795,7 @@ proc ::safe::PathToken {n} {
# translate virtual path into real path
#
proc ::safe::TranslatePath {slave path} {
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
# somehow strip the namespaces 'functionality' out (the danger is that
# we would strip valid macintosh "../" queries... :
@@ -688,6 +841,7 @@ proc ::safe::AliasFileSubcommand {slave subcommand name} {
# 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
@@ -710,11 +864,15 @@ proc ::safe::AliasGlob {slave args} {
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
@@ -728,16 +886,10 @@ proc ::safe::AliasGlob {slave args} {
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"
- }
-* {
Log $slave "Safe base rejecting glob option '$opt'"
return -code error "Safe base rejecting glob option '$opt'"
+ # unsafe/unnecessary options rejected: -path
}
default {
break
@@ -758,24 +910,40 @@ proc ::safe::AliasGlob {slave args} {
if {$got(-nocomplain)} return
return -code error "permission denied"
}
- lappend cmd -directory $dir
+ if {$got(--)} {
+ set cmd [linsert $cmd end-1 -directory $dir]
+ } else {
+ lappend cmd -directory $dir
+ }
+ } else {
+ # The code after this "if ... else" block would conspire to return with
+ # no results in this case, if it were allowed to proceed. Instead,
+ # return now and reduce the number of cases to be considered later.
+ Log $slave {option -directory must be supplied}
+ if {$got(-nocomplain)} return
+ return -code error "permission denied"
}
- # 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
+ # Process the pattern arguments. If we've done a join there is only one
+ # pattern argument.
+
set firstPattern [llength $cmd]
foreach opt [lrange $args $at end] {
if {![regexp $dirPartRE $opt -> thedir thefile]} {
set thedir .
- } elseif {[string match ~* $thedir]} {
- set thedir ./$thedir
+ # The *.tm search comes here.
}
- if {$thedir eq "*" &&
- ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} {
+ # "Special" treatment for (joined) argument {*/pkgIndex.tcl}.
+ # Do the expansion of "*" here, and filter out any directories that are
+ # not in the access path. The outcome is to lappend to cmd a path of
+ # the form $virtualdir/subdir/pkgIndex.tcl for each subdirectory subdir,
+ # after removing any subdir that are not in the access path.
+ if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} {
set mapped 0
foreach d [glob -directory [TranslatePath $slave $virtualdir] \
-types d -tails *] {
@@ -787,7 +955,25 @@ proc ::safe::AliasGlob {slave args} {
}
}
if {$mapped} continue
+ # Don't [continue] if */pkgIndex.tcl has no matches in the access
+ # path. The pattern will now receive the same treatment as a
+ # "non-special" pattern (and will fail because it includes a "*" in
+ # the directory name).
}
+ # Any directory pattern that is not an exact (i.e. non-glob) match to a
+ # directory in the access path will be rejected here.
+ # - Rejections include any directory pattern that has glob matching
+ # patterns "*", "?", backslashes, braces or square brackets, (UNLESS
+ # it corresponds to a genuine directory name AND that directory is in
+ # the access path).
+ # - The only "special matching characters" that remain in patterns for
+ # processing by glob are in the filename tail.
+ # - [file join $anything ~${foo}] is ~${foo}, which is not an exact
+ # match to any directory in the access path. Hence directory patterns
+ # that begin with "~" are rejected here. Tests safe-16.[5-8] check
+ # that "file join" remains as required and does not expand ~${foo}.
+ # - Bug [3529949] relates to unwanted expansion of ~${foo} and this is
+ # how the present code avoids the bug. All tests safe-16.* relate.
try {
DirInAccessPath $slave [TranslatePath $slave \
[file join $virtualdir $thedir]]
@@ -805,8 +991,17 @@ proc ::safe::AliasGlob {slave args} {
return
}
try {
+ # >>>>>>>>>> HERE'S THE CALL TO SAFE INTERP GLOB <<<<<<<<<<
+ # - Pattern arguments added to cmd have NOT been translated from tokens.
+ # Only the virtualdir is translated (to dir).
+ # - In the pkgIndex.tcl case, there is no "*" in the pattern arguments,
+ # which are a list of names each with tail pkgIndex.tcl. The purpose
+ # of the call to glob is to remove the names for which the file does
+ # not exist.
set entries [::interp invokehidden $slave glob {*}$cmd]
} on error msg {
+ # This is the only place that a call with -nocomplain and no invalid
+ # "dash-options" can return an error.
Log $slave $msg
return -code error "script error"
}
@@ -868,12 +1063,15 @@ proc ::safe::AliasSource {slave args} {
return -code error "permission denied"
}
- # do the checks on the filename :
+ # Check that the filename exists and is readable. If it is not, deliver
+ # this -errorcode so that caller in tclPkgUnknown does not write a message
+ # to tclLog. Has no effect on other callers of ::source, which are in
+ # "package ifneeded" scripts.
if {[catch {
CheckFileName $slave $realfile
} msg]} {
Log $slave "$realfile:$msg"
- return -code error $msg
+ return -code error -errorcode {POSIX EACCES} $msg
}
# Passed all the tests, lets source it. Note that we do this all manually
@@ -918,7 +1116,7 @@ proc ::safe::AliasLoad {slave file args} {
# package name (can be empty if file is not).
set package [lindex $args 0]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
# Determine where to load. load use a relative interp path and {}
# means self, so we can directly and safely use passed arg.
@@ -980,7 +1178,7 @@ proc ::safe::AliasLoad {slave file args} {
# the security here relies on "file dirname" answering the proper
# result... needs checking ?
proc ::safe::FileInAccessPath {slave file} {
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
set access_path $state(access_path)
if {[file isdirectory $file]} {
@@ -992,14 +1190,14 @@ proc ::safe::FileInAccessPath {slave file} {
# potential pathname anomalies.
set norm_parent [file normalize $parent]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
if {$norm_parent ni $state(access_path,norm)} {
return -code error "\"$file\": not in access_path"
}
}
proc ::safe::DirInAccessPath {slave dir} {
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
set access_path $state(access_path)
if {[file isfile $dir]} {
@@ -1010,7 +1208,7 @@ proc ::safe::DirInAccessPath {slave dir} {
# potential pathname anomalies.
set norm_dir [file normalize $dir]
- namespace upvar ::safe S$slave state
+ namespace upvar ::safe [VarName $slave] state
if {$norm_dir ni $state(access_path,norm)} {
return -code error "\"$dir\": not in access_path"
}
@@ -1048,22 +1246,79 @@ proc ::safe::AliasExeName {slave} {
return ""
}
+# ------------------------------------------------------------------------------
+# Using Interpreter Names with Namespace Qualifiers
+# ------------------------------------------------------------------------------
+# (1) We wish to preserve compatibility with existing code, in which Safe Base
+# interpreter names have no namespace qualifiers.
+# (2) safe::interpCreate and the rest of the Safe Base previously could not
+# accept namespace qualifiers in an interpreter name.
+# (3) The interp command will accept namespace qualifiers in an interpreter
+# name, but accepts distinct interpreters that will have the same command
+# name (e.g. foo, ::foo, and :::foo) (bug 66c2e8c974).
+# (4) To satisfy these constraints, Safe Base interpreter names will be fully
+# qualified namespace names with no excess colons and with the leading "::"
+# omitted.
+# (5) Trailing "::" implies a namespace tail {}, which interp reads as {{}}.
+# Reject such names.
+# (6) We could:
+# (a) EITHER reject usable but non-compliant names (e.g. excess colons) in
+# interpCreate, interpInit;
+# (b) OR accept such names and then translate to a compliant name in every
+# command.
+# The problem with (b) is that the user will expect to use the name with the
+# interp command and will find that it is not recognised.
+# E.g "interpCreate ::foo" creates interpreter "foo", and the user's name
+# "::foo" works with all the Safe Base commands, but "interp eval ::foo"
+# fails.
+# So we choose (a).
+# (7) The command
+# namespace upvar ::safe S$slave state
+# becomes
+# namespace upvar ::safe [VarName $slave] state
+# ------------------------------------------------------------------------------
+
+proc ::safe::RejectExcessColons {slave} {
+ set stripped [regsub -all -- {:::*} $slave ::]
+ if {[string range $stripped end-1 end] eq {::}} {
+ return -code error {interpreter name must not end in "::"}
+ }
+ if {$stripped ne $slave} {
+ set msg {interpreter name has excess colons in namespace separators}
+ return -code error $msg
+ }
+ if {[string range $stripped 0 1] eq {::}} {
+ return -code error {interpreter name must not begin "::"}
+ }
+ return
+}
+
+proc ::safe::VarName {slave} {
+ # return S$slave
+ return S[string map {:: @N @ @A} $slave]
+}
+
proc ::safe::Setup {} {
####
#
# 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 {
@@ -1100,8 +1355,72 @@ proc ::safe::Setup {} {
return
}
+# Accessor method for ::safe::AutoPathSync
+# Usage: ::safe::setSyncMode ?newValue?
+# Respond to changes by calling Setup again, preserving 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::setSyncMode {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::setSyncMode ?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 {}
@@ -1119,10 +1438,21 @@ namespace eval ::safe {
# access_path,slave : Ditto, as the path tokens as seen by the slave.
# access_path,map : dict ( token -> path )
# access_path,remap : dict ( path -> token )
+ # auto_path : List of paths requested by the caller as slave's ::auto_path.
# 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
+ #
+ # In principle, the slave can change its value of ::auto_path -
+ # - a package might add a path (that is already in the access path) for
+ # access to tclIndex files;
+ # - the script might remove some elements of the auto_path.
+ # However, this is really the business of the master, and the auto_path will
+ # be reset whenever the token mapping changes (i.e. when option -accessPath is
+ # used to change the access path).
+ # -autoPath is now stored in the array and is no longer obtained from
+ # the slave.
}
::safe::Setup
diff --git a/library/tclIndex b/library/tclIndex
index 5f7fbfb..a8db3cb 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -61,6 +61,7 @@ set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir
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::setSyncMode) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
diff --git a/library/tm.tcl b/library/tm.tcl
index 0ed3f1a..c60084c 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -212,11 +212,12 @@ proc ::tcl::tm::UnknownHandler {original name args} {
}
set strip [llength [file split $path]]
- # We can't use glob in safe interps, so enclose the following in a
- # catch statement, where we get the module files out of the
- # subdirectories. In other words, Tcl Modules are not-functional
- # in such an interpreter. This is the same as for the command
- # "tclPkgUnknown", i.e. the search for regular packages.
+ # Get the module files out of the subdirectories.
+ # - Safe Base interpreters have a restricted "glob" command that
+ # works in this case.
+ # - The "catch" was essential when there was no safe glob and every
+ # call in a safe interp failed; it is retained only for corner
+ # cases in which the eventual call to glob returns an error.
catch {
# We always look for _all_ possible modules in the current
diff --git a/tests/auto-files.zip b/tests/auto-files.zip
new file mode 100644
index 0000000..b8bdf88
--- /dev/null
+++ b/tests/auto-files.zip
Binary files differ
diff --git a/tests/auto0/auto1/file1.tcl b/tests/auto0/auto1/file1.tcl
new file mode 100644
index 0000000..bd8b92b
--- /dev/null
+++ b/tests/auto0/auto1/file1.tcl
@@ -0,0 +1,3 @@
+proc report1 {args} {
+ return ok1
+}
diff --git a/tests/auto0/auto1/package1.tcl b/tests/auto0/auto1/package1.tcl
new file mode 100644
index 0000000..32d7c56
--- /dev/null
+++ b/tests/auto0/auto1/package1.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage1 {args} {
+ return OK1
+}
+
+package provide SafeTestPackage1 1.2.3
diff --git a/tests/auto0/auto1/pkgIndex.tcl b/tests/auto0/auto1/pkgIndex.tcl
new file mode 100644
index 0000000..babb6d5
--- /dev/null
+++ b/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]]
diff --git a/tests/auto0/auto1/tclIndex b/tests/auto0/auto1/tclIndex
new file mode 100644
index 0000000..bbfa6d4
--- /dev/null
+++ b/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]]
diff --git a/tests/auto0/auto2/file2.tcl b/tests/auto0/auto2/file2.tcl
new file mode 100644
index 0000000..5bc622f
--- /dev/null
+++ b/tests/auto0/auto2/file2.tcl
@@ -0,0 +1,3 @@
+proc report2 {args} {
+ return ok2
+}
diff --git a/tests/auto0/auto2/package2.tcl b/tests/auto0/auto2/package2.tcl
new file mode 100644
index 0000000..61774df
--- /dev/null
+++ b/tests/auto0/auto2/package2.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage2 {args} {
+ return OK2
+}
+
+package provide SafeTestPackage2 2.3.4
diff --git a/tests/auto0/auto2/pkgIndex.tcl b/tests/auto0/auto2/pkgIndex.tcl
new file mode 100644
index 0000000..1022691
--- /dev/null
+++ b/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]]
diff --git a/tests/auto0/auto2/tclIndex b/tests/auto0/auto2/tclIndex
new file mode 100644
index 0000000..9cd2a74
--- /dev/null
+++ b/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]]
diff --git a/tests/auto0/modules/mod1/test1-1.0.tm b/tests/auto0/modules/mod1/test1-1.0.tm
new file mode 100644
index 0000000..927fa6f
--- /dev/null
+++ b/tests/auto0/modules/mod1/test1-1.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod1::test1 {}
+
+proc mod1::test1::try1 args {
+ return res1
+}
diff --git a/tests/auto0/modules/mod2/test2-2.0.tm b/tests/auto0/modules/mod2/test2-2.0.tm
new file mode 100644
index 0000000..b5cd45b
--- /dev/null
+++ b/tests/auto0/modules/mod2/test2-2.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod2::test2 {}
+
+proc mod2::test2::try2 args {
+ return res2
+}
diff --git a/tests/auto0/modules/test0-0.5.tm b/tests/auto0/modules/test0-0.5.tm
new file mode 100644
index 0000000..19f3613
--- /dev/null
+++ b/tests/auto0/modules/test0-0.5.tm
@@ -0,0 +1,5 @@
+namespace eval test0 {}
+
+proc test0::try0 args {
+ return res0
+}
diff --git a/tests/safe-stock87.test b/tests/safe-stock87.test
new file mode 100644
index 0000000..1ca2020
--- /dev/null
+++ b/tests/safe-stock87.test
@@ -0,0 +1,450 @@
+# safe-stock87.test --
+#
+# This file contains tests for safe Tcl that were previously in the file
+# safe.test, and use files and packages of stock Tcl 8.7 to perform the tests.
+# These files may be changed or disappear in future revisions of Tcl, for
+# example package opt will eventually be removed.
+#
+# The tests are replaced in safe.tcl with tests that use files provided in the
+# tests directory. Test numbering is for comparison with similar tests in
+# safe.test.
+#
+# Sourcing this file into tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# The defunct package http 1.0 was convenient for testing package loading.
+# - This file, safe-stock87.test, uses packages opt and (from cookiejar)
+# tcl::idna to provide alternative tests based on stock Tcl packages.
+# - These are tests 7.1 7.2 7.4 9.11 9.13
+# - Tests 7.[124], 9.1[13] use "package require opt".
+# - Tests 9.1[13] also use "package require tcl::idna".
+# - The corresponding tests in safe.test use example packages provided in
+# subdirectory auto0 of the tests directory, which are independent of any
+# changes made to the packages provided with Tcl.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5-
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+foreach i [interp slaves] {
+ interp delete $i
+}
+
+# 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 test 7.2 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.4, 9.10, 9.12 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.10, 9.12 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 SaveAutoPath $::auto_path
+set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+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
+
+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)
+
+testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
+testConstraint AutoSyncDefined 1
+
+# high level general test
+test safe-stock87-7.1 {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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 opt}]
+ # no error shall occur:
+ interp eval $i {::tcl::Lempty {a list}}
+ set v
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 0.4.*
+test safe-stock87-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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"]
+ # an error shall occur (opt is not anymore in the secure 0-level
+ # provided deep path)
+ 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\
+ {TCLLIB */dummy/unixlike/test/path} -- {}"
+test safe-stock87-7.4 {tests specific path and positive search with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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-stock87-7.2, 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\
+ {TCLLIB * TCLLIB/OPTDIR} -- {}}
+test safe-stock87-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package shell} 0}
+
+# The following test checks whether the definition of tcl_endOfWord can be
+# obtained from auto_loading. It was previously test "safe-5.1".
+test safe-stock87-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+} -body {
+ interp eval a {tcl_endOfWord "" 0}
+} -cleanup {
+ safe::interpDelete a
+} -result -1
+test safe-stock87-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-stock87-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-stock87-18.1 {cf. safe-stock87-7.1opt - tests that everything works at high level without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 0.4.*
+test safe-stock87-18.2 {cf. safe-stock87-7.2opt - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ set auto1 [interp eval $i {set ::auto_path}]
+ # This will differ from the value -autoPath {}
+ 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} 1 {$pkgOptErrMsg}\
+ {-accessPath {[list $tcl_library */dummy/unixlike/test/path]}\
+ -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+test safe-stock87-18.4 {cf. safe-stock87-7.4opt - tests specific path and positive search and auto_path without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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}]
+
+ # This will differ from the value -autoPath {}
+ 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-stock87-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::setSyncMode $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 {}} {}"
+test safe-stock87-18.5 {cf. safe-stock87-7.5 - tests positive and negative module loading without conventional AutoPathSync} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package shell} 0}
+
+set ::auto_path $SaveAutoPath
+unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp
+rename mapList {}
+rename mapAndSortList {}
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/safe-zipfs.test b/tests/safe-zipfs.test
new file mode 100644
index 0000000..bc29147
--- /dev/null
+++ b/tests/safe-zipfs.test
@@ -0,0 +1,950 @@
+# safe-zipfs.test --
+#
+# This file contains tests for safe Tcl that test its compatibility with the
+# zipfs facilities introduced in Tcl 8.7. Test numbering is for comparison
+# with similar tests in safe.test that do not use the zipfs file system.
+#
+# Sourcing this file into tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5-
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+foreach i [interp slaves] {
+ interp delete $i
+}
+
+set SaveAutoPath $::auto_path
+set ::auto_path [info 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 $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)
+
+testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
+
+testConstraint AutoSyncDefined 1
+
+# Tests 5.* test the example files before using them to test safe interpreters.
+
+test safe-zipfs-5.1 {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-zipfs-5.2 {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-zipfs-5.3 {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-zipfs-5.4 {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-zipfs-5.5 {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-zipfs-5.6 {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 zipped example packages not http1.0 etc
+test safe-zipfs-7.1 {tests that everything works at high level with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 1.2.3
+test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
+ 1 {can't find package SafeTestPackage1} --\
+ {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
+test safe-zipfs-7.4 {tests specific path and positive search with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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-zipfs-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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
+ {TCLLIB * ZIPDIR/auto0/auto1} -- {}}
+
+test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset) with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset) with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+} -body {
+ # For complete correspondence to safe-stock87-9.11, 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::setSyncMode $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-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0 with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.20 {check module loading, with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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}
+# - 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-zipfs-9.21 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 1; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.20.
+test safe-zipfs-9.22 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 0; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.20.
+test safe-zipfs-9.23 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 3; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.20.
+test safe-zipfs-9.24 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 2 (worst case); zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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-zipfs-9.20.
+
+test safe-zipfs-18.1 {cf. safe-zipfs-7.1 - tests that everything works at high level without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 1.2.3
+test safe-zipfs-18.2 {cf. safe-zipfs-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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::setSyncMode $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 {}} {}"
+test safe-zipfs-18.4 {cf. safe-zipfs-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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}]
+
+ # This will differ from the value -autoPath {}
+ 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}]
+
+ # This will differ from the value -autoPath {}
+ set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]]
+
+ # This time, unlike test safe-zipfs-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::setSyncMode $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 {}} {}"
+
+# cleanup
+set ::auto_path $SaveAutoPath
+zipfs unmount ${ZipMountPoint}
+unset SaveAutoPath TestsDir ZipMountPoint PathMapp
+rename mapList {}
+rename mapAndSortList {}
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/safe.test b/tests/safe.test
index 79aa9ab..81e08f2 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -4,6 +4,16 @@
# using safe interpreters. Sourcing this file into tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
+# The defunct package http 1.0 was convenient for testing package loading.
+# - Tests that used http are replaced here with tests that use example packages
+# provided in subdirectory auto0 of the tests directory, which are independent
+# of any changes made to the packages provided with Tcl itself.
+# - These are tests 7.1 7.2 7.4 9.11 9.13 17.1 17.2 17.4
+# - Tests 5.* test the example packages themselves before they
+# are used to test Safe Base interpreters.
+# - Alternative tests using stock packages of Tcl 8.7 are in file
+# safe-stock87.test.
+#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
@@ -21,10 +31,32 @@ foreach i [interp slaves] {
interp delete $i
}
-set saveAutoPath $::auto_path
+set SaveAutoPath $::auto_path
set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
-# Force actual loading of the safe package because we use un exported (and
+proc getAutoPath {slave} {
+ set ap1 [lrange [lindex [safe::interpConfigure $slave -autoPath] 1] 0 end]
+ set ap2 [::safe::DetokPath $slave [interp eval $slave set ::auto_path]]
+ list $ap1 -- $ap2
+}
+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}
@@ -32,13 +64,28 @@ catch {safe::interpConfigure}
# package - Tcltest - but it might be absent if we're in standard tclsh)
testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
+testConstraint AutoSyncDefined 1
+### 1. Basic help/error messages.
+
test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
safe::interpConfigure
} -result {no value given for parameter "slave" (use -help for full usage) :
slave name () name of the slave}
-test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
+test safe-1.2 {safe::interpCreate syntax, Sync Mode on} -returnCodes error -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
+} -body {
safe::interpCreate -help
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -result {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
@@ -50,11 +97,39 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
-nestedLoadOk boolflag (false) allow nested loading
-nested boolean (false) nested loading
-deleteHook script () delete hook}
+test safe-1.2.1 {safe::interpCreate syntax, Sync Mode off} -returnCodes error -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ safe::interpCreate -help
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {Usage information:
+ Var/FlagName Type Value Help
+ ------------ ---- ----- ----
+ (-help gives this help)
+ ?slave? name () name of the slave (optional)
+ -accessPath list () access path for the slave
+ -noStatics boolflag (false) prevent loading of statically linked pkgs
+ -statics boolean (true) loading of statically linked pkgs
+ -nestedLoadOk boolflag (false) allow nested loading
+ -nested boolean (false) nested loading
+ -deleteHook script () delete hook
+ -autoPath list () ::auto_path for the slave}
test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
safe::interpInit -noStatics
} -result {bad value "-noStatics" for parameter
slave name () name of the slave}
+### 2. Aliases in a new "interp create" interpreter.
+
test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
# Disabled this test. It tests nothing sensible. [Bug 999612]
# interp aliases
@@ -66,6 +141,8 @@ test safe-2.2 {creating interpreters, should have no aliases} -setup {
a aliases
} -cleanup {
safe::interpDelete a
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
catch {safe::interpDelete a}
@@ -76,6 +153,9 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s
interp delete a
} -result {clock}
+### 3. Simple use of interpCreate, interpInit.
+### Aliases in a new "interpCreate/interpInit" interpreter.
+
test safe-3.1 {calling safe::interpInit is safe} -setup {
catch {safe::interpDelete a}
interp create a -safe
@@ -110,11 +190,15 @@ test safe-3.4 {calling safe::interpCreate on trusted interp} -setup {
safe::interpDelete a
} -result {}
+### 4. Testing safe::interpDelete, double interpCreate.
+
test safe-4.1 {safe::interpDelete} -setup {
catch {safe::interpDelete a}
} -body {
interp create a
safe::interpDelete a
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-4.2 {safe::interpDelete, indirectly} -setup {
catch {safe::interpDelete a}
@@ -122,6 +206,8 @@ test safe-4.2 {safe::interpDelete, indirectly} -setup {
interp create a
a alias exit safe::interpDelete a
a eval exit
+ # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
+ # is regrettable and should be removed at the next major revision.
} -result ""
test safe-4.5 {safe::interpDelete} -setup {
catch {safe::interpDelete a}
@@ -138,19 +224,121 @@ test safe-4.6 {safe::interpDelete, indirectly} -setup {
a eval exit
} -result ""
-# The following test checks whether the definition of tcl_endOfWord can be
-# obtained from auto_loading.
+### 5. Test the example files before using them to test safe interpreters.
+### The old test "safe-5.1" has been moved to "safe-stock86-9.8".
+### A replacement test using example files is "safe-9.8".
-test safe-5.1 {test auto-loading in safe interpreters} -setup {
- catch {safe::interpDelete a}
- safe::interpCreate a
+test safe-5.1 {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 {
- interp eval a {tcl_endOfWord "" 0}
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
} -cleanup {
- safe::interpDelete a
-} -result -1
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {0 ok1 0 ok2}
+test safe-5.2 {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-5.3 {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-5.4 {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-5.5 {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-5.6 {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}
+
+### 6. Test safe interps 'information leak'.
-# test safe interps 'information leak'
proc SafeEval {script} {
# Helper procedure that ensures the safe interp is cleaned up even if
# there is a failure in the script.
@@ -176,59 +364,176 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}
+rename SafeEval {}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
-# high level general test
-test safe-7.1 {tests that everything works at high level} -body {
+### 7. Test the use of ::auto_path for loading commands (via tclIndex files)
+### and non-module packages (via pkgIndex.tcl files).
+### Corresponding tests with Sync Mode off are 17.*
+
+test safe-7.1 {positive non-module package require, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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 http 2}]
+ set v [interp eval $i {package require SafeTestPackage1}]
# no error shall occur:
- interp eval $i {http::config}
- safe::interpDelete $i
+ interp eval $i {HeresPackage1}
set v
-} -match glob -result 2.*
-test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 1.2.3
+test safe-7.2 {negative non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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
- # 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 {}} {}"
+ # 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 in auto0 but a subdirectory)
+ list $token1 $token2 $token3 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $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.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.3.1 {check that safe subinterpreters work with namespace names} -setup {
+} -body {
+ 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 foo::bar]
+ set j [safe::interpCreate [list $i hello::world]]
+ list $g $h [interp eval $j {join {o k} ""}] \
+ [foo::bar eval {hello::world eval {join {o k} ""}}] \
+ [safe::interpDelete $i] \
+ [interp exists $j] [info vars ::safe::S*]
+} -match glob -result {{} {} ok ok {} 0 {}}
+test safe-7.4 {positive non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
+ {TCLLIB * TESTSDIR/auto0/auto1} -- {}}
+test safe-7.5 {positive and negative module package require, including ancestor directory issue, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+ set i [safe::interpCreate]
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ interp eval $i {
+ package forget mod1::test1
+ catch {namespace delete ::mod1}
+ }
+} -body {
+ # Should raise an error (module ancestor directory issue)
+ set code1 [catch {interp eval $i {package require test1}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package test1} 0}
+
+### 8. Test source control on file name.
-# test source control on file name
-set i "a"
test safe-8.1 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
$i eval {source}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.2 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
$i eval {source a b c d e}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.3 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {lappend ::log $str}
@@ -239,10 +544,12 @@ test safe-8.3 {safe source control on file} -setup {
list [catch {$i eval {source .}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -253,10 +560,12 @@ test safe-8.4 {safe source control on file} -setup {
list [catch {$i eval {source /abc/def}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -271,10 +580,12 @@ test safe-8.5 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -287,10 +598,12 @@ test safe-8.6 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -305,14 +618,16 @@ test safe-8.7 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} emptyTest {
# Disabled this test. It was only useful for long unsupported
# Mac OS 9 systems. [Bug 860a9f1945]
} {}
test safe-8.9 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -322,8 +637,10 @@ test safe-8.9 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
test safe-8.10 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return -level 2 "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -336,10 +653,14 @@ test safe-8.10 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
-set i "a"
+### 9. Assorted options, including changes to option values.
+### If Sync Mode is on, a corresponding test with Sync Mode off is 19.*
+
test safe-9.1 {safe interps' deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -352,8 +673,12 @@ test safe-9.1 {safe interps' deleteHook} -setup {
}
safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
list [interp eval $i exit] $res
+} -cleanup {
+ catch {rename testDelHook {}}
+ unset i res
} -result {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
set log {}
@@ -374,7 +699,9 @@ test safe-9.2 {safe interps' error in deleteHook} -setup {
list [safe::interpDelete $i] $res $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
+ catch {rename testDelHook {}}
+ rename safe-test-log {}
+ unset i log res
} -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}}
test safe-9.3 {dual specification of statics} -returnCodes error -body {
safe::interpCreate -stat true -nostat
@@ -403,7 +730,636 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
safe::interpConfigure $i]\
[safe::interpConfigure $i -deleteHook toto -nosta -nested 0
safe::interpConfigure $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}}
+} -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
+ unset -nocomplain a b c d e f g 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 {autoloading commands indexed in tclIndex files, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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 and run the commands.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}}
+test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-9.11 without path auto0, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.20 {check module loading, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.21 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 1} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.22 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 0} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.23 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 3} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.24 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 2 (worst case)} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 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::setSyncMode $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.
+
+### 10. Test options -statics -nostatics -nested -nestedloadok
catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
@@ -458,6 +1414,8 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints T
invoked from within
"interp eval $i {interp create x; load {} Safepkg1 x}"}
+### 11. Safe encoding.
+
test safe-11.1 {testing safe encoding} -setup {
set i [safe::interpCreate]
} -body {
@@ -552,6 +1510,9 @@ test safe-11.8.1 {testing safe encoding} -setup {
invoked from within
"interp eval $i encoding convertto"}
+### 12. Safe glob.
+### More tests of glob in sections 13, 16.
+
test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
@@ -602,13 +1563,25 @@ test safe-12.7 {glob is restricted} -setup {
safe::interpDelete $i
} -result {permission denied}
+### 13. More tests for Safe base glob, with patches @ Bug 2964715
+### More tests of glob in sections 12, 16.
+
proc buildEnvironment {filename} {
upvar 1 testdir testdir testdir2 testdir2 testfile testfile
set testdir [makeDirectory deletethisdir]
set testdir2 [makeDirectory deletemetoo $testdir]
set testfile [makeFile {} $filename $testdir2]
}
-#### New tests for Safe base glob, with patches @ Bug 2964715
+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]
+}
+
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
@@ -679,21 +1652,33 @@ test safe-13.6 {as 13.4 but test silent failure when result is outside access_pa
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}}
-# 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/deletemetoo/pkgIndex.tcl}
+test safe-13.7.1 {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/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 {
@@ -731,8 +1716,10 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p
removeDirectory $testdir
} -result {}
rename buildEnvironment {}
+rename buildEnvironment2 {}
+
+### 14. Sanity checks on paths - module path, access path, auto_path.
-#### 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 {
@@ -744,6 +1731,122 @@ test safe-14.1 {Check that module path is the same as in the master interpreter
} -cleanup {
safe::interpDelete $i
} -result [::tcl::tm::path list]
+test safe-14.2 {Check that first element of slave auto_path (and access path) is Tcl Library, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library]]
+test safe-14.2.1 {Check that first element of slave auto_path (and access path) is Tcl Library, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+
+ 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]
+ set autoList [lindex [safe::interpConfigure $i -autoPath] 1]
+ return [list [lindex $accessList 0] [lindex $autoList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library] [info library]]
+test safe-14.3 {Check that first element of slave auto_path (and access path) is Tcl Library, even if not true for master, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library]]
+test safe-14.3.1 {Check that first element of slave auto_path (and access path) is Tcl Library, even if not true for master, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+
+ 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]
+ set autoList [lindex [safe::interpConfigure $i -autoPath] 1]
+
+ return [list [lindex $accessList 0] [lindex $autoList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library] [info library]]
+
+### 15. Safe file ensemble.
test safe-15.1 {safe file ensemble does not surprise code} -setup {
set i [interp create -safe]
@@ -782,7 +1885,10 @@ test safe-15.2 {safe file ensemble does not surprise code} -setup {
invoked from within
"interp eval $i {file isdirectory .}"}}
-### ~ should have no special meaning in paths in safe interpreters
+### 16. ~ should have no special meaning in paths in safe interpreters.
+### Defang it in glob.
+### More tests of glob in sections 12, 13.
+
test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
set savedHOME $env(HOME)
set env(HOME) /foo/bar
@@ -795,6 +1901,7 @@ test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
} -cleanup {
safe::interpDelete $i
set env(HOME) $savedHOME
+ unset savedHOME
} -result {./~}
test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
set i [safe::interpCreate]
@@ -804,6 +1911,7 @@ test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
"file join \[file dirname ~$user\] \[file tail ~$user\]"]
} -cleanup {
safe::interpDelete $i
+ unset user
} -result {./~USER}
test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
set syntheticHOME [makeDirectory foo]
@@ -818,6 +1926,7 @@ test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
safe::interpDelete $i
set env(HOME) $savedHOME
removeDirectory $syntheticHOME
+ unset savedHOME syntheticHOME
} -result {}
test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
set i [safe::interpCreate]
@@ -827,9 +1936,1624 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
} -cleanup {
safe::interpDelete $i
} -result {}
+test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)/foo/bar} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
+test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
+
+### 17. Test the use of ::auto_path for loading commands (via tclIndex files)
+### and non-module packages (via pkgIndex.tcl files).
+### Corresponding tests with Sync Mode on are 7.*
+
+test safe-17.1 {cf. safe-7.1 - positive non-module package require, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 1.2.3
+test safe-17.2 {cf. safe-7.2 - negative non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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}]
+ # This does not change the value of option -autoPath:
+ 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 in auto0 but a subdirectory)
+ list $auto1 $token1 $token2 $token3 \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \
+ [safe::interpConfigure $i]\
+ [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $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 {}} {}"
+# (not a counterpart of safe-7.3)
+test safe-17.3 {Check that default auto_path is the same as in the master interpreter, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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 [list $ap [lindex [::safe::interpConfigure $i -autoPath] 1]]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path $::auto_path]
+test safe-17.4 {cf. safe-7.4 - positive non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode 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}]
+
+ # This does not change the value of option -autoPath.
+ 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-17.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::setSyncMode $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 {}} {}"
+test safe-17.5 {cf. safe-7.5 - positive and negative module package require, including ancestor directory issue, Sync Mode off} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+ set i [safe::interpCreate]
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ interp eval $i {
+ package forget mod1::test1
+ catch {namespace delete ::mod1}
+ }
+} -body {
+ # Should raise an error (tests module ancestor directory rule)
+ set code1 [catch {interp eval $i {package require test1}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package test1} 0}
+
+### 18. Test tokenization of directories available to a slave.
+
+test safe-18.1 {Check that each directory of the default auto_path is a valid token, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.1.1 {Check that each directory of the default auto_path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.2 {Check that each directory of the module path is a valid token, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.2.1 {Check that each directory of the module path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+
+### 19. Assorted options, including changes to option values.
+### Mostly these are changes to access path, auto_path, module path.
+### If Sync Mode is on, a corresponding test with Sync Mode off is 9.*
+
+test safe-19.8 {autoloading commands indexed in tclIndex files, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load and run the commands.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA -- $mappC -- $toksC
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}}}
+test safe-19.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # 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]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # 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]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $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*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}}
+test safe-19.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # 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]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # 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]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $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*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}}
+test safe-19.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement (1), Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # 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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # 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]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]
+ # 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]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 -- $mappC -- $mappD -- $toksC -- $toksD -- \
+ $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $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*} --\
+ {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:1:)}} --\
+ 0 OK1 0 OK2}
+test safe-19.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-19.11 without path auto0, Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # To manage without path auto0, use an auto_path that is unusual for
+ # package discovery.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]] \
+ -autoPath [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]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 -- $mappC -- $mappD -- $toksC -- $toksD -- \
+ $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $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*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:1:)} {$p(:2:)}} --\
+ 0 OK1 0 OK2}
+test safe-19.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Path auto0 added (cf. safe-9.3) because it is needed for auto_path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # 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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Limit access path. Remove tokens {$p(:2:)} and {$p(:3:)}.
+ 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]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:2:)} {$p(:3:)} -- 1 {* not found in access path} --\
+ 1 {* not found in access path} -- 1 1 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB*} -- {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)}}}
+# (no counterpart safe-9.14)
+test safe-19.14 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Test that although -autoPath is unchanged, the slave's ::auto_path changes to
+ # reflect the changes in token mappings.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # 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]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:3:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 $path0 $path1 $path2 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \
+ $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} {$p(:1:)} -- {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1 TESTSDIR/auto0*} --\
+ {TCLLIB TESTSDIR/auto0} --\
+ {TCLLIB TESTSDIR/auto0} --\
+ 0 OK1 0 OK2}
+# (no counterpart safe-9.15)
+test safe-19.15 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Test that although -autoPath is unchanged, the slave's ::auto_path changes to
+ # reflect the changes in token mappings; and that it is based on the -autoPath
+ # value, not the previously restricted slave ::auto_path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0]] \
+ -autoPath [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 path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Add more directories.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # 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 $path0 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \
+ $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} -- {$p(:1:)} {$p(:2:)} {$p(:3:)} -- {{$p(:0:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0*} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ 0 OK1 0 OK2}
+# (no counterpart safe-9.16)
+test safe-19.16 {default value for -accessPath and -autoPath on creation; -autoPath preserved when -accessPath changes, ::auto_path using changed tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set tmpAutoPath $::auto_path
+ set ::auto_path [list $tcl_library [file join $TestsDir auto0]]
+ set i [safe::interpCreate]
+ set ::auto_path $tmpAutoPath
+} -body {
+ # Test that the -autoPath acquires and keeps the master's value unless otherwise specified.
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Remove a directory.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path5 $path3 -- [lindex $toksC 0] [llength $toksC] -- \
+ $toksD -- $code3 $msg3 $code4 $msg4 -- \
+ $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:0:)} 2 --\
+ {{$p(:0:)} {$p(:1:)}} -- 0 1.2.3 1 {can't find package SafeTestPackage2} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ 0 OK1 1 {invalid command name "HeresPackage2"}}
+test safe-19.20 {check module loading, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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::setSyncMode $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}
+# See comments on lsort after test safe-9.20.
+test safe-19.21 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 1} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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::setSyncMode $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-19.22 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 0} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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::setSyncMode $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-19.23 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 3} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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::setSyncMode $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-19.24 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 2 (worst case)} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ 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::setSyncMode $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.
+
+
+### 20. safe::interpCreate with different cases of -accessPath, -autoPath.
+
+set ::auto_path [list $tcl_library [file dirname $tcl_library] [file join $TestsDir auto0]]
+
+test safe-20.1 "create -accessPath NULL -autoPath NULL -> master's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-20.2 "create -accessPath {} -autoPath NULL -> master's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-20.3 "create -accessPath path1 -autoPath NULL -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.4 "create -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.5 "create -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.6 "create -accessPath path1 -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.7 "create -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.8 "create -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.9 "create -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.10 "create -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-20.11 "create -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-20.12 "create -accessPath path1 -autoPath pathX -> {pathX}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+
+### 21. safe::interpConfigure with different cases of -accessPath, -autoPath.
+
+test safe-21.1 "interpConfigure -accessPath NULL -autoPath NULL -> no change" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -deleteHook {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-21.2 "interpConfigure -accessPath {} -autoPath NULL -> master's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-21.3 "interpConfigure -accessPath path1 -autoPath NULL -> no change" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-21.4 "interpConfigure -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.5 "interpConfigure -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.6 "interpConfigure -accessPath {path1} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 1 1] -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.7 "interpConfigure -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.8 "interpConfigure -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.9 "interpConfigure -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.10 "interpConfigure -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-21.11 "interpConfigure -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-21.12 "interpConfigure -accessPath path1 -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
-set ::auto_path $saveAutoPath
# cleanup
+set ::auto_path $SaveAutoPath
+unset SaveAutoPath TestsDir PathMapp
+rename getAutoPath {}
+rename mapList {}
+rename mapAndSortList {}
::tcltest::cleanupTests
return
generated by cgit v0.12 at 2025-12-12 18:17:49 (GMT)