diff options
Diffstat (limited to 'tests/safe.test')
| -rw-r--r-- | tests/safe.test | 3630 |
1 files changed, 411 insertions, 3219 deletions
diff --git a/tests/safe.test b/tests/safe.test index 0a888f4..6784bb9 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1,346 +1,145 @@ # safe.test -- # -# This file contains a collection of tests for safe Tcl, packages loading, and -# using safe interpreters. Sourcing this file into tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for safe Tcl, packages loading, +# and 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-stock.test. +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # -# Copyright © 1995-1996 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# 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.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] -foreach i [interp children] { +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 getAutoPath {child} { - set ap1 [lrange [lindex [safe::interpConfigure $child -autoPath] 1] 0 end] - set ap2 [::safe::DetokPath $child [interp eval $child 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 unexported (and -# thus unautoindexed) APIs in this test result arguments: +# 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 - tcl::test - but it might be absent if we're in standard tclsh) - -testConstraint tcl::test [expr {![catch {package require tcl::test}]}] -testConstraint AutoSyncDefined 1 +proc equiv {x} {return $x} -### 1. Basic help/error messages. - -test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { - safe::interpConfigure -} -result {no value given for parameter "child" (use -help for full usage) : - child name () name of the child} -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 - ------------ ---- ----- ---- - (-help gives this help) - ?child? name () name of the child (optional) - -accessPath list () access path for the child - -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} -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: +test safe-1.1 {safe::interpConfigure syntax} { + list [catch {safe::interpConfigure} msg] $msg; +} {1 {no value given for parameter "slave" (use -help for full usage) : + slave name () name of the slave}} +test safe-1.2 {safe::interpCreate syntax} { + list [catch {safe::interpCreate -help} msg] $msg; +} {1 {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- - (-help gives this help) - ?child? name () name of the child (optional) - -accessPath list () access path for the child + ( -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 child} -test safe-1.3 {safe::interpInit syntax} -returnCodes error -body { - safe::interpInit -noStatics -} -result {bad value "-noStatics" for parameter - child name () name of the child} + -deleteHook script () delete hook}} +test safe-1.3 {safe::interpInit syntax} { + list [catch {safe::interpInit -noStatics} msg] $msg; +} {1 {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 } "" -test safe-2.2 {creating interpreters, should have no aliases} -setup { +test safe-2.2 {creating interpreters, should have no aliases} { catch {safe::interpDelete a} -} -body { interp create a - a aliases -} -cleanup { + set l [a aliases] 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 { + set l +} "" +test safe-2.3 {creating safe interpreters, should have no unexpected aliases} { catch {safe::interpDelete a} -} -body { interp create a -safe - lsort [a aliases] -} -cleanup { + set l [a aliases] interp delete a -} -result {clock} - -### 3. Simple use of interpCreate, interpInit. -### Aliases in a new "interpCreate/interpInit" interpreter. + lsort $l +} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} -test safe-3.1 {calling safe::interpInit is safe} -setup { +test safe-3.1 {calling safe::interpInit is safe} { catch {safe::interpDelete a} - interp create a -safe -} -body { + interp create a -safe safe::interpInit a - interp eval a exec ls -} -returnCodes error -cleanup { + catch {interp eval a exec ls} msg safe::interpDelete a -} -result {invalid command name "exec"} -test safe-3.2 {calling safe::interpCreate on trusted interp} -setup { + set msg +} {invalid command name "exec"} +test safe-3.2 {calling safe::interpCreate on trusted interp} { catch {safe::interpDelete a} -} -body { safe::interpCreate a - lsort [a aliases] -} -cleanup { + set l [lsort [a aliases]] safe::interpDelete a -} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source} -test safe-3.3 {calling safe::interpCreate on trusted interp} -setup { + set l +} {::tcl::info::nameofexecutable clock encoding exit file glob load source} +test safe-3.3 {calling safe::interpCreate on trusted interp} { catch {safe::interpDelete a} -} -body { safe::interpCreate a - interp eval a {source [file join $tcl_library init.tcl]} -} -cleanup { + set x [interp eval a {source [file join $tcl_library init.tcl]}] safe::interpDelete a -} -result "" -test safe-3.4 {calling safe::interpCreate on trusted interp} -setup { + set x +} "" +test safe-3.4 {calling safe::interpCreate on trusted interp} { catch {safe::interpDelete a} -} -body { safe::interpCreate a - interp eval a {source [file join $tcl_library init.tcl]} -} -cleanup { + catch {set x \ + [interp eval a {source [file join $tcl_library init.tcl]}]} msg safe::interpDelete a -} -result {} + list $x $msg +} {{} {}} -### 4. Testing safe::interpDelete, double interpCreate. - -test safe-4.1 {safe::interpDelete} -setup { +test safe-4.1 {safe::interpDelete} { 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 { +} "" +test safe-4.2 {safe::interpDelete, indirectly} { catch {safe::interpDelete a} -} -body { 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 { +} "" + +test safe-4.5 {safe::interpDelete} { catch {safe::interpDelete a} -} -body { - safe::interpCreate a safe::interpCreate a -} -returnCodes error -cleanup { - safe::interpDelete a -} -result {interpreter named "a" already exists, cannot create} -test safe-4.6 {safe::interpDelete, indirectly} -setup { + catch {safe::interpCreate a} msg + set msg +} {interpreter named "a" already exists, cannot create} +test safe-4.6 {safe::interpDelete, indirectly} { catch {safe::interpDelete a} -} -body { safe::interpCreate a a eval exit -} -result "" - -### 5. Test the example files before using them to test safe interpreters. -### The old test "safe-5.1" has been moved to "safe-stock-9.8". -### A replacement test using example files is "safe-9.8". - -unset -nocomplain path +} "" -test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup { - set tmpAutoPath $::auto_path - lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] -} -body { - # Try to load the commands. - set code3 [catch report1 msg3] - set code4 [catch report2 msg4] - list $code3 $msg3 $code4 $msg4 -} -cleanup { - catch {rename report1 {}} - catch {rename report2 {}} - set ::auto_path $tmpAutoPath - auto_reset -} -match glob -result {0 ok1 0 ok2} -test safe-5.2 {example tclIndex commands, negative test in parent 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 parent 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 parent 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 parent 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 parent 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} +# The following test checks whether the definition of tcl_endOfWord can be +# obtained from auto_loading. -### 6. Test safe interps 'information leak'. +test safe-5.1 {test auto-loading in safe interpreters} { + catch {safe::interpDelete a} + safe::interpCreate a + set r [catch {interp eval a {tcl_endOfWord "" 0}} msg] + safe::interpDelete a + list $r $msg +} {0 -1} +# 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. @@ -357,279 +156,149 @@ test safe-6.2 {test safe interpreters knowledge of the world} { SafeEval {info script} } {} test safe-6.3 {test safe interpreters knowledge of the world} { - set r [SafeEval {array names tcl_platform}] + set r [lsort [SafeEval {array names tcl_platform}]] # If running a windows-debug shell, remove the "debug" element from r. - if {[testConstraint win]} { - set r [lsearch -all -inline -not -exact $r "debug"] + if {[testConstraint win] && ("debug" in $r)} { + set r [lreplace $r 1 1] } - set r [lsearch -all -inline -not -exact $r "threaded"] - 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... + set threaded [lsearch $r "threaded"] + if {$threaded != -1} { + set r [lreplace $r $threaded $threaded] + } + set r +} {byteOrder engine platform pointerSize wordSize} -### 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.* +# more test should be added to check that hostname, nameofexecutable, +# aren't leaking infos, but they still do... -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 { +# high level general test +test safe-7.1 {tests that everything works at high level} { + set i [safe::interpCreate]; # no error shall occur: - # (because the default access_path shall include 1st level sub dirs so - # package require in a child works like in the parent) - set v [interp eval $i {package require SafeTestPackage1}] + # (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 1}] # no error shall occur: - interp eval $i {HeresPackage1} - set v -} -cleanup { + interp eval $i {http_config}; 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 p* (not p1 if parent has a module path) - set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] - # should add as p* (not p2 if parent 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 children] - 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 $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 children] - 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]]] + set v +} 1.0 +test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -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 parent 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} + # should add as p1 + 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 {}} {}" -### 8. Test source control on file name. -test safe-8.1 {safe source control on file} -setup { - set i "a" +# test source control on file name +test safe-8.1 {safe source control on file} { + 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" + safe::interpCreate $i; + list [catch {$i eval {source}} msg] \ + $msg \ + [safe::interpDelete $i] ; +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} +test safe-8.2 {safe source control on file} { + 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" + safe::interpCreate $i; + list [catch {$i eval {source}} msg] \ + $msg \ + [safe::interpDelete $i] ; +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} +test safe-8.3 {safe source control on file} { + set i "a"; catch {safe::interpDelete $i} - set log {} - proc safe-test-log {str} {lappend ::log $str} - set prevlog [safe::setLogCmd] -} -body { - safe::interpCreate $i - safe::setLogCmd safe-test-log - list [catch {$i eval {source .}} msg] $msg $log -} -cleanup { - safe::setLogCmd $prevlog - safe::interpDelete $i - rename safe-test-log {} - unset i log -} -result {1 {permission denied} {{ERROR for child a : ".": is a directory}}} -test safe-8.4 {safe source control on file} -setup { - set i "a" + safe::interpCreate $i; + set log {}; + proc safe-test-log {str} {global log; lappend log $str} + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [catch {$i eval {source .}} msg] \ + $msg \ + $log \ + [safe::setLogCmd $prevlog; unset log] \ + [safe::interpDelete $i] ; +} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}} +test safe-8.4 {safe source control on file} { + set i "a"; catch {safe::interpDelete $i} - set log {} + safe::interpCreate $i; + set log {}; proc safe-test-log {str} {global log; lappend log $str} - set prevlog [safe::setLogCmd] -} -body { - safe::interpCreate $i - safe::setLogCmd safe-test-log - list [catch {$i eval {source /abc/def}} msg] $msg $log -} -cleanup { - safe::setLogCmd $prevlog - safe::interpDelete $i - rename safe-test-log {} - unset i log -} -result {1 {permission denied} {{ERROR for child a : "/abc/def": not in access_path}}} -test safe-8.5 {safe source control on file} -setup { - set i "a" + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [catch {$i eval {source /abc/def}} msg] \ + $msg \ + $log \ + [safe::setLogCmd $prevlog; unset log] \ + [safe::interpDelete $i] ; +} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}} +test safe-8.5 {safe source control on file} { + # This tested filename == *.tcl or tclIndex, but that restriction + # was removed in 8.4a4 - hobbs + set i "a"; catch {safe::interpDelete $i} - set log {} + safe::interpCreate $i; + set log {}; proc safe-test-log {str} {global log; lappend log $str} - set prevlog [safe::setLogCmd] -} -body { - # This tested filename == *.tcl or tclIndex, but that restriction was - # removed in 8.4a4 - hobbs - safe::interpCreate $i - safe::setLogCmd safe-test-log - list [catch { - $i eval {source [file join [info lib] blah]} - } msg] $msg $log -} -cleanup { - safe::setLogCmd $prevlog - safe::interpDelete $i - rename safe-test-log {} - unset i log -} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah]:no such file or directory"]] -test safe-8.6 {safe source control on file} -setup { - set i "a" + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [catch {$i eval {source [file join [info lib] blah]}} msg] \ + $msg \ + $log \ + [safe::setLogCmd $prevlog; unset log] \ + [safe::interpDelete $i] ; +} [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} { + set i "a"; catch {safe::interpDelete $i} - set log {} + safe::interpCreate $i; + set log {}; proc safe-test-log {str} {global log; lappend log $str} - set prevlog [safe::setLogCmd] -} -body { - safe::interpCreate $i - safe::setLogCmd safe-test-log - list [catch { - $i eval {source [file join [info lib] blah.tcl]} - } msg] $msg $log -} -cleanup { - safe::setLogCmd $prevlog - safe::interpDelete $i - rename safe-test-log {} - unset i log -} -result [list 1 {no such file or directory} [list "ERROR for child 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" + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \ + $msg \ + $log \ + [safe::setLogCmd $prevlog; unset log] \ + [safe::interpDelete $i] ; +} [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} { + # This tested length of filename, but that restriction + # was removed in 8.4a4 - hobbs + set i "a"; catch {safe::interpDelete $i} - set log {} + safe::interpCreate $i; + set log {}; proc safe-test-log {str} {global log; lappend log $str} - set prevlog [safe::setLogCmd] -} -body { - safe::interpCreate $i - # This tested length of filename, but that restriction was removed in - # 8.4a4 - hobbs - safe::setLogCmd safe-test-log - list [catch { - $i eval {source [file join [info lib] xxxxxxxxxxx.tcl]} - } msg] $msg $log -} -cleanup { - safe::setLogCmd $prevlog - safe::interpDelete $i - rename safe-test-log {} - unset i log -} -result [list 1 {no such file or directory} [list "ERROR for child 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] -} {} + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\ + msg] \ + $msg \ + $log \ + [safe::setLogCmd $prevlog; unset log] \ + [safe::interpDelete $i] ; +} [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} { + set i "a"; + catch {safe::interpDelete $i} + safe::interpCreate $i; + list [catch {$i eval {source -rsrc Init}} msg] \ + $msg \ + [safe::interpDelete $i] ; +} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}} test safe-8.9 {safe source and return} -setup { - set i "a" set returnScript [makeFile {return "ok"} return.tcl] catch {safe::interpDelete $i} } -body { @@ -639,10 +308,8 @@ 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 { @@ -655,865 +322,169 @@ test safe-8.10 {safe source and return} -setup { } -cleanup { catch {safe::interpDelete $i} removeFile $returnScript - unset i } -result ok -### 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" +test safe-9.1 {safe interps' deleteHook} { + set i "a"; catch {safe::interpDelete $i} set res {} -} -body { proc testDelHook {args} { - global res + global res; # the interp still exists at that point interp eval a {set delete 1} # mark that we've been here (successfully) - set res $args + set res $args; } - safe::interpCreate $i -deleteHook "testDelHook arg1 arg2" + 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" +} {{} {arg1 arg2 a}} +test safe-9.2 {safe interps' error in deleteHook} { + set i "a"; catch {safe::interpDelete $i} set res {} - set log {} - proc safe-test-log {str} {lappend ::log $str} - set prevlog [safe::setLogCmd] -} -body { proc testDelHook {args} { - global res + global res; # the interp still exists at that point interp eval a {set delete 1} # mark that we've been here (successfully) - set res $args + set res $args; # create an exception - error "being catched" + error "being catched"; } - safe::interpCreate $i -deleteHook "testDelHook arg1 arg2" - safe::setLogCmd safe-test-log - list [safe::interpDelete $i] $res $log -} -cleanup { - safe::setLogCmd $prevlog - catch {rename testDelHook {}} - rename safe-test-log {} - unset i log res -} -result {{} {arg1 arg2 a} {{NOTICE for child a : About to delete} {ERROR for child a : Delete hook error (being catched)} {NOTICE for child a : Deleted}}} -test safe-9.3 {dual specification of statics} -returnCodes error -body { - safe::interpCreate -stat true -nostat -} -result {conflicting values given for -statics and -noStatics} + set log {}; + proc safe-test-log {str} {global log; lappend log $str} + safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"; + set prevlog [safe::setLogCmd]; + safe::setLogCmd safe-test-log; + list [safe::interpDelete $i] $res \ + $log \ + [safe::setLogCmd $prevlog; unset log]; +} {{} {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} { + list [catch {safe::interpCreate -stat true -nostat} msg] $msg +} {1 {conflicting values given for -statics and -noStatics}} test safe-9.4 {dual specification of statics} { # no error shall occur safe::interpDelete [safe::interpCreate -stat false -nostat] } {} -test safe-9.5 {dual specification of nested} -returnCodes error -body { - safe::interpCreate -nested 0 -nestedload -} -result {conflicting values given for -nested and -nestedLoadOk} +test safe-9.5 {dual specification of nested} { + list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg +} {1 {conflicting values given for -nested and -nestedLoadOk}} + test safe-9.6 {interpConfigure widget like behaviour} -body { - # this test shall work, don't try to "fix it" unless you *really* know what - # you are doing (ie you are me :p) -- dl + # this test shall work, don't try to "fix it" unless + # you *really* know what you are doing (ie you are me :p) -- dl list [set i [safe::interpCreate \ - -noStatics \ - -nestedLoadOk \ - -deleteHook {foo bar}] - safe::interpConfigure $i -accessPath /foo/bar + -noStatics \ + -nestedLoadOk \ + -deleteHook {foo bar}]; + safe::interpConfigure $i -accessPath /foo/bar ; safe::interpConfigure $i]\ [safe::interpConfigure $i -aCCess]\ [safe::interpConfigure $i -nested]\ [safe::interpConfigure $i -statics]\ [safe::interpConfigure $i -DEL]\ - [safe::interpConfigure $i -accessPath /blah -statics 1 + [safe::interpConfigure $i -accessPath /blah -statics 1; safe::interpConfigure $i]\ - [safe::interpConfigure $i -deleteHook toto -nosta -nested 0 + [safe::interpConfigure $i -deleteHook toto -nosta -nested 0; safe::interpConfigure $i] -} -cleanup { - safe::interpDelete $i -} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\ - {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ - {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ - {-accessPath * -statics 0 -nested 0 -deleteHook toto}} -test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { - # this test shall work, believed equivalent to 9.6 - set i [safe::interpCreate \ - -noStatics \ - -nestedLoadOk \ - -deleteHook {foo bar}] - safe::interpConfigure $i -accessPath /foo/bar - set a [safe::interpConfigure $i] - set b [safe::interpConfigure $i -aCCess] - set c [safe::interpConfigure $i -nested] - set d [safe::interpConfigure $i -statics] - set e [safe::interpConfigure $i -DEL] - safe::interpConfigure $i -accessPath /blah -statics 1 - set f [safe::interpConfigure $i] - safe::interpConfigure $i -deleteHook toto -nosta -nested 0 - set g [safe::interpConfigure $i] - - list $a $b $c $d $e $f $g -} -cleanup { - safe::interpDelete $i - 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] +} -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}} - 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}} +# testing that nested and statics do what is advertised +# (we use a static package : Tcltest) - # 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 parent's [tcl::tm::list] in -# tokenized form to the child'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 +if {[catch {package require Tcltest} msg]} { + testConstraint TcltestPackage 0 +} else { + testConstraint TcltestPackage 1 + # we use the Tcltest package , which has no Safe_Init +} -catch {teststaticlibrary Safepfx1 0 0} -test safe-10.1 {testing statics loading} -constraints tcl::test -setup { +test safe-10.1 {testing statics loading} TcltestPackage { set i [safe::interpCreate] -} -body { - interp eval $i {load {} Safepfx1} -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure} -test safe-10.1.1 {testing statics loading} -constraints tcl::test -setup { - set i [safe::interpCreate] -} -body { - catch {interp eval $i {load {} Safepfx1}} m o - dict get $o -errorinfo -} -cleanup { - unset -nocomplain m o - safe::interpDelete $i -} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure - invoked from within -"load {} Safepfx1" - invoked from within -"interp eval $i {load {} Safepfx1}"} -test safe-10.2 {testing statics loading / -nostatics} -constraints tcl::test -body { + list \ + [catch {interp eval $i {load {} Tcltest}} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}} +test safe-10.2 {testing statics loading / -nostatics} TcltestPackage { set i [safe::interpCreate -nostatics] - interp eval $i {load {} Safepfx1} -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {permission denied (static library)} -test safe-10.3 {testing nested statics loading / no nested by default} -setup { - set i [safe::interpCreate] -} -constraints tcl::test -body { - interp eval $i {interp create x; load {} Safepfx1 x} -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {permission denied (nested load)} -test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body { + list \ + [catch {interp eval $i {load {} Tcltest}} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {permission denied (static package)} {}} +test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage { + set i [safe::interpCreate] + list \ + [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {permission denied (nested load)} {}} +test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage { set i [safe::interpCreate -nestedloadok] - interp eval $i {interp create x; load {} Safepfx1 x} -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure} -test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body { - set i [safe::interpCreate -nestedloadok] - catch {interp eval $i {interp create x; load {} Safepfx1 x}} m o - dict get $o -errorinfo -} -cleanup { - unset -nocomplain m o - safe::interpDelete $i -} -result {load of library for prefix Safepfx1 failed: can't use library in a safe interpreter: no Safepfx1_SafeInit procedure - invoked from within -"load {} Safepfx1 x" - invoked from within -"interp eval $i {interp create x; load {} Safepfx1 x}"} - -### 11. Safe encoding. - -test safe-11.1 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {wrong # args: should be "encoding subcommand ?arg ...?"} -test safe-11.1a {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding foobar -} -returnCodes error -cleanup { - safe::interpDelete $i -} -match glob -result {unknown or ambiguous subcommand "foobar": must be *} -test safe-11.2 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding system cp775 -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {wrong # args: should be "encoding system"} -test safe-11.3 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding system -} -cleanup { - safe::interpDelete $i -} -result [encoding system] -test safe-11.4 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding names -} -cleanup { - safe::interpDelete $i -} -result [encoding names] -test safe-11.5 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding convertfrom cp1258 foobar -} -cleanup { - safe::interpDelete $i -} -result foobar -test safe-11.6 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding convertto cp1258 foobar -} -cleanup { - safe::interpDelete $i -} -result foobar -test safe-11.7 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding convertfrom -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data"} -test safe-11.7.1 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - catch {interp eval $i encoding convertfrom} m o - dict get $o -errorinfo -} -match glob -cleanup { - unset -nocomplain m o - safe::interpDelete $i -} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data" - while executing -"encoding convertfrom" - invoked from within -"encoding convertfrom" - invoked from within -"interp eval $i encoding convertfrom"} -test safe-11.8 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - interp eval $i encoding convertto -} -returnCodes error -cleanup { - safe::interpDelete $i -} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data"} -test safe-11.8.1 {testing safe encoding} -setup { - set i [safe::interpCreate] -} -body { - catch {interp eval $i encoding convertto} m o - dict get $o -errorinfo -} -match glob -cleanup { - unset -nocomplain m o - safe::interpDelete $i -} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data" - while executing -"encoding convertto" - invoked from within -"encoding convertto" - invoked from within -"interp eval $i encoding convertto"} - -### 12. Safe glob. -### More tests of glob in sections 13, 16. + list \ + [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}} + +test safe-11.1 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding option ..."} {}} +test safe-11.2 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding system cp775} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding system"} {}} +test safe-11.3 {testing safe encoding} { + set i [safe::interpCreate] + set result [catch { + string match [encoding system] [interp eval $i encoding system] + } msg] + list $result $msg [safe::interpDelete $i] +} {0 1 {}} +test safe-11.4 {testing safe encoding} { + set i [safe::interpCreate] + set result [catch { + string match [encoding names] [interp eval $i encoding names] + } msg] + list $result $msg [safe::interpDelete $i] +} {0 1 {}} +test safe-11.5 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \ + $msg \ + [safe::interpDelete $i]; +} {0 foobar {}} +test safe-11.6 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertto cp1258 foobar} msg] \ + $msg \ + [safe::interpDelete $i]; +} {0 foobar {}} +test safe-11.7 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertfrom} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}} +test safe-11.8 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertto} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}} test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] @@ -1557,33 +528,11 @@ test safe-12.6 {glob is restricted [Bug 2906841]} -setup { } -cleanup { safe::interpDelete $i } -result {} -test safe-12.7 {glob is restricted} -setup { - set i [safe::interpCreate] -} -body { - $i eval glob * -} -returnCodes error -cleanup { - 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] +proc mkfile {filename} { + close [open $filename w] } -proc buildEnvironment2 {filename} { - upvar 1 testdir testdir testdir2 testdir2 testfile testfile - upvar 1 testdir3 testdir3 testfile2 testfile2 - set testdir [makeDirectory deletethisdir] - set testdir2 [makeDirectory deletemetoo $testdir] - set testfile [makeFile {} $filename $testdir2] - set testdir3 [makeDirectory deleteme $testdir] - set testfile2 [makeFile {} $filename $testdir3] -} - +#### New tests for Safe base glob, with patches @ Bug 2964715 test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { @@ -1593,7 +542,11 @@ test safe-13.1 {glob is restricted [Bug 2964715]} -setup { } -result {permission denied} test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment deleteme.tm + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval glob -nocomplain -directory $testdir2 *.tm] @@ -1604,20 +557,28 @@ test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964 } } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {glob match} test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment deleteme.tm + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile } -body { $i eval glob -directory $testdir2 *.tm } -returnCodes error -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {permission denied} test safe-13.4 {another valid glob call [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment deleteme.tm + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir ::safe::interpAddToAccessPath $i $testdir2 @@ -1630,70 +591,78 @@ test safe-13.4 {another valid glob call [Bug 2964715]} -setup { } } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {glob match} test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment deleteme.tm + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir2 $i eval \ glob -directory $testdir [file join deletemetoo *.tm] } -returnCodes error -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {permission denied} test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment deleteme.tm + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 deleteme.tm] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir $i eval \ glob -nocomplain -directory $testdir [file join deletemetoo *.tm] } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {} -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 - 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 { +test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment2 pkgIndex.tcl + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 pkgIndex.tcl] + file mkdir $testdir2 + mkfile $testfile } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 - ::safe::interpAddToAccessPath $i $testdir3 - mapAndSortList [list $safeTD EXPECTED] [$i eval [list \ + string map [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 { + file delete -force $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 { set i [safe::interpCreate] - buildEnvironment notIndex.tcl + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl] } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {} test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment notIndex.tcl + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval \ @@ -1705,24 +674,26 @@ test safe-13.9 {as 13.8 but test glob failure when -directory is outside access } } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {no match: } test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup { set i [safe::interpCreate] - buildEnvironment notIndex.tcl + set testdir [file join [temporaryDirectory] deletethisdir] + set testdir2 [file join $testdir deletemetoo] + set testfile [file join $testdir2 notIndex.tcl] + file mkdir $testdir2 + mkfile $testfile } -body { ::safe::interpAddToAccessPath $i $testdir $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl } -cleanup { safe::interpDelete $i - removeDirectory $testdir + file delete -force $testdir } -result {} -rename buildEnvironment {} -rename buildEnvironment2 {} - -### 14. Sanity checks on paths - module path, access path, auto_path. +rename mkfile {} -test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup { +#### 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 { set tm {} @@ -1733,1833 +704,54 @@ test safe-14.1 {Check that module path is the same as in the parent interpreter } -cleanup { safe::interpDelete $i } -result [::tcl::tm::path list] -test safe-14.2 {Check that first element of child 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 child 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 child auto_path (and access path) is Tcl Library, even if not true for parent, 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 child - 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 child auto_path (and access path) is Tcl Library, even if not true for parent, 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 child - - 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] -} -body { - set result [expr {"file" in [interp hidden $i]}] - lappend result [interp eval $i {tcl::file::split a/b/c}] - lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] - lappend result [interp invokehidden $i file split a/b/c] - lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg - lappend result [catch {interp invokehidden $i file isdirectory .}] - interp expose $i file - lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg - lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg -} -cleanup { - 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.2 {safe file ensemble does not surprise code} -setup { - set i [interp create -safe] -} -body { - set result [expr {"file" in [interp hidden $i]}] - lappend result [interp eval $i {tcl::file::split a/b/c}] - lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] - lappend result [interp invokehidden $i file split a/b/c] - lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg - lappend result [catch {interp invokehidden $i file isdirectory .}] - interp expose $i file - lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg - lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo] -} -cleanup { - unset -nocomplain msg o - 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 - while executing -"file isdirectory ." - invoked from within -"interp eval $i {file isdirectory .}"}} - -### 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 { +### ~ should have no special meaning in paths in safe interpreters +test safe-15.1 {Bug 2913625: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] -} -body { +} -constraints knownBug -body { $i eval { set d [format %c 126] - list [file join [file dirname $d] [file tail $d]] + list [file dirname $d] [file tail $d] \ + [file join [file dirname $d] [file tail $d]] } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME - unset savedHOME -} -result {./~} -test safe-16.2 {Bug 3529949: defang ~user in paths} -setup { +} -result {~} +test safe-15.2 {Bug 2913625: defang ~user in paths} -setup { set i [safe::interpCreate] set user $tcl_platform(user) -} -body { +} -constraints knownBug -body { string map [list $user USER] [$i eval \ "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] - makeFile {} bar $syntheticHOME - set savedHOME $env(HOME) - set env(HOME) $syntheticHOME - set i [safe::interpCreate] -} -body { - ::safe::interpAddToAccessPath $i $syntheticHOME - $i eval {glob -nocomplain ~/*} -} -cleanup { - 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] -} -body { - ::safe::interpAddToAccessPath $i $~$tcl_platform(user) - $i eval [list glob -nocomplain ~$tcl_platform(user)/*] -} -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 { +} -result {~USER} +test safe-15.3 {Bug 2913625: defang ~ in globs} -setup { set savedHOME $env(HOME) - set env(HOME) /foo/bar + set env(HOME) / set i [safe::interpCreate] -} -body { - $i eval { - set d [format %c 126] - file join {$p(:0:)/foo/bar} $d - } +} -constraints knownBug -body { + $i expose glob realglob + $i eval {realglob -nocomplain [join {~ / *} ""]} } -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 { +test safe-15.4 {Bug 2913625: defang ~user in globs} -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]] +} -constraints knownBug -body { + $i expose glob realglob + string map [list $user USER] [$i eval [list\ + realglob -directory ~$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 child 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 child works like in the parent) - 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 parent has a module path) - set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] - # should add as p* (not p2 if parent 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 parent 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 parent has a module path) - set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] - - # should add as p* (not p2 if parent 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 child. - -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 child'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 child's ::auto_path changes to - # reflect the changes in token mappings; and that it is based on the -autoPath - # value, not the previously restricted child ::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 parent'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 -> parent'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 -> parent'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 -> parent'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 {} -unset -nocomplain path -rename mapList {} -rename mapAndSortList {} ::tcltest::cleanupTests return - -# Local Variables: -# mode: tcl -# End: |