1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
# 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$
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
# 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"]
tcltest::cleanupTests
return
|
