diff options
author | aniap <aniap@noemail.net> | 2008-08-30 21:52:25 (GMT) |
---|---|---|
committer | aniap <aniap@noemail.net> | 2008-08-30 21:52:25 (GMT) |
commit | 6b06ffeaf11d98016196a3ee172f6711daee60a9 (patch) | |
tree | 2b09e17e0659d453eeaf5dfc31c2a205148b5e91 /tests/winWm.test | |
parent | 86288e1661fd0022afe7a525db7558e1ca78ffc0 (diff) | |
download | tk-6b06ffeaf11d98016196a3ee172f6711daee60a9.zip tk-6b06ffeaf11d98016196a3ee172f6711daee60a9.tar.gz tk-6b06ffeaf11d98016196a3ee172f6711daee60a9.tar.bz2 |
Update to tcltest2
FossilOrigin-Name: 3e86dc471b4f1d8a189f5fb30a939774057b0cfb
Diffstat (limited to 'tests/winWm.test')
-rw-r--r-- | tests/winWm.test | 320 |
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: + |