diff options
Diffstat (limited to 'tests/bitmap.test')
-rw-r--r-- | tests/bitmap.test | 88 |
1 files changed, 54 insertions, 34 deletions
diff --git a/tests/bitmap.test b/tests/bitmap.test index 6e2255c..6e2573f 100644 --- a/tests/bitmap.test +++ b/tests/bitmap.test @@ -6,55 +6,71 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap { +test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} -constraints { + testbitmap +} -body { set x gray25 - lindex $x 0 - destroy .b1 - button .b1 -bitmap $x + lindex $x 0 + button .b -bitmap $x lindex $x 0 testbitmap gray25 -} {{1 0}} -test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap { +} -cleanup { + destroy .b +} -result {{1 0}} +test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x gray25 - destroy .b1 .b2 button .b1 -bitmap $x destroy .b1 - set result {} lappend result [testbitmap gray25] button .b2 -bitmap $x lappend result [testbitmap gray25] -} {{} {{1 1}}} -test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap { - set x gray25 +} -cleanup { destroy .b1 .b2 - button .b1 -bitmap $x +} -result {{} {{1 1}}} +test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} -constraints { + testbitmap +} -setup { set result {} +} -body { + set x gray25 + button .b1 -bitmap $x lappend result [testbitmap gray25] button .b2 -bitmap $x pack .b1 .b2 -side top lappend result [testbitmap gray25] -} {{{1 1}} {{2 1}}} +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} -test bitmap-2.1 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap bad_name} msg] $msg -} {1 {bitmap "bad_name" not defined}} -test bitmap-2.2 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap @xyzzy} msg] $msg -} {1 {error reading bitmap file "xyzzy"}} +test bitmap-2.1 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap bad_name +} -cleanup { + destroy .b1 +} -returnCodes error -result {bitmap "bad_name" not defined} +test bitmap-2.2 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap @xyzzy +} -cleanup { + destroy .b1 +} -returnCodes error -result {error reading bitmap file "xyzzy"} -test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { +test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x questhead - destroy .b1 .b2 .b3 button .b1 -bitmap $x button .b3 -bitmap $x button .b2 -bitmap $x - set result {} lappend result [testbitmap questhead] destroy .b1 lappend result [testbitmap questhead] @@ -62,15 +78,18 @@ test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { lappend result [testbitmap questhead] destroy .b3 lappend result [testbitmap questhead] -} {{{3 1}} {{2 1}} {{1 1}} {}} +} -cleanup { + destroy .b1 .b2 .b3 ;# destroying just in case +} -result {{{3 1}} {{2 1}} {{1 1}} {}} -test bitmap-4.1 {FreeBitmapObjProc} testbitmap { - destroy .b - set x [format questhead] +test bitmap-4.1 {FreeBitmapObjProc} -constraints { + testbitmap +} -body { + set x [join questhead] button .b -bitmap $x - set y [format questhead] + set y [join questhead] .b configure -bitmap $y - set z [format questhead] + set z [join questhead] .b configure -bitmap $z set result {} lappend result [testbitmap questhead] @@ -81,10 +100,11 @@ test bitmap-4.1 {FreeBitmapObjProc} testbitmap { destroy .b lappend result [testbitmap questhead] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} -destroy .t # cleanup cleanupTests |