diff options
Diffstat (limited to 'tests/ttk/treetags.test')
| -rw-r--r-- | tests/ttk/treetags.test | 190 |
1 files changed, 168 insertions, 22 deletions
diff --git a/tests/ttk/treetags.test b/tests/ttk/treetags.test index fe4dbcd..5f1287d 100644 --- a/tests/ttk/treetags.test +++ b/tests/ttk/treetags.test @@ -1,48 +1,147 @@ # -# $Id: treetags.test,v 1.2 2007/05/18 16:53:18 dgp Exp $ +# $Id: treetags.test,v 1.2.4.1 2010/08/26 02:06:10 hobbs Exp $ # -package require Tk 8.5 +package require Tk package require tcltest ; namespace import -force tcltest::* loadTestedCommands -tk useinputmethods 0 -testConstraint treeview [llength [info commands ttk::treeview]] -testConstraint nyi 0 +### treeview tag invariants: +# + +proc assert {expr {message ""}} { + if {![uplevel 1 [list expr $expr]]} { + error "PANIC: $message ($expr failed)" + } +} +proc in {e l} { expr {[lsearch -exact $l $e] >= 0} } + +proc itemConstraints {tv item} { + # $tag in [$tv item $item -tags] <==> [$tv tag has $tag $item] + foreach tag [$tv item $item -tags] { + assert {[in $item [$tv tag has $tag]]} + } + foreach child [$tv children $item] { + itemConstraints $tv $child + } +} + +proc treeConstraints {tv} { + # $item in [$tv tag has $tag] <==> [$tv tag has $tag $item] + # + foreach tag [$tv tag names] { + foreach item [$tv tag has $tag] { + assert {[in $tag [$tv item $item -tags]]} + } + } -test treetags-1.0 "Setup" -constraints treeview -body { + itemConstraints $tv {} +} +# +### + +test treetags-1.0 "Setup" -body { set tv [ttk::treeview .tv] .tv insert {} end -id item1 -text "Item 1" - pack .tv + pack .tv +} -cleanup { + treeConstraints $tv } -test treetags-1.1 "Bad tag list" -constraints treeview -body { +test treetags-1.1 "Bad tag list" -body { $tv item item1 -tags {bad {list}here bad} + $tv item item1 -tags } -returnCodes error -result "list element in braces *" -match glob -test treetags-1.2 "Good tag list" -constraints treeview -body { +test treetags-1.2 "Good tag list" -body { $tv item item1 -tags tag1 $tv item item1 -tags +} -cleanup { + assert {[$tv tag has tag1 item1]} + treeConstraints $tv } -result [list tag1] -test treetags-1.3 "Bad events" -constraints treeview -body { - $tv tag bind bad <Enter> { puts "Entered!" } -} -returnCodes 1 -result "unsupported event <Enter>*" -match glob +test treetags-1.3 "tag has - test" -body { + $tv insert {} end -id item2 -text "Item 2" -tags tag2 + set result [list] + foreach item {item1 item2} { + foreach tag {tag1 tag2 tag3} { + lappend result $item $tag [$tv tag has $tag $item] + } + } + set result +} -cleanup { + treeConstraints $tv +} -result [list \ + item1 tag1 1 item1 tag2 0 item1 tag3 0 \ + item2 tag1 0 item2 tag2 1 item2 tag3 0 ] + +test treetags-1.4 "tag has - query" -body { + list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3] +} -cleanup { + treeConstraints $tv +} -result [list [list item1] [list item2] [list]] + +test treetags-1.5 "tag add" -body { + $tv tag add tag3 {item1 item2} + list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3] +} -cleanup { + treeConstraints $tv +} -result [list [list item1] [list item2] [list item1 item2]] + +test treetags-1.6 "tag remove - list" -body { + $tv tag remove tag3 {item1 item2} + list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3] +} -cleanup { + treeConstraints $tv +} -result [list [list item1] [list item2] [list]] + +test treetags-1.7 "tag remove - all items" -body { + $tv tag remove tag1 + list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3] +} -cleanup { + treeConstraints $tv +} -result [list [list] [list item2] [list]] + +test treetags-1.8 "tag names" -body { + lsort [$tv tag names] +} -result [list tag1 tag2 tag3] + +test treetags-1.9 "tag names - tag added to item" -body { + $tv item item1 -tags tag4 + lsort [$tv tag names] +} -result [list tag1 tag2 tag3 tag4] + +test treetags-1.10 "tag names - tag configured" -body { + $tv tag configure tag5 + lsort [$tv tag names] +} -result [list tag1 tag2 tag3 tag4 tag5] + +test treetags-1.end "cleanup" -body { + $tv item item1 -tags tag1 + $tv item item2 -tags tag2 + list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3] +} -cleanup { + treeConstraints $tv +} -result [list [list item1] [list item2] [list]] -test treetags-2.0 "tag bind" -constraints treeview -body { +test treetags-2.0 "tag bind" -body { $tv tag bind tag1 <KeyPress> {set ::KEY %A} $tv tag bind tag1 <KeyPress> +} -cleanup { + treeConstraints $tv } -result {set ::KEY %A} -test treetags-2.1 "Events delivered to tags" -constraints treeview -body { +test treetags-2.1 "Events delivered to tags" -body { focus -force $tv ; update ;# needed so [event generate] delivers KeyPress $tv focus item1 - event generate .tv <KeyPress-a> + event generate $tv <KeyPress-a> set ::KEY +} -cleanup { + treeConstraints $tv } -result a -test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body { - $tv insert {} end -id item2 -tags tag2 +test treetags-2.2 "Events delivered to correct tags" -body { $tv tag bind tag2 <KeyPress> [list set ::KEY2 %A] $tv focus item1 @@ -51,9 +150,11 @@ test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body event generate $tv <KeyPress-c> list $::KEY $::KEY2 +} -cleanup { + treeConstraints $tv } -result [list b c] -test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview -body { +test treetags-2.3 "Virtual events delivered to focus item" -body { set ::bong 0 $tv tag bind tag2 <<Bing>> { incr bong } $tv focus item2 @@ -61,18 +162,63 @@ test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview $tv focus item1 event generate $tv <<Bing>> set bong +} -cleanup { + treeConstraints $tv } -result 1 +test treetags-2.4 "Bad events" -body { + $tv tag bind bad <Enter> { puts "Entered!" } +} -returnCodes 1 -result "unsupported event <Enter>*" -match glob -test treetags-3.0 "tag configure" -constraints treeview -body { +test treetags-3.0 "tag configure - set" -body { $tv tag configure tag1 -foreground blue -background red +} -cleanup { + treeConstraints $tv } -result {} -test treetags-3.1 "tag configure" -constraints treeview -body { +test treetags-3.1 "tag configure - get" -body { $tv tag configure tag1 -foreground -} -result [list blue] +} -cleanup { + treeConstraints $tv +} -result blue + +# @@@ fragile test +test treetags-3.2 "tag configure - enumerate" -body { + $tv tag configure tag1 +} -cleanup { + treeConstraints $tv +} -result [list \ + -text {} -image {} -anchor {} -background red -foreground blue -font {} \ +] + +# The next test exercises tag resource management. +# If options are not properly freed, the message: +# Test file error: "Font times 20 still in cache." +# will show up on stderr at program exit. +# +test treetags-3.3 "tag configure - set font" -body { + $tv tag configure tag2 -font {times 20} +} + +test treetags-3.4 "stomp tags in tag binding procedure" -body { + set result [list] + $tv tag bind rm1 <<Remove>> { lappend ::result rm1 [%W focus] <<Remove>> } + $tv tag bind rm2 <<Remove>> { + lappend ::result rm2 [%W focus] <<Remove>> + %W item [%W focus] -tags {tag1} + } + $tv tag bind rm3 <<Remove>> { lappend ::result rm3 [%W focus] <<Remove>> } + $tv item item1 -tags {rm1 rm2 rm3} + $tv focus item1 + event generate $tv <<Remove>> + set result +} -cleanup { + treeConstraints $tv +} -result [list rm1 item1 <<Remove>> rm2 item1 <<Remove>> rm3 item1 <<Remove>>] + +# -test treetags-end "Cleanup" -constraints treeview -body { destroy .tv } +test treetags-end "Cleanup" -body { destroy $tv } tcltest::cleanupTests |