Update to tcltest2

1 files changed, 200 insertions, 120 deletions

diff --git a/tests/winWm.test b/tests/winWm.test
index 13ab984..5267b28 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,39 +9,28 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winWm.test,v 1.19 2008/07/23 23:24:24 nijtmans Exp $
+# RCS: @(#) $Id: winWm.test,v 1.20 2008/08/30 21:52:26 aniap Exp $
 
-package require tcltest 2.1
-eval tcltest::configure $argv
+package require tcltest 2.2
+namespace import ::tcltest::*
+tcltest::configure {*}$argv
 tcltest::loadTestedCommands
 
-# Measure the height of a single menu line
 
-toplevel .t
-frame .t.f -width 100 -height 50
-pack .t.f
-menu .t.m
-.t.m add command -label "thisisreallylong"
-.t configure -menu .t.m
-wm geometry .t -0-0
-update
-set menuheight [winfo y .t]
-.t.m add command -label "thisisreallylong"
-wm geometry .t -0-0
-update
-set menuheight [expr {$menuheight - [winfo y .t]}]
-destroy .t
-
-test winWm-1.1 {TkWmMapWindow} win {
+test winWm-1.1 {TkWmMapWindow} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm override .t 1
     wm geometry .t +0+0
     update
-    set result [list [winfo rootx .t] [winfo rooty .t]]
+    list [winfo rootx .t] [winfo rooty .t]
+} -cleanup {
     destroy .t
-    set result
-} {0 0}
-test winWm-1.2 {TkWmMapWindow} win {
+} -result {0 0}
+test winWm-1.2 {TkWmMapWindow} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm transient .t .
     update
@@ -49,40 +38,47 @@ test winWm-1.2 {TkWmMapWindow} win {
     update
     wm deiconify .
     update
-    catch {wm iconify .t} msg
+    wm iconify .t
+} -cleanup {
     destroy .t
-    set msg
-} {can't iconify ".t": it is a transient}
-test winWm-1.3 {TkWmMapWindow} win {
+} -returnCodes error -result {can't iconify ".t": it is a transient}
+test winWm-1.3 {TkWmMapWindow} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     update
     toplevel .t2
     update
-    set result [expr {[winfo x .t] != [winfo x .t2]}]
+    expr {[winfo x .t] != [winfo x .t2]}
+} -cleanup {
     destroy .t .t2
-    set result
-} 1
-test winWm-1.4 {TkWmMapWindow} win {
+} -result 1
+test winWm-1.4 {TkWmMapWindow} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm geometry .t +10+10
     update
     toplevel .t2
     wm geometry .t2 +40+10
     update
-    set result [list [winfo x .t] [winfo x .t2]]
+    list [winfo x .t] [winfo x .t2]
+} -cleanup {
     destroy .t .t2
-    set result
-} {10 40}
-test winWm-1.5 {TkWmMapWindow} win {
+} -result {10 40}
+test winWm-1.5 {TkWmMapWindow} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm iconify .t
     update
-    set result [wm state .t]
-    destroy .t
-    set result
-} iconic
+    wm state .t
+} -result {iconic}
+
 
