diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-12-07 16:32:06 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-12-07 16:32:06 (GMT) |
commit | 47c3450e87baedd6fc319e0c3bc88e678f69a421 (patch) | |
tree | 20f9f770a15e075fbdfb3554c8131e2a660f79c8 /tests/safe.test | |
parent | 161037972186f1887c20f00bafdb708c3c87fdca (diff) | |
download | tcl-47c3450e87baedd6fc319e0c3bc88e678f69a421.zip tcl-47c3450e87baedd6fc319e0c3bc88e678f69a421.tar.gz tcl-47c3450e87baedd6fc319e0c3bc88e678f69a421.tar.bz2 |
* tests/fCmd.test, tests/safe.test, tests/uplevel.test,
* tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and
factor them to be easier to understand.
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 { |