Update to tcltest2

1 files changed, 99 insertions, 61 deletions

diff --git a/tests/border.test b/tests/border.test
index db1a5f7..0348959 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -5,51 +5,62 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: border.test,v 1.7 2004/12/04 00:04:40 dkf Exp $
+# RCS: @(#) $Id: border.test,v 1.8 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
 
-if {[testConstraint pseudocolor8]} {
-    toplevel .t -visual {pseudocolor 8} -colormap new
-    wm geom .t +0+0
-}
-
-test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} testborder {
+test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} -constraints {  
+    testborder 
+} -body {
     set x orange
     lindex $x 0
-    destroy .b1
     button .b1 -bg $x -text .b1
     lindex $x 0
     testborder orange
-} {{1 0}}
-test border-1.3 {Tk_AllocBorderFromObj - discard stale border} testborder {
+} -cleanup {
+    destroy .b1
+} -result {{1 0}}
+test border-1.2 {Tk_AllocBorderFromObj - discard stale border} -constraints {  
+    testborder 
+} -setup {
+    set result {}
+} -body {
     set x orange
-    destroy .b1 .b2
     button .b1 -bg $x -text First
     destroy .b1
-    set result {}
     lappend result [testborder orange]
     button .b2 -bg $x -text Second
     lappend result [testborder orange]
-} {{} {{1 1}}}
-test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} testborder {
-    set x orange
+} -cleanup {
     destroy .b1 .b2
-    button .b1 -bg $x -text First
+} -result {{} {{1 1}}}
+test border-1.3 {Tk_AllocBorderFromObj - reuse existing border} -constraints {  
+    testborder 
+} -setup {
     set result {}
+} -body {
+    set x orange
+    button .b1 -bg $x -text First
     lappend result [testborder orange]
     button .b2 -bg $x -text Second
     pack .b1 .b2 -side top
     lappend result [testborder orange]
-} {{{1 1}} {{2 1}}}
-test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor8 testborder} {
+} -cleanup {
+    destroy .b1 .b2
+} -result {{{1 1}} {{2 1}}}
+test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} -constraints {  
+    testborder pseudocolor8
+} -setup {
+    toplevel .t -visual {pseudocolor 8} -colormap new
+    wm geom .t +0+0
+    set result {}
+} -body {
     set x purple
-    destroy .b1 .b2 .t.b
     button .b1 -bg $x -text First
     pack .b1 -side top
-    set result {}
     lappend result [testborder purple]
     button .t.b -bg $x -text Second
     pack .t.b -side top
@@ -57,18 +68,24 @@ test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor
     button .b2 -bg $x -text Third
     pack .b2 -side top
     lappend result [testborder purple]
-} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+} -cleanup {
+    destroy .b1 .b2 .t
+} -result {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
 
-test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} {
+test border-2.1 {Tk_Free3DBorder - reference counts} -constraints {  
+    testborder pseudocolor8
+} -setup {
+    toplevel .t -visual {pseudocolor 8} -colormap new
+    wm geom .t +0+0
+    set result {}
+} -body {
     set x purple
-    destroy .b1 .b2 .t.b
     button .b1 -bg $x -text First
     pack .b1 -side top
     button .t.b -bg $x -text Second
     pack .t.b -side top
     button .b2 -bg $x -text Third
     pack .b2 -side top
-    set result {}
     lappend result [testborder purple]
     destroy .b1
     lappend result [testborder purple]
@@ -76,11 +93,18 @@ test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} {
     lappend result [testborder purple]
     destroy .t.b
     lappend result [testborder purple]
-} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
-test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder} {
-    destroy .b .t.b .t2 .t3
+} -cleanup {
+    destroy .b1 .b2 .t
+} -result {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints {  
+    testborder pseudocolor8
+} -setup {
+    toplevel .t -visual {pseudocolor 8} -colormap new
+    wm geom .t +0+0
     toplevel .t2 -visual {pseudocolor 8} -colormap new
     toplevel .t3 -visual {pseudocolor 8} -colormap new
+    set result {}
+} -body {
     set x purple
     button .b -bg $x -text .b1
     button .t.b1 -bg $x -text .t.b1
@@ -92,7 +116,6 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder
     button .t3.b2 -bg $x -text .t3.b2
     button .t3.b3 -bg $x -text .t3.b3
     button .t3.b4 -bg $x -text .t3.b4
-    set result {}
     lappend result [testborder purple]
     destroy .t2
     lappend result [testborder purple]
@@ -102,17 +125,21 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder
     lappend result [testborder purple]
     destroy .t
     lappend result [testborder purple]
-} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+} -cleanup {
+    destroy .b .t2 .t3 .t
+} -result {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
 
-test border-4.1 {FreeBorderObjProc} testborder {
-    destroy .b
+test border-3.1 {FreeBorderObjProc} -constraints {  
+    testborder 
+} -setup {
+    set result {}
+} -body {
     set x [format purple]
     button .b -bg $x -text .b1
     set y [format purple]
     .b configure -bg $y
     set z [format purple]
     .b configure -bg $z
-    set result {}
     lappend result [testborder purple]
     set x red
     lappend result [testborder purple]
@@ -121,42 +148,53 @@ test border-4.1 {FreeBorderObjProc} testborder {
     destroy .b
     lappend result [testborder purple]
     set y bogus
-    set result
-} {{{1 3}} {{1 2}} {{1 1}} {}}
+    return $result
+} -cleanup {
+    destroy .b
+} -result {{{1 3}} {{1 2}} {{1 1}} {}}
 
-catch {destroy .b}
-button .b
-test border-5.1 {Tk_GetReliefFromObj} {
-    .b configure -relief flat
+test border-4.1 {Tk_GetReliefFromObj} -body {
+    button .b -relief flat
     .b cget -relief
-} {flat}
-test border-5.2 {Tk_GetReliefFromObj} {
-    .b configure -relief groove
+} -cleanup {
+    destroy .b
+} -result {flat}
+test border-4.2 {Tk_GetReliefFromObj} -body {
+    button .b -relief groove
     .b cget -relief
-} {groove}
-test border-5.3 {Tk_GetReliefFromObj} {
-    .b configure -relief raised
+} -cleanup {
+    destroy .b
+} -result {groove}
+test border-4.3 {Tk_GetReliefFromObj} -body {
+    button .b -relief raised
     .b cget -relief
-} {raised}
-test border-5.4 {Tk_GetReliefFromObj} {
-    .b configure -relief ridge
+} -cleanup {
+    destroy .b
+} -result {raised}
+test border-4.4 {Tk_GetReliefFromObj} -body {
+    button .b -relief ridge
     .b cget -relief
-} {ridge}
-test border-5.5 {Tk_GetReliefFromObj} {
-    .b configure -relief solid
+} -cleanup {
+    destroy .b
+} -result {ridge}
+test border-4.5 {Tk_GetReliefFromObj} -body {
+    button .b -relief solid
     .b cget -relief
-} {solid}
-test border-5.6 {Tk_GetReliefFromObj} {
-    .b configure -relief sunken
+} -cleanup {
+    destroy .b
+} -result {solid}
+test border-4.6 {Tk_GetReliefFromObj} -body {
+    button .b -relief sunken
     .b cget -relief
-} {sunken}
-test border-5.7 {Tk_GetReliefFromObj - error} {
-    list [catch {.b configure -relief upanddown} msg] $msg
-} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}}
+} -cleanup {
+    destroy .b
+} -result {sunken}
+test border-4.7 {Tk_GetReliefFromObj - error} -body {
+    button .b -relief upanddown
+} -cleanup {
+    destroy .b
+} -returnCodes error -result {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}
 
-if {[testConstraint pseudocolor8]} {
-    destroy .t
-}
 
 # cleanup
 cleanupTests