summaryrefslogtreecommitdiffstats
path: root/tests/grab.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/grab.test')
-rw-r--r--tests/grab.test220
1 files changed, 114 insertions, 106 deletions
diff --git a/tests/grab.test b/tests/grab.test
index d2ee4b2..c9f6688 100644
--- a/tests/grab.test
+++ b/tests/grab.test
@@ -7,142 +7,147 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: grab.test,v 1.3 2003/04/01 21:06:35 dgp Exp $
+# RCS: @(#) $Id: grab.test,v 1.5 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
# There's currently no way to test the actual grab effect, per se,
# in an automated test. Therefore, this test suite only covers the
# interface to the grab command (ie, error messages, etc.)
-test grab-1.1 {Tk_GrabObjCmd} {
- list [catch {grab} msg] $msg
-} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""]
-test grab-1.2 {Tk_GrabObjCmd} {
+
+test grab-1.1 {Tk_GrabObjCmd} -body {
+ grab
+} -returnCodes error -result {wrong # args: should be "grab ?-global? window" or "grab option ?arg ...?"}
+test grab-1.2 {Tk_GrabObjCmd} -body {
rename grab grabTest1.2
- set res [list [catch {grabTest1.2} msg] $msg]
+ grabTest1.2
+} -cleanup {
rename grabTest1.2 grab
- set res
-} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""]
-
-test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} {
- list [catch {grab .foo bar baz} msg] $msg
-} [list 1 "wrong # args: should be \"grab ?-global? window\""]
-test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} {
- catch {destroy .foo}
- list [catch {grab .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} {
- list [catch {grab -foo bar} msg] $msg
-} [list 1 "bad option \"-foo\": must be -global"]
-test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} {
- catch {destroy .foo}
- list [catch {grab -global .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-
-test grab-1.7 {Tk_GrabObjCmd} {
- list [catch {grab foo} msg] $msg
-} [list 1 "bad option \"foo\": must be current, release, set, or status"]
-
-test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} {
- list [catch {grab current foo bar} msg] $msg
-} [list 1 "wrong # args: should be \"grab current ?window?\""]
-test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} {
- catch {destroy .foo}
- list [catch {grab current .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-
-test grab-1.10 {Tk_GrabObjCmd, "grab release window"} {
- list [catch {grab release} msg] $msg
-} [list 1 "wrong # args: should be \"grab release window\""]
-test grab-1.11 {Tk_GrabObjCmd, "grab release window"} {
- catch {destroy .foo}
- list [catch {grab release .foo} msg] $msg
-} [list 0 ""]
-test grab-1.12 {Tk_GrabObjCmd, "grab release window"} {
- list [catch {grab release foo} msg] $msg
-} [list 0 ""]
-
-test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} {
- list [catch {grab set} msg] $msg
-} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
-test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} {
- list [catch {grab set foo bar baz} msg] $msg
-} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
-test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} {
- catch {destroy .foo}
- list [catch {grab set .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} {
- list [catch {grab set -foo bar} msg] $msg
-} [list 1 "bad option \"-foo\": must be -global"]
-test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} {
- catch {destroy .foo}
- list [catch {grab set -global .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-
-test grab-1.18 {Tk_GrabObjCmd, "grab status window"} {
- list [catch {grab status} msg] $msg
-} [list 1 "wrong # args: should be \"grab status window\""]
-test grab-1.19 {Tk_GrabObjCmd, "grab status window"} {
- list [catch {grab status foo bar} msg] $msg
-} [list 1 "wrong # args: should be \"grab status window\""]
-test grab-1.20 {Tk_GrabObjCmd, "grab status window"} {
- catch {destroy .foo}
- list [catch {grab status .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-
-test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} {
+} -returnCodes error -result {wrong # args: should be "grabTest1.2 ?-global? window" or "grabTest1.2 option ?arg ...?"}
+
+test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} -body {
+ grab .foo bar baz
+} -returnCodes error -result {wrong # args: should be "grab ?-global? window"}
+test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} -body {
+ destroy .foo
+ grab .foo
+} -returnCodes error -result {bad window path name ".foo"}
+test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} -body {
+ grab -foo bar
+} -returnCodes error -result {bad option "-foo": must be -global}
+test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} -body {
+ destroy .foo
+ grab -global .foo
+} -returnCodes error -result {bad window path name ".foo"}
+
+test grab-1.7 {Tk_GrabObjCmd} -body {
+ grab foo
+} -returnCodes error -result {bad option "foo": must be current, release, set, or status}
+
+test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} -body {
+ grab current foo bar
+} -returnCodes error -result {wrong # args: should be "grab current ?window?"}
+test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} -body {
+ destroy .foo
+ grab current .foo
+} -returnCodes error -result {bad window path name ".foo"}
+
+test grab-1.10 {Tk_GrabObjCmd, "grab release window"} -body {
+ grab release
+} -returnCodes error -result {wrong # args: should be "grab release window"}
+test grab-1.11 {Tk_GrabObjCmd, "grab release window"} -body {
+ destroy .foo
+ grab release .foo
+} -returnCodes ok -result {}
+test grab-1.12 {Tk_GrabObjCmd, "grab release window"} -body {
+ grab release foo
+} -returnCodes ok -result {}
+
+test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} -body {
+ grab set
+} -returnCodes error -result {wrong # args: should be "grab set ?-global? window"}
+test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} -body {
+ grab set foo bar baz
+} -returnCodes error -result {wrong # args: should be "grab set ?-global? window"}
+test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} -body {
+ destroy .foo
+ grab set .foo
+} -returnCodes error -result {bad window path name ".foo"}
+test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} -body {
+ grab set -foo bar
+} -returnCodes error -result {bad option "-foo": must be -global}
+test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} -body {
+ destroy .foo
+ grab set -global .foo
+} -returnCodes error -result {bad window path name ".foo"}
+
+test grab-1.18 {Tk_GrabObjCmd, "grab status window"} -body {
+ grab status
+} -returnCodes error -result {wrong # args: should be "grab status window"}
+test grab-1.19 {Tk_GrabObjCmd, "grab status window"} -body {
+ grab status foo bar
+} -returnCodes error -result {wrong # args: should be "grab status window"}
+test grab-1.20 {Tk_GrabObjCmd, "grab status window"} -body {
+ destroy .foo
+ grab status .foo
+} -returnCodes error -result {bad window path name ".foo"}
+
+
+test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
- set result [grab status .]
+ grab status .
+} -cleanup {
grab release .
- set result
-} "none"
-test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} {
+} -result {none}
+test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab .
- set result [grab status .]
+ grab status .
+} -cleanup {
grab release .
- set result
-} "local"
-test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} {
+} -result {local}
+test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab -global .
- set result [grab status .]
+ grab status .
+} -cleanup {
grab release .
- set result
-} "global"
+} -result {global}
+
-test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} {
+test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
- set curr
-} ""
-test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} {
+ return $curr
+} -result {}
+test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab .
- set curr [grab current]
+ grab current
+} -cleanup {
grab release .
- set curr
-} "."
+} -result {.}
-test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} {
+
+test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
@@ -155,28 +160,31 @@ test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} {
lappend result [grab status .]
grab release .
lappend result [grab status .]
-} [list "local" "none" "global" "none"]
+} -result {local none global none}
+
-test grab-5.1 {Tk_GrabObjCmd, grab set} {
+test grab-5.1 {Tk_GrabObjCmd, grab set} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab set .
- set result [list [grab current .] [grab status .]]
+ list [grab current .] [grab status .]
+} -cleanup {
grab release .
- set result
-} [list "." "local"]
-test grab-5.2 {Tk_GrabObjCmd, grab set} {
+} -result {. local}
+test grab-5.2 {Tk_GrabObjCmd, grab set} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab set -global .
- set result [list [grab current .] [grab status .]]
+ list [grab current .] [grab status .]
+} -cleanup {
grab release .
- set result
-} [list "." "global"]
+} -result {. global}
+
cleanupTests
return
+