开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
macMenu.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：51k
源码类别：

通讯编程

开发平台：

Visual C++

macMenu.test：源码内容
  1. # This file is a Tcl script to test menus in Tk.  It is
  2. # organized in the standard fashion for Tcl tests. This
  3. # file tests the Macintosh-specific features of the menu
  4. # system.
  5. #
  6. # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  7. # Copyright (c) 1998-1999 by Scriptics Corporation.
  8. # All rights reserved.
  9. #
  10. # RCS: @(#) $Id: macMenu.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
  12. package require tcltest 2.1
  13. namespace import -force tcltest::configure
  14. namespace import -force tcltest::testsDirectory
  15. configure -testdir [file join [pwd] [file dirname [info script]]]
  16. configure -loadfile [file join [testsDirectory] constraints.tcl]
  17. tcltest::loadTestedCommands
  19. test macMenu-1.0 {TkMacUseMenuID} {macOnly} {
  20.     # Can't really test TkMacUseMenuID; it's only called on startup.
  21. } {}
  23. test macMenu-2.1 {GetNewID} {macOnly} {
  24.     catch {destroy .m1}
  25.     list [catch {menu .m1} msg] $msg [destroy .m1]
  26. } {0 .m1 {}}
  27. test macMenu-2.2 {GetNewID - cascade menu} {macOnly} {
  28.     catch {destroy .m1}
  29.     menu .m1
  30.     .m1 add cascade -menu .m2
  31.     list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2]
  32. } {0 .m2 {} {}}
  33. test macMenu-2.3 {GetNewID - running out of ids} {macOnly} {
  34.     deleteWindows
  35.     menu .menu
  36.     for {set i 0} {$i < 230} {incr i} {
  37.      menu .m$i
  38.      .menu add cascade -label ".m$i" -menu .m$i
  39.     }
  40.     menu .breaker
  41.     list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
  42. } {1 {No more menus can be allocated.} {}}
  44. test macMenu-3.1 {FreeID} {macOnly} {
  45.     catch {destroy .m1}
  46.     menu .m1
  47.     list [catch {destroy .m1} msg] $msg
  48. } {0 {}}
  50. # No way to test running out of ids in TkpNewPlatformMenu
  51. test macMenu-4.1 {TkpNewMenu} {macOnly} {
  52.     catch {destroy .m1}
  53.     list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
  54. } {0 .m1 0 {}}
  55. test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} {macOnly} {
  56.     catch {destroy .m1}
  57.     catch {destroy .m2}
  58.     menu .m1
  59.     menu .m1.help -tearoff 0
  60.     .m1.help add command -label Test
  61.     . configure -menu .m1
  62.     raise .
  63.     update
  64.     list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2] [. configure -menu ""]
  65. } {0 .m2 {} {} {}}
  66. test macMenu-4.3 {TkpNewMenu - menubar set but different interp} {macOnly} {
  67.     catch {interp delete testinterp}
  68.     catch {destroy .m1}
  69.     interp create testinterp
  70.     load {} Tk testinterp
  71.     interp eval testinterp {raise .}
  72.     interp eval testinterp {menu .m1}
  73.     interp eval testinterp {. configure -menu .m1}
  74.     interp eval testinterp {update}
  75.     list [catch {menu .m1} msg] $msg [destroy .m1] [interp delete testinterp]
  76. } {0 .m1 {} {}}
  77. test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} {macOnly} {
  78.     catch {destroy .m1}
  79.     catch {destroy .m2}
  80.     menu .m1 -tearoff 0
  81.     .m1 add cascade -menu .m1.help
  82.     menu .m2
  83.     .m2 add cascade -menu .m2.help
  84.     . configure -menu .m1
  85.     raise .
  86.     update
  87.     list [catch {menu .m2.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2]
  88. } {0 .m2.help {} {} {}}
  89. test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} {macOnly} {
  90.     catch {destroy .m1}
  91.     menu .m1 -tearoff 0
  92.     .m1 add cascade -menu .m1.help
  93.     . configure -menu .m1
  94.     raise .
  95.     update
  96.     list [catch {menu .m1.foo} msg] $msg [. configure -menu ""] [destroy .m1]
  97. } {0 .m1.foo {} {}}
  98. test macMenu-4.6 {TkpNewMenu - creating the help menu} {macOnly} {
  99.     catch {destroy .m1}
  100.     menu .m1 -tearoff 0
  101.     .m1 add cascade -menu .m1.help
  102.     . configure -menu .m1
  103.     raise .
  104.     update
  105.     list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
  106. } {0 .m1.help {} {}}
  108. test macMenu-5.1 {TkpDestroyMenu} {macOnly} {
  109.     catch {destroy .m1}
  110.     menu .m1
  111.     list [catch {destroy .m1} msg] $msg
  112. } {0 {}}
  113. test macMenu-5.2 {TkpDestroyMenu - help menu} {macOnly} {
  114.     catch {destroy .m1}
  115.     menu .m1 -tearoff 0
  116.     .m1 add cascade -menu .m1.help
  117.     . configure -menu .m1
  118.     menu .m1.help
  119.     raise .
  120.     update
  121.     list [catch {destroy .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
  122. } {0 {} {} {}}
  123. test macMenu-5.3 {TkpDestroyMenu - idle handler pending} {macOnly} {
  124.     catch {destroy .m1}
  125.     menu .m1
  126.     .m1 add command -label test
  127.     list [catch {destroy .m1} msg] $msg
  128. } {0 {}}
  129. test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} {macOnly} {
  130.     catch {destroy .m1}
  131.     menu .m1
  132.     .m1 add command -label test
  133.     update idletasks
  134.     list [catch {destroy .m1} msg] $msg
  135. } {0 {}}
  137. test macMenu-6.1 {SetMenuCascade} {macOnly} {
  138.     catch {destroy .m1}
  139.     catch {destroy .m2}
  140.     menu .m1
  141.     menu .m2
  142.     list [catch {.m2 add cascade -menu .m1} msg] $msg [destroy .m1 .m2]
  143. } {0 {} {}}
  144. test macMenu-6.2 {SetMenuCascade - running out of ids} {macOnly} {
  145.     deleteWindows
  146.     menu .menu
  147.     for {set i 0} {$i < 230} {incr i} {
  148.      menu .m$i
  149.      .menu add cascade -label ".m$i" -menu .m$i
  150.     }
  151.     menu .breaker
  152.     list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
  153. } {1 {No more menus can be allocated.} {}}
  155. test macMenu-7.1 {TkpDestroyMenuEntry} {macOnly} {
  156.     catch {destroy .m1}
  157.     menu .m1
  158.     .m1 add command -label "test"
  159.     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
  160. } {0 {} {}}
  161. test macMenu-7.2 {TkpDestroyMenuEntry - help menu} {macOnly} {
  162.     catch {destroy .m1}
  163.     menu .m1
  164.     .m1 add cascade -menu .m1.help
  165.     menu .m1.help -tearoff 0
  166.     .m1.help add command -label "test"
  167.     . configure -menu .m1
  168.     raise .
  169.     update
  170.     list [catch {.m1.help delete test} msg] $msg [. configure -menu ""] [destroy .m1]
  171. } {0 {} {} {}}
  173. test macMenu-8.1 {GetEntryText} {macOnly} {
  174.     catch {destroy .m1}
  175.     list [catch {menu .m1} msg] $msg [destroy .m1]
  176. } {0 .m1 {}}
  177. test macMenu-8.2 {GetEntryText} {macOnly testImageType} {
  178.     catch {destroy .m1}
  179.     catch {image delete image1}
  180.     menu .m1
  181.     image create test image1
  182.     list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
  183. } {0 {} {} {}}
  184. test macMenu-8.3 {GetEntryText} {macOnly} {
  185.     catch {destroy .m1}
  186.     menu .m1
  187.     list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
  188. } {0 {} {}}
  189. test macMenu-8.4 {GetEntryText} {macOnly} {
  190.     catch {destroy .m1}
  191.     menu .m1
  192.     list [catch {.m1 add command} msg] $msg [destroy .m1]
  193. } {0 {} {}}
  194. test macMenu-8.5 {GetEntryText} {macOnly} {
  195.     catch {destroy .m1}
  196.     menu .m1
  197.     .m1 add command -label "foo"
  198.     list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
  199. } {0 {} {}}
  200. test macMenu-8.6 {GetEntryText} {macOnly} {
  201.     catch {destroy .m1}
  202.     menu .m1
  203.     list [catch {.m1 add command -label "This is a very long string. 9012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890"} 
  204.          msg] $msg [destroy .m1]
  205. } {0 {} {}}
  206. test macMenu-8.7 {GetEntryText - elipses character} {macOnly} {
  207.     catch {destroy .m1}
  208.     menu .m1
  209.     list [catch {.m1 add command -label "foo..."} msg] $msg [destroy .m1]
  210. } {0 {} {}}
  211. test macMenu-8.8 {GetEntryText - false elipses character} {macOnly} {
  212.     catch {destroy .m1}
  213.     menu .m1
  214.     list [catch {.m1 add command -label "foo."} msg] $msg [destroy .m1]
  215. } {0 {} {}}
  216. test macMenu-8.9 {GetEntryText - false elipses character} {macOnly} {
  217.     catch {destroy .m1}
  218.     menu .m1
  219.     list [catch {.m1 add command -label "foo.."} msg] $msg [destroy .m1]
  220. } {0 {} {}}
  221. test macMenu-8.10 {GetEntryText - false elipses character} {macOnly} {
  222.     catch {destroy .m1}
  223.     menu .m1
  224.     list [catch {.m1 add command -label "foo.b"} msg] $msg [destroy .m1]
  225. } {0 {} {}}
  226. test macMenu-8.11 {GetEntryText - false elipses character} {macOnly} {
  227.     catch {destroy .m1}
  228.     menu .m1
  229.     list [catch {.m1 add command -label "foo..b"} msg] $msg [destroy .m1]
  230. } {0 {} {}}
  233. # test macMenu-9.1 - assumes some fonts
  234. test macMenu-9.1 {FindMarkCharacter} {macOnly} {
  235.     catch {destroy .m1}
  236.     menu .m1 -font "Helvetica 12" -tearoff 0
  237.     .m1 add checkbutton -label test
  238.     .m1 invoke test
  239.     list [catch {update idletasks} msg] $msg [destroy .m1]
  240. } {0 {} {}}
  241. # All standard fonts have "