diff options
Diffstat (limited to 'tests/cursor.test')
| -rw-r--r-- | tests/cursor.test | 319 |
1 files changed, 172 insertions, 147 deletions
diff --git a/tests/cursor.test b/tests/cursor.test index 3624b62..539e933 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -7,14 +7,9 @@ # All rights reserved. package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] +eval tcltest::configure $argv tcltest::loadTestedCommands -testConstraint testcursor [llength [info commands testcursor]] - test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} { set x watch lindex $x 0 @@ -79,19 +74,19 @@ set wincur(data_octal) { } set wincur(data_binary) {} foreach wincur(num) $wincur(data_octal) { - append wincur(data_binary) [binary format c 0$wincur(num)] + append wincur(data_binary) [binary format c [scan $wincur(num) %o]] } -set wincur(dir) [::tcltest::makeDirectory {dir with spaces}] -set wincur(file) [::tcltest::makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] -test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} { +set wincur(dir) [makeDirectory {dir with spaces}] +set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] +test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor [list @$wincur(file)] } {.b1} -test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} { +test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] } {.b1} -::tcltest::removeDirectory $wincur(dir) +removeDirectory $wincur(dir) unset wincur test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { @@ -132,157 +127,187 @@ test cursor-4.1 {FreeCursorObjProc} {testcursor} { # ------------------------------------------------------------------------- -test cursor-5.1 {assert consistent cursor configuration command} \ - -setup { button .b } \ - -body { - list [catch {.b configure -cursor {watch red black}} msg] $msg - } \ - -cleanup {destroy .b} \ - -result {0 {}} +test cursor-5.1 {assert consistent cursor configuration command} -setup { + button .b +} -body { + .b configure -cursor {watch red black} +} -cleanup { + destroy .b +} -result {} # ------------------------------------------------------------------------- # Check for the standard set of cursors. -set n 0 -foreach cursor { - X_cursor - arrow - based_arrow_down - based_arrow_up - boat - bogosity - bottom_left_corner - bottom_right_corner - bottom_side - bottom_tee - box_spiral - center_ptr - circle - clock - coffee_mug - cross - cross_reverse - crosshair - diamond_cross - dot - dotbox - double_arrow - draft_large - draft_small - draped_box - exchange - fleur - gobbler - gumby - hand1 - hand2 - heart - icon - iron_cross - left_ptr - left_side - left_tee - leftbutton - ll_angle - lr_angle - man - middlebutton - mouse - pencil - pirate - plus - question_arrow - right_ptr - right_side - right_tee - rightbutton - rtl_logo - sailboat - sb_down_arrow - sb_h_double_arrow - sb_left_arrow - sb_right_arrow - sb_up_arrow - sb_v_double_arrow - shuttle - sizing - spider - spraycan - star - target - tcross - top_left_arrow - top_left_corner - top_right_corner - top_side - top_tee - trek - ul_angle - umbrella - ur_angle - watch - xterm +foreach {testName cursor} { + cursor-6.1 X_cursor + cursor-6.2 arrow + cursor-6.3 based_arrow_down + cursor-6.4 based_arrow_up + cursor-6.5 boat + cursor-6.6 bogosity + cursor-6.7 bottom_left_corner + cursor-6.8 bottom_right_corner + cursor-6.9 bottom_side + cursor-6.10 bottom_tee + cursor-6.11 box_spiral + cursor-6.12 center_ptr + cursor-6.13 circle + cursor-6.14 clock + cursor-6.15 coffee_mug + cursor-6.16 cross + cursor-6.17 cross_reverse + cursor-6.18 crosshair + cursor-6.19 diamond_cross + cursor-6.20 dot + cursor-6.21 dotbox + cursor-6.22 double_arrow + cursor-6.23 draft_large + cursor-6.24 draft_small + cursor-6.25 draped_box + cursor-6.26 exchange + cursor-6.27 fleur + cursor-6.28 gobbler + cursor-6.29 gumby + cursor-6.30 hand1 + cursor-6.31 hand2 + cursor-6.32 heart + cursor-6.33 icon + cursor-6.34 iron_cross + cursor-6.35 left_ptr + cursor-6.36 left_side + cursor-6.37 left_tee + cursor-6.38 leftbutton + cursor-6.39 ll_angle + cursor-6.40 lr_angle + cursor-6.41 man + cursor-6.42 middlebutton + cursor-6.43 mouse + cursor-6.44 pencil + cursor-6.45 pirate + cursor-6.46 plus + cursor-6.47 question_arrow + cursor-6.48 right_ptr + cursor-6.49 right_side + cursor-6.50 right_tee + cursor-6.51 rightbutton + cursor-6.52 rtl_logo + cursor-6.53 sailboat + cursor-6.54 sb_down_arrow + cursor-6.55 sb_h_double_arrow + cursor-6.56 sb_left_arrow + cursor-6.57 sb_right_arrow + cursor-6.58 sb_up_arrow + cursor-6.59 sb_v_double_arrow + cursor-6.60 shuttle + cursor-6.61 sizing + cursor-6.62 spider + cursor-6.63 spraycan + cursor-6.64 star + cursor-6.65 target + cursor-6.66 tcross + cursor-6.67 top_left_arrow + cursor-6.68 top_left_corner + cursor-6.69 top_right_corner + cursor-6.70 top_side + cursor-6.71 top_tee + cursor-6.72 trek + cursor-6.73 ul_angle + cursor-6.74 umbrella + cursor-6.75 ur_angle + cursor-6.76 watch + cursor-6.77 xterm } { - test cursor-6.$n {check cursor $cursor} \ - -setup {button .b -text $cursor} \ - -body { - list [catch {.b configure -cursor $cursor} msg] $msg - } \ - -cleanup {destroy .b} \ - -result {0 {}} - incr n + test $testName "check cursor-font cursor $cursor" -setup { + button .b -text $cursor + } -body { + .b configure -cursor $cursor + } -cleanup { + destroy .b + } -result {} } -unset n + +# Test cursor named "none", it is not defined in +# the X cursor table. It is defined in a Tk specific +# table of named cursors and should be available on +# all platforms. + +test cursor-6.80 {} -setup { + button .b -text CButton +} -body { + .b configure -cursor none + .b cget -cursor +} -cleanup { + destroy .b +} -result none + +test cursor-6.81 {} -setup { + button .b -text CButton +} -body { + .b configure -cursor none + .b configure -cursor {} + .b cget -cursor +} -cleanup { + destroy .b +} -result {} + +test cursor-6.82 {} -setup { + button .b -text CButton +} -body { + .b configure -cursor none + .b configure -cursor {} + .b configure -cursor none + .b cget -cursor +} -cleanup { + destroy .b +} -result none + +test cursor-6.83 {} -setup { + button .b -text CButton +} -body { + # Setting fg and bg does nothing for the none cursor + # because it displays no fg or bg pixels. + set results [list] + .b configure -cursor none + lappend results [.b cget -cursor] + .b configure -cursor {none blue} + lappend results [.b cget -cursor] + .b configure -cursor {none blue green} + lappend results [.b cget -cursor] + .b configure -cursor {} + lappend results [.b cget -cursor] + set results +} -cleanup { + destroy .b + unset results +} -result {none {none blue} {none blue green} {}} # ------------------------------------------------------------------------- # Check the Windows specific cursors -set n 0 -foreach cursor { - no - starting - size - size_ne_sw - size_ns - size_nw_se - size_we - uparrow - wait -} { - test cursor-7.$n {check cursor $cursor} \ - -constraints {pcOnly} \ - -setup {button .b -text $cursor} \ - -body { - list [catch {.b configure -cursor $cursor} msg] $msg - } \ - -cleanup {destroy .b} \ - -result {0 {}} - incr n -} -unset n -# ------------------------------------------------------------------------- -# Check the Mac specific cursors -set n 0 -foreach cursor { - text - cross-hair +foreach {testName cursor} { + cursor-7.1 no + cursor-7.2 starting + cursor-7.3 size + cursor-7.4 size_ne_sw + cursor-7.5 size_ns + cursor-7.6 size_nw_se + cursor-7.7 size_we + cursor-7.8 uparrow + cursor-7.9 wait } { - test cursor-8.$n {check cursor $cursor} \ - -constraints {macOnly} \ - -setup {button .b -text $cursor} \ - -body { - list [catch {.b configure -cursor $cursor} msg] $msg - } \ - -cleanup {destroy .b} \ - -result {0 {}} - incr n + test $testName "check Windows cursor $cursor" -constraints win -setup { + button .b -text $cursor + } -body { + .b configure -cursor $cursor + } -cleanup { + destroy .b + } -result {} } -unset n # ------------------------------------------------------------------------- destroy .t # cleanup -::tcltest::cleanupTests +cleanupTests return |