1# Tests for the grab command.
2#
3# This file contains a collection of tests for one or more of the Tk
4# built-in commands.  Sourcing this file runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1998-2000 by Ajuba Solutions.
8# All rights reserved.
9#
10# RCS: @(#) $Id$
11
12package require tcltest 2.1
13eval tcltest::configure $argv
14tcltest::loadTestedCommands
15
16# There's currently no way to test the actual grab effect, per se,
17# in an automated test.  Therefore, this test suite only covers the
18# interface to the grab command (ie, error messages, etc.)
19
20test grab-1.1 {Tk_GrabObjCmd} {
21    list [catch {grab} msg] $msg
22} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""]
23test grab-1.2 {Tk_GrabObjCmd} {
24    rename grab grabTest1.2
25    set res [list [catch {grabTest1.2} msg] $msg]
26    rename grabTest1.2 grab
27    set res
28} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""]
29
30test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} {
31    list [catch {grab .foo bar baz} msg] $msg
32} [list 1 "wrong # args: should be \"grab ?-global? window\""]
33test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} {
34    catch {destroy .foo}
35    list [catch {grab .foo} msg] $msg
36} [list 1 "bad window path name \".foo\""]
37test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} {
38    list [catch {grab -foo bar} msg] $msg
39} [list 1 "bad option \"-foo\": must be -global"]
40test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} {
41    catch {destroy .foo}
42    list [catch {grab -global .foo} msg] $msg
43} [list 1 "bad window path name \".foo\""]
44
45test grab-1.7 {Tk_GrabObjCmd} {
46    list [catch {grab foo} msg] $msg
47} [list 1 "bad option \"foo\": must be current, release, set, or status"]
48
49test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} {
50    list [catch {grab current foo bar} msg] $msg
51} [list 1 "wrong # args: should be \"grab current ?window?\""]
52test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} {
53    catch {destroy .foo}
54    list [catch {grab current .foo} msg] $msg
55} [list 1 "bad window path name \".foo\""]
56
57test grab-1.10 {Tk_GrabObjCmd, "grab release window"} {
58    list [catch {grab release} msg] $msg
59} [list 1 "wrong # args: should be \"grab release window\""]
60test grab-1.11 {Tk_GrabObjCmd, "grab release window"} {
61    catch {destroy .foo}
62    list [catch {grab release .foo} msg] $msg
63} [list 0 ""]
64test grab-1.12 {Tk_GrabObjCmd, "grab release window"} {
65    list [catch {grab release foo} msg] $msg
66} [list 0 ""]
67
68test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} {
69    list [catch {grab set} msg] $msg
70} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
71test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} {
72    list [catch {grab set foo bar baz} msg] $msg
73} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
74test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} {
75    catch {destroy .foo}
76    list [catch {grab set .foo} msg] $msg
77} [list 1 "bad window path name \".foo\""]
78test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} {
79    list [catch {grab set -foo bar} msg] $msg
80} [list 1 "bad option \"-foo\": must be -global"]
81test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} {
82    catch {destroy .foo}
83    list [catch {grab set -global .foo} msg] $msg
84} [list 1 "bad window path name \".foo\""]
85
86test grab-1.18 {Tk_GrabObjCmd, "grab status window"} {
87    list [catch {grab status} msg] $msg
88} [list 1 "wrong # args: should be \"grab status window\""]
89test grab-1.19 {Tk_GrabObjCmd, "grab status window"} {
90    list [catch {grab status foo bar} msg] $msg
91} [list 1 "wrong # args: should be \"grab status window\""]
92test grab-1.20 {Tk_GrabObjCmd, "grab status window"} {
93    catch {destroy .foo}
94    list [catch {grab status .foo} msg] $msg
95} [list 1 "bad window path name \".foo\""]
96
97test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} {
98    set curr [grab current .]
99    if { [string length $curr] > 0 } {
100	grab release $curr
101    }
102    set result [grab status .]
103    grab release .
104    set result
105} "none"
106test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} {
107    set curr [grab current .]
108    if { [string length $curr] > 0 } {
109	grab release $curr
110    }
111    grab .
112    set result [grab status .]
113    grab release .
114    set result
115} "local"
116test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} {
117    set curr [grab current .]
118    if { [string length $curr] > 0 } {
119	grab release $curr
120    }
121    grab -global .
122    set result [grab status .]
123    grab release .
124    set result
125} "global"
126
127test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} {
128    set curr [grab current .]
129    if { [string length $curr] > 0 } {
130	grab release $curr
131    }
132    set curr
133} ""
134test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} {
135    set curr [grab current .]
136    if { [string length $curr] > 0 } {
137	grab release $curr
138    }
139    grab .
140    set curr [grab current]
141    grab release .
142    set curr
143} "."
144
145test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} {
146    set curr [grab current .]
147    if { [string length $curr] > 0 } {
148	grab release $curr
149    }
150    grab .
151    set result [grab status .]
152    grab release .
153    lappend result [grab status .]
154    grab -global .
155    lappend result [grab status .]
156    grab release .
157    lappend result [grab status .]
158} [list "local" "none" "global" "none"]
159
160test grab-5.1 {Tk_GrabObjCmd, grab set} {
161    set curr [grab current .]
162    if { [string length $curr] > 0 } {
163	grab release $curr
164    }
165    grab set .
166    set result [list [grab current .] [grab status .]]
167    grab release .
168    set result
169} [list "." "local"]
170test grab-5.2 {Tk_GrabObjCmd, grab set} {
171    set curr [grab current .]
172    if { [string length $curr] > 0 } {
173	grab release $curr
174    }
175    grab set -global .
176    set result [list [grab current .] [grab status .]]
177    grab release .
178    set result
179} [list "." "global"]
180
181cleanupTests
182return
183