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