diff options
Diffstat (limited to 'tests/grab.test')
| -rw-r--r-- | tests/grab.test | 220 |
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 + |