diff options
Diffstat (limited to 'tests/ttk/treeview.test')
| -rw-r--r-- | tests/ttk/treeview.test | 639 |
1 files changed, 639 insertions, 0 deletions
diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test new file mode 100644 index 0000000..d8bc65d --- /dev/null +++ b/tests/ttk/treeview.test @@ -0,0 +1,639 @@ +# +# [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do +# what it currently does) +# + +package require Tk 8.5 +package require tcltest ; namespace import -force tcltest::* +loadTestedCommands + +# consistencyCheck -- +# Traverse the tree to make sure the item data structures +# are properly linked. +# +# Since [$tv children] follows ->next links and [$tv index] +# follows ->prev links, this should cover all invariants. +# +proc consistencyCheck {tv {item {}}} { + set i 0; + foreach child [$tv children $item] { + assert {[$tv parent $child] == $item} "parent $child = $item" + assert {[$tv index $child] == $i} "index $child [$tv index $child]=$i" + incr i + consistencyCheck $tv $child + } +} + +proc assert {expr {message ""}} { + if {![uplevel 1 [list expr $expr]]} { + set error "PANIC! PANIC! PANIC: $message ($expr failed)" + puts stderr $error + error $error + } +} + +test treeview-0 "treeview test - setup" -body { + ttk::treeview .tv -columns {a b c} + pack .tv -expand true -fill both + update +} + +test treeview-1.1 "columns" -body { + .tv configure -columns {a b c} +} + +test treeview-1.2 "Bad columns" -body { + #.tv configure -columns {illegal "list"value} + ttk::treeview .badtv -columns {illegal "list"value} +} -returnCodes 1 -result "list element in quotes followed by*" -match glob + +test treeview-1.3 "bad displaycolumns" -body { + .tv configure -displaycolumns {a b d} +} -returnCodes 1 -result "Invalid column index d" + +test treeview-1.4 "more bad displaycolumns" -body { + .tv configure -displaycolumns {1 2 3} +} -returnCodes 1 -result "Column index 3 out of bounds" + +test treeview-1.5 "Don't forget to check negative numbers" -body { + .tv configure -displaycolumns {1 -2 3} +} -returnCodes 1 -result "Column index -2 out of bounds" + +# Item creation. +# +test treeview-2.1 "insert -- not enough args" -body { + .tv insert +} -returnCodes 1 -result "wrong # args: *" -match glob + +test treeview-2.3 "insert -- bad integer index" -body { + .tv insert {} badindex +} -returnCodes 1 -result "expected integer *" -match glob + +test treeview-2.4 "insert -- bad parent node" -body { + .tv insert badparent end +} -returnCodes 1 -result "Item badparent not found" -match glob + +test treeview-2.5 "insert -- finaly insert a node" -body { + .tv insert {} end -id newnode -text "New node" +} -result newnode + +test treeview-2.6 "insert -- make sure node was inserted" -body { + .tv children {} +} -result [list newnode] + +test treeview-2.7 "insert -- prevent duplicate node names" -body { + .tv insert {} end -id newnode +} -returnCodes 1 -result "Item newnode already exists" + +test treeview-2.8 "insert -- new node at end" -body { + .tv insert {} end -id lastnode + consistencyCheck .tv + .tv children {} +} -result [list newnode lastnode] + +consistencyCheck .tv + +test treeview-2.9 "insert -- new node at beginning" -body { + .tv insert {} 0 -id firstnode + consistencyCheck .tv + .tv children {} +} -result [list firstnode newnode lastnode] + +test treeview-2.10 "insert -- one more node" -body { + .tv insert {} 2 -id onemore + consistencyCheck .tv + .tv children {} +} -result [list firstnode newnode onemore lastnode] + +test treeview-2.11 "insert -- and another one" -body { + .tv insert {} 2 -id anotherone + consistencyCheck .tv + .tv children {} +} -result [list firstnode newnode anotherone onemore lastnode] + +test treeview-2.12 "insert -- one more at end" -body { + .tv insert {} end -id newlastone + consistencyCheck .tv + .tv children {} +} -result [list firstnode newnode anotherone onemore lastnode newlastone] + +test treeview-2.13 "insert -- one more at beginning" -body { + .tv insert {} 0 -id newfirstone + consistencyCheck .tv + .tv children {} +} -result [list newfirstone firstnode newnode anotherone onemore lastnode newlastone] + +test treeview-2.14 "insert -- bad options" -body { + .tv insert {} end -badoption foo +} -returnCodes 1 -result {unknown option "-badoption"} + +test treeview-2.15 "insert -- at position 0 w/no children" -body { + .tv insert newnode 0 -id newnode.n2 -text "Foo" + .tv children newnode +} -result newnode.n2 ;# don't crash + +test treeview-2.16 "insert -- insert way past end" -body { + .tv insert newnode 99 -id newnode.n3 -text "Foo" + consistencyCheck .tv + .tv children newnode +} -result [list newnode.n2 newnode.n3] + +test treeview-2.17 "insert -- insert before beginning" -body { + .tv insert newnode -1 -id newnode.n1 -text "Foo" + consistencyCheck .tv + .tv children newnode +} -result [list newnode.n1 newnode.n2 newnode.n3] + +### +# +test treeview-3.1 "parent" -body { + .tv parent newnode.n1 +} -result newnode +test treeview-3.2 "parent - top-level node" -body { + .tv parent newnode +} -result {} +test treeview-3.3 "parent - root node" -body { + .tv parent {} +} -result {} +test treeview-3.4 "index" -body { + list [.tv index newnode.n3] [.tv index newnode.n2] [.tv index newnode.n1] +} -result [list 2 1 0] +test treeview-3.5 "index - exhaustive test" -body { + set result [list] + foreach item [.tv children {}] { + lappend result [.tv index $item] + } + set result +} -result [list 0 1 2 3 4 5 6] + +test treeview-3.6 "detach" -body { + .tv detach newnode + consistencyCheck .tv + .tv children {} +} -result [list newfirstone firstnode anotherone onemore lastnode newlastone] +# XREF: treeview-2.13 + +test treeview-3.7 "detach didn't screw up internal links" -body { + consistencyCheck .tv + set result [list] + foreach item [.tv children {}] { + lappend result [.tv index $item] + } + set result +} -result [list 0 1 2 3 4 5] + +test treeview-3.8 "detached node has no parent, index 0" -body { + list [.tv parent newnode] [.tv index newnode] +} -result [list {} 0] +# @@@ Can't distinguish detached nodes from first root node + +test treeview-3.9 "detached node's children undisturbed" -body { + .tv children newnode +} -result [list newnode.n1 newnode.n2 newnode.n3] + +test treeview-3.10 "detach is idempotent" -body { + .tv detach newnode + consistencyCheck .tv + .tv children {} +} -result [list newfirstone firstnode anotherone onemore lastnode newlastone] + +test treeview-3.11 "Can't detach root item" -body { + .tv detach [list {}] + update + consistencyCheck .tv +} -returnCodes 1 -result "Cannot detach root item" +consistencyCheck .tv + +test treeview-3.12 "Reattach" -body { + .tv move newnode {} end + consistencyCheck .tv + .tv children {} +} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode] + +# Bug # ????? +test treeview-3.13 "Re-reattach" -body { + .tv move newnode {} end + consistencyCheck .tv + .tv children {} +} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode] + +catch { + .tv insert newfirstone end -id x1 + .tv insert newfirstone end -id x2 + .tv insert newfirstone end -id x3 +} + +test treeview-3.14 "Duplicated entry in children list" -body { + .tv children newfirstone [list x3 x1 x2 x3] + # ??? Maybe this should raise an error? + consistencyCheck .tv + .tv children newfirstone +} -result [list x3 x1 x2] + +test treeview-3.14.1 "Duplicated entry in children list" -body { + .tv children newfirstone [list x1 x2 x3 x3 x2 x1] + consistencyCheck .tv + .tv children newfirstone +} -result [list x1 x2 x3] + +test treeview-3.15 "Consecutive duplicate entries in children list" -body { + .tv children newfirstone [list x1 x2 x2 x3] + consistencyCheck .tv + .tv children newfirstone +} -result [list x1 x2 x3] + +test treeview-3.16 "Insert child after self" -body { + .tv move x2 newfirstone 1 + consistencyCheck .tv + .tv children newfirstone +} -result [list x1 x2 x3] + +test treeview-3.17 "Insert last child after self" -body { + .tv move x3 newfirstone 2 + consistencyCheck .tv + .tv children newfirstone +} -result [list x1 x2 x3] + +test treeview-3.18 "Insert last child after end" -body { + .tv move x3 newfirstone 3 + consistencyCheck .tv + .tv children newfirstone +} -result [list x1 x2 x3] + +test treeview-4.1 "opened - initial state" -body { + .tv item newnode -open +} -result 0 +test treeview-4.2 "opened - open node" -body { + .tv item newnode -open 1 + .tv item newnode -open +} -result 1 +test treeview-4.3 "opened - closed node" -body { + .tv item newnode -open 0 + .tv item newnode -open +} -result 0 + +test treeview-5.1 "item -- error checks" -body { + .tv item newnode -text "Bad values" -values "{bad}list" +} -returnCodes 1 -result "list element in braces followed by*" -match glob + +test treeview-5.2 "item -- error leaves options unchanged " -body { + .tv item newnode -text +} -result "New node" + +test treeview-5.3 "Heading" -body { + .tv heading #0 -text "Heading" +} + +test treeview-5.4 "get cell" -body { + set l [list a b c] + .tv item newnode -values $l + .tv set newnode 1 +} -result b + +test treeview-5.5 "set cell" -body { + .tv set newnode 1 XXX + .tv item newnode -values +} -result [list a XXX c] + +test treeview-5.6 "set illegal cell" -body { + .tv set newnode #0 YYY +} -returnCodes 1 -result "Display column #0 cannot be set" + +test treeview-5.7 "set illegal cell" -body { + .tv set newnode 3 YY ;# 3 == current #columns +} -returnCodes 1 -result "Column index 3 out of bounds" + +test treeview-5.8 "set display columns" -body { + .tv configure -displaycolumns [list 2 1 0] + .tv set newnode #1 X + .tv set newnode #2 Y + .tv set newnode #3 Z + .tv item newnode -values +} -result [list Z Y X] + +test treeview-5.9 "display columns part 2" -body { + list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id] +} -result [list c b a] + +test treeview-5.10 "cannot set column -id" -body { + .tv column #1 -id X +} -returnCodes 1 -result "Attempt to change read-only option" + +test treeview-5.11 "get" -body { + .tv set newnode #1 +} -result X + +test treeview-5.12 "get dictionary" -body { + .tv set newnode +} -result [list a Z b Y c X] + +test treeview-5.13 "get, no value" -body { + set newitem [.tv insert {} end] + set result [.tv set $newitem #1] + .tv delete $newitem + set result +} -result {} + + +test treeview-6.1 "deletion - setup" -body { + .tv insert {} end -id dtest + foreach id [list a b c d e] { + .tv insert dtest end -id $id + } + .tv children dtest +} -result [list a b c d e] + +test treeview-6.1.1 "delete" -body { + .tv delete b + consistencyCheck .tv + list [.tv exists b] [.tv children dtest] +} -result [list 0 [list a c d e]] + +consistencyCheck .tv + +test treeview-6.2 "delete - duplicate items in list" -body { + .tv delete [list a e a e] + consistencyCheck .tv + .tv children dtest +} -result [list c d] + +test treeview-6.3 "delete - descendants removed" -body { + .tv insert c end -id c1 + .tv insert c end -id c2 + .tv insert c1 end -id c11 + consistencyCheck .tv + .tv delete c + consistencyCheck .tv + list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] +} -result [list 0 0 0 0] + +test treeview-6.4 "delete - delete parent and descendants" -body { + .tv insert dtest end -id c + .tv insert c end -id c1 + .tv insert c end -id c2 + .tv insert c1 end -id c11 + consistencyCheck .tv + .tv delete [list c c1 c2 c11] + consistencyCheck .tv + list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] +} -result [list 0 0 0 0] + +test treeview-6.5 "delete - delete descendants and parent" -body { + .tv insert dtest end -id c + .tv insert c end -id c1 + .tv insert c end -id c2 + .tv insert c1 end -id c11 + consistencyCheck .tv + .tv delete [list c11 c1 c2 c] + consistencyCheck .tv + list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11] +} -result [list 0 0 0 0] + +test treeview-6.6 "delete - end" -body { + consistencyCheck .tv + .tv children dtest +} -result [list d] + +test treeview-7.1 "move" -body { + .tv insert d end -id d1 + .tv insert d end -id d2 + .tv insert d end -id d3 + .tv move d3 d 0 + consistencyCheck .tv + .tv children d +} -result [list d3 d1 d2] + +test treeview-7.2 "illegal move" -body { + .tv move d d2 end +} -returnCodes 1 -result "Cannot insert d as a descendant of d2" + +test treeview-7.3 "illegal move has no effect" -body { + consistencyCheck .tv + .tv children d +} -result [list d3 d1 d2] + +test treeview-7.4 "Replace children" -body { + .tv children d [list d3 d2 d1] + consistencyCheck .tv + .tv children d +} -result [list d3 d2 d1] + +test treeview-7.5 "replace children - precondition" -body { + # Just check to make sure the test suite so far has left + # us in the state we expect to be in: + list [.tv parent newnode] [.tv children newnode] +} -result [list {} [list newnode.n1 newnode.n2 newnode.n3]] + +test treeview-7.6 "Replace children - illegal move" -body { + .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3] +} -returnCodes 1 -result "Cannot insert newnode.n1 as a descendant of newnode.n1" + +consistencyCheck .tv + +test treeview-8.0 "Selection set" -body { + .tv selection set [list newnode.n1 newnode.n3 newnode.n2] + .tv selection +} -result [list newnode.n1 newnode.n2 newnode.n3] + +test treeview-8.1 "Selection add" -body { + .tv selection add [list newnode] + .tv selection +} -result [list newnode newnode.n1 newnode.n2 newnode.n3] + +test treeview-8.2 "Selection toggle" -body { + .tv selection toggle [list newnode.n2 d3] + .tv selection +} -result [list newnode newnode.n1 newnode.n3 d3] + +test treeview-8.3 "Selection remove" -body { + .tv selection remove [list newnode.n2 d3] + .tv selection +} -result [list newnode newnode.n1 newnode.n3] + +test treeview-8.4 "Selection - clear" -body { + .tv selection set {} + .tv selection +} -result {} + +test treeview-8.5 "Selection - bad operation" -body { + .tv selection badop foo +} -returnCodes 1 -match glob -result {bad selection operation "badop": must be *} + +### NEED: more tests for see/yview/scrolling + +proc scrollcallback {args} { + set ::scrolldata $args +} +test treeview-9.0 "scroll callback - empty tree" -body { + .tv configure -yscrollcommand scrollcallback + .tv delete [.tv children {}] + update + set ::scrolldata +} -result [list 0.0 1.0] + +### identify tests: +# +proc identify* {tv comps args} { + foreach {x y} $args { + foreach comp $comps { + lappend result [$tv identify $comp $x $y] + } + } + return $result +} + +# get list of column IDs from list of display column ids. +# +proc columnids {tv dcols} { + set result [list] + foreach dcol $dcols { + if {[catch { + lappend result [$tv column $dcol -id] + }]} { + lappend result ERROR + } + } + return $result +} + +test treeview-identify-setup "identify series - setup" -body { + destroy .tv + ttk::setTheme default + ttk::treeview .tv -columns [list A B C] + .tv insert {} end -id branch -text branch -open true + .tv insert branch end -id item1 -text item1 + .tv insert branch end -id item2 -text item2 + .tv insert branch end -id item3 -text item3 + + .tv column #0 -width 50 ;# 0-50 + .tv column A -width 50 ;# 50-100 + .tv column B -width 50 ;# 100-150 + .tv column C -width 50 ;# 150-200 (plus slop for margins) + + wm geometry . {} ; pack .tv ; update +} + +test treeview-identify-1 "identify heading" -body { + .tv configure -show {headings tree} + update idletasks + identify* .tv {region column} 10 10 +} -result [list heading #0] + +test treeview-identify-2 "identify columns" -body { + .tv configure -displaycolumns #all + update idletasks + columnids .tv [identify* .tv column 25 10 75 10 125 10 175 10] +} -result [list {} A B C] + +test treeview-identify-3 "reordered columns" -body { + .tv configure -displaycolumns {B A C} + update idletasks + columnids .tv [identify* .tv column 25 10 75 10 125 10 175 10] +} -result [list {} B A C] + +test treeview-identify-4 "no tree column" -body { + .tv configure -displaycolumns #all -show {headings} + update idletasks + identify* .tv {region column} 25 10 75 10 125 10 175 10 +} -result [list heading #1 heading #2 heading #3 nothing {}] + +# Item height in default theme is 20px +test treeview-identify-5 "vertical scan - no headings" -body { + .tv configure -displaycolumns #all -show {tree} + update idletasks + identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 +} -result [list tree branch tree item1 tree item2 tree item3 nothing {}] + +test treeview-identify-6 "vertical scan - with headings" -body { + .tv configure -displaycolumns #all -show {tree headings} + update idletasks + identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 +} -result [list heading {} tree branch tree item1 tree item2 tree item3] + +test treeview-identify-7 "vertical scan - headings, no tree" -body { + .tv configure -displaycolumns #all -show {headings} + update idletasks + identify* .tv {region item} 25 10 25 30 25 50 25 70 25 90 +} -result [list heading {} cell branch cell item1 cell item2 cell item3] + +# In default theme, -indent and -itemheight both 20px +# Disclosure element name is "Treeitem.indicator" +set disclosure "*.indicator" +test treeview-identify-8 "identify element" -body { + .tv configure -show {tree} + .tv insert branch 0 -id branch2 -open true + .tv insert branch2 0 -id branch3 -open true + .tv insert branch3 0 -id leaf3 + update idletasks; + identify* .tv {item element} 10 10 30 30 50 50 +} -match glob -result [list \ + branch $disclosure branch2 $disclosure branch3 $disclosure] + +# See #2381555 +test treeview-identify-9 "identify works when horizontally scrolled" -setup { + .tv configure -show {tree headings} + foreach column {#0 A B C} { + .tv column $column -stretch 0 -width 50 + } + place .tv -x 0 -y 0 -width 100 +} -body { + set result [list] + foreach xoffs {0 50 100} { + .tv xview $xoffs ; update + lappend result [identify* .tv {region column} 10 10 60 10] + } + set result +} -result [list \ + [list heading #0 heading #1] \ + [list heading #1 heading #2] \ + [list heading #2 heading #3] ] + +test treeview-identify-cleanup "identify - cleanup" -body { + destroy .tv +} + +### NEED: tests for focus item, selection + +### Misc. tests: + +destroy .tv +test treeview-10.1 "Root node properly initialized (#1541739)" -setup { + ttk::treeview .tv + .tv insert {} end -id a + .tv see a +} -cleanup { + destroy .tv +} + +test treeview-3006842 "Null bindings" -setup { + ttk::treeview .tv -show tree +} -body { + .tv tag bind empty <ButtonPress-1> {} + .tv insert {} end -text "Click me" -tags empty + event generate .tv <ButtonPress-1> -x 10 -y 10 + .tv tag bind empty +} -result {} -cleanup { + destroy .tv +} + +test treeview-3085489-1 "tag add, no -tags" -setup { + ttk::treeview .tv +} -body { + set item [.tv insert {} end] + .tv tag add foo $item + .tv item $item -tags +} -cleanup { + destroy .tv +} -result [list foo] + +test treeview-3085489-2 "tag remove, no -tags" -setup { + ttk::treeview .tv +} -body { + set item [.tv insert {} end] + .tv tag remove foo $item + .tv item $item -tags +} -cleanup { + destroy .tv +} -result [list] + +tcltest::cleanupTests |