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. 4# 5# Copyright (c) 1995 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id$ 10 11package require tcltest 2.1 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14 15test id-1.1 {WindowIdCleanup, delaying window release} {unix testwrapper} { 16 bind all <Destroy> {lappend x %W} 17 catch {unset map} 18 frame .f 19 set j 0 20 foreach i {a b c d e f g h i j k l m n o p q} { 21 toplevel .f.$i -height 50 -width 100 22 wm geometry .f.$i +$j+$j 23 incr j 10 24 update 25 set map([winfo id .f.$i]) .f.$i 26 set map([testwrapper .f.$i]) wrapper.f.$i 27 } 28 set x {} 29 destroy .f 30 31 # Destroy events should have occurred for all windows. 32 set result [list [lsort $x]] 33 34 set x {} 35 update idletasks 36 set reused {} 37 foreach i {a b c d e} { 38 set w .${i}2 39 frame $w -height 20 -width 100 -bd 2 -relief raised 40 pack $w 41 if [info exists map([winfo id $w])] { 42 lappend reused $map([winfo id $w]) 43 } 44 set map([winfo id $w]) $w 45 } 46 47 # No window ids should have been reused: stale Destroy events still 48 # pending in queue. 49 lappend result [lsort $reused] 50 51 # Wait a few seconds, then try again; ids should still not have 52 # been re-used. 53 54 set y 0 55 after 2000 {set y 1} 56 tkwait variable y 57 foreach i {a b c} { 58 set w .${i}3 59 frame $w -height 20 -width 100 -bd 2 -relief raised 60 pack $w 61 if [info exists map([winfo id $w])] { 62 lappend reused $map([winfo id $w]) 63 } 64 set map([winfo id $w])] $w 65 } 66 67 # Ids should not yet have been reused. 68 lappend result [lsort $reused] 69 70 71 # Wait a few more seconds, to give ids enough time to be recycled. 72 set y 0 73 after 6000 {set y 1} 74 tkwait variable y 75 foreach i {a b c d e f} { 76 set w .${i}4 77 frame $w -height 20 -width 100 -bd 2 -relief raised 78 pack $w 79 if [info exists map([winfo id $w])] { 80 lappend reused $map([winfo id $w]) 81 } 82 set map([winfo id $w])] $w 83 } 84 85 # Ids should be reused now, due to time delay. Destroy events should 86 # have been discarded. 87 lappend result [lsort $reused] [lsort $x] 88} {{.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} {}} 89bind all <Destroy> {} 90 91# cleanup 92cleanupTests 93return 94