os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/safe.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/safe.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,536 @@
1.4 +# safe.test --
1.5 +#
1.6 +# This file contains a collection of tests for safe Tcl, packages loading,
1.7 +# and using safe interpreters. Sourcing this file into tcl runs the tests
1.8 +# and generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1995-1996 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: safe.test,v 1.13.2.3 2006/11/28 22:20:03 andreas_kupries Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +foreach i [interp slaves] {
1.24 + interp delete $i
1.25 +}
1.26 +
1.27 +set saveAutoPath $::auto_path
1.28 +set ::auto_path [info library]
1.29 +
1.30 +# Force actual loading of the safe package
1.31 +# because we use un exported (and thus un-autoindexed) APIs
1.32 +# in this test result arguments:
1.33 +catch {safe::interpConfigure}
1.34 +
1.35 +proc equiv {x} {return $x}
1.36 +
1.37 +test safe-1.1 {safe::interpConfigure syntax} {
1.38 + list [catch {safe::interpConfigure} msg] $msg;
1.39 +} {1 {no value given for parameter "slave" (use -help for full usage) :
1.40 + slave name () name of the slave}}
1.41 +
1.42 +test safe-1.2 {safe::interpCreate syntax} {
1.43 + list [catch {safe::interpCreate -help} msg] $msg;
1.44 +} {1 {Usage information:
1.45 + Var/FlagName Type Value Help
1.46 + ------------ ---- ----- ----
1.47 + ( -help gives this help )
1.48 + ?slave? name () name of the slave (optional)
1.49 + -accessPath list () access path for the slave
1.50 + -noStatics boolflag (false) prevent loading of statically linked pkgs
1.51 + -statics boolean (true) loading of statically linked pkgs
1.52 + -nestedLoadOk boolflag (false) allow nested loading
1.53 + -nested boolean (false) nested loading
1.54 + -deleteHook script () delete hook}}
1.55 +
1.56 +test safe-1.3 {safe::interpInit syntax} {
1.57 + list [catch {safe::interpInit -noStatics} msg] $msg;
1.58 +} {1 {bad value "-noStatics" for parameter
1.59 + slave name () name of the slave}}
1.60 +
1.61 +
1.62 +test safe-2.1 {creating interpreters, should have no aliases} {
1.63 + interp aliases
1.64 +} ""
1.65 +test safe-2.2 {creating interpreters, should have no aliases} {
1.66 + catch {safe::interpDelete a}
1.67 + interp create a
1.68 + set l [a aliases]
1.69 + safe::interpDelete a
1.70 + set l
1.71 +} ""
1.72 +test safe-2.3 {creating safe interpreters, should have no aliases} {
1.73 + catch {safe::interpDelete a}
1.74 + interp create a -safe
1.75 + set l [a aliases]
1.76 + interp delete a
1.77 + set l
1.78 +} ""
1.79 +
1.80 +test safe-3.1 {calling safe::interpInit is safe} {
1.81 + catch {safe::interpDelete a}
1.82 + interp create a -safe
1.83 + safe::interpInit a
1.84 + catch {interp eval a exec ls} msg
1.85 + safe::interpDelete a
1.86 + set msg
1.87 +} {invalid command name "exec"}
1.88 +test safe-3.2 {calling safe::interpCreate on trusted interp} {
1.89 + catch {safe::interpDelete a}
1.90 + safe::interpCreate a
1.91 + set l [lsort [a aliases]]
1.92 + safe::interpDelete a
1.93 + set l
1.94 +} {encoding exit file load source}
1.95 +test safe-3.3 {calling safe::interpCreate on trusted interp} {
1.96 + catch {safe::interpDelete a}
1.97 + safe::interpCreate a
1.98 + set x [interp eval a {source [file join $tcl_library init.tcl]}]
1.99 + safe::interpDelete a
1.100 + set x
1.101 +} ""
1.102 +test safe-3.4 {calling safe::interpCreate on trusted interp} {
1.103 + catch {safe::interpDelete a}
1.104 + safe::interpCreate a
1.105 + catch {set x \
1.106 + [interp eval a {source [file join $tcl_library init.tcl]}]} msg
1.107 + safe::interpDelete a
1.108 + list $x $msg
1.109 +} {{} {}}
1.110 +
1.111 +test safe-4.1 {safe::interpDelete} {
1.112 + catch {safe::interpDelete a}
1.113 + interp create a
1.114 + safe::interpDelete a
1.115 +} ""
1.116 +test safe-4.2 {safe::interpDelete, indirectly} {
1.117 + catch {safe::interpDelete a}
1.118 + interp create a
1.119 + a alias exit safe::interpDelete a
1.120 + a eval exit
1.121 +} ""
1.122 +test safe-4.3 {safe::interpDelete, state array (not a public api)} {
1.123 + catch {safe::interpDelete a}
1.124 + namespace eval safe {set [InterpStateName a](foo) 33}
1.125 + # not an error anymore to call it if interp is already
1.126 + # deleted, to make trhings smooth if it's called twice...
1.127 + catch {safe::interpDelete a} m1
1.128 + catch {namespace eval safe {set [InterpStateName a](foo)}} m2
1.129 + list $m1 $m2
1.130 +} "{}\
1.131 + {can't read \"[safe::InterpStateName a](foo)\": no such variable}"
1.132 +
1.133 +
1.134 +test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
1.135 + catch {safe::interpDelete a}
1.136 + safe::interpCreate a
1.137 + namespace eval safe {set [InterpStateName a](foo) 33}
1.138 + a eval exit
1.139 + catch {namespace eval safe {set [InterpStateName a](foo)}} msg
1.140 +} 1
1.141 +
1.142 +test safe-4.5 {safe::interpDelete} {
1.143 + catch {safe::interpDelete a}
1.144 + safe::interpCreate a
1.145 + catch {safe::interpCreate a} msg
1.146 + set msg
1.147 +} {interpreter named "a" already exists, cannot create}
1.148 +test safe-4.6 {safe::interpDelete, indirectly} {
1.149 + catch {safe::interpDelete a}
1.150 + safe::interpCreate a
1.151 + a eval exit
1.152 +} ""
1.153 +
1.154 +# The following test checks whether the definition of tcl_endOfWord can be
1.155 +# obtained from auto_loading.
1.156 +
1.157 +test safe-5.1 {test auto-loading in safe interpreters} {
1.158 + catch {safe::interpDelete a}
1.159 + safe::interpCreate a
1.160 + set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
1.161 + safe::interpDelete a
1.162 + list $r $msg
1.163 +} {0 -1}
1.164 +
1.165 +# test safe interps 'information leak'
1.166 +proc SI {} {
1.167 + global I
1.168 + set I [interp create -safe];
1.169 +}
1.170 +proc DI {} {
1.171 + global I;
1.172 + interp delete $I;
1.173 +}
1.174 +test safe-6.1 {test safe interpreters knowledge of the world} {
1.175 + SI; set r [lsort [$I eval {info globals}]]; DI; set r
1.176 +} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
1.177 +test safe-6.2 {test safe interpreters knowledge of the world} {
1.178 + SI; set r [$I eval {info script}]; DI; set r
1.179 +} {}
1.180 +test safe-6.3 {test safe interpreters knowledge of the world} {
1.181 + SI
1.182 + set r [lsort [$I eval {array names tcl_platform}]]
1.183 + DI
1.184 + # If running a windows-debug shell, remove the "debug" element from r.
1.185 + if {$tcl_platform(platform) == "windows" && \
1.186 + [lsearch $r "debug"] != -1} {
1.187 + set r [lreplace $r 1 1]
1.188 + }
1.189 + set threaded [lsearch $r "threaded"]
1.190 + if {$threaded != -1} {
1.191 + set r [lreplace $r $threaded $threaded]
1.192 + }
1.193 + set tip [lsearch $r "tip,268"]
1.194 + if {$tip != -1} {
1.195 + set r [lreplace $r $tip $tip]
1.196 + }
1.197 + set tip [lsearch $r "tip,280"]
1.198 + if {$tip != -1} {
1.199 + set r [lreplace $r $tip $tip]
1.200 + }
1.201 + set r
1.202 +} {byteOrder platform wordSize}
1.203 +
1.204 +# more test should be added to check that hostname, nameofexecutable,
1.205 +# aren't leaking infos, but they still do...
1.206 +
1.207 +# high level general test
1.208 +test safe-7.1 {tests that everything works at high level} {
1.209 + set i [safe::interpCreate];
1.210 + # no error shall occur:
1.211 + # (because the default access_path shall include 1st level sub dirs
1.212 + # so package require in a slave works like in the master)
1.213 + set v [interp eval $i {package require http 1}]
1.214 + # no error shall occur:
1.215 + interp eval $i {http_config};
1.216 + safe::interpDelete $i
1.217 + set v
1.218 +} 1.0
1.219 +
1.220 +test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
1.221 + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
1.222 + # should not add anything (p0)
1.223 + set token1 [safe::interpAddToAccessPath $i [info library]]
1.224 + # should add as p1
1.225 + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
1.226 + # an error shall occur (http is not anymore in the secure 0-level
1.227 + # provided deep path)
1.228 + list $token1 $token2 \
1.229 + [catch {interp eval $i {package require http 1}} msg] $msg \
1.230 + [safe::interpConfigure $i]\
1.231 + [safe::interpDelete $i]
1.232 +} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
1.233 +
1.234 +
1.235 +# test source control on file name
1.236 +test safe-8.1 {safe source control on file} {
1.237 + set i "a";
1.238 + catch {safe::interpDelete $i}
1.239 + safe::interpCreate $i;
1.240 + list [catch {$i eval {source}} msg] \
1.241 + $msg \
1.242 + [safe::interpDelete $i] ;
1.243 +} {1 {wrong # args: should be "source fileName"} {}}
1.244 +
1.245 +# test source control on file name
1.246 +test safe-8.2 {safe source control on file} {
1.247 + set i "a";
1.248 + catch {safe::interpDelete $i}
1.249 + safe::interpCreate $i;
1.250 + list [catch {$i eval {source}} msg] \
1.251 + $msg \
1.252 + [safe::interpDelete $i] ;
1.253 +} {1 {wrong # args: should be "source fileName"} {}}
1.254 +
1.255 +test safe-8.3 {safe source control on file} {
1.256 + set i "a";
1.257 + catch {safe::interpDelete $i}
1.258 + safe::interpCreate $i;
1.259 + set log {};
1.260 + proc safe-test-log {str} {global log; lappend log $str}
1.261 + set prevlog [safe::setLogCmd];
1.262 + safe::setLogCmd safe-test-log;
1.263 + list [catch {$i eval {source .}} msg] \
1.264 + $msg \
1.265 + $log \
1.266 + [safe::setLogCmd $prevlog; unset log] \
1.267 + [safe::interpDelete $i] ;
1.268 +} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
1.269 +
1.270 +
1.271 +test safe-8.4 {safe source control on file} {
1.272 + set i "a";
1.273 + catch {safe::interpDelete $i}
1.274 + safe::interpCreate $i;
1.275 + set log {};
1.276 + proc safe-test-log {str} {global log; lappend log $str}
1.277 + set prevlog [safe::setLogCmd];
1.278 + safe::setLogCmd safe-test-log;
1.279 + list [catch {$i eval {source /abc/def}} msg] \
1.280 + $msg \
1.281 + $log \
1.282 + [safe::setLogCmd $prevlog; unset log] \
1.283 + [safe::interpDelete $i] ;
1.284 +} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
1.285 +
1.286 +
1.287 +test safe-8.5 {safe source control on file} {
1.288 + # This tested filename == *.tcl or tclIndex, but that restriction
1.289 + # was removed in 8.4a4 - hobbs
1.290 + set i "a";
1.291 + catch {safe::interpDelete $i}
1.292 + safe::interpCreate $i;
1.293 + set log {};
1.294 + proc safe-test-log {str} {global log; lappend log $str}
1.295 + set prevlog [safe::setLogCmd];
1.296 + safe::setLogCmd safe-test-log;
1.297 + list [catch {$i eval {source [file join [info lib] blah]}} msg] \
1.298 + $msg \
1.299 + $log \
1.300 + [safe::setLogCmd $prevlog; unset log] \
1.301 + [safe::interpDelete $i] ;
1.302 +} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
1.303 +
1.304 +
1.305 +test safe-8.6 {safe source control on file} {
1.306 + set i "a";
1.307 + catch {safe::interpDelete $i}
1.308 + safe::interpCreate $i;
1.309 + set log {};
1.310 + proc safe-test-log {str} {global log; lappend log $str}
1.311 + set prevlog [safe::setLogCmd];
1.312 + safe::setLogCmd safe-test-log;
1.313 + list [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \
1.314 + $msg \
1.315 + $log \
1.316 + [safe::setLogCmd $prevlog; unset log] \
1.317 + [safe::interpDelete $i] ;
1.318 +} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
1.319 +
1.320 +
1.321 +test safe-8.7 {safe source control on file} {
1.322 + # This tested length of filename, but that restriction
1.323 + # was removed in 8.4a4 - hobbs
1.324 + set i "a";
1.325 + catch {safe::interpDelete $i}
1.326 + safe::interpCreate $i;
1.327 + set log {};
1.328 + proc safe-test-log {str} {global log; lappend log $str}
1.329 + set prevlog [safe::setLogCmd];
1.330 + safe::setLogCmd safe-test-log;
1.331 + list [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\
1.332 + msg] \
1.333 + $msg \
1.334 + $log \
1.335 + [safe::setLogCmd $prevlog; unset log] \
1.336 + [safe::interpDelete $i] ;
1.337 +} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
1.338 +
1.339 +test safe-8.8 {safe source forbids -rsrc} {
1.340 + set i "a";
1.341 + catch {safe::interpDelete $i}
1.342 + safe::interpCreate $i;
1.343 + list [catch {$i eval {source -rsrc Init}} msg] \
1.344 + $msg \
1.345 + [safe::interpDelete $i] ;
1.346 +} {1 {wrong # args: should be "source fileName"} {}}
1.347 +
1.348 +
1.349 +test safe-9.1 {safe interps' deleteHook} {
1.350 + set i "a";
1.351 + catch {safe::interpDelete $i}
1.352 + set res {}
1.353 + proc testDelHook {args} {
1.354 + global res;
1.355 + # the interp still exists at that point
1.356 + interp eval a {set delete 1}
1.357 + # mark that we've been here (successfully)
1.358 + set res $args;
1.359 + }
1.360 + safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
1.361 + list [interp eval $i exit] $res
1.362 +} {{} {arg1 arg2 a}}
1.363 +
1.364 +test safe-9.2 {safe interps' error in deleteHook} {
1.365 + set i "a";
1.366 + catch {safe::interpDelete $i}
1.367 + set res {}
1.368 + proc testDelHook {args} {
1.369 + global res;
1.370 + # the interp still exists at that point
1.371 + interp eval a {set delete 1}
1.372 + # mark that we've been here (successfully)
1.373 + set res $args;
1.374 + # create an exception
1.375 + error "being catched";
1.376 + }
1.377 + set log {};
1.378 + proc safe-test-log {str} {global log; lappend log $str}
1.379 + safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
1.380 + set prevlog [safe::setLogCmd];
1.381 + safe::setLogCmd safe-test-log;
1.382 + list [safe::interpDelete $i] $res \
1.383 + $log \
1.384 + [safe::setLogCmd $prevlog; unset log];
1.385 +} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
1.386 +
1.387 +
1.388 +test safe-9.3 {dual specification of statics} {
1.389 + list [catch {safe::interpCreate -stat true -nostat} msg] $msg
1.390 +} {1 {conflicting values given for -statics and -noStatics}}
1.391 +
1.392 +test safe-9.4 {dual specification of statics} {
1.393 + # no error shall occur
1.394 + safe::interpDelete [safe::interpCreate -stat false -nostat]
1.395 +} {}
1.396 +
1.397 +test safe-9.5 {dual specification of nested} {
1.398 + list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
1.399 +} {1 {conflicting values given for -nested and -nestedLoadOk}}
1.400 +
1.401 +test safe-9.6 {interpConfigure widget like behaviour} {
1.402 + # this test shall work, don't try to "fix it" unless
1.403 + # you *really* know what you are doing (ie you are me :p) -- dl
1.404 + list [set i [safe::interpCreate \
1.405 + -noStatics \
1.406 + -nestedLoadOk \
1.407 + -deleteHook {foo bar}];
1.408 + safe::interpConfigure $i -accessPath /foo/bar ;
1.409 + safe::interpConfigure $i]\
1.410 + [safe::interpConfigure $i -aCCess]\
1.411 + [safe::interpConfigure $i -nested]\
1.412 + [safe::interpConfigure $i -statics]\
1.413 + [safe::interpConfigure $i -DEL]\
1.414 + [safe::interpConfigure $i -accessPath /blah -statics 1;
1.415 + safe::interpConfigure $i]\
1.416 + [safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
1.417 + safe::interpConfigure $i]
1.418 +} {{-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}}
1.419 +
1.420 +
1.421 +# testing that nested and statics do what is advertised
1.422 +# (we use a static package : Tcltest)
1.423 +
1.424 +if {[catch {package require Tcltest} msg]} {
1.425 + puts "This application hasn't been compiled with Tcltest"
1.426 + puts "skipping remining safe test that relies on it."
1.427 +} else {
1.428 +
1.429 + # we use the Tcltest package , which has no Safe_Init
1.430 +
1.431 +test safe-10.1 {testing statics loading} {
1.432 + set i [safe::interpCreate]
1.433 + list \
1.434 + [catch {interp eval $i {load {} Tcltest}} msg] \
1.435 + $msg \
1.436 + [safe::interpDelete $i];
1.437 +} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
1.438 +
1.439 +test safe-10.2 {testing statics loading / -nostatics} {
1.440 + set i [safe::interpCreate -nostatics]
1.441 + list \
1.442 + [catch {interp eval $i {load {} Tcltest}} msg] \
1.443 + $msg \
1.444 + [safe::interpDelete $i];
1.445 +} {1 {permission denied (static package)} {}}
1.446 +
1.447 +
1.448 +
1.449 +test safe-10.3 {testing nested statics loading / no nested by default} {
1.450 + set i [safe::interpCreate]
1.451 + list \
1.452 + [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
1.453 + $msg \
1.454 + [safe::interpDelete $i];
1.455 +} {1 {permission denied (nested load)} {}}
1.456 +
1.457 +
1.458 +test safe-10.4 {testing nested statics loading / -nestedloadok} {
1.459 + set i [safe::interpCreate -nestedloadok]
1.460 + list \
1.461 + [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
1.462 + $msg \
1.463 + [safe::interpDelete $i];
1.464 +} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
1.465 +
1.466 +
1.467 +}
1.468 +
1.469 +test safe-11.1 {testing safe encoding} {
1.470 + set i [safe::interpCreate]
1.471 + list \
1.472 + [catch {interp eval $i encoding} msg] \
1.473 + $msg \
1.474 + [safe::interpDelete $i];
1.475 +} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
1.476 +
1.477 +test safe-11.2 {testing safe encoding} {
1.478 + set i [safe::interpCreate]
1.479 + list \
1.480 + [catch {interp eval $i encoding system cp775} msg] \
1.481 + $msg \
1.482 + [safe::interpDelete $i];
1.483 +} {1 {wrong # args: should be "encoding system"} {}}
1.484 +
1.485 +test safe-11.3 {testing safe encoding} {
1.486 + set i [safe::interpCreate]
1.487 + set result [catch {
1.488 + string match [encoding system] [interp eval $i encoding system]
1.489 + } msg]
1.490 + list $result $msg [safe::interpDelete $i]
1.491 +} {0 1 {}}
1.492 +
1.493 +test safe-11.4 {testing safe encoding} {
1.494 + set i [safe::interpCreate]
1.495 + set result [catch {
1.496 + string match [encoding names] [interp eval $i encoding names]
1.497 + } msg]
1.498 + list $result $msg [safe::interpDelete $i]
1.499 +} {0 1 {}}
1.500 +
1.501 +test safe-11.5 {testing safe encoding} {
1.502 + set i [safe::interpCreate]
1.503 + list \
1.504 + [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
1.505 + $msg \
1.506 + [safe::interpDelete $i];
1.507 +} {0 foobar {}}
1.508 +
1.509 +
1.510 +test safe-11.6 {testing safe encoding} {
1.511 + set i [safe::interpCreate]
1.512 + list \
1.513 + [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
1.514 + $msg \
1.515 + [safe::interpDelete $i];
1.516 +} {0 foobar {}}
1.517 +
1.518 +test safe-11.7 {testing safe encoding} {
1.519 + set i [safe::interpCreate]
1.520 + list \
1.521 + [catch {interp eval $i encoding convertfrom} msg] \
1.522 + $msg \
1.523 + [safe::interpDelete $i];
1.524 +} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
1.525 +
1.526 +
1.527 +test safe-11.8 {testing safe encoding} {
1.528 + set i [safe::interpCreate]
1.529 + list \
1.530 + [catch {interp eval $i encoding convertto} msg] \
1.531 + $msg \
1.532 + [safe::interpDelete $i];
1.533 +} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
1.534 +
1.535 +
1.536 +set ::auto_path $saveAutoPath
1.537 +# cleanup
1.538 +::tcltest::cleanupTests
1.539 +return