-test winWm-2.1 {TkpWmSetState} win {
+test winWm-2.1 {TkpWmSetState} -constraints win -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -93,10 +89,12 @@ test winWm-2.1 {TkpWmSetState} win {
     wm deiconify .t
     update
     lappend result [wm state .t]
+} -cleanup {
+    destroy .t
+} -result {normal iconic normal}
+test winWm-2.2 {TkpWmSetState} -constraints win -setup {
     destroy .t
-    set result
-} {normal iconic normal}
-test winWm-2.2 {TkpWmSetState} win {
+} -body {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -108,12 +106,14 @@ test winWm-2.2 {TkpWmSetState} win {
     update
     lappend result [wm state .t]
     wm deiconify .t
-    update 
+    update
     lappend result [wm state .t]
+} -cleanup {
+    destroy .t
+} -result {normal withdrawn iconic normal}
+test winWm-2.3 {TkpWmSetState} -constraints win -setup {
     destroy .t
-    set result
-} {normal withdrawn iconic normal}
-test winWm-2.3 {TkpWmSetState} win {
+} -body {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -125,13 +125,15 @@ test winWm-2.3 {TkpWmSetState} win {
     update
     lappend result [wm state .t]
     wm state .t normal
-    update 
+    update
     lappend result [wm state .t]
+} -cleanup {
+    destroy .t
+} -result {normal withdrawn iconic normal}
+test winWm-2.4 {TkpWmSetState} -constraints win -setup {
     destroy .t
-    set result
-} {normal withdrawn iconic normal}
-test winWm-2.4 {TkpWmSetState} win {
     set result {}
+} -body {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -145,11 +147,16 @@ test winWm-2.4 {TkpWmSetState} win {
     wm deiconify .t
     update
     lappend result [list [wm state .t] [wm geometry .t]]
+} -cleanup {
     destroy .t
-    set result
-} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
+} -result {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
 
-test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
+
+test winWm-3.1 {ConfigureTopLevel: window geometry propagation} -constraints {
+    win
+} -setup {
+    destroy .t
+} -body {
     toplevel .t
     wm geometry .t +0+0
     button .t.b
@@ -163,13 +170,30 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
     update
     pack .t.b
     update
-    set x [expr {$x == [winfo x .t.b]}]
+    expr {$x == [winfo x .t.b]}
+} -cleanup {
+    destroy .t
+} -result 1
+
+
+test winWm-4.1 {ConfigureTopLevel: menu resizing} -constraints win -setup {
+    destroy .t
+} -body {
+    toplevel .t
+    frame .t.f -width 100 -height 50
+    pack .t.f
+    menu .t.m
+    .t.m add command -label "thisisreallylong"
+    .t configure -menu .t.m
+    wm geometry .t -0-0
+    update
+    set menuheight [winfo y .t]
+    .t.m add command -label "thisisreallylong"
+    wm geometry .t -0-0
+    update
+    set menuheight [expr {$menuheight - [winfo y .t]}]
     destroy .t
-    set x
-} 1
 
-test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
-    set result {}
     toplevel .t
     frame .t.f -width 150 -height 50 -background red
     pack .t.f
@@ -180,18 +204,21 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
     .t.m add command -label foo
     .t configure -menu .t.m
     update
-    set result [expr {$y - [winfo y .t]}]
+    expr {$y - [winfo y .t]  eq  $menuheight + 1}
+} -cleanup {
     destroy .t
-    set result
-} [expr {$menuheight + 1}]
+} -result 1
+
 
 # This test works on 8.0p2 but has not worked on anything since 8.2.
 # It would be very strange to have a windows application increase the size
 # of the clientarea when a menu wraps so I believe this test to be wrong.
 # Original result was {50 50 50} new result may depend on the default menu
 # font
-test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
+test winWm-5.1 {UpdateGeometryInfo: menu resizing} -constraints win -setup {
+    destroy .t
     set result {}
+} -body {
     toplevel .t
     frame .t.f -width 150 -height 50 -background red
     pack .t.f
@@ -206,11 +233,12 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     .t.m add command -label "thisisreallylong"
     update
     lappend result [winfo height .t]
+} -cleanup {
+    destroy .t
+} -result {50 50 31}
+test winWm-5.2 {UpdateGeometryInfo: menu resizing} -constraints win -setup {
     destroy .t
-    
-    set result
-} {50 50 31}
-test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
+} -body {
     set result {}
     toplevel .t
     frame .t.f -width 150 -height 50 -background red
@@ -228,29 +256,41 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
     lappend result [winfo height .t]
     lappend result [expr {$y - [winfo rooty .t]}]
     destroy .t
-    set result
-} {50 50 0}
+    return $result
+} -cleanup {
+    destroy .t
+} -result {50 50 0}
 
-test winWm-6.1 {wm attributes} win {
+test winWm-6.1 {wm attributes} -constraints win -setup {
     destroy .t
+} -body {
     toplevel .t
     wm attributes .t
-} {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0}
-test winWm-6.2 {wm attributes} win {
+} -cleanup {
+    destroy .t
+} -result {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0}
+test winWm-6.2 {wm attributes} -constraints win -setup {
     destroy .t
+} -body {
     toplevel .t
     wm attributes .t -disabled
-} {0}
-test winWm-6.3 {wm attributes} win {
-    # This isn't quite the correct error message yet, but it works.
+} -cleanup {
+    destroy .t
+} -result {0}
+test winWm-6.3 {wm attributes} -constraints win -setup {
     destroy .t
+} -body {
+    # This isn't quite the correct error message yet, but it works.
     toplevel .t
-    list [catch {wm attributes .t -foo} msg] $msg
-} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
+    wm attributes .t -foo
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}
 
-test winWm-6.4 {wm attributes -alpha} win {
-    # Expect this to return all 1.0 {} on pre-2K/XP
+test winWm-6.4 {wm attributes -alpha} -constraints win -setup {
     destroy .t
+} -body {
+    # Expect this to return all 1.0 {} on pre-2K/XP
     toplevel .t
     set res [wm attributes .t -alpha]
     # we don't return on set yet
@@ -260,72 +300,94 @@ test winWm-6.4 {wm attributes -alpha} win {
     lappend res [wm attributes .t -alpha]
     lappend res [wm attributes .t -alpha 100]
     lappend res [wm attributes .t -alpha]
-    set res
-} {1.0 {} 0.5 {} 0.0 {} 1.0}
+    return $res
+} -cleanup {
+    destroy .t
+} -result {1.0 {} 0.5 {} 0.0 {} 1.0}
 
-test winWm-6.5 {wm attributes -alpha} win {
+test winWm-6.5 {wm attributes -alpha} -constraints win -setup {
     destroy .t
+} -body {
     toplevel .t
-    list [catch {wm attributes .t -alpha foo} msg] $msg
-} {1 {expected floating-point number but got "foo"}}
+    wm attributes .t -alpha foo
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {expected floating-point number but got "foo"}
 
-test winWm-6.6 {wm attributes -alpha} win {
-    # This test is just to show off -alpha
+test winWm-6.6 {wm attributes -alpha} -constraints win -setup {
     destroy .t
+} -body {
+    # This test is just to show off -alpha
     toplevel .t
     wm attributes .t -alpha 0.2
     pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"]
     tk::PlaceWindow .t center
     update
     if {$::tcl_platform(osVersion) >= 5.0} {
-	for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} {
-	    wm attributes .t -alpha $i
-	    update idle
-	    after 20
-	}
-	for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} {
-	    wm attributes .t -alpha $i
-	    update idle
-	    after 20
-	}
+    for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} {
+        wm attributes .t -alpha $i
+        update idle
+        after 20
+    }
+    for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} {
+        wm attributes .t -alpha $i
+        update idle
+        after 20
+    }
     }
