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
186
187
188
|
# 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.
package require tcltest 2.2
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 {
rename grab grabTest1.2
grabTest1.2
} -cleanup {
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 curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab status .
} -cleanup {
grab release .
} -result {none}
test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab .
grab status .
} -cleanup {
grab release .
} -result {local}
test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab -global .
grab status .
} -cleanup {
grab release .
} -result {global}
test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} -body {
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 [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab .
grab current
} -cleanup {
grab release .
} -result {.}
test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body {
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 .]
} -result {local none global none}
test grab-5.1 {Tk_GrabObjCmd, grab set} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab set .
list [grab current .] [grab status .]
} -cleanup {
grab release .
} -result {. local}
test grab-5.2 {Tk_GrabObjCmd, grab set} -body {
set curr [grab current .]
if { [string length $curr] > 0 } {
grab release $curr
}
grab set -global .
list [grab current .] [grab status .]
} -cleanup {
grab release .
} -result {. global}
cleanupTests
return
|
