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