Update to tcltest2

1 files changed, 116 insertions, 90 deletions

diff --git a/tests/tk.test b/tests/tk.test
index e2e0e7e..0527be0 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -5,137 +5,155 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2002 ActiveState Corporation.
 #
-# RCS: @(#) $Id: tk.test,v 1.14 2005/06/01 15:48:50 rmax Exp $
+# RCS: @(#) $Id: tk.test,v 1.15 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
 
-test tk-1.1 {tk command: general} \
-    -body {tk} -returnCodes 1 \
-    -result {wrong # args: should be "tk option ?arg?"}
-test tk-1.2 {tk command: general} \
-    -body {tk xyz} -returnCodes 1 \
-    -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive}
+test tk-1.1 {tk command: general} -body {
+    tk
+} -returnCodes error -result {wrong # args: should be "tk option ?arg?"}
+test tk-1.2 {tk command: general} -body {
+    tk xyz
+} -returnCodes error -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive}
 
+
+# Value stored to restore default settings after 2.* tests
 set appname [tk appname]
-test tk-2.1 {tk command: appname} {
-    list [catch {tk appname xyz abc} msg] $msg
-} {1 {wrong # args: should be "tk appname ?newName?"}}
-test tk-2.2 {tk command: appname} {
+test tk-2.1 {tk command: appname} -body {
+    tk appname xyz abc
+} -returnCodes error -result {wrong # args: should be "tk appname ?newName?"}
+test tk-2.2 {tk command: appname} -body {
     tk appname foobazgarply
-} {foobazgarply}
-test tk-2.3 {tk command: appname} unix {
+} -result {foobazgarply}
+test tk-2.3 {tk command: appname} -constraints unix -body {
     tk appname bazfoogarply
     expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
-} {1}
-test tk-2.4 {tk command: appname} {
-    tk appname $appname
-} $appname
+} -result {1}
+test tk-2.4 {tk command: appname} -body {
+    tk appname [tk appname]
+} -result [tk appname]
 tk appname $appname
 
+
+# Value stored to restore default settings after 3.* tests
 set scaling [tk scaling]
-test tk-3.1 {tk command: scaling} {
-    list [catch {tk scaling -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test tk-3.2 {tk command: scaling: get current} {
+test tk-3.1 {tk command: scaling} -body {
+    tk scaling -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test tk-3.2 {tk command: scaling: get current} -body {
     tk scaling 1
     format %.2g [tk scaling]
-} 1
-test tk-3.3 {tk command: scaling: get current} {
+}  -result 1
+test tk-3.3 {tk command: scaling: get current} -body {
     tk scaling -displayof . 1.25
     format %.3g [tk scaling]
-} 1.25
-test tk-3.4 {tk command: scaling: set new} {
-    list [catch {tk scaling xyz} msg] $msg
-} {1 {expected floating-point number but got "xyz"}}
-test tk-3.5 {tk command: scaling: set new} {
-    list [catch {tk scaling -displayof . xyz} msg] $msg
-} {1 {expected floating-point number but got "xyz"}}
-test tk-3.6 {tk command: scaling: set new} {
+}  -result 1.25
+test tk-3.4 {tk command: scaling: set new} -body {
+    tk scaling xyz
+} -returnCodes error -result {expected floating-point number but got "xyz"}
+test tk-3.5 {tk command: scaling: set new} -body {
+    tk scaling -displayof . xyz
+} -returnCodes error -result {expected floating-point number but got "xyz"}
+test tk-3.6 {tk command: scaling: set new} -body {
     tk scaling 1
     format %.2g [tk scaling]
-} 1
-test tk-3.7 {tk command: scaling: set new} {
+} -result 1
+test tk-3.7 {tk command: scaling: set new} -body {
     tk scaling -displayof . 1.25
     format %.3g [tk scaling]
-} 1.25
-test tk-3.8 {tk command: scaling: negative} {
+} -result 1.25
+test tk-3.8 {tk command: scaling: negative} -body {
     tk scaling -1
     expr {[tk scaling] > 0}
-} {1}
-test tk-3.9 {tk command: scaling: too big} {
+} -result {1}
+test tk-3.9 {tk command: scaling: too big} -body {
     tk scaling 1000000
     expr {[tk scaling] < 10000}
-} {1}    
-test tk-3.10 {tk command: scaling: widthmm} {
+} -result {1}    
+test tk-3.10 {tk command: scaling: widthmm} -body {
     tk scaling 1.25
-    expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
-} {0}
-test tk-3.11 {tk command: scaling: heightmm} {
+    expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \
+        - [winfo screenmmwidth .]}
+} -result {0}
+test tk-3.11 {tk command: scaling: heightmm} -body {
     tk scaling 1.25
-    expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
-} {0}
+    expr {int((25.4*[winfo screenheight .])/(72*1.25) + 0.5) \
+        - [winfo screenmmheight .]}
+} -result {0}
 tk scaling $scaling
 
+
+# Value stored to restore default settings after 4.* tests
 set useim [tk useinputmethods]
-test tk-4.1 {tk command: useinputmethods} {
-    list [catch {tk useinputmethods -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test tk-4.2 {tk command: useinputmethods: get current} {
+test tk-4.1 {tk command: useinputmethods} -body {
+    tk useinputmethods -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test tk-4.2 {tk command: useinputmethods: get current} -body {
+    tk useinputmethods no
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
+test tk-4.3 {tk command: useinputmethods: get current} -body {
     tk useinputmethods no
-} 0
-test tk-4.3 {tk command: useinputmethods: get current} {
     tk useinputmethods -displayof .
-} 0
-test tk-4.4 {tk command: useinputmethods: set new} {
-    list [catch {tk useinputmethods xyz} msg] $msg
-} {1 {expected boolean value but got "xyz"}}
-test tk-4.5 {tk command: useinputmethods: set new} {
-    list [catch {tk useinputmethods -displayof . xyz} msg] $msg
-} {1 {expected boolean value but got "xyz"}}
-test tk-4.6 {tk command: useinputmethods: set new} unix {
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
+test tk-4.4 {tk command: useinputmethods: set new} -body {
+    tk useinputmethods xyz
+} -returnCodes error -result {expected boolean value but got "xyz"}
+test tk-4.5 {tk command: useinputmethods: set new} -body {
+    tk useinputmethods -displayof . xyz
+} -returnCodes error -result {expected boolean value but got "xyz"}
+test tk-4.6 {tk command: useinputmethods: set new} -body {
     # This isn't really a test, but more of a check...
     # The answer is what was given, because we may be on a Unix
     # system that doesn't have the XIM stuff
     if {[tk useinputmethods 1] == 0} {
-	puts "this wish doesn't have XIM (X Input Methods) support"
+	    puts "this wish doesn't have XIM (X Input Methods) support"
     }
-    set useim
-} $useim
-test tk-4.7 {tk command: useinputmethods: set new} win {
+
+    return $useim
+} -result $useim
+test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
     # Mac and Windows don't have X Input Methods, so this should
     # always return 0
     tk useinputmethods 1
-} 0
-tk useinputmethods $useim
-
-test tk-5.1 {tk caret} {
-    list [catch {tk caret} msg] $msg
-} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
-test tk-5.2 {tk caret} {
-    list [catch {tk caret bogus} msg] $msg
-} {1 {bad window path name "bogus"}}
-test tk-5.3 {tk caret} {
-    list [catch {tk caret . -foo} msg] $msg
-} {1 {bad caret option "-foo": must be -x, -y, or -height}}
-test tk-5.4 {tk caret} {
-    list [catch {tk caret . -x 0 -y} msg] $msg
-} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
-test tk-5.5 {tk caret} {
-    list [catch {tk caret . -x 10 -y 11 -h 12; tk caret .} msg] $msg
-} {0 {-height 12 -x 10 -y 11}}
-test tk-5.6 {tk caret} {
-    list [catch {tk caret . -x 20 -y 25 -h 30; tk caret . -hei} msg] $msg
-} {0 30}
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
+
+
+test tk-5.1 {tk caret} -body {
+    tk caret
+} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
+test tk-5.2 {tk caret} -body {
+    tk caret bogus
+} -returnCodes error -result {bad window path name "bogus"}
+test tk-5.3 {tk caret} -body {
+    tk caret . -foo
+} -returnCodes error -result {bad caret option "-foo": must be -x, -y, or -height}
+test tk-5.4 {tk caret} -body {
+    tk caret . -x 0 -y
+} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
+test tk-5.5 {tk caret} -body {
+    tk caret . -x 10 -y 11 -h 12; tk caret .
+} -result {-height 12 -x 10 -y 11}
+test tk-5.6 {tk caret} -body {
+    tk caret . -x 20 -y 25 -h 30; tk caret . -hei
+} -result {30}
+
 
 # tk inactive
 test tk-6.1 {tk inactive} -body {
     string is integer [tk inactive]
 } -result 1
 test tk-6.2 {tk inactive reset} -body {
-    catch {tk inactive reset}
-} -result 0
+    tk inactive reset
+} -returnCodes ok -match glob -result *
 test tk-6.3 {tk inactive wrong argument} -body {
     tk inactive foo
 } -returnCodes 1 -result {bad option "foo": must be reset}
@@ -150,16 +168,24 @@ test tk-6.5 {tk inactive} -body {
     expr {$i == -1 || ( $i > 90 && $i < 200 )}
 } -result 1
 
-# tk inactive in safe interpreters
-safe::interpCreate foo
-safe::loadTk foo
+
 test tk-7.1 {tk inactive in a safe interpreter} -body {
+# tk inactive in safe interpreters
+    safe::interpCreate foo
+    safe::loadTk foo
     foo eval {tk inactive}
+} -cleanup {
+    ::safe::interpDelete foo
 } -result -1
 test tk-7.2 {tk inactive reset in a safe interpreter} -body {
+# tk inactive in safe interpreters
+    safe::interpCreate foo
+    safe::loadTk foo
     foo eval {tk inactive reset}
+} -cleanup {
+    ::safe::interpDelete foo
 } -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
-::safe::interpDelete foo
+
 
 # cleanup
 cleanupTests