home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / menu.test < prev    next >
Encoding:
Text File  |  1995-06-26  |  4.5 KB  |  164 lines
  1. # This file is a Tcl script to test menus in Tk.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1995 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # @(#) menu.test 1.3 95/05/05 13:38:06
  10.  
  11. # XXX This test file is woefully incomplete right now.
  12.  
  13. if {[info procs test] != "test"} {
  14.     source defs
  15. }
  16.  
  17. foreach i [winfo children .] {
  18.     destroy $i
  19. }
  20. wm geometry . {}
  21. raise .
  22.  
  23. test menu-1.1 {MenuWidgetCmd procedure, "add" option} {
  24.     catch {destroy .m}
  25.     menu .m
  26.     list [catch {.m add} msg] $msg
  27. } {1 {wrong # args: should be ".m add type ?options?"}}
  28. test menu-1.2 {MenuWidgetCmd procedure, "add" option} {
  29.     catch {destroy .m}
  30.     menu .m
  31.     list [catch {.m add gorp} msg] $msg
  32. } {1 {bad menu entry type "gorp":  must be cascade, checkbutton, command, radiobutton, or separator}}
  33. test menu-1.3 {MenuWidgetCmd procedure, "add" option} {
  34.     catch {destroy .m}
  35.     menu .m
  36.     .m add command -label first
  37.     .m entrycget 1 -label
  38. } {first}
  39.  
  40. test menu-2.1 {MenuWidgetCmd procedure, "insert" option} {
  41.     catch {destroy .m}
  42.     menu .m
  43.     list [catch {.m insert 1} msg] $msg
  44. } {1 {wrong # args: should be ".m insert index type ?options?"}}
  45. test menu-2.2 {MenuWidgetCmd procedure, "insert" option} {
  46.     catch {destroy .m}
  47.     menu .m
  48.     list [catch {.m insert 1 gorp} msg] $msg
  49. } {1 {bad menu entry type "gorp":  must be cascade, checkbutton, command, radiobutton, or separator}}
  50. test menu-2.3 {MenuWidgetCmd procedure, "insert" option} {
  51.     catch {destroy .m}
  52.     menu .m
  53.     list [catch {.m insert none gorp} msg] $msg
  54. } {1 {bad index "none"}}
  55. test menu-2.4 {MenuWidgetCmd procedure, "insert" option} {
  56.     catch {destroy .m}
  57.     menu .m
  58.     .m add command -label first
  59.     .m insert 1 command -label second
  60.     .m insert 3 command -label third
  61.     .m insert 3 command -label fourth
  62.     list [.m entrycget 1 -label] [.m entrycget 2 -label] [.m entrycget 3 -label] [.m entrycget 4 -label]
  63. } {second first fourth third}
  64.  
  65. catch {destroy .m}
  66. menu .m
  67. .m add command -label first
  68. .m add command -label second
  69. .m add command -label third
  70. .m post 100 100
  71. .m activate 2
  72. update
  73. test menu-3.1 {GetMenuIndex procedure} {
  74.     .m index active
  75. } 2
  76. test menu-3.2 {GetMenuIndex procedure} {
  77.     .m index last
  78. } 3
  79. test menu-3.3 {GetMenuIndex procedure} {
  80.     .m index end
  81. } 3
  82. test menu-3.4 {GetMenuIndex procedure} {
  83.     .m index none
  84. } none
  85. if $doNonPortableTests {
  86.     test menu-3.5 {GetMenuIndex procedure} {
  87.     .m index @13
  88.     } 0
  89.     test menu-3.6 {GetMenuIndex procedure} {
  90.     .m index @14
  91.     } 1
  92. }
  93. test menu-3.7 {GetMenuIndex procedure} {
  94.     .m index @1000
  95. } {3}
  96. test menu-3.8 {GetMenuIndex procedure} {
  97.     .m index @-40
  98. } {0}
  99. test menu-3.9 {GetMenuIndex procedure} {
  100.     list [catch {.m index @foobar} msg] $msg
  101. } {1 {bad menu entry index "@foobar"}}
  102. test menu-3.10 {GetMenuIndex procedure} {
  103.     .m index first
  104. } {1}
  105. test menu-3.11 {GetMenuIndex procedure} {
  106.     .m index *d
  107. } {2}
  108.  
  109. test menu-4.1 {MenuAddOrInsert procedure} {
  110.     catch {destroy .m}
  111.     menu .m
  112.     list [catch {.m insert foo gorp} msg] $msg
  113. } {1 {bad menu entry index "foo"}}
  114. test menu-4.2 {MenuAddOrInsert procedure} {
  115.     catch {destroy .m}
  116.     menu .m
  117.     .m add cascade
  118.     .m type last
  119. } {cascade}
  120. test menu-4.3 {MenuAddOrInsert procedure} {
  121.     catch {destroy .m}
  122.     menu .m
  123.     .m add checkbutton
  124.     .m type last
  125. } {checkbutton}
  126. test menu-4.4 {MenuAddOrInsert procedure} {
  127.     catch {destroy .m}
  128.     menu .m
  129.     .m add command
  130.     .m type last
  131. } {command}
  132. test menu-4.5 {MenuAddOrInsert procedure} {
  133.     catch {destroy .m}
  134.     menu .m
  135.     .m add radiobutton
  136.     .m type last
  137. } {radiobutton}
  138. test menu-4.6 {MenuAddOrInsert procedure} {
  139.     catch {destroy .m}
  140.     menu .m
  141.     .m add separator
  142.     .m type last
  143. } {separator}
  144. test menu-4.7 {MenuAddOrInsert procedure} {
  145.     catch {destroy .m}
  146.     menu .m
  147.     list [catch {.m add bogus} msg] $msg
  148. } {1 {bad menu entry type "bogus":  must be cascade, checkbutton, command, radiobutton, or separator}}
  149. test menu-4.8 {MenuAddOrInsert procedure} {
  150.     catch {destroy .m}
  151.     menu .m
  152.     list [catch {.m add command -foo bar} msg] $msg
  153. } {1 {unknown option "-foo"}}
  154. test menu-4.9 {MenuAddOrInsert procedure} {
  155.     catch {destroy .m}
  156.     menu .m
  157.     .m add command -label first
  158.     .m add command -label second
  159.     .m add command -label third
  160.     .m add command -label fourth
  161.     catch {.m insert command -label new -bogus option}
  162.     list [.m entrycget 1 -label] [.m entrycget 2 -label] [.m entrycget 3 -label] [.m entrycget 4 -label]
  163. } {first second third fourth}
  164.