diff options
| -rw-r--r-- | tests/cursor.test | 904 | ||||
| -rw-r--r-- | tests/message.test | 536 |
2 files changed, 1162 insertions, 278 deletions
diff --git a/tests/cursor.test b/tests/cursor.test index f728174..4d2e608 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -6,98 +6,135 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: cursor.test,v 1.18 2007/12/13 15:27:54 dgp Exp $ +# RCS: @(#) $Id: cursor.test,v 1.19 2008/07/28 10:53:45 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} { + +# Tests 2.3 and 2.4 need a helper file with a very specific name and +# controlled format. +proc setWincur {wincurName} { + upvar $wincurName wincur + set wincur(data_octal) { + 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 + 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 + 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036 + 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360 + 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370 + 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016 + 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300 + 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007 + 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003 + 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 + 377 377 017 360 377 377 + } + set wincur(data_binary) {} + foreach wincur(num) $wincur(data_octal) { + append wincur(data_binary) [binary format c [scan $wincur(num) %o]] + } + set wincur(dir) [makeDirectory {dir with spaces}] + set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] +} + + +test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} -constraints { + testcursor +} -body { set x watch lindex $x 0 - destroy .b1 - button .b1 -cursor $x + button .b -cursor $x lindex $x 0 testcursor watch -} {{1 0}} -test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {testcursor} { +} -cleanup { + destroy .b +} -result {{1 0}} +test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} -constraints { + testcursor +} -body { set x watch - destroy .b1 .b2 + set result {} button .b1 -cursor $x destroy .b1 - set result {} lappend result [testcursor watch] button .b2 -cursor $x lappend result [testcursor watch] -} {{} {{1 1}}} -test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {testcursor} { +} -cleanup { + destroy .b2 +} -result {{} {{1 1}}} +test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} -constraints { + testcursor +} -body { set x watch - destroy .b1 .b2 - button .b1 -cursor $x set result {} + button .b1 -cursor $x lappend result [testcursor watch] button .b2 -cursor $x pack .b1 .b2 -side top lappend result [testcursor watch] -} {{{1 1}} {{2 1}}} +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} -test cursor-2.1 {Tk_GetCursor procedure} { - destroy .b1 - list [catch {button .b1 -cursor bad_name} msg] $msg -} {1 {bad cursor spec "bad_name"}} -test cursor-2.2 {Tk_GetCursor procedure} { - destroy .b1 - list [catch {button .b1 -cursor @xyzzy} msg] $msg -} {1 {bad cursor spec "@xyzzy"}} -# Next two tests need a helper file with a very specific name and -# controlled format. -set wincur(data_octal) { - 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 - 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 - 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036 - 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360 - 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370 - 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016 - 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300 - 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007 - 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003 - 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 - 377 377 017 360 377 377 -} -set wincur(data_binary) {} -foreach wincur(num) $wincur(data_octal) { - append wincur(data_binary) [binary format c [scan $wincur(num) %o]] -} -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} win { - destroy .b1 - button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] -} {.b1} -removeDirectory $wincur(dir) -unset wincur +test cursor-2.1 {Tk_GetCursor procedure} -body { + button .b -cursor bad_name +} -cleanup { + destroy .b +} -returnCodes error -result {bad cursor spec "bad_name"} +test cursor-2.2 {Tk_GetCursor procedure} -body { + button .b -cursor @xyzzy +} -cleanup { + destroy .b +} -returnCodes error -result {bad cursor spec "@xyzzy"} -test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { +test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} -constraints { + win +} -setup { + unset -nocomplain wincur + set wincur(file) "" +} -body { + setWincur wincur + button .b -cursor [list @$wincur(file)] +} -cleanup { + destroy .b + removeDirectory $wincur(dir) + unset wincur +} -result {.b} +test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} -constraints { + win +} -setup { + unset -nocomplain wincur + set wincur(file) "" +} -body { + setWincur wincur + button .b -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] +} -cleanup { + destroy .b + removeDirectory $wincur(dir) + unset wincur +} -result {.b} + +test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} -constraints { + testcursor +} -setup { set x heart - destroy .b1 .b2 .b3 + set result {} +} -body { button .b1 -cursor $x button .b3 -cursor $x button .b2 -cursor $x - set result {} lappend result [testcursor heart] destroy .b1 lappend result [testcursor heart] @@ -105,10 +142,11 @@ test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { lappend result [testcursor heart] destroy .b3 lappend result [testcursor heart] -} {{{3 1}} {{2 1}} {{1 1}} {}} +} -result {{{3 1}} {{2 1}} {{1 1}} {}} -test cursor-4.1 {FreeCursorObjProc} {testcursor} { - destroy .b +test cursor-4.1 {FreeCursorObjProc} -constraints { + testcursor +} -body { set x [format heart] button .b -cursor $x set y [format heart] @@ -125,10 +163,11 @@ test cursor-4.1 {FreeCursorObjProc} {testcursor} { lappend result [testcursor heart] set y bogus set result -} {{{1 3}} {{1 2}} {{1 1}} {}} +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} # ------------------------------------------------------------------------- - test cursor-5.1 {assert consistent cursor configuration command} -setup { button .b } -body { @@ -139,101 +178,551 @@ test cursor-5.1 {assert consistent cursor configuration command} -setup { # ------------------------------------------------------------------------- # Check for the standard set of cursors. - -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 $testName "check cursor-font cursor $cursor" -setup { - button .b -text $cursor - } -body { - .b configure -cursor $cursor - } -cleanup { - destroy .b - } -result {} -} +test cursor-6.1 {check cursor-font cursor X_cursor} -setup { + button .b -text X_cursor +} -body { + .b configure -cursor X_cursor +} -cleanup { + destroy .b +} -result {} +test cursor-6.2 {check cursor-font cursor arrow} -setup { + button .b -text arrow +} -body { + .b configure -cursor arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.3 {check cursor-font cursor based_arrow_down} -setup { + button .b -text based_arrow_down +} -body { + .b configure -cursor based_arrow_down +} -cleanup { + destroy .b +} -result {} +test cursor-6.4 {check cursor-font cursor based_arrow_up} -setup { + button .b -text based_arrow_up +} -body { + .b configure -cursor based_arrow_up +} -cleanup { + destroy .b +} -result {} +test cursor-6.5 {check cursor-font cursor boat} -setup { + button .b -text boat +} -body { + .b configure -cursor boat +} -cleanup { + destroy .b +} -result {} +test cursor-6.6 {check cursor-font cursor bogosity} -setup { + button .b -text bogosity +} -body { + .b configure -cursor bogosity +} -cleanup { + destroy .b +} -result {} +test cursor-6.7 {check cursor-font cursor bottom_left_corner} -setup { + button .b -text bottom_left_corner +} -body { + .b configure -cursor bottom_left_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.8 {check cursor-font cursor bottom_right_corner} -setup { + button .b -text bottom_right_corner +} -body { + .b configure -cursor bottom_right_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.9 {check cursor-font cursor bottom_side} -setup { + button .b -text bottom_side +} -body { + .b configure -cursor bottom_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.10 {check cursor-font cursor bottom_tee} -setup { + button .b -text bottom_tee +} -body { + .b configure -cursor bottom_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.11 {check cursor-font cursor box_spiral} -setup { + button .b -text box_spiral +} -body { + .b configure -cursor box_spiral +} -cleanup { + destroy .b +} -result {} +test cursor-6.12 {check cursor-font cursor center_ptr} -setup { + button .b -text center_ptr +} -body { + .b configure -cursor center_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.13 {check cursor-font cursor circle} -setup { + button .b -text circle +} -body { + .b configure -cursor circle +} -cleanup { + destroy .b +} -result {} +test cursor-6.14 {check cursor-font cursor clock} -setup { + button .b -text clock +} -body { + .b configure -cursor clock +} -cleanup { + destroy .b +} -result {} +test cursor-6.15 {check cursor-font cursor coffee_mug} -setup { + button .b -text coffee_mug +} -body { + .b configure -cursor coffee_mug +} -cleanup { + destroy .b +} -result {} +test cursor-6.16 {check cursor-font cursor cross} -setup { + button .b -text cross +} -body { + .b configure -cursor cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.17 {check cursor-font cursor cross_reverse} -setup { + button .b -text cross_reverse +} -body { + .b configure -cursor cross_reverse +} -cleanup { + destroy .b +} -result {} +test cursor-6.18 {check cursor-font cursor crosshair} -setup { + button .b -text crosshair +} -body { + .b configure -cursor crosshair +} -cleanup { + destroy .b +} -result {} +test cursor-6.19 {check cursor-font cursor diamond_cross} -setup { + button .b -text diamond_cross +} -body { + .b configure -cursor diamond_cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.20 {check cursor-font cursor dot} -setup { + button .b -text dot +} -body { + .b configure -cursor dot +} -cleanup { + destroy .b +} -result {} +test cursor-6.21 {check cursor-font cursor dotbox} -setup { + button .b -text dotbox +} -body { + .b configure -cursor dotbox +} -cleanup { + destroy .b +} -result {} +test cursor-6.22 {check cursor-font cursor double_arrow} -setup { + button .b -text double_arrow +} -body { + .b configure -cursor double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.23 {check cursor-font cursor draft_large} -setup { + button .b -text draft_large +} -body { + .b configure -cursor draft_large +} -cleanup { + destroy .b +} -result {} +test cursor-6.24 {check cursor-font cursor draft_small} -setup { + button .b -text draft_small +} -body { + .b configure -cursor draft_small +} -cleanup { + destroy .b +} -result {} +test cursor-6.25 {check cursor-font cursor draped_box} -setup { + button .b -text draped_box +} -body { + .b configure -cursor draped_box +} -cleanup { + destroy .b +} -result {} +test cursor-6.26 {check cursor-font cursor exchange} -setup { + button .b -text exchange +} -body { + .b configure -cursor exchange +} -cleanup { + destroy .b +} -result {} +test cursor-6.27 {check cursor-font cursor fleur} -setup { + button .b -text fleur +} -body { + .b configure -cursor fleur +} -cleanup { + destroy .b +} -result {} +test cursor-6.28 {check cursor-font cursor gobbler} -setup { + button .b -text gobbler +} -body { + .b configure -cursor gobbler +} -cleanup { + destroy .b +} -result {} +test cursor-6.29 {check cursor-font cursor gumby} -setup { + button .b -text gumby +} -body { + .b configure -cursor gumby +} -cleanup { + destroy .b +} -result {} +test cursor-6.30 {check cursor-font cursor hand1} -setup { + button .b -text hand1 +} -body { + .b configure -cursor hand1 +} -cleanup { + destroy .b +} -result {} +test cursor-6.31 {check cursor-font cursor hand2} -setup { + button .b -text hand2 +} -body { + .b configure -cursor hand2 +} -cleanup { + destroy .b +} -result {} +test cursor-6.32 {check cursor-font cursor heart} -setup { + button .b -text heart +} -body { + .b configure -cursor heart +} -cleanup { + destroy .b +} -result {} +test cursor-6.33 {check cursor-font cursor icon} -setup { + button .b -text icon +} -body { + .b configure -cursor icon +} -cleanup { + destroy .b +} -result {} +test cursor-6.34 {check cursor-font cursor iron_cross} -setup { + button .b -text iron_cross +} -body { + .b configure -cursor iron_cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.35 {check cursor-font cursor left_ptr} -setup { + button .b -text left_ptr +} -body { + .b configure -cursor left_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.36 {check cursor-font cursor left_side} -setup { + button .b -text left_side +} -body { + .b configure -cursor left_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.37 {check cursor-font cursor left_tee} -setup { + button .b -text left_tee +} -body { + .b configure -cursor left_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.38 {check cursor-font cursor leftbutton} -setup { + button .b -text leftbutton +} -body { + .b configure -cursor leftbutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.39 {check cursor-font cursor ll_angle} -setup { + button .b -text ll_angle +} -body { + .b configure -cursor ll_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.40 {check cursor-font cursor lr_angle} -setup { + button .b -text lr_angle +} -body { + .b configure -cursor lr_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.41 {check cursor-font cursor man} -setup { + button .b -text man +} -body { + .b configure -cursor man +} -cleanup { + destroy .b +} -result {} +test cursor-6.42 {check cursor-font cursor middlebutton} -setup { + button .b -text middlebutton +} -body { + .b configure -cursor middlebutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.43 {check cursor-font cursor mouse} -setup { + button .b -text mouse +} -body { + .b configure -cursor mouse +} -cleanup { + destroy .b +} -result {} +test cursor-6.44 {check cursor-font cursor pencil} -setup { + button .b -text pencil +} -body { + .b configure -cursor pencil +} -cleanup { + destroy .b +} -result {} +test cursor-6.45 {check cursor-font cursor pirate} -setup { + button .b -text pirate +} -body { + .b configure -cursor pirate +} -cleanup { + destroy .b +} -result {} +test cursor-6.46 {check cursor-font cursor plus} -setup { + button .b -text plus +} -body { + .b configure -cursor plus +} -cleanup { + destroy .b +} -result {} +test cursor-6.47 {check cursor-font cursor question_arrow} -setup { + button .b -text question_arrow +} -body { + .b configure -cursor question_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.48 {check cursor-font cursor right_ptr} -setup { + button .b -text right_ptr +} -body { + .b configure -cursor right_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.49 {check cursor-font cursor right_side} -setup { + button .b -text right_side +} -body { + .b configure -cursor right_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.50 {check cursor-font cursor right_tee} -setup { + button .b -text right_tee +} -body { + .b configure -cursor right_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.51 {check cursor-font cursor rightbutton} -setup { + button .b -text rightbutton +} -body { + .b configure -cursor rightbutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.52 {check cursor-font cursor rtl_logo} -setup { + button .b -text rtl_logo +} -body { + .b configure -cursor rtl_logo +} -cleanup { + destroy .b +} -result {} +test cursor-6.53 {check cursor-font cursor sailboat} -setup { + button .b -text sailboat +} -body { + .b configure -cursor sailboat +} -cleanup { + destroy .b +} -result {} +test cursor-6.54 {check cursor-font cursor sb_down_arrow} -setup { + button .b -text sb_down_arrow +} -body { + .b configure -cursor sb_down_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.55 {check cursor-font cursor sb_h_double_arrow} -setup { + button .b -text sb_h_double_arrow +} -body { + .b configure -cursor sb_h_double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.56 {check cursor-font cursor sb_left_arrow} -setup { + button .b -text sb_left_arrow +} -body { + .b configure -cursor sb_left_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.57 {check cursor-font cursor sb_right_arrow} -setup { + button .b -text sb_right_arrow +} -body { + .b configure -cursor sb_right_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.58 {check cursor-font cursor sb_up_arrow} -setup { + button .b -text sb_up_arrow +} -body { + .b configure -cursor sb_up_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.59 {check cursor-font cursor sb_v_double_arrow} -setup { + button .b -text sb_v_double_arrow +} -body { + .b configure -cursor sb_v_double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.60 {check cursor-font cursor shuttle} -setup { + button .b -text shuttle +} -body { + .b configure -cursor shuttle +} -cleanup { + destroy .b +} -result {} +test cursor-6.61 {check cursor-font cursor sizing} -setup { + button .b -text sizing +} -body { + .b configure -cursor sizing +} -cleanup { + destroy .b +} -result {} +test cursor-6.62 {check cursor-font cursor spider} -setup { + button .b -text spider +} -body { + .b configure -cursor spider +} -cleanup { + destroy .b +} -result {} +test cursor-6.63 {check cursor-font cursor spraycan} -setup { + button .b -text spraycan +} -body { + .b configure -cursor spraycan +} -cleanup { + destroy .b +} -result {} +test cursor-6.64 {check cursor-font cursor star} -setup { + button .b -text star +} -body { + .b configure -cursor star +} -cleanup { + destroy .b +} -result {} +test cursor-6.65 {check cursor-font cursor target} -setup { + button .b -text target +} -body { + .b configure -cursor target +} -cleanup { + destroy .b +} -result {} +test cursor-6.66 {check cursor-font cursor tcross} -setup { + button .b -text tcross +} -body { + .b configure -cursor tcross +} -cleanup { + destroy .b +} -result {} +test cursor-6.67 {check cursor-font cursor top_left_arrow} -setup { + button .b -text top_left_arrow +} -body { + .b configure -cursor top_left_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.68 {check cursor-font cursor top_left_corner} -setup { + button .b -text top_left_corner +} -body { + .b configure -cursor top_left_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.69 {check cursor-font cursor top_right_corner} -setup { + button .b -text top_right_corner +} -body { + .b configure -cursor top_right_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.70 {check cursor-font cursor top_side} -setup { + button .b -text top_side +} -body { + .b configure -cursor top_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.71 {check cursor-font cursor top_tee} -setup { + button .b -text top_tee +} -body { + .b configure -cursor top_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.72 {check cursor-font cursor trek} -setup { + button .b -text trek +} -body { + .b configure -cursor trek +} -cleanup { + destroy .b +} -result {} +test cursor-6.73 {check cursor-font cursor ul_angle} -setup { + button .b -text ul_angle +} -body { + .b configure -cursor ul_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.74 {check cursor-font cursor umbrella} -setup { + button .b -text umbrella +} -body { + .b configure -cursor umbrella +} -cleanup { + destroy .b +} -result {} +test cursor-6.75 {check cursor-font cursor ur_angle} -setup { + button .b -text ur_angle +} -body { + .b configure -cursor ur_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.76 {check cursor-font cursor watch} -setup { + button .b -text watch +} -body { + .b configure -cursor watch +} -cleanup { + destroy .b +} -result {} +test cursor-6.77 {check cursor-font cursor xterm} -setup { + button .b -text xterm +} -body { + .b configure -cursor xterm +} -cleanup { + destroy .b +} -result {} # 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 { +test cursor-6.78 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -242,7 +731,7 @@ test cursor-6.80 {} -setup { destroy .b } -result none -test cursor-6.81 {} -setup { +test cursor-6.79 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -252,7 +741,7 @@ test cursor-6.81 {} -setup { destroy .b } -result {} -test cursor-6.82 {} -setup { +test cursor-6.80 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -263,7 +752,7 @@ test cursor-6.82 {} -setup { destroy .b } -result none -test cursor-6.83 {} -setup { +test cursor-6.81 {test cursor named "none"} -setup { button .b -text CButton } -body { # Setting fg and bg does nothing for the none cursor @@ -285,31 +774,72 @@ test cursor-6.83 {} -setup { # ------------------------------------------------------------------------- # Check the Windows specific cursors - -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 $testName "check Windows cursor $cursor" -constraints win -setup { - button .b -text $cursor - } -body { - .b configure -cursor $cursor - } -cleanup { - destroy .b - } -result {} -} +test cursor-7.1 {check Windows cursor no} -constraints win -setup { + button .b -text no +} -body { + .b configure -cursor no +} -cleanup { + destroy .b +} -result {} +test cursor-7.2 {check Windows cursor starting} -constraints win -setup { + button .b -text starting +} -body { + .b configure -cursor starting +} -cleanup { + destroy .b +} -result {} +test cursor-7.3 {check Windows cursor size} -constraints win -setup { + button .b -text size +} -body { + .b configure -cursor size +} -cleanup { + destroy .b +} -result {} +test cursor-7.4 {check Windows cursor size_ne_sw} -constraints win -setup { + button .b -text size_ne_sw +} -body { + .b configure -cursor size_ne_sw +} -cleanup { + destroy .b +} -result {} +test cursor-7.5 {check Windows cursor size_ns} -constraints win -setup { + button .b -text size_ns +} -body { + .b configure -cursor size_ns +} -cleanup { + destroy .b +} -result {} +test cursor-7.6 {check Windows cursor size_nw_se} -constraints win -setup { + button .b -text size_nw_se +} -body { + .b configure -cursor size_nw_se +} -cleanup { + destroy .b +} -result {} +test cursor-7.7 {check Windows cursor size_we} -constraints win -setup { + button .b -text size_we +} -body { + .b configure -cursor size_we +} -cleanup { + destroy .b +} -result {} +test cursor-7.8 {check Windows cursor uparrow} -constraints win -setup { + button .b -text uparrow +} -body { + .b configure -cursor uparrow +} -cleanup { + destroy .b +} -result {} +test cursor-7.9 {check Windows cursor wait} -constraints win -setup { + button .b -text wait +} -body { + .b configure -cursor wait +} -cleanup { + destroy .b +} -result {} # ------------------------------------------------------------------------- -destroy .t - # cleanup cleanupTests -return +return
\ No newline at end of file diff --git a/tests/message.test b/tests/message.test index c9ad03d..b548b97 100644 --- a/tests/message.test +++ b/tests/message.test @@ -6,117 +6,471 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: message.test,v 1.4 2008/07/23 23:24:25 nijtmans Exp $ +# RCS: @(#) $Id: message.test,v 1.5 2008/07/28 11:12:32 aniap Exp $ -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* tcltest::loadTestedCommands +eval tcltest::configure $argv + + +test message-1.1 {configuration option: "anchor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -anchor w + .m cget -anchor +} -cleanup { + destroy .m +} -result {w} +test message-1.2 {configuration option: "anchor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -anchor bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} + +test message-1.3 {configuration option: "aspect"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -aspect 3 + .m cget -aspect +} -cleanup { + destroy .m +} -result {3} +test message-1.4 {configuration option: "aspect"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -aspect bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {expected integer but got "bogus"} + +test message-1.5 {configuration option: "background"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -background #ff0000 + .m cget -background +} -cleanup { + destroy .m +} -result {#ff0000} +test message-1.6 {configuration option: "background"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -background non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.7 {configuration option: "bd"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bd 4 + .m cget -bd +} -cleanup { + destroy .m +} -result {4} +test message-1.8 {configuration option: "bd"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bd badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.9 {configuration option: "bg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bg #ff0000 + .m cget -bg +} -cleanup { + destroy .m +} -result {#ff0000} +test message-1.10 {configuration option: "bg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bg non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.11 {configuration option: "borderwidth"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -borderwidth 1.3 + .m cget -borderwidth +} -cleanup { + destroy .m +} -result {1} +test message-1.12 {configuration option: "borderwidth"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -borderwidth badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.13 {configuration option: "cursor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -cursor arrow + .m cget -cursor +} -cleanup { + destroy .m +} -result {arrow} +test message-1.14 {configuration option: "cursor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -cursor badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test message-1.15 {configuration option: "fg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -fg #00ff00 + .m cget -fg +} -cleanup { + destroy .m +} -result {#00ff00} +test message-1.16 {configuration option: "fg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -fg badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "badValue"} + +test message-1.17 {configuration option: "font"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -font fixed + .m cget -font +} -cleanup { + destroy .m +} -result {fixed} +test message-1.18 {configuration option: "font"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -font {} +} -cleanup { + destroy .m +} -returnCodes {error} -result {font "" doesn't exist} + +test message-1.19 {configuration option: "-foreground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -foreground green + .m cget -foreground +} -cleanup { + destroy .m +} -result {green} +test message-1.20 {configuration option: "-foreground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -foreground badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "badValue"} -option add *Message.borderWidth 2 -option add *Message.highlightThickness 2 -option add *Message.font {Helvetica -12 bold} - -message .m -pack .m -update -set i 0 -foreach test { - {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} - {-aspect 3 3 bogus {expected integer but got "bogus"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} - {-font fixed fixed {} {font "" doesn't exist}} - {-foreground green green badValue {unknown color name "badValue"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-padx 12m 12m 420x {bad screen distance "420x"}} - {-pady 12m 12m 420x {bad screen distance "420x"}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-text "Sample text" {Sample text} {} {} {1 1 1 1}} - {-textvariable i i {} {} {1 1 1 1}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - set name [lindex $test 0] - test message-1.$i {configuration options} { - .m configure $name [lindex $test 1] - lindex [.m configure $name] 4 - } [lindex $test 2] - incr i - if {[lindex $test 3] != ""} { - test message-1.$i {configuration options} { - list [catch {.m configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .m configure $name [lindex [.m configure $name] 3] - incr i -} -destroy .m - -test message-2.1 {Tk_MessageObjCmd procedure} { - list [catch {message} msg] $msg -} {1 {wrong # args: should be "message pathName ?-option value ...?"}} -test message-2.2 {Tk_MessageObjCmd procedure} { - list [catch {message foo} msg] $msg [winfo child .] -} {1 {bad window path name "foo"} {}} -test message-2.3 {Tk_MessageObjCmd procedure} { - list [catch {message .s -gorp dumb} msg] $msg [winfo child .] -} {1 {unknown option "-gorp"} {}} - -test message-3.1 {MessageWidgetObjCmd procedure} { +test message-1.21 {configuration option: "highlightbackground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightbackground #112233 + .m cget -highlightbackground +} -cleanup { + destroy .m +} -result {#112233} +test message-1.22 {configuration option: "highlightbackground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightbackground ugly +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "ugly"} + +test message-1.23 {configuration option: "highlightcolor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightcolor #123456 + .m cget -highlightcolor +} -cleanup { + destroy .m +} -result {#123456} +test message-1.24 {configuration option: "highlightcolor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightcolor non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.25 {configuration option: "highlightthickness"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightthickness 2 + .m cget -highlightthickness +} -cleanup { + destroy .m +} -result {2} +test message-1.26 {configuration option: "highlightthickness"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightthickness badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.27 {configuration option: "justify"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -justify right + .m cget -justify +} -cleanup { + destroy .m +} -result {right} +test message-1.28 {configuration option: "justify"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -justify bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test message-1.29 {configuration option: "padx"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -padx 12m + .m cget -padx +} -cleanup { + destroy .m +} -result {12m} +test message-1.30 {configuration option: "padx"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -padx 420x +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "420x"} + +test message-1.31 {configuration option: "pady"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -pady 12m + .m cget -pady +} -cleanup { + destroy .m +} -result {12m} +test message-1.32 {configuration option: "pady"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -pady 420x +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "420x"} + +test message-1.33 {configuration option: "relief"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -relief ridge + .m cget -relief +} -cleanup { + destroy .m +} -result {ridge} +test message-1.34 {configuration option: "relief"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -relief badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} + +test message-1.35 {configuration options: "text"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -text "Sample text" + .m cget -text +} -cleanup { + destroy .m +} -result {Sample text} + +test message-1.36 {configuration option: "textvariable"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -textvariable i + .m cget -textvariable +} -cleanup { + destroy .m +} -result {i} + +test message-1.37 {configuration option: "width"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -width 2 + .m cget -width +} -cleanup { + destroy .m +} -result {2} +test message-1.38 {configuration option: "width"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -width badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + + +test message-2.1 {Tk_MessageObjCmd procedure} -body { + message +} -returnCodes {error} -result {wrong # args: should be "message pathName ?-option value ...?"} + +test message-2.2 {Tk_MessageObjCmd procedure} -body { + message foo +} -returnCodes {error} -result {bad window path name "foo"} +test message-2.3 {Tk_MessageObjCmd procedure} -body { + catch {message foo} + winfo child . +} -result {} + +test message-2.4 {Tk_MessageObjCmd procedure} -body { + message .s -gorp dump +} -returnCodes {error} -result {unknown option "-gorp"} +test message-2.5 {Tk_MessageObjCmd procedure} -body { + catch {message .s -gorp dump} + winfo child . +} -result {} + + +test message-3.1 {MessageWidgetObjCmd procedure} -setup { message .m - set result [list [catch {.m} msg] $msg] +} -body { + .m +} -cleanup { destroy .m - set result -} {1 {wrong # args: should be ".m option ?arg ...?"}} -test message-3.2 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {wrong # args: should be ".m option ?arg ...?"} +test message-3.2 {MessageWidgetObjCmd procedure, "cget"} -setup { message .m - set result [list [catch {.m cget} msg] $msg] +} -body { + .m cget +} -cleanup { destroy .m - set result -} {1 {wrong # args: should be ".m cget option"}} -test message-3.3 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {wrong # args: should be ".m cget option"} +test message-3.3 {MessageWidgetObjCmd procedure, "cget"} -setup { message .m - set result [list [catch {.m cget -gorp} msg] $msg] +} -body { + .m cget -gorp +} -cleanup { destroy .m - set result -} {1 {unknown option "-gorp"}} -test message-3.4 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {unknown option "-gorp"} + +test message-3.4 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m +} -body { .m configure -text foobar - set result [.m cget -text] + lindex [.m configure -text] 4 +} -cleanup { destroy .m - set result -} "foobar" -test message-3.5 {MessageWidgetObjCmd procedure, "configure"} { +} -result {foobar} +test message-3.5 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m - set result [llength [.m configure]] +} -body { + llength [.m configure] +} -cleanup { destroy .m - set result -} 21 -test message-3.6 {MessageWidgetObjCmd procedure, "configure"} { +} -result {21} +test message-3.6 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m - set result [list [catch {.m configure -foo} msg] $msg] +} -body { + .m configure -foo +} -cleanup { destroy .m - set result -} {1 {unknown option "-foo"}} -test message-3.7 {MessageWidgetObjCmd procedure, "configure"} { +} -returnCodes error -result {unknown option "-foo"} +test message-3.7 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m +} -body { .m configure -bd 4 .m configure -bg #ffffff - set result [lindex [.m configure -bd] 4] + lindex [.m configure -bd] 4 +} -cleanup { destroy .m - set result -} {4} +} -result {4} -# cleanup cleanupTests return |