home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tests / select.test < prev    next >
Encoding:
Text File  |  1993-06-04  |  7.5 KB  |  213 lines
  1. # This file is a Tcl script to test out Tk's selection management code,
  2. # especially the "selection" command.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1993 The Regents of the University of California.
  6. # All rights reserved.
  7. #
  8. # Permission is hereby granted, without written agreement and without
  9. # license or royalty fees, to use, copy, modify, and distribute this
  10. # software and its documentation for any purpose, provided that the
  11. # above copyright notice and the following two paragraphs appear in
  12. # all copies of this software.
  13. #
  14. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  15. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  16. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  17. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  18. #
  19. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  20. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  21. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  22. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  23. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  24. #
  25. # $Header: /user6/ouster/wish/tests/RCS/select.test,v 1.4 93/06/04 08:44:14 ouster Exp $ (Berkeley)
  26.  
  27. if {[string compare test [info procs test]] == 1} {
  28.     source defs
  29. }
  30.  
  31. catch {destroy .f1}
  32. catch {destroy .f2}
  33. catch {destroy .f3}
  34.  
  35. frame .f1
  36. frame .f2
  37. frame .f3
  38.  
  39. proc handler {type offset count} {
  40.     global selValue selInfo
  41.  
  42.     lappend selInfo $type $offset $count
  43.     set numBytes [expr {[string length $selValue] - $offset}]
  44.     if {$numBytes <= 0} {
  45.     return ""
  46.     }
  47.     string range $selValue $offset [expr $numBytes+$offset]
  48. }
  49.  
  50. proc errHandler args {
  51.     error "selection handler aborted"
  52. }
  53.  
  54. # Eliminate any existing selection on the screen.  This is needed in case
  55. # there is a selection in some other application, in order to prevent races
  56. # from causing false errors in the tests below.
  57.  
  58. selection clear .
  59. after 1000
  60.  
  61. test select-1.1 {simple Tcl-based handler} {
  62.     selection own .f1
  63.     lsort [selection get TARGETS]
  64. } {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME}
  65. selection handle .f1 {handler TEST} TEST
  66. test select-1.2 {simple Tcl-based handler} {
  67.     selection own .f1
  68.     lsort [selection get TARGETS]
  69. } {APPLICATION MULTIPLE TARGETS TEST TIMESTAMP WINDOW_NAME}
  70. test select-1.3 {simple Tcl-based handler} {
  71.     selection own .f1
  72.     set selValue "Test value"
  73.     set selInfo ""
  74.     list [selection get TEST] $selInfo
  75. } {{Test value} {TEST 0 4000}}
  76. selection handle .f1 {handler STRING}
  77. test select-1.4 {simple Tcl-based handler} {
  78.     selection own .f1
  79.     lsort [selection get TARGETS]
  80. } {APPLICATION MULTIPLE STRING TARGETS TEST TIMESTAMP WINDOW_NAME}
  81. test select-1.5 {simple Tcl-based handler} {
  82.     selection own .f1
  83.     set selValue ""
  84.     set selInfo ""
  85.     list [selection get] $selInfo
  86. } {{} {STRING 0 4000}}
  87. test select-1.6 {simple Tcl-based handler} {
  88.     list [catch {selection get BADTARGET} msg] $msg
  89. } {1 {selection doesn't exist or form "BADTARGET" not defined}}
  90. test select-1.7 {simple Tcl-based handler} {
  91.     set lostSel {XXX}
  92.     selection own .f1 {set lostSel "selection gone"}
  93.     selection own .f2
  94.     set lostSel
  95. } {selection gone}
  96. selection handle .f1 ERROR errHandler
  97. test select-1.8 {simple Tcl-based handler} {
  98.     selection own .f1
  99.     list [catch {selection get ERROR} msg] $msg
  100. } {1 {selection doesn't exist or form "ERROR" not defined}}
  101. if $atBerkeley {
  102.     test select-1.9 {simple Tcl-based handler} {
  103.     set lostSel {XXX}
  104.     set selValue "Test2"
  105.     set selInfo ""
  106.     selection own .f1 {set lostSel "selection gone"}
  107.     destroy .f1
  108.     list [catch {selection get} msg] $msg $lostSel $selInfo
  109.     } {1 {selection doesn't exist or form "STRING" not defined} XXX {}}
  110. }
  111.  
  112. selection handle .f2 {handler STRING.f2}
  113. set selValue ""
  114. foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
  115.     set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
  116.     append selValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
  117. }
  118. test select-2.1 {long retrievals} {
  119.     selection own .f2
  120.     set selInfo ""
  121.     list [selection get] $selInfo
  122. } "$selValue {STRING.f2 0 4000 STRING.f2 4000 4000 STRING.f2 8000 4000 STRING.f2 12000 4000 STRING.f2 16000 4000}"
  123.  
  124. test select-3.1 {handlers provided by Tk} {
  125.     selection own .f2
  126.     list [selection get APPLICATION] [selection get WINDOW_NAME]
  127. } [list [winfo name .] .f2]
  128. selection handle .f2 {handler TARGETS.f2} TARGETS
  129. test select-3.2 {handlers provided by Tk} {
  130.     selection own .f2
  131.     set selValue "Timestamp value"
  132.     set selInfo ""
  133.     list [selection get TARGETS] $selInfo
  134. } {{Timestamp value} {TARGETS.f2 0 4000}}
  135. selection handle .f2 {} TARGETS
  136. test select-3.3 {handlers provided by Tk} {
  137.     selection get TARGETS
  138. } {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME STRING}
  139.  
  140. catch {destroy .f1}
  141. frame .f1
  142. selection handle .f1 {handler TEST1.f1} TEST1
  143. selection handle .f1 {handler TEST2.f1} TEST2
  144. selection handle .f1 {handler TEST3.f1} TEST3
  145. test select-4.1 {modifying and deleting handlers} {
  146.     selection handle .f1 {handler TEST1.new} TEST1
  147.     selection own .f1
  148.     set selValue "value"
  149.     set selInfo ""
  150.     list [selection get TEST1] $selInfo
  151. } {value {TEST1.new 0 4000}}
  152. selection handle .f1 {} TEST2
  153. test select-4.2 {modifying and deleting handlers} {
  154.     selection get TARGETS
  155. } {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME TEST3 TEST1}
  156. selection handle .f1 {} TEST1
  157. test select-4.3 {modifying and deleting handlers} {
  158.     selection get TARGETS
  159. } {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME TEST3}
  160. selection handle .f1 {} TEST3
  161. test select-4.4 {modifying and deleting handlers} {
  162.     selection get TARGETS
  163. } {APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME}
  164.  
  165. test select-5.1 {clearing the selection} {
  166.     selection own .f2
  167.     set result [selection get WINDOW_NAME]
  168.     selection clear .
  169.     list $result [catch {selection get WINDOW_NAME} msg] $msg
  170. } {.f2 1 {selection doesn't exist or form "WINDOW_NAME" not defined}}
  171.  
  172. test select-6.1 {selection own option} {
  173.     selection own .f2
  174.     selection own
  175. } .f2
  176. test select-6.2 {selection own option} {
  177.     selection own .f3
  178.     selection clear .
  179.     selection own
  180. } {}
  181.  
  182. test select-6.1 {errors in selection command} {
  183.     list [catch selection msg] $msg
  184. } {1 {wrong # args: should be "selection option ?arg arg ...?"}}
  185. test select-6.2 {errors in selection command} {
  186.     list [catch {selection junk} msg] $msg
  187. } {1 {bad option "junk":  must be clear, get, handle, or own}}
  188. test select-6.3 {errors in selection command} {
  189.     list [catch {selection clear} msg] $msg
  190. } {1 {wrong # args: should be "selection clear window"}}
  191. test select-6.4 {errors in selection command} {
  192.     list [catch {selection clear foo} msg] $msg
  193. } {1 {bad window path name "foo"}}
  194. test select-6.5 {errors in selection command} {
  195.     list [catch {selection get a b} msg] $msg
  196. } {1 {too may args: should be "selection get ?type?"}}
  197. test select-6.6 {errors in selection command} {
  198.     list [catch {selection handle a} msg] $msg
  199. } {1 {wrong # args: should be "selection handle window command ?type? ?format?"}}
  200. test select-6.7 {errors in selection command} {
  201.     list [catch {selection handle a b c d e} msg] $msg
  202. } {1 {wrong # args: should be "selection handle window command ?type? ?format?"}}
  203. test select-6.8 {errors in selection command} {
  204.     list [catch {selection own a b c} msg] $msg
  205. } {1 {wrong # args: should be "selection own ?window? ?command?"}}
  206. test select-6.9 {errors in selection command} {
  207.     list [catch {selection own junk} msg] $msg
  208. } {1 {bad window path name "junk"}}
  209.  
  210. destroy .f1
  211. destroy .f2
  212. destroy .f3
  213.