path: root/tests/item.test

# Commands covered:  treectrl's widget command item
#
# This file contains a collection of tests for the item widget 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.
#
# CVS: @(#) $Id: item.test,v 1.12 2005/07/15 01:43:39 treectrl Exp $

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

package require Tk
package require treectrl

test item-0.1 {some needed preparations} -body {
    pack [treectrl .t]
} -result {}

test item-1.1 {item: missing command} -body {
    .t item
} -returnCodes error -result {wrong # args: should be ".t item command ?arg arg ...?"}

test item-2.2 {item: invalid command} -body {
    .t item foo
} -returnCodes error -result {bad command "foo": must be *} -match glob

# 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 item-2.4 {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 item-2.5 {some more preparations} -body {
    .t state define state0
    .t element create eBorder border
    .t element create eImage image
    .t element create eRect rect
    .t element create eText text -fill red
    .t style create testStyle
    .t style elements testStyle {eText eBorder}
} -result {}

test item-2.6 {item create} -body {
    list [.t item create] [.t item create] [.t item create]
} -result {9 10 11}

test item-3.1 {item delete: missing itemDesc} -body {
    .t item delete
} -returnCodes error -result {wrong # args: should be ".t item delete first ?last?"}

test item-3.2 {item delete: unknown item} -body {
    .t item delete 999
} -returnCodes error -result {item "999" doesn't exist}

test item-3.3 {item delete: one item} -body {
    .t item delete 9
} -result {}

test item-3.4 {item delete: item range without common ancestor} -body {
    .t item delete 10 11
} -returnCodes error -result {item 10 and item 11 don't share a common ancestor}

test item-3.5 {item delete: item range without common ancestor} -body {
    .t item lastchild 8 10
    .t item lastchild 8 11
    .t item delete 10 11
} -result {}

test item-3.6 {item delete: don't delete "root" itemDesc} -body {
    .t item delete root
    .t item id root
} -result {0}

test item-3.7 {item delete: deleting root should be ignored} -body {
    .t item delete [.t item id root]
    update idletasks
} -result {}

test item-4.1 {item ancestors: no ancestor yet} -body {
    .t item create
    .t item ancestors 12
} -result {}

test item-4.2 {item ancestors} -body {
    .t item lastchild 7 12
    .t item ancestors 12
} -result {7 5 0}

test item-5.1 {item children: no children} -body {
    .t item children 12
} -result {}

test item-5.2 {item children} -body {
    .t item children 0
} -result {1 5 8}

test item-6.1 {item firstchild: missing itemDesc} -body {
    .t item firstchild
} -returnCodes error -result {wrong # args: should be ".t item firstchild item ?newFirstChild?"}

test item-6.2 {item firstchild: no children} -body {
    .t item firstchild 12
} -result {}

test item-6.3 {item firstchild} -body {
    .t item firstchild 1
} -result {2}

test item-7.1 {item lastchild: no children} -body {
    .t item lastchild 1
} -result {3}

test item-8.1 {item nextsibling: no sibling} -body {
    .t item nextsibling 12
} -result {}

test item-8.2 {item nextsibling: no sibling} -body {
    .t item nextsibling 2
} -result {3}

test item-9.1 {item numchildren: no children} -body {
    .t item numchildren 12
} -result {0}

test item-9.2 {item numchildren} -body {
    .t item numchildren 1
} -result {2}

test item-10.1 {item parent: no parent} -body {
    .t item parent root
} -result {}

test item-10.2 {item parent} -body {
    .t item parent "root firstchild"
} -result {0}

test item-11.1 {item prevsibling: missing arg} -body {
    .t item prevsibling
} -returnCodes error -result {wrong # args: should be ".t item prevsibling item ?newPrevSibling?"}

test item-11.2 {item prevsibling: no prevsibling} -body {
    .t item prevsibling 1
} -result {}

test item-11.3 {item prevsibling} -body {
    .t item prevsibling 3
} -result {2}

test item-12.1 {item remove: invalid item} -body {
    .t item remove 999
} -returnCodes error -result {item "999" doesn't exist}

test item-12.2 {item remove} -body {
    .t item remove 12
} -result {}

test item-13.1 {item complex: missing args} -body {
    .t item complex 8
} -returnCodes error -result {wrong # args: should be ".t item complex item list ..."}

test item-13.2 {item complex: only allowed if column style is defined} -body {
    .t item complex 8 {{e1 -text Hallo}}
} -returnCodes error -result {column #0 doesn't exist}

test item-13.3 {item complex: invalid list} -body {
	.t column create
    .t item style set 8 0 testStyle
    .t item complex 8 {{e1 -text}}
} -returnCodes error -result {wrong # args: should be "element option value ..."}

test item-13.4 {item complex: element name not defined in style} -body {
    .t item complex 8 {{e1 -text Hallo}}
} -returnCodes error -result {element "e1" doesn't exist}

test item-13.5 {item complex: option not known in element} -body {
    .t item complex 8 {{eText -bitmap questhead}}
} -returnCodes error -result {unknown option "-bitmap"}

test item-13.6 {item complex: invalid option value in element} -body {
    .t item complex 8 {{eText -fill foo}}
} -returnCodes error -result {unknown color name "foo"}

test item-14.1 {item element: missing command} -body {
    .t item element
} -returnCodes error -result {wrong # args: should be ".t item element command item column element ?arg ...?"}

test item-14.2 {item element: invalid command} -body {
    .t item element foo 8 0 eText
} -returnCodes error -result {bad command "foo": must be *} -match glob

test item-14.3 {item element perstate: missing arg} -body {
    .t item element perstate 8 0 eText
} -returnCodes error -result {wrong # args: should be ".t item element perstate item column element option ?stateList?"}

test item-14.4 {item element perstate} -body {
    .t item element actual 8 0 eText -fill
} -result {red}

test item-14.5 {item element cget: missing arg} -body {
    .t item element cget 8 0 eText
} -returnCodes error -result {wrong # args: should be ".t item element cget item column element option"}

test item-14.6 {item element cget} -body {
    .t item element cget 8 0 eText -fill
} -result {}

test item-14.7 {item element configure} -body {
    .t item element configure 8 0 eText
} -result {{-data {} {} {} {}} {-datatype {} {} {} {}} *} -match glob

test item-14.8 {item element configure/cget} -body {
    .t item element configure 8 0 eText -fill yellow
    .t item element cget 8 0 eText -fill
} -result {yellow}

test item-14.9 {item element configure} -body {
    .t item element configure 8 0 eText -fill
} -result {-fill {} {} {} yellow}

test item-15.1 {item style: missing args} -body {
    .t item style
} -returnCodes error -result {wrong # args: should be ".t item style command item ?arg ...?"}

test item-15.2 {item style: invalid command} -body {
    .t item style foo bar
} -returnCodes error -result {bad command "foo": must be *} -match glob

test item-15.3 {item style: invalid command} -body {
    .t item style foo bar
} -returnCodes error -result {bad command "foo": must be *} -match glob

test item-15.4 {item style elements: missing args} -body {
    .t item style elements 8
} -returnCodes error -result {wrong # args: should be ".t item style elements item column"}

test item-15.5 {item style elements: invalid item} -body {
    .t item style elements 999
} -returnCodes error -result {item "999" doesn't exist}

test item-15.6 {item style elements: item without style} -body {
    .t item style elements 1 0
} -returnCodes error -result {item 1 column 0 has no style}

test item-15.7 {item style elements} -body {
    .t item style elements 8 0
} -result {eText}

test item-15.8 {item style map: missing args} -body {
    .t item style map 8
} -returnCodes error -result {wrong # args: should be ".t item style map item column style map"}

test item-15.9 {item style map: invalid item} -body {
    .t item style map 999
} -returnCodes error -result {item "999" doesn't exist}

test item-15.10 {item style map: item with unknown style} -body {
    .t item style map 1 0 noStyle {foo bar}
} -returnCodes error -result {style "noStyle" doesn't exist}

test item-15.11 {item style map: odd elemented list} -body {
    .t item style map 8 0 testStyle foo
    .t item style elements 8 0
} -returnCodes error -result {list must contain even number of elements}

test item-15.12 {item style map: unknown element} -body {
    .t style create testStyle2
    .t item style map 8 0 testStyle2 {eText foo}
    .t item style elements 8 0
} -returnCodes error -result {element "foo" doesn't exist}

test item-15.13 {item style map: element not in to-style} -body {
    .t item style map 8 0 testStyle2 {eText eRect}
} -returnCodes error -result {style testStyle2 does not use element eRect}

test item-15.14 {item style map: element not in from-style} -body {
    # .t style elements testStyle2 {eImage eRect}
    .t item style map 8 0 testStyle2 {eRect eBorder}
} -returnCodes error -result {style testStyle does not use element eRect}

test item-15.15 {item style map: different element types} -body {
    .t style elements testStyle2 {eImage eRect}
    .t item style map 8 0 testStyle2 {eBorder eRect}
} -returnCodes error -result {can't map element type border to rect}

test item-15.16 {item style set: invalid item} -body {
    .t item style set foo bar
} -returnCodes error -result {bad item description "foo"}

test item-15.17 {item style set: without args returns all styles} -body {
    .t item style set 2
} -result {{}}

test item-15.18 {item style set: without args returns style} -body {
    .t item style set 2 0
} -result {}

test item-15.19 {item style set: without args returns style} -body {
    .t item style set 8 0
} -result {testStyle}

test item-15.20 {item style set} -body {
    .t item style set 8 0 testStyle2
    .t item style set 8
} -result {testStyle2}

test item-16.1 {item state: missing args} -body {
    .t item state
} -returnCodes error -result {wrong # args: should be ".t item state command item ?arg ...?"}

test item-16.2 {item state: unknown command} -body {
    .t item state foo bar
} -returnCodes error -result {bad command "foo": must be *} -match glob

test item-16.3 {item state get: unknown item} -body {
    .t item state get 999
} -returnCodes error -result {item "999" doesn't exist}

test item-16.4 {item state get: too much arg} -body {
    .t item state get 8 open enabled
} -returnCodes error -result {wrong # args: should be ".t item state get 8 ?state?"}

test item-16.5 {item state get: invalid arg} -body {
    .t item state get 8 !open
} -returnCodes error -result {can't specify '!' for this command}

test item-16.6 {item state get: invalid arg} -body {
    .t item state get 8 ~open
} -returnCodes error -result {can't specify '~' for this command}

test item-16.6 {item state get: unknown state} -body {
    .t item state get 8 foo
} -returnCodes error -result {unknown state "foo"}

test item-16.7 {item state: list all set states} -body {
    .t item state get 8
} -result {open enabled}

test item-16.8 {item state get: state not set} -body {
    .t item state get 8 active
} -result {0}

test item-16.9 {item state get: state set} -body {
    .t item state get 8 open
} -result {1}

test item-16.10 {item state get: user defined state not set} -body {
    .t item state get 8 state0
} -result {0}

test item-16.11 {item state set: missing arg} -body {
    .t item state set 8
} -returnCodes error -result {wrong # args: should be ".t item state set 8 ?last? stateList"}

test item-16.12 {item state: try to reset predefined state} -body {
    .t item state set 8 open
} -returnCodes error -result {can't specify state "open" for this command}

test item-16.13 {item state: unknown states} -body {
    .t item state set 8 {foo bar}
} -returnCodes error -result {unknown state "foo"}

test item-16.14 {item state: unknown state leaded by !} -body {
    .t item state set 8 !foo
} -returnCodes error -result {unknown state "foo"}

test item-16.15 {item state: unknown state leaded by ~} -body {
    .t item state set 8 ~bar
} -returnCodes error -result {unknown state "bar"}

test item-16.16 {item state: switch on states} -body {
    .t item state set 8 state0
    .t item state get 8
} -result {open enabled state0}

test item-16.17 {item state get: user defined state set} -body {
    .t item state get 8 state0
} -result {1}

test item-16.18 {item state: toggle state} -body {
    .t item state set 8 ~state0
    .t item state get 8
} -result {open enabled}

test item-16.19 {item state: switch off states} -body {
    .t item state set 8 !state0
    .t item state get 8 state0
} -result {0}

test item-16.20 {item state: reset predefined state} -body {
    .t collapse 8
    .t item state get 8
} -result {enabled}

test item-16.21 {item state: reset predefined state} -body {
    .t expand 8
    .t item state get 8
} -result {open enabled}

test item-16.22 {item state: reset predefined state} -body {
    .t toggle 8
    .t item state get 8 enabled
} -result {1}

test item-17.1 {item sort: missing args} -body {
    .t item sort
} -returnCodes error -result {wrong # args: should be ".t item sort item ?option ...?"}

test item-17.2 {item sort: invalid item} -body {
    .t item sort foo
} -returnCodes error -result {bad item description "foo"}

test item-17.3 {item sort: is all allowed?} -body {
    .t item sort all
} -returnCodes error -result {can't specify "all" for this command}

test item-17.4 {item sort: invalid option} -body {
    .t item sort root -foo
} -returnCodes error -result {bad option "-foo": must be *} -match glob

test item-17.5 {item sort: missing arg to an option} -body {
    .t item sort root -first
} -returnCodes error -result {missing value for "-first" option}

test item-17.6 {item sort: invalid column} -body {
    .t item sort root -column 3
} -returnCodes error -result {column "3" doesn't exist}

test item-17.7 {item sort: invalid column, second try} -body {
    .t item sort root -column tail
} -returnCodes error -result {can't specify "tail" for this command}

test item-17.8 {item sort: sort needs style to find text} -body {
    .t item sort root
} -returnCodes error -result {item 1 column 0 has no style}

proc listItems {t {i root}} {
    set res {}
    foreach c [$t item children $i] {
	lappend res $c
	eval lappend res [listItems $t $c]
    }
    return $res
}

test item-17.9 {item sort: set the texts in column 0 for all items} -body {
    .t column create
    .t style create   textStyle
    .t style elements textStyle {eRect eBorder eText}
    .t element create eTime text
    .t style create   timeStyle
    .t style elements timeStyle eTime
    foreach i [listItems .t] {
	.t item style set $i 0 textStyle
	.t item style set $i 1 timeStyle
	.t item text $i 0 [expr {$i+5}]
    }
    .t item text 8 0
} -result {13}

test item-17.10 {item sort: sort all by ascii} -body {
    .t item sort root
    listItems .t
} -result {5 6 7 8 1 2 3 4}

test item-17.11 {item sort: sort all decreasing by ascii} -body {
    .t item sort root -decreasing
    listItems .t
} -result {1 2 3 4 8 5 6 7}

test item-17.12 {item sort: sort all as integer} -body {
    .t item sort root -integer
    listItems .t
} -result {1 2 3 4 5 6 7 8}

test item-17.13 {item sort: for integers -dictionary works also} -body {
    .t item sort root -dictionary
    listItems .t
} -result {1 2 3 4 5 6 7 8}

test item-17.14 {item sort: sort all decreasing as integer} -body {
    .t item sort root -integer -decreasing
    listItems .t
} -result {8 5 6 7 1 2 3 4}

test item-17.15 {item sort: don't sort, only return sorted items} -body {
    .t item lastchild root 5
    list [.t item sort root -notreally] [listItems .t]
} -result {{5 8 1} {8 1 2 3 4 5 6 7}}

test item-17.16 {item sort: return integer sorted items} -body {
    .t item sort root -notreally -integer
} -result {1 5 8}

test item-17.17 {item sort: return integer sorted items} -body {
    .t item sort root -notreally -dictionary -decreasing
} -result {8 5 1}

test item-17.18 {item sort: two sort options, last wins (as in lsort)} -body {
    .t item sort root -integer -ascii
    listItems .t
} -result {5 6 7 8 1 2 3 4}

test item-17.19 {item sort: two order options, last wins (as in lsort)} -body {
    .t item sort root -real -decreasing -increasing
    listItems .t
} -result {1 2 3 4 5 6 7 8}

test item-17.20 {item sort: restrict to item of different parent} -body {
    .t item sort root -first 2
} -returnCodes error -result {item 2 is not a child of item 0}

test item-17.21 {item sort: restrict to unknown item} -body {
    .t item sort root -first foo
} -returnCodes error -result {bad item description "foo"}

test item-17.22 {item sort: restricted sort} -body {
    .t item sort root -first 5 -last 8 -decreasing
    listItems .t
} -result {1 2 3 4 8 5 6 7}

test item-17.23 {item sort: restricted sort returned} -body {
    .t item sort root -first 5 -last 8 -notreally
} -result {5 8}

test item-17.24 {item sort: order of restriction doesn't matter} -body {
    .t item sort root -first 8 -last 5 -notreally
} -result {5 8}

test item-17.25 {item sort: very restricted sort returned} -body {
    .t item sort root -first 5 -last 5 -notreally
} -result {5}

test item-17.26 {item sort -command: missing arg} -body {
    .t item sort root -command
} -returnCodes error -result {missing value for "-command" option}

test item-17.27 {item sort -command: unknown command} -body {
    .t item sort root -command foo
} -returnCodes error -result {invalid command name "foo"}

test item-17.28 {item sort -command: unknown command} -body {
    .t item sort root -command #
} -returnCodes error -result {invalid command name "#"}

test item-17.29 {item sort -command: invalid return value} -body {
    .t item sort root -command list
} -returnCodes error -result {-command returned non-numeric result}

proc myCompare {op item1 item2} {
    switch -- $op {
	1 - 0 - -1 {
	    return $op
	}
	timespan-1 {
	    regsub -all : [.t item text $item1 1] "" val1
	    regsub -all : [.t item text $item2 1] "" val2
	    return [expr {[string trimleft $val1 0]-[string trimleft $val2 0]}]
	}
	ascii {
	    return [string compare [.t item text $item1 0] \
				   [.t item text $item2 0]]
	}
	ascii-1 {
	    return [string compare [.t item text $item1 1] \
				   [.t item text $item2 1]]
	}
	default {
	    return -code $op 0
	}
    }
}

test item-17.30 {item sort -command: too less arguments to proc call} -body {
    .t item sort root -command myCompare
} -returnCodes error -result {wrong # args: should be "myCompare op item1 item2"}

test item-17.31 {item sort -command: always returning 0 is identity} -body {
    set res [list [listItems .t]]
    .t item sort root -command {myCompare 0}
    lappend res [listItems .t]
} -result {{1 2 3 4 8 5 6 7} {1 2 3 4 8 5 6 7}}

test item-17.32 {item sort -command: returnCode break} -body {
    list [catch {.t item sort root -command {myCompare break}} msg] $msg \
	$errorInfo
} -result {3 0 {0
    (evaluating item sort -command)}}

test item-17.33 {item sort -command: always returning 1 is identity?} -body {
    set res [list [listItems .t]]
    .t item sort root -command {myCompare 1}
} -returnCodes error -result {buggy item sort -command detected}

test item-17.34 {item sort -command: always returning -1 reverts?} -body {
    .t item sort root -command {myCompare -1}
} -returnCodes error -result {buggy item sort -command detected}

test item-17.35 {item sort -command: ascii} -body {
    .t item sort root -command {myCompare ascii}
    listItems .t
} -result {5 6 7 8 1 2 3 4}

test item-17.36 {item sort -command: reverse ascii} -body {
    .t item sort root -command {myCompare ascii} -decreasing
    listItems .t
} -result {1 2 3 4 8 5 6 7}

test item-17.37 {item sort: with timespans column} -body {
    .t item text 1 1 "01:00"
    .t item text 5 1 "10:00"
    .t item text 8 1 "02:09:00"
    .t item sort root -column 1
    listItems .t
} -result {1 2 3 4 8 5 6 7}

test item-17.38 {item sort -command: ascii with timespans column} -body {
    .t item sort root -command {myCompare ascii-1}
    listItems .t
} -result {1 2 3 4 8 5 6 7}

test item-17.39 {item sort -command: timespan with timespans column} -body {
    .t item sort root -command {myCompare timespan-1}
    listItems .t
} -result {1 2 3 4 5 6 7 8}

test item-17.40 {item sort -command: reverse timespan with timespans} -body {
    .t item sort root -command {myCompare timespan-1} -decreasing
    listItems .t
} -result {8 5 6 7 1 2 3 4}

test item-17.41 {item sort -command: reverse timespan with timespans} -body {
    .t item sort root -command {myCompare timespan-1} -decreasing -notreally
} -result {8 5 1}

test item-17.42 {item sort -element: missing arg} -body {
    .t item sort root -element
} -returnCodes error -result {missing value for "-element" option}

test item-17.43 {item sort -element: invalid element} -body {
    .t item sort root -element foo
} -returnCodes error -result {element "foo" doesn't exist}

test item-17.44 {item sort -element: no text element} -body {
    .t item sort root -element eBorder
} -returnCodes error -result {element eBorder is not of type "text"}

test item-17.45 {item sort -element: element in wrong column} -body {
    .t item sort root -column 1 -element eText -dictionary
    listItems .t
} -returnCodes error -result {style timeStyle does not use element eText}

test item-17.46 {item sort -element: -colum defaults to 0} -body {
    .t item sort root -element eTime
    listItems .t
} -returnCodes error -result {style textStyle does not use element eTime}

test item-17.47 {item sort -element: element in columns} -body {
    .t item sort root -column 1 -element eTime
    listItems .t
} -result {1 2 3 4 8 5 6 7} ;# same result as in 17.37

test item-17.48 {item sort -element: useless for -command} -body {
    .t item sort root -column 1 -element eTime -command {myCompare timespan-1}
    listItems .t
} -result {1 2 3 4 5 6 7 8} ;# same result as in 17.39

test item-17.49 {item sort -command: no columns} -body {
    while {![catch {.t column configure "order 0"}]} {
	.t column delete "order 0"
    }
    .t item sort root
} -returnCodes error -result {there are no columns}

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

# cleanup
::tcltest::cleanupTests
return