summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-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-stock86.test116
-rw-r--r--tests/safe.test921
13 files changed, 1062 insertions, 46 deletions
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-stock86.test b/tests/safe-stock86.test
new file mode 100644
index 0000000..ccfdd3f
--- /dev/null
+++ b/tests/safe-stock86.test
@@ -0,0 +1,116 @@
+# safe-stock86.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.6 to perform the tests.
+# These files may be changed or disappear in future revisions of Tcl,
+# for example package http 1.0 will be removed from Tcl 8.7.
+#
+# 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.
+#
+# 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 {[lsearch [namespace children] ::tcltest] == -1} {
+ 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 PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
+
+proc mapList {map listIn} {
+ set listOut {}
+ foreach element $listIn {
+ lappend listOut [string map $map $element]
+ }
+ return $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}]}]
+
+# high level general test
+test safe-stock86-7.1 {tests that everything works at high level, uses http 2} -body {
+ set i [safe::interpCreate]
+ # 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}]
+ # no error shall occur:
+ interp eval $i {http::config}
+ safe::interpDelete $i
+ set v
+} -match glob -result 2.*
+test safe-stock86-7.2 {tests specific path and interpFind/AddToAccessPath, uses http1.0} -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
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # 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 -- \
+ $mappA -- [safe::interpDelete $i]
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package http 1} --\
+ {TCLLIB */dummy/unixlike/test/path} -- {}}
+test safe-stock86-7.4 {tests specific path and positive search, uses http1.0} -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
+ set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # this time, unlike test safe-stock86-7.2, http should be found
+ list $token1 $token2 -- \
+ [catch {interp eval $i {package require http 1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.0 -- {TCLLIB *TCLLIB/http1.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-stock86-9.8 {test auto-loading in safe interpreters, was test 5.1} -setup {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+} -body {
+ interp eval a {tcl_endOfWord "" 0}
+} -cleanup {
+ safe::interpDelete a
+} -result -1
+
+set ::auto_path $SaveAutoPath
+unset SaveAutoPath TestsDir PathMapp
+rename mapList {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/safe.test b/tests/safe.test
index 11ad2a9..eba6057 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -4,6 +4,17 @@
# using safe interpreters. Sourcing this file into tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
+# The package http 1.0 is convenient for testing package loading, but will soon
+# be removed.
+# - Tests that use 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
+# - Tests 5.* test the example packages themselves before they
+# are used to test Safe Base interpreters.
+# - Alternative tests using stock packages of Tcl 8.6 are in file
+# safe-stock86.test.
+#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
@@ -21,10 +32,27 @@ 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]
+
+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
+# 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}
@@ -66,6 +94,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}
@@ -115,6 +145,8 @@ test safe-4.1 {safe::interpDelete} -setup {
} -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 +154,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,17 +172,118 @@ 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.
+# The old test "safe-5.1" has been moved to "safe-stock86-9.8".
+# A replacement test using example files is "safe-9.8".
+# Tests 5.* test the example files before using them to test safe interpreters.
-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}
# test safe interps 'information leak'
proc SafeEval {script} {
@@ -176,59 +311,121 @@ 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 {
+# Use example packages not http1.0 etc
+test safe-7.1 {tests that everything works at high level} -setup {
+ 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
+} -match glob -result 1.2.3
+test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
+} -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
+ # should add as p* (not p2 if master has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
# provided deep path)
- list $token1 $token2 \
- [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 {}} {}"
+ list $token1 $token2 $token3 -- \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
+ $mappA -- [safe::interpDelete $i]
+} -cleanup {
+} -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 {tests specific path and positive search} -setup {
+} -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 {
+} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
+ {TCLLIB * TESTSDIR/auto0/auto1} -- {}}
# 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 +436,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 +452,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 +472,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 +490,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 +510,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 +529,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 +545,11 @@ test safe-8.10 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
-set i "a"
test safe-9.1 {safe interps' deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -352,8 +562,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 +588,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 +619,546 @@ 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 {test autoloading commands indexed in tclIndex files} -setup {
+} -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
+} -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)} -setup {
+} -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
+} -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)} -setup {
+} -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
+} -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} -setup {
+} -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
+} -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, 9.10 without path auto0} -setup {
+} -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
+} -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} -setup {
+} -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
+} -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} -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 {
+ 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
+} -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; stale data case 1} -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 {
+ 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
+} -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; stale data case 0} -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 {
+ 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
+} -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; stale data case 3} -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 {
+ 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
+} -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; stale data case 2 (worst case)} -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 {
+ 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
+} -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.
catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
@@ -412,7 +1167,7 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
set i [safe::interpCreate]
} -body {
@@ -421,7 +1176,7 @@ test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
invoked from within
"load {} Safepkg1"
invoked from within
@@ -444,7 +1199,7 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl
interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
set i [safe::interpCreate -nestedloadok]
catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
@@ -452,7 +1207,7 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints T
} -returnCodes ok -cleanup {
unset -nocomplain m o
safe::interpDelete $i
-} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
invoked from within
"load {} Safepkg1 x"
invoked from within
@@ -612,6 +1367,15 @@ proc buildEnvironment {filename} {
set testdir2 [makeDirectory deletemetoo $testdir]
set testfile [makeFile {} $filename $testdir2]
}
+proc buildEnvironment2 {filename} {
+ upvar 1 testdir testdir testdir2 testdir2 testfile testfile
+ upvar 1 testdir3 testdir3 testfile2 testfile2
+ set testdir [makeDirectory deletethisdir]
+ set testdir2 [makeDirectory deletemetoo $testdir]
+ set testfile [makeFile {} $filename $testdir2]
+ set testdir3 [makeDirectory deleteme $testdir]
+ set testfile2 [makeFile {} $filename $testdir3]
+}
#### New tests for Safe base glob, with patches @ Bug 2964715
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
set i [safe::interpCreate]
@@ -683,21 +1447,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}
+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/deletemetoo/pkgIndex.tcl}}
-# Note the extra {} around the result above; that's *expected* because of the
-# format of virtual path roots.
-test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
+} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl}
+# See comments on lsort after test safe-9.20.
+test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
set i [safe::interpCreate]
buildEnvironment notIndex.tcl
} -body {
@@ -735,6 +1511,7 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p
removeDirectory $testdir
} -result {}
rename buildEnvironment {}
+rename buildEnvironment2 {}
#### Test for the module path
test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
@@ -765,7 +1542,7 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup {
unset -nocomplain msg
interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
-test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
+test safe-15.2 {safe file ensemble does not surprise code} -setup {
set i [interp create -safe]
} -body {
set result [expr {"file" in [interp hidden $i]}]
@@ -799,6 +1576,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]
@@ -808,6 +1586,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]
@@ -822,6 +1601,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]
@@ -831,9 +1611,58 @@ 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}
-set ::auto_path $saveAutoPath
# cleanup
+set ::auto_path $SaveAutoPath
+unset SaveAutoPath TestsDir PathMapp
+rename mapList {}
+rename mapAndSortList {}
::tcltest::cleanupTests
return
generated by cgit v0.12 at 2024-09-28 17:27:15 (GMT)