Update to tcltest2

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