summaryrefslogtreecommitdiffstats
path: root/tests/window.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/window.test')
-rw-r--r--tests/window.test131
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.
+} {}