path: root/tests/itemdesc.test

# Commands covered:  item descriptions
#
# This file contains a collection of tests for the treectrl command of
# the tktreectrl extension.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2000 by Scriptics Corporation.
# Copyright (c) 2002 by Christian Krone.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: itemdesc.test,v 1.3 2007/11/12 04:07:16 treectrl Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import ::tcltest::*
}

package require Tk
package require treectrl

# For the tests of the item descriptions we use [.t see],
# if we want to generate an error on unknown items.
# For the positive cases we use [.t item id] since it returns the item id.

test itemdesc-0.1 {some needed preparations} -body {
    treectrl .t -itemheight 20 -showheader no
    .t column create -width 200
    pack .t -expand yes -fill both
    update idletasks
} -result {}

test itemdesc-1.1 {bogus itemdesc} -body {
    .t item id ""
} -returnCodes error -result {bad item description ""}

test itemdesc-1.1.1 {bogus itemdesc} -body {
    .t item id "\{all"
} -returnCodes error -result "bad item description \"\{all\""

test itemdesc-1.2 {all} -setup {
    .t item create -count 10
} -body {
    lsort -integer [.t item id all]
} -cleanup {
    .t item delete all
} -result {0 1 2 3 4 5 6 7 8 9 10}

test itemdesc-1.3 {unknown id} -body {
    .t see 999
} -returnCodes error -result {item "999" doesn't exist}

test itemdesc-1.4 {id of root} -body {
    .t item id 0
} -result {0}

test itemdesc-1.5 {id of active} -body {
    .t item id active
} -result {0}

test itemdesc-1.6 {id of anchor (abbreviated)} -body {
    .t item id an
} -result {0}

test itemdesc-1.7 {first} -body {
    .t item id first
} -result {0}

test itemdesc-1.8 {first visible} -setup {
    .t configure -showroot 1
} -body {
    .t item id "first visible"
} -result {0}

test itemdesc-1.9 {first visible without any node} -setup {
    .t configure -showroot 0
} -body {
    .t see "first visible"
} -returnCodes error -result {item "first visible" doesn't exist}

test itemdesc-1.10 {last} -body {
    .t item id last
} -result {0}

test itemdesc-1.10.1 {end} -body {
    .t item id end
} -result {0}

test itemdesc-1.11 {last visible} -setup {
    .t configure -showroot 1
} -body {
    .t item id "last visible"
} -result {0}

test itemdesc-1.12 {last visible without any node} -setup {
    .t configure -showroot 0
} -body {
    .t see "last visible"
} -returnCodes error -result {item "last visible" doesn't exist}

test itemdesc-1.13 {nearest without x/y} -body {
    .t item id nearest
} -returnCodes error -result {missing arguments to "nearest" keyword}

test itemdesc-1.14 {nearest with invalid x/y} -body {
    .t item id "nearest foo bar"
} -returnCodes error -result {bad screen distance "foo"}

test itemdesc-1.15 {nearest with valid x/y} -setup {
    .t configure -showroot 1
} -body {
    .t item id "nearest 10 10"
} -result {0}

test itemdesc-1.16 {nearest with valid x/y, but no item} -setup {
    .t configure -showroot 0
} -body {
    .t item id "nearest 10 10"
} -result {}

# Before continuing to test the item descriptions and their modifiers,
# lets create some items with this hierarchy:
# 0
# + 1
# | + 2
# | + 3
# |   + 4
# + 5
# | + 6
# | + 7
# + 8
test itemdesc-2.16 {create some items} -body {
    set n1 [.t item create]; .t item lastchild 0   $n1
    set n2 [.t item create]; .t item lastchild $n1 $n2
    set n3 [.t item create]; .t item lastchild $n1 $n3
    set n4 [.t item create]; .t item lastchild $n3 $n4
    set n5 [.t item create]; .t item lastchild 0   $n5
    set n6 [.t item create]; .t item lastchild $n5 $n6
    set n7 [.t item create]; .t item lastchild $n5 $n7
    set n8 [.t item create]; .t item lastchild 0   $n8
} -result {8}

test itemdesc-2.18 {rnc without r/c} -body {
    .t item id rnc
} -returnCodes error -result {missing arguments to "rnc" keyword}

test itemdesc-2.19 {rnc with invalid r/c} -body {
    .t item id "rnc foo bar"
} -returnCodes error -result {expected integer but got "foo"}

test itemdesc-2.20 {rnc with valid r/c} -body {
    .t item id "rnc 0 0"
} -result {1}

test itemdesc-2.21 {root} -body {
    .t configure -showroot 1 -orient vertical
    .t item id root
} -result {0}

test itemdesc-2.22 {bogus modifier} -body {
    .t item id "0 foo"
} -returnCodes error -result {bad modifier "foo": must be *} -match glob

test itemdesc-2.23 {valid modifier with too few arguments} -body {
    .t item id "0 child"
} -returnCodes error -result {missing arguments to "child" modifier}

test itemdesc-2.24 {modifier visible alone generates an error} -body {
    .t item id "0 visible"
} -returnCodes error -result {bad modifier "visible": must be *} -match glob

test itemdesc-2.25 {modifier above} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n above"]
    }
    set res
} -result {{} 0 1 2 3 4 5 6 7}

test itemdesc-2.26 {modifier below} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n below"]
    }
    set res
} -result {1 2 3 4 5 6 7 8 {}}

test itemdesc-2.27 {modifier bottom} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n bottom"]
    }
    set res
} -result {8 8 8 8 8 8 8 8 8}

test itemdesc-2.28 {modifier child} -body {
    set res {}
    for {set n 0} {$n < 6} {incr n} {
	for {set c 0} {$c < 3} {incr c} {
	    lappend res [.t item id "$n child $c"]
	}
    }
    set res
} -result {1 5 8 2 3 {} {} {} {} 4 {} {} {} {} {} 6 7 {}}

test itemdesc-2.29 {modifier firstchild} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n firstchild"]
    }
    set res
} -result {1 2 {} 4 {} 6 {} {} {}}

test itemdesc-2.30 {modifier lastchild} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n lastchild"]
    }
    set res
} -result {8 3 {} 4 {} 7 {} {} {}}

test itemdesc-2.30 {modifier left, leftmost, right, and rightmost} -body {
    list [.t item id "1 left"] [.t item id "1 right"] \
	 [.t item id "2 leftmost"] [.t item id "3 rightmost"]
} -result {{} {} 2 3}

test itemdesc-2.31 {modifier next} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n next"]
    }
    set res
} -result {1 2 3 4 5 6 7 8 {}}

test itemdesc-2.32 {modifier nextsibling} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n nextsibling"]
    }
    set res
} -result {{} 5 3 {} {} 8 7 {} {}}

test itemdesc-2.33 {modifier parent} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n parent"]
    }
    set res
} -result {{} 0 1 1 3 0 5 5 0}

test itemdesc-2.34 {modifier prev} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n prev"]
    }
    set res
} -result {{} 0 1 2 3 4 5 6 7}

test itemdesc-2.34 {modifier prevsibling} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n prevsibling"]
    }
    set res
} -result {{} {} {} 2 {} 1 {} 6 5}

test itemdesc-2.35 {modifier sibling} -body {
    set res {}
    for {set n 0} {$n < 7} {incr n} {
	for {set c 0} {$c < 3} {incr c} {
	    lappend res [.t item id "$n sibling $c"]
	}
    }
    set res
} -result {{} {} {} 1 5 8 2 3 {} 2 3 {} 4 {} {} 1 5 8 6 7 {}}

test itemdesc-2.36 {modifier top} -body {
    set res {}
    for {set n 0} {$n < 9} {incr n} {
	lappend res [.t item id "$n top"]
    }
    set res
} -result {0 0 0 0 0 0 0 0 0}

test itemdesc-2.37 {modifier cocktail} -body {
    set res {}
    set itemDesc 7
    foreach mod {
	bottom rightmost sibling 0 nextsibling prev parent
	prevsibling prev nextsibling lastchild next
    } {
	lappend itemDesc $mod
	catch {lappend res [.t item id $itemDesc]}
    }
    set res
} -result {8 8 1 5 4 3 2 1 5 7 8}

test itemdesc-2.38 {multiple items: list} -body {
    .t item id "list {3 8 8}"
} -result {3 8 8}

test itemdesc-2.39 {multiple items: range} -body {
    .t item id "range 1 6"
} -result {1 2 3 4 5 6}

test itemdesc-2.40 {multiple items: range reversed} -body {
    .t item id "range 6 1"
} -result {1 2 3 4 5 6}

test itemdesc-2.41 {multiple items: ancestors} -body {
    .t item id "4 ancestors"
} -result {3 1 0}

test itemdesc-2.42 {multiple items: children} -body {
    .t item id "root children"
} -result {1 5 8}

test itemdesc-2.43 {multiple items: nested list} -body {
    .t item id "list {3 {list {1 root}} 4}"
} -result {3 1 0 4}

test itemdesc-2.44 {multiple items: descendants} -body {
    .t item id "1 descendants"
} -result {2 3 4}

# qualifiers in item descriptions
test itemdesc-3.1 {where visible is allowed} -body {
    .t item collapse 3
    .t item collapse 5
    set res {}
    foreach index {
	first last
    } {
	lappend res [.t item id "$index visible"]
    }
    foreach modifier {
	next prev firstchild lastchild {child 1}
	nextsibling prevsibling {sibling 0}
    } {
	lappend res [.t item id "5 $modifier visible"]
    }
    set res
} -result {0 8 8 3 {} {} {} 8 1 1}

test itemdesc-3.2 {where state is allowed} -body {
    set res {}
    foreach index {
	first last
    } {
	lappend res [.t item id "$index state enabled"]
    }
    foreach modifier {
	next prev firstchild lastchild {child 0}
	nextsibling prevsibling {sibling 0}
    } {
	lappend res [.t item id "5 $modifier state enabled"]
    }
    set res
} -result {0 8 6 4 6 7 6 8 1 1}

test itemdesc-3.3 {qualifier state: missing args} -body {
    .t item id "first state"
} -returnCodes error -result {missing arguments to "state" qualifier}

test itemdesc-3.4 {qualifier state: unknown state} -body {
    .t item id "first state foo"
} -returnCodes error -result {unknown state "foo"}

test itemdesc-3.5 {qualifier state: toggle not allowed} -body {
    .t item id "first state ~open"
} -returnCodes error -result {can't specify '~' for this command}

test itemdesc-3.6 {qualifier state: open ok} -body {
    .t item id "first state open"
} -result {0}

test itemdesc-3.7 {qualifier state: !open ok} -body {
    set res {}
    lappend res [.t item id "first state !open"]
    lappend res [.t item id "last state !open"]
} -result {3 5}

test itemdesc-3.8 {qualifier state: multiple states} -body {
    .t item id "last state {open enabled active}"
} -result {0}

test itemdesc-3.9 {qualifier after index and modifier} -body {
    .t item id "first state !open next state !open"
} -result {5}

test itemdesc-3.10 {qualifier state: following each modifier} -body {
    set res {}
    foreach modifier {
	firstchild lastchild {child 0}
    } {
	lappend res [.t item id "root $modifier state !open"]
    }
    foreach modifier {
	next prev nextsibling prevsibling {sibling 0}
    } {
	lappend res [.t item id "1 $modifier state !open"]
    }
    .t item expand 3
    .t item expand 5
    set res
} -result {5 5 5 3 {} 5 {} 5}

test itemdesc-4.1 {modifiers following multiple items is forbidden} -body {
    .t item id "all children"
} -returnCodes error -result {unexpected arguments after "all"}

test itemdesc-4.2 {modifiers following multiple items is forbidden} -body {
    .t item id "all visible children"
} -returnCodes error -result {unexpected arguments after "all visible"}

test itemdesc-4.3 {modifiers following multiple items is forbidden} -body {
    .t item id "range 1 2 next"
} -returnCodes error -result {unexpected arguments after "range 1 2"}

test itemdesc-4.4 {modifiers following multiple items is forbidden} -body {
    .t item id "1 descendants next"
} -returnCodes error -result {unexpected arguments after "1 descendants"}

test itemdesc-4.5 {modifiers following multiple items is forbidden} -setup {
    .t item tag add "1 descendants" tagA
} -body {
    lsort -integer [.t item id "tagA above"]
} -cleanup {
    .t item tag remove all tagA
} -returnCodes error -result {unexpected arguments after "tagA"}

test itemdesc-4.10 {modifiers following single item ok} -setup {
    .t item tag add 3 tagA
} -body {
    lsort -integer [.t item id "tagA above"]
} -cleanup {
    .t item tag remove all tagA
} -result {2}

test itemdesc-5.1 {qualifiers may be first} -body {
    lsort -integer [.t item id "depth 1"]
} -result {1 5 8}

test itemdesc-5.2 {qualifiers may be first} -body {
    lsort -integer [.t item id "visible"]
} -result {0 1 2 3 4 5 6 7 8}

test itemdesc-5.3 {qualifiers may be first} -setup {
    .t item collapse 3
} -body {
    lsort -integer [.t item id "!visible"]
} -cleanup {
    .t item expand 3
} -result {4}

test itemdesc-5.4 {qualifiers may be first} -setup {
    .t item tag add "1 descendants" a
} -body {
    lsort -integer [.t item id "tag a"]
} -cleanup {
    .t item tag remove all a
} -result {2 3 4}

test itemdesc-5.5 {qualifiers may be first} -setup {
    .t item collapse {list {3 5}}
} -body {
    lsort -integer [.t item id "state !open"]
} -cleanup {
    .t item expand {list {3 5}}
} -result {3 5}

test itemdesc-6.1 {-itemprefix} -setup {
    .t configure -itemprefix item
} -body {
    lsort -dictionary [.t item id "item1 descendants"]
} -cleanup {
    .t configure -itemprefix ""
} -result {item2 item3 item4}

test itemdesc-6.2 {-itemprefix same as a tag} -setup {
    .t configure -itemprefix item
    .t item tag add all item1
} -body {
    lsort -dictionary [.t item id "item1 descendants"]
} -cleanup {
    .t configure -itemprefix ""
    .t item tag remove all item1
} -result {item2 item3 item4}

test itemdesc-7.1 {-itemtagexpr, error} -setup {
    .t item tag add "depth 1" a&&b||
} -body {
    lsort -dictionary [.t item id "tag a&&b||"]
} -returnCodes error -result {Missing tag in tag search expression}

test itemdesc-7.2 {-itemtagexpr, tag as first word} -setup {
    .t configure -itemtagexpr false
} -body {
    lsort -dictionary [.t item id "a&&b||"]
} -result {1 5 8}

test itemdesc-7.3 {-itemtagexpr, tag as qualifier} -body {
    lsort -dictionary [.t item id "tag a&&b||"]
} -cleanup {
    .t configure -itemtagexpr true
    .t item tag remove all a&&b||
} -result {1 5 8}

test itemdesc-99.1 {some needed cleanup} -body {
    destroy .t
} -result {}

# cleanup
::tcltest::cleanupTests
return