1 # This file is a Tcl script to test out the procedures in the file
2 # tkId.c, which recycle X resource identifiers. It is organized in
3 # the standard fashion for Tcl tests.
5 # Copyright (c) 1995 Sun Microsystems, Inc.
6 # Copyright (c) 1998-1999 by Scriptics Corporation.
11 if {[lsearch [namespace children] ::tcltest] == -1} {
12 source [file join [pwd] [file dirname [info script]] defs.tcl]
15 if {[string compare testwrapper [info commands testwrapper]] != 0} {
16 puts "This application hasn't been compiled with the testwrapper command,"
17 puts "therefore I am skipping all of these tests."
18 ::tcltest::cleanupTests
22 foreach i [winfo children .] {
28 test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} {
29 bind all <Destroy> {lappend x %W}
33 foreach i {a b c d e f g h i j k l m n o p q} {
34 toplevel .f.$i -height 50 -width 100
35 wm geometry .f.$i +$j+$j
38 set map([winfo id .f.$i]) .f.$i
39 set map([testwrapper .f.$i]) wrapper.f.$i
44 # Destroy events should have occurred for all windows.
45 set result [list [lsort $x]]
50 foreach i {a b c d e} {
52 frame $w -height 20 -width 100 -bd 2 -relief raised
54 if [info exists map([winfo id $w])] {
55 lappend reused $map([winfo id $w])
57 set map([winfo id $w]) $w
60 # No window ids should have been reused: stale Destroy events still
62 lappend result [lsort $reused]
64 # Wait a few seconds, then try again; ids should still not have
72 frame $w -height 20 -width 100 -bd 2 -relief raised
74 if [info exists map([winfo id $w])] {
75 lappend reused $map([winfo id $w])
77 set map([winfo id $w])] $w
80 # Ids should not yet have been reused.
81 lappend result [lsort $reused]
84 # Wait a few more seconds, to give ids enough time to be recycled.
88 foreach i {a b c d e f} {
90 frame $w -height 20 -width 100 -bd 2 -relief raised
92 if [info exists map([winfo id $w])] {
93 lappend reused $map([winfo id $w])
95 set map([winfo id $w])] $w
98 # Ids should be reused now, due to time delay. Destroy events should
99 # have been discarded.
100 lappend result [lsort $reused] [lsort $x]
101 } {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}}
102 bind all <Destroy> {}
105 ::tcltest::cleanupTests