# This file is a Tcl script to test out the procedures in the file # tkId.c, which recycle X resource identifiers. It is organized in # the standard fashion for Tcl tests. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: id.test,v 1.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly testwrapper} { bind all {lappend x %W} catch {unset map} frame .f set j 0 foreach i {a b c d e f g h i j k l m n o p q} { toplevel .f.$i -height 50 -width 100 wm geometry .f.$i +$j+$j incr j 10 update set map([winfo id .f.$i]) .f.$i set map([testwrapper .f.$i]) wrapper.f.$i } set x {} destroy .f # Destroy events should have occurred for all windows. set result [list [lsort $x]] set x {} update idletasks set reused {} foreach i {a b c d e} { set w .${i}2 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w]) $w } # No window ids should have been reused: stale Destroy events still # pending in queue. lappend result [lsort $reused] # Wait a few seconds, then try again; ids should still not have # been re-used. set y 0 after 2000 {set y 1} tkwait variable y foreach i {a b c} { set w .${i}3 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w])] $w } # Ids should not yet have been reused. lappend result [lsort $reused] # Wait a few more seconds, to give ids enough time to be recycled. set y 0 after 6000 {set y 1} tkwait variable y foreach i {a b c d e f} { set w .${i}4 frame $w -height 20 -width 100 -bd 2 -relief raised pack $w if [info exists map([winfo id $w])] { lappend reused $map([winfo id $w]) } set map([winfo id $w])] $w } # Ids should be reused now, due to time delay. Destroy events should # have been discarded. lappend result [lsort $reused] [lsort $x] } {{.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} {}} bind all {} # cleanup ::tcltest::cleanupTests return