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