diff options
Diffstat (limited to 'tests/canvText.test')
| -rw-r--r-- | tests/canvText.test | 58 |
1 files changed, 23 insertions, 35 deletions
diff --git a/tests/canvText.test b/tests/canvText.test index 9566769..070011b 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -7,10 +7,7 @@ # 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 canvas .c -width 400 -height 300 -bd 2 -relief sunken @@ -34,18 +31,19 @@ foreach test { {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} {-tags {test a b c} {test a b c} {} {}} {-text xyz xyz {} {}} + {-underline 0 0 xyz {expected integer but got "xyz"}} {-width 6 6 xyz {bad screen distance "xyz"}} } { - set name [lindex $test 0] - test canvText-1.$i {configuration options} { - .c itemconfigure test $name [lindex $test 1] + lassign $test name goodValue goodResult badValue badResult + test canvText-1.$i "configuration options: good value for $name" { + .c itemconfigure test $name $goodValue list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name] - } [list [lindex $test 2] [lindex $test 2]] + } [list $goodResult $goodResult] incr i - if {[lindex $test 3] != ""} { - test canvText-1.$i {configuration options} { - list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] + if {$badValue ne ""} { + test canvText-1.$i "configuration options: bad value for $name" -body { + .c itemconfigure test $name $badValue + } -returnCodes error -result $badResult } incr i } @@ -402,7 +400,7 @@ test canvText-9.15 {TextInsert procedure: cursor doesn't move} { .c dchars test 7 9 .c index test insert } {5} - + test canvText-10.1 {TextToPoint procedure} { .c coords test 0 0 .c itemconfig test -text 0 -anchor center @@ -423,15 +421,15 @@ test canvText-11.2 {TextToArea procedure} { test canvText-12.1 {ScaleText procedure} { .c coords test 100 100 .c scale all 50 50 2 2 - .c coords test -} {150.0 150.0} + format {%.6g %.6g} {*}[.c coords test] +} {150 150} test canvText-13.1 {TranslateText procedure} { .c coords test 100 100 .c move all 10 10 - .c coords test -} {110.0 110.0} - + format {%.6g %.6g} {*}[.c coords test] +} {110 110} + .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 @@ -458,6 +456,9 @@ test canvText-14.4 {GetTextIndex procedure: select error} { test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} { list [catch {.c index test xyz} msg] $msg } {1 {bad index "xyz"}} +test canvText-14.6 {select clear errors} -body { + .c select clear test +} -returnCodes error -result "wrong \# args: should be \".c select clear\"" test canvText-15.1 {SetTextCursor procedure} { .c itemconfig -text "abcdefg" @@ -480,7 +481,7 @@ test canvText-17.1 {TextToPostscript procedure} { .c delete all .c config -height 300 -highlightthickness 0 -bd 0 update - .c create text 100 100 -tags test + .c create text 100 100 -tags test .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] .c itemconfig test -anchor n -fill black set x [.c postscript] @@ -491,7 +492,7 @@ test canvText-17.1 {TextToPostscript procedure} { \[(000)\] \[(000)\] \[(00)\] -] $ay -0.5 0 0 false DrawText +] $ay -0.5 0.0 0 false DrawText grestore restore showpage @@ -561,7 +562,7 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { + ([font measure {Arial 28 bold} "Y"] / 2)}] set y1 [expr {18 + ($metrics(-linespace) / 2)}] set y2 [expr {160 + ($metrics(-linespace) / 2)}] - + lappend results [$c index tbox1 @$x,$y1] lappend results [$c index tbox2 @$x,$y2] @@ -570,18 +571,5 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { # cleanup -::tcltest::cleanupTests +cleanupTests return - - - - - - - - - - - - - |