summaryrefslogtreecommitdiffstats
path: root/tests/tk.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/tk.test')
-rw-r--r--tests/tk.test206
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