home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / scrollbar.test < prev    next >
Encoding:
Text File  |  1995-06-29  |  15.0 KB  |  432 lines
  1. # This file is a Tcl script to test out scrollbar widgets and
  2. # the "scrollbar" command of Tk.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994 Sun Microsystems, Inc.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # @(#) scrollbar.test 1.12 95/06/29 13:53:32
  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. proc scroll args {
  24.     global scrollInfo
  25.     set scrollInfo $args
  26. }
  27.  
  28. # XXX Note: this test file is woefully incomplete.  Right now there are
  29. # only bits and pieces of tests.  Please make this file more complete
  30. # as you fix bugs and add features.
  31.  
  32. frame .f -height 200 -width 1
  33. pack .f -side left
  34. scrollbar .s
  35. pack .s -side right -fill y
  36. update
  37. set i 1
  38. foreach test {
  39.     {-activebackground #ff0000 #ff0000 non-existent
  40.         {unknown color name "non-existent"}}
  41.     {-activerelief sunken sunken non-existent
  42.         {bad relief type "non-existent":  must be flat, groove, raised, ridge, or sunken}}
  43.     {-background #ff0000 #ff0000 non-existent
  44.         {unknown color name "non-existent"}}
  45.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  46.     {-bg #ff0000 #ff0000 non-existent
  47.         {unknown color name "non-existent"}}
  48.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  49.     {-command "set x" {set x} {} {}}
  50.     {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}}
  51.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  52.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  53.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  54.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  55.     {-highlightthickness -2 0 {} {}}
  56.     {-jump true 1 silly {expected boolean value but got "silly"}}
  57.     {-orient horizontal horizontal badValue
  58.         {bad orientation "badValue": must be vertical or horizontal}}
  59.     {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}}
  60.     {-relief ridge ridge badValue {bad relief type "badValue":  must be flat, groove, raised, ridge, or sunken}}
  61.     {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
  62.     {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}
  63.     {-takefocus "any string" "any string" {} {}}
  64.     {-trough #432 #432 lousy {unknown color name "lousy"}}
  65.     {-width 32 32 badValue {bad screen distance "badValue"}}
  66. } {
  67.     set name [lindex $test 0]
  68.     test scroll-1.$i {configuration options} {
  69.     .s configure $name [lindex $test 1]
  70.     lindex [.s configure $name] 4
  71.     } [lindex $test 2]
  72.     incr i
  73.     if {[lindex $test 3] != ""} {
  74.     test scroll-1.$i {configuration options} {
  75.         list [catch {.s configure $name [lindex $test 3]} msg] $msg
  76.     } [list 1 [lindex $test 4]]
  77.     }
  78.     .s configure $name [lindex [.s configure $name] 3]
  79.     incr i
  80. }
  81.  
  82. destroy .s
  83. test scroll-2.1 {Tk_ScrollbarCmd procedure} {
  84.     list [catch {scrollbar} msg] $msg
  85. } {1 {wrong # args:  should be "scrollbar pathName ?options?"}}
  86. test scroll-2.2 {Tk_ScrollbarCmd procedure} {
  87.     list [catch {scrollbar gorp} msg] $msg
  88. } {1 {bad window path name "gorp"}}
  89. test scroll-2.3 {Tk_ScrollbarCmd procedure} {
  90.     scrollbar .s
  91.     set x "[winfo class .s] [info command .s]"
  92.     destroy .s
  93.     set x
  94. } {Scrollbar .s}
  95. test scroll-2.4 {Tk_ScrollbarCmd procedure} {
  96.     list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] \
  97.         [info command .s]
  98. } {1 {unknown option "-gorp"} 0 {}}
  99. test scroll-2.5 {Tk_ScrollbarCmd procedure} {
  100.     set x [scrollbar .s]
  101.     destroy .s
  102.     set x
  103. } {.s}
  104.  
  105. scrollbar .s -orient vertical -command scroll
  106. pack .s -side right -fill y
  107. update
  108. test scroll-3.1 {ScrollbarWidgetCmd procedure} {
  109.     list [catch {.s} msg] $msg
  110. } {1 {wrong # args: should be ".s option ?arg arg ...?"}}
  111. test scroll-3.2 {ScrollbarWidgetCmd procedure, "cget" option} {
  112.     list [catch {.s cget} msg] $msg
  113. } {1 {wrong # args: should be ".s cget option"}}
  114. test scroll-3.3 {ScrollbarWidgetCmd procedure, "cget" option} {
  115.     list [catch {.s cget -gorp} msg] $msg
  116. } {1 {unknown option "-gorp"}}
  117. test scroll-3.4 {ScrollbarWidgetCmd procedure, "activate" option} {
  118.     list [catch {.s activate a b} msg] $msg
  119. } {1 {wrong # args: should be ".s activate element"}}
  120. test scroll-3.5 {ScrollbarWidgetCmd procedure, "activate" option} {
  121.     .s activate arrow1
  122.     .s activate
  123. } {arrow1}
  124. test scroll-3.6 {ScrollbarWidgetCmd procedure, "activate" option} {
  125.     .s activate slider
  126.     .s activate
  127. } {slider}
  128. test scroll-3.7 {ScrollbarWidgetCmd procedure, "activate" option} {
  129.     .s activate arrow2
  130.     .s activate
  131. } {arrow2}
  132. test scroll-3.8 {ScrollbarWidgetCmd procedure, "activate" option} {
  133.     .s activate s
  134.     .s activate {}
  135.     .s activate
  136. } {}
  137. test scroll-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
  138.     list [catch {.s activate trough1} msg] $msg
  139. } {0 {}}
  140. test scroll-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
  141.     list [catch {.s cget -orient} msg] $msg
  142. } {0 vertical}
  143. test scroll-3.11 {ScrollbarWidgetCmd procedure, "configure" option} {
  144.     llength [.s configure]
  145. } {20}
  146. test scroll-3.12 {ScrollbarWidgetCmd procedure, "configure" option} {
  147.     list [catch {.s configure -bad} msg] $msg
  148. } {1 {unknown option "-bad"}}
  149. test scroll-3.13 {ScrollbarWidgetCmd procedure, "configure" option} {
  150.     .s configure -orient
  151. } {-orient orient Orient vertical vertical}
  152. test scroll-3.14 {ScrollbarWidgetCmd procedure, "configure" option} {
  153.     .s configure -orient horizontal
  154.     set x [.s cget -orient]
  155.     .s configure -orient vertical
  156.     set x
  157. } {horizontal}
  158. test scroll-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
  159.     list [catch {.s configure -bad worse} msg] $msg
  160. } {1 {unknown option "-bad"}}
  161. test scroll-3.16 {ScrollbarWidgetCmd procedure, "delta" option} {
  162.     list [catch {.s delta 24} msg] $msg
  163. } {1 {wrong # args: should be ".s delta xDelta yDelta"}}
  164. test scroll-3.17 {ScrollbarWidgetCmd procedure, "delta" option} {
  165.     list [catch {.s delta 24 35 42} msg] $msg
  166. } {1 {wrong # args: should be ".s delta xDelta yDelta"}}
  167. test scroll-3.18 {ScrollbarWidgetCmd procedure, "delta" option} {
  168.     list [catch {.s delta silly 24} msg] $msg
  169. } {1 {expected integer but got "silly"}}
  170. test scroll-3.19 {ScrollbarWidgetCmd procedure, "delta" option} {
  171.     list [catch {.s delta 18 xxyz} msg] $msg
  172. } {1 {expected integer but got "xxyz"}}
  173. test scroll-3.20 {ScrollbarWidgetCmd procedure, "delta" option} {
  174.     list [catch {.s delta 18 xxyz} msg] $msg
  175. } {1 {expected integer but got "xxyz"}}
  176. test scroll-3.21 {ScrollbarWidgetCmd procedure, "delta" option} {
  177.     .s delta 20 0
  178. } {0}
  179. test scroll-3.22 {ScrollbarWidgetCmd procedure, "delta" option} {
  180.     .s delta 0 20
  181. } {0.125786}
  182. test scroll-3.23 {ScrollbarWidgetCmd procedure, "delta" option} {
  183.     .s delta 0 -20
  184. } {-0.125786}
  185. test scroll-3.24 {ScrollbarWidgetCmd procedure, "delta" option} {
  186.     toplevel .t -width 250 -height 100
  187.     wm geom .t +0+0
  188.     scrollbar .t.s -orient horizontal -borderwidth 2
  189.     place .t.s -width 201
  190.     update
  191.     set result [list [.t.s delta 0 20] [.t.s delta 160 0]]
  192.     destroy .t
  193.     set result
  194. } {0 1}
  195. test scroll-3.25 {ScrollbarWidgetCmd procedure, "fraction" option} {
  196.     list [catch {.s fraction 24} msg] $msg
  197. } {1 {wrong # args: should be ".s fraction x y"}}
  198. test scroll-3.26 {ScrollbarWidgetCmd procedure, "fraction" option} {
  199.     list [catch {.s fraction 24 30 32} msg] $msg
  200. } {1 {wrong # args: should be ".s fraction x y"}}
  201. test scroll-3.27 {ScrollbarWidgetCmd procedure, "fraction" option} {
  202.     list [catch {.s fraction silly 24} msg] $msg
  203. } {1 {expected integer but got "silly"}}
  204. test scroll-3.28 {ScrollbarWidgetCmd procedure, "fraction" option} {
  205.     list [catch {.s fraction 24 bogus} msg] $msg
  206. } {1 {expected integer but got "bogus"}}
  207. test scroll-3.29 {ScrollbarWidgetCmd procedure, "fraction" option} {
  208.     .s fraction 0 0
  209. } {0}
  210. test scroll-3.30 {ScrollbarWidgetCmd procedure, "fraction" option} {
  211.     .s fraction 0 1000
  212. } {1}
  213. test scroll-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} {
  214.     .s fraction 4 21
  215. } {0.00628931}
  216. test scroll-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} {
  217.     .s fraction 4 179
  218. } {1}
  219. test scroll-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} {
  220.     .s fraction 4 178
  221. } {0.993711}
  222. toplevel .t -width 250 -height 100
  223. wm geom .t +0+0
  224. scrollbar .t.s -orient horizontal -borderwidth 2
  225. place .t.s -width 201
  226. update
  227. test scroll-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
  228.     .t.s fraction 100 0
  229. } {0.5}
  230. place configure .t.s -width [expr [winfo reqwidth .t.s] - 4]
  231. update
  232. test scroll-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
  233.     .t.s fraction 100 0
  234. } {0}
  235. destroy .t
  236. test scroll-3.36 {ScrollbarWidgetCmd procedure, "get" option} {
  237.     list [catch {.s get a} msg] $msg
  238. } {1 {wrong # args: should be ".s get"}}
  239. test scroll-3.37 {ScrollbarWidgetCmd procedure, "get" option} {
  240.     .s set 100 10 13 14
  241.     .s get
  242. } {100 10 13 14}
  243. test scroll-3.38 {ScrollbarWidgetCmd procedure, "get" option} {
  244.     .s set 0.6 0.8
  245.     .s get
  246. } {0.6 0.8}
  247. test scroll-3.39 {ScrollbarWidgetCmd procedure, "identify" option} {
  248.     list [catch {.s identify 0} msg] $msg
  249. } {1 {wrong # args: should be ".s identify x y"}}
  250. test scroll-3.40 {ScrollbarWidgetCmd procedure, "identify" option} {
  251.     list [catch {.s identify 0 0 1} msg] $msg
  252. } {1 {wrong # args: should be ".s identify x y"}}
  253. test scroll-3.41 {ScrollbarWidgetCmd procedure, "identify" option} {
  254.     list [catch {.s identify bogus 2} msg] $msg
  255. } {1 {expected integer but got "bogus"}}
  256. test scroll-3.42 {ScrollbarWidgetCmd procedure, "identify" option} {
  257.     list [catch {.s identify -1 bogus} msg] $msg
  258. } {1 {expected integer but got "bogus"}}
  259. test scroll-3.43 {ScrollbarWidgetCmd procedure, "identify" option} {
  260.     .s identify 5 5
  261. } {arrow1}
  262. test scroll-3.44 {ScrollbarWidgetCmd procedure, "identify" option} {
  263.     .s identify 5 35
  264. } {trough1}
  265. test scroll-3.45 {ScrollbarWidgetCmd procedure, "identify" option} {
  266.     .s set .3 .6
  267.     .s identify 5 100
  268. } {slider}
  269. test scroll-3.46 {ScrollbarWidgetCmd procedure, "identify" option} {
  270.     .s identify 5 145
  271. } {trough2}
  272. test scroll-3.47 {ScrollbarWidgetCmd procedure, "identify" option} {
  273.     .s identify 5 195
  274. } {arrow2}
  275. test scroll-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
  276.     .s identify 0 0
  277. } {}
  278. test scroll-3.49 {ScrollbarWidgetCmd procedure, "set" option} {
  279.     list [catch {.s set abc def} msg] $msg
  280. } {1 {expected floating-point number but got "abc"}}
  281. test scroll-3.50 {ScrollbarWidgetCmd procedure, "set" option} {
  282.     list [catch {.s set 0.6 def} msg] $msg
  283. } {1 {expected floating-point number but got "def"}}
  284. test scroll-3.51 {ScrollbarWidgetCmd procedure, "set" option} {
  285.     .s set -.2 .3
  286.     .s get
  287. } {0.0 0.3}
  288. test scroll-3.52 {ScrollbarWidgetCmd procedure, "set" option} {
  289.     .s set 1.1 .4 
  290.     .s get
  291. } {1.0 1.0}
  292. test scroll-3.53 {ScrollbarWidgetCmd procedure, "set" option} {
  293.     .s set .5 -.3 
  294.     .s get
  295. } {0.5 0.5}
  296. test scroll-3.54 {ScrollbarWidgetCmd procedure, "set" option} {
  297.     .s set .5 87 
  298.     .s get
  299. } {0.5 1.0}
  300. test scroll-3.55 {ScrollbarWidgetCmd procedure, "set" option} {
  301.     .s set .4 .3 
  302.     .s get
  303. } {0.4 0.4}
  304. test scroll-3.56 {ScrollbarWidgetCmd procedure, "set" option} {
  305.     list [catch {.s set abc def ghi jkl} msg] $msg
  306. } {1 {expected integer but got "abc"}}
  307. test scroll-3.57 {ScrollbarWidgetCmd procedure, "set" option} {
  308.     list [catch {.s set 1 def ghi jkl} msg] $msg
  309. } {1 {expected integer but got "def"}}
  310. test scroll-3.58 {ScrollbarWidgetCmd procedure, "set" option} {
  311.     list [catch {.s set 1 2 ghi jkl} msg] $msg
  312. } {1 {expected integer but got "ghi"}}
  313. test scroll-3.59 {ScrollbarWidgetCmd procedure, "set" option} {
  314.     list [catch {.s set 1 2 3 jkl} msg] $msg
  315. } {1 {expected integer but got "jkl"}}
  316. test scroll-3.60 {ScrollbarWidgetCmd procedure, "set" option} {
  317.     .s set -10 50 20 30 
  318.     .s get
  319. } {0 50 0 0}
  320. test scroll-3.61 {ScrollbarWidgetCmd procedure, "set" option} {
  321.     .s set 100 -10 20 30 
  322.     .s get
  323. } {100 0 20 30}
  324. test scroll-3.62 {ScrollbarWidgetCmd procedure, "set" option} {
  325.     .s set 100 50 30 20 
  326.     .s get
  327. } {100 50 30 30}
  328. test scroll-3.63 {ScrollbarWidgetCmd procedure, "set" option} {
  329.     list [catch {.s set 1 2 3} msg] $msg
  330. } {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
  331. test scroll-3.64 {ScrollbarWidgetCmd procedure, "set" option} {
  332.     list [catch {.s set 1 2 3 4 5} msg] $msg
  333. } {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
  334. test scroll-3.65 {ScrollbarWidgetCmd procedure} {
  335.     list [catch {.s bogus} msg] $msg
  336. } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}}
  337. test scroll-3.66 {ScrollbarWidgetCmd procedure} {
  338.     list [catch {.s c} msg] $msg
  339. } {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}}
  340.  
  341. test scroll-4.1 {ScrollbarEventProc procedure} {
  342.     catch {destroy .s1}
  343.     scrollbar .s1 -bg #543210
  344.     rename .s1 .s2
  345.     set x {}
  346.     lappend x [winfo exists .s1]
  347.     lappend x [.s2 cget -bg]
  348.     destroy .s1
  349.     lappend x [info command .s?] [winfo exists .s1] [winfo exists .s2]
  350. } {1 #543210 {} 0 0}
  351.  
  352. test scroll-5.1 {ScrollbarCmdDeletedProc procedure} {
  353.     catch {destroy .s1}
  354.     scrollbar .s1
  355.     rename .s1 {}
  356.     list [info command .s?] [winfo exists .s1]
  357. } {{} 0}
  358.  
  359. catch {destroy .s}
  360. scrollbar .s -orient vertical -relief sunken
  361. pack .s -side right -fill y
  362. .s set .2 .4
  363. update
  364. test scroll-6.1 {ScrollbarPosition procedure} {
  365.     .s identify 8 3
  366. } {}
  367. test scroll-6.2 {ScrollbarPosition procedure} {
  368.     .s identify 8 4
  369. } {arrow1}
  370. test scroll-6.3 {ScrollbarPosition procedure} {
  371.     .s identify 8 19
  372. } {arrow1}
  373. test scroll-6.4 {ScrollbarPosition procedure} {
  374.     .s identify 8 20
  375. } {trough1}
  376. test scroll-6.5 {ScrollbarPosition procedure} {
  377.     .s identify 8 51
  378. } {trough1}
  379. test scroll-6.6 {ScrollbarPosition procedure} {
  380.     .s identify 8 52
  381. } {slider}
  382. test scroll-6.7 {ScrollbarPosition procedure} {
  383.     .s identify 8 83
  384. } {slider}
  385. test scroll-6.8 {ScrollbarPosition procedure} {
  386.     .s identify 8 84
  387. } {trough2}
  388. test scroll-6.9 {ScrollbarPosition procedure} {
  389.     .s identify 8 179
  390. } {trough2}
  391. test scroll-6.10 {ScrollbarPosition procedure} {
  392.     .s identify 8 180
  393. } {arrow2}
  394. test scroll-6.11 {ScrollbarPosition procedure} {
  395.     .s identify 8 195
  396. } {arrow2}
  397. test scroll-6.12 {ScrollbarPosition procedure} {
  398.     .s identify 8 196
  399. } {}
  400. test scroll-6.13 {ScrollbarPosition procedure} {
  401.     .s identify 3 100
  402. } {}
  403. test scroll-6.14 {ScrollbarPosition procedure} {
  404.     .s identify 4 100
  405. } {trough2}
  406. test scroll-6.15 {ScrollbarPosition procedure} {
  407.     .s identify 18 100
  408. } {trough2}
  409. test scroll-6.16 {ScrollbarPosition procedure} {
  410.     .s identify 19 100
  411. } {}
  412. catch {destroy .t}
  413. toplevel .t -width 250 -height 150
  414. wm geometry .t +0+0
  415. scrollbar .t.s -orient horizontal -relief sunken
  416. place .t.s -width 200
  417. .t.s set .2 .4
  418. update
  419. test scroll-6.17 {ScrollbarPosition procedure} {
  420.     .t.s identify 4 8
  421. } {arrow1}
  422. test scroll-6.18 {ScrollbarPosition procedure} {
  423.     .t.s identify 82 8
  424. } {slider}
  425. test scroll-6.19 {ScrollbarPosition procedure} {
  426.     .t.s identify 100 18
  427. } {trough2}
  428.  
  429. catch {destroy .s}
  430. catch {destroy .t}
  431. concat {}
  432.