summaryrefslogtreecommitdiff
path: root/tk/tests/listbox.test
diff options
context:
space:
mode:
Diffstat (limited to 'tk/tests/listbox.test')
-rw-r--r--tk/tests/listbox.test439
1 files changed, 423 insertions, 16 deletions
diff --git a/tk/tests/listbox.test b/tk/tests/listbox.test
index 40e65d6218e..900ad1f963a 100644
--- a/tk/tests/listbox.test
+++ b/tk/tests/listbox.test
@@ -3,14 +3,14 @@
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
foreach i [winfo children .] {
destroy $i
@@ -88,7 +88,7 @@ foreach test {
{-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
{-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
{-highlightthickness -2 0 {} {}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
{-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
{-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
@@ -98,6 +98,7 @@ foreach test {
{-width 45 45 3p {expected integer but got "3p"}}
{-xscrollcommand {Some command} {Some command} {} {}}
{-yscrollcommand {Another command} {Another command} {} {}}
+ {-listvar testVariable testVariable {} {}}
} {
set name [lindex $test 0]
test listbox-1.$i {configuration options} {
@@ -238,7 +239,7 @@ test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
} {0}
test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
llength [.l configure]
-} {23}
+} {24}
test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
list [catch {.l configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
@@ -335,10 +336,10 @@ test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} {
} {el0 el1 el2 el3 el4 el5 el6 el7}
test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} {
list [catch {.l get} msg] $msg
-} {1 {wrong # args: should be ".l get first ?last?"}}
+} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}}
test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} {
list [catch {.l get a b c} msg] $msg
-} {1 {wrong # args: should be ".l get first ?last?"}}
+} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}}
test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} {
list [catch {.l get 2.4} msg] $msg
} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}}
@@ -481,7 +482,7 @@ test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} {
} {{0.249364 0.427481} {0.0714286 0.428571}}
test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} {
list [catch {.l scan foo 2 4} msg] $msg
-} {1 {bad scan option "foo": must be mark or dragto}}
+} {1 {bad option "foo": must be mark or dragto}}
test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} {
list [catch {.l see} msg] $msg
} {1 {wrong # args: should be ".l see index"}}
@@ -618,7 +619,7 @@ test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} {
} {2 5 6 7}
test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} {
list [catch {.l selection badOption 0 0} msg] $msg
-} {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
+} {1 {bad option "badOption": must be anchor, clear, includes, or set}}
test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} {
list [catch {.l size a} msg] $msg
} {1 {wrong # args: should be ".l size"}}
@@ -740,19 +741,19 @@ test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} {
} {0.55 0.65}
test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l whoknows} msg] $msg
-} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {1 {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.134 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l c} msg] $msg
-} {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {1 {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.135 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l in} msg] $msg
-} {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {1 {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.136 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l s} msg] $msg
-} {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {1 {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.137 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l se} msg] $msg
-} {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {1 {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}}
# No tests for DestroyListbox: I can't come up with anything to test
# in this procedure.
@@ -865,6 +866,83 @@ test listbox-4.8 {ConfigureListbox procedure} {
update
set log
} {{y 0 1} {x 0 1}}
+test listbox-4.9 {ConfigureListbox procedure, -listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l
+ .l insert end 1 2 3 4
+ .l configure -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ .l insert end 1 2 3 4
+ list $x [.l get 0 end]
+} [list [list a b c d] [list a b c d 1 2 3 4]]
+test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ set y [list 1 2 3 4]
+ listbox .l
+ .l configure -listvar x
+ .l configure -listvar y
+ .l insert end 5 6 7 8
+ list $x $y
+} [list [list a b c d] [list 1 2 3 4 5 6 7 8]]
+test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.14 {ConfigureListbox, non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ list [info exists x] $x
+} [list 1 {}]
+test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset y}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar y
+ list [info exists y] $y
+} [list 1 [list a b c d]]
+test listbox-4.16 {ConfigureListbox, listvar -> same listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar {}
+ .l get 0 end
+} [list a b c d]
+test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ set x {this is a " bad list}
+ catch {.l configure -listvar x} result
+ list [.l get 0 end] [.l cget -listvar] $result
+} [list [list a b c d] {} \
+ "unmatched open quote in list: invalid listvar value"]
# No tests for DisplayListbox: I don't know how to test this procedure.
@@ -1007,6 +1085,22 @@ test listbox-6.12 {InsertEls procedure} {fonts} {
.l2 insert 0 "much longer entry"
lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
} {80 93 122 110}
+test listbox-6.13 {InsertEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 insert 0 1 2 3 4
+ set x
+} [list 1 2 3 4 a b c d]
+test listbox-6.14 {InsertEls procedure, check selection update} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 0 1 2 3 4
+ .l2 selection set 2 4
+ .l2 insert 0 a
+ .l2 curselection
+} [list 3 4 5]
+
test listbox-7.1 {DeleteEls procedure} {
.l delete 0 end
@@ -1163,6 +1257,13 @@ test listbox-7.20 {DeleteEls procedure} {fonts} {
lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
} {80 144 17 93}
catch {destroy .l2}
+test listbox-7.21 {DeleteEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 delete 0 1
+ set x
+} [list c d]
test listbox-8.1 {ListboxEventProc procedure} {fonts} {
catch {destroy .l}
@@ -1649,6 +1750,309 @@ test listbox-20.1 {listbox vs hidden commands} {
list [winfo children .] [interp hidden]
} [list {} $l]
+# tests for ListboxListVarProc
+test listbox-21.1 {ListboxListVarProc} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ set x [list a b c d]
+ .l get 0 end
+} [list a b c d]
+test listbox-21.2 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ unset x
+ set x
+} [list a b c d]
+test listbox-21.3 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ unset x
+ info exists x
+} 0
+test listbox-21.4 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ lappend x e f g
+ .l size
+} 7
+test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l selection set end
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l curselection
+} {}
+test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 3
+ lappend x e f g
+ .l curselection
+} 3
+test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 0
+ set x [linsert $x 0 1 2 3 4]
+ .l curselection
+} 0
+test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 2
+ set x [list a b c]
+ .l curselection
+} 2
+test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
+ pack .l
+ update
+ lappend x "0000000000"
+ update
+ lappend x "00000000000000000000"
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5}]
+test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
+ pack .l
+ update
+ lappend x "0000000000"
+ update
+ lappend x "00000000000000000000"
+ update
+ set x [list "0000000000"]
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}]
+test listbox-21.11 {ListboxListVarProc, bad list} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ set x [list a b c d]
+ catch {set x {this is a " bad list}} result
+ set result
+} {can't set "x": invalid listvar value}
+test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l itemconfigure end -fg red
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l itemcget end -fg
+} {}
+test listbox-21.12 {ListboxListVarProc, cleanup item attributes} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l itemconfigure end -fg red
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l itemcget end -fg
+} {}
+test listbox-21.13 {listbox item configurations and listvar based deletions} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ .l insert end a b c
+ .l itemconfigure 1 -fg red
+ set x [list b c]
+ .l itemcget 1 -fg
+} red
+test listbox-21.14 {listbox item configurations and listvar based inserts} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ .l insert end a b c
+ .l itemconfigure 0 -fg red
+ set x [list 1 2 3 4 a b c]
+ .l itemcget 0 -fg
+} red
+test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} {
+ catch {destroy .l}
+ catch {unset x}
+ set log {}
+ listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3
+ pack .l
+ update
+ lappend x a b c d e f
+ update
+ set log
+} [list {y 0 1} {y 0 0.5}]
+test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x -height 3
+ pack .l
+ update
+ set x [list 0 1 2 3 4 5]
+ .l yview scroll 3 units
+ update
+ set result {}
+ lappend result [.l yview]
+ set x [lreplace $x 3 3]
+ set x [lreplace $x 3 3]
+ set x [lreplace $x 3 3]
+ update
+ lappend result [.l yview]
+ set result
+} [list {0.5 1} {0 1}]
+
+# UpdateHScrollbar
+test listbox-22.1 {UpdateHScrollbar} {
+ catch {destroy .l}
+ set log {}
+ listbox .l -font $fixed -width 10 -xscrollcommand "record x"
+ pack .l
+ update
+ .l insert end "0000000000"
+ update
+ .l insert end "00000000000000000000"
+ update
+ set log
+} [list {x 0 1} {x 0 1} {x 0 0.5}]
+
+# ConfigureListboxItem
+test listbox-23.1 {ConfigureListboxItem} {
+ catch {destroy .l}
+ listbox .l
+ catch {.l itemconfigure 0} result
+ set result
+} {item number "0" out of range}
+test listbox-23.2 {ConfigureListboxItem} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemconfigure 0
+} [list {-background background Background {} {}} \
+ {-bg -background} \
+ {-fg -foreground} \
+ {-foreground foreground Foreground {} {}} \
+ {-selectbackground selectBackground Foreground {} {}} \
+ {-selectforeground selectForeground Background {} {}}]
+test listbox-23.3 {ConfigureListboxItem, itemco shortcut} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemco 0 -background
+} {-background background Background {} {}}
+test listbox-23.4 {ConfigureListboxItem, wrong num args} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a
+ catch {.l itemco} result
+ set result
+} {wrong # args: should be ".l itemconfigure index ?option? ?value? ?option value ...?"}
+test listbox-23.5 {ConfigureListboxItem, multiple calls} {
+ catch {destroy .l}
+ listbox .l
+ set i 0
+ foreach color {red orange yellow green blue darkblue violet} {
+ .l insert end $color
+ .l itemconfigure $i -bg $color
+ incr i
+ }
+ pack .l
+ update
+ list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \
+ [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \
+ [.l itemcget 6 -bg]
+} {red orange yellow green blue darkblue violet}
+catch {destroy .l}
+listbox .l
+.l insert end a b c d
+set i 6
+foreach test {
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+ {-fg #110022 #110022 bogus {unknown color name "bogus"}}
+ {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
+ {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
+} {
+ set name [lindex $test 0]
+ test listbox-23.$i {configuration options} {
+ .l itemconfigure 0 $name [lindex $test 1]
+ list [lindex [.l itemconfigure 0 $name] 4] [.l itemcget 0 $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test listbox-1.$i {configuration options} {
+ list [catch {.l configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .l configure $name [lindex [.l configure $name] 3]
+ incr i
+}
+
+# ListboxWidgetObjCmd, itemcget
+test listbox-24.1 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemcget 0 -fg
+} {}
+test listbox-24.2 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l itemconfigure 0 -fg red
+ .l itemcget 0 -fg
+} red
+test listbox-24.3 {itemcget} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ catch {.l itemcget 0} result
+ set result
+} {wrong # args: should be ".l itemcget index option"}
+test listbox-24.3 {itemcget, itemcg shortcut} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ catch {.l itemcg 0} result
+ set result
+} {wrong # args: should be ".l itemcget index option"}
+
+# General item configuration issues
+test listbox-25.1 {listbox item configurations and widget based deletions} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a
+ .l itemconfigure 0 -fg red
+ .l delete 0 end
+ .l insert end a
+ .l itemcget 0 -fg
+} {}
+test listbox-25.2 {listbox item configurations and widget based inserts} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c
+ .l itemconfigure 0 -fg red
+ .l insert 0 1 2 3 4
+ list [.l itemcget 0 -fg] [.l itemcget 4 -fg]
+} [list {} red]
+
+
+
resetGridInfo
catch {destroy .l2}
catch {destroy .t}
@@ -1656,3 +2060,6 @@ catch {destroy .e}
catch {destroy .partial}
option clear
+# cleanup
+::tcltest::cleanupTests
+return
View Lorry Controller Status