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