diff options
Diffstat (limited to 'tests/grab.test')
| -rw-r--r-- | tests/grab.test | 218 |
1 files changed, 105 insertions, 113 deletions
diff --git a/tests/grab.test b/tests/grab.test index 33399cb..2f4f73b 100644 --- a/tests/grab.test +++ b/tests/grab.test @@ -7,145 +7,140 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. -package require tcltest 2.2 +package require tcltest 2.1 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} -body { - grab -} -returnCodes error -result {wrong # args: should be "grab ?-global? window" or "grab option ?arg ...?"} -test grab-1.2 {Tk_GrabObjCmd} -body { +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} { rename grab grabTest1.2 - grabTest1.2 -} -cleanup { + set res [list [catch {grabTest1.2} msg] $msg] rename grabTest1.2 grab -} -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 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} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } - grab status . -} -cleanup { + set result [grab status .] grab release . -} -result {none} -test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} -body { + set result +} "none" +test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . - grab status . -} -cleanup { + set result [grab status .] grab release . -} -result {local} -test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} -body { + set result +} "local" +test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab -global . - grab status . -} -cleanup { + set result [grab status .] grab release . -} -result {global} - + set result +} "global" -test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} -body { +test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } - return $curr -} -result {} -test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} -body { + set curr +} "" +test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . - grab current -} -cleanup { + set curr [grab current] grab release . -} -result {.} + set curr +} "." - -test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body { +test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr @@ -158,31 +153,28 @@ test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body { lappend result [grab status .] grab release . lappend result [grab status .] -} -result {local none global none} - +} [list "local" "none" "global" "none"] -test grab-5.1 {Tk_GrabObjCmd, grab set} -body { +test grab-5.1 {Tk_GrabObjCmd, grab set} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set . - list [grab current .] [grab status .] -} -cleanup { + set result [list [grab current .] [grab status .]] grab release . -} -result {. local} -test grab-5.2 {Tk_GrabObjCmd, grab set} -body { + set result +} [list "." "local"] +test grab-5.2 {Tk_GrabObjCmd, grab set} { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set -global . - list [grab current .] [grab status .] -} -cleanup { + set result [list [grab current .] [grab status .]] grab release . -} -result {. global} - + set result +} [list "." "global"] cleanupTests return - |