* 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]

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]]