summaryrefslogtreecommitdiffstats
path: root/tk8.6/tests/window.test
diff options
context:
space:
mode:
Diffstat (limited to 'tk8.6/tests/window.test')
-rw-r--r--tk8.6/tests/window.test351
1 files changed, 0 insertions, 351 deletions
diff --git a/tk8.6/tests/window.test b/tk8.6/tests/window.test
deleted file mode 100644
index fea695a..0000000
--- a/tk8.6/tests/window.test
+++ /dev/null
@@ -1,351 +0,0 @@
-# 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.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-
-package require tcltest 2.2
-namespace import ::tcltest::*
-tcltest::configure {*}$argv
-tcltest::loadTestedCommands
-namespace import ::tk::test::loadTkCommand
-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} -setup {
- destroy .t
-} -body {
- proc bgerror msg {
- global x errorInfo
- set x [list $msg $errorInfo]
- }
-
- set x unchanged
- 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
- set x
-} -cleanup {
- rename bgerror {}
-} -result {{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} -setup {
- destroy .t
-} -body {
- 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
-} -result {}
-test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup {
- destroy .t
-} -body {
- 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
-} -result {}
-test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup {
- destroy .f
-} -body {
- 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
-} -result {}
-
-test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- update
- bind . <Destroy> exit
- destroy .
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {}}
-
-test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t
- update
- bind .t <Destroy> exit
- destroy .t
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {}}
-
-test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t
- update
- bind .t <Destroy> exit
- destroy .
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {}}
-
-test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t
- toplevel .t.f
- update
- bind .t.f <Destroy> exit
- destroy .
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {}}
-
-test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t1
- toplevel .t2
- toplevel .t3
- update
- bind .t3 <Destroy> {destroy .t2}
- bind .t2 <Destroy> {destroy .t1}
- bind .t1 <Destroy> {exit 0}
- destroy .t3
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {}}
-
-test window-2.9 {Tk_DestroyWindow, Destroy bindings evaluated after exit} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t1
- toplevel .t2
- update
- bind .t2 <Destroy> {puts "Destroy .t2" ; exit 1}
- bind .t1 <Destroy> {puts "Destroy .t1" ; exit 0}
- destroy .t2
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {Destroy .t2
-Destroy .t1}}
-
-test window-2.10 {Tk_DestroyWindow, Destroy binding evaluated once} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- update
- bind . <Destroy> {
- puts "Destroy ."
- bind . <Destroy> {puts "Re-Destroy ."}
- exit 0
- }
- destroy .
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 {Destroy .}}
-
-test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constraints {
- unixOrWin
-} -body {
- set code [loadTkCommand]
- append code {
- toplevel .t1
- toplevel .t2
- update
- bind .t1 <Destroy> {
- if {[catch {entry .t2.newchild}]} {
- puts YES
- } else {
- puts NO
- }
- }
- bind .t2 <Destroy> {exit}
- destroy .t2
- }
- set script [makeFile $code script]
- if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
- set error 1
- } else {
- set error 0
- }
- removeFile script
- list $error $msg
-} -result {0 YES}
-
-
-test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints {
- unix testmenubar
-} -setup {
- destroy .t
-} -body {
- 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.
-} -cleanup {
- destroy .t
-} -result {}
-test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints {
- unix testmenubar
-} -setup {
- destroy .t
-} -body {
- 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.
-} -cleanup {
- destroy .t
-} -result {}
-
-
-test window-4.1 {Tk_NameToWindow procedure} -constraints {
- testmenubar
-} -setup {
- destroy .t
-} -body {
- winfo geometry .t
-} -cleanup {
- destroy .t
-} -returnCodes error -result {bad window path name ".t"}
-test window-4.2 {Tk_NameToWindow procedure} -constraints {
- testmenubar
-} -setup {
- destroy .t
-} -body {
- frame .t -width 100 -height 50
- place .t -x 10 -y 10
- update
- winfo geometry .t
-} -cleanup {
- destroy .t
-} -returnCodes ok -result {100x50+10+10}
-
-
-test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints {
- unix testmenubar
-} -setup {
- destroy .t
-} -body {
- 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.
-} -cleanup {
- destroy .t
-} -result {}
-
-
-# cleanup
-cleanupTests
-return
-
-# Local variables:
-# mode: tcl
-# End: