← Back to branch summary

~ubuntu-branches/ubuntu/dapper/tk8.0/dapper-updates

« back to all changes in this revision

Viewing changes to tests/menubut.test

  • Committer: Bazaar Package Importer
  • Author(s): Mike Markley
  • Date: 2001-07-24 21:57:40 UTC
  • Revision ID: james.westby@ubuntu.com-20010724215740-r70t25rtmbqjil2h
Tags: upstream-8.0.5
Import upstream version 8.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/menubut.test
 
1
# This file is a Tcl script to test menubuttons in Tk.  It is
 
2
# organized in the standard fashion for Tcl tests.
 
3
#
 
4
# Copyright (c) 1994 The Regents of the University of California.
 
5
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
 
6
#
 
7
# See the file "license.terms" for information on usage and redistribution
 
8
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
9
#
 
10
# RCS: @(#) $Id: menubut.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
 
11
 
 
12
# XXX This test file is woefully incomplete right now.  If any part
 
13
# XXX of a procedure has tests then the whole procedure has tests,
 
14
# XXX but many procedures have no tests.
 
15
 
 
16
if {[lsearch [image types] test] < 0} {
 
17
    puts "This application hasn't been compiled with the \"test\" image"
 
18
    puts "type, so I can't run this test.  Are you sure you're using"
 
19
    puts "tktest instead of wish?"
 
20
    return
 
21
}
 
22
 
 
23
if {[info procs test] != "test"} {
 
24
    source defs
 
25
}
 
26
 
 
27
foreach i [winfo children .] {
 
28
    destroy $i
 
29
}
 
30
wm geometry . {}
 
31
raise .
 
32
 
 
33
# Create entries in the option database to be sure that geometry options
 
34
# like border width have predictable values.
 
35
 
 
36
option add *Menubutton.borderWidth 2
 
37
option add *Menubutton.highlightThickness 2
 
38
option add *Menubutton.font {Helvetica -12 bold}
 
39
option add *Button.borderWidth 2
 
40
option add *Button.highlightThickness 2
 
41
option add *Button.font {Helvetica -12 bold}
 
42
 
 
43
eval image delete [image names]
 
44
image create test image1
 
45
menubutton .mb -text "Test"
 
46
pack .mb
 
47
update
 
48
set i 1
 
49
foreach test {
 
50
    {-activebackground #012345 #012345 non-existent
 
51
            {unknown color name "non-existent"}}
 
52
    {-activeforeground #ff0000 #ff0000 non-existent
 
53
            {unknown color name "non-existent"}}
 
54
    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
 
55
    {-background #ff0000 #ff0000 non-existent
 
56
            {unknown color name "non-existent"}}
 
57
    {-bd 4 4 badValue {bad screen distance "badValue"}}
 
58
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
 
59
    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
 
60
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
 
61
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
 
62
    {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}}
 
63
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
 
64
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
 
65
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
 
66
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
 
67
    {-height 18 18 20.0 {expected integer but got "20.0"}}
 
68
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
 
69
    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
 
70
    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
 
