summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authormdejong <mdejong>2002-11-14 17:30:19 (GMT)
committermdejong <mdejong>2002-11-14 17:30:19 (GMT)
commit2d7b26ed587e5aa1455b7f830ba1a6a3230c4793 (patch)
tree4e58850a8e36ff740a8a9f9b2180617c7a875455 /tests
parent89ae849b757a275e85ad9a774a19efafda5da08b (diff)
downloadtk-2d7b26ed587e5aa1455b7f830ba1a6a3230c4793.zip
tk-2d7b26ed587e5aa1455b7f830ba1a6a3230c4793.tar.gz
tk-2d7b26ed587e5aa1455b7f830ba1a6a3230c4793.tar.bz2
* generic/tkWindow.c (Tk_DestroyWindow,
DeleteWindowsExitProc): Add TkHalfdeadWindow type and halfdeadWindowList to keep track of windows that were only partially deallocated before a call to exit. Finnish cleaning up these windows in DeleteWindowsExitProc. Keep track of cleanup status in Tk_DestroyWindow so that a window with a Destroy binding which calls exit will get fully destroyed. * tests/window.test: Add Tk_DestroyWindow tests for an assortment of half dead window cases. [Bug 630533]
Diffstat (limited to 'tests')
-rw-r--r--tests/window.test159
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]]