toolbar.test

这是一个Linux下的集成开发环境

# This file is a Tcl script to test out [incr Widgets] Toolbar 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 DSC Technologies Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id: toolbar.test,v 1.1 2003/02/05 10:54:15 mdejong Exp $

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 Toolbar-1.$c {Toolbar construction} {
    iwidgets::Toolbar .tb
    pack .tb 
    update 
    .tb add button item1 -text item1 
    update 
    .tb add button item2 -text item2
    update 
    .tb add button item3 -text item3
    update 
} {}

incr c

#
# Option tests which are successful.
#
test Toolbar-2.$o {configuration option} {
    llength [.tb configure]
} {27}

incr o

foreach test {
	{-disabledforeground #a3a3a3 #a3a3a3 }
	{-highlightthickness 0 0 }
	{-selectborderwidth 4 4  }
	{-balloonfont 6x10 6x10 }
	{-balloondelay1 1000 1000 }
	{-balloondelay2 200 200 }
	{-borderwidth 2 2 }
	{-selectcolor #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
	{-highlightcolor Black Black }
	{-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
	{-balloonbackground yellow yellow }
	{-helpvariable testing testing}
	{-troughcolor #c3c3c3 #c3c3c3 }
	{-selectbackground #c3c3c3 #c3c3c3 }
	{-highlightbackground #d9d9d9 #d9d9d9 }
	{-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
	{-state normal normal }
	{-balloonforeground black black }
	{-selectforeground Black Black }
	{-foreground #000000000000 #000000000000 }
	{-activebackground #ececec #ececec }
	{-insertbackground Black Black }
	{-cursor crosshair crosshair  }
	{-activeforeground Black Black }
	{-insertforeground Black Black }
	{-orient horizontal horizontal }
	} {
	set option [lindex $test 0]
	test Toolbar-2.$o "configuration options, $option" {
	    .tb configure $option [lindex $test 1] 
		.tb cget $option
	} [lindex $test 2]
	update 
	incr o
}

#
# Itemconfigure Option tests which are successful.
#
# This happens to be for a button...
set o 0
test Toolbar-3.$o {tab configuration option} {
    llength [.tb itemconfigure 0]
} {33}

# do itemconfigure tests also...
foreach test {
	{0 -activebackground #ececec #ececec }
	{0 -activeforeground Black Black }
	{0 -anchor center center }
	{0 -background #d9d9d9 #d9d9d9 }
	{0 -bd 0 0 }
	{0 -bg #d9d9d9 #d9d9d9  }
	{0 -bitmap {} {} }
	{0 -borderwidth 2 2 }
	{0 -command {} {} }
	{0 -cursor {} {} }
	{0 -disabledforeground #a3a3a3 #a3a3a3 }
	{0 -fg Black Black }
	{0 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
	{0 -foreground Black Black }
	{0 -height 0 0 }
	{0 -highlightbackground #d9d9d9 #d9d9d9 }
	{0 -highlightcolor Black Black }
	{0 -highlightthickness 2 2 }
	{0 -image  {} {} }
	{0 -justify center center }
	{0 -padx 4 4 }
	{0 -pady 4 4 }
	{0 -relief raised raised }
	{0 -state normal normal }
	{0 -takefocus false false  }
	{0 -text {} {} }
	{0 -textvariable {} {}  }
	{0 -underline -1 -1 }
	{0 -width 0 0 }
	{0 -wraplength 0 0 }
	{0 -helpstr {} {} }
	{0 -balloonstr {} {} }
	} {
		set index  [lindex $test 0]
		set option [lindex $test 1]
		test Toolbar-2.$o "tab configuration options, $option" {
			.tb itemconfigure $index $option [lindex $test 2] 
			.tb itemcget $index $option
		} [lindex $test 3]
	update 
	incr o
}

#
# Option tests which fail and produce errors.
#
#foreach test {
#	{ -OPTION BADVALUE {ERROR_MESSAGE} }
#	} {
#	set option [lindex $test 0]
#        test Toolbar-2.$o "configuration options, $option" {
#	    list [catch {.bb configure $option [lindex $test 1]} msg] $msg
#	} [list 1 [lindex $test 2]]
#	incr o
#}

#
# Method tests which are successful.
#
foreach test {
    {{.tb delete 0 end}
		{}}
    {{.tb add radiobutton one} 
		{.tb.one}}
    {{.tb index end} 
		{0}}
    {{.tb add checkbutton two} 
		{.tb.two}}
    {{.tb index end} 
		{1}}
    {{.tb index one} 
		{0}}
    {{.tb insert end button oneandhalf -text "One & half"} 
		{.tb.oneandhalf}}
    {{.tb index oneandhalf} 
		{1}}
    {{.tb delete oneandhalf} 
		{}}
    {{.tb index two} 
		{1}}
    {{.tb delete 0 end} 
		{}}
    {{.tb index 0} 
		{-1}}
	} {
	set method [lindex [lindex $test 0] 1]
	set method_invoke [lindex $test 0]

	set testContents "set msg {}\n"
	append testContents \
	    "set result \[catch \{[lindex $test 0]\} msg\]\n"
	append testContents \
	    "lappend result \[regexp -- \{[lindex $test 1]\} \$msg\] \n"
	append testContents "set result\n"
	test Toolbar-4.$m "\[$method_invoke\]" $testContents \
		[list 0 1]
	update 
	incr m
}

#
# Method tests which fail and produce errors
#
foreach test {
		{1 {.tb delete 0 end} {}}
		{0 {.tb add button item1} {}}
		{0 {.tb delete 0} {}}
		{1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
		{0 {.tb add button item1} {}}
		{1 {.tb delete 1} {bad Toolbar widget index in delete method}}
		{0 {.tb delete 0} {}}
		{0 {.tb add button item1} {}}
		{1 {.tb delete 0 1} {bad Toolbar widget index2 in delete method}}
		{1 {.tb delete 1 4} {bad Toolbar widget index1 in delete method}}
		{0 {.tb add button item2} {}}
		{1 {.tb delete 1 0} {bad Toolbar widget index1 in delete method}}
		{0 {.tb delete 0 1} {}}
		{0 {.tb add button item1} {}}
		{1 {.tb delete 0 1 4 5 6} {wrong # args}}
		{1 {.tb delete} {wrong # args}}
		{0 {.tb delete 0} {}}
		{1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
		{1 {.tb insert 0 button itemA} {}}
		{0 {.tb add button item1} {}}
		{0 {.tb add button item2} {}}
		{0 {.tb insert 0 button itemAA} {}}
		{1 {.tb insert -1 button bogus} {bad toolbar entry index -1}}
		{0 {.tb delete 0 end} {}}
	} {
		set method_status [lindex $test 0]
		set method_invoke [lindex $test 1]
		set method [lindex $method_invoke 1]

		set testContents "set msg {}\n"
		append testContents \
		    "set result \[catch \{$method_invoke\} msg\]\n"
		append testContents \
		    "lappend result \[regexp -- \{[lindex $test 2]\} \$msg\] \n"
		append testContents "set result\n"
		test Toolbar-5.$m "\[$method_invoke\]" $testContents \
			[list $method_status 1]
	incr m
	}

#
# Conclusion of constrcution/destruction tests
#
test Toolbar-1.$c {Toolbar destruction} {
    destroy .tb
    update 
} {}

incr c

test Toolbar-1.$c {Toolbar construction} {
    iwidgets::Toolbar .tb 
    pack .tb 
    update 
    .tb add iwidgets::optionmenu opt
    update 
    .tb add button b
    update 
    .tb add frame filler
    update 
} {}

incr c

test Toolbar-1.$c {Toolbar destruction} {
	destroy .tb
    update 
} {}

::tcltest::cleanupTests
exit