diff options
Diffstat (limited to 'tests/window.test')
| -rw-r--r-- | tests/window.test | 131 |
1 files changed, 131 insertions, 0 deletions
diff --git a/tests/window.test b/tests/window.test new file mode 100644 index 0000000..aaa29c0 --- /dev/null +++ b/tests/window.test @@ -0,0 +1,131 @@ +# This file is a Tcl script to test the procedures in the file +# tkWindow.c. It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) window.test 1.8 97/01/22 14:17:54 + +if {[info procs test] != "test"} { + source defs +} + +foreach i [winfo children .] { + destroy $i +} +wm geometry . {} +raise . +update + +# XXX This file is woefully incomplete. Right now it only tests +# a few parts of a few procedures in tkWindow.c + +test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} { + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] + } + set x unchanged + catch {destroy .t} + frame .t -width 100 -height 50 + place .t -x 10 -y 10 + bind .t <Destroy> {button .t.b -text hello; pack .t.b} + update + destroy .t + update + rename bgerror {} + set x +} {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed + while executing +"button .t.b -text hello" + (command bound to event)}} + +# Most of the tests below don't produce meaningful results; they +# will simply dump core if there are bugs. + +test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} { + toplevel .t -width 300 -height 200 + wm geometry .t +0+0 + frame .t.f -width 200 -height 200 -relief raised -bd 2 + place .t.f -x 0 -y 0 + frame .t.f.f -width 100 -height 100 -relief raised -bd 2 + place .t.f.f -relx 1 -rely 1 -anchor se + bind .t.f <Destroy> {destroy .t} + update + destroy .t.f +} {} +test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} { + toplevel .t -width 300 -height 200 + wm geometry .t +0+0 + frame .t.f -width 200 -height 200 -relief raised -bd 2 + place .t.f -x 0 -y 0 + frame .t.f.f -width 100 -height 100 -relief raised -bd 2 + place .t.f.f -relx 1 -rely 1 -anchor se + bind .t.f.f <Destroy> {destroy .t} + update + destroy .t.f +} {} +test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { + frame .f -width 80 -height 120 -relief raised -bd 2 + place .f -relx 0.5 -rely 0.5 -anchor center + toplevel .f.t -width 300 -height 200 + wm geometry .f.t +0+0 + frame .f.t.f -width 200 -height 200 -relief raised -bd 2 + place .f.t.f -x 0 -y 0 + frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2 + place .f.t.f.f -relx 1 -rely 1 -anchor se + update + destroy .f +} {} + +test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { + catch {destroy .t} + toplevel .t -width 300 -height 200 + wm geometry .t +0+0 + pack [entry .t.e] + frame .t.f -bd 2 -relief raised + testmenubar window .t .t.f + update + # If stacking order isn't handle properly, generates an X error. +} {} +test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { + catch {destroy .t} + toplevel .t -width 300 -height 200 + wm geometry .t +0+0 + pack [entry .t.e] + pack [entry .t.e2] + update + frame .t.f -bd 2 -relief raised + raise .t.f .t.e + testmenubar window .t .t.f + update + # If stacking order isn't handled properly, generates an X error. +} {} + +test window-4.1 {Tk_NameToWindow procedure} { + catch {destroy .t} + list [catch {winfo geometry .t} msg] $msg +} {1 {bad window path name ".t"}} +test window-4.2 {Tk_NameToWindow procedure} { + catch {destroy .t} + frame .t -width 100 -height 50 + place .t -x 10 -y 10 + update + list [catch {winfo geometry .t} msg] $msg +} {0 100x50+10+10} + +test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly { + catch {destroy .t} + toplevel .t -width 300 -height 200 + wm geometry .t +0+0 + pack [entry .t.e] + pack [entry .t.e2] + frame .t.f -bd 2 -relief raised + testmenubar window .t .t.f + update + lower .t.e2 .t.f + update + # If stacking order isn't handled properly, generates an X error. +} {} |