diff options
Diffstat (limited to 'tcl/tests/canvRect.test')
| -rw-r--r-- | tcl/tests/canvRect.test | 341 |
1 files changed, 0 insertions, 341 deletions
diff --git a/tcl/tests/canvRect.test b/tcl/tests/canvRect.test deleted file mode 100644 index ad59f5c7afe..00000000000 --- a/tcl/tests/canvRect.test +++ /dev/null @@ -1,341 +0,0 @@ -# This file is a Tcl script to test out the procedures in tkRectOval.c, -# which implement canvas "rectangle" and "oval" items. It is organized -# in the standard fashion for Tcl tests. -# -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. -# -# RCS: @(#) $Id$ - -package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] -tcltest::loadTestedCommands - -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 -.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"}} -} { - set name [lindex $test 0] - test canvRect-1.$i {configuration options} { - .c itemconfigure test $name [lindex $test 1] - list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name] - } [list [lindex $test 2] [lindex $test 2]] - incr i - if {[lindex $test 3] != ""} { - test canvRect-1.$i {configuration options} { - list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - incr i -} -test canvRect-1.$i {configuration options} { - .c itemconfigure test -tags {test xyz} - .c itemcget xyz -tags -} {test xyz} - -test canvRect-2.1 {CreateRectOval procedure} { - list [catch {.c create rect} msg] $msg -} {1 {wrong # args: should be ".c create rectangle x1 y1 x2 y2 ?options?"}} -test canvRect-2.2 {CreateRectOval procedure} { - list [catch {.c create oval x y z} msg] $msg -} {1 {wrong # args: should be ".c create oval x1 y1 x2 y2 ?options?"}} -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} { - .c create rectangle 1 2 3 4 -tags x - set result {} - foreach element [.c coords x] { - 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"}} - -.c delete withtag all -.c create rectangle 10 20 30 40 -tags x -test canvRect-3.1 {RectOvalCoords procedure} { - set result {} - foreach element [.c coords x] { - 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} { - # 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}} - -.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. - .c itemconfigure x -width 10 - .c bbox x -} {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} { - # Non-portable due to rounding differences: - .c coords x 20 15 10 5 - .c bbox x -} {10 5 20 15} -test canvRect-5.2 {ComputeRectOvalBbox procedure} {nonPortable} { - # Non-portable due to rounding differences: - .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} { - # Non-portable due to rounding differences: - .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} { - # Non-portable due to rounding differences: - .c coords x 10 20 30 10 - .c itemconfigure x -width 3 -outline red - .c bbox x -} {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} { - .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} { - .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} { - .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} { - .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" - -.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 {} {}" - -.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} { - .c delete withtag all - .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} - -test canvRect-10.1 {TranslateRectOval procedure} { - .c delete withtag all - .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} - -# 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} { - # Crashes on Mac because the XGetImage() call isn't implemented, causing a - # dereference of NULL. - - .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 -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 -0.000 0.000 0.000 setrgbcolor AdjustColor -clip 16 16 <5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555 -aaaa> StippleFill -grestore -gsave -matrix currentmatrix -150 125 translate 50 25 scale 1 0 moveto 0 0 1 0 360 arc -setmatrix -5 setlinewidth 0 setlinejoin 2 setlinecap -1.000 0.000 0.000 setrgbcolor AdjustColor -stroke -grestore -restore showpage - -%%Trailer -end -%%EOF -} - -# cleanup -::tcltest::cleanupTests -return - - - - - - - - - - - - - |