home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / event.test < prev    next >
Encoding:
Text File  |  1995-06-23  |  2.8 KB  |  98 lines
  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. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) event.test 1.3 95/06/22 17:10:29
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19. wm geometry . {}
  20. raise .
  21.  
  22. # XXX This test file is woefully incomplete.  Right now it only tests
  23. # a few of the procedures in tkEvent.c.  Please add more tests whenever
  24. # possible.
  25.  
  26.  
  27. proc tkerror msg {
  28.     global x errorInfo errorCode y
  29.     lappend x $msg $errorInfo $errorCode
  30.     if [string match break* $msg] {
  31.     return -code break
  32.     }
  33.     if [string match more* $msg] {
  34.     after 0 {error "Another error"}
  35.     after 0 {set y done; error "Still another"}
  36.     tkwait variable y
  37.     }
  38. }
  39.  
  40. test event-1.1 {Tk_BackgroundError and HandleBgErrors procedures} {
  41.     catch {unset errorCode}
  42.     catch {unset errorInfo}
  43.     after idle {error "First error"}
  44.     after idle {error "Second error"}
  45.     set x {}
  46.     tkwait variable x
  47.     set x
  48. } {{First error} {First error
  49.     while executing
  50. "error "First error""
  51.     ("after" script)} NONE {Second error} {Second error
  52.     while executing
  53. "error "Second error""
  54.     ("after" script)} NONE}
  55. test event-1.2 {Tk_BackgroundError and HandleBgErrors procedures} {
  56.     catch {unset errorCode}
  57.     catch {unset errorInfo}
  58.     after idle {error "First error" "error code initialization" "foo bar baz"}
  59.     after idle {error "Second error"}
  60.     set x {}
  61.     tkwait variable x
  62.     set x
  63. } {{First error} {error code initialization
  64.     ("after" script)} {foo bar baz} {Second error} {Second error
  65.     while executing
  66. "error "Second error""
  67.     ("after" script)} NONE}
  68. test event-1.3 {Tk_BackgroundError and HandleBgErrors procedures} {
  69.     after idle {error "break returned"}
  70.     after idle {error "number 1"}
  71.     after idle {error "number 2"}
  72.     set x {}
  73.     tkwait variable x
  74.     set x
  75. } {{break returned} {break returned
  76.     while executing
  77. "error "break returned""
  78.     ("after" script)} NONE}
  79. test event-1.4 {Tk_BackgroundError and HandleBgErrors procedures} {
  80.     after idle {error "more errors, please"}
  81.     after idle {error "number 1"}
  82.     set x {}
  83.     tkwait variable x
  84.     set x
  85. } {{more errors, please} {more errors, please
  86.     while executing
  87. "error "more errors, please""
  88.     ("after" script)} NONE {number 1} {number 1
  89.     while executing
  90. "error "number 1""
  91.     ("after" script)} NONE {Another error} {Another error
  92.     while executing
  93. "error "Another error""
  94.     ("after" script)} NONE {Still another} {Still another
  95.     while executing
  96. "error "Still another""
  97.     ("after" script)} NONE}
  98.