tk/tests/event.test

   1 # This file is a Tcl script to test the code in tkEvent.c.  It is
   2 # organized in the standard fashion for Tcl tests.
   3 #
   4 # Copyright (c) 1994 The Regents of the University of California.
   5 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
   6 # Copyright (c) 1998-1999 by Scriptics Corporation.
   7 # All rights reserved.
   8 #
   9 # RCS: @(#) $Id$
  10
  11 if {[lsearch [namespace children] ::tcltest] == -1} {
  12     source [file join [pwd] [file dirname [info script]] defs.tcl]
  13 }
  14
  15 foreach i [winfo children .] {
  16     destroy $i
  17 }
  18 wm geometry . {}
  19 raise .
  20
  21 # XXX This test file is woefully incomplete.  Right now it only tests
  22 # a few of the procedures in tkEvent.c.  Please add more tests whenever
  23 # possible.
  24
  25 test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
  26     button .b -text Test
  27     pack .b
  28     bindtags .b .b
  29     update
  30     bind .b <Destroy> {
  31         lappend x destroy
  32         event generate .b <1>
  33         event generate .b <ButtonRelease-1>
  34     }
  35     bind .b <1> {
  36         lappend x button
  37     }
  38     set x {}
  39     destroy .b
  40     set x
  41 } {destroy}
  42
  43 test event-1.2 {event generate <Alt-z>} {
  44         catch {destroy .e}
  45         catch {unset ::event12result}
  46         set ::event12result 0
  47         pack [entry .e]
  48         update
  49         bind .e <Alt-z> {set ::event12result "1"}
  50         focus -force .e ; event generate .e <Alt-z>
  51         destroy .e
  52         set ::event12result
  53 } 1
  54 # cleanup
  55 ::tcltest::cleanupTests
  56 return
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70