Update to tcltest2

1 files changed, 89 insertions, 64 deletions

diff --git a/tests/safe.test b/tests/safe.test
index d2406ab..7ec859c 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,11 +6,12 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: safe.test,v 1.18 2007/12/13 15:27:54 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.19 2008/08/16 23:52:34 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
+namespace import -force tcltest::test
 
 ## NOTE: Any time tests fail here with an error like:
 
@@ -43,99 +44,117 @@ if {[string equal $tcl_platform(platform) "windows"]} {
 set saveAutoPath $::auto_path
 set auto_path [list [info library] $::tk_library]
 
-test safe-1.1 {Safe Tk loading into an interpreter} {
-    catch {safe::interpDelete a}
+test safe-1.1 {Safe Tk loading into an interpreter} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::loadTk [safe::interpCreate a]
     safe::interpDelete a
     set x {}
-    set x
-} ""
-test safe-1.2 {Safe Tk loading into an interpreter} {
-    catch {safe::interpDelete a}
+    return $x
+} -result {}
+test safe-1.2 {Safe Tk loading into an interpreter} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
-    set l [lsort [interp hidden a]]
+    lsort [interp hidden a]
+} -cleanup {
     safe::interpDelete a
-    set l
-} $hidden_cmds
-test safe-1.3 {Safe Tk loading into an interpreter} -body {
-    catch {safe::interpDelete a}
+} -result $hidden_cmds
+test safe-1.3 {Safe Tk loading into an interpreter} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
-    set l [lsort [interp aliases a]]
+    lsort [interp aliases a]
+} -cleanup {
     safe::interpDelete a
-    set l
 } -match glob -result {*encoding*exit*file*load*source*}
 
-test safe-2.1 {Unsafe commands not available} {
-    catch {safe::interpDelete a}
+
+test safe-2.1 {Unsafe commands not available} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {toplevel .t}} msg]} {
 	set status ok
     }
+    return $status
+} -cleanup {
     safe::interpDelete a
-    set status
-} ok
-test safe-2.2 {Unsafe commands not available} {
-    catch {safe::interpDelete a}
+} -result ok
+test safe-2.2 {Unsafe commands not available} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {menu .m}} msg]} {
 	set status ok
     }
+    return $status
+} -cleanup {
     safe::interpDelete a
-    set status
-} ok
-test safe-2.3 {Unsafe subcommands not available} {
-    catch {safe::interpDelete a}
+} -result ok
+test safe-2.3 {Unsafe subcommands not available} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {tk appname}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     list $status $msg
-} {ok {appname not accessible in a safe interpreter}}
-test safe-2.4 {Unsafe subcommands not available} {
-    catch {safe::interpDelete a}
+} -cleanup {
+	safe::interpDelete a
+} -result {ok {appname not accessible in a safe interpreter}}
+test safe-2.4 {Unsafe subcommands not available} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {tk scaling}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     list $status $msg
-} {ok {scaling not accessible in a safe interpreter}}
+} -cleanup {
+	safe::interpDelete a
+} -result {ok {scaling not accessible in a safe interpreter}}
+
 
-test safe-3.1 {Unsafe commands are available hidden} {
-    catch {safe::interpDelete a}
+test safe-3.1 {Unsafe commands are available hidden} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status ok
     if {[catch {interp invokehidden a toplevel .t} msg]} {
 	set status broken
     }
+    return $status
+} -cleanup {
     safe::interpDelete a
-    set status
-} ok
-test safe-3.2 {Unsafe commands are available hidden} {
-    catch {safe::interpDelete a}
+} -result ok
+test safe-3.2 {Unsafe commands are available hidden} -setup {
+	catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status ok
     if {[catch {interp invokehidden a menu .m} msg]} {
 	set status broken
     }
+    return $status
+} -cleanup {
     safe::interpDelete a
-    set status
-} ok
+} -result ok
 
-test safe-4.1 {testing loadTk} {
+
+test safe-4.1 {testing loadTk} -body {
     # no error shall occur, the user will
     # eventually see a new toplevel
     set i [safe::loadTk [safe::interpCreate]]
@@ -144,27 +163,28 @@ test safe-4.1 {testing loadTk} {
     # to position the window (if the wm does not do it automatically)
     # and thus make the test suite not runable non interactively
     safe::interpDelete $i
-} {}
+} -result {}
 
-test safe-4.2 {testing loadTk -use} {
+test safe-4.2 {testing loadTk -use} -body {
     set w .safeTkFrame
-    catch {destroy $w}
+    destroy $w
     frame $w -container 1;
     pack .safeTkFrame
     set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]]
     interp eval $i {button .b -text "hello world!"; pack .b}
     safe::interpDelete $i
     destroy $w
-} {}
+} -result {}
+
 
-test safe-5.1 {loading Tk in safe interps without master's clearance} {
+test safe-5.1 {loading Tk in safe interps without master's clearance} -body {
     set i [safe::interpCreate]
-    catch {interp eval $i {load {} Tk}} msg
+    interp eval $i {load {} Tk}
+} -cleanup {
     safe::interpDelete $i
-    set msg
-} {not allowed to start Tk by master's safe::TkInit}
+} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit}
 
-test safe-5.2 {multi-level Tk loading with clearance} {
+test safe-5.2 {multi-level Tk loading with clearance} -body {
     # No error shall occur in that test and no window
     # shall remain at the end.
     set i [safe::interpCreate]
@@ -172,47 +192,52 @@ test safe-5.2 {multi-level Tk loading with clearance} {
     set j [safe::interpCreate $j]
     safe::loadTk $j
     interp eval $j {
-	button .b -text Ok -command {destroy .}
-	pack .b
-#	tkwait window . ; # for interactive testing/debugging
+	    button .b -text Ok -command {destroy .}
+	    pack .b
+#	    tkwait window . ; # for interactive testing/debugging
     }
+} -cleanup {
     safe::interpDelete $j
     safe::interpDelete $i
-} {}
+} -result {}
 
-test safe-6.1 {loadTk -use windowPath} {
+
+test safe-6.1 {loadTk -use windowPath} -body {
     set w .safeTkFrame
-    catch {destroy $w}
+    destroy $w
     frame $w -container 1;
     pack .safeTkFrame
     set i [safe::loadTk [safe::interpCreate] -use $w]
     interp eval $i {button .b -text "hello world!"; pack .b}
     safe::interpDelete $i
     destroy $w
-} {}
+} -result {}
 
-test safe-6.2 {loadTk -use windowPath, conflicting -display} {
+test safe-6.2 {loadTk -use windowPath, conflicting -display} -body {
     set w .safeTkFrame
-    catch {destroy $w}
+    destroy $w
     frame $w -container 1;
     pack .safeTkFrame
     set i     [safe::interpCreate]
     catch {safe::loadTk $i -use $w -display :23.56} msg
+    string range $msg 0 36
+} -cleanup {
     safe::interpDelete $i
     destroy $w
-    string range $msg 0 36
-} {conflicting -display :23.56 and -use }
+} -result {conflicting -display :23.56 and -use }
 
 
-test safe-7.1 {canvas printing} {
+test safe-7.1 {canvas printing} -body {
     set i [safe::loadTk [safe::interpCreate]]
-    set r [catch {interp eval $i {canvas .c; .c postscript}}]
+    interp eval $i {canvas .c; .c postscript}
+} -cleanup {
     safe::interpDelete $i
-    set r
-} 0
+} -returnCodes ok -match glob -result *
 
 # cleanup
 set ::auto_path $saveAutoPath
 unset hidden_cmds
 cleanupTests
 return
+
+