util/src/TclTk/tcl8.6.12/tests/safe.test

   1 # safe.test --
   2 #
   3 # This file contains a collection of tests for safe Tcl, packages loading, and
   4 # using safe interpreters. Sourcing this file into tcl runs the tests and
   5 # generates output for errors. No output means no errors were found.
   6 #
   7 # The package http 1.0 is convenient for testing package loading, but will soon
   8 # be removed.
   9 # - Tests that use http are replaced here with tests that use example packages
  10 #   provided in subdirectory auto0 of the tests directory, which are independent
  11 #   of any changes made to the packages provided with Tcl itself.
  12 #   - These are tests 7.1 7.2 7.4 9.11 9.13
  13 #   - Tests 5.* test the example packages themselves before they
  14 #     are used to test Safe Base interpreters.
  15 # - Alternative tests using stock packages of Tcl 8.6 are in file
  16 #   safe-stock.test.
  17 #
  18 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
  19 # Copyright (c) 1998-1999 by Scriptics Corporation.
  20 #
  21 # See the file "license.terms" for information on usage and redistribution of
  22 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
  23
  24 if {"::tcltest" ni [namespace children]} {
  25     package require tcltest 2.5
  26     namespace import -force ::tcltest::*
  27 }
  28
  29 foreach i [interp children] {
  30     interp delete $i
  31 }
  32
  33 set SaveAutoPath $::auto_path
  34 set ::auto_path [info library]
  35 set TestsDir [file normalize [file dirname [info script]]]
  36 set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
  37
  38 proc mapList {map listIn} {
  39     set listOut {}
  40     foreach element $listIn {
  41         lappend listOut [string map $map $element]
  42     }
  43     return $listOut
  44 }
  45 proc mapAndSortList {map listIn} {
  46     set listOut {}
  47     foreach element $listIn {
  48         lappend listOut [string map $map $element]
  49     }
  50     lsort $listOut
  51 }
  52
  53 # Force actual loading of the safe package because we use un-exported (and
  54 # thus un-autoindexed) APIs in this test result arguments:
  55 catch {safe::interpConfigure}
  56
  57 # testing that nested and statics do what is advertised (we use a static
  58 # package - Tcltest - but it might be absent if we're in standard tclsh)
  59
  60 testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
  61 \f
  62 test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
  63     safe::interpConfigure
  64 } -result {no value given for parameter "slave" (use -help for full usage) :
  65     slave name () name of the slave}
  66 test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
  67     safe::interpCreate -help
  68 } -result {Usage information:
  69     Var/FlagName  Type     Value   Help
  70     ------------  ----     -----   ----
  71     (-help                         gives this help)
  72     ?slave?       name     ()      name of the slave (optional)
  73     -accessPath   list     ()      access path for the slave
  74     -noStatics    boolflag (false) prevent loading of statically linked pkgs
  75     -statics      boolean  (true)  loading of statically linked pkgs
  76     -nestedLoadOk boolflag (false) allow nested loading
  77     -nested       boolean  (false) nested loading
  78     -deleteHook   script   ()      delete hook}
  79 test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
  80     safe::interpInit -noStatics
  81 } -result {bad value "-noStatics" for parameter
  82     slave name () name of the slave}
  83
  84 test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
  85     # Disabled this test.  It tests nothing sensible.  [Bug 999612]
  86     # interp aliases
  87 } ""
  88 test safe-2.2 {creating interpreters, should have no aliases} -setup {
  89     catch {safe::interpDelete a}
  90 } -body {
  91     interp create a
  92     a aliases
  93 } -cleanup {
  94     safe::interpDelete a
  95     # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
  96     # is regrettable and should be removed at the next major revision.
  97 } -result ""
  98 test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
  99     catch {safe::interpDelete a}
 100 } -body {
 101     interp create a -safe
 102     lsort [a aliases]
 103 } -cleanup {
 104     interp delete a
 105 } -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
 106
 107 test safe-3.1 {calling safe::interpInit is safe} -setup {
 108     catch {safe::interpDelete a}
 109     interp create a -safe
 110 } -body {
 111     safe::interpInit a
 112     interp eval a exec ls
 113 } -returnCodes error -cleanup {
 114     safe::interpDelete a
 115 } -result {invalid command name "exec"}
 116 test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
 117     catch {safe::interpDelete a}
 118 } -body {
 119     safe::interpCreate a
 120     lsort [a aliases]
 121 } -cleanup {
 122     safe::interpDelete a
 123 } -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}
 124 test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
 125     catch {safe::interpDelete a}
 126 } -body {
 127     safe::interpCreate a
 128     interp eval a {source [file join $tcl_library init.tcl]}
 129 } -cleanup {
 130     safe::interpDelete a
 131 } -result ""
 132 test safe-3.4 {calling safe::interpCreate on trusted interp} -setup {
 133     catch {safe::interpDelete a}
 134 } -body {
 135     safe::interpCreate a
 136     interp eval a {source [file join $tcl_library init.tcl]}
 137 } -cleanup {
 138     safe::interpDelete a
 139 } -result {}
 140
 141 test safe-4.1 {safe::interpDelete} -setup {
 142     catch {safe::interpDelete a}
 143 } -body {
 144     interp create a
 145     safe::interpDelete a
 146     # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
 147     # is regrettable and should be removed at the next major revision.
 148 } -result ""
 149 test safe-4.2 {safe::interpDelete, indirectly} -setup {
 150     catch {safe::interpDelete a}
 151 } -body {
 152     interp create a
 153     a alias exit safe::interpDelete a
 154     a eval exit
 155     # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
 156     # is regrettable and should be removed at the next major revision.
 157 } -result ""
 158 test safe-4.5 {safe::interpDelete} -setup {
 159     catch {safe::interpDelete a}
 160 } -body {
 161     safe::interpCreate a
 162     safe::interpCreate a
 163 } -returnCodes error -cleanup {
 164     safe::interpDelete a
 165 } -result {interpreter named "a" already exists, cannot create}
 166 test safe-4.6 {safe::interpDelete, indirectly} -setup {
 167     catch {safe::interpDelete a}
 168 } -body {
 169     safe::interpCreate a
 170     a eval exit
 171 } -result ""
 172
 173 # The old test "safe-5.1" has been moved to "safe-stock-9.8".
 174 # A replacement test using example files is "safe-9.8".
 175 # Tests 5.* test the example files before using them to test safe interpreters.
 176
 177 unset -nocomplain path
 178
 179 test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup {
 180     set tmpAutoPath $::auto_path
 181     lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
 182 } -body {
 183     # Try to load the commands.
 184     set code3 [catch report1 msg3]
 185     set code4 [catch report2 msg4]
 186     list $code3 $msg3 $code4 $msg4
 187 } -cleanup {
 188     catch {rename report1 {}}
 189     catch {rename report2 {}}
 190     set ::auto_path $tmpAutoPath
 191     auto_reset
 192 } -match glob -result {0 ok1 0 ok2}
 193 test safe-5.2 {example tclIndex commands, negative test in parent interpreter} -setup {
 194     set tmpAutoPath $::auto_path
 195     lappend ::auto_path [file join $TestsDir auto0]
 196 } -body {
 197     # Try to load the commands.
 198     set code3 [catch report1 msg3]
 199     set code4 [catch report2 msg4]
 200     list $code3 $msg3 $code4 $msg4
 201 } -cleanup {
 202     catch {rename report1 {}}
 203     catch {rename report2 {}}
 204     set ::auto_path $tmpAutoPath
 205     auto_reset
 206 } -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
 207 test safe-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories} -setup {
 208     set tmpAutoPath $::auto_path
 209     lappend ::auto_path [file join $TestsDir auto0]
 210 } -body {
 211     # Try to load the packages and run a command from each one.
 212     set code3 [catch {package require SafeTestPackage1} msg3]
 213     set code4 [catch {package require SafeTestPackage2} msg4]
 214     set code5 [catch HeresPackage1 msg5]
 215     set code6 [catch HeresPackage2 msg6]
 216     list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
 217 } -cleanup {
 218     set ::auto_path $tmpAutoPath
 219     catch {package forget SafeTestPackage1}
 220     catch {package forget SafeTestPackage2}
 221     catch {rename HeresPackage1 {}}
 222     catch {rename HeresPackage2 {}}
 223 } -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
 224 test safe-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories} -setup {
 225     set tmpAutoPath $::auto_path
 226     lappend ::auto_path [file join $TestsDir auto0 auto1] \
 227                         [file join $TestsDir auto0 auto2]
 228 } -body {
 229     # Try to load the packages and run a command from each one.
 230     set code3 [catch {package require SafeTestPackage1} msg3]
 231     set code4 [catch {package require SafeTestPackage2} msg4]
 232     set code5 [catch HeresPackage1 msg5]
 233     set code6 [catch HeresPackage2 msg6]
 234     list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
 235 } -cleanup {
 236     set ::auto_path $tmpAutoPath
 237     catch {package forget SafeTestPackage1}
 238     catch {package forget SafeTestPackage2}
 239     catch {rename HeresPackage1 {}}
 240     catch {rename HeresPackage2 {}}
 241 } -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
 242 test safe-5.5 {example modules packages, test in parent interpreter, replace path} -setup {
 243     set oldTm [tcl::tm::path list]
 244     foreach path $oldTm {
 245         tcl::tm::path remove $path
 246     }
 247     tcl::tm::path add [file join $TestsDir auto0 modules]
 248 } -body {
 249     # Try to load the modules and run a command from each one.
 250     set code0 [catch {package require test0} msg0]
 251     set code1 [catch {package require mod1::test1} msg1]
 252     set code2 [catch {package require mod2::test2} msg2]
 253     set out0  [test0::try0]
 254     set out1  [mod1::test1::try1]
 255     set out2  [mod2::test2::try2]
 256     list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
 257 } -cleanup {
 258     tcl::tm::path remove [file join $TestsDir auto0 modules]
 259     foreach path [lreverse $oldTm] {
 260         tcl::tm::path add $path
 261     }
 262     catch {package forget test0}
 263     catch {package forget mod1::test1}
 264     catch {package forget mod2::test2}
 265     catch {namespace delete ::test0}
 266     catch {namespace delete ::mod1}
 267 } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
 268 test safe-5.6 {example modules packages, test in parent interpreter, append to path} -setup {
 269     tcl::tm::path add [file join $TestsDir auto0 modules]
 270 } -body {
 271     # Try to load the modules and run a command from each one.
 272     set code0 [catch {package require test0} msg0]
 273     set code1 [catch {package require mod1::test1} msg1]
 274     set code2 [catch {package require mod2::test2} msg2]
 275     set out0  [test0::try0]
 276     set out1  [mod1::test1::try1]
 277     set out2  [mod2::test2::try2]
 278     list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
 279 } -cleanup {
 280     tcl::tm::path remove [file join $TestsDir auto0 modules]
 281     catch {package forget test0}
 282     catch {package forget mod1::test1}
 283     catch {package forget mod2::test2}
 284     catch {namespace delete ::test0}
 285     catch {namespace delete ::mod1}
 286 } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
 287
 288 # test safe interps 'information leak'
 289 proc SafeEval {script} {
 290     # Helper procedure that ensures the safe interp is cleaned up even if
 291     # there is a failure in the script.
 292     set SafeInterp [interp create -safe]
 293     catch {$SafeInterp eval $script} msg opts
 294     interp delete $SafeInterp
 295     return -options $opts $msg
 296 }
 297
 298 test safe-6.1 {test safe interpreters knowledge of the world} {
 299     lsort [SafeEval {info globals}]
 300 } {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
 301 test safe-6.2 {test safe interpreters knowledge of the world} {
 302     SafeEval {info script}
 303 } {}
 304 test safe-6.3 {test safe interpreters knowledge of the world} {
 305     set r [SafeEval {array names tcl_platform}]
 306     # If running a windows-debug shell, remove the "debug" element from r.
 307     if {[testConstraint win]} {
 308         set r [lsearch -all -inline -not -exact $r "debug"]
 309     }
 310     set r [lsearch -all -inline -not -exact $r "threaded"]
 311     lsort $r
 312 } {byteOrder engine pathSeparator platform pointerSize wordSize}
 313
 314 rename SafeEval {}
 315 # More test should be added to check that hostname, nameofexecutable, aren't
 316 # leaking infos, but they still do...
 317
 318 # high level general test
 319 # Use example packages not http1.0 etc
 320 test safe-7.1 {tests that everything works at high level} -setup {
 321     set tmpAutoPath $::auto_path
 322     lappend ::auto_path [file join $TestsDir auto0]
 323     set i [safe::interpCreate]
 324     set ::auto_path $tmpAutoPath
 325 } -body {
 326     # no error shall occur:
 327     # (because the default access_path shall include 1st level sub dirs so
 328     #  package require in a child works like in the parent)
 329     set v [interp eval $i {package require SafeTestPackage1}]
 330     # no error shall occur:
 331     interp eval $i {HeresPackage1}
 332     set v
 333 } -cleanup {
 334     safe::interpDelete $i
 335 } -match glob -result 1.2.3
 336 test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
 337 } -body {
 338     set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
 339     # should not add anything (p0)
 340     set token1 [safe::interpAddToAccessPath $i [info library]]
 341     # should add as p* (not p1 if parent has a module path)
 342     set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
 343     # should add as p* (not p2 if parent has a module path)
 344     set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
 345     set confA [safe::interpConfigure $i]
 346     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 347     # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
 348     # provided deep path)
 349     list $token1 $token2 $token3 -- \
 350             [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
 351             $mappA -- [safe::interpDelete $i]
 352 } -cleanup {
 353 } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
 354         1 {can't find package SafeTestPackage1} --\
 355         {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}}
 356 test safe-7.3 {check that safe subinterpreters work} {
 357     set g [interp children]
 358     if {$g ne {}} {
 359         append g { -- residue of an earlier test}
 360     }
 361     set h [info vars ::safe::S*]
 362     if {$h ne {}} {
 363         append h { -- residue of an earlier test}
 364     }
 365     set i [safe::interpCreate]
 366     set j [safe::interpCreate [list $i x]]
 367     list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \
 368             [interp exists $j] [info vars ::safe::S*]
 369 } {{} {} ok {} 0 {}}
 370 test safe-7.3.1 {check that safe subinterpreters work with namespace names} -setup {
 371 } -body {
 372     set g [interp children]
 373     if {$g ne {}} {
 374         append g { -- residue of an earlier test}
 375     }
 376     set h [info vars ::safe::S*]
 377     if {$h ne {}} {
 378         append h { -- residue of an earlier test}
 379     }
 380     set i [safe::interpCreate foo::bar]
 381     set j [safe::interpCreate [list $i hello::world]]
 382     list $g $h [interp eval $j {join {o k} ""}] \
 383             [foo::bar eval {hello::world eval {join {o k} ""}}] \
 384             [safe::interpDelete $i] \
 385             [interp exists $j] [info vars ::safe::S*]
 386 } -match glob -result {{} {} ok ok {} 0 {}}
 387 test safe-7.4 {tests specific path and positive search} -setup {
 388 } -body {
 389     set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
 390     # should not add anything (p0)
 391     set token1 [safe::interpAddToAccessPath $i [info library]]
 392     # should add as p* (not p1 if parent has a module path)
 393     set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]]
 394     set confA [safe::interpConfigure $i]
 395     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 396     # this time, unlike test safe-7.2, SafeTestPackage1 should be found
 397     list $token1 $token2 -- \
 398             [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
 399             $mappA -- [safe::interpDelete $i]
 400     # Note that the glob match elides directories (those from the module path)
 401     # other than the first and last in the access path.
 402 } -cleanup {
 403 } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
 404         {TCLLIB * TESTSDIR/auto0/auto1} -- {}}
 405
 406 # test source control on file name
 407 test safe-8.1 {safe source control on file} -setup {
 408     set i "a"
 409     catch {safe::interpDelete $i}
 410 } -body {
 411     safe::interpCreate $i
 412     $i eval {source}
 413 } -returnCodes error -cleanup {
 414     safe::interpDelete $i
 415     unset i
 416 } -result {wrong # args: should be "source ?-encoding E? fileName"}
 417 test safe-8.2 {safe source control on file} -setup {
 418     set i "a"
 419     catch {safe::interpDelete $i}
 420 } -body {
 421     safe::interpCreate $i
 422     $i eval {source a b c d e}
 423 } -returnCodes error -cleanup {
 424     safe::interpDelete $i
 425     unset i
 426 } -result {wrong # args: should be "source ?-encoding E? fileName"}
 427 test safe-8.3 {safe source control on file} -setup {
 428     set i "a"
 429     catch {safe::interpDelete $i}
 430     set log {}
 431     proc safe-test-log {str} {lappend ::log $str}
 432     set prevlog [safe::setLogCmd]
 433 } -body {
 434     safe::interpCreate $i
 435     safe::setLogCmd safe-test-log
 436     list [catch {$i eval {source .}} msg] $msg $log
 437 } -cleanup {
 438     safe::setLogCmd $prevlog
 439     safe::interpDelete $i
 440     rename safe-test-log {}
 441     unset i log
 442 } -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
 443 test safe-8.4 {safe source control on file} -setup {
 444     set i "a"
 445     catch {safe::interpDelete $i}
 446     set log {}
 447     proc safe-test-log {str} {global log; lappend log $str}
 448     set prevlog [safe::setLogCmd]
 449 } -body {
 450     safe::interpCreate $i
 451     safe::setLogCmd safe-test-log
 452     list [catch {$i eval {source /abc/def}} msg] $msg $log
 453 } -cleanup {
 454     safe::setLogCmd $prevlog
 455     safe::interpDelete $i
 456     rename safe-test-log {}
 457     unset i log
 458 } -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
 459 test safe-8.5 {safe source control on file} -setup {
 460     set i "a"
 461     catch {safe::interpDelete $i}
 462     set log {}
 463     proc safe-test-log {str} {global log; lappend log $str}
 464     set prevlog [safe::setLogCmd]
 465 } -body {
 466     # This tested filename == *.tcl or tclIndex, but that restriction was
 467     # removed in 8.4a4 - hobbs
 468     safe::interpCreate $i
 469     safe::setLogCmd safe-test-log
 470     list [catch {
 471         $i eval {source [file join [info lib] blah]}
 472     } msg] $msg $log
 473 } -cleanup {
 474     safe::setLogCmd $prevlog
 475     safe::interpDelete $i
 476     rename safe-test-log {}
 477     unset i log
 478 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
 479 test safe-8.6 {safe source control on file} -setup {
 480     set i "a"
 481     catch {safe::interpDelete $i}
 482     set log {}
 483     proc safe-test-log {str} {global log; lappend log $str}
 484     set prevlog [safe::setLogCmd]
 485 } -body {
 486     safe::interpCreate $i
 487     safe::setLogCmd safe-test-log
 488     list [catch {
 489         $i eval {source [file join [info lib] blah.tcl]}
 490     } msg] $msg $log
 491 } -cleanup {
 492     safe::setLogCmd $prevlog
 493     safe::interpDelete $i
 494     rename safe-test-log {}
 495     unset i log
 496 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
 497 test safe-8.7 {safe source control on file} -setup {
 498     set i "a"
 499     catch {safe::interpDelete $i}
 500     set log {}
 501     proc safe-test-log {str} {global log; lappend log $str}
 502     set prevlog [safe::setLogCmd]
 503 } -body {
 504     safe::interpCreate $i
 505     # This tested length of filename, but that restriction was removed in
 506     # 8.4a4 - hobbs
 507     safe::setLogCmd safe-test-log
 508     list [catch {
 509         $i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}
 510     } msg] $msg $log
 511 } -cleanup {
 512     safe::setLogCmd $prevlog
 513     safe::interpDelete $i
 514     rename safe-test-log {}
 515     unset i log
 516 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
 517 test safe-8.8 {safe source forbids -rsrc} emptyTest {
 518     # Disabled this test.  It was only useful for long unsupported
 519     # Mac OS 9 systems. [Bug 860a9f1945]
 520 } {}
 521 test safe-8.9 {safe source and return} -setup {
 522     set i "a"
 523     set returnScript [makeFile {return "ok"} return.tcl]
 524     catch {safe::interpDelete $i}
 525 } -body {
 526     safe::interpCreate $i
 527     set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
 528     $i eval [list source $token/[file tail $returnScript]]
 529 } -cleanup {
 530     catch {safe::interpDelete $i}
 531     removeFile $returnScript
 532     unset i
 533 } -result ok
 534 test safe-8.10 {safe source and return} -setup {
 535     set i "a"
 536     set returnScript [makeFile {return -level 2 "ok"} return.tcl]
 537     catch {safe::interpDelete $i}
 538 } -body {
 539     safe::interpCreate $i
 540     set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
 541     $i eval [list apply {filename {
 542         source $filename
 543         error boom
 544     }} $token/[file tail $returnScript]]
 545 } -cleanup {
 546     catch {safe::interpDelete $i}
 547     removeFile $returnScript
 548     unset i
 549 } -result ok
 550
 551 test safe-9.1 {safe interps' deleteHook} -setup {
 552     set i "a"
 553     catch {safe::interpDelete $i}
 554     set res {}
 555 } -body {
 556     proc testDelHook {args} {
 557         global res
 558         # the interp still exists at that point
 559         interp eval a {set delete 1}
 560         # mark that we've been here (successfully)
 561         set res $args
 562     }
 563     safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
 564     list [interp eval $i exit] $res
 565 } -cleanup {
 566     catch {rename testDelHook {}}
 567     unset i res
 568 } -result {{} {arg1 arg2 a}}
 569 test safe-9.2 {safe interps' error in deleteHook} -setup {
 570     set i "a"
 571     catch {safe::interpDelete $i}
 572     set res {}
 573     set log {}
 574     proc safe-test-log {str} {lappend ::log $str}
 575     set prevlog [safe::setLogCmd]
 576 } -body {
 577     proc testDelHook {args} {
 578         global res
 579         # the interp still exists at that point
 580         interp eval a {set delete 1}
 581         # mark that we've been here (successfully)
 582         set res $args
 583         # create an exception
 584         error "being catched"
 585     }
 586     safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
 587     safe::setLogCmd safe-test-log
 588     list [safe::interpDelete $i] $res $log
 589 } -cleanup {
 590     safe::setLogCmd $prevlog
 591     catch {rename testDelHook {}}
 592     rename safe-test-log {}
 593     unset i log res
 594 } -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}}}
 595 test safe-9.3 {dual specification of statics} -returnCodes error -body {
 596     safe::interpCreate -stat true -nostat
 597 } -result {conflicting values given for -statics and -noStatics}
 598 test safe-9.4 {dual specification of statics} {
 599     # no error shall occur
 600     safe::interpDelete [safe::interpCreate -stat false -nostat]
 601 } {}
 602 test safe-9.5 {dual specification of nested} -returnCodes error -body {
 603     safe::interpCreate -nested 0 -nestedload
 604 } -result {conflicting values given for -nested and -nestedLoadOk}
 605 test safe-9.6 {interpConfigure widget like behaviour} -body {
 606    # this test shall work, don't try to "fix it" unless you *really* know what
 607    # you are doing (ie you are me :p) -- dl
 608    list [set i [safe::interpCreate \
 609                     -noStatics \
 610                     -nestedLoadOk \
 611                     -deleteHook {foo bar}]
 612          safe::interpConfigure $i -accessPath /foo/bar
 613          safe::interpConfigure $i]\
 614         [safe::interpConfigure $i -aCCess]\
 615         [safe::interpConfigure $i -nested]\
 616         [safe::interpConfigure $i -statics]\
 617         [safe::interpConfigure $i -DEL]\
 618         [safe::interpConfigure $i -accessPath /blah -statics 1
 619          safe::interpConfigure $i]\
 620         [safe::interpConfigure $i -deleteHook toto -nosta -nested 0
 621          safe::interpConfigure $i]
 622 } -cleanup {
 623     safe::interpDelete $i
 624 } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
 625         {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
 626         {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
 627         {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
 628 test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
 629    # this test shall work, believed equivalent to 9.6
 630     set i [safe::interpCreate \
 631             -noStatics \
 632             -nestedLoadOk \
 633             -deleteHook {foo bar}]
 634            safe::interpConfigure $i -accessPath /foo/bar
 635     set a [safe::interpConfigure $i]
 636     set b [safe::interpConfigure $i -aCCess]
 637     set c [safe::interpConfigure $i -nested]
 638     set d [safe::interpConfigure $i -statics]
 639     set e [safe::interpConfigure $i -DEL]
 640            safe::interpConfigure $i -accessPath /blah -statics 1
 641     set f [safe::interpConfigure $i]
 642            safe::interpConfigure $i -deleteHook toto -nosta -nested 0
 643     set g [safe::interpConfigure $i]
 644
 645     list $a $b $c $d $e $f $g
 646 } -cleanup {
 647     safe::interpDelete $i
 648     unset -nocomplain a b c d e f g i
 649 } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
 650         {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
 651         {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
 652         {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
 653 test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup {
 654 } -body {
 655     set i [safe::interpCreate -accessPath [list $tcl_library \
 656                                             [file join $TestsDir auto0 auto1] \
 657                                             [file join $TestsDir auto0 auto2]]]
 658     # Inspect.
 659     set confA [safe::interpConfigure $i]
 660     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 661     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 662     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 663
 664     # Load and run the commands.
 665     set code1 [catch {interp eval $i {report1}} msg1]
 666     set code2 [catch {interp eval $i {report2}} msg2]
 667
 668     list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA
 669 } -cleanup {
 670     safe::interpDelete $i
 671 } -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
 672         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}}
 673 test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup {
 674 } -body {
 675     set i [safe::interpCreate -accessPath [list $tcl_library \
 676                                             [file join $TestsDir auto0 auto1] \
 677                                             [file join $TestsDir auto0 auto2]]]
 678     # Inspect.
 679     set confA [safe::interpConfigure $i]
 680     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 681     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 682     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 683
 684     # Load auto_load data.
 685     interp eval $i {catch nonExistentCommand}
 686
 687     # Load and run the commands.
 688     # This guarantees the test will pass even if the tokens are swapped.
 689     set code1 [catch {interp eval $i {report1}} msg1]
 690     set code2 [catch {interp eval $i {report2}} msg2]
 691
 692     # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
 693     safe::interpConfigure $i -accessPath [list $tcl_library \
 694                                            [file join $TestsDir auto0 auto2] \
 695                                            [file join $TestsDir auto0 auto1]]
 696     # Inspect.
 697     set confB [safe::interpConfigure $i]
 698     set mappB [mapList $PathMapp [dict get $confB -accessPath]]
 699     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 700     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 701
 702     # Run the commands.
 703     set code3 [catch {interp eval $i {report1}} msg3]
 704     set code4 [catch {interp eval $i {report2}} msg4]
 705
 706     list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
 707 } -cleanup {
 708     safe::interpDelete $i
 709 } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
 710         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
 711         {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
 712 test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup {
 713 } -body {
 714     set i [safe::interpCreate -accessPath [list $tcl_library \
 715                                             [file join $TestsDir auto0 auto1] \
 716                                             [file join $TestsDir auto0 auto2]]]
 717     # Inspect.
 718     set confA [safe::interpConfigure $i]
 719     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 720     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 721     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 722
 723     # Load auto_load data.
 724     interp eval $i {catch nonExistentCommand}
 725
 726     # Do not load the commands.  With the tokens swapped, the test
 727     # will pass only if the Safe Base has called auto_reset.
 728
 729     # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
 730     safe::interpConfigure $i -accessPath [list $tcl_library \
 731                                            [file join $TestsDir auto0 auto2] \
 732                                            [file join $TestsDir auto0 auto1]]
 733     # Inspect.
 734     set confB [safe::interpConfigure $i]
 735     set mappB [mapList $PathMapp [dict get $confB -accessPath]]
 736     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 737     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 738
 739     # Load and run the commands.
 740     set code3 [catch {interp eval $i {report1}} msg3]
 741     set code4 [catch {interp eval $i {report2}} msg4]
 742
 743     list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
 744 } -cleanup {
 745     safe::interpDelete $i
 746 } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
 747         0 ok1 0 ok2 --\
 748         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
 749         {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
 750 test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup {
 751 } -body {
 752     # For complete correspondence to safe-9.10opt, include auto0 in access path.
 753     set i [safe::interpCreate -accessPath [list $tcl_library \
 754                                             [file join $TestsDir auto0] \
 755                                             [file join $TestsDir auto0 auto1] \
 756                                             [file join $TestsDir auto0 auto2]]]
 757     # Inspect.
 758     set confA [safe::interpConfigure $i]
 759     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 760     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
 761     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 762     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 763
 764     # Load pkgIndex.tcl data.
 765     catch {interp eval $i {package require NOEXIST}}
 766
 767     # Rearrange access path.  Swap tokens {$p(:2:)} and {$p(:3:)}.
 768     # This would have no effect because the records in Pkg of these directories
 769     # were from access as children of {$p(:1:)}.
 770     safe::interpConfigure $i -accessPath [list $tcl_library \
 771                                            [file join $TestsDir auto0] \
 772                                            [file join $TestsDir auto0 auto2] \
 773                                            [file join $TestsDir auto0 auto1]]
 774     # Inspect.
 775     set confB [safe::interpConfigure $i]
 776     set mappB [mapList $PathMapp [dict get $confB -accessPath]]
 777     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 778     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 779
 780     # Try to load the packages and run a command from each one.
 781     set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
 782     set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
 783     set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
 784     set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
 785
 786     list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
 787          $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
 788 } -cleanup {
 789     safe::interpDelete $i
 790 } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
 791         {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
 792         {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
 793         0 OK1 0 OK2}
 794 test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup {
 795 } -body {
 796     set i [safe::interpCreate -accessPath [list $tcl_library \
 797                                             [file join $TestsDir auto0 auto1] \
 798                                             [file join $TestsDir auto0 auto2]]]
 799     # Inspect.
 800     set confA [safe::interpConfigure $i]
 801     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 802     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 803     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 804
 805     # Load pkgIndex.tcl data.
 806     catch {interp eval $i {package require NOEXIST}}
 807
 808     # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
 809     safe::interpConfigure $i -accessPath [list $tcl_library \
 810                                            [file join $TestsDir auto0 auto2] \
 811                                            [file join $TestsDir auto0 auto1]]
 812     # Inspect.
 813     set confB [safe::interpConfigure $i]
 814     set mappB [mapList $PathMapp [dict get $confB -accessPath]]
 815     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 816     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 817
 818     # Try to load the packages and run a command from each one.
 819     set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
 820     set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
 821     set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
 822     set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
 823
 824     list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
 825             $mappA -- $mappB -- \
 826             $code5 $msg5 $code6 $msg6
 827 } -cleanup {
 828     safe::interpDelete $i
 829 } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
 830         0 1.2.3 0 2.3.4 --\
 831         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
 832         {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
 833         0 OK1 0 OK2}
 834 test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup {
 835 } -body {
 836     set i [safe::interpCreate -accessPath [list $tcl_library \
 837                                             [file join $TestsDir auto0 auto1] \
 838                                             [file join $TestsDir auto0 auto2]]]
 839     # Inspect.
 840     set confA [safe::interpConfigure $i]
 841     set mappA [mapList $PathMapp [dict get $confA -accessPath]]
 842     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
 843     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
 844
 845     # Load pkgIndex.tcl data.
 846     catch {interp eval $i {package require NOEXIST}}
 847
 848     # Limit access path.  Remove tokens {$p(:1:)} and {$p(:2:)}.
 849     safe::interpConfigure $i -accessPath [list $tcl_library]
 850
 851     # Inspect.
 852     set confB [safe::interpConfigure $i]
 853     set mappB [mapList $PathMapp [dict get $confB -accessPath]]
 854     set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4]
 855     set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5]
 856
 857     # Try to load the packages.
 858     set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
 859     set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
 860
 861     list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
 862             $mappA -- $mappB
 863 } -cleanup {
 864     safe::interpDelete $i
 865 } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
 866         1 {* not found in access path} -- 1 1 --\
 867         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}}
 868 test safe-9.20 {check module loading} -setup {
 869     set oldTm [tcl::tm::path list]
 870     foreach path $oldTm {
 871         tcl::tm::path remove $path
 872     }
 873     tcl::tm::path add [file join $TestsDir auto0 modules]
 874 } -body {
 875     set i [safe::interpCreate -accessPath [list $tcl_library]]
 876
 877     # Inspect.
 878     set confA [safe::interpConfigure $i]
 879     set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
 880     set modsA [interp eval $i {tcl::tm::path list}]
 881     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
 882     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
 883     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
 884
 885     # Try to load the packages and run a command from each one.
 886     set code0 [catch {interp eval $i {package require test0}} msg0]
 887     set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
 888     set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
 889     set out0  [interp eval $i {test0::try0}]
 890     set out1  [interp eval $i {mod1::test1::try1}]
 891     set out2  [interp eval $i {mod2::test2::try2}]
 892
 893     list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
 894             $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
 895 } -cleanup {
 896     tcl::tm::path remove [file join $TestsDir auto0 modules]
 897     foreach path [lreverse $oldTm] {
 898         tcl::tm::path add $path
 899     }
 900     safe::interpDelete $i
 901 } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
 902         0 0.5 0 1.0 0 2.0 --\
 903         {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
 904          TESTSDIR/auto0/modules/mod2} -- res0 res1 res2}
 905 # - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
 906 #   tokenized form to the child's access path, and then adds all the
 907 #   descendants, discovered recursively by using glob.
 908 # - The order of the directories in the list returned by glob is system-dependent,
 909 #   and therefore this is true also for (a) the order of token assignment to
 910 #   descendants of the [tcl::tm::list] roots; and (b) the order of those same
 911 #   directories in the access path.  Both those things must be sorted before
 912 #   comparing with expected results.  The test is therefore not totally strict,
 913 #   but will notice missing or surplus directories.
 914 test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup {
 915     set oldTm [tcl::tm::path list]
 916     foreach path $oldTm {
 917         tcl::tm::path remove $path
 918     }
 919     tcl::tm::path add [file join $TestsDir auto0 modules]
 920 } -body {
 921     set i [safe::interpCreate -accessPath [list $tcl_library]]
 922
 923     # Inspect.
 924     set confA [safe::interpConfigure $i]
 925     set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
 926     set modsA [interp eval $i {tcl::tm::path list}]
 927     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
 928     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
 929     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
 930
 931     # Add to access path.
 932     # This injects more tokens, pushing modules to higher token numbers.
 933     safe::interpConfigure $i -accessPath [list $tcl_library \
 934                                            [file join $TestsDir auto0 auto1] \
 935                                            [file join $TestsDir auto0 auto2]]
 936     # Inspect.
 937     set confB [safe::interpConfigure $i]
 938     set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
 939     set modsB [interp eval $i {tcl::tm::path list}]
 940     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
 941     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
 942     set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
 943
 944     # Load pkg data.
 945     catch {interp eval $i {package require NOEXIST}}
 946     catch {interp eval $i {package require mod1::NOEXIST}}
 947     catch {interp eval $i {package require mod2::NOEXIST}}
 948
 949     # Try to load the packages and run a command from each one.
 950     set code0 [catch {interp eval $i {package require test0}} msg0]
 951     set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
 952     set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
 953     set out0  [interp eval $i {test0::try0}]
 954     set out1  [interp eval $i {mod1::test1::try1}]
 955     set out2  [interp eval $i {mod2::test2::try2}]
 956
 957     list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
 958             [lsort [list $path3 $path4 $path5]] -- $modsB -- \
 959             $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
 960             $out0 $out1 $out2
 961 } -cleanup {
 962     tcl::tm::path remove [file join $TestsDir auto0 modules]
 963     foreach path [lreverse $oldTm] {
 964         tcl::tm::path add $path
 965     }
 966     safe::interpDelete $i
 967 } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
 968         {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
 969         0 0.5 0 1.0 0 2.0 --\
 970         {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
 971          TESTSDIR/auto0/modules/mod2} --\
 972         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
 973          TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
 974         res0 res1 res2}
 975 # See comments on lsort after test safe-9.20.
 976 test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup {
 977     set oldTm [tcl::tm::path list]
 978     foreach path $oldTm {
 979         tcl::tm::path remove $path
 980     }
 981     tcl::tm::path add [file join $TestsDir auto0 modules]
 982 } -body {
 983     set i [safe::interpCreate -accessPath [list $tcl_library]]
 984
 985     # Inspect.
 986     set confA [safe::interpConfigure $i]
 987     set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
 988     set modsA [interp eval $i {tcl::tm::path list}]
 989     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
 990     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
 991     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
 992
 993     # Add to access path.
 994     # This injects more tokens, pushing modules to higher token numbers.
 995     safe::interpConfigure $i -accessPath [list $tcl_library \
 996                                           [file join $TestsDir auto0 auto1] \
 997                                           [file join $TestsDir auto0 auto2]]
 998     # Inspect.
 999     set confB [safe::interpConfigure $i]
1000     set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
1001     set modsB [interp eval $i {tcl::tm::path list}]
1002     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
1003     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
1004     set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
1005
1006     # Try to load the packages and run a command from each one.
1007     set code0 [catch {interp eval $i {package require test0}} msg0]
1008     set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
1009     set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
1010     set out0  [interp eval $i {test0::try0}]
1011     set out1  [interp eval $i {mod1::test1::try1}]
1012     set out2  [interp eval $i {mod2::test2::try2}]
1013
1014     list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
1015             [lsort [list $path3 $path4 $path5]] -- $modsB -- \
1016             $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
1017             $out0 $out1 $out2
1018 } -cleanup {
1019     tcl::tm::path remove [file join $TestsDir auto0 modules]
1020     foreach path [lreverse $oldTm] {
1021         tcl::tm::path add $path
1022     }
1023     safe::interpDelete $i
1024 } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
1025         {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
1026         0 0.5 0 1.0 0 2.0 --\
1027         {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
1028          TESTSDIR/auto0/modules/mod2} --\
1029         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
1030          TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
1031         res0 res1 res2}
1032 # See comments on lsort after test safe-9.20.
1033 test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup {
1034     set oldTm [tcl::tm::path list]
1035     foreach path $oldTm {
1036         tcl::tm::path remove $path
1037     }
1038     tcl::tm::path add [file join $TestsDir auto0 modules]
1039 } -body {
1040     set i [safe::interpCreate -accessPath [list $tcl_library]]
1041
1042     # Inspect.
1043     set confA [safe::interpConfigure $i]
1044     set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
1045     set modsA [interp eval $i {tcl::tm::path list}]
1046     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
1047     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
1048     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
1049
1050     # Force the interpreter to acquire pkg data which will soon become stale.
1051     catch {interp eval $i {package require NOEXIST}}
1052     catch {interp eval $i {package require mod1::NOEXIST}}
1053     catch {interp eval $i {package require mod2::NOEXIST}}
1054
1055     # Add to access path.
1056     # This injects more tokens, pushing modules to higher token numbers.
1057     safe::interpConfigure $i -accessPath [list $tcl_library \
1058                                            [file join $TestsDir auto0 auto1] \
1059                                            [file join $TestsDir auto0 auto2]]
1060     # Inspect.
1061     set confB [safe::interpConfigure $i]
1062     set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
1063     set modsB [interp eval $i {tcl::tm::path list}]
1064     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
1065     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
1066     set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
1067
1068     # Refresh stale pkg data.
1069     catch {interp eval $i {package require NOEXIST}}
1070     catch {interp eval $i {package require mod1::NOEXIST}}
1071     catch {interp eval $i {package require mod2::NOEXIST}}
1072
1073     # Try to load the packages and run a command from each one.
1074     set code0 [catch {interp eval $i {package require test0}} msg0]
1075     set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
1076     set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
1077     set out0  [interp eval $i {test0::try0}]
1078     set out1  [interp eval $i {mod1::test1::try1}]
1079     set out2  [interp eval $i {mod2::test2::try2}]
1080
1081     list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
1082             [lsort [list $path3 $path4 $path5]] -- $modsB -- \
1083             $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
1084             $out0 $out1 $out2
1085 } -cleanup {
1086     tcl::tm::path remove [file join $TestsDir auto0 modules]
1087     foreach path [lreverse $oldTm] {
1088         tcl::tm::path add $path
1089     }
1090     safe::interpDelete $i
1091 } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
1092         {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
1093         0 0.5 0 1.0 0 2.0 --\
1094         {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
1095          TESTSDIR/auto0/modules/mod2} --\
1096         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
1097          TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
1098         res0 res1 res2}
1099 # See comments on lsort after test safe-9.20.
1100 test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup {
1101     set oldTm [tcl::tm::path list]
1102     foreach path $oldTm {
1103         tcl::tm::path remove $path
1104     }
1105     tcl::tm::path add [file join $TestsDir auto0 modules]
1106 } -body {
1107     set i [safe::interpCreate -accessPath [list $tcl_library]]
1108
1109     # Inspect.
1110     set confA [safe::interpConfigure $i]
1111     set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
1112     set modsA [interp eval $i {tcl::tm::path list}]
1113     set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
1114     set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
1115     set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
1116
1117     # Force the interpreter to acquire pkg data which will soon become stale.
1118     catch {interp eval $i {package require NOEXIST}}
1119     catch {interp eval $i {package require mod1::NOEXIST}}
1120     catch {interp eval $i {package require mod2::NOEXIST}}
1121
1122     # Add to access path.
1123     # This injects more tokens, pushing modules to higher token numbers.
1124     safe::interpConfigure $i -accessPath [list $tcl_library \
1125                                            [file join $TestsDir auto0 auto1] \
1126                                            [file join $TestsDir auto0 auto2]]
1127     # Inspect.
1128     set confB [safe::interpConfigure $i]
1129     set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
1130     set modsB [interp eval $i {tcl::tm::path list}]
1131     set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
1132     set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
1133     set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
1134
1135     # Try to load the packages and run a command from each one.
1136     set code0 [catch {interp eval $i {package require test0}} msg0]
1137     set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
1138     set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
1139     set out0  [interp eval $i {test0::try0}]
1140     set out1  [interp eval $i {mod1::test1::try1}]
1141     set out2  [interp eval $i {mod2::test2::try2}]
1142
1143     list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
1144             [lsort [list $path3 $path4 $path5]] -- $modsB -- \
1145             $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
1146             $out0 $out1 $out2
1147 } -cleanup {
1148     tcl::tm::path remove [file join $TestsDir auto0 modules]
1149     foreach path [lreverse $oldTm] {
1150         tcl::tm::path add $path
1151     }
1152     safe::interpDelete $i
1153 } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
1154         {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
1155         0 0.5 0 1.0 0 2.0 --\
1156         {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
1157          TESTSDIR/auto0/modules/mod2} --\
1158         {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
1159          TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
1160         res0 res1 res2}
1161 # See comments on lsort after test safe-9.20.
1162
1163 catch {teststaticpkg Safepkg1 0 0}
1164 test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
1165     set i [safe::interpCreate]
1166 } -body {
1167     interp eval $i {load {} Safepkg1}
1168 } -returnCodes error -cleanup {
1169     safe::interpDelete $i
1170 } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
1171 test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
1172     set i [safe::interpCreate]
1173 } -body {
1174     catch {interp eval $i {load {} Safepkg1}} m o
1175     dict get $o -errorinfo
1176 } -returnCodes ok -cleanup {
1177     unset -nocomplain m o
1178     safe::interpDelete $i
1179 } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
1180     invoked from within
1181 "load {} Safepkg1"
1182     invoked from within
1183 "interp eval $i {load {} Safepkg1}"}
1184 test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
1185     set i [safe::interpCreate -nostatics]
1186     interp eval $i {load {} Safepkg1}
1187 } -returnCodes error -cleanup {
1188     safe::interpDelete $i
1189 } -result {permission denied (static package)}
1190 test safe-10.3 {testing nested statics loading / no nested by default} -setup {
1191     set i [safe::interpCreate]
1192 } -constraints TcltestPackage -body {
1193     interp eval $i {interp create x; load {} Safepkg1 x}
1194 } -returnCodes error -cleanup {
1195     safe::interpDelete $i
1196 } -result {permission denied (nested load)}
1197 test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
1198     set i [safe::interpCreate -nestedloadok]
1199     interp eval $i {interp create x; load {} Safepkg1 x}
1200 } -returnCodes error -cleanup {
1201     safe::interpDelete $i
1202 } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
1203 test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
1204     set i [safe::interpCreate -nestedloadok]
1205     catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
1206     dict get $o -errorinfo
1207 } -returnCodes ok -cleanup {
1208     unset -nocomplain m o
1209     safe::interpDelete $i
1210 } -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
1211     invoked from within
1212 "load {} Safepkg1 x"
1213     invoked from within
1214 "interp eval $i {interp create x; load {} Safepkg1 x}"}
1215
1216 test safe-11.1 {testing safe encoding} -setup {
1217     set i [safe::interpCreate]
1218 } -body {
1219     interp eval $i encoding
1220 } -returnCodes error -cleanup {
1221     safe::interpDelete $i
1222 } -result {wrong # args: should be "encoding option ?arg ...?"}
1223 test safe-11.1a {testing safe encoding} -setup {
1224     set i [safe::interpCreate]
1225 } -body {
1226     interp eval $i encoding foobar
1227 } -returnCodes error -cleanup {
1228     safe::interpDelete $i
1229 } -match glob -result {bad option "foobar": must be *}
1230 test safe-11.2 {testing safe encoding} -setup {
1231     set i [safe::interpCreate]
1232 } -body {
1233     interp eval $i encoding system cp775
1234 } -returnCodes error -cleanup {
1235     safe::interpDelete $i
1236 } -result {wrong # args: should be "encoding system"}
1237 test safe-11.3 {testing safe encoding} -setup {
1238     set i [safe::interpCreate]
1239 } -body {
1240     interp eval $i encoding system
1241 } -cleanup {
1242     safe::interpDelete $i
1243 } -result [encoding system]
1244 test safe-11.4 {testing safe encoding} -setup {
1245     set i [safe::interpCreate]
1246 } -body {
1247     interp eval $i encoding names
1248 } -cleanup {
1249     safe::interpDelete $i
1250 } -result [encoding names]
1251 test safe-11.5 {testing safe encoding} -setup {
1252     set i [safe::interpCreate]
1253 } -body {
1254     interp eval $i encoding convertfrom cp1258 foobar
1255 } -cleanup {
1256     safe::interpDelete $i
1257 } -result foobar
1258 test safe-11.6 {testing safe encoding} -setup {
1259     set i [safe::interpCreate]
1260 } -body {
1261     interp eval $i encoding convertto cp1258 foobar
1262 } -cleanup {
1263     safe::interpDelete $i
1264 } -result foobar
1265 test safe-11.7 {testing safe encoding} -setup {
1266     set i [safe::interpCreate]
1267 } -body {
1268     interp eval $i encoding convertfrom
1269 } -returnCodes error -cleanup {
1270     safe::interpDelete $i
1271 } -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
1272 test safe-11.7.1 {testing safe encoding} -setup {
1273     set i [safe::interpCreate]
1274 } -body {
1275     catch {interp eval $i encoding convertfrom} m o
1276     dict get $o -errorinfo
1277 } -returnCodes ok -match glob -cleanup {
1278     unset -nocomplain m o
1279     safe::interpDelete $i
1280 } -result {wrong # args: should be "encoding convertfrom ?encoding? data"
1281     while executing
1282 "encoding convertfrom"
1283     invoked from within
1284 "::interp invokehidden interp* encoding convertfrom"
1285     invoked from within
1286 "encoding convertfrom"
1287     invoked from within
1288 "interp eval $i encoding convertfrom"}
1289 test safe-11.8 {testing safe encoding} -setup {
1290     set i [safe::interpCreate]
1291 } -body {
1292     interp eval $i encoding convertto
1293 } -returnCodes error -cleanup {
1294     safe::interpDelete $i
1295 } -result {wrong # args: should be "encoding convertto ?encoding? data"}
1296 test safe-11.8.1 {testing safe encoding} -setup {
1297     set i [safe::interpCreate]
1298 } -body {
1299     catch {interp eval $i encoding convertto} m o
1300     dict get $o -errorinfo
1301 } -returnCodes ok -match glob -cleanup {
1302     unset -nocomplain m o
1303     safe::interpDelete $i
1304 } -result {wrong # args: should be "encoding convertto ?encoding? data"
1305     while executing
1306 "encoding convertto"
1307     invoked from within
1308 "::interp invokehidden interp* encoding convertto"
1309     invoked from within
1310 "encoding convertto"
1311     invoked from within
1312 "interp eval $i encoding convertto"}
1313
1314 test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
1315     set i [safe::interpCreate]
1316 } -body {
1317     $i eval glob ../*
1318 } -returnCodes error -cleanup {
1319     safe::interpDelete $i
1320 } -result "permission denied"
1321 test safe-12.2 {glob is restricted [Bug 2906841]} -setup {
1322     set i [safe::interpCreate]
1323 } -body {
1324     $i eval glob -directory .. *
1325 } -returnCodes error -cleanup {
1326     safe::interpDelete $i
1327 } -result "permission denied"
1328 test safe-12.3 {glob is restricted [Bug 2906841]} -setup {
1329     set i [safe::interpCreate]
1330 } -body {
1331     $i eval glob -join .. *
1332 } -returnCodes error -cleanup {
1333     safe::interpDelete $i
1334 } -result "permission denied"
1335 test safe-12.4 {glob is restricted [Bug 2906841]} -setup {
1336     set i [safe::interpCreate]
1337 } -body {
1338     $i eval glob -nocomplain ../*
1339 } -cleanup {
1340     safe::interpDelete $i
1341 } -result {}
1342 test safe-12.5 {glob is restricted [Bug 2906841]} -setup {
1343     set i [safe::interpCreate]
1344 } -body {
1345     $i eval glob -directory .. -nocomplain *
1346 } -cleanup {
1347     safe::interpDelete $i
1348 } -result {}
1349 test safe-12.6 {glob is restricted [Bug 2906841]} -setup {
1350     set i [safe::interpCreate]
1351 } -body {
1352     $i eval glob -nocomplain -join .. *
1353 } -cleanup {
1354     safe::interpDelete $i
1355 } -result {}
1356 test safe-12.7 {glob is restricted} -setup {
1357     set i [safe::interpCreate]
1358 } -body {
1359     $i eval glob *
1360 } -returnCodes error -cleanup {
1361     safe::interpDelete $i
1362 } -result {permission denied}
1363
1364 proc buildEnvironment {filename} {
1365     upvar 1 testdir testdir testdir2 testdir2 testfile testfile
1366     set testdir [makeDirectory deletethisdir]
1367     set testdir2 [makeDirectory deletemetoo $testdir]
1368     set testfile [makeFile {} $filename $testdir2]
1369 }
1370 proc buildEnvironment2 {filename} {
1371     upvar 1 testdir testdir testdir2 testdir2 testfile testfile
1372     upvar 1 testdir3 testdir3 testfile2 testfile2
1373     set testdir [makeDirectory deletethisdir]
1374     set testdir2 [makeDirectory deletemetoo $testdir]
1375     set testfile [makeFile {} $filename $testdir2]
1376     set testdir3 [makeDirectory deleteme $testdir]
1377     set testfile2 [makeFile {} $filename $testdir3]
1378 }
1379 #### New tests for Safe base glob, with patches @ Bug 2964715
1380 test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
1381     set i [safe::interpCreate]
1382 } -body {
1383     $i eval glob *
1384 } -returnCodes error -cleanup {
1385     safe::interpDelete $i
1386 } -result {permission denied}
1387 test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
1388     set i [safe::interpCreate]
1389     buildEnvironment deleteme.tm
1390 } -body {
1391     ::safe::interpAddToAccessPath $i $testdir2
1392     set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
1393     if {$result eq [list $testfile]} {
1394         return "glob match"
1395     } else {
1396         return "no match: $result"
1397     }
1398 } -cleanup {
1399     safe::interpDelete $i
1400     removeDirectory $testdir
1401 } -result {glob match}
1402 test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
1403     set i [safe::interpCreate]
1404     buildEnvironment deleteme.tm
1405 } -body {
1406     $i eval glob -directory $testdir2 *.tm
1407 } -returnCodes error -cleanup {
1408     safe::interpDelete $i
1409     removeDirectory $testdir
1410 } -result {permission denied}
1411 test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
1412     set i [safe::interpCreate]
1413     buildEnvironment deleteme.tm
1414 } -body {
1415     ::safe::interpAddToAccessPath $i $testdir
1416     ::safe::interpAddToAccessPath $i $testdir2
1417     set result [$i eval \
1418             glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
1419     if {$result eq [list $testfile]} {
1420         return "glob match"
1421     } else {
1422         return "no match: $result"
1423     }
1424 } -cleanup {
1425     safe::interpDelete $i
1426     removeDirectory $testdir
1427 } -result {glob match}
1428 test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
1429     set i [safe::interpCreate]
1430     buildEnvironment deleteme.tm
1431 } -body {
1432     ::safe::interpAddToAccessPath $i $testdir2
1433     $i eval \
1434         glob -directory $testdir [file join deletemetoo *.tm]
1435 } -returnCodes error -cleanup {
1436     safe::interpDelete $i
1437     removeDirectory $testdir
1438 } -result {permission denied}
1439 test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
1440     set i [safe::interpCreate]
1441     buildEnvironment deleteme.tm
1442 } -body {
1443     ::safe::interpAddToAccessPath $i $testdir
1444     $i eval \
1445         glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
1446 } -cleanup {
1447     safe::interpDelete $i
1448     removeDirectory $testdir
1449 } -result {}
1450 test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup {
1451     set i [safe::interpCreate]
1452     buildEnvironment pkgIndex.tcl
1453 } -body {
1454     set safeTD [::safe::interpAddToAccessPath $i $testdir]
1455     ::safe::interpAddToAccessPath $i $testdir2
1456     mapList [list $safeTD EXPECTED] [$i eval [list \
1457         glob -directory $safeTD -join * pkgIndex.tcl]]
1458 } -cleanup {
1459     safe::interpDelete $i
1460     removeDirectory $testdir
1461 } -result {EXPECTED/deletemetoo/pkgIndex.tcl}
1462 test safe-13.7.1 {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup {
1463     set i [safe::interpCreate]
1464     buildEnvironment2 pkgIndex.tcl
1465 } -body {
1466     set safeTD [::safe::interpAddToAccessPath $i $testdir]
1467     ::safe::interpAddToAccessPath $i $testdir2
1468     ::safe::interpAddToAccessPath $i $testdir3
1469     mapAndSortList [list $safeTD EXPECTED] [$i eval [list \
1470         glob -directory $safeTD -join * pkgIndex.tcl]]
1471 } -cleanup {
1472     safe::interpDelete $i
1473     removeDirectory $testdir
1474 } -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl}
1475 # See comments on lsort after test safe-9.20.
1476 test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
1477     set i [safe::interpCreate]
1478     buildEnvironment notIndex.tcl
1479 } -body {
1480     set safeTD [::safe::interpAddToAccessPath $i $testdir]
1481     ::safe::interpAddToAccessPath $i $testdir2
1482     $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
1483 } -cleanup {
1484     safe::interpDelete $i
1485     removeDirectory $testdir
1486 } -result {}
1487 test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
1488     set i [safe::interpCreate]
1489     buildEnvironment notIndex.tcl
1490 } -body {
1491     ::safe::interpAddToAccessPath $i $testdir2
1492     set result [$i eval \
1493             glob -directory $testdir -join -nocomplain * notIndex.tcl]
1494     if {$result eq [list $testfile]} {
1495         return {glob match}
1496     } else {
1497         return "no match: $result"
1498     }
1499 } -cleanup {
1500     safe::interpDelete $i
1501     removeDirectory $testdir
1502 } -result {no match: }
1503 test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
1504     set i [safe::interpCreate]
1505     buildEnvironment notIndex.tcl
1506 } -body {
1507     ::safe::interpAddToAccessPath $i $testdir
1508     $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
1509 } -cleanup {
1510     safe::interpDelete $i
1511     removeDirectory $testdir
1512 } -result {}
1513 rename buildEnvironment {}
1514 rename buildEnvironment2 {}
1515
1516 #### Test for the module path
1517 test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup {
1518     set i [safe::interpCreate]
1519 } -body {
1520     set tm {}
1521     foreach token [$i eval ::tcl::tm::path list] {
1522         lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
1523     }
1524     return $tm
1525 } -cleanup {
1526     safe::interpDelete $i
1527 } -result [::tcl::tm::path list]
1528
1529 test safe-15.1 {safe file ensemble does not surprise code} -setup {
1530     set i [interp create -safe]
1531 } -body {
1532     set result [expr {"file" in [interp hidden $i]}]
1533     lappend result [interp eval $i {tcl::file::split a/b/c}]
1534     lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
1535     lappend result [interp invokehidden $i file split a/b/c]
1536     lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
1537     lappend result [catch {interp invokehidden $i file isdirectory .}]
1538     interp expose $i file
1539     lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
1540     lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
1541 } -cleanup {
1542     unset -nocomplain msg
1543     interp delete $i
1544 } -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}}
1545 test safe-15.2 {safe file ensemble does not surprise code} -setup {
1546     set i [interp create -safe]
1547 } -body {
1548     set result [expr {"file" in [interp hidden $i]}]
1549     lappend result [interp eval $i {tcl::file::split a/b/c}]
1550     lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
1551     lappend result [interp invokehidden $i file split a/b/c]
1552     lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
1553     lappend result [catch {interp invokehidden $i file isdirectory .}]
1554     interp expose $i file
1555     lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
1556     lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo]
1557 } -cleanup {
1558     unset -nocomplain msg o
1559     interp delete $i
1560 } -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
1561     while executing
1562 "file isdirectory ."
1563     invoked from within
1564 "interp eval $i {file isdirectory .}"}}
1565
1566 ### ~ should have no special meaning in paths in safe interpreters
1567 test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
1568     set savedHOME $env(HOME)
1569     set env(HOME) /foo/bar
1570     set i [safe::interpCreate]
1571 } -body {
1572     $i eval {
1573         set d [format %c 126]
1574         list [file join [file dirname $d] [file tail $d]]
1575     }
1576 } -cleanup {
1577     safe::interpDelete $i
1578     set env(HOME) $savedHOME
1579     unset savedHOME
1580 } -result {./~}
1581 test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
1582     set i [safe::interpCreate]
1583     set user $tcl_platform(user)
1584 } -body {
1585     string map [list $user USER] [$i eval \
1586             "file join \[file dirname ~$user\] \[file tail ~$user\]"]
1587 } -cleanup {
1588     safe::interpDelete $i
1589     unset user
1590 } -result {./~USER}
1591 test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
1592     set syntheticHOME [makeDirectory foo]
1593     makeFile {} bar $syntheticHOME
1594     set savedHOME $env(HOME)
1595     set env(HOME) $syntheticHOME
1596     set i [safe::interpCreate]
1597 } -body {
1598     ::safe::interpAddToAccessPath $i $syntheticHOME
1599     $i eval {glob -nocomplain ~/*}
1600 } -cleanup {
1601     safe::interpDelete $i
1602     set env(HOME) $savedHOME
1603     removeDirectory $syntheticHOME
1604     unset savedHOME syntheticHOME
1605 } -result {}
1606 test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
1607     set i [safe::interpCreate]
1608 } -body {
1609     ::safe::interpAddToAccessPath $i $~$tcl_platform(user)
1610     $i eval [list glob -nocomplain ~$tcl_platform(user)/*]
1611 } -cleanup {
1612     safe::interpDelete $i
1613 } -result {}
1614 test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup {
1615     set savedHOME $env(HOME)
1616     set env(HOME) /foo/bar
1617     set i [safe::interpCreate]
1618 } -body {
1619     $i eval {
1620         set d [format %c 126]
1621         file join {$p(:0:)} $d
1622     }
1623 } -cleanup {
1624     safe::interpDelete $i
1625     set env(HOME) $savedHOME
1626     unset savedHOME
1627 } -result {~}
1628 test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup {
1629     set savedHOME $env(HOME)
1630     set env(HOME) /foo/bar
1631     set i [safe::interpCreate]
1632 } -body {
1633     $i eval {
1634         set d [format %c 126]
1635         file join {$p(:0:)/foo/bar} $d
1636     }
1637 } -cleanup {
1638     safe::interpDelete $i
1639     set env(HOME) $savedHOME
1640     unset savedHOME
1641 } -result {~}
1642 test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup {
1643     set i [safe::interpCreate]
1644     set user $tcl_platform(user)
1645 } -body {
1646     string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]]
1647 } -cleanup {
1648     safe::interpDelete $i
1649     unset user
1650 } -result {~USER}
1651 test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup {
1652     set i [safe::interpCreate]
1653     set user $tcl_platform(user)
1654 } -body {
1655     string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]]
1656 } -cleanup {
1657     safe::interpDelete $i
1658     unset user
1659 } -result {~USER}
1660 \f
1661 # cleanup
1662 set ::auto_path $SaveAutoPath
1663 unset SaveAutoPath TestsDir PathMapp
1664 unset -nocomplain path
1665 rename mapList {}
1666 rename mapAndSortList {}
1667 ::tcltest::cleanupTests
1668 return
1669
1670 # Local Variables:
1671 # mode: tcl
1672 # End: