[25] | 1 | # safe.test -- |
---|
| 2 | # |
---|
| 3 | # This file contains a collection of tests for safe Tcl, packages loading, |
---|
| 4 | # and using safe interpreters. Sourcing this file into tcl runs the tests |
---|
| 5 | # and generates output for errors. No output means no errors were found. |
---|
| 6 | # |
---|
| 7 | # Copyright (c) 1995-1996 Sun Microsystems, Inc. |
---|
| 8 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
| 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and redistribution |
---|
| 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # |
---|
| 13 | # RCS: @(#) $Id: safe.test,v 1.22 2006/12/05 18:45:51 andreas_kupries Exp $ |
---|
| 14 | |
---|
| 15 | package require Tcl 8.5 |
---|
| 16 | |
---|
| 17 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 18 | package require tcltest |
---|
| 19 | namespace import -force ::tcltest::* |
---|
| 20 | } |
---|
| 21 | |
---|
| 22 | foreach i [interp slaves] { |
---|
| 23 | interp delete $i |
---|
| 24 | } |
---|
| 25 | |
---|
| 26 | set saveAutoPath $::auto_path |
---|
| 27 | set ::auto_path [info library] |
---|
| 28 | |
---|
| 29 | # Force actual loading of the safe package |
---|
| 30 | # because we use un exported (and thus un-autoindexed) APIs |
---|
| 31 | # in this test result arguments: |
---|
| 32 | catch {safe::interpConfigure} |
---|
| 33 | |
---|
| 34 | proc equiv {x} {return $x} |
---|
| 35 | |
---|
| 36 | test safe-1.1 {safe::interpConfigure syntax} { |
---|
| 37 | list [catch {safe::interpConfigure} msg] $msg; |
---|
| 38 | } {1 {no value given for parameter "slave" (use -help for full usage) : |
---|
| 39 | slave name () name of the slave}} |
---|
| 40 | test safe-1.2 {safe::interpCreate syntax} { |
---|
| 41 | list [catch {safe::interpCreate -help} msg] $msg; |
---|
| 42 | } {1 {Usage information: |
---|
| 43 | Var/FlagName Type Value Help |
---|
| 44 | ------------ ---- ----- ---- |
---|
| 45 | ( -help gives this help ) |
---|
| 46 | ?slave? name () name of the slave (optional) |
---|
| 47 | -accessPath list () access path for the slave |
---|
| 48 | -noStatics boolflag (false) prevent loading of statically linked pkgs |
---|
| 49 | -statics boolean (true) loading of statically linked pkgs |
---|
| 50 | -nestedLoadOk boolflag (false) allow nested loading |
---|
| 51 | -nested boolean (false) nested loading |
---|
| 52 | -deleteHook script () delete hook}} |
---|
| 53 | test safe-1.3 {safe::interpInit syntax} { |
---|
| 54 | list [catch {safe::interpInit -noStatics} msg] $msg; |
---|
| 55 | } {1 {bad value "-noStatics" for parameter |
---|
| 56 | slave name () name of the slave}} |
---|
| 57 | |
---|
| 58 | |
---|
| 59 | test safe-2.1 {creating interpreters, should have no aliases} emptyTest { |
---|
| 60 | # Disabled this test. It tests nothing sensible. [Bug 999612] |
---|
| 61 | # interp aliases |
---|
| 62 | } "" |
---|
| 63 | test safe-2.2 {creating interpreters, should have no aliases} { |
---|
| 64 | catch {safe::interpDelete a} |
---|
| 65 | interp create a |
---|
| 66 | set l [a aliases] |
---|
| 67 | safe::interpDelete a |
---|
| 68 | set l |
---|
| 69 | } "" |
---|
| 70 | test safe-2.3 {creating safe interpreters, should have no unexpected aliases} { |
---|
| 71 | catch {safe::interpDelete a} |
---|
| 72 | interp create a -safe |
---|
| 73 | set l [a aliases] |
---|
| 74 | interp delete a |
---|
| 75 | set l |
---|
| 76 | } {clock} |
---|
| 77 | |
---|
| 78 | test safe-3.1 {calling safe::interpInit is safe} { |
---|
| 79 | catch {safe::interpDelete a} |
---|
| 80 | interp create a -safe |
---|
| 81 | safe::interpInit a |
---|
| 82 | catch {interp eval a exec ls} msg |
---|
| 83 | safe::interpDelete a |
---|
| 84 | set msg |
---|
| 85 | } {invalid command name "exec"} |
---|
| 86 | test safe-3.2 {calling safe::interpCreate on trusted interp} { |
---|
| 87 | catch {safe::interpDelete a} |
---|
| 88 | safe::interpCreate a |
---|
| 89 | set l [lsort [a aliases]] |
---|
| 90 | safe::interpDelete a |
---|
| 91 | set l |
---|
| 92 | } {clock encoding exit file load source} |
---|
| 93 | test safe-3.3 {calling safe::interpCreate on trusted interp} { |
---|
| 94 | catch {safe::interpDelete a} |
---|
| 95 | safe::interpCreate a |
---|
| 96 | set x [interp eval a {source [file join $tcl_library init.tcl]}] |
---|
| 97 | safe::interpDelete a |
---|
| 98 | set x |
---|
| 99 | } "" |
---|
| 100 | test safe-3.4 {calling safe::interpCreate on trusted interp} { |
---|
| 101 | catch {safe::interpDelete a} |
---|
| 102 | safe::interpCreate a |
---|
| 103 | catch {set x \ |
---|
| 104 | [interp eval a {source [file join $tcl_library init.tcl]}]} msg |
---|
| 105 | safe::interpDelete a |
---|
| 106 | list $x $msg |
---|
| 107 | } {{} {}} |
---|
| 108 | |
---|
| 109 | test safe-4.1 {safe::interpDelete} { |
---|
| 110 | catch {safe::interpDelete a} |
---|
| 111 | interp create a |
---|
| 112 | safe::interpDelete a |
---|
| 113 | } "" |
---|
| 114 | test safe-4.2 {safe::interpDelete, indirectly} { |
---|
| 115 | catch {safe::interpDelete a} |
---|
| 116 | interp create a |
---|
| 117 | a alias exit safe::interpDelete a |
---|
| 118 | a eval exit |
---|
| 119 | } "" |
---|
| 120 | test safe-4.3 {safe::interpDelete, state array (not a public api)} { |
---|
| 121 | catch {safe::interpDelete a} |
---|
| 122 | namespace eval safe {set [InterpStateName a](foo) 33} |
---|
| 123 | # not an error anymore to call it if interp is already |
---|
| 124 | # deleted, to make trhings smooth if it's called twice... |
---|
| 125 | catch {safe::interpDelete a} m1 |
---|
| 126 | catch {namespace eval safe {set [InterpStateName a](foo)}} m2 |
---|
| 127 | list $m1 $m2 |
---|
| 128 | } "{}\ |
---|
| 129 | {can't read \"[safe::InterpStateName a](foo)\": no such variable}" |
---|
| 130 | test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} { |
---|
| 131 | catch {safe::interpDelete a} |
---|
| 132 | safe::interpCreate a |
---|
| 133 | namespace eval safe {set [InterpStateName a](foo) 33} |
---|
| 134 | a eval exit |
---|
| 135 | catch {namespace eval safe {set [InterpStateName a](foo)}} msg |
---|
| 136 | } 1 |
---|
| 137 | test safe-4.5 {safe::interpDelete} { |
---|
| 138 | catch {safe::interpDelete a} |
---|
| 139 | safe::interpCreate a |
---|
| 140 | catch {safe::interpCreate a} msg |
---|
| 141 | set msg |
---|
| 142 | } {interpreter named "a" already exists, cannot create} |
---|
| 143 | test safe-4.6 {safe::interpDelete, indirectly} { |
---|
| 144 | catch {safe::interpDelete a} |
---|
| 145 | safe::interpCreate a |
---|
| 146 | a eval exit |
---|
| 147 | } "" |
---|
| 148 | |
---|
| 149 | # The following test checks whether the definition of tcl_endOfWord can be |
---|
| 150 | # obtained from auto_loading. |
---|
| 151 | |
---|
| 152 | test safe-5.1 {test auto-loading in safe interpreters} { |
---|
| 153 | catch {safe::interpDelete a} |
---|
| 154 | safe::interpCreate a |
---|
| 155 | set r [catch {interp eval a {tcl_endOfWord "" 0}} msg] |
---|
| 156 | safe::interpDelete a |
---|
| 157 | list $r $msg |
---|
| 158 | } {0 -1} |
---|
| 159 | |
---|
| 160 | # test safe interps 'information leak' |
---|
| 161 | proc SafeEval {script} { |
---|
| 162 | # Helper procedure that ensures the safe interp is cleaned up even if |
---|
| 163 | # there is a failure in the script. |
---|
| 164 | set SafeInterp [interp create -safe] |
---|
| 165 | catch {$SafeInterp eval $script} msg opts |
---|
| 166 | interp delete $SafeInterp |
---|
| 167 | return -options $opts $msg |
---|
| 168 | } |
---|
| 169 | |
---|
| 170 | test safe-6.1 {test safe interpreters knowledge of the world} { |
---|
| 171 | lsort [SafeEval {info globals}] |
---|
| 172 | } {tcl_interactive tcl_patchLevel tcl_platform tcl_version} |
---|
| 173 | test safe-6.2 {test safe interpreters knowledge of the world} { |
---|
| 174 | SafeEval {info script} |
---|
| 175 | } {} |
---|
| 176 | test safe-6.3 {test safe interpreters knowledge of the world} { |
---|
| 177 | set r [lsort [SafeEval {array names tcl_platform}]] |
---|
| 178 | # If running a windows-debug shell, remove the "debug" element from r. |
---|
| 179 | if {[testConstraint win] && ("debug" in $r)} { |
---|
| 180 | set r [lreplace $r 1 1] |
---|
| 181 | } |
---|
| 182 | set threaded [lsearch $r "threaded"] |
---|
| 183 | if {$threaded != -1} { |
---|
| 184 | set r [lreplace $r $threaded $threaded] |
---|
| 185 | } |
---|
| 186 | set r |
---|
| 187 | } {byteOrder platform pointerSize wordSize} |
---|
| 188 | |
---|
| 189 | # more test should be added to check that hostname, nameofexecutable, |
---|
| 190 | # aren't leaking infos, but they still do... |
---|
| 191 | |
---|
| 192 | # high level general test |
---|
| 193 | test safe-7.1 {tests that everything works at high level} { |
---|
| 194 | set i [safe::interpCreate]; |
---|
| 195 | # no error shall occur: |
---|
| 196 | # (because the default access_path shall include 1st level sub dirs |
---|
| 197 | # so package require in a slave works like in the master) |
---|
| 198 | set v [interp eval $i {package require http 1}] |
---|
| 199 | # no error shall occur: |
---|
| 200 | interp eval $i {http_config}; |
---|
| 201 | safe::interpDelete $i |
---|
| 202 | set v |
---|
| 203 | } 1.0 |
---|
| 204 | test safe-7.2 {tests specific path and interpFind/AddToAccessPath} { |
---|
| 205 | set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]; |
---|
| 206 | # should not add anything (p0) |
---|
| 207 | set token1 [safe::interpAddToAccessPath $i [info library]] |
---|
| 208 | # should add as p1 |
---|
| 209 | set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]; |
---|
| 210 | # an error shall occur (http is not anymore in the secure 0-level |
---|
| 211 | # provided deep path) |
---|
| 212 | list $token1 $token2 \ |
---|
| 213 | [catch {interp eval $i {package require http 1}} msg] $msg \ |
---|
| 214 | [safe::interpConfigure $i]\ |
---|
| 215 | [safe::interpDelete $i] |
---|
| 216 | } "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" |
---|
| 217 | |
---|
| 218 | |
---|
| 219 | # test source control on file name |
---|
| 220 | test safe-8.1 {safe source control on file} { |
---|
| 221 | set i "a"; |
---|
| 222 | catch {safe::interpDelete $i} |
---|
| 223 | safe::interpCreate $i; |
---|
| 224 | list [catch {$i eval {source}} msg] \ |
---|
| 225 | $msg \ |
---|
| 226 | [safe::interpDelete $i] ; |
---|
| 227 | } {1 {wrong # args: should be "source fileName"} {}} |
---|
| 228 | test safe-8.2 {safe source control on file} { |
---|
| 229 | set i "a"; |
---|
| 230 | catch {safe::interpDelete $i} |
---|
| 231 | safe::interpCreate $i; |
---|
| 232 | list [catch {$i eval {source}} msg] \ |
---|
| 233 | $msg \ |
---|
| 234 | [safe::interpDelete $i] ; |
---|
| 235 | } {1 {wrong # args: should be "source fileName"} {}} |
---|
| 236 | test safe-8.3 {safe source control on file} { |
---|
| 237 | set i "a"; |
---|
| 238 | catch {safe::interpDelete $i} |
---|
| 239 | safe::interpCreate $i; |
---|
| 240 | set log {}; |
---|
| 241 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 242 | set prevlog [safe::setLogCmd]; |
---|
| 243 | safe::setLogCmd safe-test-log; |
---|
| 244 | list [catch {$i eval {source .}} msg] \ |
---|
| 245 | $msg \ |
---|
| 246 | $log \ |
---|
| 247 | [safe::setLogCmd $prevlog; unset log] \ |
---|
| 248 | [safe::interpDelete $i] ; |
---|
| 249 | } {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}} |
---|
| 250 | test safe-8.4 {safe source control on file} { |
---|
| 251 | set i "a"; |
---|
| 252 | catch {safe::interpDelete $i} |
---|
| 253 | safe::interpCreate $i; |
---|
| 254 | set log {}; |
---|
| 255 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 256 | set prevlog [safe::setLogCmd]; |
---|
| 257 | safe::setLogCmd safe-test-log; |
---|
| 258 | list [catch {$i eval {source /abc/def}} msg] \ |
---|
| 259 | $msg \ |
---|
| 260 | $log \ |
---|
| 261 | [safe::setLogCmd $prevlog; unset log] \ |
---|
| 262 | [safe::interpDelete $i] ; |
---|
| 263 | } {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}} |
---|
| 264 | test safe-8.5 {safe source control on file} { |
---|
| 265 | # This tested filename == *.tcl or tclIndex, but that restriction |
---|
| 266 | # was removed in 8.4a4 - hobbs |
---|
| 267 | set i "a"; |
---|
| 268 | catch {safe::interpDelete $i} |
---|
| 269 | safe::interpCreate $i; |
---|
| 270 | set log {}; |
---|
| 271 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 272 | set prevlog [safe::setLogCmd]; |
---|
| 273 | safe::setLogCmd safe-test-log; |
---|
| 274 | list [catch {$i eval {source [file join [info lib] blah]}} msg] \ |
---|
| 275 | $msg \ |
---|
| 276 | $log \ |
---|
| 277 | [safe::setLogCmd $prevlog; unset log] \ |
---|
| 278 | [safe::interpDelete $i] ; |
---|
| 279 | } [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}] |
---|
| 280 | test safe-8.6 {safe source control on file} { |
---|
| 281 | set i "a"; |
---|
| 282 | catch {safe::interpDelete $i} |
---|
| 283 | safe::interpCreate $i; |
---|
| 284 | set log {}; |
---|
| 285 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 286 | set prevlog [safe::setLogCmd]; |
---|
| 287 | safe::setLogCmd safe-test-log; |
---|
| 288 | list [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \ |
---|
| 289 | $msg \ |
---|
| 290 | $log \ |
---|
| 291 | [safe::setLogCmd $prevlog; unset log] \ |
---|
| 292 | [safe::interpDelete $i] ; |
---|
| 293 | } [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}] |
---|
| 294 | test safe-8.7 {safe source control on file} { |
---|
| 295 | # This tested length of filename, but that restriction |
---|
| 296 | # was removed in 8.4a4 - hobbs |
---|
| 297 | set i "a"; |
---|
| 298 | catch {safe::interpDelete $i} |
---|
| 299 | safe::interpCreate $i; |
---|
| 300 | set log {}; |
---|
| 301 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 302 | set prevlog [safe::setLogCmd]; |
---|
| 303 | safe::setLogCmd safe-test-log; |
---|
| 304 | list [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\ |
---|
| 305 | msg] \ |
---|
| 306 | $msg \ |
---|
| 307 | $log \ |
---|
| 308 | [safe::setLogCmd $prevlog; unset log] \ |
---|
| 309 | [safe::interpDelete $i] ; |
---|
| 310 | } [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}] |
---|
| 311 | test safe-8.8 {safe source forbids -rsrc} { |
---|
| 312 | set i "a"; |
---|
| 313 | catch {safe::interpDelete $i} |
---|
| 314 | safe::interpCreate $i; |
---|
| 315 | list [catch {$i eval {source -rsrc Init}} msg] \ |
---|
| 316 | $msg \ |
---|
| 317 | [safe::interpDelete $i] ; |
---|
| 318 | } {1 {wrong # args: should be "source fileName"} {}} |
---|
| 319 | |
---|
| 320 | test safe-9.1 {safe interps' deleteHook} { |
---|
| 321 | set i "a"; |
---|
| 322 | catch {safe::interpDelete $i} |
---|
| 323 | set res {} |
---|
| 324 | proc testDelHook {args} { |
---|
| 325 | global res; |
---|
| 326 | # the interp still exists at that point |
---|
| 327 | interp eval a {set delete 1} |
---|
| 328 | # mark that we've been here (successfully) |
---|
| 329 | set res $args; |
---|
| 330 | } |
---|
| 331 | safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"; |
---|
| 332 | list [interp eval $i exit] $res |
---|
| 333 | } {{} {arg1 arg2 a}} |
---|
| 334 | test safe-9.2 {safe interps' error in deleteHook} { |
---|
| 335 | set i "a"; |
---|
| 336 | catch {safe::interpDelete $i} |
---|
| 337 | set res {} |
---|
| 338 | proc testDelHook {args} { |
---|
| 339 | global res; |
---|
| 340 | # the interp still exists at that point |
---|
| 341 | interp eval a {set delete 1} |
---|
| 342 | # mark that we've been here (successfully) |
---|
| 343 | set res $args; |
---|
| 344 | # create an exception |
---|
| 345 | error "being catched"; |
---|
| 346 | } |
---|
| 347 | set log {}; |
---|
| 348 | proc safe-test-log {str} {global log; lappend log $str} |
---|
| 349 | safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"; |
---|
| 350 | set prevlog [safe::setLogCmd]; |
---|
| 351 | safe::setLogCmd safe-test-log; |
---|
| 352 | list [safe::interpDelete $i] $res \ |
---|
| 353 | $log \ |
---|
| 354 | [safe::setLogCmd $prevlog; unset log]; |
---|
| 355 | } {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}} |
---|
| 356 | test safe-9.3 {dual specification of statics} { |
---|
| 357 | list [catch {safe::interpCreate -stat true -nostat} msg] $msg |
---|
| 358 | } {1 {conflicting values given for -statics and -noStatics}} |
---|
| 359 | test safe-9.4 {dual specification of statics} { |
---|
| 360 | # no error shall occur |
---|
| 361 | safe::interpDelete [safe::interpCreate -stat false -nostat] |
---|
| 362 | } {} |
---|
| 363 | test safe-9.5 {dual specification of nested} { |
---|
| 364 | list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg |
---|
| 365 | } {1 {conflicting values given for -nested and -nestedLoadOk}} |
---|
| 366 | |
---|
| 367 | test safe-9.6 {interpConfigure widget like behaviour} { |
---|
| 368 | # this test shall work, don't try to "fix it" unless |
---|
| 369 | # you *really* know what you are doing (ie you are me :p) -- dl |
---|
| 370 | list [set i [safe::interpCreate \ |
---|
| 371 | -noStatics \ |
---|
| 372 | -nestedLoadOk \ |
---|
| 373 | -deleteHook {foo bar}]; |
---|
| 374 | safe::interpConfigure $i -accessPath /foo/bar ; |
---|
| 375 | safe::interpConfigure $i]\ |
---|
| 376 | [safe::interpConfigure $i -aCCess]\ |
---|
| 377 | [safe::interpConfigure $i -nested]\ |
---|
| 378 | [safe::interpConfigure $i -statics]\ |
---|
| 379 | [safe::interpConfigure $i -DEL]\ |
---|
| 380 | [safe::interpConfigure $i -accessPath /blah -statics 1; |
---|
| 381 | safe::interpConfigure $i]\ |
---|
| 382 | [safe::interpConfigure $i -deleteHook toto -nosta -nested 0; |
---|
| 383 | safe::interpConfigure $i] |
---|
| 384 | } {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}} |
---|
| 385 | |
---|
| 386 | # testing that nested and statics do what is advertised |
---|
| 387 | # (we use a static package : Tcltest) |
---|
| 388 | |
---|
| 389 | if {[catch {package require Tcltest} msg]} { |
---|
| 390 | testConstraint TcltestPackage 0 |
---|
| 391 | } else { |
---|
| 392 | testConstraint TcltestPackage 1 |
---|
| 393 | # we use the Tcltest package , which has no Safe_Init |
---|
| 394 | } |
---|
| 395 | |
---|
| 396 | test safe-10.1 {testing statics loading} TcltestPackage { |
---|
| 397 | set i [safe::interpCreate] |
---|
| 398 | list \ |
---|
| 399 | [catch {interp eval $i {load {} Tcltest}} msg] \ |
---|
| 400 | $msg \ |
---|
| 401 | [safe::interpDelete $i]; |
---|
| 402 | } {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}} |
---|
| 403 | test safe-10.2 {testing statics loading / -nostatics} TcltestPackage { |
---|
| 404 | set i [safe::interpCreate -nostatics] |
---|
| 405 | list \ |
---|
| 406 | [catch {interp eval $i {load {} Tcltest}} msg] \ |
---|
| 407 | $msg \ |
---|
| 408 | [safe::interpDelete $i]; |
---|
| 409 | } {1 {permission denied (static package)} {}} |
---|
| 410 | test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage { |
---|
| 411 | set i [safe::interpCreate] |
---|
| 412 | list \ |
---|
| 413 | [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \ |
---|
| 414 | $msg \ |
---|
| 415 | [safe::interpDelete $i]; |
---|
| 416 | } {1 {permission denied (nested load)} {}} |
---|
| 417 | test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage { |
---|
| 418 | set i [safe::interpCreate -nestedloadok] |
---|
| 419 | list \ |
---|
| 420 | [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \ |
---|
| 421 | $msg \ |
---|
| 422 | [safe::interpDelete $i]; |
---|
| 423 | } {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}} |
---|
| 424 | |
---|
| 425 | test safe-11.1 {testing safe encoding} { |
---|
| 426 | set i [safe::interpCreate] |
---|
| 427 | list \ |
---|
| 428 | [catch {interp eval $i encoding} msg] \ |
---|
| 429 | $msg \ |
---|
| 430 | [safe::interpDelete $i]; |
---|
| 431 | } {1 {wrong # args: should be "encoding option ?arg ...?"} {}} |
---|
| 432 | test safe-11.2 {testing safe encoding} { |
---|
| 433 | set i [safe::interpCreate] |
---|
| 434 | list \ |
---|
| 435 | [catch {interp eval $i encoding system cp775} msg] \ |
---|
| 436 | $msg \ |
---|
| 437 | [safe::interpDelete $i]; |
---|
| 438 | } {1 {wrong # args: should be "encoding system"} {}} |
---|
| 439 | test safe-11.3 {testing safe encoding} { |
---|
| 440 | set i [safe::interpCreate] |
---|
| 441 | set result [catch { |
---|
| 442 | string match [encoding system] [interp eval $i encoding system] |
---|
| 443 | } msg] |
---|
| 444 | list $result $msg [safe::interpDelete $i] |
---|
| 445 | } {0 1 {}} |
---|
| 446 | test safe-11.4 {testing safe encoding} { |
---|
| 447 | set i [safe::interpCreate] |
---|
| 448 | set result [catch { |
---|
| 449 | string match [encoding names] [interp eval $i encoding names] |
---|
| 450 | } msg] |
---|
| 451 | list $result $msg [safe::interpDelete $i] |
---|
| 452 | } {0 1 {}} |
---|
| 453 | test safe-11.5 {testing safe encoding} { |
---|
| 454 | set i [safe::interpCreate] |
---|
| 455 | list \ |
---|
| 456 | [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \ |
---|
| 457 | $msg \ |
---|
| 458 | [safe::interpDelete $i]; |
---|
| 459 | } {0 foobar {}} |
---|
| 460 | test safe-11.6 {testing safe encoding} { |
---|
| 461 | set i [safe::interpCreate] |
---|
| 462 | list \ |
---|
| 463 | [catch {interp eval $i encoding convertto cp1258 foobar} msg] \ |
---|
| 464 | $msg \ |
---|
| 465 | [safe::interpDelete $i]; |
---|
| 466 | } {0 foobar {}} |
---|
| 467 | test safe-11.7 {testing safe encoding} { |
---|
| 468 | set i [safe::interpCreate] |
---|
| 469 | list \ |
---|
| 470 | [catch {interp eval $i encoding convertfrom} msg] \ |
---|
| 471 | $msg \ |
---|
| 472 | [safe::interpDelete $i]; |
---|
| 473 | } {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}} |
---|
| 474 | test safe-11.8 {testing safe encoding} { |
---|
| 475 | set i [safe::interpCreate] |
---|
| 476 | list \ |
---|
| 477 | [catch {interp eval $i encoding convertto} msg] \ |
---|
| 478 | $msg \ |
---|
| 479 | [safe::interpDelete $i]; |
---|
| 480 | } {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}} |
---|
| 481 | |
---|
| 482 | |
---|
| 483 | set ::auto_path $saveAutoPath |
---|
| 484 | # cleanup |
---|
| 485 | ::tcltest::cleanupTests |
---|
| 486 | return |
---|