# 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. # # The package http 1.0 is convenient for testing package loading, but will soon # be removed. # - Tests that use http are replaced here with tests that use example packages # provided in subdirectory auto0 of the tests directory, which are independent # of any changes made to the packages provided with Tcl itself. # - These are tests 7.1 7.2 7.4 9.11 9.13 # - Tests 5.* test the example packages themselves before they # are used to test Safe Base interpreters. # - Alternative tests using stock packages of Tcl 8.6 are in file # safe-stock86.test. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } foreach i [interp children] { interp delete $i } set SaveAutoPath $::auto_path set ::auto_path [info library] set TestsDir [file normalize [file dirname [info script]]] set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR] proc mapList {map listIn} { set listOut {} foreach element $listIn { lappend listOut [string map $map $element] } return $listOut } proc mapAndSortList {map listIn} { set listOut {} foreach element $listIn { lappend listOut [string map $map $element] } lsort $listOut } # Force actual loading of the safe package because we use un-exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}] test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { safe::interpConfigure } -result {no value given for parameter "slave" (use -help for full usage) : slave name () name of the slave} test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body { safe::interpCreate -help } -result {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- (-help gives this help) ?slave? name () name of the slave (optional) -accessPath list () access path for the slave -noStatics boolflag (false) prevent loading of statically linked pkgs -statics boolean (true) loading of statically linked pkgs -nestedLoadOk boolflag (false) allow nested loading -nested boolean (false) nested loading -deleteHook script () delete hook} test safe-1.3 {safe::interpInit syntax} -returnCodes error -body { safe::interpInit -noStatics } -result {bad value "-noStatics" for parameter slave name () name of the slave} 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 { catch {safe::interpDelete a} } -body { interp create a a aliases } -cleanup { safe::interpDelete a # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters # is regrettable and should be removed at the next major revision. } -result "" test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup { catch {safe::interpDelete a} } -body { interp create a -safe lsort [a aliases] } -cleanup { interp delete a } -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock} test safe-3.1 {calling safe::interpInit is safe} -setup { catch {safe::interpDelete a} interp create a -safe } -body { safe::interpInit a interp eval a exec ls } -returnCodes error -cleanup { safe::interpDelete a } -result {invalid command name "exec"} test safe-3.2 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a lsort [a aliases] } -cleanup { safe::interpDelete a } -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source} test safe-3.3 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a interp eval a {source [file join $tcl_library init.tcl]} } -cleanup { safe::interpDelete a } -result "" test safe-3.4 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { safe::interpCreate a interp eval a {source [file join $tcl_library init.tcl]} } -cleanup { safe::interpDelete a } -result {} test safe-4.1 {safe::interpDelete} -setup { catch {safe::interpDelete a} } -body { interp create a safe::interpDelete a # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters # is regrettable and should be removed at the next major revision. } -result "" test safe-4.2 {safe::interpDelete, indirectly} -setup { catch {safe::interpDelete a} } -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 { 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::interpDelete a} } -body { safe::interpCreate a a eval exit } -result "" # The old test "safe-5.1" has been moved to "safe-stock86-9.8". # A replacement test using example files is "safe-9.8". # Tests 5.* test the example files before using them to test safe interpreters. test safe-5.1 {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} # 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. set SafeInterp [interp create -safe] catch {$SafeInterp eval $script} msg opts interp delete $SafeInterp return -options $opts $msg } test safe-6.1 {test safe interpreters knowledge of the world} { lsort [SafeEval {info globals}] } {tcl_interactive tcl_patchLevel tcl_platform tcl_version} 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}] # If running a windows-debug shell, remove the "debug" element from r. if {[testConstraint win]} { set r [lsearch -all -inline -not -exact $r "debug"] } 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... # high level general test # Use example packages not http1.0 etc test safe-7.1 {tests that everything works at high level} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] set i [safe::interpCreate] set ::auto_path $tmpAutoPath } -body { # no error shall occur: # (because the default access_path shall include 1st level sub dirs so # package require in a 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 } -match glob -result 1.2.3 test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as 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 anymore in the secure 0-level # provided deep path) list $token1 $token2 $token3 -- \ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -cleanup { } -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 {tests specific path and positive search} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p* (not p1 if 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 { } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ {TCLLIB * TESTSDIR/auto0/auto1} -- {}} # test source control on file name test safe-8.1 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i $i eval {source} } -returnCodes error -cleanup { safe::interpDelete $i unset i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.2 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i $i eval {source a b c d e} } -returnCodes error -cleanup { safe::interpDelete $i unset i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.3 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {lappend ::log $str} 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 slave a : ".": is a directory}}} test safe-8.4 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} 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 slave a : "/abc/def": not in access_path}}} test safe-8.5 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} 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 slave a : [file join [info library] blah]:no such file or directory"]] test safe-8.6 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} 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 slave a : [file join [info library] blah.tcl]:no such file or directory"]] test safe-8.7 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} 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 slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]] test safe-8.8 {safe source forbids -rsrc} emptyTest { # Disabled this test. It was only useful for long unsupported # Mac OS 9 systems. [Bug 860a9f1945] } {} test safe-8.9 {safe source and return} -setup { set i "a" set returnScript [makeFile {return "ok"} return.tcl] catch {safe::interpDelete $i} } -body { safe::interpCreate $i set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] $i eval [list source $token/[file tail $returnScript]] } -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 { safe::interpCreate $i set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] $i eval [list apply {filename { source $filename error boom }} $token/[file tail $returnScript]] } -cleanup { catch {safe::interpDelete $i} removeFile $returnScript unset i } -result ok test safe-9.1 {safe interps' deleteHook} -setup { set i "a" catch {safe::interpDelete $i} set res {} } -body { proc testDelHook {args} { 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 } safe::interpCreate $i -deleteHook "testDelHook arg1 arg2" list [interp eval $i exit] $res } -cleanup { catch {rename testDelHook {}} unset i res } -result {{} {arg1 arg2 a}} test safe-9.2 {safe interps' error in deleteHook} -setup { set i "a" catch {safe::interpDelete $i} set res {} set log {} proc safe-test-log {str} {lappend ::log $str} set prevlog [safe::setLogCmd] } -body { proc testDelHook {args} { 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 # create an exception 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 slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}} test safe-9.3 {dual specification of statics} -returnCodes error -body { safe::interpCreate -stat true -nostat } -result {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.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 list [set i [safe::interpCreate \ -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]\ [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 {test autoloading commands indexed in tclIndex files} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load and run the commands. set code1 [catch {interp eval $i {report1}} msg1] set code2 [catch {interp eval $i {report2}} msg2] list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}} test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load auto_load data. interp eval $i {catch nonExistentCommand} # Load and run the commands. # This guarantees the test will pass even if the tokens are swapped. set code1 [catch {interp eval $i {report1}} msg1] set code2 [catch {interp eval $i {report2}} msg2] # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Run the commands. set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load auto_load data. interp eval $i {catch nonExistentCommand} # Do not load the commands. With the tokens swapped, the test # will pass only if the Safe Base has called auto_reset. # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load and run the commands. set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup { } -body { # For complete correspondence to safe-9.10opt, include auto0 in access path. set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0] \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. # This would have no effect because the records in Pkg of these directories # were from access as children of {$p(:1:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0] \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Try to load the packages and run a command from each one. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Try to load the packages and run a command from each one. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ $mappA -- $mappB -- \ $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] # Load pkgIndex.tcl data. catch {interp eval $i {package require NOEXIST}} # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. safe::interpConfigure $i -accessPath [list $tcl_library] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] # Try to load the packages. set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ $mappA -- $mappB } -cleanup { safe::interpDelete $i } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ 1 {* not found in access path} -- 1 1 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}} test safe-9.20 {check module loading} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} -- res0 res1 res2} # - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in # tokenized form to the slave's access path, and then adds all the # descendants, discovered recursively by using glob. # - The order of the directories in the list returned by glob is system-dependent, # and therefore this is true also for (a) the order of token assignment to # descendants of the [tcl::tm::list] roots; and (b) the order of those same # directories in the access path. Both those things must be sorted before # comparing with expected results. The test is therefore not totally strict, # but will notice missing or surplus directories. test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Load pkg data. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Force the interpreter to acquire pkg data which will soon become stale. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Refresh stale pkg data. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path } tcl::tm::path add [file join $TestsDir auto0 modules] } -body { set i [safe::interpCreate -accessPath [list $tcl_library]] # Inspect. set confA [safe::interpConfigure $i] set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Force the interpreter to acquire pkg data which will soon become stale. catch {interp eval $i {package require NOEXIST}} catch {interp eval $i {package require mod1::NOEXIST}} catch {interp eval $i {package require mod2::NOEXIST}} # Add to access path. # This injects more tokens, pushing modules to higher token numbers. safe::interpConfigure $i -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] # Try to load the packages and run a command from each one. set code0 [catch {interp eval $i {package require test0}} msg0] set code1 [catch {interp eval $i {package require mod1::test1}} msg1] set code2 [catch {interp eval $i {package require mod2::test2}} msg2] set out0 [interp eval $i {test0::try0}] set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ TESTSDIR/auto0/modules/mod2} --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { catch {interp eval $i {load {} Safepkg1}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1" invoked from within "interp eval $i {load {} Safepkg1}"} test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body { set i [safe::interpCreate -nostatics] interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (static package)} test safe-10.3 {testing nested statics loading / no nested by default} -setup { set i [safe::interpCreate] } -constraints TcltestPackage -body { interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i } -result {permission denied (nested load)} test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o dict get $o -errorinfo } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1 x" invoked from within "interp eval $i {interp create x; load {} Safepkg1 x}"} 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 option ?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 {bad option "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 ?encoding? 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 } -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data" while executing "encoding convertfrom" invoked from within "::interp invokehidden interp* 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 ?encoding? 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 } -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data" while executing "encoding convertto" invoked from within "::interp invokehidden interp* encoding convertto" invoked from within "encoding convertto" invoked from within "interp eval $i encoding convertto"} test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob ../* } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.2 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -directory .. * } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.3 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -join .. * } -returnCodes error -cleanup { safe::interpDelete $i } -result "permission denied" test safe-12.4 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -nocomplain ../* } -cleanup { safe::interpDelete $i } -result {} test safe-12.5 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -directory .. -nocomplain * } -cleanup { safe::interpDelete $i } -result {} test safe-12.6 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { $i eval glob -nocomplain -join .. * } -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} 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 buildEnvironment2 {filename} { upvar 1 testdir testdir testdir2 testdir2 testfile testfile upvar 1 testdir3 testdir3 testfile2 testfile2 set testdir [makeDirectory deletethisdir] set testdir2 [makeDirectory deletemetoo $testdir] set testfile [makeFile {} $filename $testdir2] set testdir3 [makeDirectory deleteme $testdir] set testfile2 [makeFile {} $filename $testdir3] } #### New tests for Safe base glob, with patches @ Bug 2964715 test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { $i eval glob * } -returnCodes error -cleanup { safe::interpDelete $i } -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 } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval glob -nocomplain -directory $testdir2 *.tm] if {$result eq [list $testfile]} { return "glob match" } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $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 } -body { $i eval glob -directory $testdir2 *.tm } -returnCodes error -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {permission denied} test safe-13.4 {another valid glob call [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment deleteme.tm } -body { ::safe::interpAddToAccessPath $i $testdir ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval \ glob -nocomplain -directory $testdir [file join deletemetoo *.tm]] if {$result eq [list $testfile]} { return "glob match" } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $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 } -body { ::safe::interpAddToAccessPath $i $testdir2 $i eval \ glob -directory $testdir [file join deletemetoo *.tm] } -returnCodes error -cleanup { safe::interpDelete $i removeDirectory $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 } -body { ::safe::interpAddToAccessPath $i $testdir $i eval \ glob -nocomplain -directory $testdir [file join deletemetoo *.tm] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} test safe-13.7 {mimic the glob call by tclPkgUnknown 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 { set i [safe::interpCreate] buildEnvironment2 pkgIndex.tcl } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 ::safe::interpAddToAccessPath $i $testdir3 mapAndSortList [list $safeTD EXPECTED] [$i eval [list \ glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl} # See comments on lsort after test safe-9.20. test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment notIndex.tcl } -body { 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 } -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 } -body { ::safe::interpAddToAccessPath $i $testdir2 set result [$i eval \ glob -directory $testdir -join -nocomplain * notIndex.tcl] if {$result eq [list $testfile]} { return {glob match} } else { return "no match: $result" } } -cleanup { safe::interpDelete $i removeDirectory $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 } -body { ::safe::interpAddToAccessPath $i $testdir $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {} rename buildEnvironment {} rename buildEnvironment2 {} #### Test for the module path test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { set tm {} foreach token [$i eval ::tcl::tm::path list] { lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token] } return $tm } -cleanup { safe::interpDelete $i } -result [::tcl::tm::path list] 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 .}"}} ### ~ should have no special meaning in paths in safe interpreters test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] } -body { $i eval { set d [format %c 126] list [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 { set i [safe::interpCreate] set user $tcl_platform(user) } -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 { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] } -body { $i eval { set d [format %c 126] file join {$p(:0:)/foo/bar} $d } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME } -result {~} test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) } -body { string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]] } -cleanup { safe::interpDelete $i unset user } -result {~USER} test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) } -body { string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]] } -cleanup { safe::interpDelete $i unset user } -result {~USER} # cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp rename mapList {} rename mapAndSortList {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: