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: id.test,v 1.6 2002/07/13 21:52:34 dgp Exp $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly testwrapper} { 19 bind all <Destroy> {lappend x %W} 20 catch {unset map} 21 frame .f 22 set j 0 23 foreach i {a b c d e f g h i j k l m n o p q} { 24 toplevel .f.$i -height 50 -width 100 25 wm geometry .f.$i +$j+$j 26 incr j 10 27 update 28 set map([winfo id .f.$i]) .f.$i 29 set map([testwrapper .f.$i]) wrapper.f.$i 30 } 31 set x {} 32 destroy .f 33 34 # Destroy events should have occurred for all windows. 35 set result [list [lsort $x]] 36 37 set x {} 38 update idletasks 39 set reused {} 40 foreach i {a b c d e} { 41 set w .${i}2 42 frame $w -height 20 -width 100 -bd 2 -relief raised 43 pack $w 44 if [info exists map([winfo id $w])] { 45 lappend reused $map([winfo id $w]) 46 } 47 set map([winfo id $w]) $w 48 } 49 50 # No window ids should have been reused: stale Destroy events still 51 # pending in queue. 52 lappend result [lsort $reused] 53 54 # Wait a few seconds, then try again; ids should still not have 55 # been re-used. 56 57 set y 0 58 after 2000 {set y 1} 59 tkwait variable y 60 foreach i {a b c} { 61 set w .${i}3 62 frame $w -height 20 -width 100 -bd 2 -relief raised 63 pack $w 64 if [info exists map([winfo id $w])] { 65 lappend reused $map([winfo id $w]) 66 } 67 set map([winfo id $w])] $w 68 } 69 70 # Ids should not yet have been reused. 71 lappend result [lsort $reused] 72 73 74 # Wait a few more seconds, to give ids enough time to be recycled. 75 set y 0 76 after 6000 {set y 1} 77 tkwait variable y 78 foreach i {a b c d e f} { 79 set w .${i}4 80 frame $w -height 20 -width 100 -bd 2 -relief raised 81 pack $w 82 if [info exists map([winfo id $w])] { 83 lappend reused $map([winfo id $w]) 84 } 85 set map([winfo id $w])] $w 86 } 87 88 # Ids should be reused now, due to time delay. Destroy events should 89 # have been discarded. 90 lappend result [lsort $reused] [lsort $x] 91} {{.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} {}} 92bind all <Destroy> {} 93 94# cleanup 95::tcltest::cleanupTests 96return 97 98 99 100 101 102 103 104 105 106 107 108 109 110