-} {}
+} -cleanup {
+    destroy .t
+} -result {}
 
-test winWm-6.7 {wm attributes -transparentcolor} win {
-    # Expect this to return all "" on pre-2K/XP
+test winWm-6.7 {wm attributes -transparentcolor} -constraints win -setup {
     destroy .t
-    toplevel .t
     set res {}
+} -body {
+    # Expect this to return all "" on pre-2K/XP
+    toplevel .t
     lappend res [wm attributes .t -transparentcolor]
     # we don't return on set yet
     lappend res [wm attributes .t -trans black]
     lappend res [wm attributes .t -trans]
     lappend res [wm attributes .t -trans "#FFFFFF"]
     lappend res [wm attributes .t -trans]
+} -cleanup {
     destroy .t
-    set res
-} [list {} {} black {} "#FFFFFF"]
+} -result [list {} {} black {} "#FFFFFF"]
 
-test winWm-6.8 {wm attributes -transparentcolor} win {
+test winWm-6.8 {wm attributes -transparentcolor} -constraints win -setup {
+    destroy .t
+} -body {
     destroy .t
     toplevel .t
-    list [catch {wm attributes .t -tr foo} msg] $msg
-} {1 {unknown color name "foo"}}
+    wm attributes .t -tr foo
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {unknown color name "foo"}
 
-test winWm-7.1 {deiconify on an unmapped toplevel\
-        will raise the window and set the focus} win {
+
+test winWm-7.1 {deiconify on an unmapped toplevel will raise \
+        the window and set the focus} -constraints {
+    win
+} -setup {
     destroy .t
+} -body {
     toplevel .t
     lower .t
     focus -force .
     wm deiconify .t
     update
     list [wm stackorder .t isabove .] [focus]
-} {1 .t}
+} -cleanup {
+    destroy .t
+} -result {1 .t}
 
 test winWm-7.2 {deiconify on an already mapped toplevel\
-        will raise the window and set the focus} win {
+        will raise the window and set the focus} -constraints {
+    win
+} -setup {
     destroy .t
+} -body {
     toplevel .t
     lower .t
     update
@@ -333,9 +395,13 @@ test winWm-7.2 {deiconify on an already mapped toplevel\
     wm deiconify .t
     update
     list [wm stackorder .t isabove .] [focus]
-} {1 .t}
+} -cleanup {
+    destroy .t
+} -result {1 .t}
 
-test winWm-7.3 {UpdateWrapper must maintain Z order} win {
+test winWm-7.3 {UpdateWrapper must maintain Z order} -constraints win -setup {
+    destroy .t
+} -body {
     destroy .t
     toplevel .t
     lower .t
@@ -344,10 +410,13 @@ test winWm-7.3 {UpdateWrapper must maintain Z order} win {
     wm resizable .t 0 0
     update
     list $res [wm stackorder .t isbelow .]
-} {1 1}
+} -cleanup {
+    destroy .t
+} -result {1 1}
 
-test winWm-7.4 {UpdateWrapper must maintain focus} win {
+test winWm-7.4 {UpdateWrapper must maintain focus} -constraints win -setup {
     destroy .t
+} -body {
     toplevel .t
     focus -force .t
     update
@@ -355,23 +424,34 @@ test winWm-7.4 {UpdateWrapper must maintain focus} win {
     wm resizable .t 0 0
     update
     list $res [focus]
-} {.t .t}
+} -cleanup {
+    destroy .t
+} -result {.t .t}
 
-test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win {
-    list [catch {wm iconph .} msg] $msg
-} {1 {wrong # args: should be "wm iconphoto window ?-default? image ?image ...?"}}
-test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win {
+
+test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -body {
+    wm iconph .
+} -returnCodes error -result {wrong # args: should be "wm iconphoto window ?-default? image ?image ...?"}
+test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -setup {
     destroy .t
+} -body {
     toplevel .t
     image create photo blank16 -width 16 -height 16
     image create photo blank32 -width 32 -height 32
     # This should just make blank icons for the window
     wm iconphoto .t blank16 blank32
     image delete blank16 blank32
-} {}
+} -cleanup {
+    destroy .t
+} -result {}
 
 destroy .t
 
 # cleanup
 cleanupTests
 return
+
+# Local variables:
+# mode: tcl
+# End:
+