diff options
Diffstat (limited to 'tests/safe.test')
| -rw-r--r-- | tests/safe.test | 40 |
1 files changed, 16 insertions, 24 deletions
diff --git a/tests/safe.test b/tests/safe.test index 14cd021..5025469 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.35 2010/11/02 21:42:28 stwo Exp $ +# RCS: @(#) $Id: safe.test,v 1.36 2010/12/07 16:32:06 dkf Exp $ package require Tcl 8.5 @@ -31,6 +31,11 @@ set ::auto_path [info library] catch {safe::interpConfigure} proc equiv {x} {return $x} + +# testing that nested and statics do what is advertised (we use a static +# package - Tcltest - but it might be absent if we're in standard tclsh) + +testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}] test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { safe::interpConfigure @@ -166,27 +171,24 @@ test safe-6.2 {test safe interpreters knowledge of the world} { SafeEval {info script} } {} test safe-6.3 {test safe interpreters knowledge of the world} { - set r [lsort [SafeEval {array names tcl_platform}]] + set r [SafeEval {array names tcl_platform}] # If running a windows-debug shell, remove the "debug" element from r. - if {[testConstraint win] && ("debug" in $r)} { - set r [lreplace $r 1 1] - } - set threaded [lsearch $r "threaded"] - if {$threaded != -1} { - set r [lreplace $r $threaded $threaded] + if {[testConstraint win]} { + set r [lsearch -all -inline -not -exact $r "debug"] } - set r + set r [lsearch -all -inline -not -exact $r "threaded"] + lsort $r } {byteOrder pathSeparator platform pointerSize wordSize} -# more test should be added to check that hostname, nameofexecutable, -# aren't leaking infos, but they still do... +# More test should be added to check that hostname, nameofexecutable, aren't +# leaking infos, but they still do... # high level general test test safe-7.1 {tests that everything works at high level} { set i [safe::interpCreate] # no error shall occur: - # (because the default access_path shall include 1st level sub dirs - # so package require in a slave works like in the master) + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) set v [interp eval $i {package require http 1}] # no error shall occur: interp eval $i {http_config} @@ -400,17 +402,7 @@ test safe-9.6 {interpConfigure widget like behaviour} -body { safe::interpConfigure $i] } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}} -# testing that nested and statics do what is advertised (we use a static -# package : Tcltest) -try { - package require Tcltest - testConstraint TcltestPackage 1 - # we use the Tcltest package , which has no Safe_Init -} on error {} { - testConstraint TcltestPackage 0 -} - -teststaticpkg Safepkg1 0 0 +catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { |