diff options
Diffstat (limited to 'tk8.6/tests/ttk/treetags.test')
| -rw-r--r-- | tk8.6/tests/ttk/treetags.test | 221 |
1 files changed, 0 insertions, 221 deletions
diff --git a/tk8.6/tests/ttk/treetags.test b/tk8.6/tests/ttk/treetags.test deleted file mode 100644 index 7f26e2f..0000000 --- a/tk8.6/tests/ttk/treetags.test +++ /dev/null @@ -1,221 +0,0 @@ - -package require Tk -package require tcltest ; namespace import -force tcltest::* -loadTestedCommands - -### 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]]} - } - } - - itemConstraints $tv {} -} -# -### - -test treetags-1.0 "Setup" -body { - set tv [ttk::treeview .tv] - .tv insert {} end -id item1 -text "Item 1" - pack .tv -} -cleanup { - treeConstraints $tv -} - -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" -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 "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" -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" -body { - focus -force $tv ; update ;# needed so [event generate] delivers KeyPress - $tv focus item1 - event generate $tv <KeyPress-a> - set ::KEY -} -cleanup { - treeConstraints $tv -} -result a - -test treetags-2.2 "Events delivered to correct tags" -body { - $tv tag bind tag2 <KeyPress> [list set ::KEY2 %A] - - $tv focus item1 - event generate $tv <KeyPress-b> - $tv focus item2 - 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" -body { - set ::bong 0 - $tv tag bind tag2 <<Bing>> { incr bong } - $tv focus item2 - event generate $tv <<Bing>> - $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 - set" -body { - $tv tag configure tag1 -foreground blue -background red -} -cleanup { - treeConstraints $tv -} -result {} - -test treetags-3.1 "tag configure - get" -body { - $tv tag configure tag1 -foreground -} -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" -body { destroy $tv } - -tcltest::cleanupTests |