diff options
Diffstat (limited to 'tk8.6/tests/winfo.test')
| -rw-r--r-- | tk8.6/tests/winfo.test | 485 |
1 files changed, 485 insertions, 0 deletions
diff --git a/tk8.6/tests/winfo.test b/tk8.6/tests/winfo.test new file mode 100644 index 0000000..14c2838 --- /dev/null +++ b/tk8.6/tests/winfo.test @@ -0,0 +1,485 @@ +# This file is a Tcl script to test out the "winfo" command. It is +# organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv +tcltest::loadTestedCommands + +# eatColors -- +# Creates a toplevel window and allocates enough colors in it to +# use up all the slots in the colormap. +# +# Arguments: +# w - Name of toplevel window to create. +# options - Options for w, such as "-colormap new". + +proc eatColors {w {options ""}} { + destroy $w + eval toplevel $w $options + wm geom $w +0+0 + canvas $w.c -width 400 -height 200 -bd 0 + pack $w.c + for {set y 0} {$y < 8} {incr y} { + for {set x 0} {$x < 40} {incr x} { + set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] + $w.c create rectangle [expr 10*$x] [expr 20*$y] \ + [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + -fill $color + } + } + update +} + +# XXX - This test file is woefully incomplete. At present, only a +# few of the winfo options are tested. + +# ---------------------------------------------------------------------- + +test winfo-1.1 {"winfo atom" command} -body { + winfo atom +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.2 {"winfo atom" command} -body { + winfo atom a b +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.3 {"winfo atom" command} -body { + winfo atom a b c d +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.4 {"winfo atom" command} -body { + winfo atom -displayof geek foo +} -returnCodes error -result {bad window path name "geek"} +test winfo-1.5 {"winfo atom" command} -body { + winfo atom PRIMARY +} -result 1 +test winfo-1.6 {"winfo atom" command} -body { + winfo atom -displayof . PRIMARY +} -result 1 + + +test winfo-2.1 {"winfo atomname" command} -body { + winfo atomname +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.2 {"winfo atomname" command} -body { + winfo atomname a b +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.3 {"winfo atomname" command} -body { + winfo atomname a b c d +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.4 {"winfo atomname" command} -body { + winfo atomname -displayof geek foo +} -returnCodes error -result {bad window path name "geek"} +test winfo-2.5 {"winfo atomname" command} -body { + winfo atomname 44215 +} -returnCodes error -result {no atom exists with id "44215"} +test winfo-2.6 {"winfo atomname" command} -body { + winfo atomname 2 +} -result SECONDARY +test winfo-2.7 {"winfo atom" command} -body { + winfo atomname -displayof . 2 +} -result SECONDARY + + +test winfo-3.1 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull +} -returnCodes error -result {wrong # args: should be "winfo colormapfull window"} +test winfo-3.2 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull a b +} -returnCodes error -result {wrong # args: should be "winfo colormapfull window"} +test winfo-3.3 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull foo +} -returnCodes error -result {bad window path name "foo"} +test winfo-3.4 {"winfo colormapfull" command} -constraints { + unix defaultPseudocolor8 +} -body { + eatColors .t {-colormap new} + set result [list [winfo colormapfull .] [winfo colormapfull .t]] + .t.c delete 34 + lappend result [winfo colormapfull .t] + .t.c create rectangle 30 30 80 80 -fill #441739 + lappend result [winfo colormapfull .t] + .t.c create rectangle 40 40 90 90 -fill #ffeedd + lappend result [winfo colormapfull .t] + destroy .t.c + lappend result [winfo colormapfull .t] +} -cleanup { + destroy .t +} -result {0 1 0 0 1 0} + + + +test winfo-4.1 {"winfo containing" command} -body { + winfo containing 22 +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.2 {"winfo containing" command} -body { + winfo containing a b c +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.3 {"winfo containing" command} -body { + winfo containing a b c d e +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.4 {"winfo containing" command} -body { + winfo containing -displayof geek 25 30 +} -returnCodes error -result {bad window path name "geek"} +test winfo-4.5 {"winfo containing" command} -body { +} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + + raise .t + winfo containing [winfo rootx .t.f] [winfo rooty .t.f] +} -cleanup { + destroy .t +} -result .t.f +test winfo-4.6 {"winfo containing" command} -constraints { + nonPortable +} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + + winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1] +} -cleanup { + destroy .t +} -result .t +test winfo-4.7 {"winfo containing" command} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + + set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \ + [expr [winfo rooty .t.f]+450]] + expr {($x == ".") || ($x == "")} +} -cleanup { + destroy .t +} -result {1} + + +test winfo-5.1 {"winfo interps" command} -body { + winfo interps a +} -returnCodes error -result {wrong # args: should be "winfo interps ?-displayof window?"} +test winfo-5.2 {"winfo interps" command} -body { + winfo interps a b c +} -returnCodes error -result {wrong # args: should be "winfo interps ?-displayof window?"} +test winfo-5.3 {"winfo interps" command} -body { + winfo interps -displayof geek +} -returnCodes error -result {bad window path name "geek"} +test winfo-5.4 {"winfo interps" command} -constraints unix -body { + expr {[lsearch -exact [winfo interps] [tk appname]] >= 0} +} -result {1} +test winfo-5.5 {"winfo interps" command} -constraints unix -body { + expr {[lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0} +} -result {1} + + +test winfo-6.1 {"winfo exists" command} -body { + winfo exists +} -returnCodes error -result {wrong # args: should be "winfo exists window"} +test winfo-6.2 {"winfo exists" command} -body { + winfo exists a b +} -returnCodes error -result {wrong # args: should be "winfo exists window"} +test winfo-6.3 {"winfo exists" command} -body { + winfo exists gorp +} -result {0} +test winfo-6.4 {"winfo exists" command} -body { + winfo exists . +} -result {1} +test winfo-6.5 {"winfo exists" command} -setup { + destroy .b +} -body { + button .b -text "Test button" + set x [winfo exists .b] + pack .b + update + bind .b <Destroy> {lappend x [winfo exists .x]} + destroy .b + lappend x [winfo exists .x] +} -result {1 0 0} + + +test winfo-7.1 {"winfo pathname" command} -body { + winfo pathname +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.2 {"winfo pathname" command} -body { + winfo pathname a b +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.3 {"winfo pathname" command} -body { + winfo pathname a b c d +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.4 {"winfo pathname" command} -body { + winfo pathname -displayof geek 25 +} -returnCodes error -result {bad window path name "geek"} +test winfo-7.5 {"winfo pathname" command} -body { + winfo pathname xyz +} -returnCodes error -result {expected integer but got "xyz"} +test winfo-7.6 {"winfo pathname" command} -body { + winfo pathname 224 +} -returnCodes error -result {window id "224" doesn't exist in this application} +test winfo-7.7 {"winfo pathname" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { + winfo pathname -displayof .b [winfo id .] +} -cleanup { + destroy .b +} -result {.} +test winfo-7.8 {"winfo pathname" command} -constraints { + unix testwrapper +} -body { + winfo pathname [testwrapper .] +} -result {} + + +test winfo-8.1 {"winfo pointerx" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { + catch [winfo pointerx .b] +} -body { + catch [winfo pointerx .b] +} -result 1 +test winfo-8.2 {"winfo pointery" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { + catch [winfo pointery .b] +} -body { + catch [winfo pointerx .b] +} -result 1 +test winfo-8.3 {"winfo pointerxy" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { + catch [winfo pointerxy .b] +} -body { + catch [winfo pointerx .b] +} -result 1 + + +test winfo-9.1 {"winfo viewable" command} -body { + winfo viewable +} -returnCodes error -result {wrong # args: should be "winfo viewable window"} +test winfo-9.2 {"winfo viewable" command} -body { + winfo viewable foo +} -returnCodes error -result {bad window path name "foo"} +test winfo-9.3 {"winfo viewable" command} -body { + winfo viewable . +} -result {1} +test winfo-9.4 {"winfo viewable" command} -body { + wm iconify . + winfo viewable . +} -cleanup { + wm deiconify . +} -result {0} +test winfo-9.5 {"winfo viewable" command} -setup { + deleteWindows +} -body { + frame .f1 -width 100 -height 100 -relief raised -bd 2 + place .f1 -x 0 -y 0 + frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + place .f1.f2 -x 0 -y 0 + update + list [winfo viewable .f1] [winfo viewable .f1.f2] +} -cleanup { + deleteWindows +} -result {1 1} +test winfo-9.6 {"winfo viewable" command} -setup { + deleteWindows +} -body { + frame .f1 -width 100 -height 100 -relief raised -bd 2 + frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + place .f1.f2 -x 0 -y 0 + update + list [winfo viewable .f1] [winfo viewable .f1.f2] +} -cleanup { + deleteWindows +} -result {0 0} +test winfo-9.7 {"winfo viewable" command} -setup { + deleteWindows +} -body { + frame .f1 -width 100 -height 100 -relief raised -bd 2 + place .f1 -x 0 -y 0 + frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + place .f1.f2 -x 0 -y 0 + update + wm iconify . + list [winfo viewable .f1] [winfo viewable .f1.f2] +} -cleanup { + wm deiconify . + deleteWindows +} -result {0 0} + + +test winfo-10.1 {"winfo visualid" command} -body { + winfo visualid +} -returnCodes error -result {wrong # args: should be "winfo visualid window"} +test winfo-10.2 {"winfo visualid" command} -body { + winfo visualid gorp +} -returnCodes error -result {bad window path name "gorp"} +test winfo-10.3 {"winfo visualid" command} -body { + expr {2 + [winfo visualid .] - [winfo visualid .]} +} -result {2} + + +test winfo-11.1 {"winfo visualid" command} -body { + winfo visualsavailable +} -returnCodes error -result {wrong # args: should be "winfo visualsavailable window ?includeids?"} +test winfo-11.2 {"winfo visualid" command} -body { + winfo visualsavailable gorp +} -returnCodes error -result {bad window path name "gorp"} +test winfo-11.3 {"winfo visualid" command} -body { + winfo visualsavailable . includeids foo +} -returnCodes error -result {wrong # args: should be "winfo visualsavailable window ?includeids?"} +test winfo-11.4 {"winfo visualid" command} -body { + llength [lindex [winfo visualsa .] 0] +} -result {2} +test winfo-11.5 {"winfo visualid" command} -body { + llength [lindex [winfo visualsa . includeids] 0] +} -result {3} +test winfo-11.6 {"winfo visualid" command} -body { + set x [lindex [lindex [winfo visualsa . includeids] 0] 2] + expr $x + 2 - $x +} -result {2} + + +test winfo-12.1 {GetDisplayOf procedure} -body { + winfo atom - foo x +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-12.2 {GetDisplayOf procedure} -body { + winfo atom -d bad_window x +} -returnCodes error -result {bad window path name "bad_window"} + + +# Some embedding tests +# +test winfo-13.1 {root coordinates of embedded toplevel} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update + + list rootx [expr {[winfo rootx .emb] == [winfo rootx .con]}] \ + rooty [expr {[winfo rooty .emb] == [winfo rooty .con]}] +} -cleanup { + deleteWindows +} -result {rootx 1 rooty 1} + +test winfo-13.2 {destroying embedded toplevel} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update + + destroy .emb + update + list embedded [winfo exists .emb.b] container [winfo exists .con] +} -cleanup { + deleteWindows +} -result {embedded 0 container 1} + +test winfo-13.3 {destroying container window} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update + + destroy .con + update + list child [winfo exists .emb.b] parent [winfo exists .emb] +} -cleanup { + deleteWindows +} -result {child 0 parent 0} + +test winfo-13.4 {[winfo containing] with embedded windows} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update + + button .b + pack .b -expand yes -fill both + update + string compare .emb.b \ + [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] +} -cleanup { + deleteWindows +} -result 0 + + +test winfo-14.1 {usage} -body { + winfo ismapped +} -returnCodes error -result {wrong # args: should be "winfo ismapped window"} + +test winfo-14.2 {usage} -body { + winfo ismapped . . +} -returnCodes error -result {wrong # args: should be "winfo ismapped window"} + +test winfo-14.3 {initially unmapped} -setup { + destroy .t +} -body { + toplevel .t + winfo ismapped .t +} -cleanup { + destroy .t +} -result 0 + +test winfo-14.4 {mapped at idle time} -setup { + destroy .t +} -body { + toplevel .t + update idletasks + winfo ismapped .t +} -cleanup { + destroy .t +} -result 1 + +deleteWindows +# cleanup +cleanupTests +return + +# Local variables: +# mode: tcl +# End: |