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

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

通讯编程

开发平台：

Visual C++

unixEmbed.test：源码内容
  1. # This file is a Tcl script to test out the procedures in the file 
  2. # tkUnixEmbed.c.  It is organized in the standard fashion for Tcl
  3. # tests.
  4. #
  5. # Copyright (c) 1996-1997 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: unixEmbed.test,v 1.11 2002/07/13 21:52:34 dgp 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. setupbg
  19. dobg {wm withdraw .}
  21. # eatColors --
  22. # Creates a toplevel window and allocates enough colors in it to
  23. # use up all the slots in the colormap.
  24. #
  25. # Arguments:
  26. # w - Name of toplevel window to create.
  28. proc eatColors {w} {
  29.     catch {destroy $w}
  30.     toplevel $w
  31.     wm geom $w +0+0
  32.     canvas $w.c -width 400 -height 200 -bd 0
  33.     pack $w.c
  34.     for {set y 0} {$y < 8} {incr y} {
  35. for {set x 0} {$x < 40} {incr x} {
  36.     set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  37.     $w.c create rectangle [expr 10*$x] [expr 20*$y] 
  38.     [expr 10*$x + 10] [expr 20*$y + 20] -outline {} 
  39.     -fill $color
  40. }
  41.     }
  42.     update
  43. }
  45. # colorsFree --
  46. #
  47. # Returns 1 if there appear to be free colormap entries in a window,
  48. # 0 otherwise.
  49. #
  50. # Arguments:
  51. # w - Name of window in which to check.
  52. # red, green, blue - Intensities to use in a trial color allocation
  53. # to see if there are colormap entries free.
  55. proc colorsFree {w {red 31} {green 245} {blue 192}} {
  56.     set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
  57.     expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) 
  58.     && ([lindex $vals 2]/256 == $blue)
  59. }
  61. test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} unix {
  62.     catch {destroy .t}
  63.     list [catch {toplevel .t -use xyz} msg] $msg
  64. } {1 {expected integer but got "xyz"}}
  65. test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} unix {
  66.     catch {destroy .t}
  67.     list [catch {toplevel .t -use 47} msg] $msg
  68. } {1 {couldn't create child of window "47"}}
  69. test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {unix nonPortable} {
  70.     catch {destroy .t}
  71.     catch {destroy .x}
  72.     toplevel .t -colormap new
  73.     wm geometry .t +0+0
  74.     eatColors .t.t
  75.     frame .t.f -container 1
  76.     toplevel .x -use [winfo id .t.f]
  77.     set result [colorsFree .x]
  78.     destroy .t
  79.     set result
  80. } {0}
  81. test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {unix nonPortable} {
  82.     catch {destroy .t}
  83.     catch {destroy .t2}
  84.     catch {destroy .x}
  85.     toplevel .t -container 1 -colormap new
  86.     wm geometry .t +0+0
  87.     eatColors .t2
  88.     toplevel .x -use [winfo id .t]
  89.     set result [colorsFree .x]
  90.     destroy .t
  91.     set result
  92. } {1}
  94. test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix testembed} {
  95.     deleteWindows
  96.     frame .f1 -container 1 -width 200 -height 50
  97.     frame .f2 -container 1 -width 200 -height 50
  98.     pack .f1 .f2
  99.     dobg "set w [winfo id .f1]"
  100.     dobg {
  101. eval destroy [winfo child .]
  102. toplevel .t -use $w
  103. list [testembed] [expr [lindex [lindex [testembed all] 0] 0] - $w]
  104.     }
  105. } {{{XXX {} {} .t}} 0}
  106. test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} {unix testembed} {
  107.     deleteWindows
  108.     frame .f1 -container 1 -width 200 -height 50
  109.     frame .f2 -container 1 -width 200 -height 50
  110.     pack .f1 .f2
  111.     dobg "set w1 [winfo id .f1]"
  112.     dobg "set w2 [winfo id .f2]"
  113.     dobg {
  114. eval destroy [winfo child .]
  115. toplevel .t1 -use $w1
  116. toplevel .t2 -use $w2
  117. testembed
  118.     }
  119. } {{XXX {} {} .t2} {XXX {} {} .t1}}
  120. test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} {unix testembed} {
  121.     deleteWindows
  122.     frame .f1 -container 1 -width 200 -height 50
  123.     frame .f2 -container 1 -width 200 -height 50
  124.     pack .f1 .f2
  125.     toplevel .t1 -use [winfo id .f1]
  126.     toplevel .t2 -use [winfo id .f2]
  127.     testembed
  128. } {{XXX .f2 {} .t2} {XXX .f1 {} .t1}}
  130. # Can't think of any way to test the procedures TkpMakeWindow,
  131. # TkpMakeContainer, or EmbedErrorProc.
  133. test unixEmbed-2.1 {EmbeddedEventProc procedure} {unix testembed} {
  134.     deleteWindows
  135.     frame .f1 -container 1 -width 200 -height 50
  136.     pack .f1
  137.     dobg "set w1 [winfo id .f1]"
  138.     dobg {
  139. eval destroy [winfo child .]
  140. toplevel .t1 -use $w1
  141. testembed
  142.     }
  143.     destroy .f1
  144.     update
  145.     dobg {
  146. testembed
  147.     }
  148. } {}
  149. test unixEmbed-2.2 {EmbeddedEventProc procedure} {unix testembed} {
  150.     deleteWindows
  151.     frame .f1 -container 1 -width 200 -height 50
  152.     pack .f1
  153.     dobg "set w1 [winfo id .f1]"
  154.     dobg {
  155. eval destroy [winfo child .]
  156. toplevel .t1 -use $w1
  157. testembed
  158. destroy .t1
  159. testembed
  160.     }
  161. } {}
  162. test unixEmbed-2.3 {EmbeddedEventProc procedure} {unix testembed} {
  163.     deleteWindows
  164.     frame .f1 -container 1 -width 200 -height 50
  165.     pack .f1
  166.     toplevel .t1 -use [winfo id .f1]
  167.     update
  168.     destroy .f1
  169.     testembed
  170. } {}
  171. test unixEmbed-2.4 {EmbeddedEventProc procedure} {unix testembed} {
  172.     deleteWindows
  173.     frame .f1 -container 1 -width 200 -height 50
  174.     pack .f1
  175.     toplevel .t1 -use [winfo id .f1]
  176.     update
  177.     destroy .t1
  178.     set x [testembed]
  179.     update
  180.     list $x [testembed]
  181. } {{{XXX .f1 {} {}}} {}}
  183. test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} 
  184. {unix testembed nonPortable} {
  185.     deleteWindows
  186.     frame .f1 -container 1 -width 200 -height 50
  187.     pack .f1
  188.     dobg "set w1 [winfo id .f1]"
  189.     set x [testembed]
  190.     dobg {
  191. eval destroy [winfo child .]
  192. toplevel .t1 -use $w1
  193. wm withdraw .t1
  194.     }
  195.     list $x [testembed]
  196. } {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}}
  197. test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} unix {
  198.     deleteWindows
  199.     toplevel .t1 -container 1
  200.     wm geometry .t1 +0+0
  201.     toplevel .t2 -use [winfo id .t1] -bg red
  202.     update
  203.     wm geometry .t2
  204. } {200x200+0+0}
  205. test unixEmbed-3.2 {ContainerEventProc procedure, disallow position changes} unix {
  206.     deleteWindows
  207.     frame .f1 -container 1 -width 200 -height 50
  208.     pack .f1
  209.     dobg "set w1 [winfo id .f1]"
  210.     dobg {
  211. eval destroy [winfo child .]
  212. toplevel .t1 -use $w1 -bd 2 -relief raised
  213. update
  214. wm geometry .t1 +30+40
  215.     }
  216.     update
  217.     dobg {
  218. wm geometry .t1
  219.     }
  220. } {200x200+0+0}
  221. test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} unix {
  222.     deleteWindows
  223.     frame .f1 -container 1 -width 200 -height 50
  224.     pack .f1
  225.     dobg "set w1 [winfo id .f1]"
  226.     dobg {
  227. eval destroy [winfo child .]
  228. toplevel .t1 -use $w1
  229. update
  230. wm geometry .t1 300x100+30+40
  231.     }
  232.     update
  233.     dobg {
  234. wm geometry .t1
  235.     }
  236. } {300x100+0+0}
  237. test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} unix {
  238.     deleteWindows
  239.     frame .f1 -container 1 -width 200 -height 50
  240.     pack .f1
  241.     dobg "set w1 [winfo id .f1]"
  242.     dobg {
  243. eval destroy [winfo child .]
  244. toplevel .t1 -use $w1
  245.     }
  246.     update
  247.     dobg {
  248. .t1 configure -width 300 -height 80
  249.     }
  250.     update
  251.     list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}]
  252. } {300 80 300x80+0+0}
  253. test unixEmbed-3.5 {ContainerEventProc procedure, map requests} unix {
  254.     deleteWindows
  255.     frame .f1 -container 1 -width 200 -height 50
  256.     pack .f1
  257.     dobg "set w1 [winfo id .f1]"
  258.     dobg {
  259. eval destroy [winfo child .]
  260. toplevel .t1 -use $w1
  261. set x unmapped
  262. bind .t1 <Map> {set x mapped}
  263.     }
  264.     update
  265.     dobg {
  266. after 100
  267. update
  268. set x
  269.     }
  270. } {mapped}
  271. test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} unix {
  272.     deleteWindows
  273.     frame .f1 -container 1 -width 200 -height 50
  274.     pack .f1
  275.     dobg "set w1 [winfo id .f1]"
  276.     bind .f1 <Destroy> {set x dead}
  277.     set x alive
  278.     dobg {
  279. eval destroy [winfo child .]
  280. toplevel .t1 -use $w1
  281.     }
  282.     update
  283.     dobg {
  284. destroy .t1
  285.     }
  286.     update
  287.     list $x [winfo exists .f1]
  288. } {dead 0}
  290. test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} unix {
  291.     deleteWindows
  292.     frame .f1 -container 1 -width 200 -height 50
  293.     pack .f1
  294.     dobg "set w1 [winfo id .f1]"
  295.     dobg {
  296. eval destroy [winfo child .]
  297. toplevel .t1 -use $w1
  298.     }
  299.     update
  300.     dobg {
  301. .t1 configure -width 180 -height 100
  302.     }
  303.     update
  304.     dobg {
  305. winfo geometry .t1
  306.     }
  307. } {180x100+0+0}
  308. test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {unix testembed} {
  309.     deleteWindows
  310.     frame .f1 -container 1 -width 200 -height 50
  311.     pack .f1
  312.     dobg "set w1 [winfo id .f1]"
  313.     dobg {
  314. eval destroy [winfo child .]
  315. toplevel .t1 -use $w1
  316.     }
  317.     update
  318.     set x [testembed]
  319.     destroy .f1
  320.     list $x [testembed]
  321. } {{{XXX .f1 XXX {}}} {}}
  323. test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} unix {
  324.     deleteWindows
  325.     frame .f1 -container 1 -width 200 -height 50
  326.     pack .f1
  327.     dobg "set w1 [winfo id .f1]"
  328.     dobg {
  329. eval destroy [winfo child .]
  330. toplevel .t1 -use $w1
  331. bind .t1 <FocusIn> {lappend x "focus in %W"}
  332. bind .t1 <FocusOut> {lappend x "focus out %W"}
  333. set x {}
  334.     }
  335.     focus -force .f1
  336.     update
  337.     dobg {set x}
  338. } {{focus in .t1}}
  339. test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} unix {
  340.     deleteWindows
  341.     frame .f1 -container 1 -width 200 -height 50
  342.     pack .f1
  343.     dobg "set w1 [winfo id .f1]"
  344.     dobg {
  345. eval destroy [winfo child .]
  346. toplevel .t1 -use $w1
  347.     }
  348.     update
  349.     dobg {
  350. after 200 {destroy .t1}
  351.     }
  352.     after 400
  353.     focus -force .f1
  354.     update
  355. } {}
  356. test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} unix {
  357.     deleteWindows
  358.     frame .f1 -container 1 -width 200 -height 50
  359.     pack .f1
  360.     dobg "set w1 [winfo id .f1]"
  361.     dobg {
  362. eval destroy [winfo child .]
  363. toplevel .t1 -use $w1
  364. bind .t1 <FocusIn> {lappend x "focus in %W"}
  365. bind .t1 <FocusOut> {lappend x "focus out %W"}
  366. set x {}
  367.     }
  368.     focus -force .f1
  369.     update
  370.     set x [dobg {update; set x}]
  371.     focus .
  372.     update
  373.     list $x [dobg {update; set x}]
  374. } {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
  376. test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} unix {
  377.     deleteWindows
  378.     frame .f1 -container 1 -width 200 -height 50
  379.     pack .f1
  380.     dobg "set w1 [winfo id .f1]"
  381.     dobg {
  382. eval destroy [winfo child .]
  383. toplevel .t1 -use $w1
  384.     }
  385.     update
  386.     dobg {
  387. bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
  388. set x {}
  389. .t1 configure -width 300 -height 120
  390. update
  391. list $x [winfo geom .t1]
  392.     }
  393. } {{{configure .t1 300 120}} 300x120+0+0}
  394. test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} unix {
  395.     deleteWindows
  396.     frame .f1 -container 1 -width 200 -height 50
  397.     place .f1 -width 200 -height 200
  398.     dobg "set w1 [winfo id .f1]"
  399.     dobg {
  400. eval destroy [winfo child .]
  401. toplevel .t1 -use $w1
  402.     }
  403.     after 300 {set x done}
  404.     vwait x
  405.     dobg {
  406. bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
  407. set x {}
  408. .t1 configure -width 300 -height 120
  409. update
  410. list $x [winfo geom .t1]
  411.     }
  412. } {{{configure .t1 200 200}} 200x200+0+0}
  414. # Can't think up any tests for TkpGetOtherWindow procedure.
  416. test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} unix {
  417.     deleteWindows
  418.     frame .f1 -container 1 -width 200 -height 50
  419.     pack .f1
  420.     dobg "set w1 [winfo id .f1]"
  421.     dobg {
  422. eval destroy [winfo child .]
  423. toplevel .t1 -use $w1
  424.     }
  425.     focus -force .
  426.     bind . <KeyPress> {lappend x {key %A %E}}
  427.     set x {}
  428.     set y [dobg {
  429. update
  430. bind .t1 <KeyPress> {lappend y {key %A}}
  431. set y {}
  432. event generate .t1 <KeyPress> -keysym a
  433. set y
  434.     }]
  435.     update
  436.     bind . <KeyPress> {}
  437.     list $x $y
  438. } {{{key a 1}} {}}
  439. test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} unix {
  440.     deleteWindows
  441.     frame .f1 -container 1 -width 200 -height 50
  442.     pack .f1
  443.     dobg "set w1 [winfo id .f1]"
  444.     dobg {
  445. eval destroy [winfo child .]
  446. toplevel .t1 -use $w1
  447.     }
  448.     update
  449.     focus -force .f1
  450.     update
  451.     bind . <KeyPress> {lappend x {key %A}}
  452.     set x {}
  453.     set y [dobg {
  454. update
  455. bind .t1 <KeyPress> {lappend y {key %A}}
  456. set y {}
  457. event generate .t1 <KeyPress> -keysym b
  458. set y
  459.     }]
  460.     update
  461.     bind . <KeyPress> {}
  462.     list $x $y
  463. } {{} {{key b}}}
  465. test unixEmbed-8.1 {TkpClaimFocus procedure} unix {
  466.     deleteWindows
  467.     frame .f1 -container 1 -width 200 -height 50
  468.     frame .f2 -width 200 -height 50
  469.     pack .f1 .f2
  470.     dobg "set w1 [winfo id .f1]"
  471.     dobg {
  472. eval destroy [winfo child .]
  473. toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
  474.     }
  475.     focus -force .f2
  476.     update
  477.     list [dobg {
  478. focus .t1
  479. set x [list [focus]]
  480. update
  481. after 500
  482. update
  483. lappend x [focus]
  484.     }] [focus]
  485. } {{{} .t1} .f1}
  486. test unixEmbed-8.2 {TkpClaimFocus procedure} unix {
  487.     catch {interp delete child}
  488.     deleteWindows
  489.     frame .f1 -container 1 -width 200 -height 50
  490.     frame .f2 -width 200 -height 50
  491.     pack .f1 .f2
  492.     interp create child
  493.     child eval "set argv {-use [winfo id .f1]}"
  494.     load {} Tk child
  495.     child eval {
  496. . configure -bd 2 -highlightthickness 2 -relief sunken
  497.     }
  498.     focus -force .f2
  499.     update
  500.     list [child eval {
  501. focus .
  502. set x [list [focus]]
  503. update
  504. lappend x [focus]
  505.     }] [focus]
  506. } {{{} .} .f1}
  507. catch {interp delete child}
  509. test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {unix testembed} {
  510.     deleteWindows
  511.     frame .f1 -container 1 -width 200 -height 50
  512.     frame .f2 -container 1 -width 200 -height 50
  513.     frame .f3 -container 1 -width 200 -height 50
  514.     frame .f4 -container 1 -width 200 -height 50
  515.     pack .f1 .f2 .f3 .f4
  516.     set x {}
  517.     lappend x [testembed]
  518.     foreach w {.f3 .f4 .f1 .f2} {
  519. destroy $w
  520. lappend x [testembed]
  521.     }
  522.     set x
  523. } {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
  524. test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {unix testembed} {
  525.     deleteWindows
  526.     frame .f1 -container 1 -width 200 -height 50
  527.     pack .f1
  528.     dobg "set w1 [winfo id .f1]"
  529.     dobg {
  530. eval destroy [winfo child .]
  531. toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
  532. set x {}
  533. lappend x [testembed]
  534. destroy .t1
  535. lappend x [testembed]
  536.     }
  537. } {{{XXX {} {} .t1}} {}}
  539. test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix {
  540.     deleteWindows
  541.     frame .f1 -container 1 -width 200 -height 50
  542.     pack .f1
  543.     toplevel .t1 -use [winfo id .f1] -width 150 -height 80
  544.     update
  545.     wm geometry .t1 +40+50
  546.     update
  547.     wm geometry .t1
  548. } {150x80+0+0}
  549. test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix {
  550.     deleteWindows
  551.     frame .f1 -container 1 -width 200 -height 50
  552.     pack .f1
  553.     toplevel .t1 -use [winfo id .f1] -width 150 -height 80
  554.     update
  555.     wm geometry .t1 70x300+10+20
  556.     update
  557.     wm geometry .t1
  558. } {70x300+0+0}
  560. # cleanup
  561. deleteWindows
  562. cleanupbg
  563. ::tcltest::cleanupTests
  564. return