71
    {-image image1 image1 bogus {image "bogus" doesn't exist}}
 
72
    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
 
73
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
 
74
    {-menu "any old string" "any old string" {} {}}
 
75
    {-padx 12 12 420x {bad screen distance "420x"}}
 
76
    {-pady 12 12 420x {bad screen distance "420x"}}
 
77
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
 
78
    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
 
79
    {-takefocus "any string" "any string" {} {}}
 
80
    {-text "Sample text" {Sample text} {} {}}
 
81
    {-textvariable i i {} {}}
 
82
    {-underline 5 5 3p {expected integer but got "3p"}}
 
83
    {-width 402 402 3p {expected integer but got "3p"}}
 
84
    {-wraplength 100 100 6x {bad screen distance "6x"}}
 
85
} {
 
86
    set name [lindex $test 0]
 
87
    test menubutton-1.$i {configuration options} {
 
88
        .mb configure $name [lindex $test 1]
 
89
        lindex [.mb configure $name] 4
 
90
    } [lindex $test 2]
 
91
    incr i
 
92
    if {[lindex $test 3] != ""} {
 
93
        test menubutton-1.$i {configuration options} {
 
94
            list [catch {.mb configure $name [lindex $test 3]} msg] $msg
 
95
        } [list 1 [lindex $test 4]]
 
96
    }
 
97
    .mb configure $name [lindex [.mb configure $name] 3]
 
98
    incr i
 
99
}
 
100
 
 
101
test menubutton-2.1 {Tk_MenubuttonCmd procedure} {
 
102
    list [catch {menubutton} msg] $msg
 
103
} {1 {wrong # args: should be "menubutton pathName ?options?"}}
 
104
test menubutton-2.2 {Tk_MenubuttonCmd procedure} {
 
105
    list [catch {menubutton foo} msg] $msg
 
106
} {1 {bad window path name "foo"}}
 
107
test menubutton-2.3 {Tk_MenubuttonCmd procedure} {
 
108
    catch {destroy .mb}
 
109
    menubutton .mb
 
110
    winfo class .mb
 
111
} {Menubutton}
 
112
test menubutton-2.4 {Tk_ButtonCmd procedure} {
 
113
    catch {destroy .mb}
 
114
    list [catch {menubutton .mb -gorp foo} msg] $msg [winfo exists .mb]
 
115
} {1 {unknown option "-gorp"} 0}
 
116
 
 
117
catch {destroy .mb}
 
118
menubutton .mb -text "Test Menu"
 
119
pack .mb
 
120
test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
 
121
    list [catch {.mb} msg] $msg
 
122
} {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
 
123
test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
 
124
    list [catch {.mb c} msg] $msg
 
125
} {1 {bad option "c": must be cget or configure}}
 
126
test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
 
127
    list [catch {.mb cget} msg] $msg
 
128
} {1 {wrong # args: should be ".mb cget option"}}
 
129
test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} {
 
130
    list [catch {.mb cget a b} msg] $msg
 
131
} {1 {wrong # args: should be ".mb cget option"}}
 
132
test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} {
 
133
    list [catch {.mb cget -gorp} msg] $msg
 
134
} {1 {unknown option "-gorp"}}
 
135
test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} {
 
136
    .mb configure -highlightthickness 3
 
137
    .mb cget -highlightthickness
 
138
} {3}
 
139
test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} {
 
140
    llength [.mb configure]
 
141
} {32}
 
142
test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} {
 
143
    list [catch {.mb configure -gorp} msg] $msg
 
144
} {1 {unknown option "-gorp"}}
 
145
test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} {
 
146
    list [catch {.mb co -bg #ffffff -fg} msg] $msg
 
147
} {1 {value for "-fg" missing}}
 
148
test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} {
 
149
    .mb configure -fg #123456
 
150
    .mb configure -bg #654321
 
151
    lindex [.mb configure -fg] 4
 
152
} {#123456}
 
153
test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} {
 
154
    list [catch {.mb foobar} msg] $msg
 
155
} {1 {bad option "foobar": must be cget or configure}}
 
156
 
 
157
# XXX Need to add tests for several procedures here.   The tests for   XXX
 
158
# XXX ConfigureMenuButton aren't complete either.                      XXX
 
159
 
 
160
test menubutton-4.1 {ConfigureMenuButton procedure} {
 
161
    catch {destroy .mb1}
 
162
    button .mb1 -text "Menubutton 1"
 
163
    list [catch {.mb1 configure -width 1i} msg] $msg $errorInfo
 
164
} {1 {expected integer but got "1i"} {expected integer but got "1i"
 
165
    (processing -width option)
 
166
    invoked from within
 
167
".mb1 configure -width 1i"}}
 
168
test menubutton-4.2 {ConfigureMenuButton procedure} {
 
169
    catch {destroy .mb1}
 
170
    button .mb1 -text "Menubutton 1"
 
171
    list [catch {.mb1 configure -height 0.5c} msg] $msg $errorInfo
 
172
} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
 
173
    (processing -height option)
 
174
    invoked from within
 
175
".mb1 configure -height 0.5c"}}
 
