开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
id.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：3k
源码类别：

通讯编程

开发平台：

Visual C++

id.test：源码内容
  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 $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. test 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
  34.     # Destroy events should have occurred for all windows.
  35.     set result [list [lsort $x]]
  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.     }
  50.     # No window ids should have been reused: stale Destroy events still
  51.     # pending in queue.
  52.     lappend result [lsort $reused]
  54.     # Wait a few seconds, then try again;  ids should still not have
  55.     # been re-used.
  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.     }
  70.     # Ids should not yet have been reused.
  71.     lappend result [lsort $reused]
  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.     }
  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} {}}
  92. bind all <Destroy> {}
  94. # cleanup
  95. ::tcltest::cleanupTests
  96. return