diff options
Diffstat (limited to 'tests/grab.test')
| -rw-r--r-- | tests/grab.test | 179 |
1 files changed, 179 insertions, 0 deletions
diff --git a/tests/grab.test b/tests/grab.test new file mode 100644 index 0000000..b1fd106 --- /dev/null +++ b/tests/grab.test @@ -0,0 +1,179 @@ +# Tests for the grab command. +# +# This file contains a collection of tests for one or more of the Tk +# built-in commands. Sourcing this file runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# All rights reserved. +# +# RCS: @(#) $Id: grab.test,v 1.1 2000/08/04 00:46:33 ericm Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +# 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} { + rename grab grabTest1.2 + set res [list [catch {grabTest1.2} msg] $msg] + 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} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + set result [grab status .] + grab release . + 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 . + set result [grab status .] + grab release . + 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 . + set result [grab status .] + grab release . + set result +} "global" + +test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { + 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} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab . + set curr [grab current] + grab release . + set curr +} "." + +test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab . + set result [grab status .] + grab release . + lappend result [grab status .] + grab -global . + lappend result [grab status .] + grab release . + lappend result [grab status .] +} [list "local" "none" "global" "none"] + +test grab-5.1 {Tk_GrabObjCmd, grab set} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab set . + set result [list [grab current .] [grab status .]] + grab release . + 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 . + set result [list [grab current .] [grab status .]] + grab release . + set result +} [list "." "global"] |