176
test menubutton-4.3 {ConfigureMenuButton procedure} {
 
177
    catch {destroy .mb1}
 
178
    button .mb1 -bitmap questhead
 
179
    list [catch {.mb1 configure -width abc} msg] $msg $errorInfo
 
180
} {1 {bad screen distance "abc"} {bad screen distance "abc"
 
181
    (processing -width option)
 
182
    invoked from within
 
183
".mb1 configure -width abc"}}
 
184
test menubutton-4.4 {ConfigureMenuButton procedure} {
 
185
    catch {destroy .mb1}
 
186
    eval image delete [image names]
 
187
    image create test image1
 
188
    button .mb1 -image image1
 
189
    list [catch {.mb1 configure -height 0.5x} msg] $msg $errorInfo
 
190
} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
 
191
    (processing -height option)
 
192
    invoked from within
 
193
".mb1 configure -height 0.5x"}}
 
194
test menubutton-4.5 {ConfigureMenuButton procedure} {fonts} {
 
195
    catch {destroy .mb1}
 
196
    button .mb1 -text "Sample text" -width 10 -height 2
 
197
    pack .mb1
 
198
    set result "[winfo reqwidth .mb1] [winfo reqheight .mb1]"
 
199
    .mb1 configure -bitmap questhead
 
200
    lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1]
 
201
} {102 46 20 12}
 
202
test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
 
203
    catch {destroy .mb}
 
204
    menubutton .mb -text "Test"
 
205
    list [catch {.mb configure -direction badValue} msg] $msg \
 
206
        [.mb cget -direction] [destroy .mb]
 
207
} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}}
 
208
 
 
209
# XXX Need to add tests for several procedures here. XXX
 
210
 
 
211
test menubutton-5.1 {MenuButtonEventProc procedure} {
 
212
    eval destroy [winfo children .]
 
213
    menubutton .mb1 -bg #543210
 
214
    rename .mb1 .mb2
 
215
    set x {}
 
216
    lappend x [winfo children .]
 
217
    lappend x [.mb2 cget -bg]
 
218
    destroy .mb1
 
219
    lappend x [info command .mb*] [winfo children .]
 
220
} {.mb1 #543210 {} {}}
 
221
 
 
222
test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} {
 
223
    eval destroy [winfo children .]
 
224
    menubutton .mb1
 
225
    rename .mb1 {}
 
226
    list [info command .mb*] [winfo children .]
 
227
} {{} {}}
 
228
 
 
229
test menubutton-7.1 {ComputeMenuButtonGeometry procedure} {
 
230
    catch {destroy .mb}
 
231
    menubutton .mb -image image1 -bd 4 -highlightthickness 0
 
232
    pack .mb
 
233
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
234
} {38 23}
 
235
test menubutton-7.2 {ComputeMenuButtonGeometry procedure} {
 
236
    catch {destroy .mb}
 
237
    menubutton .mb -image image1 -bd 1 -highlightthickness 2
 
238
    pack .mb
 
239
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
240
} {36 21}
 
241
test menubutton-7.3 {ComputeMenuButtonGeometry procedure} {
 
242
    catch {destroy .mb}
 
243
    menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5
 
244
    pack .mb
 
245
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
246
} {34 19}
 
247
test menubutton-7.4 {ComputeMenuButtonGeometry procedure} {
 
248
    catch {destroy .mb}
 
249
    menubutton .mb -image image1 -bd 2 -relief raised -width 40 \
 
250
            -highlightthickness 2
 
251
    pack .mb
 
252
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
253
} {48 23}
 
