1# This file is a Tcl script to test out the procedures in the file
2# tkBitmap.c.  It is organized in the standard white-box fashion for
3# Tcl tests.
4#
5# Copyright (c) 1998 Sun Microsystems, Inc.
6# Copyright (c) 1998-1999 by Scriptics Corporation.
7# All rights reserved.
8#
9# RCS: @(#) $Id$
10
11package require tcltest 2.1
12eval tcltest::configure $argv
13tcltest::loadTestedCommands
14
15test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap {
16    set x gray25
17    lindex $x 0
18    destroy .b1
19    button .b1 -bitmap $x
20    lindex $x 0
21    testbitmap gray25
22} {{1 0}}
23test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap {
24    set x gray25
25    destroy .b1 .b2
26    button .b1 -bitmap $x
27    destroy .b1
28    set result {}
29    lappend result [testbitmap gray25]
30    button .b2 -bitmap $x
31    lappend result [testbitmap gray25]
32} {{} {{1 1}}}
33test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap {
34    set x gray25
35    destroy .b1 .b2
36    button .b1 -bitmap $x
37    set result {}
38    lappend result [testbitmap gray25]
39    button .b2 -bitmap $x
40    pack .b1 .b2 -side top
41    lappend result [testbitmap gray25]
42} {{{1 1}} {{2 1}}}
43
44test bitmap-2.1 {Tk_GetBitmap procedure} {
45    destroy .b1
46    list [catch {button .b1 -bitmap bad_name} msg] $msg
47} {1 {bitmap "bad_name" not defined}}
48test bitmap-2.2 {Tk_GetBitmap procedure} {
49    destroy .b1
50    list [catch {button .b1 -bitmap @xyzzy} msg] $msg
51} {1 {error reading bitmap file "xyzzy"}}
52
53test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap {
54    set x questhead
55    destroy .b1 .b2 .b3
56    button .b1 -bitmap $x
57    button .b3 -bitmap $x
58    button .b2 -bitmap $x
59    set result {}
60    lappend result [testbitmap questhead]
61    destroy .b1
62    lappend result [testbitmap questhead]
63    destroy .b2
64    lappend result [testbitmap questhead]
65    destroy .b3
66    lappend result [testbitmap questhead]
67} {{{3 1}} {{2 1}} {{1 1}} {}}
68
69test bitmap-4.1 {FreeBitmapObjProc} testbitmap {
70    destroy .b
71    set x [format questhead]
72    button .b -bitmap $x
73    set y [format questhead]
74    .b configure -bitmap $y
75    set z [format questhead]
76    .b configure -bitmap $z
77    set result {}
78    lappend result [testbitmap questhead]
79    set x red
80    lappend result [testbitmap questhead]
81    set z 32
82    lappend result [testbitmap questhead]
83    destroy .b
84    lappend result [testbitmap questhead]
85    set y bogus
86    set result
87} {{{1 3}} {{1 2}} {{1 1}} {}}
88
89destroy .t
90
91# cleanup
92cleanupTests
93return
94