combobox.test

linux 下的源代码分析阅读器 red hat公司新版

# This file is a Tcl script to test out [incr Widgets] Combobox class.
# It is organized in the standard fashion for Tcl tests with the following
# notation for test case labels:
#
#   1.x - Construction/Destruction tests
#   2.x - Configuration option tests
#   3.x - Method tests
#
# Copyright (c) 1995 John S. Sigler
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest
namespace import -force ::tcltest::*

package require Iwidgets 3.0

if {[string compare test [info procs test]] == 1} {
    source defs
}

wm geometry . {}
raise .

set c 1
set o 1
set m 1

#
# Initial construction test
#
test Combobox-1.$c {Combobox construction} {
    iwidgets::Combobox .cb
    pack .cb -padx 10 -pady 10 -fill x -expand yes
    image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
    update 
} {}

incr c

#
# Option tests which are successful.
#
test Combobox-2.$o {configuration option} {
    llength [.cb configure]
} {51}

incr o

foreach test {
    {-listheight 150 150}
    {-width 20 20}
    {-textvariable option option}
    {-labeltext Combobox: Combobox:} 
    {-labelpos nw nw}
    {-labelpos n n}
    {-labelpos ne ne}
    {-labelpos w w}
    {-labelimage flagup flagup}
    {-labelpos nw nw}
    {-labelpos n n}
    {-labelpos ne ne}
    {-labelpos w w}
    {-labelimage {} {}} 
    {-borderwidth 10 10}
    {-borderwidth 2 2}
    {-background steelblue steelblue}
    {-foreground white white}
    {-background grey85 grey85}
    {-foreground Black Black}
    {-textvariable {} {}}
    {-state disabled disabled}
    {-state normal normal}
    {-textvariable option option}
    {-arrowrelief groove groove}
    {-arrowrelief flat flat}
    {-arrowrelief raised raised}
    {-selectioncommand {doit} {@scope :: doit}}
    {-selectioncommand {} {}}
    {-cursor {} {}}
	{-grab global global}
	{-grab local local}
    {-textvariable {} {} }
    {-dropdown false false}
    {-dropdown true true}
    {-textvariable option option}
    {-editable true true}
    {-editable false false}
    {-relief raised raised}
    {-relief groove groove}
    {-relief flat flat}
    {-relief sunken sunken}
    {-exportselection 1 1}
    {-exportselection 0 0}
    {-invalid {catch {blt_bell}} {catch {blt_bell}} }
    {-labelmargin 2 2}
    {-labelfont -Adobe-Helvetica-Bold-R-Normal--*-120-*  \
	-Adobe-Helvetica-Bold-R-Normal--*-120-*}
    {-margin 5 5}
    {-popupcursor hand1 hand1}
    {-popupcursor hand2 hand2}
    {-selectbackground \#b2dfee \#b2dfee}
    {-selectbackground steelblue steelblue}
    {-selectborderwidth 1 1}
    {-selectforeground Black Black}
    {-textbackground white white}
    {-textfont 10x20 10x20}
    {-textfont -Adobe-Helvetica-Medium-R-Normal--*-120-* \
	-Adobe-Helvetica-Medium-R-Normal--*-120-*} 
    {-textvariable {} {} }
    {-unique true true}
    {-validate alpha alpha}
    {-validate {} {}}
    {-dropdown false false}
    {-hscrollmode dynamic static}
    {-hscrollmode dynamic dynamic}
    {-vscrollmode dynamic static}
	{-grab global global}
    {-vscrollmode dynamic dynamic}
    {-dropdown true true}} {
	set option [lindex $test 0]
	test Combobox-2.$o "configuration options, $option" {
	    .cb configure $option [lindex $test 2]
	    lindex [.cb configure $option] 4
	} [lindex $test 2]
	update 
	incr o
    }

#
# Option tests which fail and produce errors.
#
foreach test {
    {-borderwidth bogus {bad screen distance "bogus"}}
	{-completion bogus {bad completion option "bogus": should be boolean}}
    {-cursor bogus {bad cursor spec "bogus"}}
    {-dropdown bogus {bad dropdown option "bogus": should be boolean}}
	{-editable bogus {bad editable option "bogus": should be boolean}}
    {-exportselection bogus {expected boolean value but got "bogus"}}
    {-grab bogus {bad grab value "bogus": must be global or local}}
    {-listheight bogus {bad screen distance "bogus"}}
    {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
    {-margin bogus {bad screen distance "bogus"}}
    {-popupcursor bogus {bad cursor spec "bogus"}}
    {-selectborderwidth bogus {bad screen distance "bogus"}}
    {-state bogus {bad state "bogus": must be disabled or normal}}
    {-unique bogus {bad unique value "bogus": should be boolean}}
    {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
    {-width bogus {expected integer but got "bogus"}} } {
	set option [lindex $test 0]
        test Combobox-2.$o "configuration options, $option" {
	    list [catch {.cb configure $option [lindex $test 1]} msg] $msg
	} [list 1 [lindex $test 2]]
	incr o
}
#
# Method tests which are successful.
#
foreach test {
    {{.cb configure -editable 1} {}}
    {{.cb clear all} {}}
    {{.cb insert list 0 Test1 Test2 Test3 Test4} {}}
    {{.cb insert list end {More Test}} {}}
    {{.cb size} {5}}
    {{.cb delete list 1} {}}
    {{.cb delete list 0 2} {}}
    {{.cb size} {1}}
    {{.cb get 0} {More Test}}
    {{.cb selection set end end} {}}
    {{.cb getcurselection} {More Test}}
    {{.cb get} {More Test}}
    {{.cb clear entry} {}}
    {{.cb get} {}}
    {{.cb insert entry end "this is a test"} {} }
    {{.cb get} {this is a test}}
    {{.cb curselection} {}}
    {{.cb clear} {}}
    {{.cb size} {0}}
    {{.cb getcurselection} {}}
    {{.cb insert list end {Test1} {Test2} {Really Long String Test}} {}}
    {{.cb size} {3}}
    {{.cb get 0} {Test1}}
	{{.cb insert entry end R} {}}
	{{.cb getcurselection} {Really Long String Test}}
	{{.cb get} {Really Long String Test}}
	{{.cb config -completion off} {}}
	{{.cb selection clear 0 end} {}}
	{{.cb insert entry end R} {}}
	{{.cb get} {R}}
	{{.cb getcurselection} {}}
	{{.cb config -completion on} {}}
    {{.cb get [expr [.cb size]-1]} {Really Long String Test}}
    {{.cb insert list 0 {Test3} {Test4} {Really Long String Test}} {}}
    {{.cb size} {6}}
    {{.cb insert list 1 {Test5} {Test6} {Really Long String Test}} {}}
    {{.cb size} {9}}
    {{.cb insert list 5 {Test7} {Test8} {Really Long String Test}} {}}
    {{.cb size} {12}}
	{{.cb config -state disabled} {}}
	{{.cb insert list end {not gonna make it in}} {}}
	{{.cb size} {12}}
	{{.cb insert entry end {eally!}} {}}
	{{.cb get} {R}}
	{{.cb config -state normal} {}}
	{{.cb config -dropdown 0} {}}
	{{.cb size} {12}}
	{{.cb config -dropdown 1} {}}
	{{.cb size} {12}}
    {{.cb see 0} {}}
    {{.cb see 11} {}}
    {{.cb get end} {Really Long String Test}}
    {{.cb selection clear 0 end} {}}
    {{.cb selection set 5 5} {}}
    {{.cb curselection} {5}}
    {{.cb justify left} {}}
    {{.cb justify right} {}}
    {{.cb justify top} {}}
    {{.cb justify bottom} {}}
    {{.cb sort ascending} {}}
    {{.cb sort descending} {}}
    {{.cb sort increasing} {}}
    {{.cb sort decreasing} {}}} {
	set method [lindex [lindex $test 0] 1]
	test Combobox-3.$m "object methods, $method" {
	    list [catch {eval [lindex $test 0]} msg] $msg
	} [list 0 [lindex $test 1]]
	update 
	incr m
}

#
# Method tests which fail and produce errors
#
foreach test {
    {{.cb clear bogus} {bad Combobox component "bogus": must be entry, list, or all.}}
    {{.cb delete} {wrong # args: should be ".cb delete component first ?last?"}}
    {{.cb delete bogus 0} {bad Combobox component "bogus": must be entry or list.}}
    {{.cb delete list} {wrong # args: should be ".cb delete component first ?last?"}}
    {{.cb delete entry} {wrong # args: should be ".cb delete component first ?last?"}}
    {{.cb get bogus1 bogus2} {wrong # args: should be ".cb get ?index?"}}
    {{.cb insert} {wrong # args: should be ".cb insert component index ?arg arg ...?"}}
    {{.cb insert bogus 0 bogus0} {bad Combobox component "bogus": must be entry or list.}}
    {{.cb insert list} {wrong # args: should be ".cb insert component index ?arg arg ...?"}}
    {{.cb insert list 1} {no value given for parameter "string" in function "Combobox::insert"}}
    {{.cb insert entry a b c} {called function "Combobox::insert entry" with too many arguments}}
    {{.cb selection} {wrong # args: should be ".cb selection option first ?last?"}}
    {{.cb selection bogus1 bogus2 bogus3 bogus4} {wrong # args: should be ".cb selection option first ?last?"}}
    {{.cb selection bogus bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}}
    {{.cb sort bogus} {bad sort argument "bogus": should be ascending, descending, increasing, or decreasing}}} {
    set method [lindex [lindex $test 0] 1]
    test Combobox-3.$m "object methods, $method" {
	list [catch {eval [lindex $test 0]} msg] $msg
    } [list 1 [lindex $test 1]]
    incr m
}

#
# Conclusion of constrcution/destruction tests
#
test Combobox-4.1 {Combobox destruction} {
    destroy .cb
    update 
} {}

incr c

test Combobox-4.2 {Combobox construction} {
    iwidgets::Combobox .cb3 -selectioncommand {puts "choice: [.cb get]" } \
	-dropdown false -listheight 50 \
	-labeltext "Numeric Simple:" -labelpos w \
	-validate numeric -unique false
	.cb3 insert list end 123 456 789 101112
    pack .cb3 -padx 10 -pady 10 -fill both -expand yes
    update 
} {}

incr c

test Combobox-4.3 {Combobox destruction} {
    destroy .cb3
    update 
} {}

test Combobox-4.4 {Combobox construction} {
    iwidgets::Combobox .cb4 -arrowrelief flat -selectioncommand {puts "choice: [.cb get]" } \
	-editable false \
	-listheight 200 -labeltext "DropDown:" -labelpos w \
	-popupcursor hand1 -unique true
	.cb4 insert list end Hello {Out There} World
    pack .cb4 -padx 10 -pady 10 -fill both -expand yes
    update 
} {}

incr c

test Combobox-4.5 {Combobox destruction} {
    destroy .cb4
    update 
} {}

::tcltest::cleanupTests
exit