summaryrefslogtreecommitdiffstats
path: root/tests/bitmap.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/bitmap.test')
-rw-r--r--tests/bitmap.test84
1 files changed, 52 insertions, 32 deletions
diff --git a/tests/bitmap.test b/tests/bitmap.test
index 3186cad..9a27b55 100644
--- a/tests/bitmap.test
+++ b/tests/bitmap.test
@@ -6,57 +6,73 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bitmap.test,v 1.6 2004/06/17 22:38:57 dkf Exp $
+# RCS: @(#) $Id: bitmap.test,v 1.7 2008/07/22 11:55:57 aniap Exp $
-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]
@@ -64,10 +80,13 @@ 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
+test bitmap-4.1 {FreeBitmapObjProc} -constraints {
+ testbitmap
+} -body {
set x [format questhead]
button .b -bitmap $x
set y [format questhead]
@@ -83,10 +102,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