diff options
author | dgp <dgp@users.sourceforge.net> | 2008-10-09 21:21:03 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2008-10-09 21:21:03 (GMT) |
commit | f5014f51de2a38100606b1a17c37dfa6adeb0254 (patch) | |
tree | 4dffdef6fe0ac726f03bbc051a23dde38ee49757 | |
parent | c56604b787456f11913887c485599b775b0ff04e (diff) | |
download | tk-f5014f51de2a38100606b1a17c37dfa6adeb0254.zip tk-f5014f51de2a38100606b1a17c37dfa6adeb0254.tar.gz tk-f5014f51de2a38100606b1a17c37dfa6adeb0254.tar.bz2 |
* generic/tkListbox.c: Make literal return values consistent with
those generated by Tcl_PrintDouble().
* tests/entry.test: Restore test naming consistency with Tk 8.5.
* tests/listbox.test: Remove some more dependency on precision in
test results.
-rw-r--r-- | ChangeLog | 9 | ||||
-rw-r--r-- | generic/tkListbox.c | 6 | ||||
-rw-r--r-- | tests/listbox.test | 149 |
3 files changed, 90 insertions, 74 deletions
@@ -1,3 +1,12 @@ +2008-10-09 Don Porter <dgp@users.sourceforge.net> + + * generic/tkListbox.c: Make literal return values consistent with + those generated by Tcl_PrintDouble(). + + * tests/entry.test: Restore test naming consistency with Tk 8.5. + * tests/listbox.test: Remove some more dependency on precision in + test results. + 2008-10-08 Jan Nijtmans <nijtmans@users.sf.net> * unix/tcl.m4: fix for bug [2073255] diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 79f8797..94be1fb 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkListbox.c,v 1.48 2008/10/05 18:22:21 dkf Exp $ + * RCS: @(#) $Id: tkListbox.c,v 1.49 2008/10/09 21:21:03 dgp Exp $ */ #include "default.h" @@ -1246,7 +1246,7 @@ ListboxXviewSubCmd( - 2*(listPtr->inset + listPtr->selBorderWidth); if (objc == 2) { if (listPtr->maxWidth == 0) { - Tcl_SetResult(interp, "0 1", TCL_STATIC); + Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); } else { char buf[TCL_DOUBLE_SPACE]; @@ -1320,7 +1320,7 @@ ListboxYviewSubCmd( if (objc == 2) { if (listPtr->nElements == 0) { - Tcl_SetResult(interp, "0 1", TCL_STATIC); + Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); } else { char buf[TCL_DOUBLE_SPACE]; diff --git a/tests/listbox.test b/tests/listbox.test index 1a1f6c3..82eebee 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: listbox.test,v 1.33 2008/10/06 23:59:02 patthoyts Exp $ +# RCS: @(#) $Id: listbox.test,v 1.34 2008/10/09 21:21:03 dgp Exp $ package require tcltest 2.2 eval tcltest::configure $argv @@ -319,7 +319,7 @@ test listbox-2.4 {Tk_ListboxCmd procedure} -setup { } -cleanup { destroy .l } -returnCodes error -result {unknown option "-gorp"} -test listbox-2.5 {Tk_ListboxCmd procedure} -setup { +test listbox-2.4.1 {Tk_ListboxCmd procedure} -setup { destroy .l } -body { catch {listbox .l -gorp foo} @@ -327,7 +327,7 @@ test listbox-2.5 {Tk_ListboxCmd procedure} -setup { } -cleanup { destroy .l } -result {0 {}} -test listbox-2.6 {Tk_ListboxCmd procedure} -setup { +test listbox-2.5 {Tk_ListboxCmd procedure} -setup { destroy .l } -body { listbox .l @@ -396,7 +396,7 @@ test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} -cleanup { tkwait visibility .l2 set x [.l2 bbox 0] destroy .l2 - return $x + set x } -cleanup { destroy .l2 } -result {} @@ -473,7 +473,7 @@ test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} -body { .l configure -bd 3 -highlightthickness 0 set x "[.l cget -bd] [.l cget -highlightthickness]" .l configure -bd $oldbd -highlightthickness $oldht - return $x + set x } -result {3 0} test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} -body { .l curselection a @@ -744,7 +744,7 @@ test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} -constraints { .t.l scan mark 100 140 .t.l scan dragto 90 137 update - list [.t.l xview] [.t.l yview] + list [format {%.6g %.6g} {*}[.t.l xview]] [format {%.6g %.6g} {*}[.t.l yview]] } -cleanup { destroy .t } -result {{0.249364 0.427481} {0.0714286 0.428571}} @@ -905,7 +905,7 @@ test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} -setup { } -body { listbox .l2 update - .l2 xview + format {%.6g %.6g} {*}[.l2 xview] } -cleanup { destroy .l2 } -result {0 1} @@ -1047,13 +1047,33 @@ test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} -setup { } -cleanup { destroy .l2 } -result {0.2 0.45} -test listbox-3.126 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} -setup { + destroy .l + listbox .l -width 10 -height 5 -font $fixed + pack .l + update +} -body { + .l insert 0 a b c d e f g h i j k l m n o p q r s t + mkPartial + format {%.6g %.6g} {*}[.partial.l yview] +} -cleanup { + destroy .l +} -result {0 0.266667} + +# Listbox used in 3.127 -3.137 tests +destroy .l +listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 +pack .l +.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ + el15 el16 el17 +update +test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} -body { .l yview foo } -returnCodes error -result {bad listbox index "foo": must be active, anchor, end, @x,y, or a number} -test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} -body { .l yview foo a b } -returnCodes error -result {unknown option "foo": must be moveto or scroll} -test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} -setup { +test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} -setup { destroy .l2 listbox .l2 -width 10 -height 5 -font $fixed pack .l2 @@ -1066,7 +1086,7 @@ test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} -setup { } -cleanup { destroy .l2 } -result {0.3 0.55} -test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} -setup { +test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} -setup { destroy .l2 listbox .l2 -width 10 -height 5 -font $fixed pack .l2 @@ -1079,7 +1099,7 @@ test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} -setup { } -cleanup { destroy .l2 } -result {0.4 0.65} -test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} -setup { +test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} -setup { destroy .l2 listbox .l2 -width 10 -height 5 -font $fixed pack .l2 @@ -1092,7 +1112,7 @@ test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} -setup { } -cleanup { destroy .l2 } -result {0.35 0.6} -test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} -setup { +test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} -setup { destroy .l2 listbox .l2 -width 10 -height 5 -font $fixed pack .l2 @@ -1107,35 +1127,22 @@ test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} -setup { } -cleanup { destroy .l2 } -result {0.55 0.65} -test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} -body { .l whoknows } -returnCodes error -result {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} -test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} -body { .l c } -returnCodes error -result {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} -test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} -body { .l in } -returnCodes error -result {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} -test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} -body { .l s } -returnCodes error -result {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} -test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} -body { +test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} -body { .l se } -returnCodes error -result {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} -test listbox-3.137 {ListboxWidgetCmd procedure, "yview" option, partial last line} -setup { - destroy .l - listbox .l -width 10 -height 5 -font $fixed - pack .l - update -} -body { - .l insert 0 a b c d e f g h i j k l m n o p q r s t - mkPartial - format {%.6g %.6g} {*}[.partial.l yview] -} -cleanup { - destroy .l -} -result {0 0.266667} - # No tests for DestroyListbox: I can't come up with anything to test # in this procedure. @@ -1290,7 +1297,7 @@ test listbox-4.8 {ConfigureListbox procedure} -setup { .l2 configure -fg black set log {} update - return $log + set log } -cleanup { destroy .l2 } -result {{y 0 1} {x 0 1}} @@ -1345,7 +1352,7 @@ test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} -setup listbox .l2 .l2 insert end a b c d .l2 configure -listvar x - return $x + set x } -cleanup { destroy .l2 } -result [list a b c d] @@ -1375,7 +1382,7 @@ test listbox-4.16 {ConfigureListbox, listvar -> same listvar} -setup { set x [list a b c d] listbox .l2 -listvar x .l2 configure -listvar x - return $x + set x } -cleanup { destroy .l2 } -result [list a b c d] @@ -1554,7 +1561,7 @@ test listbox-6.10 {InsertEls procedure} -body { set log {} .l insert 0 word update - return $log + set log } -result {{y 0 0.166667}} test listbox-6.11 {InsertEls procedure} -body { .l delete 0 end @@ -1563,7 +1570,7 @@ test listbox-6.11 {InsertEls procedure} -body { set log {} .l insert 0 "much longer entry" update - return $log + set log } -result {{y 0 0.166667} {x 0 1}} test listbox-6.12 {InsertEls procedure} -constraints { fonts @@ -1586,7 +1593,7 @@ test listbox-6.13 {InsertEls procedure, check -listvar update} -setup { set x [list a b c d] listbox .l2 -listvar x .l2 insert 0 1 2 3 4 - return $x + set x } -cleanup { destroy .l2 } -result [list 1 2 3 4 a b c d] @@ -1750,7 +1757,7 @@ test listbox-7.18 {DeleteEls procedure} -body { set log {} .l delete 4 6 update - return $log + set log } -result {{y 0 0.25}} test listbox-7.19 {DeleteEls procedure} -body { .l delete 0 end @@ -1759,7 +1766,7 @@ test listbox-7.19 {DeleteEls procedure} -body { set log {} .l delete 3 update - return $log + set log } -result {{y 0 0.2} {x 0 1}} test listbox-7.20 {DeleteEls procedure} -constraints { fonts @@ -1780,7 +1787,7 @@ test listbox-7.21 {DeleteEls procedure, check -listvar update} -setup { set x [list a b c d] listbox .l2 -listvar x .l2 delete 0 1 - return $x + set x } -result [list c d] @@ -1810,7 +1817,7 @@ test listbox-8.2 {ListboxEventProc procedure} -constraints { update place .l -width 50 -height 80 update - list [.l xview] [.l yview] + list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } -cleanup { destroy .l } -result {{0 0.222222} {0 0.333333}} @@ -2166,7 +2173,7 @@ test listbox-12.1 {ChangeListboxOffset procedure} -constraints { set log {} .l xview 99 update - list [.l xview] $log + list [format {%.6g %.6g} {*}[.l xview]] $log } -result {{0.9 1} {{x 0.9 1}}} test listbox-12.2 {ChangeListboxOffset procedure} -constraints { fonts @@ -2175,7 +2182,7 @@ test listbox-12.2 {ChangeListboxOffset procedure} -constraints { .l xview 99 .l xview moveto -.25 update - list [.l xview] $log + list [format {%.6g %.6g} {*}[.l xview]] $log } -result {{0 0.1} {{x 0 0.1}}} test listbox-12.3 {ChangeListboxOffset procedure} -constraints { fonts @@ -2185,11 +2192,11 @@ test listbox-12.3 {ChangeListboxOffset procedure} -constraints { set log {} .l xview 10 update - list [.l xview] $log + list [format {%.6g %.6g} {*}[.l xview]] $log } -result {{0.1 0.2} {}} -# Listbox used in 12.* tests +# Listbox used in 13.* tests destroy .l listbox .l -font $fixed -width 10 -height 5 pack .l @@ -2206,7 +2213,7 @@ test listbox-13.1 {ListboxScanTo procedure} -constraints { .l scan mark 10 20 .l scan dragto [expr 10-$width] [expr 20-$height] update - list [.l xview] [.l yview] + list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } -result {{0.2 0.4} {0.5 0.75}} test listbox-13.2 {ListboxScanTo procedure} -constraints { fonts @@ -2216,10 +2223,10 @@ test listbox-13.2 {ListboxScanTo procedure} -constraints { .l scan mark 10 20 .l scan dragto 20 40 update - set x [list [.l xview] [.l yview]] + set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] .l scan dragto [expr 20-$width] [expr 40-$height] update - lappend x [.l xview] [.l yview] + lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } -result {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} test listbox-13.3 {ListboxScanTo procedure} -constraints { fonts @@ -2229,10 +2236,10 @@ test listbox-13.3 {ListboxScanTo procedure} -constraints { .l scan mark 10 20 .l scan dragto 5 10 update - set x [list [.l xview] [.l yview]] + set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] .l scan dragto [expr 5+$width] [expr 10+$height] update - lappend x [.l xview] [.l yview] + lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } -result {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} @@ -2424,7 +2431,7 @@ test listbox-18.1 {ListboxUpdateVScrollbar procedure} -body { update .l delete 0 end update - return $log + set log } -result {{y 0 1} {y 0 0.625} {y 0 1}} test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} -body { mkPartial @@ -2432,7 +2439,7 @@ test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} -body { set log {} .partial.l yview 3 update - return $log + set log } -result {{y 0.2 0.466667}} test listbox-18.3 {ListboxUpdateVScrollbar procedure} -body { proc bgerror args { @@ -2442,7 +2449,7 @@ test listbox-18.3 {ListboxUpdateVScrollbar procedure} -body { .l configure -yscrollcommand gorp .l insert 0 foo update - return $x + set x } -cleanup { rename bgerror {} } -result {{{invalid command name "gorp"}} {invalid command name "gorp" @@ -2467,7 +2474,7 @@ test listbox-19.1 {ListboxUpdateVScrollbar procedure} -constraints { update .l delete 0 end update - return $log + set log } -result {{x 0 1} {x 0 0.322581} {x 0 1}} test listbox-19.2 {ListboxUpdateVScrollbar procedure} -body { proc bgerror args { @@ -2477,7 +2484,7 @@ test listbox-19.2 {ListboxUpdateVScrollbar procedure} -body { .l configure -xscrollcommand bogus .l insert 0 foo update - return $x + set x } -result {{{invalid command name "bogus"}} {invalid command name "bogus" while executing "bogus 0.0 1.0" @@ -2514,7 +2521,7 @@ test listbox-21.2 {ListboxListVarProc} -setup { set x [list a b c d] listbox .l -listvar x unset x - return $x + set x } -cleanup { destroy .l } -result [list a b c d] @@ -2596,7 +2603,7 @@ test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} -setup update lappend x "00000000000000000000" update - return $log + set log } -cleanup { destroy .l } -result [list {x 0 1} {x 0 1} {x 0 0.5}] @@ -2614,7 +2621,7 @@ test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} -setu update set x [list "0000000000"] update - return $log + set log } -cleanup { destroy .l } -result [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] @@ -2625,7 +2632,7 @@ test listbox-21.11 {ListboxListVarProc, bad list} -setup { listbox .l -listvar x set x [list a b c d] catch {set x "this is a \" bad list"} result - return $result + set result } -cleanup { destroy .l } -result {can't set "x": invalid listvar value} @@ -2641,7 +2648,7 @@ test listbox-21.12 {ListboxListVarProc, cleanup item attributes} -setup { } -cleanup { destroy .l } -result {} -test listbox-21.13 {ListboxListVarProc, cleanup item attributes} -setup { +test listbox-21.12a {ListboxListVarProc, cleanup item attributes} -setup { destroy .l } -body { set x [list a b c d e f g] @@ -2653,7 +2660,7 @@ test listbox-21.13 {ListboxListVarProc, cleanup item attributes} -setup { } -cleanup { destroy .l } -result {} -test listbox-21.14 {listbox item configurations and listvar based deletions} -setup { +test listbox-21.13 {listbox item configurations and listvar based deletions} -setup { destroy .l } -body { catch {unset x} @@ -2665,7 +2672,7 @@ test listbox-21.14 {listbox item configurations and listvar based deletions} -se } -cleanup { destroy .l } -result red -test listbox-21.15 {listbox item configurations and listvar based inserts} -setup { +test listbox-21.14 {listbox item configurations and listvar based inserts} -setup { destroy .l } -body { catch {unset x} @@ -2677,7 +2684,7 @@ test listbox-21.15 {listbox item configurations and listvar based inserts} -setu } -cleanup { destroy .l } -result red -test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup { +test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} -setup { destroy .l } -body { catch {unset x} @@ -2687,11 +2694,11 @@ test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup { update lappend x a b c d e f update - return $log + set log } -cleanup { destroy .l } -result [list {y 0 1} {y 0 0.5}] -test listbox-21.17 {ListboxListVarProc, update vertical scrollbar} -setup { +test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup { destroy .l } -body { catch {unset x} @@ -2708,7 +2715,7 @@ test listbox-21.17 {ListboxListVarProc, update vertical scrollbar} -setup { set x [lreplace $x 3 3] update lappend result [format {%.6g %.6g} {*}[.l yview]] - return $result + set result } -cleanup { destroy .l } -result [list {0.5 1} {0 1}] @@ -2726,7 +2733,7 @@ test listbox-22.1 {UpdateHScrollbar} -setup { update .l insert end "00000000000000000000" update - return $log + set log } -cleanup { destroy .l } -result [list {x 0 1} {x 0 1} {x 0 0.5}] @@ -2738,7 +2745,7 @@ test listbox-23.1 {ConfigureListboxItem} -setup { } -body { listbox .l catch {.l itemconfigure 0} result - return $result + set result } -cleanup { destroy .l } -result {item number "0" out of range} @@ -2771,7 +2778,7 @@ test listbox-23.4 {ConfigureListboxItem, wrong num args} -setup { listbox .l .l insert end a catch {.l itemco} result - return $result + set result } -cleanup { destroy .l } -result {wrong # args: should be ".l itemconfigure index ?-option? ?value? ?-option value ...?"} @@ -2880,7 +2887,7 @@ test listbox-24.3 {itemcget} -setup { listbox .l .l insert end a b c d catch {.l itemcget 0} result - return $result + set result } -cleanup { destroy .l } -result {wrong # args: should be ".l itemcget index option"} @@ -2890,7 +2897,7 @@ test listbox-24.4 {itemcget, itemcg shortcut} -setup { listbox .l .l insert end a b c d catch {.l itemcg 0} result - return $result + set result } -cleanup { destroy .l } -result {wrong # args: should be ".l itemcget index option"} |