home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tests / option.test < prev    next >
Encoding:
Text File  |  1993-07-08  |  11.3 KB  |  226 lines
  1. # This file is a Tcl script to test out the option-handling facilities
  2. # of Tk.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1991-1993 The Regents of the University of California.
  5. # All rights reserved.
  6. #
  7. # Permission is hereby granted, without written agreement and without
  8. # license or royalty fees, to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose, provided that the
  10. # above copyright notice and the following two paragraphs appear in
  11. # all copies of this software.
  12. #
  13. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  14. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  15. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  16. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  17. #
  18. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  19. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  20. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  21. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  22. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  23. #
  24. # $Header: /user6/ouster/wish/tests/RCS/option.test,v 1.12 93/07/08 11:51:26 ouster Exp $ (Berkeley)
  25.  
  26. if {[string compare test [info procs test]] == 1} then \
  27.   {source defs}
  28.  
  29. catch {destroy .op1}
  30. catch {destroy .op2}
  31. set appName [winfo name .]
  32.  
  33. # First, test basic retrievals, being sure to trigger all the various
  34. # types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and
  35. # everything in-between).
  36.  
  37. frame .op1 -class Class1
  38. frame .op2 -class Class2
  39. frame .op1.op3 -class Class1
  40. frame .op1.op4 -class Class3
  41. frame .op2.op5 -class Class2
  42. frame .op1.op3.op6 -class Class4
  43.  
  44. option clear
  45. option add *Color1 red
  46. option add *x blue
  47. option add *Class1.x yellow
  48. option add $appName.op1.x green
  49. option add *Class2.Color1 orange
  50. option add $appName.op2.op5.Color2 purple
  51. option add $appName.Class1.Class3.y brown
  52. option add $appName*op6*Color2 black
  53. option add $appName*Class1.op1.Color2 grey
  54.  
  55. test option-1.1 {basic option retrieval} {option get . x Color1} blue
  56. test option-1.2 {basic option retrieval} {option get . y Color1} red
  57. test option-1.3 {basic option retrieval} {option get . z Color1} red
  58. test option-1.4 {basic option retrieval} {option get . x Color2} blue
  59. test option-1.5 {basic option retrieval} {option get . y Color2} {}
  60. test option-1.6 {basic option retrieval} {option get . z Color2} {}
  61.  
  62. test option-2.1 {basic option retrieval} {option get .op1 x Color1} green
  63. test option-2.2 {basic option retrieval} {option get .op1 y Color1} red
  64. test option-2.3 {basic option retrieval} {option get .op1 z Color1} red
  65. test option-2.4 {basic option retrieval} {option get .op1 x Color2} green
  66. test option-2.5 {basic option retrieval} {option get .op1 y Color2} {}
  67. test option-2.6 {basic option retrieval} {option get .op1 z Color2} {}
  68.  
  69. test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow
  70. test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red
  71. test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red
  72. test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow
  73. test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {}
  74. test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {}
  75.  
  76. test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue
  77. test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red
  78. test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red
  79. test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black
  80. test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black
  81. test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black
  82.  
  83. test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue
  84. test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown
  85. test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red
  86. test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue
  87. test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown
  88. test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {}
  89.  
  90. test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange
  91. test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange
  92. test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange
  93. test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue
  94. test option-6.5 {basic option retrieval} {option get .op2 y Color2} {}
  95. test option-6.6 {basic option retrieval} {option get .op2 z Color2} {}
  96.  
  97. test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange
  98. test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange
  99. test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange
  100. test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple
  101. test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple
  102. test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple
  103.  
  104. # Now try similar tests to above, except jump around non-hierarchically
  105. # between windows to make sure that the option stacks are pushed and
  106. # popped correctly.
  107.  
  108. option get . foo Foo
  109. test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange
  110. test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange
  111. test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange
  112. test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple
  113. test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple
  114. test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple
  115.  
  116. test option-9.1 {stack pushing/popping} {option get . x Color1} blue
  117. test option-9.2 {stack pushing/popping} {option get . y Color1} red
  118. test option-9.3 {stack pushing/popping} {option get . z Color1} red
  119. test option-9.4 {stack pushing/popping} {option get . x Color2} blue
  120. test option-9.5 {stack pushing/popping} {option get . y Color2} {}
  121. test option-9.6 {stack pushing/popping} {option get . z Color2} {}
  122.  
  123. test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue
  124. test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red
  125. test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red
  126. test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black
  127. test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black
  128. test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black
  129.  
  130. test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow
  131. test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red
  132. test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red
  133. test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow
  134. test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {}
  135. test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {}
  136.  
  137. test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green
  138. test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red
  139. test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red
  140. test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green
  141. test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {}
  142. test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {}
  143.  
  144. # Test the major priority levels (widgetDefault, etc.)
  145.  
  146. option add $appName.op1.a 100 100
  147. option add $appName.op1.A interactive interactive
  148. option add $appName.op1.b userDefault userDefault
  149. option add $appName.op1.B startupFile startupFile
  150. option add $appName.op1.c widgetDefault widgetDefault
  151. option add $appName.op1.C 0 0
  152.  
  153. test option-13.1 {priority levels} {option get .op1 a A} 100
  154. test option-13.2 {priority levels} {option get .op1 b A} interactive
  155. test option-13.3 {priority levels} {option get .op1 b B} userDefault
  156. test option-13.4 {priority levels} {option get .op1 c B} startupFile
  157. test option-13.5 {priority levels} {option get .op1 c C} widgetDefault
  158. option add $appName.op1.B file2 widget
  159. test option-13.7 {priority levels} {option get .op1 c B} startupFile
  160. option add $appName.op1.B file2 startupFile
  161. test option-13.8 {priority levels} {option get .op1 c B} file2
  162.  
  163. # Test various error conditions
  164.  
  165. test option-14.1 {error conditions} {
  166.     list [catch {option} msg] $msg
  167. } {1 {wrong # args: should be "option cmd arg ?arg ...?"}}
  168. test option-14.2 {error conditions} {
  169.     list [catch {option x} msg] $msg
  170. } {1 {bad option "x": must be add, clear, get, or readfile}}
  171. test option-14.3 {error conditions} {
  172.     list [catch {option foo 3} msg] $msg
  173. } {1 {bad option "foo": must be add, clear, get, or readfile}}
  174. test option-14.4 {error conditions} {
  175.     list [catch {option add 3} msg] $msg
  176. } {1 {wrong # args: should be "option add pattern value ?priority?"}}
  177. test option-14.5 {error conditions} {
  178.     list [catch {option add . a b c} msg] $msg
  179. } {1 {wrong # args: should be "option add pattern value ?priority?"}}
  180. test option-14.6 {error conditions} {
  181.     list [catch {option add . a -1} msg] $msg
  182. } {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
  183. test option-14.7 {error conditions} {
  184.     list [catch {option add . a 101} msg] $msg
  185. } {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
  186. test option-14.8 {error conditions} {
  187.     list [catch {option add . a gorp} msg] $msg
  188. } {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
  189. test option-14.9 {error conditions} {
  190.     list [catch {option get 3} msg] $msg
  191. } {1 {wrong # args: should be "option get window name class"}}
  192. test option-14.10 {error conditions} {
  193.     list [catch {option get 3 4} msg] $msg
  194. } {1 {wrong # args: should be "option get window name class"}}
  195. test option-14.11 {error conditions} {
  196.     list [catch {option get 3 4 5 6} msg] $msg
  197. } {1 {wrong # args: should be "option get window name class"}}
  198. test option-14.12 {error conditions} {
  199.     list [catch {option get .gorp.gorp a A} msg] $msg
  200. } {1 {bad window path name ".gorp.gorp"}}
  201.  
  202. test option-15.1 {database files} {
  203.     list [catch {option read non-existent} msg] $msg
  204. } {1 {couldn't read file "non-existent"}}
  205. option read option.file1
  206. test option-15.2 {database files} {option get . x1 color} blue
  207. if {$appName == "tktest"} {
  208.     test option-15.3 {database files} {option get . x2 color} green
  209. }
  210. test option-15.4 {database files} {option get . x3 color} purple
  211. test option-15.5 {database files} {option get . {x 4} color} brown
  212. test option-15.5 {database files} {option get . x6 color} {}
  213. test option-15.7 {database files} {
  214.     list [catch {option read option.file1 widget foo} msg] $msg
  215. } {1 {wrong # args:  should be "option readfile fileName ?priority?"}}
  216. option add *x3 burgundy
  217. catch {option read option.file1 userDefault}
  218. test option-15.8 {database files} {option get . x3 color} burgundy
  219. test option-15.9 {database files} {
  220.     list [catch {option read option.file2} msg] $msg
  221. } {1 {missing colon on line 2}}
  222.  
  223. catch {destroy .op1}
  224. catch {destroy .op2}
  225. concat {}
  226.