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: bitmap.test,v 1.3 2002/07/14 05:48:46 dgp Exp $
10
11package require tcltest 2.1
12namespace import -force tcltest::configure
13namespace import -force tcltest::testsDirectory
14configure -testdir [file join [pwd] [file dirname [info script]]]
15configure -loadfile [file join [testsDirectory] constraints.tcl]
16tcltest::loadTestedCommands
17
18testConstraint testbitmap [llength [info commands testbitmap]]
19
20test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap {
21    set x gray25
22    lindex $x 0
23    destroy .b1
24    button .b1 -bitmap $x
25    lindex $x 0
26    testbitmap gray25
27} {{1 0}}
28test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap {
29    set x gray25
30    destroy .b1 .b2
31    button .b1 -bitmap $x
32    destroy .b1
33    set result {}
34    lappend result [testbitmap gray25]
35    button .b2 -bitmap $x
36    lappend result [testbitmap gray25]
37} {{} {{1 1}}}
38test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap {
39    set x gray25
40    destroy .b1 .b2
41    button .b1 -bitmap $x
42    set result {}
43    lappend result [testbitmap gray25]
44    button .b2 -bitmap $x
45    pack .b1 .b2 -side top
46    lappend result [testbitmap gray25]
47} {{{1 1}} {{2 1}}}
48
49test bitmap-2.1 {Tk_GetBitmap procedure} {
50    destroy .b1
51    list [catch {button .b1 -bitmap bad_name} msg] $msg
52} {1 {bitmap "bad_name" not defined}}
53test bitmap-2.2 {Tk_GetBitmap procedure} {
54    destroy .b1
55    list [catch {button .b1 -bitmap @xyzzy} msg] $msg
56} {1 {error reading bitmap file "xyzzy"}}
57
58test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap {
59    set x questhead
60    destroy .b1 .b2 .b3
61    button .b1 -bitmap $x
62    button .b3 -bitmap $x
63    button .b2 -bitmap $x
64    set result {}
65    lappend result [testbitmap questhead]
66    destroy .b1
67    lappend result [testbitmap questhead]
68    destroy .b2
69    lappend result [testbitmap questhead]
70    destroy .b3
71    lappend result [testbitmap questhead]
72} {{{3 1}} {{2 1}} {{1 1}} {}}
73
74test bitmap-4.1 {FreeBitmapObjProc} testbitmap {
75    destroy .b
76    set x [format questhead]
77    button .b -bitmap $x
78    set y [format questhead]
79    .b configure -bitmap $y
80    set z [format questhead]
81    .b configure -bitmap $z
82    set result {}
83    lappend result [testbitmap questhead]
84    set x red
85    lappend result [testbitmap questhead]
86    set z 32
87    lappend result [testbitmap questhead]
88    destroy .b
89    lappend result [testbitmap questhead]
90    set y bogus
91    set result
92} {{{1 3}} {{1 2}} {{1 1}} {}}
93
94destroy .t
95
96# cleanup
97::tcltest::cleanupTests
98return
99
100
101
102
103
104
105
106
107
108
109
110
111
112