diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/window.test | 159 |
1 files changed, 158 insertions, 1 deletions
diff --git a/tests/window.test b/tests/window.test index 1325fab..51bacbc 100644 --- a/tests/window.test +++ b/tests/window.test @@ -5,11 +5,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: window.test,v 1.6 2002/07/13 20:28:36 dgp Exp $ +# RCS: @(#) $Id: window.test,v 1.7 2002/11/14 17:30:20 mdejong Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory +namespace import -force tcltest::interpreter +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands @@ -77,6 +80,160 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { destroy .f } {} +test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} \ + unixOrWin { + set script [makeFile { + update + bind . <Destroy> exit + destroy . + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {}} + +test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} \ + unixOrWin { + set script [makeFile { + toplevel .t + update + bind .t <Destroy> exit + destroy .t + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {}} + +test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} \ + unixOrWin { + set script [makeFile { + toplevel .t + update + bind .t <Destroy> exit + destroy . + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {}} + +test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} \ + unixOrWin { + set script [makeFile { + toplevel .t + toplevel .t.f + update + bind .t.f <Destroy> exit + destroy . + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {}} + +test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} \ + unixOrWin { + set script [makeFile { + toplevel .t1 + toplevel .t2 + toplevel .t3 + update + bind .t3 <Destroy> {destroy .t2} + bind .t2 <Destroy> {destroy .t1} + bind .t1 <Destroy> {exit 0} + destroy .t3 + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {}} + +test window-2.9 {Tk_DestroyWindow, Destroy bindings + evaluated after exit} unixOrWin { + set script [makeFile { + toplevel .t1 + toplevel .t2 + update + bind .t2 <Destroy> {puts "Destroy .t2" ; exit 1} + bind .t1 <Destroy> {puts "Destroy .t1" ; exit 0} + destroy .t2 + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {Destroy .t2 +Destroy .t1}} + +test window-2.10 {Tk_DestroyWindow, Destroy binding + evaluated once} unixOrWin { + set script [makeFile { + update + bind . <Destroy> { + puts "Destroy ." + bind . <Destroy> {puts "Re-Destroy ."} + exit 0 + } + destroy . + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 {Destroy .}} + +test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \ + unixOrWin { + set script [makeFile { + toplevel .t1 + toplevel .t2 + update + bind .t1 <Destroy> { + if {[catch {entry .t2.newchild}]} { + puts YES + } else { + puts NO + } + } + bind .t2 <Destroy> {exit} + destroy .t2 + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} {0 YES} + # Some tests require the testmenubar command testConstraint testmenubar [llength [info commands testmenubar]] |