summaryrefslogtreecommitdiffstats
path: root/tests/winWm.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winWm.test')
-rw-r--r--tests/winWm.test321
1 files changed, 198 insertions, 123 deletions
diff --git a/tests/winWm.test b/tests/winWm.test
index 933d09e..ad4988d 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,37 +9,26 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-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
@@ -47,40 +36,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
@@ -91,10 +87,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
@@ -106,12 +104,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
@@ -123,13 +123,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
@@ -143,11 +145,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
@@ -161,13 +168,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
@@ -178,18 +202,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
@@ -204,11 +231,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
@@ -226,29 +254,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
@@ -258,72 +298,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
@@ -331,9 +393,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
@@ -342,10 +408,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
@@ -353,20 +422,26 @@ 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? image1 ?image2 ...?"}}
-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? image1 ?image2 ...?"}
+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 {}
test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup {
proc winwm90click {w} {
@@ -396,7 +471,6 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai
pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]]
bind $w.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}}
}
- destroy .t
global winwm90done
set winwm90done wait
toplevel .t
@@ -411,7 +485,7 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai
rename winwm90$cmd {}
}
destroy .tx .t .sd
-} -result {ok}
+} -result {ok}
test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup {
proc winwm91click {w} {
@@ -465,7 +539,7 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup
frame .t.f -background blue -height 200 -width 200
frame .t.f.x -background red -height 100 -width 100
} -body {
- pack .t.f.x
+ pack .t.f.x
pack .t.f
lappend aid [after 2000 {set ::winwm92 timeout}] [after 100 {
wm manage .t.f
@@ -488,7 +562,7 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup
set winwm92
} -cleanup {
destroy .t.f.x .t.f .t
- unset -nocomplain winwm92 aid
+ unset -nocomplain winwm92 aid id
} -result ok
destroy .t
@@ -500,3 +574,4 @@ return
# Local variables:
# mode: tcl
# End:
+