mclistbox.test

# -*- tcl -*-
#
# Packages covered: mclistbox
# Commands covered: mclistbox
#
# This file contains a collection of tests for the "mclistbox" mega-
# widget. Sourcing this file into Tcl runs the tests and generates 
# output for errors.  No output means no errors were found.

if {![info exists DEFS_HAS_BEEN_LOADED]} {source defs}
if {[llength [info commands ::mclistbox::*]] == 0} {source mclistbox.tcl}

# make sure no other widgets presently exist
eval destroy [winfo children .]
wm geometry . {}
raise .

# testing the mclistbox command itself...
test mclistbox-1.0 {
    description "mclistbox creation" 
    constraints {}
    script      {::mclistbox::mclistbox .mclistbox}
    expected    {.mclistbox}
}


# this creates the widget we'll use for later tests...
test mclistbox-1.1 {
    description "mclistbox command with no arguments"
    constraints {}

    script {
	list [catch {::mclistbox::mclistbox} msg] $msg
    }

    expected {
	[list 1 {wrong # args: should be "mclistbox pathName ?options?"}]
    }
}

# testing when we give it the name of an already existing widget
test mclistbox-1.2 {
    description "mclistbox command with name of an existing widget"
    constraints {}
    script {
	catch {destroy .mclistbox}
	::mclistbox::mclistbox .mclistbox
	list [catch {::mclistbox::mclistbox .mclistbox} msg] $msg
    }
    expected {
	[list 1 {window name ".mclistbox" already exists}]
    }
}

test mclistbox-1.3 {
    description "mclistbox creates a widget of the proper name and class"
    script {
	catch {destroy .mclistbox}
	::mclistbox::mclistbox .mclistbox
	list \
		[winfo exists .mclistbox] \
		[winfo class .mclistbox] \
		[info commands .mclistbox]
    }
    expected {
	[list 1 Mclistbox .mclistbox]
    }
}

# try to create the widget with a bogus option
test mclistbox-1.4 {
    description {
	mclistbox command with a bogus option
    }

    script {
	catch {destroy .bogus}
	list \
		[catch {::mclistbox::mclistbox .bogus -bogus foo} msg] \
		$msg \
		[winfo exists .bogus] \
		[info commands .bogus]
    }

    expected {
	[ list \
		1 \
		{unknown option "-bogus"; must be one of\
		-background, -bd, -bg, -borderwidth,\
		-columnbd, -columnborderwidth, -columnrelief,\
		-cursor, -exportselection, -fg, -fillcolumn,\
		-font, -foreground, -height, -highlightbackground,\
		-highlightcolor, -highlightthickness, -labelanchor,\
		-labelbackground, -labelbd, -labelbg, -labelborderwidth,\
		-labelfg, -labelfont, -labelforeground, -labelheight,\
		-labelimage, -labelrelief, -labels, -relief,\
		-resizablecolumns, -selectbackground, -selectborderwidth,\
		-selectcommand, -selectforeground, -selectmode, -setgrid,\
		-takefocus, -width, -xscrollcommand or -yscrollcommand} \
		0 \
		{}]
    }
}

# make the window from the previous command visible
pack .mclistbox -side top -fill both -expand y

# these are tests on the various configuration options. Each option
# should have two tests -- one that uses a valid value and one that
# uses an invalid value.
set tests {
    {-background \
	    #ff0000 #ff0000 \
	    non-existent {unknown color name "non-existent"}}
    {-bd \
	    4 4 \
	    badValue {bad screen distance "badValue"}}
    {-bg \
	    #ff0000 #ff0000 \
	    non-existent {unknown color name "non-existent"}}
    {-borderwidth \
	    1.3 1 \
	    badValue {bad screen distance "badValue"}}
    {-columnborderwidth \
	    4 4 \
	    badValue {bad screen distance "badValue"}}
    {-columnrelief \
	    raised raised \
	    badValue {bad relief type "badValue":\
	    must be flat, groove, raised, ridge, solid, or sunken}}
    {-cursor \
	    arrow arrow \
	    badValue {bad cursor spec "badValue"}}
    {-exportselection \
	    yes 1 \
	    xyzzy {expected boolean value but got "xyzzy"}}
    {-fg \
	    #110022 #110022 \
	    badValue {unknown color name "badValue"}}
    {-fillcolumn \
	    bogus bogus \
	    {} {}}
    {-font \
	    {Helvetica 12} {Helvetica 12} \
	    {} {font "" doesn't exist}}
    {-foreground \
	    #110022 #110022 \
	    badValue {unknown color name "badValue"}}
    {-height \
	    30 30 \
	    20p {expected integer but got "20p"}}
    {-highlightbackground \
	    #112233 #112233 \
	    ugly {unknown color name "ugly"}}
    {-highlightcolor \
	    #123456 #123456 \
	    badValue {unknown color name "badValue"}}
    {-highlightthickness \
	    6 6 badValue \
	    {bad screen distance "badValue"}}
    {-highlightthickness \
	    -2 0 \
	    {} {}}
    {-labelimage \
	    {} {} \
	    badValue {image "badValue" doesn't exist}}
    {-labelheight \
	    20 20 \
	    20p {expected integer but got "20p"}}
    {-labels \
	    true 1 \
	    badValue {expected boolean value but got "badValue"}}
    {-labelrelief \
	    raised raised \
	    badValue {bad relief "badValue":\
	    must be flat, groove, raised, ridge, solid, or sunken}}
    {-labelfont \
	    {Helvetica 12} {Helvetica 12} \
	    {} {font "" doesn't exist}}
    {-labelanchor \
	    n n \
	    badValue {bad anchor "badValue":\
	    must be n, ne, e, se, s, sw, w, nw, or center}}
    {-labelbackground \
	    #ff0000 #ff0000 \
	    non-existent {unknown color name "non-existent"}}
    {-labelforeground \
	    #ff0000 #ff0000 \
	    non-existent {unknown color name "non-existent"}}
    {-labelborderwidth \
	    4 4 \
	    badValue {bad screen distance "badValue"}}
    {-relief \
	    groove groove \
	    1.5 {bad relief type "1.5":\
	    must be flat, groove, raised, ridge, solid, or sunken}}
    {-resizablecolumns \
	    true 1 \
	    badValue {expected boolean value but got "badValue"}}
    {-selectbackground \
	    #110022 #110022 \
	    badValue {unknown color name "badValue"}}
    {-selectborderwidth \
	    1.3 1 \
	    badValue {bad screen distance "badValue"}}
    {-selectforeground \
	    #654321 #654321 \
	    badValue {unknown color name "badValue"}}
    {-selectcommand \
	    string string \
	    {} {}}
    {-selectmode \
	    string string \
	    {} {}}
    {-setgrid \
	    false 0 \
	    lousy {expected boolean value but got "lousy"}}
    {-takefocus \
	    "any string" "any string" \
	    {} {}}
    {-width \
	    45 45 \
	    3p {expected integer but got "3p"}}
    {-xscrollcommand \
	    {Some command} {Some command} \
	    {} {}}
    {-yscrollcommand \
	    {Another command} {Another command} \
	    {} {}}
} 

# generally speaking, each option should have two tests, one with 
# a valid value and one with an invalid value. Some option tests
# skip the latter...
set i 1
foreach test $tests {
    set name [lindex $test 0]
    test mclistbox-2.$i "configuration options ([lindex $test 0])" \
	    {.mclistbox configure $name [lindex $test 1]
             list [lindex [.mclistbox configure $name] 4] \
		     [.mclistbox cget $name]} \
	    [list [lindex $test 2] [lindex $test 2]]
    incr i

    if {[lindex $test 3] != ""} {
	test mclistbox-2.$i "configuration options ([lindex $test 0])" {
	    list [catch {.mclistbox configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .mclistbox configure $name [lindex [.mclistbox configure $name] 3]
    incr i
}


# column related commands

test mclistbox-3.0 {
    description "mclistbox columns" 
    script {
	list [catch {.mclistbox column add col0 "Column 0"} msg] $msg
    } 
    expected {
	[list 1 {unknown column option "Column 0"; must be one of\
		-background, -bitmap, -font, -foreground,\
		-image, -label, -position, -resizable, -visible\
		or -width}]
    }
}

test mclistbox-3.1 {
    description "adding columns" 
    script {
	.mclistbox column add col0 -label "Column 0"
	.mclistbox column add col1 -label "Column 1"
	.mclistbox column add col2 -label "Column 2" -position 1
	.mclistbox column add col3 -label "Column 3" -position end
	.mclistbox column add col4 -label "Column 4" -position start
	.mclistbox column names
    }
    expected {
	[list col4 col0 col2 col1 col3]
    }
}

test mclistbox-3.2 {
    description "deleting columns" 
    script {
	.mclistbox column delete col2
	.mclistbox column names
    }
    expected {
	[list col4 col0 col1 col3]
    }
}

test mclistbox-3.3 {
    description "showing and hiding columns" 
    script {
	.mclistbox column configure col0 -visible 0
	.mclistbox column configure col1 -visible 1
	.mclistbox column configure col3 -visible 0
	.mclistbox column configure col4 -visible 1
	list \
		[.mclistbox column cget col0 -visible] \
		[.mclistbox column cget col1 -visible] \
		[.mclistbox column cget col3 -visible] \
		[.mclistbox column cget col4 -visible]
    }
    expected {
	[list 0 1 0 1]
    }
}

test mclistbox-3.4 {
    description "columns with spaces as identifiers" 
    script {
	.mclistbox column add "new column"
	.mclistbox column names
    }
    expected {
	[list col4 col0 col1 col3 {new column}]
    }
}
	
# inserting and retrieving data
# this assumes we have four columns...
test mclistbox-4.0 {
    description "inserting data" 
    script {
	.mclistbox insert end   [list "1" ]
	.mclistbox insert 0     [list "2" one]
	.mclistbox insert @0,0  [list "3" one two]
	.mclistbox activate 1 
	.mclistbox selection anchor 2
	.mclistbox insert active  [list "4" one two three]
	.mclistbox insert anchor  [list "5" one two three four]
	.mclistbox get 0 end
    }
    expected {
	[list \
		[list 3 one two {} {}] \
		[list 4 one two three {}] \
		[list 2 one {} {} {}] \
		[list 5 one two three four] \
		[list 1 {} {} {} {}]]
    }
}

test mclistbox-4.1 {
    description "inserting data at a bogus index" 
    script {
	list [catch {.mclistbox insert bogus \
		[list "Column 0" {} {}]} msg] $msg
    }
    expected {
	[list 1 {bad listbox index "bogus": must be active,\
		anchor, end, @x,y, or a number}]
    }
}

test mclistbox-5.0 {
    description "deleting all data" 
    script      {.mclistbox delete 0 end}
    expected    {}
}

test mclistbox-5.1 {
    description "deleting some data" 
    script {
	.mclistbox insert end {zero}
	.mclistbox insert end {one}
	.mclistbox insert end {two}
	.mclistbox delete 1 1
	.mclistbox get 0 end
    }
    expected {
	[list [list zero {} {} {} {}] [list two {} {} {} {}]]
    }
}

# yview. Mostly I'm just looking for catastrophic failures...
# This test adds some data used by later tests, so modify with 
# caution..
test mclistbox-6.0 {
    description "retrieving the yview" 
    script {
	.mclistbox configure -height 5 -labels 1
	.mclistbox delete 0 end
	.mclistbox insert end [list "0" ]
	.mclistbox insert end [list "1" one]
	.mclistbox insert end [list "2" two] 
	.mclistbox insert end [list "3" three] 
	.mclistbox insert end [list "4" four]
	.mclistbox insert end [list "5" five]
	.mclistbox insert end [list "6" six]
	.mclistbox insert end [list "7" seven]
	.mclistbox insert end [list "8" eight]
	.mclistbox insert end [list "9" nine]
	update idletasks
	.mclistbox yview
    }
    expected {
	[list 0 0.5]
    }
}

# this test assumes data is still left over from test 6.0...
test mclistbox-6.1 {
    description "adjusting the yview" 
    script {
	.mclistbox yview 5
	.mclistbox yview
    }
    expected {
	[list 0.5 1]
    }
}

test mclistbox-6.2 {
    description "adjusting the yview" 
    script {
	.mclistbox yview 0
	.mclistbox yview moveto .3
	.mclistbox yview
    }
    expected {
	[list 0.3 0.8]
    }
}

test mclistbox-6.3 {
    description "scrolling in the Y direction" 
    script {
	.mclistbox yview 0
	.mclistbox yview scroll 3 units
	set first [.mclistbox yview]
	.mclistbox yview 0
	.mclistbox yview scroll 1 page
	set second [.mclistbox yview]
	set result [list $first $second]
    }
    expected {
	[list {0.3 0.8} {0.3 0.8}]
    }
}

# xview. Mostly I'm just looking for catastrophic failures...
# This test adds some data used by later tests, so modify with 
# caution..

test mclistbox-7.0 {

    description "determining the xview" 

    script {
	.mclistbox configure -height 5 -width 25 -labels 1
	foreach column [.mclistbox column names] {
	    .mclistbox column delete $column
	}
	.mclistbox column add col0 -label "Column 0" -width 25
	.mclistbox column add col1 -label "Column 1" -width 25
	.mclistbox column add col2 -label "Column 2" -width 25
	.mclistbox column add col3 -label "Column 3" -width 25
	update idletasks

	set result [.mclistbox xview]
	.mclistbox xview moveto .25
	set result [concat $result [.mclistbox xview]]

	# There's a little "slop" somewhere, but I'm not sure where.
	# (probably in column borders and such...)  So, for the time
	# being we'll round the results of the xview command to two
	# decimal places. The main goal for this test is to make sure the
	# xview command doesn't crash, and at least gives answers that
	# are mostly correct.

	set newResult ""
	foreach item $result {
	    set item [expr {int($item * 100) / 100.0}]
	    lappend newResult $item
	}
	set newResult
    }
    expected {
	[list 0.0 0.25 0.25 0.5]
    }
}

return