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

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

通讯编程

开发平台：

Visual C++

cursor.test：源码内容
  1. # This file is a Tcl script to test out the procedures in the file
  2. # tkCursor.c.  It is organized in the standard white-box fashion for
  3. # Tcl tests.
  4. #
  5. # Copyright (c) 1998 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: cursor.test,v 1.8.2.1 2004/01/28 23:37:23 patthoyts Exp $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. testConstraint testcursor [llength [info commands testcursor]]
  20. test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} {
  21.     set x watch
  22.     lindex $x 0
  23.     destroy .b1
  24.     button .b1 -cursor $x
  25.     lindex $x 0
  26.     testcursor watch
  27. } {{1 0}}
  28. test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {testcursor} {
  29.     set x watch
  30.     destroy .b1 .b2
  31.     button .b1 -cursor $x
  32.     destroy .b1
  33.     set result {}
  34.     lappend result [testcursor watch]
  35.     button .b2 -cursor $x
  36.     lappend result [testcursor watch]
  37. } {{} {{1 1}}}
  38. test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {testcursor} {
  39.     set x watch
  40.     destroy .b1 .b2
  41.     button .b1 -cursor $x
  42.     set result {}
  43.     lappend result [testcursor watch]
  44.     button .b2 -cursor $x
  45.     pack .b1 .b2 -side top
  46.     lappend result [testcursor watch]
  47. } {{{1 1}} {{2 1}}}
  49. test cursor-2.1 {Tk_GetCursor procedure} {
  50.     destroy .b1
  51.     list [catch {button .b1 -cursor bad_name} msg] $msg
  52. } {1 {bad cursor spec "bad_name"}}
  53. test cursor-2.2 {Tk_GetCursor procedure} {
  54.     destroy .b1
  55.     list [catch {button .b1 -cursor @xyzzy} msg] $msg
  56. } {1 {bad cursor spec "@xyzzy"}}
  57. # Next two tests need a helper file with a very specific name and
  58. # controlled format.
  59. set wincur(data_octal) {
  60.     000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001
  61.     000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000
  62.     000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000
  63.     000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
  64.     000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000
  65.     000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
  66.     000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
  67.     000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000
  68.     000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036
  69.     000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360
  70.     000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370
  71.     000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016
  72.     000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377
  73.     377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
  74.     377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
  75.     377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377
  76.     377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300
  77.     377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007
  78.     377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003
  79.     377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340
  80.     377 377 017 360 377 377
  81. }
  82. set wincur(data_binary) {}
  83. foreach wincur(num) $wincur(data_octal) {
  84.     append wincur(data_binary) [binary format c 0$wincur(num)]
  85. }
  86. set wincur(dir) [::tcltest::makeDirectory {dir with spaces}]
  87. set wincur(file) [::tcltest::makeFile $wincur(data_binary) "test file.cur" $wincur(dir)]
  88. test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} {
  89.     destroy .b1
  90.     button .b1 -cursor [list @$wincur(file)]
  91. } {.b1}
  92. test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} {
  93.     destroy .b1
  94.     button .b1 -cursor @[regsub -all {[][ \{}""$#]} $wincur(file) {\&}]
  95. } {.b1}
  96. ::tcltest::removeDirectory $wincur(dir)
  97. unset wincur
  99. test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} {
  100.     set x heart
  101.     destroy .b1 .b2 .b3
  102.     button .b1 -cursor $x
  103.     button .b3 -cursor $x
  104.     button .b2 -cursor $x
  105.     set result {}
  106.     lappend result [testcursor heart]
  107.     destroy .b1
  108.     lappend result [testcursor heart]
  109.     destroy .b2
  110.     lappend result [testcursor heart]
  111.     destroy .b3
  112.     lappend result [testcursor heart]
  113. } {{{3 1}} {{2 1}} {{1 1}} {}}
  115. test cursor-4.1 {FreeCursorObjProc} {testcursor} {
  116.     destroy .b
  117.     set x [format heart]
  118.     button .b -cursor $x
  119.     set y [format heart]
  120.     .b configure -cursor $y
  121.     set z [format heart]
  122.     .b configure -cursor $z
  123.     set result {}
  124.     lappend result [testcursor heart]
  125.     set x red
  126.     lappend result [testcursor heart]
  127.     set z 32
  128.     lappend result [testcursor heart]
  129.     destroy .b
  130.     lappend result [testcursor heart]
  131.     set y bogus
  132.     set result
  133. } {{{1 3}} {{1 2}} {{1 1}} {}}
  135. # -------------------------------------------------------------------------
  137. test cursor-5.1 {assert consistent cursor configuration command} 
  138.     -setup { button .b } 
  139.     -body {
  140.         list [catch {.b configure -cursor {watch red black}} msg] $msg
  141.     } 
  142.     -cleanup {destroy .b} 
  143.     -result {0 {}}
  145. # -------------------------------------------------------------------------
  146. # Check for the standard set of cursors.
  148. set n 0
  149. foreach cursor {
  150.     X_cursor
  151.     arrow
  152.     based_arrow_down
  153.     based_arrow_up
  154.     boat
  155.     bogosity
  156.     bottom_left_corner
  157.     bottom_right_corner
  158.     bottom_side
  159.     bottom_tee
  160.     box_spiral
  161.     center_ptr
  162.     circle
  163.     clock
  164.     coffee_mug
  165.     cross
  166.     cross_reverse
  167.     crosshair
  168.     diamond_cross
  169.     dot
  170.     dotbox
  171.     double_arrow
  172.     draft_large
  173.     draft_small
  174.     draped_box
  175.     exchange
  176.     fleur
  177.     gobbler
  178.     gumby
  179.     hand1
  180.     hand2
  181.     heart
  182.     icon
  183.     iron_cross
  184.     left_ptr
  185.     left_side
  186.     left_tee
  187.     leftbutton
  188.     ll_angle
  189.     lr_angle
  190.     man
  191.     middlebutton
  192.     mouse
  193.     pencil
  194.     pirate
  195.     plus
  196.     question_arrow
  197.     right_ptr
  198.     right_side
  199.     right_tee
  200.     rightbutton
  201.     rtl_logo
  202.     sailboat
  203.     sb_down_arrow
  204.     sb_h_double_arrow
  205.     sb_left_arrow
  206.     sb_right_arrow
  207.     sb_up_arrow
  208.     sb_v_double_arrow
  209.     shuttle
  210.     sizing
  211.     spider
  212.     spraycan
  213.     star
  214.     target
  215.     tcross
  216.     top_left_arrow
  217.     top_left_corner
  218.     top_right_corner
  219.     top_side
  220.     top_tee
  221.     trek
  222.     ul_angle
  223.     umbrella
  224.     ur_angle
  225.     watch
  226.     xterm
  227. } {
  228.     test cursor-6.$n {check cursor $cursor} 
  229.         -setup {button .b -text $cursor} 
  230.         -body {
  231.             list [catch {.b configure -cursor $cursor} msg] $msg
  232.         } 
  233.         -cleanup {destroy .b} 
  234.         -result {0 {}}
  235.     incr n
  236. }
  237. unset n
  239. # -------------------------------------------------------------------------
  240. # Check the Windows specific cursors
  241. set n 0
  242. foreach cursor {
  243.     no
  244.     starting
  245.     size
  246.     size_ne_sw
  247.     size_ns
  248.     size_nw_se
  249.     size_we
  250.     uparrow
  251.     wait
  252. } {
  253.     test cursor-7.$n {check cursor $cursor} 
  254.         -constraints {pcOnly} 
  255.         -setup {button .b -text $cursor} 
  256.         -body {
  257.             list [catch {.b configure -cursor $cursor} msg] $msg
  258.         } 
  259.         -cleanup {destroy .b} 
  260.         -result {0 {}}
  261.     incr n
  262. }
  263. unset n
  265. # -------------------------------------------------------------------------
  266. # Check the Mac specific cursors
  267. set n 0
  268. foreach cursor {
  269.     text
  270.     cross-hair
  271. } {
  272.     test cursor-8.$n {check cursor $cursor} 
  273.         -constraints {macOnly} 
  274.         -setup {button .b -text $cursor} 
  275.         -body {
  276.             list [catch {.b configure -cursor $cursor} msg] $msg
  277.         } 
  278.         -cleanup {destroy .b} 
  279.         -result {0 {}}
  280.     incr n
  281. }
  282. unset n
  284. # -------------------------------------------------------------------------
  286. destroy .t
  288. # cleanup
  289. ::tcltest::cleanupTests
  290. return