254
test menubutton-7.5 {ComputeMenuButtonGeometry procedure} {
 
255
    catch {destroy .mb}
 
256
    menubutton .mb -image image1 -bd 2 -relief raised -height 30 \
 
257
            -highlightthickness 2
 
258
    pack .mb
 
259
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
260
} {38 38}
 
261
test menubutton-7.6 {ComputeMenuButtonGeometry procedure} {
 
262
    catch {destroy .mb}
 
263
    menubutton .mb -bitmap question -bd 2 -relief raised \
 
264
            -highlightthickness 2
 
265
    pack .mb
 
266
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
267
} {25 35}
 
268
test menubutton-7.7 {ComputeMenuButtonGeometry procedure} {
 
269
    catch {destroy .mb}
 
270
    menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \
 
271
            -highlightthickness 1
 
272
    pack .mb
 
273
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
274
} {46 33}
 
275
test menubutton-7.8 {ComputeMenuButtonGeometry procedure} {
 
276
    catch {destroy .mb}
 
277
    menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \
 
278
            -highlightthickness 1
 
279
    pack .mb
 
280
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
281
} {23 56}
 
282
test menubutton-7.9 {ComputeMenuButtonGeometry procedure} {fonts} {
 
283
    catch {destroy .mb}
 
284
    menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \
 
285
            -highlightthickness 1
 
286
    pack .mb
 
287
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
288
} {42 20}
 
289
test menubutton-7.10 {ComputeMenuButtonGeometry procedure} {fonts} {
 
290
    catch {destroy .mb}
 
291
    menubutton .mb -text String -bd 2 -relief raised -width 20 \
 
292
            -padx 0 -pady 0 -highlightthickness 1
 
293
    pack .mb
 
294
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
295
} {146 20}
 
296
test menubutton-7.11 {ComputeMenuButtonGeometry procedure} {fonts} {
 
297
    catch {destroy .mb}
 
298
    menubutton .mb -text String -bd 2 -relief raised -height 2 \
 
299
            -padx 0 -pady 0 -highlightthickness 1
 
300
    pack .mb
 
301
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
302
} {42 34}
 
303
test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} {
 
304
    catch {destroy .mb}
 
305
    menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \
 
306
            -highlightthickness 1
 
307
    pack .mb
 
308
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
309
} {62 30}
 
310
test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
 
311
    catch {destroy .mb}
 
312
    menubutton .mb -text String -bd 2 -relief raised \
 
313
            -highlightthickness 1 -indicatoron 1
 
314
    pack .mb
 
315
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
316
} {78 28}
 
317
test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
 
318
    # The following test is non-portable because the indicator's pixel
 
319
    # size varies to maintain constant absolute size.
 
320
 
 
321
    catch {destroy .mb}
 
322
    menubutton .mb -image image1 -bd 2 -relief raised \
 
323
            -highlightthickness 2 -indicatoron 1
 
324
    pack .mb
 
325
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
326
} {64 23}
 
327
test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} {
 
328
    # The following test is non-portable because the indicator's pixel
 
329
    # size varies to maintain constant absolute size.
 
330
 
 
331
    catch {destroy .mb}
 
332
    menubutton .mb -image image1 -bd 2 -relief raised \
 
333
            -highlightthickness 2 -indicatoron 1
 
334
    pack .mb
 
335
    list [winfo reqwidth .mb] [winfo reqheight .mb]
 
336
} {65 23}
 
337
 
 
338
set l [interp hidden]
 
339
eval destroy [winfo children .]
 
340
 
 
341
test menubutton-8.1 {menubutton vs hidden commands} {
 
342
    catch {destroy .mb}
 
343
    menubutton .mb
 
344
    interp hide {} .mb
 
345
    destroy .mb
 
346
    list [winfo children .] [interp hidden]
 
347
} [list {} $l]
 
348
 
 
349
eval image delete [image names]
 
350
eval destroy [winfo children .]
 
351
option clear
 
352