diff options
| author | aniap <aniap> | 2008-08-11 21:33:17 (GMT) |
|---|---|---|
| committer | aniap <aniap> | 2008-08-11 21:33:17 (GMT) |
| commit | a66a478b11a3a5fb8ca2f96b1455d1513f6b228e (patch) | |
| tree | a599278039a0e8e4f1e616c3919ec81896ed19a1 | |
| parent | 3e1853a0a7548512056eb08a8b4916ec2f683ee6 (diff) | |
| download | tk-a66a478b11a3a5fb8ca2f96b1455d1513f6b228e.zip tk-a66a478b11a3a5fb8ca2f96b1455d1513f6b228e.tar.gz tk-a66a478b11a3a5fb8ca2f96b1455d1513f6b228e.tar.bz2 | |
Update to tcltest2
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | tests/canvImg.test | 797 | ||||
| -rw-r--r-- | tests/canvRect.test | 597 | ||||
| -rw-r--r-- | tests/canvText.test | 884 | ||||
| -rw-r--r-- | tests/obj.test | 24 |
5 files changed, 1625 insertions, 687 deletions
@@ -1,11 +1,15 @@ -2008-08-07 Ania Pawelczyk <aniap@users.sourceforge.net> +2008-08-11 Ania Pawelczyk <aniap@users.sourceforge.net> - * test/canvas.test: Update to tcltest2 + * test/canvImg.test: Update to tcltest2 + * test/canvRect.test + * test/canvText.test + * test/obj.test 2008-08-07 Ania Pawelczyk <aniap@users.sourceforge.net> * test/canvPs.test: Update to tcltest2 - * test/config.test + * test/config.test + * test/canvas.test 2008-08-05 Joe English <jenglish@users.sourceforge.net> diff --git a/tests/canvImg.test b/tests/canvImg.test index 7814d8a..94f818a 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -7,105 +7,163 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvImg.test,v 1.9 2007/05/16 18:10:35 dgp Exp $ +# RCS: @(#) $Id: canvImg.test,v 1.10 2008/08/11 21:33:17 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands eval image delete [image names] +# Canvas used in every test case of the whole file canvas .c pack .c update -if {[testConstraint testImageType]} { - image create test foo -variable x - image create test foo2 -variable y - foo2 changed 0 0 0 0 80 60 -} -test canvImg-1.1 {options for image items} { - .c delete all + + +test canvImg-1.1 {options for image items} -body { .c create image 50 50 -anchor nw -tags i1 .c itemconfigure i1 -anchor -} {-anchor {} {} center nw} -test canvImg-1.2 {options for image items} { - .c delete all - list [catch {.c create image 50 50 -anchor gorp -tags i1} msg] $msg -} {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}} -test canvImg-1.3 {options for image items} testImageType { - .c delete all +} -cleanup { + .c delete all +} -result {-anchor {} {} center nw} +test canvImg-1.2 {options for image items} -body { + .c create image 50 50 -anchor gorp -tags i1 +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center} +test canvImg-1.3 {options for image items} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 50 50 -image foo -tags i1 .c itemconfigure i1 -image -} {-image {} {} {} foo} -test canvImg-1.4 {options for image items} { - .c delete all - list [catch {.c create image 50 50 -image unknown -tags i1} msg] $msg -} {1 {image "unknown" doesn't exist}} -test canvImg-1.5 {options for image items} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {-image {} {} {} foo} +test canvImg-1.4 {options for image items} -body { + .c create image 50 50 -image unknown -tags i1 +} -cleanup { + .c delete all +} -returnCodes {error} -result {image "unknown" doesn't exist} +test canvImg-1.5 {options for image items} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 50 50 -image foo -tags {i1 foo} .c itemconfigure i1 -tags -} {-tags {} {} {} {i1 foo}} +} -cleanup { + .c delete all + image delete foo +} -result {-tags {} {} {} {i1 foo}} -test canvImg-2.1 {CreateImage procedure} { - list [catch {.c create image 40} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvImg-2.2 {CreateImage procedure} { - list [catch {.c create image 40 50 60} msg] $msg -} {1 {unknown option "60"}} -test canvImg-2.3 {CreateImage procedure} { +test canvImg-2.1 {CreateImage procedure} -body { + .c create image 40 +} -cleanup { + .c delete all +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvImg-2.2 {CreateImage procedure} -body { + .c create image 40 50 60 +} -cleanup { + .c delete all +} -returnCodes {error} -result {unknown option "60"} +test canvImg-2.3 {CreateImage procedure} -body { .c delete all set i [.c create image 50 50] list [lindex [.c itemconf $i -anchor] 4] \ [lindex [.c itemconf $i -image] 4] \ [lindex [.c itemconf $i -tags] 4] -} {center {} {}} -test canvImg-2.4 {CreateImage procedure} { - list [catch {.c create image xyz 40} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvImg-2.5 {CreateImage procedure} { - list [catch {.c create image 50 qrs} msg] $msg -} {1 {bad screen distance "qrs"}} -test canvImg-2.6 {CreateImage procedure} testImageType { - list [catch {.c create image 50 50 -gorp foo} msg] $msg -} {1 {unknown option "-gorp"}} - -test canvImg-3.1 {ImageCoords procedure} testImageType { +} -cleanup { + .c delete all +} -result {center {} {}} +test canvImg-2.4 {CreateImage procedure} -body { + .c create image xyz 40 +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvImg-2.5 {CreateImage procedure} -body { + .c create image 50 qrs +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "qrs"} +test canvImg-2.6 {CreateImage procedure} -constraints testImageType -body { + .c create image 50 50 -gorp foo +} -cleanup { .c delete all +} -returnCodes {error} -result {unknown option "-gorp"} + + +test canvImg-3.1 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c create image 50 100 -image foo -tags i1 .c coords i1 -} {50.0 100.0} -test canvImg-3.2 {ImageCoords procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {50.0 100.0} +test canvImg-3.2 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 dumb 100} msg] $msg -} {1 {bad screen distance "dumb"}} -test canvImg-3.3 {ImageCoords procedure} testImageType { + .c coords i1 dumb 100 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {bad screen distance "dumb"} +test canvImg-3.3 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250 dumb0} msg] $msg -} {1 {bad screen distance "dumb0"}} -test canvImg-3.4 {ImageCoords procedure} testImageType { + .c coords i1 250 dumb0 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {bad screen distance "dumb0"} +test canvImg-3.4 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvImg-3.5 {ImageCoords procedure} testImageType { + .c coords i1 250 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvImg-3.5 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250 300 400} msg] $msg -} {1 {wrong # coordinates: expected 0 or 2, got 3}} + .c coords i1 250 300 400 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} -test canvImg-4.1 {ConfiugreImage procedure} testImageType { + +test canvImg-4.1 {ConfiugreImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags i1 update set x {} .c itemconfigure i1 -image {} update list $x [.c bbox i1] -} {{{foo free}} {}} -test canvImg-4.2 {ConfiugreImage procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {{{foo free}} {}} +test canvImg-4.2 {ConfiugreImage procedure} -constraints testImageType -setup { + .c delete all +} -body { + image create test foo -variable x + image create test foo2 -variable y + foo2 changed 0 0 0 0 80 60 .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} @@ -113,19 +171,34 @@ test canvImg-4.2 {ConfiugreImage procedure} testImageType { .c itemconfigure i1 -image foo2 update list $x $y [.c bbox i1] -} {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} -test canvImg-4.3 {ConfiugreImage procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo + image delete foo2 +} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} +test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup { + .c delete all +} -body { + image create test foo -variable x + image create test foo2 -variable y + foo2 changed 0 0 0 0 80 60 .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} set y {} - list [catch {.c itemconfigure i1 -image lousy} msg] $msg -} {1 {image "lousy" doesn't exist}} + .c itemconfigure i1 -image lousy +} -cleanup { + .c delete all + image delete foo foo2 +} -returnCodes {error} -result {image "lousy" doesn't exist} -test canvImg-5.1 {DeleteImage procedure} testImageType { - image create test xyzzy -variable z + +test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x + image create test foo2 -variable y + image create test xyzzy -variable z .c create image 50 100 -image xyzzy -tags i1 update set names [lsort [image names]] @@ -135,259 +208,587 @@ test canvImg-5.1 {DeleteImage procedure} testImageType { .c delete i1 update list $names $names2 $z [lsort [image names]] -} {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} -test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} { +} -cleanup { + image delete foo foo2 + .c delete all +} -result {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} +test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body { .c delete all .c create image 50 100 -tags i1 update .c delete i1 update -} {} +} -result {} + -test canvImg-6.1 {ComputeImageBbox procedure} testImageType { +test canvImg-6.1 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo .c delete all +} -body { .c create image 15.51 17.51 -image foo -tags i1 -anchor nw .c bbox i1 -} {16 18 46 33} -test canvImg-6.2 {ComputeImageBbox procedure} testImageType { +} -cleanup { .c delete all + image delete foo +} -result {16 18 46 33} +test canvImg-6.2 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 15.49 17.49 -image foo -tags i1 -anchor nw .c bbox i1 -} {15 17 45 32} -test canvImg-6.3 {ComputeImageBbox procedure} { +} -cleanup { + .c delete all + image delete foo +} -result {15 17 45 32} +test canvImg-6.3 {ComputeImageBbox procedure} -setup { .c delete all +} -body { .c create image 20 30 -tags i1 -anchor nw .c bbox i1 -} {} -test canvImg-6.4 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-6.4 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor nw .c bbox i1 -} {20 30 50 45} -test canvImg-6.5 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {20 30 50 45} +test canvImg-6.5 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor n .c bbox i1 -} {5 30 35 45} -test canvImg-6.6 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {5 30 35 45} +test canvImg-6.6 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor ne .c bbox i1 -} {-10 30 20 45} -test canvImg-6.7 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {-10 30 20 45} +test canvImg-6.7 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor e .c bbox i1 -} {-10 23 20 38} -test canvImg-6.8 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {-10 23 20 38} +test canvImg-6.8 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor se .c bbox i1 -} {-10 15 20 30} -test canvImg-6.9 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {-10 15 20 30} +test canvImg-6.9 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor s .c bbox i1 -} {5 15 35 30} -test canvImg-6.10 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {5 15 35 30} +test canvImg-6.10 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor sw .c bbox i1 -} {20 15 50 30} -test canvImg-6.11 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {20 15 50 30} +test canvImg-6.11 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor w .c bbox i1 -} {20 23 50 38} -test canvImg-6.12 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {20 23 50 38} +test canvImg-6.12 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor center .c bbox i1 -} {5 23 35 38} +} -cleanup { + .c delete all + image delete foo +} -result {5 23 35 38} # The following test is non-portable because of differences in # coordinate rounding on some machines (does 0.5 round up?). -test canvImg-7.1 {DisplayImage procedure} {nonPortable testImageType} { +test canvImg-7.1 {DisplayImage procedure} -constraints { + nonPortable testImageType +} -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} .c create rect 55 110 65 115 -width 1 -outline black -fill white update set x -} {{foo display 4 9 12 6 30 30}} -test canvImg-7.2 {DisplayImage procedure, no image} { +} -result {{foo display 4 9 12 6 30 30}} +test canvImg-7.2 {DisplayImage procedure, no image} -body { .c delete all .c create image 50 100 -tags i1 update .c create rect 55 110 65 115 -width 1 -outline black -fill white update -} {} +} -result {} -.c delete all + +# image used in 8.* test cases if {[testConstraint testImageType]} { - .c create image 50 100 -image foo -tags image -anchor nw -} -.c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} -foreach check { - {canvImg-8.1 {50 70 80 81} {70 90} rect} - {canvImg-8.2 {50 70 80 79} {70 90} image} - {canvImg-8.3 {99 70 110 81} {90 90} rect} - {canvImg-8.4 {101 70 110 79} {90 90} image} - {canvImg-8.5 {99 100 110 115} {90 110} rect} - {canvImg-8.6 {101 100 110 115} {90 110} image} - {canvImg-8.7 {99 134 110 145} {90 125} rect} - {canvImg-8.8 {101 136 110 145} {90 125} image} - {canvImg-8.9 {50 134 80 145} {70 125} rect} - {canvImg-8.10 {50 136 80 145} {70 125} image} - {canvImg-8.11 {20 134 31 145} {40 125} rect} - {canvImg-8.12 {20 136 29 145} {40 125} image} - {canvImg-8.13 {20 100 31 115} {40 110} rect} - {canvImg-8.14 {20 100 29 115} {40 110} image} - {canvImg-8.15 {20 70 31 80} {40 90} rect} - {canvImg-8.16 {20 70 29 79} {40 90} image} - {canvImg-8.17 {60 70 69 109} {70 110} image} - {canvImg-8.18 {60 70 71 111} {70 110} rect} -} { - lassign $check name rectCoords testPoint result - test $name {ImageToPoint procedure} testImageType { - .c coords rect {*}$rectCoords - .c gettags [.c find closest {*}$testPoint] - } $result + image create test foo } - +test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect 50 70 80 81 + .c gettags [.c find closest 70 90] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.2 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 70 80 79} + .c gettags [.c find closest {*}{70 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.3 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 70 110 81} + .c gettags [.c find closest {*}{90 90}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.4 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 70 110 79} + .c gettags [.c find closest {*}{90 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.5 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 100 110 115} + .c gettags [.c find closest {*}{90 110}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.6 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 100 110 115} + .c gettags [.c find closest {*}{90 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.7 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 134 110 145} + .c gettags [.c find closest {*}{90 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.8 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 136 110 145} + .c gettags [.c find closest {*}{90 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.9 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 134 80 145} + .c gettags [.c find closest {*}{70 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.10 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 136 80 145} + .c gettags [.c find closest {*}{70 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.11 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 134 31 145} + .c gettags [.c find closest {*}{40 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.12 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 136 29 145} + .c gettags [.c find closest {*}{40 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.13 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 100 31 115} + .c gettags [.c find closest {*}{40 110}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.14 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 100 29 115} + .c gettags [.c find closest {*}{40 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.15 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 70 31 80} + .c gettags [.c find closest {*}{40 90}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.16 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 70 29 79} + .c gettags [.c find closest {*}{40 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.17 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{60 70 69 109} + .c gettags [.c find closest {*}{70 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.18 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{60 70 71 111} + .c gettags [.c find closest {*}{70 110}] +} -cleanup { + .c delete all +} -result {rect} .c delete all -if {[testConstraint testImageType]} { + +test canvImg-8.19 {ImageToArea procedure} -constraints testImageType -body { .c create image 50 100 -image foo -tags image -anchor nw -} -test canvImg-8.19 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 0 70 99] -} {} -test canvImg-8.20 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.20 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 0 70 99.999] -} {} -test canvImg-8.21 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.21 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 0 70 101] -} {image} -test canvImg-8.22 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.22 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 81 105 120 115] -} {} -test canvImg-8.23 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.23 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80.001 105 120 115] -} {} -test canvImg-8.24 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.24 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 105 120 115] -} {image} -test canvImg-8.25 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.25 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 116 70 150] -} {} -test canvImg-8.26 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.26 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 115.001 70 150] -} {} -test canvImg-8.27 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.27 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 114 70 150] -} {image} -test canvImg-8.28 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.28 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 49 115] -} {} -test canvImg-8.29 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.29 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 50 114.999] -} {} -test canvImg-8.30 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.30 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 51 115] -} {image} -test canvImg-8.31 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.31 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 0 49.999 99.999] -} {} -test canvImg-8.32 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.32 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 0 51 101] -} {image} -test canvImg-8.33 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.33 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80 0 150 100] -} {} -test canvImg-8.34 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.34 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 0 150 101] -} {image} -test canvImg-8.35 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.35 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80.001 115.001 150 180] -} {} -test canvImg-8.36 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.36 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 114 150 180] -} {image} -test canvImg-8.37 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.37 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 115 50 180] -} {} -test canvImg-8.38 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.38 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 114 51 180] -} {image} -test canvImg-8.39 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.39 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 0 0 200 200] -} {image} -test canvImg-8.40 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.40 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 49.999 99.999 80.001 115.001] -} {image} -test canvImg-8.41 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.41 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 51 100 80 115] -} {} -test canvImg-8.42 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.42 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 101 80 115] -} {} -test canvImg-8.43 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.43 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 100 79 115] -} {} -test canvImg-8.44 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.44 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 100 80 114] -} {} +} -cleanup { + .c delete all +} -result {} +if {[testConstraint testImageType]} { + image delete foo +} -test canvImg-9.1 {DisplayImage procedure} testImageType { + +test canvImg-9.1 {DisplayImage procedure} -constraints testImageType -setup { .c delete all + image create test foo +} -body { .c create image 50 100 -image foo -tags image -anchor nw .c scale image 25 0 2.0 1.5 .c bbox image -} {75 150 105 165} +} -cleanup { + .c delete all + image delete foo +} -result {75 150 105 165} -test canvImg-10.1 {TranslateImage procedure} testImageType { +test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 30 15 update - set x -} {{foo display 2 4 6 8 30 30}} + return $x +} -cleanup { + .c delete all + image delete foo +} -result {{foo display 2 4 6 8 30 30}} -test canvImg-11.1 {TranslateImage procedure} testImageType { +test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 40 50 update - set x -} {{foo display 0 0 40 50 30 30}} -test canvImg-11.2 {ImageChangedProc procedure} testImageType { - .c delete all + return $x +} -cleanup { + .c delete all + image delete foo +} -result {{foo display 0 0 40 50 30 30}} +test canvImg-11.2 {ImageChangedProc procedure} -constraints { + testImageType +} -setup { + .c delete all +} -body { image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor center update set x {} foo changed 0 0 0 0 40 50 .c bbox image -} {30 75 70 125} -test canvImg-11.3 {ImageChangedProc procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {30 75 70 125} +test canvImg-11.3 {ImageChangedProc procedure} -constraints { + testImageType +} -setup { + .c delete all +} -body { image create test foo -variable x + image create test foo2 -variable y foo changed 0 0 0 0 40 50 + foo2 changed 0 0 0 0 80 60 + .c create image 50 100 -image foo -tags image -anchor nw .c create image 70 110 -image foo2 -anchor nw update set y {} image create test foo -variable x update - set y -} {{foo2 display 0 0 20 40 50 40}} + return $y +} -cleanup { + .c delete all + image delete foo foo2 +} -result {{foo2 display 0 0 20 40 50 40}} # cleanup cleanupTests return + + diff --git a/tests/canvRect.test b/tests/canvRect.test index 975c71a..c9f2dfb 100644 --- a/tests/canvRect.test +++ b/tests/canvRect.test @@ -6,303 +6,446 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvRect.test,v 1.9 2008/07/23 23:24:26 nijtmans Exp $ +# RCS: @(#) $Id: canvRect.test,v 1.10 2008/08/11 21:33:17 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# Canvas used in every test case of the whole file canvas .c -width 400 -height 300 -bd 2 -relief sunken pack .c -bind .c <1> { - puts "button down at (%x,%y)" -} update -set i 1 +# Rectangle used in canvRect-1.* tests .c create rectangle 20 20 80 80 -tag test -foreach test { - {-fill #ff0000 #ff0000 - non-existent {unknown color name "non-existent"}} - {-outline #123456 #123456 - bad_color {unknown color name "bad_color"}} - {-stipple gray50 gray50 - bogus {bitmap "bogus" not defined}} - {-tags {test a b c} {test a b c} - {} {}} - {-width 6.0 6.0 - abc {bad screen distance "abc"}} -} { - lassign $test name goodValue goodResult badValue badResult - test canvRect-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 $goodResult $goodResult] - incr i - if {$badValue ne ""} { - test canvRect-1.$i "configuration options: bad value for $name" -body { - .c itemconfigure test $name $badValue - } -returnCodes error -result $badResult - } - incr i -} -test canvRect-1.$i {configuration options} { +test canvRect-1.1 {configuration options: good value for -fill} -body { + .c itemconfigure test -fill #ff0000 + list [.c itemcget test -fill] [lindex [.c itemconfigure test -fill] 4] +} -result {{#ff0000} #ff0000} +test canvRect-1.2 {configuration options: bad value for -fill} -body { + .c itemconfigure test -fill non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvRect-1.3 {configuration options: good value for -outline} -body { + .c itemconfigure test -outline #123456 + list [.c itemcget test -outline] [lindex [.c itemconfigure test -outline] 4] +} -result {{#123456} #123456} +test canvRect-1.4 {configuration options: bad value for -outline} -body { + .c itemconfigure test -outline non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvRect-1.5 {configuration options: good value for -stipple } -body { + .c itemconfigure test -stipple gray50 + list [.c itemcget test -stipple ] [lindex [.c itemconfigure test -stipple ] 4] +} -result {gray50 gray50} +test canvRect-1.6 {configuration options: bad value for -stipple } -body { + .c itemconfigure test -stipple bogus +} -returnCodes error -result {bitmap "bogus" not defined} +test canvRect-1.7 {configuration options: good value for -tags} -body { + .c itemconfigure test -tags {test a b c} + list [.c itemcget test -tags] [lindex [.c itemconfigure test -tags] 4] +} -result {{test a b c} {test a b c}} +test canvRect-1.8 {configuration options} -body { .c itemconfigure test -tags {test xyz} .c itemcget xyz -tags -} {test xyz} +} -result {test xyz} +test canvRect-1.9 {configuration options: good value for -width} -body { + .c itemconfigure test -width 6.0 + list [.c itemcget test -width] [lindex [.c itemconfigure test -width] 4] +} -result {6.0 6.0} +test canvRect-1.10 {configuration options: bad value for -width} -body { + .c itemconfigure test -width abc +} -returnCodes error -result {bad screen distance "abc"} +.c delete withtag all + -test canvRect-2.1 {CreateRectOval procedure} { - list [catch {.c create rect} msg] $msg -} {1 {wrong # args: should be ".c create rect coords ?arg ...?"}} -test canvRect-2.2 {CreateRectOval procedure} { - list [catch {.c create oval x y z} msg] $msg -} {1 {wrong # coordinates: expected 0 or 4, got 3}} -test canvRect-2.3 {CreateRectOval procedure} { - list [catch {.c create rectangle x 2 3 4} msg] $msg -} {1 {bad screen distance "x"}} -test canvRect-2.4 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 y 3 4} msg] $msg -} {1 {bad screen distance "y"}} -test canvRect-2.5 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 z 4} msg] $msg -} {1 {bad screen distance "z"}} -test canvRect-2.6 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 3 q} msg] $msg -} {1 {bad screen distance "q"}} -test canvRect-2.7 {CreateRectOval procedure} { +test canvRect-2.1 {CreateRectOval procedure} -body { + .c create rect +} -returnCodes error -result {wrong # args: should be ".c create rect coords ?arg ...?"} +test canvRect-2.2 {CreateRectOval procedure} -body { + .c create oval x y z +} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 3} +test canvRect-2.3 {CreateRectOval procedure} -body { + .c create rectangle x 2 3 4 +} -returnCodes error -result {bad screen distance "x"} +test canvRect-2.4 {CreateRectOval procedure} -body { + .c create rectangle 1 y 3 4 +} -returnCodes error -result {bad screen distance "y"} +test canvRect-2.5 {CreateRectOval procedure} -body { + .c create rectangle 1 2 z 4 +} -returnCodes error -result {bad screen distance "z"} +test canvRect-2.6 {CreateRectOval procedure} -body { + .c create rectangle 1 2 3 q +} -returnCodes error -result {bad screen distance "q"} +test canvRect-2.7 {CreateRectOval procedure} -body { .c create rectangle 1 2 3 4 -tags x set result {} foreach element [.c coords x] { - lappend result [format %.1f $element] + lappend result [format %.1f $element] } set result -} {1.0 2.0 3.0 4.0} -test canvRect-2.8 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 3 4 -gorp foo} msg] $msg -} {1 {unknown option "-gorp"}} - +} -result {1.0 2.0 3.0 4.0} +test canvRect-2.8 {CreateRectOval procedure} -body { + .c create rectangle 1 2 3 4 -gorp foo +} -returnCodes error -result {unknown option "-gorp"} .c delete withtag all -.c create rectangle 10 20 30 40 -tags x -test canvRect-3.1 {RectOvalCoords procedure} { + + +test canvRect-3.1 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x set result {} foreach element [.c coords x] { - lappend result [format %.1f $element] + lappend result [format %.1f $element] } - set result -} {10.0 20.0 30.0 40.0} -test canvRect-3.2 {RectOvalCoords procedure} { - list [catch {.c coords x a 2 3 4} msg] $msg -} {1 {bad screen distance "a"}} -test canvRect-3.3 {RectOvalCoords procedure} { - list [catch {.c coords x 1 b 3 4} msg] $msg -} {1 {bad screen distance "b"}} -test canvRect-3.4 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 c 4} msg] $msg -} {1 {bad screen distance "c"}} -test canvRect-3.5 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 3 d} msg] $msg -} {1 {bad screen distance "d"}} -test canvRect-3.6 {RectOvalCoords procedure} {nonPortable} { + return $result +} -cleanup { + .c delete withtag all +} -result {10.0 20.0 30.0 40.0} +test canvRect-3.2 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x a 2 3 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "a"} +test canvRect-3.3 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 b 3 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "b"} +test canvRect-3.4 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 c 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "c"} +test canvRect-3.5 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 3 d +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "d"} +test canvRect-3.6 {RectOvalCoords procedure} -constraints { + nonPortable +} -body { + .c create rectangle 10 20 30 40 -tags x # Non-portable due to rounding differences. .c coords x 10 25 15 40 .c bbox x -} {9 24 16 41} -test canvRect-3.7 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 3 4 5} msg] $msg -} {1 {wrong # coordinates: expected 0 or 4, got 5}} +} -cleanup { + .c delete withtag all +} -result {9 24 16 41} +test canvRect-3.7 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 3 4 5 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 5} -.c delete withtag all -.c create rectangle 10 20 30 40 -tags x -width 1 -test canvRect-4.1 {ConfigureRectOval procedure} { - list [catch {.c itemconfigure x -width abc} msg] $msg \ - [.c itemcget x -width] -} {1 {bad screen distance "abc"} 1.0} -test canvRect-4.2 {ConfigureRectOval procedure} { - list [catch {.c itemconfigure x -width -5} msg] $msg -} {1 {bad screen distance "-5"}} -test canvRect-4.3 {ConfigureRectOval procedure} {nonPortable} { - # Non-portable due to rounding differences. + +test canvRect-4.1 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + .c itemconfigure x -width abc +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "abc"} +test canvRect-4.2 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + catch {.c itemconfigure x -width abc} + .c itemcget x -width +} -cleanup { + .c delete withtag all +} -result {1.0} +test canvRect-4.3 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + .c itemconfigure x -width -5 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "-5"} +test canvRect-4.4 {ConfigureRectOval procedure} -constraints nonPortable -body { + # Non-portable due to rounding differences + .c create rectangle 10 20 30 40 -tags x -width 1 .c itemconfigure x -width 10 .c bbox x -} {5 15 35 45} +} -cleanup { + .c delete withtag all +} -result {5 15 35 45} + # I can't come up with any good tests for DeleteRectOval. -.c delete withtag all -.c create rectangle 10 20 30 40 -tags x -width 1 -outline {} -test canvRect-5.1 {ComputeRectOvalBbox procedure} {nonPortable} { +test canvRect-5.1 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 20 15 10 5 .c bbox x -} {10 5 20 15} -test canvRect-5.2 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {10 5 20 15} +test canvRect-5.2 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 1 -outline red .c bbox x -} {9 9 31 21} -test canvRect-5.3 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {9 9 31 21} +test canvRect-5.3 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 2 -outline red .c bbox x -} {9 9 31 21} -test canvRect-5.4 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {9 9 31 21} +test canvRect-5.4 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 3 -outline red .c bbox x -} {8 8 32 22} +} -cleanup { + .c delete withtag all +} -result {8 8 32 22} # I can't come up with any good tests for DisplayRectOval. -.c delete withtag all -set x [.c create rectangle 10 20 30 35 -tags x -fill green] -set y [.c create rectangle 15 25 25 30 -tags y -fill red] -test canvRect-6.1 {RectToPoint procedure} { +test canvRect-6.1 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -outline {} - list [.c find closest 14.9 28] [.c find closest 15.1 28] \ - [.c find closest 24.9 28] [.c find closest 25.1 28] -} "$x $y $y $x" -test canvRect-6.2 {RectToPoint procedure} { + list [expr {[.c find closest 14.9 28] eq $xId}] \ + [expr {[.c find closest 15.1 28] eq $yId}] \ + [expr {[.c find closest 24.9 28] eq $yId}] \ + [expr {[.c find closest 25.1 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.2 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -outline {} - list [.c find closest 20 24.9] [.c find closest 20 25.1] \ - [.c find closest 20 29.9] [.c find closest 20 30.1] -} "$x $y $y $x" -test canvRect-6.3 {RectToPoint procedure} { + list [expr {[.c find closest 20 24.9] eq $xId}] \ + [expr {[.c find closest 20 25.1] eq $yId}] \ + [expr {[.c find closest 20 29.9] eq $yId}] \ + [expr {[.c find closest 20 30.1] eq $xId}] + +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.3 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -width 1 -outline black - list [.c find closest 14.4 28] [.c find closest 14.6 28] \ - [.c find closest 25.4 28] [.c find closest 25.6 28] -} "$x $y $y $x" -test canvRect-6.4 {RectToPoint procedure} { + list [expr {[.c find closest 14.4 28] eq $xId}] \ + [expr {[.c find closest 14.6 28] eq $yId}] \ + [expr {[.c find closest 25.4 28] eq $yId}] \ + [expr {[.c find closest 25.6 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.4 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -width 1 -outline black - list [.c find closest 20 24.4] [.c find closest 20 24.6] \ - [.c find closest 20 30.4] [.c find closest 20 30.6] -} "$x $y $y $x" -.c itemconfigure x -fill {} -outline black -width 3 -.c itemconfigure y -outline {} -test canvRect-6.5 {RectToPoint procedure} { - list [.c find closest 13.2 28] [.c find closest 13.3 28] \ - [.c find closest 26.7 28] [.c find closest 26.8 28] -} "$x $y $y $x" -test canvRect-6.6 {RectToPoint procedure} { - list [.c find closest 20 23.2] [.c find closest 20 23.3] \ - [.c find closest 20 31.7] [.c find closest 20 31.8] -} "$x $y $y $x" -.c delete withtag all -set x [.c create rectangle 10 20 30 40 -outline {} -fill black] -set y [.c create rectangle 40 40 50 50 -outline {} -fill black] -test canvRect-6.7 {RectToPoint procedure} { - list [.c find closest 35 35] [.c find closest 36 36] \ - [.c find closest 37 37] [.c find closest 38 38] -} "$x $y $y $y" + list [expr {[.c find closest 20 24.4] eq $xId}] \ + [expr {[.c find closest 20 24.6] eq $yId}] \ + [expr {[.c find closest 20 30.4] eq $yId}] \ + [expr {[.c find closest 20 30.6] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} -.c delete withtag all -set x [.c create rectangle 10 20 30 35 -fill green -outline {}] -set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] -set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] -test canvRect-7.1 {RectToArea procedure} { - list [.c find overlapping 20 50 38 60] \ - [.c find overlapping 20 50 39 60] \ - [.c find overlapping 20 50 70 60] \ - [.c find overlapping 61 50 70 60] \ - [.c find overlapping 62 50 70 60] -} "{} $y $y $y {}" -test canvRect-7.2 {RectToArea procedure} { - list [.c find overlapping 45 20 55 43] \ - [.c find overlapping 45 20 55 44] \ - [.c find overlapping 45 20 55 80] \ - [.c find overlapping 45 71 55 80] \ - [.c find overlapping 45 72 55 80] -} "{} $y $y $y {}" -test canvRect-7.3 {RectToArea procedure} { - list [.c find overlapping 5 25 9.9 30] [.c find overlapping 5 25 10.1 30] -} "{} $x" -test canvRect-7.4 {RectToArea procedure} { - list [.c find overlapping 102 152 118 168] \ - [.c find overlapping 101 152 118 168] \ - [.c find overlapping 102 151 118 168] \ - [.c find overlapping 102 152 119 168] \ - [.c find overlapping 102 152 118 169] -} "{} $z $z $z $z" -test canvRect-7.5 {RectToArea procedure} { - list [.c find enclosed 20 40 38 80] \ - [.c find enclosed 20 40 39 80] \ - [.c find enclosed 20 40 70 80] \ - [.c find enclosed 61 40 70 80] \ - [.c find enclosed 62 40 70 80] -} "{} {} $y {} {}" -test canvRect-7.6 {RectToArea procedure} { - list [.c find enclosed 20 20 65 43] \ - [.c find enclosed 20 20 65 44] \ - [.c find enclosed 20 20 65 80] \ - [.c find enclosed 20 71 65 80] \ - [.c find enclosed 20 72 65 80] -} "{} {} $y {} {}" +test canvRect-6.5 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] + .c itemconfigure x -fill {} -outline black -width 3 + .c itemconfigure y -outline {} + list [expr {[.c find closest 13.2 28] eq $xId}] \ + [expr {[.c find closest 13.3 28] eq $yId}] \ + [expr {[.c find closest 26.7 28] eq $yId}] \ + [expr {[.c find closest 26.8 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.6 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] + .c itemconfigure x -fill {} -outline black -width 3 + .c itemconfigure y -outline {} + list [expr {[.c find closest 20 23.2] eq $xId}] \ + [expr {[.c find closest 20 23.3] eq $yId}] \ + [expr {[.c find closest 20 31.7] eq $yId}] \ + [expr {[.c find closest 20 31.8] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} + +test canvRect-6.7 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 40 -outline {} -fill black] + set yId [.c create rectangle 40 40 50 50 -outline {} -fill black] + list [expr {[.c find closest 35 35] eq $xId}] \ + [expr {[.c find closest 36 36] eq $yId}] \ + [expr {[.c find closest 37 37] eq $yId}] \ + [expr {[.c find closest 38 38] eq $yId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} -.c delete withtag all -set x [.c create oval 50 100 200 150 -fill green -outline {}] -set y [.c create oval 50 100 200 150 -fill red -outline black -width 3] -set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3] -test canvRect-8.1 {OvalToArea procedure} { - list [.c find overlapping 20 120 48 130] \ - [.c find overlapping 20 120 49 130] \ - [.c find overlapping 20 120 50.2 130] \ - [.c find overlapping 20 120 300 130] \ - [.c find overlapping 60 120 190 130] \ - [.c find overlapping 199.9 120 300 130] \ - [.c find overlapping 201 120 300 130] \ - [.c find overlapping 202 120 300 130] -} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}" -test canvRect-8.2 {OvalToArea procedure} { - list [.c find overlapping 100 50 150 98] \ - [.c find overlapping 100 50 150 99] \ - [.c find overlapping 100 50 150 100.1] \ - [.c find overlapping 100 50 150 200] \ - [.c find overlapping 100 110 150 140] \ - [.c find overlapping 100 149.9 150 200] \ - [.c find overlapping 100 151 150 200] \ - [.c find overlapping 100 152 150 200] -} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}" -test canvRect-8.3 {OvalToArea procedure} { - list [.c find overlapping 176 104 177 105] \ - [.c find overlapping 187 116 188 117] \ - [.c find overlapping 192 142 193 143] \ - [.c find overlapping 180 138 181 139] \ - [.c find overlapping 61 142 62 143] \ - [.c find overlapping 65 137 66 136] \ - [.c find overlapping 62 108 63 109] \ - [.c find overlapping 68 115 69 116] -} "{} {$x $y} {} {$x $y} {} {$x $y} {} {$x $y}" -test canvRect-9.1 {ScaleRectOval procedure} { +test canvRect-7.1 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 20 50 38 60] eq {}}] \ + [expr {[.c find overlapping 20 50 39 60] eq $yId}] \ + [expr {[.c find overlapping 20 50 70 60] eq $yId}] \ + [expr {[.c find overlapping 61 50 70 60] eq $yId}] \ + [expr {[.c find overlapping 62 50 70 60] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.2 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 45 20 55 43] eq {}}] \ + [expr {[.c find overlapping 45 20 55 44] eq $yId}] \ + [expr {[.c find overlapping 45 20 55 80] eq $yId}] \ + [expr {[.c find overlapping 45 71 55 80] eq $yId}] \ + [expr {[.c find overlapping 45 72 55 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.3 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 5 25 9.9 30] eq {}}] \ + [expr {[.c find overlapping 5 25 10.1 30] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1} +test canvRect-7.4 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 102 152 118 168] eq {}}]\ + [expr {[.c find overlapping 101 152 118 168] eq $zId}] \ + [expr {[.c find overlapping 102 151 118 168] eq $zId}] \ + [expr {[.c find overlapping 102 152 119 168] eq $zId}] \ + [expr {[.c find overlapping 102 152 118 169] eq $zId}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.5 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find enclosed 20 40 38 80] eq {}}] \ + [expr {[.c find enclosed 20 40 39 80] eq {}}] \ + [expr {[.c find enclosed 20 40 70 80] eq $yId}] \ + [expr {[.c find enclosed 61 40 70 80] eq {}}] \ + [expr {[.c find enclosed 62 40 70 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.6 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find enclosed 20 20 65 43] eq {}}] \ + [expr {[.c find enclosed 20 20 65 44] eq {}}] \ + [expr {[.c find enclosed 20 20 65 80] eq $yId}] \ + [expr {[.c find enclosed 20 71 65 80] eq {}}] \ + [expr {[.c find enclosed 20 72 65 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} + + +test canvRect-8.1 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 20 120 48 130] eq {}}] \ + [expr {[.c find overlapping 20 120 49 130] eq "$yId $zId"}] \ + [expr {[.c find overlapping 20 120 50.2 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 20 120 300 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 60 120 190 130] eq "$xId $yId"}] \ + [expr {[.c find overlapping 199.9 120 300 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 201 120 300 130] eq "$yId $zId"}] \ + [expr {[.c find overlapping 202 120 300 130] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} +test canvRect-8.2 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 100 50 150 98] eq {}}] \ + [expr {[.c find overlapping 100 50 150 99] eq "$yId $zId"}] \ + [expr {[.c find overlapping 100 50 150 100.1] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 50 150 200] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 110 150 140] eq "$xId $yId"}] \ + [expr {[.c find overlapping 100 149.9 150 200] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 151 150 200] eq "$yId $zId"}] \ + [expr {[.c find overlapping 100 152 150 200] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} +test canvRect-8.3 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 176 104 177 105] eq {}}] \ + [expr {[.c find overlapping 187 116 188 117] eq "$xId $yId"}] \ + [expr {[.c find overlapping 192 142 193 143] eq {}}] \ + [expr {[.c find overlapping 180 138 181 139] eq "$xId $yId"}] \ + [expr {[.c find overlapping 61 142 62 143] eq {}}] \ + [expr {[.c find overlapping 65 137 66 136] eq "$xId $yId"}] \ + [expr {[.c find overlapping 62 108 63 109] eq {}}] \ + [expr {[.c find overlapping 68 115 69 116] eq "$xId $yId"}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} + + +test canvRect-9.1 {ScaleRectOval procedure} -setup { .c delete withtag all +} -body { .c create rect 100 300 200 350 -tags x .c scale x 50 100 2 4 .c coords x -} {150.0 900.0 350.0 1100.0} +} -result {150.0 900.0 350.0 1100.0} -test canvRect-10.1 {TranslateRectOval procedure} { +test canvRect-10.1 {TranslateRectOval procedure} -setup { .c delete withtag all +} -body { .c create rect 100 300 200 350 -tags x .c move x 100 -10 .c coords x -} {200.0 290.0 300.0 340.0} +} -result {200.0 290.0 300.0 340.0} + -# This test is non-portable because different color information -# will get generated on different displays (e.g. mono displays -# vs. color). -test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} { +test canvRect-11.1 {RectOvalToPostscript procedure} -constraints { + nonPortable macCrash +} -setup { + .c delete withtag all +} -body { # Crashes on Mac because the XGetImage() call isn't implemented, causing a # dereference of NULL. - + # This test is non-portable because different color information + # will get generated on different displays (e.g. mono displays + # vs. color). .c configure -bd 0 -highlightthickness 0 - .c delete withtag all .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {} .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5 update set x [.c postscript] string range $x [string first "-200 -150 translate" $x] end -} {-200 -150 translate +} -result {-200 -150 translate 0 300 moveto 400 300 lineto 400 0 lineto 0 0 lineto closepath clip newpath gsave 50 240 moveto 40 0 rlineto 0 -20 rlineto -40 0 rlineto closepath @@ -328,3 +471,7 @@ end # cleanup cleanupTests return + + + + diff --git a/tests/canvText.test b/tests/canvText.test index 5367681..2e7ac54 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -6,117 +6,191 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvText.test,v 1.17 2008/07/23 23:24:25 nijtmans Exp $ +# RCS: @(#) $Id: canvText.test,v 1.18 2008/08/11 21:33:17 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# Canvas used in 1.* - 17.* tests canvas .c -width 400 -height 300 -bd 2 -relief sunken pack .c update -set i 1 +# Item used in 1.* tests .c create text 20 20 -tag test - -set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" -set ay [font metrics $font -linespace] -set ax [font measure $font 0] - - -foreach test { - {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}} - {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}} - {-fill {} {} {} {}} - {-font {Times 40} {Times 40} {} {font "" doesn't exist}} - {-justify left left xyz {bad justification "xyz": must be left, right, or center}} - {-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"}} -} { - 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 $goodResult $goodResult] - incr i - 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 -} -test canvText-1.$i {configuration options} { - .c itemconfigure test -tags {test xyz} - .c itemcget xyz -tags -} {test xyz} - +test canvText-1.1 {configuration options: good value for "anchor"} -body { + .c itemconfigure test -anchor nw + list [lindex [.c itemconfigure test -anchor] 4] [.c itemcget test -anchor] +} -result {nw nw} +test canvasText-1.2 {configuration options: bad value for "anchor"} -body { + .c itemconfigure test -anchor xyz +} -returnCodes error -result {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center} + +test canvText-1.3 {configuration options: good value for "fill"} -body { + .c itemconfigure test -fill #ff0000 + list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill] +} -result {{#ff0000} #ff0000} +test canvasText-1.4 {configuration options: bad value for "fill"} -body { + .c itemconfigure test -fill xyz +} -returnCodes error -result {unknown color name "xyz"} +test canvText-1.5 {configuration options: good value for "fill"} -body { + .c itemconfigure test -fill {} + list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill] +} -result {{} {}} + +test canvText-1.6 {configuration options: good value for "font"} -body { + .c itemconfigure test -font {Times 40} + list [lindex [.c itemconfigure test -font] 4] [.c itemcget test -font] +} -result {{Times 40} {Times 40}} +test canvasText-1.7 {configuration options: bad value for "font"} -body { + .c itemconfigure test -font {} +} -returnCodes error -result {font "" doesn't exist} + +test canvText-1.8 {configuration options: good value for "justify"} -body { + .c itemconfigure test -justify left + list [lindex [.c itemconfigure test -justify] 4] [.c itemcget test -justify] +} -result {left left} +test canvasText-1.9 {configuration options: bad value for "justify"} -body { + .c itemconfigure test -justify xyz +} -returnCodes error -result {bad justification "xyz": must be left, right, or center} + +test canvText-1.10 {configuration options: good value for "stipple"} -body { + .c itemconfigure test -stipple gray50 + list [lindex [.c itemconfigure test -stipple] 4] [.c itemcget test -stipple] +} -result {gray50 gray50} +test canvasText-1.11 {configuration options: bad value for "stipple"} -body { + .c itemconfigure test -stipple xyz +} -returnCodes error -result {bitmap "xyz" not defined} + +test canvText-1.12 {configuration options: good value for "underline"} -body { + .c itemconfigure test -underline 0 + list [lindex [.c itemconfigure test -underline] 4] [.c itemcget test -underline] +} -result {0 0} +test canvasText-1.13 {configuration options: bad value for "underline"} -body { + .c itemconfigure test -underline xyz +} -returnCodes error -result {expected integer but got "xyz"} + +test canvText-1.14 {configuration options: good value for "width"} -body { + .c itemconfigure test -width 6 + list [lindex [.c itemconfigure test -width] 4] [.c itemcget test -width] +} -result {6 6} +test canvasText-1.15 {configuration options: bad value for "width"} -body { + .c itemconfigure test -width xyz +} -returnCodes error -result {bad screen distance "xyz"} + +test canvText-1.16 {configuration options: good value for "tags"} -body { + .c itemconfigure test -tags {test a b c} + list [lindex [.c itemconfigure test -tags] 4] [.c itemcget test -tags] +} -result {{test a b c} {test a b c}} .c delete test -.c create text 20 20 -tag test -test canvText-2.1 {CreateText procedure: args} { - list [catch {.c create text} msg] $msg -} {1 {wrong # args: should be ".c create text coords ?arg ...?"}} -test canvText-2.2 {CreateText procedure: args} { - list [catch {.c create text xyz 0} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-2.3 {CreateText procedure: args} { - list [catch {.c create text 0 xyz} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-2.4 {CreateText procedure: args} { - list [catch {.c create text 0 0 -xyz xyz} msg] $msg -} {1 {unknown option "-xyz"}} -test canvText-2.5 {CreateText procedure} { + +test canvText-2.1 {CreateText procedure: args} -body { + .c create text +} -returnCodes {error} -result {wrong # args: should be ".c create text coords ?arg ...?"} +test canvText-2.2 {CreateText procedure: args} -body { + .c create text xyz 0 +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-2.3 {CreateText procedure: args} -body { + .c create text 0 xyz +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-2.4 {CreateText procedure: args} -body { + .c create text 0 0 -xyz xyz +} -cleanup { + .c delete all +} -returnCodes {error} -result {unknown option "-xyz"} +test canvText-2.5 {CreateText procedure} -body { .c create text 0 0 -tags x - set x [.c coords x] + .c coords x +} -cleanup { .c delete x - set x -} {0.0 0.0} +} -result {0.0 0.0} -focus -force .c -.c focus test -.c coords test 0 0 -update -test canvText-3.1 {TextCoords procedure} { +test canvText-3.1 {TextCoords procedure} -body { + .c create text 20 20 -tag test + .c coords test 0 0 + update .c coords test -} {0.0 0.0} -test canvText-3.2 {TextCoords procedure} { - list [catch {.c coords test xyz 0} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-3.3 {TextCoords procedure} { - list [catch {.c coords test 0 xyz} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-3.4 {TextCoords procedure} { +} -cleanup { + .c delete test +} -result {0.0 0.0} +test canvText-3.2 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test xyz 0 +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-3.3 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 0 xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-3.4 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { .c coords test 10 10 set result {} foreach element [.c coords test] { lappend result [format %.1f $element] } - set result -} {10.0 10.0} -test canvText-3.5 {TextCoords procedure} { - list [catch {.c coords test 10} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvText-3.6 {TextCoords procedure} { - list [catch {.c coords test 10 10 10} msg] $msg -} {1 {wrong # coordinates: expected 0 or 2, got 3}} - -test canvText-4.1 {ConfigureText procedure} { - list [catch {.c itemconfig test -fill xyz} msg] $msg -} {1 {unknown color name "xyz"}} -test canvText-4.2 {ConfigureText procedure} { + return $result +} -cleanup { + .c delete test +} -result {10.0 10.0} +test canvText-3.5 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 10 +} -cleanup { + .c delete test +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvText-3.6 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 10 10 10 +} -cleanup { + .c delete test +} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} + + +test canvText-4.1 {ConfigureText procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c itemconfig test -fill xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {unknown color name "xyz"} +test canvText-4.2 {ConfigureText procedure} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -fill blue .c itemcget test -fill -} {blue} -test canvText-4.3 {ConfigureText procedure: construct font gcs} { +} -cleanup { + .c delete test +} -result {blue} +test canvText-4.3 {ConfigureText procedure: construct font gcs} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -font "times 20" -fill black -stipple gray50 list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple] -} {{times 20} black gray50} -test canvText-4.4 {ConfigureText procedure: construct cursor gc} { +} -cleanup { + .c delete test +} -result {{times 20} black gray50} +test canvText-4.4 {ConfigureText procedure: construct cursor gc} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 @@ -133,9 +207,15 @@ test canvText-4.4 {ConfigureText procedure: construct cursor gc} { .c config -selectbackground red .c itemconfig test -just left update -} {} -test canvText-4.5 {ConfigureText procedure: adjust selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-4.5 {ConfigureText procedure: adjust selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test set x {} +} -body { .c itemconfig test -text "abcdefghi" .c select from test 2 .c select to test 6 @@ -154,89 +234,276 @@ test canvText-4.5 {ConfigureText procedure: adjust selection} { lappend x [selection get] .c dchars test 4 end lappend x [selection get] -} {cdefg 1 cdefg cd cdef cd} -test canvText-4.6 {ConfigureText procedure: adjust cursor} { +} -cleanup { + .c delete test +} -result {cdefg 1 cdefg cd cdef cd} +test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -text "abcdefghi" - set x {} .c icursor test 6 .c dchars test 4 end .c index test insert -} {4} +} -cleanup { + .c delete test +} -result {4} + -test canvText-5.1 {ConfigureText procedure: adjust cursor} { +test canvText-5.1 {ConfigureText procedure: adjust cursor} -body { .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz" .c delete x -} {} +} -result {} + -test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} { +test canvText-6.1 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test .c itemconfig test -font $font -text 0 - .c coords test 0 0 - set x {} - lappend x [.c itemconfig test -anchor n; .c bbox test] - lappend x [.c itemconfig test -anchor nw; .c bbox test] - lappend x [.c itemconfig test -anchor w; .c bbox test] - lappend x [.c itemconfig test -anchor sw; .c bbox test] - lappend x [.c itemconfig test -anchor s; .c bbox test] - lappend x [.c itemconfig test -anchor se; .c bbox test] - lappend x [.c itemconfig test -anchor e; .c bbox test] - lappend x [.c itemconfig test -anchor ne; .c bbox test] - lappend x [.c itemconfig test -anchor center; .c bbox test] -} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\ -{-1 0 [expr $ax+1] $ay}\ -{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\ -{-1 -$ay [expr $ax+1] 0}\ -{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\ -{[expr -$ax-1] -$ay 1 0}\ -{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\ -{[expr -$ax-1] 0 1 $ay}\ -{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}" + expr {[.c itemconfig test -anchor n; .c bbox test] \ + eq "[expr -$ax/2-1] 0 [expr $ax/2+1] $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.2 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor nw; .c bbox test] \ + eq "-1 0 [expr $ax+1] $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.3 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor w; .c bbox test] \ + eq "-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.4 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor sw; .c bbox test] \ + eq "-1 -$ay [expr $ax+1] 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.5 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor s; .c bbox test] \ + eq "[expr -$ax/2-1] -$ay [expr $ax/2+1] 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.6 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor se; .c bbox test] \ + eq "[expr -$ax-1] -$ay 1 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.7 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor e; .c bbox test]\ + eq "[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.8 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor ne; .c bbox test] \ + eq "[expr -$ax-1] 0 1 $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.9 {ComputeTextBbox procedure} -constraints { + fonts +} -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor center; .c bbox test] \ + eq "[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 + +#.c delete test +#.c create text 20 20 -tag test +#focus -force .c +#.c focus test focus .c .c focus test .c itemconfig test -text "abcd\nefghi\njklmnopq" -test canvText-7.0 {DisplayText procedure: stippling} { +test canvText-7.1 {DisplayText procedure: stippling} -body { + .c create text 20 20 -tag test .c itemconfig test -stipple gray50 update .c itemconfig test -stipple {} update -} {} -test canvText-7.2 {DisplayText procedure: draw selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.2 {DisplayText procedure: draw selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 0 .c select to test end update selection get -} "abcd\nefghi\njklmnopq" -test canvText-7.3 {DisplayText procedure: selection} { +} -cleanup { + .c delete test +} -result "abcd\nefghi\njklmnopq" +test canvText-7.3 {DisplayText procedure: selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 0 .c select to test end update selection get -} "abcd\nefghi\njklmnopq" -test canvText-7.4 {DisplayText procedure: one line selection} { +} -cleanup { + .c delete test +} -result "abcd\nefghi\njklmnopq" +test canvText-7.4 {DisplayText procedure: one line selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 2 .c select to test 3 update -} {} -test canvText-7.5 {DisplayText procedure: multi-line selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.5 {DisplayText procedure: multi-line selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 2 .c select to test 12 update -} {} -test canvText-7.6 {DisplayText procedure: draw cursor} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.6 {DisplayText procedure: draw cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c icursor test 3 update -} {} -test canvText-7.7 {DisplayText procedure: selected text different color} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.7 {DisplayText procedure: selected text different color} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c config -selectforeground blue .c itemconfig test -anchor n update -} {} -test canvText-7.8 {DisplayText procedure: not selected} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.8 {DisplayText procedure: not selected} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c select clear update -} {} -test canvText-7.9 {DisplayText procedure: select end} { - catch {destroy .t} +} -cleanup { + .c delete test +} -result {} +test canvText-7.9 {DisplayText procedure: select end} -setup { + destroy .t +} -body { toplevel .t wm geometry .t +0+0 canvas .t.c @@ -248,244 +515,348 @@ test canvText-7.9 {DisplayText procedure: select end} { update #catch {destroy .t} update -} {} - -test canvText-8.1 {TextInsert procedure: 0 length insert} { +} -cleanup { + destroy .t +} -result {} + +test canvText-8.1 {TextInsert procedure: 0 length insert} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c insert test end {} -} {} -test canvText-8.2 {TextInsert procedure: before beginning/after end} { +} -cleanup { + .c delete test +} -result {} +test canvText-8.2 {TextInsert procedure: before beginning/after end} -body { # Can't test this because GetTextIndex filters out those numbers. -} {} -test canvText-8.3 {TextInsert procedure: inserting in a selected item} { +} -result {} +test canvText-8.3 {TextInsert procedure: inserting in a selected item} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" .c itemcget test -text -} {axyzbcdefg} -test canvText-8.4 {TextInsert procedure: inserting before selection} { +} -result {axyzbcdefg} +test canvText-8.4 {TextInsert procedure: inserting before selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {5 7} -test canvText-8.5 {TextInsert procedure: inserting in selection} { +} -result {5 7} +test canvText-8.5 {TextInsert procedure: inserting in selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 3 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {2 7} -test canvText-8.6 {TextInsert procedure: inserting after selection} { +} -result {2 7} +test canvText-8.6 {TextInsert procedure: inserting after selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 5 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {2 4} -test canvText-8.7 {TextInsert procedure: inserting in unselected item} { +} -result {2 4} +test canvText-8.7 {TextInsert procedure: inserting in unselected item} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select clear .c insert test 5 "xyz" .c itemcget test -text -} {abcdexyzfg} -test canvText-8.8 {TextInsert procedure: inserting before cursor} { +} -result {abcdexyzfg} +test canvText-8.8 {TextInsert procedure: inserting before cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 2 "xyz" .c index test insert -} {6} -test canvText-8.9 {TextInsert procedure: inserting after cursor} { +} -result {6} +test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 4 "xyz" .c index test insert -} {3} +} -result {3} -test canvText-9.1 {TextInsert procedure: before beginning/after end} { +# Item used in 9.* tests +.c create text 20 20 -tag test +test canvText-9.1 {TextInsert procedure: before beginning/after end} -body { # Can't test this because GetTextIndex filters out those numbers. -} {} -test canvText-9.2 {TextInsert procedure: start > end} { +} -result {} +test canvText-9.2 {TextInsert procedure: start > end} -body { .c itemconfig test -text "abcdefg" .c dchars test 4 2 .c itemcget test -text -} {abcdefg} -test canvText-9.3 {TextInsert procedure: deleting from a selected item} { +} -result {abcdefg} +test canvText-9.3 {TextInsert procedure: deleting from a selected item} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c dchars test 3 5 .c itemcget test -text -} {abcg} -test canvText-9.4 {TextInsert procedure: deleting before start} { +} -result {abcg} +test canvText-9.4 {TextInsert procedure: deleting before start} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 1 1 list [.c index test sel.first] [.c index test sel.last] -} {3 7} -test canvText-9.5 {TextInsert procedure: keep start > first char deleted} { +} -result {3 7} +test canvText-9.5 {TextInsert procedure: keep start > first char deleted} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 2 6 list [.c index test sel.first] [.c index test sel.last] -} {2 3} -test canvText-9.6 {TextInsert procedure: deleting inside selection} { +} -result {2 3} +test canvText-9.6 {TextInsert procedure: deleting inside selection} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 6 list [.c index test sel.first] [.c index test sel.last] -} {4 7} -test canvText-9.7 {TextInsert procedure: keep end > first char deleted} { +} -result {4 7} +test canvText-9.7 {TextInsert procedure: keep end > first char deleted} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 10 list [.c index test sel.first] [.c index test sel.last] -} {4 5} -test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} { +} -result {4 5} +test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 3 10 - list [catch {.c index test sel.first} msg] $msg -} {1 {selection isn't in item}} -test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} { + .c index test sel.first +} -returnCodes {error} -result {selection isn't in item} +test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 4 7 list [.c index test sel.first] [.c index test sel.last] -} {4 4} -test canvText-9.10 {TextInsert procedure: move anchor} { +} -result {4 4} +test canvText-9.10 {TextInsert procedure: move anchor} -body { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 2 4 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] -} {1 2} -test canvText-9.11 {TextInsert procedure: keep anchor >= first} { +} -result {1 2} +test canvText-9.11 {TextInsert procedure: keep anchor >= first} -body { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 5 7 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] -} {1 4} -test canvText-9.12 {TextInsert procedure: anchor doesn't move} { +} -result {1 4} +test canvText-9.12 {TextInsert procedure: anchor doesn't move} -body { .c itemconfig test -text "abcdefghijk" .c select from test 2 .c select to test 5 .c dchars test 6 8 .c select to test 8 list [.c index test sel.first] [.c index test sel.last] -} {2 8} -test canvText-9.13 {TextInsert procedure: move cursor} { +} -result {2 8} +test canvText-9.13 {TextInsert procedure: move cursor} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 4 .c index test insert -} {3} -test canvText-9.14 {TextInsert procedure: keep cursor >= first} { +} -result {3} +test canvText-9.14 {TextInsert procedure: keep cursor >= first} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 10 .c index test insert -} {2} -test canvText-9.15 {TextInsert procedure: cursor doesn't move} { +} -result {2} +test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 5 .c dchars test 7 9 .c index test insert -} {5} +} -result {5} +.c delete test + -test canvText-10.1 {TextToPoint procedure} { - .c coords test 0 0 +test canvText-10.1 {TextToPoint procedure} -body { + .c create text 0 0 -tag test .c itemconfig test -text 0 -anchor center .c index test @0,0 -} {0} +} -cleanup { + .c delete test +} -result {0} + -test canvText-11.1 {TextToArea procedure} { - .c coords test 0 0 +test canvText-11.1 {TextToArea procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text 0 -anchor center - .c find overlapping 0 0 1 1 -} [.c find withtag test] -test canvText-11.2 {TextToArea procedure} { - .c coords test 0 0 + set res1 [.c find overlapping 0 0 1 1] + set res2 [.c find withtag test] + expr {$res1 eq $res2} +} -cleanup { + .c delete test +} -result 1 +test canvText-11.2 {TextToArea procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text 0 -anchor center .c find overlapping 1000 1000 1001 1001 -} {} +} -cleanup { + .c delete test +} -result {} -test canvText-12.1 {ScaleText procedure} { - .c coords test 100 100 + +test canvText-12.1 {ScaleText procedure} -body { + .c create text 100 100 -tag test .c scale all 50 50 2 2 .c coords test -} {150.0 150.0} +} -cleanup { + .c delete test +} -result {150.0 150.0} + -test canvText-13.1 {TranslateText procedure} { - .c coords test 100 100 +test canvText-13.1 {TranslateText procedure} -body { + .c create text 100 100 -tag test .c move all 10 10 .c coords test -} {110.0 110.0} - -.c itemconfig test -text "abcdefghijklmno" -anchor nw -.c select from test 5 -.c select to test 8 -.c icursor test 12 -.c coords test 0 0 -test canvText-14.1 {GetTextIndex procedure} { +} -cleanup { + .c delete test +} -result {110.0 110.0} + + +test canvText-14.1 {GetTextIndex procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcdefghijklmno" -anchor nw + .c select from test 5 + .c select to test 8 + .c icursor test 12 + .c coords test 0 0 + list [.c index test end] [.c index test insert] \ [.c index test sel.first] [.c index test sel.last] \ [.c index test @0,0] \ [.c index test -1] [.c index test 10] [.c index test 100] -} {15 12 5 8 0 0 10 15} -test canvText-14.2 {GetTextIndex procedure: select error} { +} -cleanup { + .c delete test +} -result {15 12 5 8 0 0 10 15} +test canvText-14.2 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.first} msg] $msg -} {1 {selection isn't in item}} -test canvText-14.3 {GetTextIndex procedure: select error} { + .c index test sel.first +} -cleanup { + .c delete test +} -returnCodes {error} -result {selection isn't in item} +test canvText-14.3 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.last} msg] $msg -} {1 {selection isn't in item}} -test canvText-14.4 {GetTextIndex procedure: select error} { + .c index test sel.last +} -cleanup { + .c delete test +} -returnCodes {error} -result {selection isn't in item} +test canvText-14.4 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.} msg] $msg -} {1 {bad index "sel."}} -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-15.1 {SetTextCursor procedure} { + .c index test sel. +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad index "sel."} +test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c index test xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad index "xyz"} + + +test canvText-15.1 {SetTextCursor procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcdefghijklmno" -anchor nw .c itemconfig -text "abcdefg" .c icursor test 3 .c index test insert -} {3} +} -cleanup { + .c delete test +} -result {3} -test canvText-16.1 {GetSelText procedure} { + +test canvText-16.1 {GetSelText procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 selection get -} {fghi} +} -cleanup { + .c delete test +} -result {fghi} -set font {Courier 12 italic} -set ax [font measure $font 0] -set ay [font metrics $font -linespace] -test canvText-17.1 {TextToPostscript procedure} { +test canvText-17.1 {TextToPostscript procedure} -setup { .c delete all - .c config -height 300 -highlightthickness 0 -bd 0 - update - .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] - set x [string range $x [string first "/Courier-Oblique" $x] end] -} "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont +} -body { + set font {Courier 12 italic} + set ax [font measure $font 0] + set ay [font metrics $font -linespace] + + set result "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont 0.000 0.000 0.000 setrgbcolor AdjustColor 100 200 \[ \[(000)\] @@ -499,23 +870,35 @@ restore showpage end %%EOF " + .c config -height 300 -highlightthickness 0 -bd 0 + update + .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] + set x [string range $x [string first "/Courier-Oblique" $x] end] + expr {$x eq $result} +} -result 1 -test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} { - catch {destroy .c} - canvas .c - pack .c - .c delete all +test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -setup { + destroy .c +} -body { + pack [canvas .c] .c create text 100 100 -text Hello\n -anchor nw set bbox [.c bbox 1] set x2 [lindex $bbox 2] set y2 [lindex $bbox 3] incr y2 update - .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1] -} 1 + .c find enclosed 99 99 [expr $x2 + 1] [expr $y2 + 1] +} -cleanup { + destroy .c +} -result 1 + -test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { - catch {destroy .c} +test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup { + destroy .c +} -body { set c [canvas .c -bg black -width 964] pack $c $c delete all @@ -565,10 +948,15 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { lappend results [$c index tbox1 @$x,$y1] lappend results [$c index tbox2 @$x,$y2] - set results -} {{Yeah } Yeah- 4 4} + return $results +} -cleanup { + destroy .c +} -result {{Yeah } Yeah- 4 4} # cleanup cleanupTests return + + + diff --git a/tests/obj.test b/tests/obj.test index 3112f8b..3cd7230 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -5,28 +5,26 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: obj.test,v 1.5 2004/05/23 17:34:49 dkf Exp $ +# RCS: @(#) $Id: obj.test,v 1.6 2008/08/11 21:33:17 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test obj-1.1 {TkGetPixelsFromObj} { -} {} +test obj-1.1 {TkGetPixelsFromObj} -body { +} -result {} -test obj-2.1 {FreePixelInternalRep} { -} {} +test obj-2.1 {FreePixelInternalRep} -body { +} -result {} -test obj-3.1 {DupPixelInternalRep} { -} {} +test obj-3.1 {DupPixelInternalRep} -body { +} -result {} -test obj-4.1 {SetPixelFromAny} { -} {} +test obj-4.1 {SetPixelFromAny} -body { +} -result {} - -deleteWindows - # cleanup cleanupTests return |